Two Hoots Banner



Visual Basic Form Tips

  • Always set a form to Nothing after unloading it freeing memory used by variables and arrays.

  • Use the following code to close all the opened child forms in your MDI parent simultaneously. 
Dim vForm as Variant
For Each vForm in Forms
  If Not TypeOf vForm Is MDIForm Then
    If vForm.MDIChild Then
      Unload vForm
    End If
  End If
Next
  • Use the following code to activate the previous instance of your app. 
Function AnotherInstance()

Dim sCaption As String
If App.PrevInstance Then
  sCaption = Me.Caption
  MsgBox "Another Instance is already running"
  Me.Caption = "Different Caption"
  AppActivate sCaption
  SendKeys "% R", True
  Unload Me
End If
End Function
  • To speed up adding a large number of items to a listbox use the SendMessage API to disable the redrawing of the control. 
Declare Function SendMessage Lib "User32" Alias "SendMessageA" _
  (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, _
  lParam As Any) As Long

Global Const WM_SETREDRAW = &HB

nRet& = SendMessage(List1.hWnd, WM_SETREDRAW, False, 0&)

List1.AddItem "Mon"
List1.AddItem "Tue"

nRet& = SendMessage(List1.hWnd, WM_SETREDRAW, True, 0&)
  • In earlier versions you could omit the property if you were referencing the default property to speed up your routines, i.e. use "txtName" instead of "txtName.Text". This is not true under later versions.

  • Use the following code to set the maximum input length in a combo box. 
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 lRet As Long

Private Sub Form_Load()

Const WM_USER = &H400
Const CB_LIMITTEXT = WM_USER + 1

lRet = SendMessage(Combo1.hwnd, CB_LIMITTEXT, 3, 0)

End Sub
  • Move controls using Ctrl with arrow keys and you can control the size using the Shift with the arrow keys.

  • To remove unused components from your project, select the Projects->Components menu option and click 'OK' with the shift key held down. All unused components will be removed.
  • Use the following code to emulate overstrike mode in text boxes 
Sub Text1_KeyPress(KeyAscii As Integer)

If KeyAscii >= 32 Then
  If Text1.SelLength = 0 Then
    If Text1.SelStart < Len(Text1.Text) Then
      Text1.SelLength = 1
    End If
  End If
End If

End Sub
  • Use the following code to add autotab like tab to text boxes. 
Sub Text1_Change()

If len(Text1.Text) = Text1.MaxLength Then
  SendKeys "{TAB}"
End If

End Sub
  • Use the following code to make the enter key work like a tab. Note that this will not word on a form where a command button has the default property is True. 
Sub Text1_KeyPress (KeyAscii As Integer)

If KeyAscii = 13 then
  SendKeys "{TAB}"
  KeyAscii = 0
End If

End Sub
  • To check which version of VBX files you are using use the WPS.EXE (Windows Process Status) which is distributed with VB in the CDK directory to determine the path the VBX is being read from.

  • Use the following code to undo changes in text boxes. 
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
	
Sub MnuUndo_Click()

Call TextUndo(Screen.ActiveControl)

End Sub

Sub TextUndo(ctrl As Control)

Dim lReturn As Long

Const EM_UNDO = &H417

If TypeOf ctrl Is TextBox Then
  lReturn = SendMessage(ctrl.hWnd, EM_UNDO, 0, 0&)
End If

End Sub
  • To quickly set the forms control tab order set the tabs in reverse order assigning each tab index to 0.

  • To line up controls on a form, select all the controls you want to line up. Press F4 to bring up the properties window. Then double-click on the property title of the property you want to set. The value that appears is the value of the first control you selected.

  • Use the following code to select text when entering a field. 
Sub SetSelected()

Screen.ActiveControl.SelStart = 0
Screen.ActiveControl.SelLength = Len(Screen.ActiveControl.Text)

End Sub

Sub txtField_GotFocus()

SetSelected

End Sub
  • Use the following code to determine the monitor resolution. 
Declare Function GetSystemMetrics Lib "User32" (ByVal nIndex As Integer) As Long

Sub Form_Load()

Dim xRes As Integer
Dim yRes As Integer

xRes = GetSystemMetrics(0)
yRes = GetSystemMetrics(1)

End Sub
  • Use the following code to unload all forms. 
Public Sub UnloadAll()

Dim f as Integer
Dim i as Integer

f = Forms.Count -1

For i = f to 0 step -1
  Unload Forms(i)
  Set Forms(i) = Nothing
Next

End Sub
  • Use the following code to enter all text in uppercase. You will need to set the Forms KeyPreview Property to True. To force upper case in a text box put the same code in the text boxes keypress event. 
