Find all our projects in development below.
All source code is GNU General Public License (GPL)
Browsing PopupForm.frm (18.82 KB)
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form PopupForm
BorderStyle = 1 'Fixed Single
Caption = "WinPopup Plus"
ClientHeight = 3615
ClientLeft = 150
ClientTop = 435
ClientWidth = 5175
Icon = "PopupForm.frx":0000
MaxButton = 0 'False
ScaleHeight = 3615
ScaleWidth = 5175
StartUpPosition = 2 'CenterScreen
Begin VB.Timer MailBoxTimer
Interval = 30
Left = 2400
Top = 480
End
Begin MSComctlLib.Toolbar Toolbar1
Align = 1 'Align Top
Height = 435
Left = 0
TabIndex = 2
Top = 0
Width = 5175
_ExtentX = 9128
_ExtentY = 767
ButtonWidth = 661
ButtonHeight = 609
AllowCustomize = 0 'False
Appearance = 1
ImageList = "ImageList1"
DisabledImageList= "ImageList2"
_Version = 393216
BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628}
NumButtons = 4
BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628}
Object.ToolTipText = "Send"
ImageIndex = 1
EndProperty
BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628}
Object.ToolTipText = "Delete"
ImageIndex = 2
EndProperty
BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628}
Object.ToolTipText = "Previous"
ImageIndex = 3
EndProperty
BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628}
Object.ToolTipText = "Next"
ImageIndex = 4
EndProperty
EndProperty
End
Begin VB.TextBox Text1
BackColor = &H00C0C0C0&
Enabled = 0 'False
Height = 2190
Left = 120
Locked = -1 'True
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 1
Top = 960
Width = 4935
End
Begin MSComctlLib.ImageList ImageList1
Left = 120
Top = 480
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 18
ImageHeight = 17
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 4
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "PopupForm.frx":0442
Key = ""
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "PopupForm.frx":09EA
Key = ""
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "PopupForm.frx":0F92
Key = ""
EndProperty
BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "PopupForm.frx":153A
Key = ""
EndProperty
EndProperty
End
Begin MSComctlLib.StatusBar StatusBar1
Align = 2 'Align Bottom
Height = 315
Left = 0
TabIndex = 0
Top = 3300
Width = 5175
_ExtentX = 9128
_ExtentY = 556
_Version = 393216
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
NumPanels = 2
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
AutoSize = 1
Object.Width = 4524
Text = "Current message: 0"
TextSave = "Current message: 0"
EndProperty
BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628}
AutoSize = 1
Object.Width = 4524
Text = "Total number of messages: 0"
TextSave = "Total number of messages: 0"
EndProperty
EndProperty
End
Begin MSComctlLib.ImageList ImageList2
Left = 720
Top = 480
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 18
ImageHeight = 17
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 4
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "PopupForm.frx":1AE2
Key = ""
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "PopupForm.frx":208A
Key = ""
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "PopupForm.frx":2632
Key = ""
EndProperty
BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "PopupForm.frx":2BDA
Key = ""
EndProperty
EndProperty
End
Begin VB.Image IconImage2
Height = 375
Left = 1920
Top = 480
Visible = 0 'False
Width = 375
End
Begin VB.Image IconImage
Height = 375
Left = 1440
Top = 480
Visible = 0 'False
Width = 375
End
Begin VB.Menu MessagesMenu
Caption = "&Messages"
Begin VB.Menu SendMenu
Caption = "&Send..."
Shortcut = ^S
End
Begin VB.Menu DiscardMenu
Caption = "&Discard"
Shortcut = ^D
End
Begin VB.Menu Blank1
Caption = "-"
End
Begin VB.Menu PreviousMenu
Caption = "&Previous"
Shortcut = ^P
End
Begin VB.Menu NextMenu
Caption = "&Next"
Shortcut = ^N
End
Begin VB.Menu ClearAllMenu
Caption = "&Clear All"
End
Begin VB.Menu Blank2
Caption = "-"
End
Begin VB.Menu OptionsMenu
Caption = "&Options..."
Shortcut = ^O
End
Begin VB.Menu AutoAliasSetupMenu
Caption = "&AutoAlias Setup..."
End
Begin VB.Menu Blank4
Caption = "-"
End
Begin VB.Menu ExitMenu
Caption = "E&xit"
End
End
Begin VB.Menu HelpMenu
Caption = "&Help"
Begin VB.Menu EnterUCMenu
Caption = "&Enter Unlock Code"
End
Begin VB.Menu Blank3
Caption = "-"
End
Begin VB.Menu AboutMenu
Caption = "&About WinPopup Plus"
End
End
End
Attribute VB_Name = "PopupForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Const DEFAULT_GUI_FONT = 17
Private Const STATIC_CLASS = "Static"
Private Const WM_SETFONT = &H30
Private Const WM_SETTEXT = &HC
Private Const WS_CHILD = &H40000000
Private Const WS_VISIBLE = &H10000000
Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
Private Declare Function EnableWindow Lib "user32" (ByVal hwnd As Long, ByVal fEnable As Long) As Long
Private Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function SendMessageByString Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
Private Declare Function ShellAbout Lib "shell32" Alias "ShellAboutA" (ByVal hwnd As Long, ByVal szApp As String, ByVal szOtherStuff As String, ByVal hIcon As Long) As Long
Dim StaticControl As Long
Dim bNoExitMsg As Boolean
Sub EnableControls(bEnabled As Boolean)
Text1.Enabled = bEnabled
DiscardMenu.Enabled = bEnabled
ClearAllMenu.Enabled = bEnabled
Toolbar1.Buttons(2).Enabled = bEnabled
If bEnabled = False Then
PreviousMenu.Enabled = False
NextMenu.Enabled = False
Toolbar1.Buttons(3).Enabled = False
Toolbar1.Buttons(4).Enabled = False
End If
EnableWindow StaticControl, 1
If bEnabled Then
Icon = IconImage2.Picture
Else
Icon = IconImage.Picture
End If
End Sub
Public Function SetCaption(ByVal hwnd As Long, ByVal Caption As String) As Long
SetCaption = SendMessageByString(hwnd, WM_SETTEXT, 0, Caption)
End Function
Private Sub AboutMenu_Click()
ShellAbout hwnd, "WinPopup Plus", "Version: " + Ver + vbCrLf + "Programmed By Jason's PC Software", IconImage.Picture
End Sub
Private Sub AutoAliasSetupMenu_Click()
AutoAliasForm.Show 1
End Sub
Private Sub ClearAllMenu_Click()
Dim M As VbMsgBoxResult
Dim i As Long
M = MsgBox("Are you sure you want to delete all your messages?", vbOKCancel + vbQuestion)
If M = vbCancel Then Exit Sub
For i = MailBox.Count To 1 Step -1
MailBox.ClearMessage i
Next i
CurrentMsg = 0
EnableControls False
Text1.Text = ""
SetCaption StaticControl, "No messages"
StatusBar1.Panels(1).Text = "Current message: 0"
StatusBar1.Panels(2).Text = "Total number of messages: 0"
End Sub
Private Sub DiscardMenu_Click()
MailBox.ClearMessage CurrentMsg
CurrentMsg = CurrentMsg - 1
If CurrentMsg = 0 Then CurrentMsg = 1
PreviousMenu.Enabled = False
Toolbar1.Buttons(3).Enabled = False
NextMenu.Enabled = False
Toolbar1.Buttons(4).Enabled = False
If MailBox.Count = 0 Then
CurrentMsg = 0
EnableControls False
Text1.Text = ""
SetCaption StaticControl, "No messages"
StatusBar1.Panels(1).Text = "Current message: 0"
StatusBar1.Panels(2).Text = "Total number of messages: 0"
WindowState = 1
ElseIf MailBox.Count > 1 Then
If CurrentMsg = 1 Then
NextMenu.Enabled = True
Toolbar1.Buttons(4).Enabled = True
ElseIf CurrentMsg > 1 And CurrentMsg < MailBox.Count Then
PreviousMenu.Enabled = True
Toolbar1.Buttons(3).Enabled = True
NextMenu.Enabled = True
Toolbar1.Buttons(4).Enabled = True
ElseIf CurrentMsg = MailBox.Count Then
PreviousMenu.Enabled = True
Toolbar1.Buttons(3).Enabled = True
End If
End If
If CurrentMsg > 0 Then
EnableWindow StaticControl, MailBox.MessageState(CurrentMsg)
Text1.Text = MailBox.MessageText(CurrentMsg)
SetCaption StaticControl, "Message from " + MailBox.MessageSender(CurrentMsg) + " to " + MailBox.MessageRecipient(CurrentMsg) + _
vbCrLf + "on " + MailBox.MessageTimeDate(CurrentMsg)
StatusBar1.Panels(1).Text = "Current message: " & CurrentMsg
StatusBar1.Panels(2).Text = "Total number of messages: " & MailBox.Count
End If
End Sub
Private Sub EnterUCMenu_Click()
Dim UC As String
UC = GetUserInput("Code: ", "Enter Unlock Code - " + App.Title, , , GI_MASKINPUT)
If UC = UnlockCode Then
bIsUnlocked = True
EnterUCMenu.Enabled = False
MsgBox "All features are now unlocked!", vbExclamation
Else
If UC <> "" Then MsgBox "Unlock Code Incorrect", vbExclamation
End If
End Sub
Private Sub ExitMenu_Click()
Unload Me
End Sub
Private Sub Form_Load()
Dim RegData As Variant
Dim bRegErr As Boolean
Dim i As Integer
Dim iOffset As Integer
StaticControl = CreateWindowEx(0&, STATIC_CLASS, "No messages", WS_CHILD Or WS_VISIBLE, 8&, 32&, 329&, 33&, hwnd, 0&, App.hInstance, 0&)
SendMessage StaticControl, WM_SETFONT, GetStockObject(DEFAULT_GUI_FONT), 0&
IconImage.Picture = Icon
IconImage2.Picture = SendForm.IconImage.Picture
Unload SendForm
Ver = App.Major & "." & App.Minor & _
IIf(App.Revision = 0, "", "." & App.Revision)
Set MailBox = New cMailBox
If Not MailBox.InitMailBox Then
MsgBox "Unable to set up a message box to store your messages.", vbExclamation
bNoExitMsg = True
Unload Me
Exit Sub
End If
EnableControls False
bIsUnlocked = False
SaveRegString HKEY_LOCAL_MACHINE, RegAppRoot, "", Ver
RegData = Val(GetRegString(HKEY_LOCAL_MACHINE, RegAppRoot, "PlaySound", bRegErr))
If (RegData <> 0 And RegData <> 1) Or bRegErr Then
Optn_PlaySound = 1
Else
Optn_PlaySound = RegData
End If
RegData = Val(GetRegString(HKEY_LOCAL_MACHINE, RegAppRoot, "AlwaysOnTop", bRegErr))
If (RegData <> 0 And RegData <> 1) Or bRegErr Then
Optn_AlwaysOnTop = 0
Else
Optn_AlwaysOnTop = RegData
End If
AlwaysOnTop Me, CBool(Optn_AlwaysOnTop)
RegData = Val(GetRegString(HKEY_LOCAL_MACHINE, RegAppRoot, "PopupDialog", bRegErr))
If (RegData <> 0 And RegData <> 1) Or bRegErr Then
Optn_PopupDialog = 0
Else
Optn_PopupDialog = RegData
End If
RegData = Val(GetRegString(HKEY_LOCAL_MACHINE, RegAppRoot, "AutoAliasEnabled", bRegErr))
If (RegData <> 0 And RegData <> 1) Or bRegErr Then
AAOptn_Enabled = 1
Else
AAOptn_Enabled = RegData
End If
RegData = Val(GetRegString(HKEY_LOCAL_MACHINE, RegAppRoot, "AutoAliasCount"))
If RegData > 0 Then
ReDim AA_List(RegData)
For i = 1 To UBound(AA_List)
AA_List(i - iOffset).Recipient = UCase(GetRegString(HKEY_LOCAL_MACHINE, RegAppRoot, "AutoAlias[" & i & "].Recipient"))
AA_List(i - iOffset).RecipientAlias = UCase(GetRegString(HKEY_LOCAL_MACHINE, RegAppRoot, "AutoAlias[" & i & "].RecipientAlias"))
If AA_List(i - iOffset).Recipient = "" Or AA_List(i - iOffset).RecipientAlias = "" Then
ReDim Preserve AA_List(UBound(AA_List) - 1)
iOffset = iOffset + 1
End If
Next i
Else
ReDim AA_List(0)
End If
bIsUnlocked = False
bNoExitMsg = False
StartMenuHelp hwnd
If App.PrevInstance Then
bNoExitMsg = True
Unload Me
End If
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If UnloadMode < 2 And bNoExitMsg = False Then
Dim M As VbMsgBoxResult
If MailBox.Count = 0 Then
M = MsgBox("When you close WinPopup Plus, you will not receive pop-up messages.", vbOKCancel + vbQuestion)
Else
M = MsgBox("When you close WinPopup Plus, you will not receive pop-up messages." + vbCrLf + _
"Unread messages will be discarded.", vbOKCancel + vbQuestion)
End If
If M = vbCancel Then Cancel = True: Exit Sub
End If
End Sub
Private Sub Form_Resize()
If WindowState = 0 Or MailBox.Count = 0 Then
Caption = App.Title
ElseIf WindowState = 1 And MailBox.Count > 0 Then
Caption = App.Title + ": " & MailBox.Count & " message" & IIf(MailBox.Count = 1, "", "s")
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
MailBox.CloseMailBox
EndMenuHelp
End
End Sub
Private Sub MailBoxTimer_Timer()
If MailBox.GetNewMessages Then
EnableControls True
StatusBar1.Panels(2).Text = "Total number of messages: " & MailBox.Count
If MailBox.Count > 1 Then
NextMenu.Enabled = True
Toolbar1.Buttons(4).Enabled = True
End If
If CurrentMsg = 0 Then
StatusBar1.Panels(1).Text = "Current message: 1"
Text1.Text = MailBox.MessageText(1)
SetCaption StaticControl, "Message from " + MailBox.MessageSender(1) + " to " + MailBox.MessageRecipient(1) + _
vbCrLf + "on " + MailBox.MessageTimeDate(1)
CurrentMsg = 1
End If
If WindowState = 1 Then Caption = App.Title + ": " & MailBox.Count & " message" & IIf(MailBox.Count = 1, "", "s")
If Optn_PlaySound = 1 Then Beep
If Optn_PopupDialog = 1 And WindowState = 1 Then WindowState = 0
End If
End Sub
Private Sub NextMenu_Click()
CurrentMsg = CurrentMsg + 1
StatusBar1.Panels(1).Text = "Current message: " & CurrentMsg
PreviousMenu.Enabled = True
Toolbar1.Buttons(3).Enabled = True
If CurrentMsg >= MailBox.Count Then
NextMenu.Enabled = False
Toolbar1.Buttons(4).Enabled = False
End If
EnableWindow StaticControl, MailBox.MessageState(CurrentMsg)
Text1.Text = MailBox.MessageText(CurrentMsg)
SetCaption StaticControl, "Message from " + MailBox.MessageSender(CurrentMsg) + " to " + MailBox.MessageRecipient(CurrentMsg) + _
vbCrLf + "on " + MailBox.MessageTimeDate(CurrentMsg)
End Sub
Private Sub OptionsMenu_Click()
AlwaysOnTop OptionsForm, CBool(Optn_AlwaysOnTop)
OptionsForm.Show 1
End Sub
Private Sub PreviousMenu_Click()
CurrentMsg = CurrentMsg - 1
StatusBar1.Panels(1).Text = "Current message: " & CurrentMsg
NextMenu.Enabled = True
Toolbar1.Buttons(4).Enabled = True
If CurrentMsg <= 1 Then
PreviousMenu.Enabled = False
Toolbar1.Buttons(3).Enabled = False
End If
EnableWindow StaticControl, MailBox.MessageState(CurrentMsg)
Text1.Text = MailBox.MessageText(CurrentMsg)
SetCaption StaticControl, "Message from " + MailBox.MessageSender(CurrentMsg) + " to " + MailBox.MessageRecipient(CurrentMsg) + _
vbCrLf + "on " + MailBox.MessageTimeDate(CurrentMsg)
End Sub
Private Sub SendMenu_Click()
If MailBox.Count > 0 Then
SendForm.Text1.Text = MailBox.MessageSender(CurrentMsg)
SendForm.Text1.SelStart = 0
SendForm.Text1.SelLength = Len(SendForm.Text1.Text)
End If
AlwaysOnTop SendForm, CBool(Optn_AlwaysOnTop)
SendForm.Show 1
End Sub
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Index
Case 1
SendMenu_Click
Case 2
DiscardMenu_Click
Case 3
PreviousMenu_Click
Case 4
NextMenu_Click
End Select
End Sub