[vb6] Adjust height of combobox dropdown to fit the number of items

When you drop down the dropdown list of a combobox, VB will set its height to display a maximum of 8 items. If the listcount property is larger than 8, vb adds a vertical scrollbar to the list. You might want to override this behaviour and set the height of the dropdown so that it fits exactly the number of items, within reasonable limits, of course. The SetDropdownHeight procedure does exactly this. This procedure should be called in response to the DropDown event of the combobox in question. The DropDown event is raised just before the dropdown is actually displayed. Set the max_extent parameter to reflect the wanted maximum extent of the dropdown. In this particular case, I set it to the ScaleHeight of the form to prevent the dropdown from extending below the form.

    Option Explicit
    
    Private Declare Function MoveWindow& Lib "user32" (ByVal hwnd As Long, _
      ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, _
      ByVal nHeight As Long, ByVal bRepaint As Long)
    
    Private Sub Combo1_DropDown()
      SetDropdownHeight Combo1, ScaleHeight
    End Sub
    
    ' Adjust height of combobox dropdown part; call in response to DropDown event
    Private Sub SetDropdownHeight(cbo As ComboBox, ByVal max_extent As Integer)
      ' max_extent is the absolute maximum clientY value that the dropdown may extend to
      ' case 1: nItems <= 8 : do nothing - vb standard behaviour
      ' case 2: Items will fit in defined max area : resize to fit
      ' case 3: Items will not fit : resize to defined max height
        
      If cbo.ListCount > 8 Then
        Dim max_fit As Integer    ' maximum number of items that will fit in maximum extent
        Dim item_ht As Integer    ' Calculated height of an item in the dropdown
        
        item_ht = ScaleY(cbo.Height, ScaleMode, vbPixels) - 8
        max_fit = (max_extent - cbo.Top - cbo.Height) \ ScaleY(item_ht, vbPixels, ScaleMode)
        
        If cbo.ListCount <= max_fit Then
          MoveWindow cbo.hwnd, ScaleX(cbo.Left, ScaleMode, vbPixels), _
            ScaleY(cbo.Top, ScaleMode, vbPixels), _
            ScaleX(cbo.Width, ScaleMode, vbPixels), _
            ScaleY(cbo.Height, ScaleMode, vbPixels) + (item_ht * cbo.ListCount) + 2, 0
        Else
          MoveWindow cbo.hwnd, ScaleX(cbo.Left, ScaleMode, vbPixels), _
            ScaleY(cbo.Top, ScaleMode, vbPixels), _
            ScaleX(cbo.Width, ScaleMode, vbPixels), _
            ScaleY(cbo.Height, ScaleMode, vbPixels) + (item_ht * max_fit) + 2, 0
        End If
      End If
    End Sub

[vb6] Register COM components

COM components (COM dlls, including ActiveX control libraries) are normally registered by setup programs or manually by using the RegSvr32 utility. If, for some reason you want to register a component in pure code you can do like this instead: First, declare the exported function DllRegisterServer that all COM dlls and ocx's export. To tailor it to your own dlls change the filename and the alias in the declare statement. The function returns 0 on success. The only disadvantage is that you have to know the name of the file at design-time, because declare statements are hard-coded into your executable - there is no such thing as a dynamic declare statement.

    Private Declare Function DllRegisterServerGRADIENTTITLE Lib _
      "GradientTitle.ocx" Alias "DllRegisterServer" () As Long

Call the function like this to make the registration:

    Dim retval As Long
    retval = DllRegisterServerGRADIENTTITLE

[vb6] Prompt for a folder

You can use the shell library to prompt the user for a folder name, like you see in setup programs. The shell function SHBrowseForFolder pops up a modal dialog box that prompts the user to select a folder. (You will probably need only a subset of the constants. See the Platform SDK for an explanation of when to use the differenct flags).

    Private Const BIF_RETURNONLYFSDIRS = &H1&
    Private Const BIF_DONTGOBELOWDOMAIN = &H2&
    Private Const BIF_STATUSTEXT = &H4&
    Private Const BIF_RETURNFSANCESTORS = &H8&
    Private Const BIF_EDITBOX = &H10&
    Private Const BIF_VALIDATE = &H20&
    Private Const BIF_BROWSEFORCOMPUTER = &H1000&
    Private Const BIF_BROWSEFORPRINTER = &H2000&
    Private Const BIF_BROWSEINCLUDEFILES = &H4000&
    
    Private Type BROWSEINFO
      hwndOwner As Long
      LPCITEMIDLIST  As Long
      lpszDisplayName As String
      lpszTitle As String
      ulFlags As Long
      lpfn As Long
      lParam As Long
      iImage As Long
    End Type
    
    Private Declare Function SHBrowseForFolder Lib "shell32.dll" _
      (lpbi As BROWSEINFO) As Long
    Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _
      (ByVal pidl As Long, ByVal sFolder As String) As Long
    
    Private Function PromptForFolder() As String
      Dim bInfo As BROWSEINFO
      With bInfo
        .hwndOwner = hwnd
        .lpszDisplayName = String(260, 32)
        .lpszTitle = "Select Directory:"
        .ulFlags = BIF_RETURNONLYFSDIRS
        .lpfn = 0
      End With
      
      Dim retval As Long, foldername As String
      foldername = String(260, 32)
      retval = SHBrowseForFolder(bInfo)
      retval = SHGetPathFromIDList(retval, foldername)
      PromptForFolder = RTrim$(foldername)
    End Function

The VB function as shown returns the full path to the folder. If you want just the name of the folder, return bInfo.lpszDisplayname instead.

[vb6] Get rid of blinking on scrollbar

Have you ever used hours trying to figure out how to get rid of that unsightly blinking on the scrollbar controls ? (well, I have !). The solution is simple (once you know it): Set the Tabstop property to false....

[vb6] When to do Refresh in response to Resize

