Visual Basic Tips and Tricks

	VB Tips and Tricks
1	SORTING AN ARRAY Public Function SortArray(intTheArray() As Integer) As Integer() Dim blnSorted As Boolean Dim intTemp As Integer Dim X As Integer blnSorted = False Do While Not blnSorted blnSorted = True For X = 0 To UBound(intTheArray) - 1 If intTheArray(X) > intTheArray(X + 1) Then intTemp = intTheArray(X + 1) intTheArray(X + 1) = intTheArray(X) intTheArray(X) = intTemp blnSorted = False End If Next X Loop SortArray = intTheArray() End Function
2	INSERTING A DELAY API: Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Sub Delay(ByVal nSecond As Long) Sleep (nSecond) End Sub
3	ALLOW KEYING IN OF ONLY HEX CHARACTERS In the KeyPress event of the text box, use the KeyAscii value to check for hex characters. Private Sub txtData_KeyPress(KeyAscii As Integer) On Error GoTo ErrtxtData_KeyPress KeyAscii = OnlyHex(KeyAscii) Exit Sub ErrtxtData_KeyPress: errMsg End Sub Public Function OnlyHex(KeyAscii As Integer, Optional strValidString As Variant) As Integer On Error GoTo ErrOnlyDigits Dim StrValid As String If IsMissing(strValidString) Then StrValid = "1234567890ABCDEFabcdef" Else StrValid = strValidString End If If KeyAscii > 26 Then If InStr(StrValid, ChrW$(KeyAscii)) = 0 Then Beep OnlyHex = 0 Else OnlyHex = KeyAscii End If Else OnlyHex = KeyAscii End If Exit Function ErrOnlyDigits: MsgBox "Error", vbInformation, "Error" End Function
4	ALLOW ONLY NUMERIC DIGITS TO BE KEYED In the KeyPress event of the text box, use the KeyAscii value to check for numeric characters. Private Sub txtData_KeyPress(KeyAscii As Integer) On Error GoTo ErrtxtData_KeyPress KeyAscii = OnlyHex(KeyAscii) Exit Sub ErrtxtData_KeyPress: errMsg End Sub Public Function OnlyDigits(KeyAscii As Integer, Optional strValidString As Variant) As Integer On Error GoTo ErrOnlyDigits Dim StrValid As String If IsMissing(strValidString) Then StrValid = "1234567890." Else StrValid = strValidString End If If KeyAscii > 26 Then If InStr(StrValid, ChrW$(KeyAscii)) = 0 Then Beep OnlyDigits = 0 Else OnlyDigits = KeyAscii End If Else OnlyDigits = KeyAscii End If Exit Function ErrOnlyDigits: MsgBox "Error", vbCritical, "Error" ' End Function
5	LEFT SHIFT Public Function LShift(w As Long, c As Integer) As Integer Dim lngShifted As Long lngShifted = w * (2 ^ c) If lngShifted < -32768 Then lngShifted = lngShifted + 65536 LShift = Val("&h" & Hex$((&HFFFF And lngShifted))) End Function
6	RIGHT SHIFT Public Function RShift(ByVal lThis As Long, ByVal lBits As Long) As Long If (lBits <= 0) Then RShift = lThis ElseIf (lBits > 63) Then RShift = 0 Exit Function ' ... error ... ElseIf (lBits > 31) Then RShift = 0 Else If (lThis And m_lPower2(31)) = m_lPower2(31) Then RShift = (lThis And &H7FFFFFFF) \ m_lPower2(lBits) Or m_lPower2(31 - lBits) Else RShift = lThis \ m_lPower2(lBits) End If End If RShift = GetLoWord(RShift) End Function
7	ROUNDING NUMBERS Function Round(X As Double, DP As Integer) As Double Round = Int((X * 10 ^ DP) + 0.5) / 10 ^ DP End Function
8	UNLOADING ALL FORMS IN A VB6 PROJECT Public Sub UnloadForms() Dim frm As Form For Each frm In Forms Select Case UCase$(frm.Name) Case names of forms you dont what to close Case Else Set frm = Nothing End Select Next End Sub
9	CHECK IF A FILE EXISTS Public Function FileExists(FullPathAndFile$) As Boolean On Error GoTo ErrHandler Call FileLen(FullPathAndFile) ErrHandler: If err = 0 Then FileExists = True End Function
10	PRINTING TO A FILE Public Sub Print_To_File(strFileName, Optional strDetails As String) Dim iFile As Integer Screen.MousePointer = vbHourglass strPrint = GetPrintInfoIntoArray iFile = FreeFile If Len(Trim$(strFileName)) <> 0 Then Open strFileName For Output As #iFile 'Print #iFile, String(65, "-") Print #iFile, "Test Print" Print #iFile, "Register"; Tab(17); "TestCol1"; Tab(39); "TestCol2"; Tab(58); "TestCol3" Print #iFile, printing a blank line Print #iFile, printing a blank line Close End If Screen.MousePointer = vbDefault End Sub
11	FLEX GRID: COPY CUT PASTE Private Sub flxArray_KeyUp(KeyCode As Integer, Shift As Integer) If ((flxArray.Col = 2) Or (flxArray.Col = 3)) Then Select Case KeyCode ' Copy Case vbKeyC And Shift = 2 ' Control + C Clipboard.Clear Clipboard.SetText flxArray.Text KeyCode = 0 ' Paste Case vbKeyV And Shift = 2 'Control + V flxArray.Text = Clipboard.GetText KeyCode = 0 ' Cut Case vbKeyX And Shift = 2 'Control + X Clipboard.Clear Clipboard.SetText flxArray.Text flxArray.Text = "" KeyCode = 0 ' Delete Case vbKeyDelete flxArray.Text = "" End Select End If End Sub
12	FLEXGRID: ALLOW TYPING OF TEXT, MOVING TO THE NEXT ROW WHEN THE ENTER KEY IS PRESS ONLY FOR SELECT ROWS. In this example, the cursor moves to the next row only for cols 2 and 3. Private Sub flxArray_KeyPress(KeyAscii As Integer) If ((flxArray.Col = 2) Or (flxArray.Col = 3)) Then Select Case KeyAscii Case vbKeyReturn ' When the user hits the return key ' this code'll move the next cell or row. With flxArray If .Row + 1 <= .Rows - 1 Then .Row = .Row + 1 If .Row > 10 Then .TopRow = .Row - 9 Else .Row = 1 End If End With Case vbKeyBack ' Delete the previous character when the ' backspace key is used. With flxArray If Trim$(.Text) <> "" Then _ .Text = Mid$(.Text, 1, Len(.Text) - 1) End With Case Is < 32 ' Avoid unprintable characters. End Select End If End Sub
13	OPENING PDF FILES FROM VB CODE API: Public 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 Sub mnuViewFile_Click() On Error GoTo err If ShellExecute(Me.hWnd, "Open", App.Path & "\Application.pdf", "", "c:\", 1) Then End If Exit Sub err: MsgBox "Cannot open file, vbOKOnly, strErrTitle End Sub
14	PUTTING HTML LINKS ON A VB FORM Private Sub lblLink_Click() On Error GoTo err If ShellExecute(Me.hWnd, "Open", "http://www.rashmirahul.com", "", "c:\", 1) Then End If Exit Sub err: MsgBox "Cannot reach hyperlink", vbOKOnly, strErrTitle End Sub
15	Opening a splash form. Should be on top of all other programs Should be at the centre of the screen Private Sub Form_Load() Dim OnTop Const SWP_NOMOVE = 2 Const SWP_NOSIZE = 1 Const Flags = SWP_NOMOVE Or SWP_NOSIZE Const HWND_TOPMOST = -1 Const HWND_NOTOPMOST = -2 'Centre the form Me.Move (Screen.Width / 2) - (Me.Width / 2), (Screen.Height / 2) - (Me.Width / 2) 'show it immediately Show 'give it time to show DoEvents 'put it ontop OnTop = SetWindowPos(Me.hWnd, HWND_TOPMOST, 0, 0, 0, 0, Flags) End Sub
16	GET THE SCREEN RESOLUTION Private Sub Form_Load() ResWidth = Screen.Width \ Screen.TwipsPerPixelX ResHeight = Screen.Height \ Screen.TwipsPerPixelY ScreenRes = ResWidth & "x" & ResHeight MsgBox (ScreenRes) End Sub
17	MAKE THE ENTER KEY ACT LIKE THE TAB KEY Private Sub Text1_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then SendKeys "{TAB}" KeyAscii = 0 End If End Sub
18	ALLOW ONLY ONE INSTANCE OF YOUR PROGRAM Private Sub Form_Load() If App.PrevInstance Then Call MsgBox("This program is already running", vbExclamation) End End If End Sub
19	CONVERT HEX TO DECIMAL `Private Sub Form_Load()` `strHex= "3FF"` `MsgBox Val("&H" & strHex)` `End Sub`
20	CONVERT DECIMAL TO HEX `Private Sub Form_Load()` `strDecimal= "3FF"` `MsgBox Hex(strDecimal)` `End Sub`
21	DETERMINE WHICH OPTION BUTTONS HAVE BEEN SELECTED When attempting to determine which option buttons a user has selected from an array of option buttons, use this code instead of using an inefficient If-Then construct: intSelectedItem = Option(0).Value * O - _ Option(1).Value1 - Option(2).Value 2 If you have more than a few items, put this code in a loop: intSelectedItems = 0 For iCount = 0 to N 'N = total number of option boxes minus one intSelectedItem = Option(iCount).Value * iCount Next intSelectedItem is the index of the option button that the user selected.
22	CONVERT A TEXT FILE INTO ACCESS MDB It can be troublesome to convert a text file into an Access database. It takes a lot of time to open the file for sequential access and create new records using the AddNew method. Instead, use the Text ISAM driver and SQL to do the job for you. First, create a SCHEMA.INI file for the text file and place it in the same directory as the text file. Use this code to convert the database: Dim db As Database, tbl as TableDef Set db = DBEngine.CreateDatabase(App.Path & "\mymdb.mdb", dbLangGeneral, dbVersion_0) Set tbl = db.CreateTableDef("Temp") tbl.Connect = "Text;database=c:\vbpj\data" tbl.SourceTableName = "Customer#txt" db.TableDefs.Append tbl db.Execute "Select Temp.* into NewTable from Temp" db.TableDefs.Delete tbl.Name db.Close Set tbl = Nothing Set db = Nothing Now, you only need to create indexes. You can use this method to convert text files in excess of 100,000 records in a few seconds
23	SWAP TWO INTEGER VARIABLES Use this algorithm to swap two integer variables: a = a Xor b b = a Xor b a = a Xor b
24	READ AND WRITE ARRAYS QUICKLY You can read and write arrays quickly from files using Put and Get. This approach is faster than reading and writing the array one entry at a time: Dim arr(1 To 100000) As Long Dim fnum As Integer fnum = FreeFile Open "C:\Temp\xxx.dat" For Binary As fnum Put #fnum, , arr Close fnum
25	CANCEL A PENDING PRINT JOB If you use PrintManager, anything printed before you press the Abort button is sent to the printer. This code uses the Windows API AbortDoc to prevent this. Put a button named cCancel on the form and caption it Abort Printing. Add this declaration to your program: Declare Function AbortDoc% Lib "GDI" ( ByVal hDC As Integer) Add this code to the cCancel buttons Click event procedure: Sub cCancel_Click () dim i% AbortPrintFlag=True On Local Error Resume Next i = AbortDoc(Printer.hDC) End Sub Add this code to the print routine: AbortPrintFlag=False Do While ...... Printer.Print ...... DoEvents If AbortPrintFlag then exit do Loop On Local Error resume next Printer.EndDoc
26	RETURN TO A PREVIOUS LOCATION IN YOUR CODE To return to a previous location in your code, press Ctrl+Shift+F2. This way you dont need to set bookmarks. VB only keeps track of the last eight lines of code that you accessed or edited. This feature is available in design time and in break mode.
27	A FAST WAY TO FIND ROUTINES To quickly go to the code for a called function, subroutine, or property, simply place your cursor on the called routine and hit Shift+F2. VB will immediately
28	FORCE UPPERCASE CHARACTERS IN A TEXT BOX To change text in a text box to uppercase as soon as the user types it in, use this code: Private Sub txtname_KeyPress(KeyAscii As Integer) 'Puts in uppercase as soon as typed KeyAscii = Asc(UCase(Chr(KeyAscii))) End Sub
29	REGISTER ACTIVEX COMPONENTS MANUALLY Not all ActiveX DLL and OCX files include installation programs to properly register the control. You need to run REGSVR32.EXE manually to perform the registration. You can save time by creating a shortcut in your WINDOWS\SENDTO folder called Register ActiveX Control. Use the target name of C:\WINDOWS\REGSVR32.EXE for the shortcut. When you have an ActiveX control you wish to register, right-click on the file name to display the context menu, click on Send To, and click on Register ActiveX Control. The RegSvr32 program will display a message box indicating the success or failure of the registration.
30	TEST FOR FALSE INSTEAD OF ZERO If youre checking a numeric value against 0, one option is to use the <> operator: If iNumber <> 0 Then ... End If It is faster, however, to check the variable with an If statement. If iNumber Then ... End If These two statements are equivalent, but the second example will run faster, albeit with some loss of readability.
31	PROGRAMMATICALLY SELECTING MULTIPLE ROWS IN A DATA GRID To select multiple, nonconsecutive rows (a tagged list) in Sheridan Softwares DataGrid (which is a part of its Data Widgets package), first set the SelectionTypeRow property of the DataGrid to TagList. For each row you want to select, set the EvalRowNumber property to the row number and the EvalRowIsSelected property to TRUE. This code illustrates how to select odd rows in a DataGrid using this approach: Sub SelectSomeRows() Dim i As Integer For i = 1 To 10 Step 2 SSDataGrid1.EvalRowNumber = i SSDataGrid1.EvalRowIsSelected = True Next i
32	SET AUTOREDRAW TO FALSE If AutoRedraw is set to True, VB keeps a bitmap of the form in memory that it uses to redraw the form after another window in front of it is closed. Because this consumes memory, set AutoRedraw to False if you are not using any graphics methods. Most business applications can have AutoRedraw set to False. This property applies to picture boxes as well as forms.
33	PREVENTING INVALID USE OF NULL ERRORS If your app uses database or other functions that can return Null variants, your app will crash sooner or later with that dreaded Invalid Use of Null error. Preventing it is simple: assign an empty string and a variant to your target variable or control: Text1.Text = "" & SomeDynaset("SomeField")
34	MOVE CONTROLS INTO A FRAME To move controls into a frame, select one or more controls and cut them out using the cut menu option. Select the frame you wish to place the controls into and then paste them in. This technique also can be used when moving controls onto other controls such as Tabs.
35	USE THE IMAGE CONTROL INSTEAD OF THE PICTURE CONTROL Because the picture control has more overhead than the image control, its best to use the image control when you need to display a graphic. Use the picture control when you need to contain other controls, align the picture either to the top or bottom, or use graphics methods. The image control optimizes both for speed and size and consumes none of the GDI heap (one of the most critical of the so-called system resources).
36	CALL THE CLICK EVENT If you need to fire a command buttons Click event, you can set the Value property to True: cmdAdd.Value = True The real benefit of this is that you can call code in other form modules. It is faster, however, to call the event procedure directly: Call cmdAdd_Click This is true for all controls, not just the command button.
37	GET RID OF UNUSED DECLARE STATEMENTS When you use the Declare statement, approximately 11 bytes are added to the size of your EXE. The name of the function and library where it resides are also stored in the EXE.
38	REDEFINE YOUR TAB ORDER When you need to reset your tab indexes quickly (without buying a third party VB extension product), set the tabs in the reverse tab order assigning each tab index to zero (0). That is, go to the very last control on the page that will receive a tab stop. Bring up the properties window, locate TabIndex, hit the zero key, click the second from the last control to receive a tab stop, type zero, click the third from the last control, type zero, and so on. This little trick will save you lots of time and aggravation, and it works perfectly every time.
39	KEEPING ACCURATE TIME IN VB The problem with the VB timer is that it lasts just over a minute. I used the API function GetCurrentTime(), which records the milliseconds since Windows was started. Place a Timer control on the form that starts the application (make sure that this form remains loaded throughout the application). Place this code in the Declarations section of the form: Dim Start&, Elapsed& Declare Function GetCurrentTime& Lib "User" () The Form_Load event of this form must also contain this code: Start = GetCurrentTime 'This routine sets the Timer interval to about a minute. Sub Timer1_Timer () Dim MsgText$ Elapsed = GetCurrentTime() ' if 10 minutes has elapsed since ' the program was started ' or the last msgbox was displayed If Elapsed - Start >= 600000 Then ' 10 minutes MsgText = "Give your eyes a rest. _ Take a 5 minute break." MsgBox MsgText, 16, "Take A Break" ' however long the msgbox is on the screen ' the timer is effectively set to 0 when the ' user presses OK Elapsed = GetCurrentTime() Start = Elapsed Elapsed = 0 End If End Sub
40	GET THE LENGTH OF THE LONGEST WORD IN A STRING LenLongestWord finds the length of the longest word in a string where a word is defined to be bounded by spaces or the ends of the string. It also illustrates a case where a recursive implementation works well in VB. For example, you would use it to decide how to spread a column heading over multiple lines: Function LenLongestWord (ByVal src As String) As Integer Dim i As Integer, j As Integer i = InStr(src, " ") If i > 0 Then j = LenLongestWord(Mid$(src, i + 1)) If j > i - 1 Then LenLongestWord = j Else LenLongestWord = i - 1 Else LenLongestWord = Len(src) End If End Function
41	WHEN TO USE SENDKEYS Use the SendKeys function to exploit the delete functionality of many grid and spreadsheet controls that have a delete functionality. Use this functionality without writing code to delete each row if your form has an option that deletes all highlighted rows. This method works much faster than writing code to check for each highlighted row in the grid, and then deleting that row. Remember not to use SendKeys to send a key value without first setting the focus of the control to which you are sending the key value. Call this procedure to simplify the process: 'Pass the Key value to send and the 'Control to which the value to be sent Sub SendKeyTo(KeyValue As String, cCnt As Control) cCnt.SetFocus SendKeys KeyValue End Sub
42	CALCULATE AGE USING DATEDIFF Use the function DateDiff to calculate an individuals exact age based on birth date. DateDiff first calculates the total number of days an individual has been alive and then divides by 365.25 to account for leap years. The Int function truncates the division results by removing the decimal and not rounding: Function CalcAge(datEmpDateOfBirth as Variant) as Integer CalcAge = Int(DateDiff(y,datEmpDateOfBirth,Date())/365.25) End Function
43	TEST FOR LEAP YEAR Simply pass in the year you are testing, append that year to 02/29/, and use the IsDate function to see if that is a valid date. If 02/29/xx is not a valid date, then you know it is not a leap year: Function IsLeap(sYear As String) As Integer If IsDate("02/29/" & sYear) Then IsLeap = True Else IsLeap = False End If End Function
44	QUICK TEST FOR WEEKEND To test whether a date falls on a weekend, you might be inclined to do this: nDay = weekday (sDate) If (nDay = 1) or (nDay = 7) Then 'It's a weekend End If However, you can use VBs MOD operator to perform the test in roughly half the time: If (Weekday (sDate) MOD 6 = 1) Then 'Its a weekend End If
45	USED BYTES IN A DIRECTORY This function returns the number of bytes used on the directory: Function DirUsedBytes(ByVal dirName As String) As Long Dim FileName As String Dim FileSize As Currency ' add a backslash if not there If Right$(dirName, 1) <> "\" Then dirName = dirName & "\" Endif FileSize = 0 FileName = Dir$(dirName & ".") Do While FileName <> "" FileSize = FileSize + _ FileLen(dirName & FileName) FileName = Dir$ Loop DirUsedBytes = FileSize End Function You can call the function passing the name of a directory: MsgBox DirUsedBytes("C:\Windows")
46	GET USEFUL DISK INFORMATION This function returns the hard disk free bytes, total bytes, percentage of free bytes, and used space. Before calling the function, set the first field of the DISKSPACEINFO structure (RootPath) to the drive letter: Dim dsi As DISKSPACEINFO dsi.RootPath = "C:\" GetDiskSpace dsi The function returns all its results in the other field of the record: ' * Declaratiosn Section **** Declare Function GetDiskFreeSpace Lib _"kernel32" Alias "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, lpSectorsPerCluster As Long, lpBytesPerSector As Long, _ lpNumberOfFreeClusters As Long, lpTotalNumberOfClusters As Long) As Long Type DISKSPACEINFO RootPath As String * 3 FreeBytes As Long TotalBytes As Long FreePcnt As Single UsedPcnt As Single End Type ' **** Code Module **** Function GetDiskSpace(CurDisk As DISKSPACEINFO) Dim X As Long Dim SxC As Long, BxS As Long Dim NOFC As Long, TNOC As Long X& = GetDiskFreeSpace(CurDisk.RootPath, SxC, BxS, NOFC, TNOC) GetDiskSpace = X& If X& Then CurDisk.FreeBytes = BxS * SxC * NOFC CurDisk.TotalBytes = BxS * SxC * TNOC CurDisk.FreePcnt = ((CurDisk.TotalBytes CurDisk._ FreeBytes) / CurDisk.TotalBytes) * 100 CurDisk.UsedPcnt = (CurDisk.FreeBytes / CurDisk.TotalBytes) * 100 Else CurDisk.FreeBytes = 0 CurDisk.TotalBytes = 0 CurDisk.FreePcnt = 0 CurDisk.UsedPcnt = 0 End If End Function As is, this routine works with drives with a capacity of 2GB or less; for larger disks, you should use Single variables instead.
47	LIMIT USER TYPING IN COMBO BOX The standard textbox has a MaxChars property that lets you limit the number of characters a user can type into it. The drop-down combo does not, but you can emulate this property setting with a simple API call: Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd _ As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Private Const CB_LIMITTEXT = &H141 Private Sub Form_Load() Const Max_Char = 24 Call SendMessage(Combo1.hWnd, CB_LIMITTEXT, Max_Char, 0&) End Sub
48	A FORM THAT WONT CLOSE If you set a forms ControlBox property to False, the Minimize and Maximize buttons also become invisible. Suppose you want to provide functionality to the user to maximize and minimize the form, but not to close the form using the control box. Simply add this code to the Query_Unload event: ' uncomment next line in VB3 ' Const vbFormControlMenu = 0 Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) If UnloadMode = vbFormControl_Menu Then Cancel = True End If End Sub
49	ROUND AND FORMAT THE EASY WAY Do you sometimes need to format rounded numbers to a specific number of digits? You can accomplish this in one step: n = 12.345 Format(n, "0.00\0") 'returns "12.350" Format(n, "0.\0\0") 'returns "12.00" Format(0.55, "#.0\0") 'returns ".60"
50	AVOID THE FLICKERING Developers often need to load forms with information, which is time-consuming. The form is often a list box filled from an outside source, and this causes the list-box contents to flash annoyingly as the information goes into it. Solve this by bringing in the declaration of the LockWindowUpdate API call: #If Win16 Then Declare Function LockWindowUpdate Lib "User" (ByVal hWndLock As Integer) As Integer #Else Declare Function LockWindowUpdate Lib _ "user32" (ByVal hWndLock As Long) As Long #End If The hWndLock variable refers to the hWnd property of the form where you dont want to have screen updates shown. When you reissue the LockWindowUpdate with a value of 0 for hwndLock, youll free up the screen and all updates will be shown instantly: Dim lErr as Long Dim x as Integer 'No list box flicker, it will appear blank for 'just a moment Screen.MousePointer = vbHourglass lErr = LockWindowUpdate(Me.hWnd) For x = 1 to 5000 lstMyListbox.AddItem CStr(x) Next Now all the information is there: lErr = LockWindowUpdate(0) Screen.MousePointer = vbDefault
51	WATCH HOW YOU USE YOUR BOOLEANS With the introduction of the Boolean data type in VB4, you might be tempted to convert it to a numeric value using the Val function for storage in a database table. Watch out! Val wont convert a Boolean into -1 (or 1) as you might expect. Use the Abs or CInt functions, depending on the format you need: Val(True) gives 0 CInt(True) gives -1 Abs(True) gives 1
52	NUMERIC CONVERSION OF STRINGS When dealing with numerics and strings, be advised of a couple gotchas. The Val( ) function isnt internationally aware and will cause problems if you have users overseas. But you cant just blindly switch to CLng, CInt, and so on, which are internationally aware. These functions dont support an empty string (vbNullString or "") or strings that fail the IsNumeric test and will raise an error if used as such. Consider wrapping your own function around these calls to check for an empty text string before converting: Public Function CInt(IntValue as Variant) as Integer If IsNumeric(IntValue) Then MyCInt = CInt(IntValue) Else MyCInt = 0 End If
53	PREVENT CHECKBOX CHANGES Youll often want to display a checkbox-style listbox to show users the values they have selected in an underlying database. However, you dont want to allow users to change the selections that is, to change which boxes they checked. You cant disable the listbox because that stops users from scrolling the list to see which items they checked. You cant use Locked, because the listbox doesnt have a Locked property. Heres one solution: Paint a Command button with the caption Click to toggle enabled property and a listbox on a form, then change the listbox style to 1-Checkbox. Add this code: Option Explicit Dim mbDisabled As Boolean Private Sub Command1_Click() mbDisabled = Not mbDisabled End Sub Private Sub List1_ItemCheck(Item As Integer) If mbDisabled Then List1.Selected(Item) = Not List1.Selected(Item) End If End Sub When mbDisabled is set to True, the changes made by the user to the listbox selections are immediately reversed. It will appear as if the selections havent changed at all, and the list is still scrollable.
54	AVOID IIF INEFFICIENCIES The IIf functionwhich returns one of two values determined by logical testhas this syntax: IIf(Expression, TruePart, FalsePart). At first, it might seem like an ideal shortcut for an IfElse...End If block. However, IIf is designed to execute both the True part and the False part. To verify, copy this into your Debug window and press enter: ? IIf(True, MsgBox("True Part"), MsgBox("False Part")) Obviously, its extremely inefficientand possibly errorinducing to place functions in the True and False parts of IIf, because they are both executed. In general, always use a standard IfElseEnd If block instead.
55	Split Strings Cleanly The Split function is great for parsing strings, but what happens when a string has more than one consecutive delimiter? It might seem odd that Split() returns empty substrings as placeholders for the data missing between delimiters, but thats exactly what needs to happen so these data positions arent lost. Unfortunately, Split() does not have an option to ignore multiple delimiters. CleanSplit() uses the same arguments as Split() and efficiently discards empty substrings caused by more than one delimiter in a row: Public Function CleanSplit(ByVal Expression As String, Optional By Val Delimiter As String = " ", Optional ByVal Limit As Long = -1, Optional Compare As VbCompareMethod = vbBinaryCompare) As Variant Dim varSubstrings As Variant, i As Long varSubstrings = Split(Expression, Delimiter, Limit, Compare) 'mark empty substrings with delimiter because 'the delimiter won't be around after Split() For i = LBound(varSubstrings) To UBound(varSubstrings) If Len(varSubstrings(i)) = 0 Then varSubstrings(i) = Delimiter End If Next i CleanSplit = Filter(varSubstrings, Delimiter, False) End Function
56	CONVERT A DECIMAL NUMBER TO BASE N Heres a function that converts a decimal number (base 10) to another base number system. Each digit position corresponds to a power of N, where N is a number between 2 and 36. In other words, if a number systems base is N, then N digits are used to write numbers in that system. For example, the base 2 number system (binary) uses the digits 0 and 1, while the base 20 system uses digits 0 through K. The ConvertDecToBaseN function accepts a double-value decimal number and a byte-value representing the base number between 2 and 36. By default, the base value used is 16 (hexadecimal). The decimal number is converted to a positive number if its negative. This function is useful for representing large numbers as strings, using fewer digit positions. I developed it to help reduce the footprint of several large numbers used in constructing a 16-character unique string ID. (Creating a complementary function to convert a base N number back into a decimal would be a great exercise.) Public Function ConvertDecToBaseN(ByVal dValue As Double, Optional ByVal byBase As Byte = 16) As String Const BASENUMBERS As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" Dim sResult As String Dim dRemainder As Double On Error GoTo ErrorHandler sResult = "" If (byBase < 2) Or (byBase > 36) Then GoTo Done dValue = Abs(dValue) Do dRemainder = dValue - (byBase * Int((dValue / byBase))) sResult = Mid$(BASENUMBERS, dRemainder + 1, 1) & sResult dValue = Int(dValue / byBase) Loop While (dValue > 0) Done: ConvertDecToBaseN = sResult Exit Function ErrorHandler: Err.Raise Err.Number, "ConvertDecToBaseN", _ Err.Description End Function Sample usage: ConvertDecToBaseN(999999999999#, 36) 'Returns 'CRE66I9R
57	COUNT THE OCCURRENCES OF A CHARACTER OR SUBSTRING VB6 introduced the Split function, which returns a zero-based, one-dimensional array containing a specified number of substrings. Although this function is useful in itself, you can also use it in other useful ways. For example, by combining the UBound and Split functions, you can count how many times a substringor single characterappears inside another string: Function InstrCount(Source As String, SearchString As String) As Long If Len(Source) Then InstrCount = UBound(Split(Source, SearchString)) End If End Function

VB Tips and Tricks

ALLOW ONLY NUMERIC DIGITS TO BE KEYED

LEFT SHIFT

Public Function LShift(w As Long, c As Integer) As Integer

RIGHT SHIFT

ROUNDING NUMBERS

Function Round(X As Double, DP As Integer) As Double

UNLOADING ALL FORMS IN A VB6 PROJECT

Public Sub UnloadForms()

PRINTING TO A FILE

FLEX GRID: COPY CUT PASTE

PUTTING HTML LINKS ON A VB FORM

GET THE SCREEN RESOLUTION

MAKE THE ENTER KEY ACT LIKE THE TAB KEY

ALLOW ONLY ONE INSTANCE OF YOUR PROGRAM

CONVERT HEX TO DECIMAL

CONVERT DECIMAL TO HEX

Private Sub Form_Load() strDecimal= "3FF" MsgBox Hex(strDecimal) End Sub

LIMIT USER TYPING IN COMBO BOX

Split Strings Cleanly

CONVERT A DECIMAL NUMBER TO BASE N

COUNT THE OCCURRENCES OF A CHARACTER OR SUBSTRING

`Private Sub Form_Load()`
`strDecimal= "3FF"`
`MsgBox Hex(strDecimal)`
`End Sub`