Visual Basic 6.0 Tips

Capitalizing the First Letter of Each Word in a String

   Dim sNew as String
   Dim sOld as String
   
   sNew = StrConv$(sOld, vbProperCase)

Determining if Your App is Already Running

   If App.PrevInstance Then
      Msgbox "Application already running"
      End
   End If

Creating a Desktop Shortcut to a Web Site

   Dim sUrl As String
   Dim sFile As String
   Dim lFile As Long
                               
   lFile = FreeFile
   sUrl = "URL=http://www.TheScarms.com"
   '
   ' See my shell link program to determine the desktop path.
   '
   sFile = "C:\Windows\desktop\TheScarms.url"
   
   Open sFile For Output As lFile
   Print #lFile, "[InternetShortcut]"
   Print #lFile, sUrl

Give Users More Icons With Your App
Resource files expose any contained icons to Windows. By adding a resource file containing icons to your application and compiling, the user can select any of those icons to display in a shortcut to your application.

Can't Create What Object
Ever get this error (error 429) and wonder what object? Use this code to wrap your calls to CreateObject. It will return the name of the object that could not be created.

   Public Function fCreateObject(sID as String) as Object
       On Error Goto ErrHhandler
       Set fCreateObject = VBA.CreateObject(sID)
       Exit Function
                                
       ErrHandler:
       Err.Raise Err.Number, "fCreateObject", Err.Description & ": '" & sID & "'"
   End Function

Create a VB Add-In to Close all Open Windows in the VB IDE
You can create a VB Add-In to close all the open windows in the VB development environment with a single click. Open a new VB project of type Add-In. Enter this code in the load event of frmAddIn. Press F2 to open the Object Browser, highlight the Connect class, right click it, and edit the Description field to change the name and description of your add-in. Also, search the entire project and replace all occurrences of "My Add-In" with whatever you decide to call it. Change the project's properties as desired. Make the DLL then you can add your add-in from the Add-In Manager.

   Dim w As Window
                               
   For Each w In VBInstance.Windows
      If (w.Type = vbext_wt_CodeWindow Or _
          w.Type = vbext_wt_Designer) And _
          w.Visible Then
       
          w.Close
      End If
   Next

A Better DoEvents
Putting DoEvents in loops to make your app responsive to user input is a common but expensive practice. Use GetInputState instead. GetInputState returns 1 when a mouse is clicked or key pressed. It has much less overhead and can be called every so often as need be. When an input event occurs, then call DoEvents.

   Private Declare Function GetInputState Lib "user32" () As Long
   
   Dim bUserCancel As Boolean
   
   Private Sub cmdCancel_Click()
      bUserCancel = True
   End Sub

   Private Sub cmdGo_Click()
      Dim lCtr As Long
      bUserCancel = False
      For lCtr = 0 To 1000000
         '
         ' A long loop that may need to be interupted.
         '
         If lCtr Mod 100 Then
            If GetInputState() <> 0 Then
               '
               ' A mouse or keyboard event occured.
               '
               DoEvents
               If bUserCancel Then Exit For
            End If
         End If
      Next
   End Sub

Center a Form Accounting for the Taskbar and Other Appbars
Center your forms based on the actual portion of the screen that is exposed. This method takes into account Window's taskbar and any other appbars such as toolbars that are docked to the edge of the screen.

   Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
   Private Const SM_CXFULLSCREEN = 16
   Private Const SM_CYFULLSCREEN = 17
                                
   Private Sub Form_Load()
      Dim lLeft As Long
      Dim lTop As Long
   
      With Me
         lLeft = (Screen.TwipsPerPixelX * _
                 (GetSystemMetrics(SM_CXFULLSCREEN) / 2)) - (.Width / 2)
                 
         lTop = (Screen.TwipsPerPixelY * _
                 (GetSystemMetrics(SM_CYFULLSCREEN) / 2)) - (.Height / 2)
         .Move lLeft, lTop
      End With
   End Sub