When a form or picture box is resized, it is automatically invalidated. This means that the Paint event handler is called immediately after the Resize event handler. However, this is only true if either the width or height (or both) were increased by the resize operation. This may be fine, if that is what you want, but in many situations you need to repaint the form / picturebox also when it is made smaller. You cannot simply do a Refresh in the Resize event handler, cause that would entail a duplicate repainting when the form or picturebox is enlarged in one or both dimensions. Instead, you must cheque the new size and compare it to the previous size, refreshing only when appropiate. This example is for a picture box named picCar:

    Private Sub picCar_Resize()
      Static OldPictureSizeX As Long
      Static OldPictureSizeY As Long
      If picCar.Width <= OldPictureSizeX And picCar.Height <= OldPictureSizeY Then
        picCar.Refresh
      End If
      OldPictureSizeX = picCar.Width
      OldPictureSizeY = picCar.Height
    End Sub

[vb6] How change the font color on a commandbutton ?

The easy answers are "Don't" or "Buy a 3rd party commandbutton control that will let you change the text color". Otherwise, you can use the hack below to change the color. The button is presupposed to reside on a form with scalemode=3. Commandbutton.Name = "Command1", .Caption = "", .Tag = the caption you want. In addition, place a timer on the form; call it Timer1, set its Enabled property to false and Interval to 10. Note: the text is written with the system font. If you want another font, you'll have to create the font and select it into the command1 device context.

    Option Explicit
    
    Private Type RECT
      Left As Long
      Top As Long
      Right As Long
      Bottom As Long
    End Type
    
    Private Const DT_SINGLELINE& = &H20
    Private Const DT_CENTER& = &H1
    Private Const DT_VCENTER& = &H4
    Private Const TRANSPARENT& = 1
    Private Declare Function SetBkMode& Lib "gdi32" (ByVal hdc As Long,  _
    ByVal nBkMode As Long)
    Private Declare Function SetTextColor& Lib "gdi32" (ByVal hdc As Long, _
    ByVal crColor As Long)
    Private Declare Function GetDC& Lib "user32" (ByVal hwnd As Long)
    Private Declare Function DrawText& Lib "user32" Alias "DrawTextA" _
    (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, _
    lpRect As RECT, ByVal wFormat As Long)
    
    Private Sub Command1_GotFocus()
      Timer1.Enabled = True
    End Sub
    
    Private Sub Command1_LostFocus()
      Timer1.Enabled = True
    End Sub
    
    Private Sub Command1_MouseDown(Button As Integer, Shift As Integer,  _
    x As Single, y As Single)
      PaintCaption Command1, 2, 2, vbRed
    End Sub
    
    Private Sub Command1_MouseUp(Button As Integer, Shift As Integer, _
    x As Single, y As Single)
      PaintCaption Command1, 0, 0, vbRed
    End Sub
    
    Private Sub Form_Paint()
      Timer1.Enabled = True
    End Sub
    
    Private Sub Timer1_Timer()
      PaintCaption Command1, 0, 0, vbRed
      Timer1.Enabled = False
    End Sub
    
    Private Sub PaintCaption(btn As CommandButton, ByVal x As Long, _
    ByVal y As Long, clr As Long)
      Dim dc As Long, re As RECT
      dc = GetDC(btn.hwnd)
      SetTextColor dc, clr
      SetBkMode dc, TRANSPARENT
      re.Left = x
      re.Top = y
      re.Bottom = btn.Height
      re.Right = btn.Width
      DrawText dc, btn.Tag, -1, re, DT_CENTER Or DT_VCENTER Or DT_SINGLELINE
    End Sub

[vb6] How change the backcolor on a commandbutton ?

The intrinsic commandbutton control offers a backcolor property, but if you attempt to set it to anything but the default, you'll notice that your changes are disregarded. To activate the backcolor setting, set the Style property of the button to 1 - graphical.

[vb6] Get rid of the title bar

Problem: I don't want my program to have a titlebar but I do want it listed in the Windows Taskbar. I figured out that I could get rid of the title bar by turning off the controlbox setting and setting the caption to "" but this gives me a blank bar in the taskbar too. Annoyingly, the "ShowInTaskbar" setting is only available at design time so I can't turn it off when the window is visible and back on when minimized. Solution: Set the following form properties: BorderStyle: 0 - None, Caption: whatever, ShowInTaskBar: True and WindowState: 1 - Minimized. Then, in the form load procedure give the form a 3d border by changing its style:

    Private Const WS_DLGFRAME& = &H400000
    ModifyStyle hwnd, 0, WS_DLGFRAME

See the tip on the ModifyStyle function and the tip on enabling moving of forms with no title bar.

[vb6] Retrieve pixel color with GetPixel

