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
|