Funfani.com - Spreading Fun All Over!

Visual Basic [ T I P S ]

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