The color of a pixel on a form or picturebox can be read with the GetPixel API. The function expects X and Y in pixels, so it is necessary to convert from whatever scalemode is in effect to pixels. The code below reads the pixel values from a picturebox when a mouse button is pressed and uses the ScaleX and ScaleY methods of the picturebox control to make the call to GetPixel independent of the scalemode property.

    Private Declare Function GetPixel Lib "gdi32" _
      (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
    
    Private Sub Pict1_MouseDown(Button As Integer, _
          Shift As Integer, X As Single, Y As Single)
      Debug.Print GetPixel(Pict1.hdc, Pict1.ScaleX(X, _
        Pict1.ScaleMode, 3), Pict1.ScaleY(Y, Pict1.ScaleMode, 3))
    End Sub

[vb6] Scrolling multiline textboxes in code

The user can scroll a multiline textbox by using the vertical scroll bar (provided you've assigned a scrollbar to the control), but the developer cannot, unless resorting to sending messages to the control.

    Private Const EM_SCROLL& = &HB5
    Private Const SB_LINEDOWN& = 1
    Private Const SB_LINEUP& = 0
    Private Const EM_LINESCROLL& = &HB6
    Private Const EM_SCROLLCARET& = &HB7
    Private Const SB_PAGEDOWN& = 3
    Private Const SB_PAGEUP& = 2
    Private Const EM_GETFIRSTVISIBLELINE& = &HCE
    Private Declare Function SendMessageBynum& Lib "user32" Alias _
        "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
        ByVal wParam As Long, ByVal lParam As Long)

Send the message EM_SCROLL to scroll up or down. This example scrolls down one page:

    SendMessageBynum Text1.hwnd, EM_SCROLL, SB_PAGEDOWN, 0

Send the message EM_SCROLLCARET to scroll to where the caret is:

    SendMessageBynum Text1.hwnd, EM_SCROLLCARET, 0, 0

Send the message EM_LINESCROLL to scroll a specified number of lines or to a specific line index. This example scrolls to line 10:

    Dim FLine&
    FLine = SendMessageBynum(Text1.hwnd, EM_GETFIRSTVISIBLELINE, 0, 0)
    SendMessageBynum Text1.hwnd, EM_LINESCROLL, 0, 10 - FLine

First, the index of the first visible line is retrieved into FLine. Then, the text is scrolled a number of lines (negative is down, positive is up).

[vb6] Drawing transparent rectangles

You can draw rectangles fast using the Rectangle API. If you want the interior of the rectangles to be transparent, you must first select the special brush NULL_BRUSH into the device context.

    Private Const NULL_BRUSH& = 5
    Private Declare Function Rectangle& Lib "gdi32" (ByVal hdc As Long, _
        ByVal X1 As Long, ByVal Y1 As Long, _
        ByVal X2 As Long, ByVal Y2 As Long)

[vb6] Rubber banding the easy way

Most vector graphics programs let you draw a straight line by pressing a mouse button and then, holding the button down, moving the mouse to the where the line should end and then releasing the mouse button. In other words, a new temporary line is drawn whenever the mouse is moved with the button down (so-called rubber banding). If you try to implement this, you run into the problem of how to erase the previous temporary line, as the mouse is moved, especially if the background is anything but a single color. The solution is very simple: Set the Drawmode property of the form or picturebox (or whatever) to 10 - Not Xor Pen. With this drawmode you can undo any drawing operation by repeating it. Draw each temporary line twice - first to erase the previous temp line, second to draw the new one.

[vb6] Get descriptions of API errors

API functions don't exactly adhere to the VB error handling scheme. Instead, they either return numeric error codes or set an error code in an internal register. To retrieve the error code of the last API error in that internal register, use the LastDllError property of the VB Err object. One thing is numeric codes, however, another thing is to get some useful description of what actually went wrong. VB does not provide that for you, but you can use the FormatMessage API to get textual description corresponding to error codes. Pass the error code to the APIerrorDescription below.

    Private Const FORMAT_MESSAGE_FROM_SYSTEM& = &H1000
    Private Const FORMAT_MESSAGE_IGNORE_INSERTS& = &H200
    Private Declare Function FormatMessage& Lib "kernel32" Alias _
        "FormatMessageA" (ByVal dwFlags As Long, lpSource As Any, _
        ByVal dwMessageId As Long, ByVal dwLanguageId As Long, _
        ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Long)
    
    Public Function APIerrorDescription(ByVal code As Long) As String
      Dim msg As String, r As Long
      msg = String(256, 0)
      r = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM Or _
        FORMAT_MESSAGE_IGNORE_INSERTS, ByVal 0, code, 0, msg, 256, ByVal 0)
      If r Then APIerrorDescription = Left$(msg, r)
    End Function

[vb6] Invoke any program from VB code

Use the ShellExecute function to start another program, to print a document file or start explorer in a specified directory. The hwnd parameter is the window handle of your main form, lpOperation specifies the operation you want and can be "open", "print" or "explore" (pass vbNullString to get the default which is "open"). lpFile is the full name of the file. Use lpParameters to specify any parameters to pass to the file, if it's an exe, or vbNullstring if no parameters. nShowCmd specifies how you want the app /doc window to appear, you'd normally pass SW_SHOWNORMAL (=1), but it can be any of the API constants starting with "SW_". The function returns the instance handle of the app, or an error code (those below 33).

    Private 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)

[vb6] Wrap your collections

You can wrap the VBA collection type in a class of your own, and thereby tailor it for any specific use. Paste the code below into a new class module; set the Item property to be the default. Give the NewEnum method a procedure ID of -4 and click the "Hide member" checkbox in the Procedure Attributes dialog. Note that this example is for collecting class objects; that's why the 'Set' keyword is required in the Item Get property. If you are collecting anything else than objects, remove the 'Set'.
This generalized example can be used as a template for generating more specific collection wrappers; for example you may want to replace the Variant type for the object parameters with something more specific and to let the class generate unique strings to use for the keys, or incorporate any other rules into it as it applies. One shortcoming of the VBA collection is the Item method - it is implemented as a method rather than a property. That means that you cannot go: Let TheCollection("key") = MyObject. Instead you have to first remove the object with key "key" and then add MyObject under the same key. That behaviour has been corrected in this example by implementing Item as a property with let and get procedures.

    Option Explicit
    Private m_Col As Collection
    
    Public Property Get Count() As Long
      Count = m_Col.Count
    End Property
    
    Public Sub Add(ByVal NewItem As Variant, ByVal key As Variant)
    On Error GoTo ERR_HAND
      m_Col.Add NewItem, key
    ERR_HAND:
    Exit Sub
      Err.Raise Err.Number, "MyCollection Class", Err.Description
    End Sub
    
    Public Sub Remove(ByVal key As Variant)
    On Error GoTo ERR_HAND
      m_Col.Remove key
    ERR_HAND:
    Exit Sub
      Err.Raise Err.Number, "MyCollection Class", Err.Description
    End Sub
    
    Public Property Let Item(ByVal key As Variant, ByVal NewItem As Variant)
    On Error Resume Next
      m_Col.Remove key
    On Error GoTo ERR_HAND
      m_Col.Add NewItem, key
    ERR_HAND:
    Exit Property
      Err.Raise Err.Number, "MyCollection Class", Err.Description
    End Property
    
    Public Property Get Item(ByVal key As Variant) As Variant
    On Error GoTo ERR_HAND
      Set Item = m_Col(key)
    Exit Property
    ERR_HAND:
      Err.Raise Err.Number, "MyCollection Class", Err.Description
    End Property
    
    Public Function NewEnum() As IUnknown
      Set NewEnum = m_Col.[_NewEnum]
    End Function
    
    Private Sub Class_Initialize()
      Set m_Col = New Collection
    End Sub