Private Sub Form_Keypress(KeyAscii as Integer)

KeyAscii = Asc(UCase(Chr(KeyAscii)))

End Sub
  • Use the following code to create numeric input text boxes. This removes the requirement to place code in each controls keypress event. 
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
  (ByVal hwnd As Long, ByVal nIndex As Long, _
  ByVal dwNewLong As Long) As Long
  
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
  (ByVal hwnd As Long, ByVal nIndex As Long) As Long

Sub NumericEdit(TheControl As Control)

Const ES_NUMBER = &H2000&
Const GWL_STYLE = (-16)

Dim x As Long
Dim Estyle As Long

Estyle = GetWindowLong(TheControl.hwnd, GWL_STYLE)
Estyle = Estyle Or ES_NUMBER

x = SetWindowLong(TheControl.hwnd, GWL_STYLE, Estyle)

End Sub
  • Iterating the Controls collection is useful when setting properties of multiple controls on a form. As an example the following code clears all the text boxes on the passed form. 
Public Sub ClearForm(FName as Form)

Dim MyControl as Control

For Each MyControl In FName.Controls
  If TypeOf MyControl Is TextBox Then
    MyControl.Text = ""
  End If
Next MyControl

End Sub
  • Use the SaveSetting and Get Setting to save the position of forms and reposition when restarting the program. Place these routines in a module and call them from the forms' Load and Unload events. You must place the name of the form in it's Tag property for these routines to work. 
Public Sub FormPosition_Get(F As Form)

' Retrieve Form frm's position from an ini/reg file and position it accordingly

Dim buf As String
Dim l As Integer
Dim t As Integer
Dim h As Integer
Dim w As Integer
Dim pos As Integer

buf = GetSetting(App.EXEName, "FormPosition", F.Tag, "")

If buf = "" Then
  ' default to centring the form
  F.Move (Screen.Width - F.Width) / 2, (Screen.Height - F.Height) / 2
Else
  ' extract l,t,w,h and move the form
  pos = InStr(buf, ",")
  l = CInt(Left(buf, pos - 1))
  buf = Mid(buf, pos + 1)
  pos = InStr(buf, ",")
  t = CInt(Left(buf, pos - 1))
  buf = Mid(buf, pos + 1)
  pos = InStr(buf, ",")
  w = CInt(Left(buf, pos - 1))
  h = CInt(Mid(buf, pos + 1))
  F.Move l, t, w, h
End If

End Sub

Public Sub FormPosition_Put(F As Form)

' Write form F's top,left,height and width

Dim buf As String
buf = F.Left & "," & F.Top & "," & F.Width & "," & F.Height

SaveSetting App.EXEName, "FormPosition", F.Tag, buf

End Sub
  • To take account of the taskbar when centring forms add the following code to your project and call the CentreForm routine passing the form to be centred. 
Private Declare Function GetSystemMetrics Lib "user32" _
  (ByVal nIndex As Long) As Long
  
Private Declare Function GetWindowLong Lib "user32" Alias _
  "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long

Private Const SM_CXFULLSCREEN = 16
Private Const SM_CYFULLSCREEN = 17

Public Sub CentreForm(frm As Form)

Dim Left As Long
Dim top As Long

Left = (Screen.TwipsPerPixelX * (GetSystemMetrics(SM_CXFULLSCREEN) / 2))_
   - (frm.Width / 2)
top = (Screen.TwipsPerPixelY * (GetSystemMetrics(SM_CYFULLSCREEN) / 2)) _
  - (frm.Height / 2)

frm.Move Left, top

End Sub
  • The following function allows you to use the plus and minus keys to increment and decrement dates. Call the routine from the KeyPress event of the required text box passing the current Keyascii value. 
Private Function DateHandler(keyascii As Integer) As Integer

Dim nRet As Integer

' This routine adds or subtracts days, based on the key pressed

On Error GoTo ErrorHandler

Const KeyAdd = 43   ' Add Key
Const KeySubtract = 45  ' Subtract Key
Const KeyEquals = 61    ' Some keyboards have '+' and '=' on same keys

' Do the action on the key pressed

Select Case keyascii

  Case KeyAdd, KeyEquals
        
    Me.ActiveControl.Text = DateAdd("d", 1, Me.ActiveControl)
    nRet = 0
  Case KeySubtract
            
    Me.ActiveControl.Text = DateAdd("d", -1, Me.ActiveControl)
    nRet = 0
           
  Case Else
        
    nRet = keyascii
            
End Select
    
' Move to end of text
If nRet = 0 Then
  Me.ActiveControl.SelStart = Len(Me.ActiveControl.Text)
End If

' Return a new Keyascii Value
DateHandler = nRet
Exit Function

