[vb6] How to change the Color of a command button, or show a picture on it?

---

In order to be able to change the BackColor property of a command button you must also set Style property of the button to "Graphical" as shown below. If you don't then you will not see any difference in the color of the button. A similar effect is also true for the the Picture property.




The reason for this behaviour is that "Standard" means the button will be shown in the normal Windows style (no picture, and a standard color for all programs) instead of having the full graphical functionality that VB's command button provides.

Once the style has been set to "Graphical" you can set the backcolor or picture in the properties window.

[vb6] Open Any Type Of File With Its Associated Window's Program

You simply want to be able to press a command button, which will trigger a file (e.g. "c:\media\mysong.mp3"), to be opened with by its associated application (e.g. "Media Player") just as what would happen if I went to the file in windows explorer, and double clicked it.

1. Create module modTools as following:

Attribute VB_Name = "modTools"
'*******************************************************************************
' Name        : modTools
' Author      : Chandra Gunawan
' Date        : 22-Jul-2009
' Description : Tools Library
'
' Maintenance Log
' ==============================================================================
' Date         ID   Description
' ------------------------------------------------------------------------------
'*******************************************************************************

Option Explicit

'==============================================================================
' CONSTANTS & VARIABLES DEFINITION
'==============================================================================
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) As Long

Private Const SW_SHOWNORMAL = 1

'------------------------------------------------------------------------------
' Name        : OpenFile
' Author      : Chandra Gunawan
' Date        : 13-Aug-2009
' Description : Open any type of file with its associated window's program
'------------------------------------------------------------------------------
Public Function OpenFile(ByVal pForm As Form, ByVal pFilePath$) As Long
  OpenFile = ShellExecute(pForm.hwnd, "open", pFilePath, vbNullString, vbNullString, SW_SHOWNORMAL)
End Function  'OpenFile

2. Execute OpenFile function inside your button's click-event

Private Sub Command1_Click()
  Call OpenFile(Me, "c:\media\mysong.mp3")
End Sub

[vb6] How to create list of same items?

Suppose you want this result:

    abc,abc,abc,abc,abc

But you don't want to create it in the Do or For loop. So you can use the following syntax:

    Mid(Replace(5, "~"), "~", ",abc"), 2)

[vb6] How to hide the grid from Report Designers?

Open the source code (file with .Dsr extension) using the Notepad, then update the value of _Setting property under the Designers module become 28.

[vb6] Get object reference by its name in a form

In some cases you might want to activate an object in a form by given its name. To get it, you can use the controls collection of the form object:

  Private Sub Form_Load()
    MsgBox GetCtlByName(Me, "Label1").Caption
  End Sub

  Private Function GetCtlByName( _
          ByVal pForm As Form, _
          ByVal pName$, _
          Optional ByVal pIndex% = -1) As Control

    On Error GoTo PROC_ERR

    If pIndex < 0 Then
      Set GetCtlByName = pForm.Controls(pName)
    Else
      Set GetCtlByName = pForm.Controls(pName, pIndex)
      If pIndex <> GetCtlObj.Index Then GoTo PROC_ERR
    End If

    Exit Function

  PROC_ERR:
    Set GetCtlByName = Nothing
    MsgBox "Error in procedure GetCtlByName for item name = '" & pName & "'.", vbExclamation
  End Function 'GetCtlByName

[vb6] Shuting down/Unload form in Form_Load event

You are doing some validation code in the Form_Load event. If that validation
code fails, then you do not want to show the form. If you call "Unload ME", you will get an error in the form that called ".Show" of the form loading, saying that the form is already unloaded.

  Private mbCancelForm As Boolean

  Private Sub Form_Activate()
    If mbCancelForm = True Then Unload Me
  End Sub

  Private Sub Form_Load()
    mbCancelForm = False

    If {SomeCondition} = True Then
      MsgBox "False condition, unable to load the form", vbExclamation + vbOKOnly
      mbCancelForm = True
    End If
  End Sub

[vb6] Convert formatted string into numeric

The function below is used to convert formatted string that produced by Format() function into numeric value (Double datatype). This function will remove all non-numeric string except minus and decimal delimiter.