Use System Icons on your Forms
Extract the standard system icons to use on your forms to make them look like typical Window's message boxes.

   Private Enum StandardIconEnum
      IDI_ASTERISK = 32516&
      IDI_EXCLAMATION = 32515&
      IDI_HAND = 32513&
      IDI_QUESTION = 32514
   End Enum

   Private Declare Function LoadStandardIcon Lib "user32" _
      Alias "LoadIconA" (ByVal hInstance As Long, _
      ByVal lpIconNum As StandardIconEnum) As Long
                                
   Private Declare Function DrawIcon Lib "user32" _
      (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, _
      ByVal hIcon As Long) As Long

Call this code:

   Dim lIcon As Long
   Me.Cls
   lIcon = LoadStandardIcon(0&, lstIcon.ItemData(lstIcon.ListIndex))
   Call DrawIcon(Me.hdc, 10&, 10&, lIcon)

Load Textbox With More Than 64K of Data
Get past the 64K limit imposed on the contents of a textbox with the SendMessage API. Note that this will work only in NT and Win2K.

   Private Const WM_SETTEXT = &HC
   Private Const WM_GETTEXT = &HD
   Private Const WM_GETTEXTLENGTH = &HE

   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 Declare Function GetWindowTextLength Lib "user32" _
      Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long

Add a multi line textbox to your form. In form_load call this code:

   Dim lret As Long
   Dim s As String

   s = String(9000, "X")
   Me.Show
   lRet = SendMessage(txtlarge.hwnd, WM_SETTEXT, 0&, ByVal s)
   Debug.Print "WM_SETTEXT: " & lRet
   
   lRet = SendMessage(txtlarge.hwnd, WM_GETTEXTLENGTH, 0&, ByVal 0&)
   Debug.Print "WM_GETTEXTLENGTH: " & lRet

In form_resize call this code:

   txtlarge.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight

Clear Structures With One Assignment
You can quickly clear a user defined type without setting each subvariable.

   Private Type udtType
      SubVariable1 As Integer
      SubVariable2 As String
      SubVariable3 As Long
   End Type
   '
   ' Dim variables of this type.
   '
   Dim TypeVar1 As udtType
   Dim TypeVar2 As udtType
   '
   ' A method in a class which clears the structure variable.
   '
   Private Sub ClearData()
      Dim EmptyVar As udtType

      TypeVar1 = EmptyVar
      TypeVar2 = EmptyVar
   End Sub

Get the Relative Path Between 2 Folders

   Private Function GetRelativePath(ByRef strRelativepath As String, _
      ByVal strPathFrom As String, ByVal strPathTo As String) As

      Boolean Dim blnResult As
      Boolean Const MAX_PATH = 260 
      strRelativepath = Space$(MAX_PATH)
      ' 
      ' Set dwAttr... to vbDirectory for directories, or 0 for files.
      '
      blnResult = PathRelativePathToW(StrPtr(strRelativepath), _
            StrPtr(strPathFrom), vbDirectory, StrPtr(strPathTo), 0)

      If blnResult Then
         strRelativepath = Left(strRelativepath, 
         InStr(strRelativepath, vbNullChar) - 1)
      Else
         strRelativepath = ""
      End If

      GetRelativePath = blnResult
   End Function

   Private Sub Command1_Click()
      Dim strRelativepath As String

      If GetRelativePath(strRelativepath, "c:\temp", "c:\windows") Then
         Debug.Print strRelativepath
      Else
         Debug.Print "Error"
      End If
   End Sub

Copy Large Arrays Faster
You can copy arrays much faster with a simple API call:

   Private Declare Sub CopyMemory Lib "kernel32" _
         Alias "RtlMoveMemory" (Dest As Any, _
         Source As Any, ByVal Length As Long)
                                
   Private Sub CopyArray()
      Dim lngbytes As Long
      Dim lngSrc(1 To 600000) As Long
      Dim lngDest(1 To 600000) As Long
      '
      ' Number of bytes equals number of array
      ' elements times the element length.
      '
      lngbytes = (UBound(lngSrc) - LBound(lngSrc) + 1) * Len(lngSrc(1))
      '
      ' Copy the array passing the address of the start to
      ' the destination and source arrays and the length
      ' of the arrays.
      '
      Call CopyMemory(lngDest(LBound(lngDest)), lngSrc(LBound(lngSrc)), lngbytes)
   End Sub

About TheScarms
About TheScarms


Sample code
version info

If you use this code, please mention "www.TheScarms.com"

Email this page


© Copyright 2016 TheScarms
Goto top of page