Visual Basic Code Snippets #10
In this next update I'll re-post my Visual Basic code snippets (which are older than five years by the way) that pertain to Window Actions and File Functions.
Minimize All Active Windows
Compatibility: Win. 98-XP
Add the following code into a module within your project...
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_LWIN = &H5B
Public Const KEYEVENTF_KEYUP = &H2
Add the following code into a command button or wherever you want the code to execute...
Call keybd_event(VK_LWIN, 0, 0, 0)
Call keybd_event(&H4D, 0, 0, 0)
Call keybd_event(VK_LWIN, 0, KEYEVENTF_KEYUP, 0)
Load a Text Box with Items from a Text File
Compatibility: Win. 98-XP
Add the following code into a module within your project...
Public Sub LoadText(Lst As TextBox, file As String)
'Call LoadText (Text1,"C:\Windows\System\Saved.txt")
On Error GoTo error
Dim mystr As String
Open file For Input As #1
Do While Not EOF(1)
Line Input #1, a$
texto$ = texto$ + a$ + Chr$(13) + Chr$(10)
Loop
Lst = texto$
Close #1
Exit Sub
error:
X = MsgBox("File Not Found", vbOKOnly, "Error")
End Sub
Add a TextBox named Text1 and make sure there is a text file named test.txt with "test" inside it inside the directory where you are working on your project and add the following code wherever you want the code to execute...
Call LoadText(Text1, "test.txt")
Save Data to a Text File
Compatibility: Win. 98-XP
Add the following code into a module within your project...
Public Sub SaveText(Lst As TextBox, file As String)
'Call SaveText (Text1,"C:\Windows\System\Saved.txt")
On Error GoTo error
Dim mystr As String
Open file For Output As #1
Print #1, Lst
Close 1
Exit Sub
error:
X = MsgBox("There has been an error!", vbOKOnly, "Error")
End Sub
Add a TextBox named Text1 and add the following code wherever you want the code to execute...
Call SaveText(Text1, "C:\Program Files\Program Name\test.txt")
Visual Basic Code Snippets #9
In this next update I'll continue to re-post my Visual Basic code snippets (which are older than five years by the way) that pertain to System Functions.
Toggle NumLock Key On/Off
Compatibility: Win. 98-XP
Add the following code into a module within your project...
Option Explicit
Public Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) 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 Declare Function GetKeyboardState Lib "user32" (pbKeyState As Byte) As Long
Public Declare Function SetKeyboardState Lib "user32" (lppbKeyState As Byte) As Long
Public Const VER_PLATFORM_WIN32_NT = 2
Public Const VER_PLATFORM_WIN32_WINDOWS = 1
Public Const VK_NUMLOCK = &H90
Public Const KEYEVENTF_EXTENDEDKEY = &H1
Public Const KEYEVENTF_KEYUP = &H2
Public Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
Public Sub ToggleNumLock(TurnOn As Boolean)
'To turn numlock on, set turnon to true
'To turn numlock off, set turnon to false
Dim bytKeys(255) As Byte
Dim bnumLockOn As Boolean
'Get status of the 256 virtual keys
GetKeyboardState bytKeys(0)
bnumLockOn = bytKeys(VK_NUMLOCK)
Dim typOS As OSVERSIONINFO
If bnumLockOn <> TurnOn Then
If typOS.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then
bytKeys(VK_NUMLOCK) = 1
SetKeyboardState bytKeys(0)
Else
'Simulate Key Press
keybd_event VK_NUMLOCK, &H45, KEYEVENTF_EXTENDEDKEY Or 0, 0
'Simulate Key Release
keybd_event VK_NUMLOCK, &H45, KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0
End If
End If
End Sub
Add the following code where you want the code to execute...
'To turn numlock on...
Call ToggleNumLock(True)
'To turn numlock off...
Call ToggleNumLock(False)
BEEP!
Compatibility: Win. 98-XP
Add the following code into a module within your project...
Public Declare Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
Add the following code where you want the code to execute...
Dim X%
X% = Beep(1500, 300)
Disable/Enable Task Manager
Compatibility: Win. 98-XP
Add the following code into a module within your project...
Public Declare Function SystemParametersInfo Lib "User32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByVal lpvParam As String, ByVal fuWinIni As Long) As Long
Add the following code where you want the code to execute...
'this will disable ctrl+alt+del
Call SystemParametersInfo(97, True, 0&, 0)
'this will enable ctrl+alt+del
Call SystemParametersInfo(97, False, 0&, 0)
Get the Windows User Name
Compatibility: Win. 98-XP
Add the following code into a module within your project...
Public Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Add the following code where you want the code to execute...
Dim X As String
X = String(50, Chr(0))
Call GetComputerName(X$, 50)
MsgBox "Your computer is named: " & X, 32, "Name"
Visual Basic Code Snippets #8
In this next update I'll continue to re-post my Visual Basic code snippets (which are older than five years by the way) that pertain to System Functions.
Ensure Application Can't Load Multiple Times
Compatibility: Win. 98-XP
This isn't a system function but is definitely essential to any application.
Add the following code to the Form_Load() event...
If App.PrevInstance Then
MsgBox ("The application is already open."), vbExclamation, "The requested " & "application is already open"
Unload Me
End If
Display Internet Properties Dialog
Compatibility: Win. 98-XP
Add the following code into a module within your project...
Public Function ShowInetProperties() As Boolean
Dim lRet As Long
lRet = Shell("rundll32.exe shell32.dll,Control_RunDLL inetcpl.cpl,,0", vbNormalFocus)
ShowInetProperties = lRet > 0
End Function
Add the following code where you want the code to execute...
Call ShowInetProperties()
Toggle CapsLock Key On/Off
Compatibility: Win. 98-XP
Add the following code into a module within your project...
Public Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) 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 Declare Function GetKeyboardState Lib "user32" (pbKeyState As Byte) As Long
Public Declare Function SetKeyboardState Lib "user32" (lppbKeyState As Byte) As Long
Public Const VER_PLATFORM_WIN32_NT = 2
Public Const VER_PLATFORM_WIN32_WINDOWS = 1
Public Const VK_CAPITAL = &H14
Public Const KEYEVENTF_EXTENDEDKEY = &H1
Public Const KEYEVENTF_KEYUP = &H2
Public Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
Public Sub ToggleCapsLock(TurnOn As Boolean)
'To turn capslock on, set turnon to true
'To turn capslock off, set turnon to false
Dim bytKeys(255) As Byte
Dim bCapsLockOn As Boolean
'Get status of the 256 virtual keys
GetKeyboardState bytKeys(0)
bCapsLockOn = bytKeys(VK_CAPITAL)
Dim typOS As OSVERSIONINFO
If bCapsLockOn <> TurnOn Then
If typOS.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then
bytKeys(VK_CAPITAL) = 1
SetKeyboardState bytKeys(0)
Else
'Simulate Key Press
keybd_event VK_CAPITAL, &H45, KEYEVENTF_EXTENDEDKEY Or 0, 0
'Simulate Key Release
keybd_event VK_CAPITAL, &H45, KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0
End If
End If
End Sub
Add the following code where you want the code to execute...
'To turn capslock on...
Call ToggleCapsLock(True)
'To turn capslock off...
Call ToggleCapsLock(False)
Visual Basic Code Snippets #7
In this next update I'll continue to re-post my Visual Basic code snippets (which are older than five years by the way) that pertain to System Functions.
Get Free Disk Space on Hard Drives
Compatibility: Win. 98-XP
Add the following code into a module within your project...
Public Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, lpSectorsPerCluster As Long, lpBytesPerSector As Long, lpNumberOfFreeClusters As Long, lpTtoalNumberOfClusters As Long) As Long
Public Type DiskInformation
lpSectorsPerCluster As Long lpBytesPerSector As Long
lpNumberOfFreeClusters As Long
lpTotalNumberOfClusters As Long
End Type
Add the following code wherever you want the code to execute...
Dim info As DiskInformation
Dim lAnswer As Long
Dim lpRootPathName As String
Dim lpSectorsPerCluster As Long
Dim lpBytesPerSector As Long
Dim lpNumberOfFreeClusters As Long
Dim lpTotalNumberOfClusters As Long
Dim lBytesPerCluster As Long
Dim lNumFreeBytes As Double
Dim sString As String
lpRootPathName = "c:\" 'simply replace this with your hard drive path
lAnswer = GetDiskFreeSpace(lpRootPathName, lpSectorsPerCluster, lpBytesPerSector, lpNumberOfFreeClusters, lpTotalNumberOfClusters)
lBytesPerCluster = lpSectorsPerCluster * lpBytesPerSector
lNumFreeBytes = lBytesPerCluster * lpNumberOfFreeClusters
sString = "Number of Free Bytes : " & lNumFreeBytes & vbCr & vbLf
sString = sString & "Number of Free Kilobytes: " & (lNumFreeBytes / 1024) & "K" & vbCr & vbLf
sString = sString & "Number of Free Megabytes: " & Format(((lNumFreeBytes / 1024) / 1024), "0.00") & "MB"
MsgBox sString
Get Windows Directory using API Call
Compatibility: Win. 98-XP
Add the following code into a module within your project...
Public Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public Const MAX_PATH = 260
Add the following code wherever you want the code to execute...
Dim strBuffer As String
Dim lngReturn As Long
Dim strWindowsDirectory As String
strBuffer = Space$(MAX_PATH)
lngReturn = GetWindowsDirectory(strBuffer, MAX_PATH)
strWindowsDirectory = Left$(strBuffer, Len(strBuffer) - 1)
Clear/Add-to Windows Recent Document List
Compatibility: Win. 98-XP
Add the following code into a module within your project...
Public Declare Sub SHAddToRecentDocs Lib "shell32.dll" (ByVal uFlags As Long, ByVal pv As String)
Add the following code wherever you want the Clear Recent Document List code to execute...
'clear the entire list
Call SHAddToRecentDocs(2,vbNullString)
Add the following code wherever you want to add the file to the list code to execute...
'add a new file to list
Dim strNewFile as String
strNewFile="c:\myfile.ext"
Call SHAddToRecentDocs(2,strNewFile)
Visual Basic Code Snippets #6
In this next update I'll continue to re-post my Visual Basic code snippets (which are older than five years by the way) that pertain to System Functions.
Hide/Show Your Application from Task Manager
Compatibility: Win. 98-ME
Add the following code into a module within your project...
Public Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Public Declare Function GetCurrentProcess Lib "kernel32" () As Long
Public Declare Function RegisterServiceProcess Lib "kernel32" (ByVal dwProcessID As Long, ByVal dwType As Long) As Long
Public Const RSP_SIMPLE_SERVICE = 1
Public Const RSP_UNREGISTER_SERVICE = 0
Public Sub removeCtrlAltDel()
'only works on win98/ME
Dim pid As Long
Dim lngRet As Long
pid = GetCurrentProcessId()
lngRet = RegisterServiceProcess(pid, RSP_SIMPLE_SERVICE)
End Sub
Public Sub showCtrlAltDel()
'only works on win98/ME
Dim pid As Long
Dim lngRet As Long
pid = GetCurrentProcessId()
lngRet = RegisterServiceProcess(pid, RSP_UNREGISTER_SERVICE)
End Sub
Add the following code wherever you want the Hide code to execute...
Call removeCtrlAltDel()
Add the following code wherever you want the Show code to execute...
Call showCtrlAltDel()
Get and Show Windows Runtime
Compatibility: Win. 98-XP
Add the following code into a module within your project...
Public Declare Function GetTickCount& Lib "kernel32" ()
Public Function windowsRuntime(lbl As Label)
Dim lngReturn As Long
lngReturn = GetTickCount()
lbl.Caption = "Windows has been running for " & (lngReturn / 1000) & " seconds."
End Function
Add a label named Label1 to a form and add the following code...
Call windowsRuntime(Label1) 'Label1 being the display label.
Add All Available System Fonts to List
Compatibility: Win. 98-XP
Add the following code into a module within your project...
Public Function AddFontsList(Lis As ListBox)
For X = 0 To Screen.FontCount - 1
Lis.AddItem Screen.Fonts(X)
Next X
End Function
Add a ListBox named List1 and add the following code wherever you want the code to execute...
Call AddFontsList(List1)
Visual Basic Code Snippets #5
In this next update I'll re-post my Visual Basic code snippets (which are older than five years by the way) that pertain to System Functions.
Shutdown/Poweroff Windows
Compatibility: Win. 98-XP
Add the following code into a module within your project...
Public Declare Function ExitWindowsEx Lib "User32" Alias "ExitWindowsEx"(ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Add the following code into a command button or wherever you want the code to execute...
Call ExitWindowsEx(EWX_POWEROFF,0)
Restart Windows
Compatibility: Win. 98-XP
Add the following code into a module within your project...
Public Declare Function ExitWindowsEx Lib "User32" Alias "ExitWindowsEx"(ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Add the following code into a command button or wherever you want the code to execute...
Call ExitWindowsEx(EWX_REBOOT,0)
Shell Out to Default Web Browser
Compatibility: Win. 98-XP
Add the following code into a module within your project...
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Public Const conSwNormal = 1
Public Function shellSite(site As String)
ShellExecute hwnd, "open", site, vbNullString, vbNullString, conSwNormal
End Function
Add the following code wherever you want the code to execute...
Call shellSite("http://www.beneskew.com")
Visual Basic Code Snippets #4
In this next update I’ll continue to re-post my Visual Basic code snippets (which are older than five years by the way) that pertain to Forms.
Save and Load the Position of the Form
Compatibility: Win. 98-XP
Add the following code into a module within your project...
Public Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Public Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Public Function GetFromINI(Section As String, Key As String, Directory As String) As String
Dim strBuffer As String
strBuffer = String(750, Chr(0))
Key$ = LCase$(Key$)
GetFromINI$ = Left(strBuffer, GetPrivateProfileString(Section$, ByVal Key$, "", strBuffer, Len(strBuffer), Directory$))
End Function
Public Sub WriteToINI(Section As String, Key As String, KeyValue As String, Directory As String)
Call WritePrivateProfileString(Section$, UCase$(Key$), KeyValue$, Directory$)
End Sub
Add the following code in the Form_Unload event...
Call WriteToINI("Main", "Xpos", Form1.Left, App.Path & "\data.ini")
Call WriteToINI("Main", "Ypos", Form1.Top, App.Path & "\data.ini")
Add the following code in the Form_Load event...
Xpos = GetFromINI("Main", "Xpos", App.Path & "\data.ini")
Ypos = GetFromINI("Main", "Ypos", App.Path & "\data.ini")
Form1.Top = Ypos
Form1.Left = Xpos
Disable the X Button on a Form
Compatibility: Win. 98-XP
Add the following code into a module within your project...
Public Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
Public Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long
Public Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Public Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
Public Const MF_BYPOSITION = &H400&
Public Const MF_DISABLED = &H2&
Public Sub DisableX(Frm As Form)
Dim hMenu As Long
Dim nCount As Long
hMenu = GetSystemMenu(Frm.hwnd, 0)
nCount = GetMenuItemCount(hMenu)
Call RemoveMenu(hMenu, nCount - 1, MF_DISABLED Or MF_BYPOSITION)
DrawMenuBar Frm.hwnd
End Sub
Add the following code wherever you want the code to execute...
Call DisableX(Me)
Make Form Stay On-Top
Compatibility: Win. 98-XP
Add the following code into a module within your project...
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) As Long
Public Const HWND_NOTOPMOST = -2
Public Const HWND_TOPMOST = -1
Public Sub StayOnTop(frm As Form)
'For best results put in the formpaint
Call SetWindowPos(frm.hWnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS)
End Sub
Public Sub NotOnTop(frm As Form)
'For best results put in the formpaint
Call SetWindowPos(frm.hWnd, HWND_NOTOPMOST, 0, 0, 0, 0, FLAGS)
End Sub
Add the following code wherever you want the StayOnTop code to execute...
Call StayOnTop(Form1) 'Form1 being the form.
Add the following code wherever you want the NotOnTop code to execute...
Call NotOnTop(Form1) 'Form1 being the form.
Visual Basic Code Snippets #3
In this next update I’ll continue to re-post my Visual Basic code snippets (which are older than five years by the way) that pertain to Forms.
Center a Form on the Screen
Compatibility: Win. 98-XP
Add the following code into a module within your project...
Public Sub Form_Center(Frm As Form)
'Usually used in form_load
Frm.Left = Screen.Width / 2 - Frm.Width / 2
Frm.Top = Screen.Height / 2 - Frm.Height / 2
End Sub
Add a form named Form1 and add the following code wherever you want the code to execute...
Call Form_Center(Form1)
Center Form at a Given Point on the Screen
Compatibility: Win. 98-XP
Add the following code into a module within your project...
Public Sub Form_CenterAt(Frm As Form, X As Integer, Y As Integer)
'X: X coordinate to center form at
'Y: Y coordinate to center form at
'Example...
'Form_CenterAt me, screen.width/2, screen.height/2
Frm.Left = X - Frm.Width / 2
Frm.Top = Y - Frm.Height / 2
End Sub
Add a form named Form1 and add the following code wherever you want the code to execute...
Call Form_CenterAt(Form1, screen.width/2, screen.height/2)
Visual Basic Code Snippets #2
In this next update I'll continue to re-post my Visual Basic code snippets (which are older than five years by the way) that pertain to Forms.
Make a Form Cover the Entire Screen
Compatibility: Win. 98-XP
Add the following code into a module within your project...
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) As Long
Public Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Public Const SM_CXSCREEN = 0
Public Const SM_CYSCREEN = 1
Public Const HWND_TOP = 0
Public Const SWP_SHOWWINDOW = &H40
Add the following code wherever you want the code to execute...
Dim cx As Long
Dim cy As Long
Dim RetVal As Long
If Me.WindowState = vbMaximized Then
Me.WindowState = vbNormal
End If
cx = GetSystemMetrics(SM_CXSCREEN)
cy = GetSystemMetrics(SM_CYSCREEN)
RetVal = SetWindowPos(Me.hwnd, HWND_TOP, 0, 0, cx, cy, SWP_SHOWWINDOW)
Flash a Forms Border
Compatibility: Win. 98-XP
Add the following code into a module within your project...
Public Declare Function FlashWindow Lib "User32" (ByVal hWnd As Long, ByVal bInvert As Long) As Long
Add a Timer to a form named Timer1 with an interval of 220 then add the following code into Timer1_Timer...
Dim nReturnValue As Long
nReturnValue = FlashWindow(Form1.hWnd, True)
Visual Basic Code Snippets #1
In this update I'll re-post my Visual Basic code snippets (which are older than five years by the way) that pertain to Forms.
Move a Form Without a Title Bar
Compatibility: Win. 98-XP
Add the following code into a module within your project...
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Const HTCAPTION = 2
Public Const WM_NCLBUTTONDOWN = &HA1
Add the following code into the MouseDown event of a Form, PictureBox, or whatever...
ReleaseCapture
SendMessage(hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
Make a Form Transparent
Compatibility: Win. 98-XP
Add the following code into a module within your project...
Public Const GWL_EXSTYLE = (-20)
Public Const WS_EX_TRANSPARENT = &H20&
Public Const SWP_FRAMECHANGED = &H20
Public Const SWP_NOMOVE = &H2
Public Const SWP_NOSIZE = &H1
Public Const SWP_SHOWME = SWP_FRAMECHANGED Or SWP_NOMOVE Or SWP_NOSIZE
Public Const HWND_NOTOPMOST = -2
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
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) As Long
Public Function formTransparent(frm As Form)
SetWindowLong frm.hwnd, GWL_EXSTYLE, WS_EX_TRANSPARENT
SetWindowPos frm.hwnd, HWND_NOTOPMOST, 0&, 0&, 0&, 0&, SWP_SHOWME
End Function
Add the following code wherever you want the code to execute...
Call formTransparent(Form1) 'Form1 being the form you want to be transparent.
These two snippets are just the tip of the iceberg! Much more to come!