Home | What's New | Articles | Code Downloads | Tool Box | Links | Code Snippets  

Other Code Snippets

Hiding the Start Button

Private Declare Function ShowWindow Lib "user32" _
(ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias _
"FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias _
"FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, _
 ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Property Let StartButtonVisible(bVisible As Boolean)
Dim lTaskbarHandle As Long
Dim lStartButtonHandle As Long

   lTaskbarHandle = FindWindow("Shell_TrayWnd", "")
   lStartButtonHandle = FindWindowEx(lTaskbarHandle, 0, "Button", vbNullString)
   
    If bVisible Then
        ShowWindow lStartButtonHandle, 5 ' Show Start Button'
    Else
        ShowWindow lStartButtonHandle, 0 ' Hide Start Button'
    End If
End Property

To make the start button invisible use: StartButtonVisible = False


Loading a Form using a String

Sub LoadFormByString(sFormName As String)
    Dim NewForm As Form
    Set NewForm = Forms.Add(sFormName)
   NewForm.Show
End Sub

Finding the Number of Digits in a number

numberofdigits = Int(Log(x) / Log(10)) + 1

Disabling / Enabling Ctrl + Alt + Delete

Works on Windows 95.

'General Declarations:

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
Public Const SPI_SCREENSAVERRUNNING = 97

'-------------------------------------------------

Public Sub CtrAltDel(Enabled as Boolean)
  Dim dis As Boolean
  SystemParametersInfo SPI_SCREENSAVERRUNNING, Not Enabled, dis, 0
End Sub


Adding a link to your homepage (using the default web browser)

Many applications today have links to there web site in there about box.  You to can add this functionality using this short piece of code.

In a module, place this:
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 SW_NORMAL = 1

Now,  place this where you want to open your link.

    Dim X as Long
    X = ShellExecute(hwnd, "Open", "http://www.developersdomain.com", &O0, &O0, SW_NORMAL)

 


Controlling Microsoft Internet Explorer

To control IE add a reference to Internet Explorer in Visual Basic
1. From the Tools menu, choose References.
2. Select Microsoft Internet Controls. This creates a reference to Shdocvw.dll.
3. Now we can control using the Navigate Method.

Dim browser As InternetExplorer
Set browser = CreateObject("InternetExplorer.Application")

browser.Visible = True
browser.Navigate "http://www.voyager.co.nz/~mbj/index.html"

Copying a TreeView Control

This code will copy one TreeView's nodes to another.  To use this code copy and paste it into a form or module.  To copy a TreeView use this

copyTreeView TreeView1, TreeView2

Sub copyTreeView(Tview1 As TreeView, Tview2 As TreeView)
Dim Nodx As Node
    With Tview2
        .Nodes.Clear
        Set .ImageList = Tview1.ImageList
        For Each Nodx In Tview1.Nodes
            If Nodx.Parent Is Nothing Then
                .Nodes.Add , , Nodx.Key, Nodx.Text, Nodx.Image, Nodx.SelectedImage
            Else
                .Nodes.Add Nodx.Parent.Key, tvwChild, Nodx.Key, Nodx.Text, Nodx.Image, Nodx.SelectedImage
            End If
        Next
    End With
End Sub

Exiting Windows

This code will change the name of disk

'Declarations section:

Const EWX_LogOff = 0
Const EWX_SHUTDOWN = 1
Const EWX_REBOOT = 2
Private Declare Function ExitWindows Lib "User32" Alias "ExitWindowsEx" (ByVal dwOptions As Long, ByVal dwReserved As Long) As Long

To restart windows use ExitWindows EWX_REBOOT, &HFFFFFFFF


Getting and Setting the Cursors Position

'Declarations section:
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function SetCursorPos Lib "user32" _
 (ByVal x As Long, ByVal y As Long) As Long
Private Type POINTAPI
        x As Long
        y As Long
End Type

To find the X, Y coordinates of the mouse cursor use:

Dim cursorPos As POINTAPI
GetCursorPos cursorPos
MsgBox "X=" & cursorPos.x & vbCrLf & "Y=" & cursorPos.y

To move the cursor to the top left hand corner use:

SetCursorPos 0, 0

Creating a Timer without a Form

If you have a project that doesn't have a form, but you need a timer you could add a form just for that purpose.  But that would be waste of resources.  This code snippet makes use of the AddressOf keyword introduced in VB 5.0 to create a callback function.  Don't click the stop button while this program is running if KillTimer hasn't been called yet as VB will properly crash.

Create a new project remove the form and add a new module.  Place this code into the module

'Declarations section:
Private Declare Function SetTimer Lib "user32" _
(ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, _
 ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" _
(ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Dim TimerID As Long

Sub Main is the entry point to this application.  The SetTimer function will cause TimerFunc to be called every three seconds.  This program loops until the Timer is killed.  If the loop wasn't there TimerFunc would continue to run once the program had ended (and properly cause VB to crash).  The important thing to remember is to kill the timer before the application finishes.

Sub Main()
    TimerID = SetTimer(0, 0, 3000, AddressOf TimerFunc)
    ' Loop until the timer is killed by the user
    Do
        DoEvents
    Loop While TimerID <> -1
End Sub

This is the sub receives the timer events.

'hwnd   :  handle of window for timer messages
'uMsg   :  WM_TIMER message
'idEvent:  timer identifier
'dwTime :  current system time
Public Sub TimerFunc(ByVal hwnd As Long, ByVal uMsg As Long, _
ByVal idEvent As Long, ByVal dwTime As Long)
    MsgBox "Time=" & dwTime & ". Click ok to Kill the Timer"
    If KillTimer(0, TimerID) <> 0 Then ' Killed the Timer
        TimerID = -1
    End If
End Sub

Setting the Desktop Wallpaper

Private Declare Function SystemParametersInfo Lib "user32" Alias _
 "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, _
 ByVal lpvParam As Any, ByVal fuWinIni As Long) As Long

Private Const SPI_SETDESKWALLPAPER = 20

Sub setWallPaper(sFilename As String)
    SystemParametersInfo SPI_SETDESKWALLPAPER, 0, sFilename, 0
End Sub

To set the desktop wall paper use:

setWallPaper "C:\myWallPaper.bmp"