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).Value*1 - 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 ......