[vb6] Autoselect text in textboxes

In some applications, you see textboxes where the entire text is automatically selected when the box obtains focus (The Address box in MS Internet Explorer, for example). You can get the same functionality with a VB textbox by using this code:

    Private Sub Text1_GotFocus()
      Text1.SelStart = 0
      Text1.SelLength = Len(Text1)
    End Sub

[vb6] Get hold of string pointers

Some API functions return pointers to strings (char*) allocated by that function. This is all very kind, except that you cannot do anything with that pointer with plain Basic. Use the lstrcpyn and lstrlen API functions to copy a string and to learn the string length, respectively. The pCharToString function shown below wraps the two string functions. For example, suppose an API function has returned you a pointer to a string. You can then call the pCharToString function with the string pointer as the parameter. The return is the copied string.

    Private Declare Function lstrcpyn& Lib "kernel32" Alias _
        "lstrcpynA" (ByVal Recipient As String, ByVal pSourceString _
        As Long, ByVal iMaxLength As Long)
    Private Declare Function lstrlen& Lib "kernel32" Alias _
        "lstrlenA" (ByVal lpString As Long)
    
    Public Function pCharToString(ByVal Address As Long) As String
      Dim r As Long
      r = lstrlen(Address)
      pCharToString = String(r, Chr(32))
      r = lstrcpyn(pCharToString, Address, r + 1)
    End Function

[vb6] CopyMemory and array copying

The CopyMemory API function is extremely handy in many situations, especially when calling API functions or subclassing. The reason is that, unlike some other languages, in VB you cannot access a variable via its memory address. A workaround is to do a physical copy of the data between variables. The declare for the function is very flexible - you can pass any data type for its source and destination parameters, and you can pass them ByVal or Byref - just state "ByVal" in the function call if calling ByVal. The last parameter is for indicating the number of bytes to copy.

    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
        (pDst As Any, pSrc As Any, ByVal ByteLen As Long)

As an example of using CopyMemory, the code snippet below copies 11 elements from one array to another array, without having to reference each and every array slot. Note that in this case, the parameters can be passed ByRef (as for the pDst parameter) or ByVal as for the pSrc parameter. In the last case a pointer to the first element of the source array is obtained with the (hidden) VarPtr function.

    Dim i As Integer
    Dim Receiver(10) As Long
    Dim Source(5 To 15) As Long
    For i = 5 To 15
      Source(i) = i
    Next
    
    CopyMemory Receiver(0), ByVal VarPtr(Source(5)), LenB(Source(5)) * 11

[vb6] A cheap CheckFrame control

Some commercial control libraries include a frame control where the caption is replaced by a checkbox control. You don't have to pay for this ! Place a standard frame control on a form and give it the caption " ". Then place a checkbox control on top of that caption.

[vb6] Rounding numbers

If you are displaying real numbers, you might like to display them in rounded format, and possibly with a fixed number of digits after the decimal separator. The format function rounds numbers if you specify a an expression for its format parameter where zeros indicate that the digit is valid and "\0" indicate that the function should append a trailing zero. For example:

    Dim n As Single
    n = 23.647
    Debug.Print Format$(n, "0.000")
    Debug.Print Format$(n, "0.00\0")
    Debug.Print Format$(n, "0.0\0\0")
    Debug.Print Format$(n, "0.\0\0\0")
    Debug.Print Format$(n, "0.00")

If your decimal separator is the dot character, the output from this code is:

    23.647
    23.650
    23.600
    24.000
    23.65

[vb6] Subclass forms and controls

Windows continually sends messages to windows, including the forms and controls in a VB application. Visual Basic takes care of responding to all these messages for you. Some messages are passed on to you in the form of control or form events, after VB has done anything it needs to do. Sometimes, this is not good enough. Maybe parameters passed to your events are missing (as in the WM_PAINT) message, maybe the VB response to a message is unwanted or maybe VB does not pass the message on to the developer at all. Then there is a case for subclassing. When Windows "sends a message" what is actually going on is Windows calling a function in the app. For normal VB programs, this function is a function in the VB run-time library. When you subclass a form a control, you tell Windows not to call the function in the VB run-time, but to call a function you supply. In order for this to work you must write a WndProc function with a certain number and type of arguments (as below) and obtain the address of that function. The function has to be in a standard module and you use the VB AddressOf operator to obtain its address. As an example, paste the code below into a standard module. This particular example subclasses the Form1 form and responds to just one message - the WM_GETMINMAXINFO - passing all other messages to the old VB window procedure. If you want to listen to other messages, you must implement code to handle them and get the appropriate WM_ constant from your favourite API viewer or the Win32 documentation.

    Public Declare Function CallWindowProc Lib "User32" Alias _
        "CallWindowProcA" (ByVal lpPrevWndFunc As Long, _
        ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, _
        ByVal lParam As Long) As Long
    Public Declare Function SetWindowLong Lib "User32" Alias _
        "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, _
        ByVal dwNewLong As Long) As Long
    Public Const GWL_WNDPROC = (-4)
    Public m_oldProc As Long 'The old VB window procedure for form1
    Private Const WM_GETMINMAXINFO = &H24
    
    Public Function WndProc(ByVal hwnd As Long, ByVal uMsg As Long, _
      ByVal wParam As Long, ByVal lParam As Long) As Long
      
      Dim R As Long
      
      If uMsg = WM_GETMINMAXINFO Then
        'Do your processing here ...
        'Here: do or don't call the VB window procedure (as below)
      Else
        'For messages you don't care about, pass it on to VB
        R = CallWindowProc(m_oldProc, Form1.hwnd, uMsg, wParam, lParam)
      End If
      
      WndProc = R
    End Function