ErrorHandler:
  DateHandler = 0
  Exit Function
    
End Function
  • As a replacement to the common dialog control try the replacement control, dlgobjs.dll which can be found in the \VB98\WIZARDS\PDWIZARD directory on the VB6 CD-ROM. To register the control -
Copy DLGOBJS.DLL from VB98\Wizards\PDWizard to your \Windows\System directory (or \System32 directory on Windows NT).

Register the design time license by merging the Registry file DLGOBJS.REG into your registry by right clicking on \Tools\Unsupprt\DlgObj\DLGOBJS.REG and choose 'Merge'.

Register DLGOBJS.DLL by either using RegSvr32.Exe found in \Tools\RegUtils or by Browsing for the DLGOBJS.DLL in the Project|References Dialog in Visual Basic and clicking 'Open'.

Once the DLL is registered, select "Microsoft Dialog Automation Objects" in the Project|References Dialog in Visual Basic.

The following code can be used to open a centred file dialog, by passing GetFileName the handle to the window that acts as the dialog's parent.

Public Function GetFileName(WinHandle As Long) As String

Dim Dlg As dialogobjects.ChooseFile

Set Dlg = New dialogobjects.ChooseFile

With Dlg
  ' Show a Save As Dialog box
  .Save = True
  ' Centre the Dialog box
  .Centre = True
  ' Need a Parent Window
  .hWnd = WinHandle
  ' Don't need 'open as read only' box
  .HideReadOnly = True
  ' Don't select multiple files
   .MultiSelect = False
  'Ask to overwrite existing files
  .OverwritePrompt = True
  .Filters.Add "BAS Files (*.bas):*.bas"  ' File Mask
  .Filters.Add "All Files (*.*):*.*"      ' File Mask
  If .Show Then
     GetFileName = .Directory & "\" & .FileName
  Else
     GetFileName = ""        ' User Pressed Cancel
  End If
End With
Set Dlg = Nothing

End Function
  • Use the following code to close your windows the windows way. Call it from the Unload procedure within a form. Each time a form is unloaded it appears to fade to the task bar and then disappears. 
Public Sub Win95Shrivel(xForm As Form)

' Sets the forms window status to minimised
xForm.WindowState = 1

End Sub
  • To add a horizontal scrollbar to a standard list box call the following routine. 
Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
  (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
  lParam As Long) As Long

Const LB_SETHORIZONTALEXTENT = &H194

Public Sub SetHScroll(frm As Form, ctl As Control, strText As String)

' set strText to be the longest item from the list i.e. list1.list(0)

Dim nScaleMode As Integer
Dim nTextWidth As Integer

' Scale in pixels for window message
nScaleMode = frm.ScaleMode
frm.ScaleMode = 3

' Get the width, in pixels, of the text string
nTextWidth = frm.TextWidth(strText)
' Send a message to the list box
SendMessage ctl.hwnd, LB_SETHORIZONTALEXTENT, nTextWidth, 0
' Restore previous scale mode
frm.ScaleMode = nScaleMode

End Sub
  • When attempting to determine which option button a user has selected from an array of option buttons, use the following code which is more efficient than an If-Then construct. 
intSelectedItems = 0
' N is total number of option boxes minus one
For iCount = 0 to N
  intSelectedItems = Option(iCount).Value * icount
Next
  • Draw users attention by flashing the windows caption. 
Declare Function FlashWindow Lib "user32" _
  (ByVal hwnd As Long, ByVal bInvert As Long) As Long

Sub Flash(hFlash As Long, iTimes As Integer, sInterval As Single)

' Call Routine e.g. Flash Me.hwnd, 20, 0.5

Dim i As Integer

For i = 0 To iTimes
  ' iTimes sets the number of flashes
  Call FlashWindow(hFlash, True)
  Dim start As Single
  ' Set the start time
  start = Timer
  ' sInterval sets the time between flashes
  Do While Timer < start + sInterval
    DoEvents
  Loop
Next i

'Put everything back to normal
Call FlashWindow(hFlash, False)

End Sub
  • Avoid flickering forms when populating list boxes by using the following API call. 
Declare Function LockWindowUpdate Lib "user32" (ByVal hWndLock As Long) As Long

Dim IEerr As Long
Dim x As Integer

Screen.MousePointer = vbHourglass
Lerr = LockWindowUpdate(Me.hwnd)

For x = 1 To 5000
  List1.AddItem CStr(x)
Next

Lerr = LockWindowUpdate(0)
Screen.MousePointer = vbDefault
  • When you place controls on a form, the Font properties of all the controls default to a sans serif font rather than a default font that you specify. To avoid this annoyance, set the Font property for the form to the value you'd like the controls to use before placing the controls on the form.