Dxt-Cobra
11-13-2007, 07:25 PM
heres alot of modules and functions that i dont use anymore use em if ya want.
app. checks for spy like ollydbg
'Checks for Spy:
'EX: Put this code in the FORM_LOAD or in a Timer With interval = 1
'Call SpyCheck("Your Message if a Spy is Found")
Public Sub SpyCheck(MessageToDisplay As String)
Dim Spy1 As Long
Dim Spy2 As Long
Dim Spy3 As Long
Spy1 = FindWindow(vbNullString, "TRNSNP")
Spy2 = FindWindow(vbNullString, "TrainerSpy XP + NT / 2000 / XP + Coded By BofeN") 'Trainer Spy
Spy3 = FindWindow(vbNullString, "OllyDbg")
If Spy1 <> 0 Then
MsgBox MessageToDisplay, vbCritical, "Error 24"
End
End If
If Spy2 <> 0 Then
MsgBox MessageToDisplay, vbCritical, "Error 24"
End
End If
If Spy3 <> 0 Then
MsgBox MessageToDisplay, vbCritical, "Error 24"
End
End If
If (FindDebugger) Then
MsgBox MessageToDisplay, vbCritical, "Error 15"
End
End If
End Sub
heres some windows functions
Attribute VB_Name = "Module1"
Option Explicit
Public Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
'
Public Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
''
Public Const VK_NUMLOCK = &H90
Public Const VK_SCROLL = &H91
Public Const VK_CAPITAL = &H14
'
Public Const KEYEVENTF_EXTENDEDKEY = &H1
Public Const KEYEVENTF_KEYUP = &H2
'
Public Declare Function SwapMouseButton Lib "user32" (ByVal bSwap As Long) As Long
'
Public Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long
heres how to do systray icon
'Add the following line to the top of your main form...
Public MyTrayIcon As New <NAME OF ADDED CLASS MODULE (see below)>
'"MyTrayIcon" is the name of the actual trayicon, this icon would
'be classed as an object. The following functions are the events
'of this object.
'To use the tray icon you must add a "Class Module"
'to your project and place the following code into it
Option Explicit
Private Type NOTIFYICONDATA
cbSize As Long
hwnd As Long
uId As Long
uFlags As Long
ucallbackMessage As Long
hIcon As Long
szTip As String * 64
End Type
Private FormHandle As Long
Private mvarbRunningInTray As Boolean
Private SysIcon As NOTIFYICONDATA
Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
Private Property Let bRunningInTray(ByVal vData As Boolean)
mvarbRunningInTray = vData
End Property
Property Get bRunningInTray() As Boolean
bRunningInTray = mvarbRunningInTray
End Property
Public Sub ShowIcon(ByRef sysTrayForm As Form)
SysIcon.cbSize = Len(SysIcon)
SysIcon.hwnd = sysTrayForm.hwnd
SysIcon.uId = vbNull
SysIcon.uFlags = 7
SysIcon.ucallbackMessage = 512
SysIcon.hIcon = sysTrayForm.Icon
SysIcon.szTip = sysTrayForm.Caption + Chr(0)
Shell_NotifyIcon 0, SysIcon
mvarbRunningInTray = True
End Sub
Public Sub RemoveIcon(sysTrayForm As Form)
SysIcon.cbSize = Len(SysIcon)
SysIcon.hwnd = sysTrayForm.hwnd
SysIcon.uId = vbNull
SysIcon.uFlags = 7
SysIcon.ucallbackMessage = vbNull
SysIcon.hIcon = sysTrayForm.Icon
SysIcon.szTip = Chr(0)
Shell_NotifyIcon 2, SysIcon
If sysTrayForm.Visible = False Then sysTrayForm.Show 'Incase user can't see form
mvarbRunningInTray = False
End Sub
Public Sub ChangeIcon(sysTrayForm As Form, picNewIcon As PictureBox)
If mvarbRunningInTray = True Then 'If running in the tray
SysIcon.cbSize = Len(SysIcon)
SysIcon.hwnd = sysTrayForm.hwnd
'SysIcon.uId = vbNull
'SysIcon.uFlags = 7
'SysIcon.ucallbackMessage = 512
SysIcon.hIcon = picNewIcon.Picture
'SysIcon.szTip = sysTrayForm.Caption + Chr(0)
Shell_NotifyIcon 1, SysIcon
End If
End Sub
Public Sub ChangeToolTip(sysTrayForm As Form, strNewTip As String)
If mvarbRunningInTray = True Then 'If running in the tray
SysIcon.cbSize = Len(SysIcon)
SysIcon.hwnd = sysTrayForm.hwnd
SysIcon.szTip = strNewTip & Chr(0)
Shell_NotifyIcon 1, SysIcon
End If
End Sub
heres how to do s.s.
Declare Function BitBlt Lib "gdi32" _
(ByVal hDestDC As Integer, ByVal x As Integer, _
ByVal y As Integer, ByVal nWidth As Integer, _
ByVal nHeight As Integer, ByVal _
hSrcDC As Integer, ByVal xSrc As Integer, _
ByVal ySrc As Integer, ByVal dwRop As _
Long) As Integer
Declare Function GetDesktopWindow Lib "user32" () As Long
Declare Function GetDC Lib "user32" _
(ByVal hwnd As Long) As Long
Public Const SRCCOPY = &HCC0020
Public Const SRCAND = &H8800C6
Public Const SRCINVERT = &H660046
Set the Form properties To the following:
AutoRedraw True
BorderStyle 0 - None
WindowState 2 - Maximized
DeskhWnd& = GetDesktopWindow()
DeskDC& = GetDC(DeskhWnd&)
BitBlt Form1.hDC, 0&, 0&, _
Screen.Width, Screen.Height, DeskDC&, _
0&, 0&, SRCCOPY
play sound
Public Declare Function sndPlaySound Lib "winmm" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
Public Sub PlaySound(strFileName As String)
sndPlaySound strFileName, 1
End Sub
here shutdown windows
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long
Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Private Const EWX_SHUTDOWN = 1
Dim ret As Integer
Dim pOld As Boolean
Dim i
Private sub Shutdown()
ret = SystemParametersInfo(97, False, pOld, 0)
'SetWindowPos(Form1.hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE)
End Sub
heres set window on top
Private Declare Function SetWindowPos& Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long)
'this code makes the window stay on top:
'rtn = SetWindowPos(<form name>.hwnd, -1, 0, 0, 0, 0, 3)
'window will not stay on top with this code:
'rtn = SetWindowPos(<form name>.hwnd, -2, 0, 0, 0, 0, 3)
private sub check1_click ()
if check1.value = 1 then rtn = SetWindowPos(<form name>.hwnd, -1, 0, 0, 0, 0, 3) else rtn = SetWindowPos(<form name>.hwnd, -2, 0, 0, 0, 0, 3)
end sub
heres a gradient bar////fading color
Option Explicit
DefInt A-Z
Global Const WM_USER = &H400
Public Const WM_NULL = &H0
Public Const WM_CREATE = &H1
Public Const WM_DESTROY = &H2
Public Const WM_MOVE = &H3
Public Const WM_SIZE = &H5
Public Const WM_ACTIVATE = &H6
Public Const WA_INACTIVE = 0
Public Const WA_ACTIVE = 1
Public Const WA_CLICKACTIVE = 2
Public Const WM_SETFOCUS = &H7
Public Const WM_KILLFOCUS = &H8
Public Const WM_ENABLE = &HA
Public Const WM_SETREDRAW = &HB
Public Const WM_SETTEXT = &HC
Public Const WM_GETTEXT = &HD
Public Const WM_GETTEXTLENGTH = &HE
Public Const WM_PAINT = &HF
Public Const WM_CLOSE = &H10
Public Const WM_QUERYENDSESSION = &H11
Public Const WM_QUIT = &H12
Public Const WM_QUERYOPEN = &H13
Public Const WM_ERASEBKGND = &H14
Public Const WM_SYSCOLORCHANGE = &H15
Public Const WM_ENDSESSION = &H16
Public Const WM_SHOWWINDOW = &H18
Public Const WM_WININICHANGE = &H1A
Public Const WM_DEVMODECHANGE = &H1B
Public Const WM_ACTIVATEAPP = &H1C
Public Const WM_FONTCHANGE = &H1D
Public Const WM_TIMECHANGE = &H1E
Public Const WM_CANCELMODE = &H1F
Public Const WM_SETCURSOR = &H20
Public Const WM_MOUSEACTIVATE = &H21
Public Const WM_CHILDACTIVATE = &H22
Public Const WM_QUEUESYNC = &H23
Public Const WM_GETMINMAXINFO = &H24
Public Const WM_PAINTICON = &H26
Public Const WM_ICONERASEBKGND = &H27
Public Const WM_NEXTDLGCTL = &H28
Public Const WM_SPOOLERSTATUS = &H2A
Public Const WM_DRAWITEM = &H2B
Public Const WM_MEASUREITEM = &H2C
Public Const WM_DELETEITEM = &H2D
Public Const WM_VKEYTOITEM = &H2E
Public Const WM_CHARTOITEM = &H2F
Public Const WM_SETFONT = &H30
Public Const WM_GETFONT = &H31
Public Const WM_SETHOTKEY = &H32
Public Const WM_GETHOTKEY = &H33
Public Const WM_QUERYDRAGICON = &H37
Public Const WM_COMPAREITEM = &H39
Public Const WM_COMPACTING = &H41
Public Const WM_OTHERWINDOWCREATED = &H42
Public Const WM_OTHERWINDOWDESTROYED = &H43
Public Const WM_COMMNOTIFY = &H44
Public Const CN_RECEIVE = &H1
Public Const CN_TRANSMIT = &H2
Public Const CN_EVENT = &H4
Public Const WM_WINDOWPOSCHANGING = &H46
Public Const WM_WINDOWPOSCHANGED = &H47
Public Const WM_POWER = &H48
Public Const PWR_OK = 1
Public Const PWR_FAIL = (-1)
Public Const PWR_SUSPENDREQUEST = 1
Public Const PWR_SUSPENDRESUME = 2
Public Const PWR_CRITICALRESUME = 3
Public Const WM_COPYDATA = &H4A
Public Const WM_CANCELJOURNAL = &H4B
Public Const WM_NCCREATE = &H81
Public Const WM_NCDESTROY = &H82
Public Const WM_NCCALCSIZE = &H83
Public Const WM_NCHITTEST = &H84
Public Const WM_NCPAINT = &H85
Public Const WM_NCACTIVATE = &H86
Public Const WM_GETDLGCODE = &H87
Public Const WM_NCMOUSEMOVE = &HA0
Public Const WM_NCLBUTTONDOWN = &HA1
Public Const WM_NCLBUTTONUP = &HA2
Public Const WM_NCLBUTTONDBLCLK = &HA3
Public Const WM_NCRBUTTONDOWN = &HA4
Public Const WM_NCRBUTTONUP = &HA5
Public Const WM_NCRBUTTONDBLCLK = &HA6
Public Const WM_NCMBUTTONDOWN = &HA7
Public Const WM_NCMBUTTONUP = &HA8
Public Const WM_NCMBUTTONDBLCLK = &HA9
Public Const WM_KEYFIRST = &H100
Public Const WM_KEYDOWN = &H100
Public Const WM_KEYUP = &H101
Public Const WM_CHAR = &H102
Public Const WM_DEADCHAR = &H103
Public Const WM_SYSKEYDOWN = &H104
Public Const WM_SYSKEYUP = &H105
Public Const WM_SYSCHAR = &H106
Public Const WM_SYSDEADCHAR = &H107
Public Const WM_KEYLAST = &H108
Public Const WM_INITDIALOG = &H110
Public Const WM_COMMAND = &H111
Public Const WM_SYSCOMMAND = &H112
Public Const WM_TIMER = &H113
Public Const WM_HSCROLL = &H114
Public Const WM_VSCROLL = &H115
Public Const WM_INITMENU = &H116
Public Const WM_INITMENUPOPUP = &H117
Public Const WM_MENUSELECT = &H11F
Public Const WM_MENUCHAR = &H120
Public Const WM_ENTERIDLE = &H121
Public Const WM_CTLCOLORMSGBOX = &H132
Public Const WM_CTLCOLOREDIT = &H133
Public Const WM_CTLCOLORLISTBOX = &H134
Public Const WM_CTLCOLORBTN = &H135
Public Const WM_CTLCOLORDLG = &H136
Public Const WM_CTLCOLORSCROLLBAR = &H137
Public Const WM_CTLCOLORSTATIC = &H138
Public Const WM_MOUSEFIRST =
Private Sub Form_Load()
GradientForm Me
End Sub
Heres flashing form
' Place in a module
Private Declare Function FlashWindow Lib "user32" Alias "FlashWindow" (ByVal hwnd As Long, ByVal bInvert As Long) As Long
' Place in your work
Private Sub Form_Load()
Timer1.Interval = 300 'Change value depending On the speed of flahing.
End Sub
Private Sub Timer1_Timer()
FlashWindow hwnd, 1
End Sub
add bmps to menus
Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Declare Function GetMenuItemID Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Declare Function SetMenuItemBitmaps Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal hBitmapUnchecked As Long, ByVal hBitmapChecked As Long) As Long
Public Const MF_BITMAP = &H4&
Type MENUITEMINFO
cbSize As Long
fMask As Long
fType As Long
fState As Long
wID As Long
hSubMenu As Long
hbmpChecked As Long
hbmpUnchecked As Long
dwItemData As Long
dwTypeData As String
cch As Long
End Type
Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long
Declare Function GetMenuItemInfo Lib "user32" Alias "GetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, ByVal b As Boolean, lpMenuItemInfo As MENUITEMINFO) As Boolean
Public Const MIIM_ID = &H2
Public Const MIIM_TYPE = &H10
Public Const MFT_STRING = &H0&
File
...New
A command Button
and a picturebox With your bitmap, absolutly cannot be an icon
Set the picturebox autosize Property to True
'
'Side Effects:None
'
'Warranty:
'code provided by Planet Source Code(tm)
' (http://www.Planet-Source-Code.com) 'as
' is', without warranties as to performanc
' e, fitness, merchantability,and any othe
' r warranty (whether expressed or implied
' ).
'Terms of Agreement:
'By using this source code, you agree to
' the following terms...
' 1) You may use this source code in per
' sonal projects and may compile it into a
' n .exe/.dll/.ocx and distribute it in bi
' nary format freely and with no charge.
' 2) You MAY NOT redistribute this sourc
' e code (for example to a web site) witho
' ut written permission from the original
' author.Failure to do so is a violation o
' f copyright laws.
' 3) You may link to this code from anot
' her website, provided it is not wrapped
' in a frame.
' 4) The author of this code may have re
' tained certain additional copyright righ
' ts.If so, this is indicated in the autho
' r's description.
'**************************************
Private Sub Command1_Click()
'Get the menuhandle of your app
hMenu& = GetMenu(Form1.hwnd)
'Get the handle of the first submenu (He
' llo)
hSubMenu& = GetSubMenu(hMenu&, 0)
'Get the menuId of the first entry (Bitm
' ap)
hID& = GetMenuItemID(hSubMenu&, 0)
'Add the bitmap
SetMenuItemBitmaps hMenu&, hID&, MF_BITMAP, _
Picture1.Picture, _
Picture1.Picture
'You can add two bitmaps to a menuentry
'One for the checked and one for the unc
' hecked
'state.
End Sub
'This can also be done in the formload e
' vent.
'I just used a command button to show ho
' w it
'looks without and with the picture.
heres form fade
Private Sub Form_Click()
Timer1.Interval = 0
Timer2.Interval = 0
Timer3.Interval = 0
frmColor.BackColor = &H8000000F
End Sub
Private Sub Form_Load()
scrColor(2).Value = Int(Rnd)
Me.WindowState = 2
scrColor(0).Value = 0
scrColor(1).Value = 255
End Sub
Private Sub scrColor_Change(Index As Integer)
With Me
.BackColor = RGB(scrColor(0), scrColor(1), scrColor(2))
End With
End Sub
Private Sub Timer1_Timer()
If Timer1.Interval = 1 Then 'this code here increases and
scrColor(0).Value = scrColor(0).Value + 5 'decreases the value of the scroll
End If'bars
If scrColor(0).Value = 255 Then
Timer1.Interval = 2
End If
If Timer1.Interval = 2 Then
scrColor(0).Value = scrColor(0).Value - 5
End If
If scrColor(0).Value = 0 Then
Timer1.Interval = 1
End If
End Sub
Private Sub Timer2_Timer()
If Timer2.Interval = 1 Then
scrColor(1).Value = scrColor(1).Value + 5
End If
If scrColor(1).Value = 255 Then
Timer2.Interval = 2
End If
If Timer2.Interval = 2 Then
scrColor(1).Value = scrColor(1).Value - 5
End If
If scrColor(1).Value = 0 Then
Timer2.Interval = 1
End If
End Sub
Private Sub Timer3_Timer()
If Timer3.Interval = 1 Then
scrColor(2).Value = scrColor(2).Value + 5
End If
If scrColor(2).Value = 255 Then
Timer3.Interval = 2
End If
If Timer3.Interval = 2 Then
scrColor(2).Value = scrColor(2).Value - 5
End If
If scrColor(2).Value = 0 Then
Timer3.Interval = 1
End If
End Sub
remove your app from windows task manager
Public Declare Function SetWindowPos& Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long)
Public Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Public Declare Function RegisterServiceProcess Lib "kernel32" (ByVal dwProcessID As Long, ByVal dwType As Long) As Long
Public Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long
Public Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
SetWindowPos Form1.hwnd, -1, 0, 0, 0, 0, 3 'if -1 then sets window always ontop, if -2 then set windows to normal
RegisterServiceProcess GetCurrentProcessId, 1 'if 1 then removes from ctrl-alt-del menu, if False then it shows in...
SystemParametersInfo 97, True, False, 0 'if True then disable ctrl-alt-del menu, if False then Enable...
ExitWindowsEx 1, 0 'Shuts down your computer (1 = Shutdown, 2 = Reboot)
app. checks for spy like ollydbg
'Checks for Spy:
'EX: Put this code in the FORM_LOAD or in a Timer With interval = 1
'Call SpyCheck("Your Message if a Spy is Found")
Public Sub SpyCheck(MessageToDisplay As String)
Dim Spy1 As Long
Dim Spy2 As Long
Dim Spy3 As Long
Spy1 = FindWindow(vbNullString, "TRNSNP")
Spy2 = FindWindow(vbNullString, "TrainerSpy XP + NT / 2000 / XP + Coded By BofeN") 'Trainer Spy
Spy3 = FindWindow(vbNullString, "OllyDbg")
If Spy1 <> 0 Then
MsgBox MessageToDisplay, vbCritical, "Error 24"
End
End If
If Spy2 <> 0 Then
MsgBox MessageToDisplay, vbCritical, "Error 24"
End
End If
If Spy3 <> 0 Then
MsgBox MessageToDisplay, vbCritical, "Error 24"
End
End If
If (FindDebugger) Then
MsgBox MessageToDisplay, vbCritical, "Error 15"
End
End If
End Sub
heres some windows functions
Attribute VB_Name = "Module1"
Option Explicit
Public Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
'
Public Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
''
Public Const VK_NUMLOCK = &H90
Public Const VK_SCROLL = &H91
Public Const VK_CAPITAL = &H14
'
Public Const KEYEVENTF_EXTENDEDKEY = &H1
Public Const KEYEVENTF_KEYUP = &H2
'
Public Declare Function SwapMouseButton Lib "user32" (ByVal bSwap As Long) As Long
'
Public Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long
heres how to do systray icon
'Add the following line to the top of your main form...
Public MyTrayIcon As New <NAME OF ADDED CLASS MODULE (see below)>
'"MyTrayIcon" is the name of the actual trayicon, this icon would
'be classed as an object. The following functions are the events
'of this object.
'To use the tray icon you must add a "Class Module"
'to your project and place the following code into it
Option Explicit
Private Type NOTIFYICONDATA
cbSize As Long
hwnd As Long
uId As Long
uFlags As Long
ucallbackMessage As Long
hIcon As Long
szTip As String * 64
End Type
Private FormHandle As Long
Private mvarbRunningInTray As Boolean
Private SysIcon As NOTIFYICONDATA
Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
Private Property Let bRunningInTray(ByVal vData As Boolean)
mvarbRunningInTray = vData
End Property
Property Get bRunningInTray() As Boolean
bRunningInTray = mvarbRunningInTray
End Property
Public Sub ShowIcon(ByRef sysTrayForm As Form)
SysIcon.cbSize = Len(SysIcon)
SysIcon.hwnd = sysTrayForm.hwnd
SysIcon.uId = vbNull
SysIcon.uFlags = 7
SysIcon.ucallbackMessage = 512
SysIcon.hIcon = sysTrayForm.Icon
SysIcon.szTip = sysTrayForm.Caption + Chr(0)
Shell_NotifyIcon 0, SysIcon
mvarbRunningInTray = True
End Sub
Public Sub RemoveIcon(sysTrayForm As Form)
SysIcon.cbSize = Len(SysIcon)
SysIcon.hwnd = sysTrayForm.hwnd
SysIcon.uId = vbNull
SysIcon.uFlags = 7
SysIcon.ucallbackMessage = vbNull
SysIcon.hIcon = sysTrayForm.Icon
SysIcon.szTip = Chr(0)
Shell_NotifyIcon 2, SysIcon
If sysTrayForm.Visible = False Then sysTrayForm.Show 'Incase user can't see form
mvarbRunningInTray = False
End Sub
Public Sub ChangeIcon(sysTrayForm As Form, picNewIcon As PictureBox)
If mvarbRunningInTray = True Then 'If running in the tray
SysIcon.cbSize = Len(SysIcon)
SysIcon.hwnd = sysTrayForm.hwnd
'SysIcon.uId = vbNull
'SysIcon.uFlags = 7
'SysIcon.ucallbackMessage = 512
SysIcon.hIcon = picNewIcon.Picture
'SysIcon.szTip = sysTrayForm.Caption + Chr(0)
Shell_NotifyIcon 1, SysIcon
End If
End Sub
Public Sub ChangeToolTip(sysTrayForm As Form, strNewTip As String)
If mvarbRunningInTray = True Then 'If running in the tray
SysIcon.cbSize = Len(SysIcon)
SysIcon.hwnd = sysTrayForm.hwnd
SysIcon.szTip = strNewTip & Chr(0)
Shell_NotifyIcon 1, SysIcon
End If
End Sub
heres how to do s.s.
Declare Function BitBlt Lib "gdi32" _
(ByVal hDestDC As Integer, ByVal x As Integer, _
ByVal y As Integer, ByVal nWidth As Integer, _
ByVal nHeight As Integer, ByVal _
hSrcDC As Integer, ByVal xSrc As Integer, _
ByVal ySrc As Integer, ByVal dwRop As _
Long) As Integer
Declare Function GetDesktopWindow Lib "user32" () As Long
Declare Function GetDC Lib "user32" _
(ByVal hwnd As Long) As Long
Public Const SRCCOPY = &HCC0020
Public Const SRCAND = &H8800C6
Public Const SRCINVERT = &H660046
Set the Form properties To the following:
AutoRedraw True
BorderStyle 0 - None
WindowState 2 - Maximized
DeskhWnd& = GetDesktopWindow()
DeskDC& = GetDC(DeskhWnd&)
BitBlt Form1.hDC, 0&, 0&, _
Screen.Width, Screen.Height, DeskDC&, _
0&, 0&, SRCCOPY
play sound
Public Declare Function sndPlaySound Lib "winmm" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
Public Sub PlaySound(strFileName As String)
sndPlaySound strFileName, 1
End Sub
here shutdown windows
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long
Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Private Const EWX_SHUTDOWN = 1
Dim ret As Integer
Dim pOld As Boolean
Dim i
Private sub Shutdown()
ret = SystemParametersInfo(97, False, pOld, 0)
'SetWindowPos(Form1.hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE)
End Sub
heres set window on top
Private Declare Function SetWindowPos& Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long)
'this code makes the window stay on top:
'rtn = SetWindowPos(<form name>.hwnd, -1, 0, 0, 0, 0, 3)
'window will not stay on top with this code:
'rtn = SetWindowPos(<form name>.hwnd, -2, 0, 0, 0, 0, 3)
private sub check1_click ()
if check1.value = 1 then rtn = SetWindowPos(<form name>.hwnd, -1, 0, 0, 0, 0, 3) else rtn = SetWindowPos(<form name>.hwnd, -2, 0, 0, 0, 0, 3)
end sub
heres a gradient bar////fading color
Option Explicit
DefInt A-Z
Global Const WM_USER = &H400
Public Const WM_NULL = &H0
Public Const WM_CREATE = &H1
Public Const WM_DESTROY = &H2
Public Const WM_MOVE = &H3
Public Const WM_SIZE = &H5
Public Const WM_ACTIVATE = &H6
Public Const WA_INACTIVE = 0
Public Const WA_ACTIVE = 1
Public Const WA_CLICKACTIVE = 2
Public Const WM_SETFOCUS = &H7
Public Const WM_KILLFOCUS = &H8
Public Const WM_ENABLE = &HA
Public Const WM_SETREDRAW = &HB
Public Const WM_SETTEXT = &HC
Public Const WM_GETTEXT = &HD
Public Const WM_GETTEXTLENGTH = &HE
Public Const WM_PAINT = &HF
Public Const WM_CLOSE = &H10
Public Const WM_QUERYENDSESSION = &H11
Public Const WM_QUIT = &H12
Public Const WM_QUERYOPEN = &H13
Public Const WM_ERASEBKGND = &H14
Public Const WM_SYSCOLORCHANGE = &H15
Public Const WM_ENDSESSION = &H16
Public Const WM_SHOWWINDOW = &H18
Public Const WM_WININICHANGE = &H1A
Public Const WM_DEVMODECHANGE = &H1B
Public Const WM_ACTIVATEAPP = &H1C
Public Const WM_FONTCHANGE = &H1D
Public Const WM_TIMECHANGE = &H1E
Public Const WM_CANCELMODE = &H1F
Public Const WM_SETCURSOR = &H20
Public Const WM_MOUSEACTIVATE = &H21
Public Const WM_CHILDACTIVATE = &H22
Public Const WM_QUEUESYNC = &H23
Public Const WM_GETMINMAXINFO = &H24
Public Const WM_PAINTICON = &H26
Public Const WM_ICONERASEBKGND = &H27
Public Const WM_NEXTDLGCTL = &H28
Public Const WM_SPOOLERSTATUS = &H2A
Public Const WM_DRAWITEM = &H2B
Public Const WM_MEASUREITEM = &H2C
Public Const WM_DELETEITEM = &H2D
Public Const WM_VKEYTOITEM = &H2E
Public Const WM_CHARTOITEM = &H2F
Public Const WM_SETFONT = &H30
Public Const WM_GETFONT = &H31
Public Const WM_SETHOTKEY = &H32
Public Const WM_GETHOTKEY = &H33
Public Const WM_QUERYDRAGICON = &H37
Public Const WM_COMPAREITEM = &H39
Public Const WM_COMPACTING = &H41
Public Const WM_OTHERWINDOWCREATED = &H42
Public Const WM_OTHERWINDOWDESTROYED = &H43
Public Const WM_COMMNOTIFY = &H44
Public Const CN_RECEIVE = &H1
Public Const CN_TRANSMIT = &H2
Public Const CN_EVENT = &H4
Public Const WM_WINDOWPOSCHANGING = &H46
Public Const WM_WINDOWPOSCHANGED = &H47
Public Const WM_POWER = &H48
Public Const PWR_OK = 1
Public Const PWR_FAIL = (-1)
Public Const PWR_SUSPENDREQUEST = 1
Public Const PWR_SUSPENDRESUME = 2
Public Const PWR_CRITICALRESUME = 3
Public Const WM_COPYDATA = &H4A
Public Const WM_CANCELJOURNAL = &H4B
Public Const WM_NCCREATE = &H81
Public Const WM_NCDESTROY = &H82
Public Const WM_NCCALCSIZE = &H83
Public Const WM_NCHITTEST = &H84
Public Const WM_NCPAINT = &H85
Public Const WM_NCACTIVATE = &H86
Public Const WM_GETDLGCODE = &H87
Public Const WM_NCMOUSEMOVE = &HA0
Public Const WM_NCLBUTTONDOWN = &HA1
Public Const WM_NCLBUTTONUP = &HA2
Public Const WM_NCLBUTTONDBLCLK = &HA3
Public Const WM_NCRBUTTONDOWN = &HA4
Public Const WM_NCRBUTTONUP = &HA5
Public Const WM_NCRBUTTONDBLCLK = &HA6
Public Const WM_NCMBUTTONDOWN = &HA7
Public Const WM_NCMBUTTONUP = &HA8
Public Const WM_NCMBUTTONDBLCLK = &HA9
Public Const WM_KEYFIRST = &H100
Public Const WM_KEYDOWN = &H100
Public Const WM_KEYUP = &H101
Public Const WM_CHAR = &H102
Public Const WM_DEADCHAR = &H103
Public Const WM_SYSKEYDOWN = &H104
Public Const WM_SYSKEYUP = &H105
Public Const WM_SYSCHAR = &H106
Public Const WM_SYSDEADCHAR = &H107
Public Const WM_KEYLAST = &H108
Public Const WM_INITDIALOG = &H110
Public Const WM_COMMAND = &H111
Public Const WM_SYSCOMMAND = &H112
Public Const WM_TIMER = &H113
Public Const WM_HSCROLL = &H114
Public Const WM_VSCROLL = &H115
Public Const WM_INITMENU = &H116
Public Const WM_INITMENUPOPUP = &H117
Public Const WM_MENUSELECT = &H11F
Public Const WM_MENUCHAR = &H120
Public Const WM_ENTERIDLE = &H121
Public Const WM_CTLCOLORMSGBOX = &H132
Public Const WM_CTLCOLOREDIT = &H133
Public Const WM_CTLCOLORLISTBOX = &H134
Public Const WM_CTLCOLORBTN = &H135
Public Const WM_CTLCOLORDLG = &H136
Public Const WM_CTLCOLORSCROLLBAR = &H137
Public Const WM_CTLCOLORSTATIC = &H138
Public Const WM_MOUSEFIRST =
Private Sub Form_Load()
GradientForm Me
End Sub
Heres flashing form
' Place in a module
Private Declare Function FlashWindow Lib "user32" Alias "FlashWindow" (ByVal hwnd As Long, ByVal bInvert As Long) As Long
' Place in your work
Private Sub Form_Load()
Timer1.Interval = 300 'Change value depending On the speed of flahing.
End Sub
Private Sub Timer1_Timer()
FlashWindow hwnd, 1
End Sub
add bmps to menus
Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Declare Function GetMenuItemID Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Declare Function SetMenuItemBitmaps Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal hBitmapUnchecked As Long, ByVal hBitmapChecked As Long) As Long
Public Const MF_BITMAP = &H4&
Type MENUITEMINFO
cbSize As Long
fMask As Long
fType As Long
fState As Long
wID As Long
hSubMenu As Long
hbmpChecked As Long
hbmpUnchecked As Long
dwItemData As Long
dwTypeData As String
cch As Long
End Type
Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long
Declare Function GetMenuItemInfo Lib "user32" Alias "GetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, ByVal b As Boolean, lpMenuItemInfo As MENUITEMINFO) As Boolean
Public Const MIIM_ID = &H2
Public Const MIIM_TYPE = &H10
Public Const MFT_STRING = &H0&
File
...New
A command Button
and a picturebox With your bitmap, absolutly cannot be an icon
Set the picturebox autosize Property to True
'
'Side Effects:None
'
'Warranty:
'code provided by Planet Source Code(tm)
' (http://www.Planet-Source-Code.com) 'as
' is', without warranties as to performanc
' e, fitness, merchantability,and any othe
' r warranty (whether expressed or implied
' ).
'Terms of Agreement:
'By using this source code, you agree to
' the following terms...
' 1) You may use this source code in per
' sonal projects and may compile it into a
' n .exe/.dll/.ocx and distribute it in bi
' nary format freely and with no charge.
' 2) You MAY NOT redistribute this sourc
' e code (for example to a web site) witho
' ut written permission from the original
' author.Failure to do so is a violation o
' f copyright laws.
' 3) You may link to this code from anot
' her website, provided it is not wrapped
' in a frame.
' 4) The author of this code may have re
' tained certain additional copyright righ
' ts.If so, this is indicated in the autho
' r's description.
'**************************************
Private Sub Command1_Click()
'Get the menuhandle of your app
hMenu& = GetMenu(Form1.hwnd)
'Get the handle of the first submenu (He
' llo)
hSubMenu& = GetSubMenu(hMenu&, 0)
'Get the menuId of the first entry (Bitm
' ap)
hID& = GetMenuItemID(hSubMenu&, 0)
'Add the bitmap
SetMenuItemBitmaps hMenu&, hID&, MF_BITMAP, _
Picture1.Picture, _
Picture1.Picture
'You can add two bitmaps to a menuentry
'One for the checked and one for the unc
' hecked
'state.
End Sub
'This can also be done in the formload e
' vent.
'I just used a command button to show ho
' w it
'looks without and with the picture.
heres form fade
Private Sub Form_Click()
Timer1.Interval = 0
Timer2.Interval = 0
Timer3.Interval = 0
frmColor.BackColor = &H8000000F
End Sub
Private Sub Form_Load()
scrColor(2).Value = Int(Rnd)
Me.WindowState = 2
scrColor(0).Value = 0
scrColor(1).Value = 255
End Sub
Private Sub scrColor_Change(Index As Integer)
With Me
.BackColor = RGB(scrColor(0), scrColor(1), scrColor(2))
End With
End Sub
Private Sub Timer1_Timer()
If Timer1.Interval = 1 Then 'this code here increases and
scrColor(0).Value = scrColor(0).Value + 5 'decreases the value of the scroll
End If'bars
If scrColor(0).Value = 255 Then
Timer1.Interval = 2
End If
If Timer1.Interval = 2 Then
scrColor(0).Value = scrColor(0).Value - 5
End If
If scrColor(0).Value = 0 Then
Timer1.Interval = 1
End If
End Sub
Private Sub Timer2_Timer()
If Timer2.Interval = 1 Then
scrColor(1).Value = scrColor(1).Value + 5
End If
If scrColor(1).Value = 255 Then
Timer2.Interval = 2
End If
If Timer2.Interval = 2 Then
scrColor(1).Value = scrColor(1).Value - 5
End If
If scrColor(1).Value = 0 Then
Timer2.Interval = 1
End If
End Sub
Private Sub Timer3_Timer()
If Timer3.Interval = 1 Then
scrColor(2).Value = scrColor(2).Value + 5
End If
If scrColor(2).Value = 255 Then
Timer3.Interval = 2
End If
If Timer3.Interval = 2 Then
scrColor(2).Value = scrColor(2).Value - 5
End If
If scrColor(2).Value = 0 Then
Timer3.Interval = 1
End If
End Sub
remove your app from windows task manager
Public Declare Function SetWindowPos& Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long)
Public Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Public Declare Function RegisterServiceProcess Lib "kernel32" (ByVal dwProcessID As Long, ByVal dwType As Long) As Long
Public Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long
Public Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
SetWindowPos Form1.hwnd, -1, 0, 0, 0, 0, 3 'if -1 then sets window always ontop, if -2 then set windows to normal
RegisterServiceProcess GetCurrentProcessId, 1 'if 1 then removes from ctrl-alt-del menu, if False then it shows in...
SystemParametersInfo 97, True, False, 0 'if True then disable ctrl-alt-del menu, if False then Enable...
ExitWindowsEx 1, 0 'Shuts down your computer (1 = Shutdown, 2 = Reboot)