In addition, the subclassing needs to be set up and also discontinued at some point - here, in the Form_Load and Form_Unload procedures of Form1, respectively:

    Private Sub Form_Load()
      m_oldProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WndProc)
    End Sub
    
    Private Sub Form_Unload(Cancel As Integer)
      SetWindowLong hwnd, GWL_WNDPROC, m_oldProc
    End Sub

The above subclassing method works just fine and is probably the most efficient one you're likely to get. However, it is suited only for debugged programs being compiled for release. That is because VB will crash when it hits a breakpoint in your code, essentially making it impossible to debug a program (!). The solution is to use a dll or ocx subclassing component. You can buy one or get one for free.

[vb6] Make ANY form fixed size

Visual Basic forms can be made non-sizable by setting the borderstyle property to 0, 1, 3 or 4. However, that also means that the user cannot minimize the form to the taskbar. Worse, the MDI form cannot be made non-sizable at all. That is, unless you implement the code below. This trick requires that you subclass the form and intercept the WM_GETMINMAXINFO message, not passing the message on to VB. This message is sent to a window when Windows queries for the maximum and minimum sizes of the window and of the tracking rectangle displayed when resizing. The code works by setting the minimum equal to the maximum, effectively making the form fixed in size. In order not to confuse the user, the maximize button in the right side of the title bar should be disabled. Do that by modifying the window style - see other tip "ModifyStyle". In this particular example, the form is fixed at VGA-size and initially centered on the screen, but the size and position is up to you, of course.

    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
        (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
    Private Const WM_GETMINMAXINFO = &H24
    Private Const WS_MAXIMIZEBOX& = &H10000
    
    Private Type POINTAPI
      x As Long
      y As Long
    End Type
    
    Private Type MINMAXINFO
      ptReserved As POINTAPI
      ptMaxSize As POINTAPI
      ptMaxPosition As POINTAPI
      ptMinTrackSize As POINTAPI
      ptMaxTrackSize As POINTAPI
    End Type
    
    Dim MinMax As MINMAXINFO
    
    Private Sub Form_Load()
      ModifyStyle hwnd, WS_MAXIMIZEBOX, 0 'Disable Maximize box
      Dim nLeft As Long, nTop As Long
      
      With MinMax
        .ptMaxSize.x = 640
        .ptMaxSize.y = 480
        .ptMinTrackSize.x = .ptMaxSize.x
        .ptMinTrackSize.y = .ptMaxSize.y
        .ptMaxTrackSize.x = .ptMaxSize.x
        .ptMaxTrackSize.y = .ptMaxSize.y
        nLeft = (Screen.Width - .ptMaxSize.x * Screen.TwipsPerPixelX) / 2
        nTop = (Screen.Height - .ptMaxSize.y * Screen.TwipsPerPixelY) / 2
        'Display with new size and centered on screen
        Move nLeft, nTop, .ptMaxSize.x * Screen.TwipsPerPixelX, _
          .ptMaxSize.y * Screen.TwipsPerPixelY
      End With
    End Sub

In the window procedure, add the following code to intercept the message. The code works by copying our private MinMax over the MINMAXINFO pointed to by lParam.

    If msg = WM_GETMINMAXINFO Then
      CopyMemory ByVal lParam, MinMax, LenB(MinMax)
    End If

[vb6] Go to web page or send an e-mail

It is very simple to enable links to web pages in your application or have the user send you an e-mail by clicking on your e-mail address, displayed in a label, for example. Just call the DoWebLink sub below, passing the startup form of your app and a link. The link may be a web-link, like http://www.santa-claus.gl/ or a mail address, like "mailto:SantaClaus@Santaorg.gl". You can make the link more browser-like by displaying it in a blue color and display the hand cursor when the mouse is hovering over it. The cursor can be found under the name h_point.cur on your VB CD-rom.

    Private Const SW_SHOWNORMAL& = 1
    Private 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)
    
    Public Sub DoWebLink(MainForm As Form, sLink As String)
      Dim r As Long
      If 33 > ShellExecute(MainForm.hwnd, "open", sLink, vbNullString, _
          vbNullString, SW_SHOWNORMAL) Then
        'raise an error
      End If
    End Sub

[vb6] Disable default popups

Some controls, such as the intrinsic textbox control, display their own popupmenus, thereby effectively excluding you from displaying your own popup (it looks awkward if the default menu displays, followed by your custom menu). You can disable the default menu by disabling the control, as in the code below. The only disadvantage is that the control displays its disabled state while the custom menu is on - that may be confusing to the user. By using the LockWindowUpdate API, the control never gets a chance to display its disabled state. If the control name is "Text1" and the name of the custom menu is "MyPopUpMenu":

    Private Declare Function LockWindowUpdate Lib "user32" _
        (ByVal hwndLock As Long) As Long
    
    Private Sub Text1_MouseDown(Button As Integer, Shift As Integer, _
       X As Single, Y As Single)
       
       If Button = vbRightButton Then
          ' Avoid the 'disabled' gray text by locking updates
          LockWindowUpdate Text1.hWnd
          ' A disabled TextBox will not display a context menu
          Text1.Enabled = False
          ' Give the previous line time to complete
          DoEvents
          ' Display own context menu
          PopupMenu MyPopUpMenu
          ' Enable the control again
          Text1.Enabled = True
          ' Unlock updates
          LockWindowUpdate 0&
        End If
    End Sub

