[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