Find all our projects in development below.
All source code is GNU General Public License (GPL)
Browsing vb/MainForm.frm (12.93 KB)
VERSION 5.00
Begin VB.Form MainForm
BorderStyle = 1 'Fixed Single
Caption = "MSN Messenger Popup Effects"
ClientHeight = 3495
ClientLeft = 45
ClientTop = 435
ClientWidth = 4935
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "MainForm.frx":0000
MaxButton = 0 'False
ScaleHeight = 3495
ScaleWidth = 4935
StartUpPosition = 2 'CenterScreen
Begin VB.Timer PostLoadTimer
Enabled = 0 'False
Interval = 1
Left = 1080
Top = 2520
End
Begin VB.CommandButton Command4
Caption = "A&bout"
Height = 375
Left = 2520
TabIndex = 7
Top = 3000
Width = 1095
End
Begin VB.CommandButton Command3
Caption = "&Hide"
Height = 375
Left = 1320
TabIndex = 6
Top = 3000
Width = 1095
End
Begin VB.Timer SetHookTimer
Enabled = 0 'False
Interval = 5000
Left = 600
Top = 2520
End
Begin VB.Timer PostCreateTimer
Enabled = 0 'False
Interval = 1
Left = 120
Top = 2520
End
Begin VB.CommandButton Command2
Caption = "Close"
Height = 375
Left = 3720
TabIndex = 8
Top = 3000
Width = 1095
End
Begin VB.CommandButton Command1
Caption = "&Activate"
Default = -1 'True
Height = 375
Left = 120
TabIndex = 5
Top = 3000
Width = 1095
End
Begin VB.OptionButton optnPopup
Caption = "&Default"
Height = 255
Index = 0
Left = 1080
TabIndex = 0
Top = 480
Value = -1 'True
Width = 3135
End
Begin VB.OptionButton optnPopup
Caption = "&Show popups with a translucency level of:"
Height = 255
Index = 2
Left = 1080
TabIndex = 2
Top = 1200
Width = 3375
End
Begin VB.OptionButton optnPopup
Caption = "D&o not show popups"
Height = 255
Index = 1
Left = 1080
TabIndex = 1
Top = 840
Width = 3135
End
Begin VB.Frame PopupStyleFrame
Caption = "Popup Effect"
Height = 2655
Left = 120
TabIndex = 9
Top = 120
Width = 4695
Begin VB.CheckBox chkMSNWindow
Caption = "Show MSN &window with translucency"
Enabled = 0 'False
Height = 255
Left = 1200
TabIndex = 4
Top = 2160
Width = 3015
End
Begin VB.PictureBox pbAVI
BorderStyle = 0 'None
Height = 375
Left = 240
ScaleHeight = 375
ScaleWidth = 495
TabIndex = 12
TabStop = 0 'False
Top = 360
Width = 495
End
Begin VB.HScrollBar hscrValue
Enabled = 0 'False
Height = 255
LargeChange = 10
Left = 1200
Max = 255
TabIndex = 3
TabStop = 0 'False
Top = 1440
Width = 3015
End
Begin VB.Label lblValue
AutoSize = -1 'True
Caption = "Value: 0%"
Enabled = 0 'False
Height = 195
Left = 1200
TabIndex = 11
Top = 1800
Width = 750
End
Begin VB.Label lblTotal
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "100%"
Enabled = 0 'False
Height = 195
Left = 3780
TabIndex = 10
Top = 1800
Width = 435
End
End
Begin VB.Menu SysTrayMenu
Caption = "SysTrayMenu"
Visible = 0 'False
Begin VB.Menu OpenMenu
Caption = "&Show"
End
Begin VB.Menu ActivateMenu
Caption = "&Activate"
End
Begin VB.Menu Blank1
Caption = "-"
End
Begin VB.Menu StartupMenu
Caption = "&Run on Startup"
End
Begin VB.Menu Blank2
Caption = "-"
End
Begin VB.Menu ExitMenu
Caption = "E&xit"
End
End
End
Attribute VB_Name = "MainForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim AnimateWnd As Long
Dim Ver As String
Private Const WM_MOUSEMOVE = &H200
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202
Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_RBUTTONDOWN = &H204
Private Const WM_RBUTTONUP = &H205
Private Const WM_RBUTTONDBLCLK = &H206
Private Const WM_MBUTTONDOWN = &H207
Private Const WM_MBUTTONUP = &H208
Private Const WM_MBUTTONDBLCLK = &H209
Private SysTray As New SystrayIcon
Private pSysTrayIcon1 As StdPicture
Private pSysTrayIcon2 As StdPicture
Private Const RegAppRoot = "Software\MSNMsgs Popups\"
Private Sub ActivateMenu_Click()
Command1_Click
End Sub
Private Sub Command1_Click()
If Command1.Caption = "&Activate" Then
If SetHook(hWnd) = False Then
MsgBox "Unable to establish the system hook.", vbCritical
Exit Sub
End If
SysTray.IconHandle = pSysTrayIcon1
SysTray.TipText = Caption + " " + Ver + " - Active"
Command1.Caption = "De&activate"
Command1.Cancel = True
SetHookTimer.Enabled = True
Else
SysTray.IconHandle = pSysTrayIcon2
SysTray.TipText = Caption + " " + Ver + " - Inactive"
Command1.Caption = "&Activate"
Command1.Cancel = False
RemoveHook
SetHookTimer.Enabled = False
End If
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Command3_Click()
StopVideo AnimateWnd
Visible = False
End Sub
Private Sub Command4_Click()
MsgBox " " + Caption + " " + Ver + vbCrLf & vbCrLf & _
"For use with MSN Messenger 4.5 and up" & vbCrLf & vbCrLf & _
" Created by Jason Java" & vbCrLf & _
"Contact me at jasonspc69@hotmail.com" & vbCrLf & vbCrLf & _
" � 1999 - 2002 Jason's PC Software", vbOKOnly, "About"
End Sub
Private Sub ExitMenu_Click()
Unload Me
End Sub
Private Sub Form_Initialize()
InitCommonCtrls
End Sub
Private Sub Form_Load()
Dim bRegErr As Boolean
Dim lRegData As Long
AnimateWnd = CreateAnimateWindow(2, 2, 16, 16, pbAVI.hWnd)
If AnimateWnd Then
If OpenVideoFile(AnimateWnd, , 200) Then PlayVideo AnimateWnd
End If
SubClass hWnd
lRegData = GetRegDWORD(HKEY_LOCAL_MACHINE, RegAppRoot, "Popup Effect", bRegErr)
If (lRegData < 0 Or lRegData > 2) Or bRegErr Then lRegData = 2
optnPopup(lRegData).Value = True
lRegData = GetRegDWORD(HKEY_LOCAL_MACHINE, RegAppRoot, "Translucency Level", bRegErr)
If (lRegData < 0 Or lRegData > 255) Or bRegErr Then lRegData = 0
hscrValue.Value = lRegData
lRegData = GetRegDWORD(HKEY_LOCAL_MACHINE, RegAppRoot, "MSN Window Translucent", bRegErr)
If (lRegData <> 0 And lRegData <> 1) Or bRegErr Then lRegData = 0
chkMSNWindow.Value = lRegData
If GetRegString(HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Run\", "MSN Popup Effects") <> "" Then StartupMenu.Checked = True
Ver = App.Major & "." & App.Minor & IIf(App.Revision = 0, "", "." & App.Revision)
SysTray.PopUpMessage = Caption + " " + Ver + " - Inactive"
Set pSysTrayIcon1 = LoadResPicture(100, 1)
Set pSysTrayIcon2 = LoadResPicture(101, 1)
SysTray.Initialize hWnd, pSysTrayIcon2, SysTray.PopUpMessage
SysTray.ShowIcon
If Trim(Command) = "-startup" Then PostLoadTimer.Enabled = True
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim msgCallBackMessage As Long
msgCallBackMessage = X / Screen.TwipsPerPixelX
Select Case msgCallBackMessage
Case WM_LBUTTONDBLCLK
Visible = True
PlayVideo AnimateWnd
Case WM_RBUTTONDOWN
If Visible Then
OpenMenu.Caption = "&Hide"
Else
OpenMenu.Caption = "&Show"
End If
ActivateMenu.Caption = Command1.Caption
PopupMenu SysTrayMenu, , , , OpenMenu
End Select
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If UnloadMode = 0 Or UnloadMode = 3 Then
StopVideo AnimateWnd
Visible = False
Cancel = True
Exit Sub
ElseIf UnloadMode = 1 Then
If Command1.Caption <> "&Activate" Then
MsgBox "Cannot exit program until the hook is deactivated.", vbExclamation
Cancel = True
Exit Sub
End If
End If
Dim i As Integer
For i = optnPopup.LBound To optnPopup.UBound
If optnPopup(i).Value = True Then
SaveRegDWORD HKEY_LOCAL_MACHINE, RegAppRoot, "Popup Effect", CLng(i)
Exit For
End If
Next i
SaveRegDWORD HKEY_LOCAL_MACHINE, RegAppRoot, "Translucency Level", CLng(hscrValue.Value)
SaveRegDWORD HKEY_LOCAL_MACHINE, RegAppRoot, "MSN Window Translucent", CLng(chkMSNWindow.Value)
SysTray.HideIcon
Set pSysTrayIcon1 = Nothing
Set pSysTrayIcon2 = Nothing
Set SysTray = Nothing
StopVideo AnimateWnd
DestroyAnimateWindow AnimateWnd
UnSubClass hWnd
End Sub
Private Sub Form_Unload(Cancel As Integer)
End
End Sub
Private Sub hscrValue_Change()
lblValue.Caption = "Value: " & Int((hscrValue.Value / hscrValue.Max) * 100) & "%"
End Sub
Private Sub hscrValue_Scroll()
hscrValue_Change
End Sub
Private Sub OpenMenu_Click()
Visible = Not Visible
If Visible Then
PlayVideo AnimateWnd
Else
StopVideo AnimateWnd
End If
End Sub
Private Sub optnPopup_Click(Index As Integer)
If Index = 2 Then
hscrValue.Enabled = True
lblValue.Enabled = True
lblTotal.Enabled = True
chkMSNWindow.Enabled = True
Else
hscrValue.Enabled = False
lblValue.Enabled = False
lblTotal.Enabled = False
chkMSNWindow.Enabled = False
End If
End Sub
Private Sub PostCreateTimer_Timer()
PostCreateTimer.Enabled = False
If NewWnd <> 0 Then
Dim sClassName As String
sClassName = GetWndClassName(NewWnd)
If sClassName = "MSBLPopupMsgWClass" Then
If optnPopup(1).Value = True Then
ClosePopup NewWnd
ElseIf optnPopup(2).Value = True Then
SetWindowTranslucency NewWnd, 255 - hscrValue.Value
End If
ElseIf sClassName = "msmsgs CHttpIE" And optnPopup(2).Value = True And _
chkMSNWindow.Value = 1 Then
SetWindowTranslucency NewWnd, 255 - hscrValue.Value
End If
NewWnd = 0
End If
End Sub
Private Sub PostLoadTimer_Timer()
PostLoadTimer.Enabled = False
StopVideo AnimateWnd
Visible = False
Command1_Click
End Sub
Private Sub SetHookTimer_Timer()
RemoveHook
SetHook hWnd
End Sub
Private Sub StartupMenu_Click()
StartupMenu.Checked = Not StartupMenu.Checked
If StartupMenu.Checked Then
SaveRegString HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Run\", "MSN Popup Effects", """" + LCase(App.Path + IIf(Right(App.Path, 1) <> "\", "\", "")) + App.EXEName + ".exe"" -startup"
Else
DeleteValue HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Run\", "MSN Popup Effects"
End If
End Sub