[vb6] Get the decimal separator and digit grouping symbol

To obtain the current user's settings for the decimal separator and digit grouping symbol, use the GetLocaleInfo function. You can use the same method to retrieve a slurry of other useful information, such as the names of months and days, language, currency format etc.

    Private Const LOCALE_USER_DEFAULT& = &H400
    Private Const LOCALE_SDECIMAL& = &HE
    Private Const LOCALE_STHOUSAND& = &HF
    Private Declare Function GetLocaleInfo& Lib "kernel32" Alias _
        "GetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, _
        ByVal lpLCData As String, ByVal cchData As Long)
    
    Private Function ThousandSeparator() As String
      Dim r As Long, s As String
      s = String(10, "a")
      r = GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_STHOUSAND, s, 10)
      ThousandSeparator = Left$(s, r)
    End Function
    
    Private Function DecimalSeparator() As String
      Dim r As Long, s As String
      s = String(10, "a")
      r = GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_SDECIMAL, s, 10)
      DecimalSeparator = Left$(s, r)
    End Function

[vb6] Generic control handling procedure

Sometimes it is useful to perform a certain action or set a certain property for all the controls of a certain type on a form. Say you needed to disable all controls of a certain type:

    Private Sub DisableControls(Frm As Form, CtrlTypeName As String)
      Dim nCount As Integer
      For nCount = 0 To Frm.Controls.Count - 1
        If TypeName(Frm.Controls(nCount)) = CtrlTypeName Then
          Frm.Controls(nCount).Enabled = False
        End If
      Next
    End Sub

Of course, the actual modification(s) done to the controls inside the loop can be anything, as long as the methods and properties are defined for the type of control that you pass. Use of the function would be something like: DisableControls Me, "TextBox"
That would disable all TextBoxes on the form.

[vb6] Use the RtlMoveMemory API function to copy data

Certain API functions return pointers to memory, that are of little use in VB where there is no intrinsic way of handling direct memory copy or accessing the variable pointed to directly. You can use the following function to copy bytes to a VB variable:

    Private|Public Declare Sub CopyBytes Lib "kernel32" _
        Alias "RtlMoveMemory" (Destination As Any, _
        Source As Any, ByVal ByteLen As Long).

If the memory address is given as the value of a variable, pass it ByVal, otherwise pass the address of a variable indirectly by passing the variable ByRef. For example, having obtained some pointer from an API function and holding that pointer in variable MyPointer:

    Dim Barray(bLen) as byte
    CopyBytes Barray(0), ByVal MyPointer, bLen

You need to determine bLen - the number of bytes to copy - beforehand.

[vb6] VarType function determines what is contained in a variant

The VB VarType function is the way for determining what type of data is contained in a variant variable, if it is an array and of which type. For example:

    Dim Barray(20) As Byte
    Dim MyVariant as Variant
    MyVariant = Barray
    Return = VarType(MyVariant)

"Return" turns out to be equal to vbArray Or vbByte.

[vb6] Use variants for passing arrays to and from classes

An array can be packed in a single variable of type variant. This goes for arrays of any datatype except user-defined types and fixed-length strings. The variant can then be passed to and from functions and subs, e.g.
In a calling procedure:

    Dim B(20) as Byte
    Dim V as Variant
    V = B
    'Call the sub "MySub"
    MySub (V)
    '-----------------
    'In MySub:
    Dim Bb() as Byte
    Dim Vb as Variant
    Bb = Vv
    'The Bb array is redimensioned automatically. 

Similarly, the variant can be passed back in the form of function result.

[vb6] Use the IS operator to compare objects

With ordinary variables you would use the = operator to compare different variables. This does not work with object variables. Instead you have to use the IS operator, e.g.:

    Dim MyObject as MyClass
    Dim MyOtherObject as MyClass
  
    Set MyObject = New MyClass
    Set MyOtherObject = MyObject
  
    'Now, the two object variables reference the same object. 
  
    If MyOtherObject Is MyObject Then
      'The message box should pop up:
      MsgBox "Yes, MyObject points to the same object as MyOtherObject and vice versa" 
    End If 

The IS operator must be used within an If - Then statement.

[vb6] Correct use of the Dir function

The Visual Basic Dir function is used to test if a certain file exists in a given directory. The Help topic in VB for the function states the function declaration: Dir[(pathname[, attributes])] The help topic incorrectly states that if the "attributes" parameter is omitted, all files are returned that match "pathname". In fact, if a file is flagged as Hidden, it will not be found by the Dir function, when no attributes are supplied to the function. Correct search for all files irrespective of their flags is therefore: Dir(pathname, vbNormal Or vbHidden Or vbSystem Or vbReadOnly)

[vb6] Disabling user input in combobox

If you don't want the user to be able to modify or delete text in the textbox part of a combobox control, you can set its style to 2 - dropdown list. However, in doing so, you also disable your own ability to do the same, because the text property is read-only at runtime. This means that if the style is set to 2 you cannot set the text property in code and you cannot link the combo box to a database either, because scrolling the database alters the textbox property. The solution is simple: Set the style to 0 - dropdown combo, its locked property to false and add the following to the combobox code:

    Private Sub Combo1_KeyDown(KeyCode As Integer, Shift As Integer)
      If KeyCode <> vbKeyUp And KeyCode <> vbKeyDown Then
        Combo1.Locked = True 
      End If
    End Sub 
    
    ' The up-down arrow keys must be allowed to enable
    ' mouse-less users to scroll the list. 
    ' Unlock the combobox again on key up events: 
    Private Sub Combo1_KeyUp(KeyCode As Integer, Shift As Integer)
      Combo1.Locked = False 
    End Sub 

[vb6] Read the computer name and current user name