Create new module and paste the source below inside your module file (.bas).

  '****************************************************************************
  ' Name        : StrToNumeric
  ' Author      : Chandra Gunawan
  ' Date        : 22-Jan-2009
  ' Description : Convert formatted string into numeric
  '****************************************************************************
  Public Function StrToNumeric( _
         ByVal pString As String, _
         Optional ByVal pDecimalDelimiter As String) As Double
         
    Dim I%, J%, strVal$
    
    If pDecimalDelimiter <> "." And pDecimalDelimiter <> "," Then
      pDecimalDelimiter = Trim(Format(0, "#.#"))
    End If
    
    'Remove all non-numeric except dot and comma
    For I = 1 To Len(pString)
      If InStr(1, "-0123456789" & pDecimalDelimiter, Mid(pString, I, 1)) > 0 Then
        strVal = strVal & Mid(pString, I, 1)
      End If
    Next
    
    'Remove unused delimiter
    J = Len(strVal) - Len(Replace(strVal, pDecimalDelimiter, ""))
    If J > 1 Then
      strVal = Replace(strVal, pDecimalDelimiter, "", 1, J - 1)
    End If
    
    'Replace to proper decimal delimiter
    If strVal = "" Or strVal = "." Then strVal = "0"
    StrToNumeric = CDbl(Replace(strVal, pDecimalDelimiter, "."))
  End Function  'StrToNumeric

[vb6] Numeric input mask for Textbox

Place the 2 Textbox objects in your form with name Textbox1 and Textbox2.
And then paste the code below into your .frm file.

  Private Sub Text1_KeyPress(KeyAscii As Integer)
    Call KeyPressNumeric(KeyAscii)
  End Sub

  Private Sub Text2_KeyPress(KeyAscii As Integer)
    Call KeyPressNumeric(KeyAscii, True, Text2.Text, True, Text2.SelStart)
  End Sub

  Private Sub Text1_GotFocus()
    Text1.Text = Replace(Replace(Text1.Text, ",", ""), ".", "")
  End Sub

  Private Sub Text1_LostFocus()
    Text1.Text = Format(Text1.Text, "###,###,##0")
  End Sub

  Private Sub Text2_GotFocus()
    Text2.Text = Replace(Replace(Text2.Text, ",", ""), ".", "")
  End Sub

  Private Sub Text2_LostFocus()
    Text2.Text = Format(Text2.Text, "###,###,##0.00")
  End Sub

Create new module and place the code below inside your module file (.bas).

  '****************************************************************************
  ' Name        : KeyPressNumeric
  ' Author      : Chandra Gunawan
  ' Date        : 22-Jan-2009
  ' Description : For use with Textbox_KeyPress events
  '               Allows only numeric entries
  ' Note        : If you set pAllowDecimal = True
  '                 then you must set pTextBox_Text = TextBox.Text
  '               If you set pAllowMinus = True
  '                 then you must set pTextbox_SelStart = TextBox.SelStart
  '*****************************************************************************
  Public Sub KeyPressNumeric( _
         pKeyAscii As Integer, _
         Optional pAllowDecimal As Boolean = False, _
         Optional pTextBox_Text As String, _
         Optional pAllowMinus As Boolean = False, _
         Optional pTextbox_SelStart As Long = 0)

    Dim strDecDlm As String

    'Note: 8=backspace, 13=enter, 27=escape
    strDecDlm = Trim(Format(0, "#.#"))
    If Chr(pKeyAscii) = strDecDlm Then
      If Not pAllowDecimal Or InStr(1, pTextBox_Text, strDecDlm) > 0 Then pKeyAscii = 0
    ElseIf Chr(pKeyAscii) = "-" Then
      If Not pAllowMinus Or pTextbox_SelStart <> 0 Then pKeyAscii = 0
    ElseIf InStr(1, "0123456789", Chr(pKeyAscii)) < 1 And _
           Not (pKeyAscii = 8 Or pKeyAscii = 13 Or pKeyAscii = 27) Then
      pKeyAscii = 0
    End If
  End Sub  'KeyPressNumeric

[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.