These functions may be used to retrieve the computer name and the name of the current user (or at least the names as they are known to the operating system).

    Private Declare Function GetComputerName& Lib "kernel32" Alias _
        "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long)
    Private Declare Function GetUserName& Lib "advapi32.dll" Alias _
        "GetUserNameA" (ByVal lpBuffer As String, nSize As Long)
    
    Private Function ComputerName() As String
      Dim s As String, l As Long
      l = 15
      s = String(l, Chr(32))
      GetComputerName s, l
      ComputerName = Left$(s, l)
    End Function
    
    Private Function UserName() As String
      Dim s As String, l As Long
      l = 255
      s = String(l, Chr(32))
      GetUserName s, l
      UserName = Left$(s, l)
    End Function

[vb6] Get the current color depth

If you are displaying graphics, you might like to learn the current color depth - true-color bitmaps generally don't look good on 256-color screens. The ColorDepth function returns the color depth as a bits per pixel number, for example on a true-color display the function will return 24. The function obtains a screen dc because the GetDeviceCaps function needs a dc for input.

    Private Const PLANES& = 14
    Private Const BITSPIXEL& = 12
    Private Declare Function GetDeviceCaps& Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long)
    Private Declare Function GetDC& Lib "user32" (ByVal hwnd As Long)
    Private Declare Function ReleaseDC& Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long)
    
    Private Function ColorDepth() As Integer
      Dim nPlanes As Integer, BitsPerPixel As Integer, dc As Long
      dc = GetDC(0)
      nPlanes = GetDeviceCaps(dc, PLANES)
      BitsPerPixel = GetDeviceCaps(dc, BITSPIXEL)
      ReleaseDC 0, dc
      ColorDepth = nPlanes * BitsPerPixel
    End Function

[vb6] Convert global variables to global properties

You should consider removing all your global variables and implement them as private variables in a BAS module instead. Then, you can declare global property procedures in the BAS module to manipulate the private variables. This way, you can do parameter validation in the property let procedure.

[vb6] Make form stay on top

Sometimes you need a form to stay on top, even when another form has focus, so that its immediately available to the user. This code toggles the OnTop state for a form when passed the hwnd property of a form:

    Private Const GW_HWNDFIRST& = 0
    Private Const HWND_NOTOPMOST& = -2
    Private Const HWND_TOPMOST& = -1
    Private Const SWP_NOMOVE& = &H2
    Private Const SWP_NOSIZE& = &H1
    Private Declare Function GetWindow& Lib "user32" _
        (ByVal hwnd As Long, ByVal wCmd As Long)
    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)
    
    Private Sub ToggleTopmost(ByVal hWindow As Long)
      Dim hw As Long
      hw = GetWindow(hWindow, GW_HWNDFIRST)
      If hw = hWindow Then
        SetWindowPos hWindow, HWND_NOTOPMOST, 0, 0, 0, 0, _
            SWP_NOMOVE Or SWP_NOSIZE
      Else
        SetWindowPos hWindow, HWND_TOPMOST, 0, 0, 0, 0, _
            SWP_NOMOVE Or SWP_NOSIZE
      End If
    End Sub

[vb6] Enable Form move anywhere

If a form has a title bar, the user can move it by pressing the left mouse button on the title bar and then move the window. However, if the form doesn't have a title bar, it cannot be moved. The sub listed below enables movement of a form, irrespective of its style. Typically, you would call this sub when the user presses the left mouse button on the form and possibly also when he presses the same button on contained controls. The sub works by faking a WM_NCLBUTTONDOWN message to be sent to the form window procedure.

    Private Const HTCAPTION& = 2
    Private Const WM_NCLBUTTONDOWN& = &HA1
    Private Declare Function SendMessageBynum& Lib "user32" _
        Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
        ByVal wParam As Long, ByVal lParam As Long)
    Private Declare Function ReleaseCapture& Lib "user32" ()
    
    Public Sub StartMove(frm As Form)
      ReleaseCapture
      SendMessageBynum frm.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0
    End Sub

[vb6] Convert system colors

Color values are specified in Visual Basic using the OLE_COLOR type. The colors come in two flavors; either true RGB values or the system colors with values above &H80000000. When using Visual Basic functions that take color parameters, VB will convert the system colors to their real value for you. However, Windows API functions don't understand the system values, so you will have to convert them manually. One way to do this is to use the OleTranslateColor function. If you convert a real color, i.e. below &H80000000, the function simply returns the same value, but for system colors, it will return a value that can be used as color parameter in an API call.

    Private Declare Function TranslateColor Lib "olepro32.dll" _
        Alias "OleTranslateColor" (ByVal clr As OLE_COLOR, _
        ByVal palet As Long, col As Long) As Long
    
    Private Function GetRealColor(ByVal Color As OLE_COLOR) As Long
      Dim R As Long
      R = TranslateColor(Color, 0, GetRealColor)
      If R <> 0 Then 'raise an error
      End If
    End Function

[vb6] Get the reference count on a VB Class object

The reference count on COM objects, including VB Class objects, are managed by Visual Basic and there is normally no reason to know about it. However, when debugging code involving class objects, it is often useful to read the reference count on an object. The function below returns the reference count, and uses the CopyMemory API and the hidden VB function ObjPtr to retrieve the address of the class object.

    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
        (dest As Any, src As Any, ByVal nbytes As Long)
    
    Private Function GetRefCount(obj As IUnknown) As Long
      If obj Is Nothing Then Exit Function
      CopyMemory GetRefCount, ByVal (ObjPtr(obj)) + 4, 4
      GetRefCount = GetRefCount - 2
    End Function

[vb6] Undo the last user action on a Textbox control

Visual Basic lets the user undo his last editing on a textbox control via the Undo item on the Textbox popupmenu, but does not give the developer access to the same functionality. The procedure below does:

    Private Declare Function SendMessageBynum& Lib "user32" Alias "SendMessageA" _
        (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
        ByVal lparam As Long)
    Private Const EM_UNDO = &HC7&
    
    Private Sub TextUndo(T As TextBox)
      SendMessageBynum T.hwnd, EM_UNDO, 0, 0
    End Sub

[vb6] Set the margins of a Textbox control

The VB Textbox control superclasses the Windows Edit window class, but doesn't implement its margin property. This procedure sets the left and right margins of a textbox control at run-time, with the margins measured in pixels.

    Private Declare Function SendMessageBynum& Lib "user32" Alias "SendMessageA" _
        (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
         ByVal lparam As Long)
    Private Const EC_LEFTMARGIN& = &H1&
    Private Const EC_RIGHTMARGIN& = &H2&
    Private Const EM_SETMARGINS = &HD3&
    
    Private Sub SetTextMargin(T As TextBox, ByVal mLeft As Integer, ByVal mRight As Integer)
      Dim lparam As Long
      lparam = mLeft + mRight * &H10000
      SendMessageBynum T.hwnd, EM_SETMARGINS, EC_LEFTMARGIN Or EC_RIGHTMARGIN, lparam
    End Sub

[vb6] Make the toolbar buttons flat

If you have Visual Basic 6, you have the option of creating a toolbar with flat-style buttons. If you have earlier versions of VB, you'll have to do it yourself, like this:

    Public Declare Function FindWindowEx& Lib "user32" Alias "FindWindowExA" _
        (ByVal hWndParent As Long, ByVal hWndChildAfter As Long, _
         ByVal lpClassName As String, ByVal lpWindowName As String)
    Public Declare Function SendMessageBynum& Lib "user32" Alias "SendMessageA" _
        (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
         ByVal lParam As Long)
    Public Const WM_USER& = &H400
    Public Const TBSTYLE_FLAT& = &H800
    Public Const TB_SETSTYLE& = (WM_USER + 56)
    Public Const TB_GETSTYLE& = (WM_USER + 57)
    Public Const TBCLASSNAME = "ToolbarWindow32"
    
    'Make a toolbar flat style
    Public Sub MakeFlat(Tb As Toolbar)
    
      Dim Style&, TbHandle&
    
      TbHandle = FindWindowEx(Tb.hwnd, 0&, TBCLASSNAME, vbNullString)
      If TbHandle = 0 Then Debug.Print "Error"
      
      Style = SendMessageBynum(TbHandle, TB_GETSTYLE, 0&, 0&)
      Style = Style Or TBSTYLE_FLAT
      
      Call SendMessageBynum(TbHandle, TB_SETSTYLE, 0, Style)
    
    End Sub

[vb6] Modify the styles for a window

Some style and extended style bits have no counterpart in VB properties for forms and control windows and hence cannot be set in Visual Basic, but it may be possible to change the style at run-time after the window has been created. Use the ModifyStyle and ModifyStyleEx functions to remove and / or add style bits to the window style or window extended style, respectively. Note that changing these bits will often have no effect in Visual Basic - you have to experiment to find out which modifications work and which do not.

    Private Const GWL_EXSTYLE& = (-20)
    Private Const GWL_STYLE& = (-16)
    Private Declare Function GetWindowLong& Lib "user32" Alias "GetWindowLongA" _
        (ByVal hwnd As Long, ByVal nIndex As Long)
    Private Declare Function SetWindowLong& Lib "user32" Alias "SetWindowLongA" _
        (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long)

    Public Sub ModifyStyle(ByVal hWindow As Long, _
        ByVal Remove As Long, ByVal Add As Long)

      Dim style As Long, OldStyle As Long
      OldStyle = GetWindowLong(hWindow, GWL_STYLE)
      style = (OldStyle And (Not Remove)) Or Add
      SetWindowLong hWindow, GWL_STYLE, style

    End Sub

    Public Sub ModifyStyleEx(ByVal hWindow As Long, _
        ByVal Remove As Long, ByVal Add As Long)

      Dim xstyle As Long, OldStyle As Long
      OldStyle = GetWindowLong(hWindow, GWL_EXSTYLE)
      xstyle = (OldStyle And (Not Remove)) Or Add
      SetWindowLong hWindow, GWL_EXSTYLE, xstyle

    End Sub

For example, to remove the maximize and minimize buttons from a form and make it transparent, you will use the above functions like this:

    ModifyStyle hwnd, WS_MAXIMIZEBOX Or WS_MINIMIZEBOX, 0
    ModifyStyleEx hwnd, 0, WS_EX_TRANSPARENT

[vb6] Get value of a hexadecimal string expression

You can convert a numeric value to a hexadecimal string expression using the Hex$ function, but how do you do it the other way round ? Believe it or not, this simple function will do the trick:

    Public Function HxVal(s As String) As Long
      HxVal = CLng("&H" & s)
    End Function

[vb6] Extract red, green or blue component from color value

The individual color components of an RGB value held in a long can be extracted with some bit manipulation to give values in the range 0 to 255:

    Private Function Red&(ByVal Color&)
      Red = Color And (Not &HFFFFFF00)
    End Function
    Private Function Green&(ByVal Color&)
      Green = (Color And (Not &HFFFF00FF)) \ &H100&
    End Function
    Private Function Blue&(ByVal Color&)
      Blue = (Color And (Not &HFF00FFFF)) \ &HFFFF&
    End Function

[vb6] Extract WORD from DWORD

When working with API functions, there is frequently a need to extract the low WORD (i.e. bits 0 to 15) or the high WORD (i.e. bits 16 to 31) from a DWORD (usually held in a VB Long variable). The sub below extracts both values and return them as Longs. If you need only one of these values, you can make a LoWord or HiWord function from the sub.

    Public Sub SplitDword(ByVal Dword As Long, HiWord%, LoWord%)
      HiWord = (Dword And (Not &HFFFF&)) \ &HFFFF&
      LoWord = Dword And &HFFFF&
    End Sub