
			Nod Programing VB Help Index
ŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻ
This is intended for free use.  The code here is for various skill levels, 
anyone from beginers to advanced programers can use these.  Do what you wish 
with the code it is free for you to use and manipulate!

****************************************************************************

Simple input validation:

Here's a way to achieve validation in text boxes and other controls that
support the KeyPress event. It's simple, but functional.

First, add this function to your project:

Function ValiText(KeyIn As Integer, _ValidateString As String, _Editable
 As Boolean) As Integer
  
    Dim ValidateList As String
    Dim KeyOut As Integer
    '
    If Editable = True Then
         ValidateList = UCase(ValidateString) & Chr(8)
    Else
         ValidateList = UCase(ValidateString)
    End If
    '
    If InStr(1, ValidateList, UCase(Chr(KeyIn)), 1) > 0 Then
        KeyOut = KeyIn
    Else
        KeyOut = 0
        Beep
    End If
    '
    ValiText = KeyOut
    '
End Function

Then, for each control whose input you wish to validate, just put something
like this in the KeyPress event of the control:

KeyAscii=ValiText(Keyascii, "0123456789/-",True)

Doing so will filter out any undesired keys that go to the control,
accepting only the keys defined by the second parameter. In this case, that
parameter ("0123456789/-") defines characters that are valid for a date.

The function's third parameter controls whether the [Backspace] key can be
used.

Note that this implementation of the function ignores the case of the
incoming keys, so if your second parameter were "abcdefg", the function
would also allow "ABCDEFG" to be entered.

****************************************************************************

Simplying the addition of items to ComboBoxes:

I often need to add items to a ComboBox and store an index or ID value in
the ItemData property. I've found that the code needed to add items to the
ComboBox and to check the ItemData property of the currently selected item
looks clumsy. So, I've written two simple helper routines to clean the code
up a bit. Here they are:

'---------------------------------------------------------------------------

 '   AddComboItem
 '   AddComboItem

'---------------------------------------------------------------------------
 Public Sub AddComboItem( _cboAdd As ComboBox, _ByVal sText As String, 
 _ByVal lData As Long)

     cboAdd.AddItem sText
     cboAdd.ItemData(cboAdd.NewIndex)  lData
   
 End Sub

'---------------------------------------------------------------------------
 '   CurrComboData
 '   CurrComboData

'---------------------------------------------------------------------------
 Public Function CurrComboData( _cbo As ComboBox) As Long

    If cbo.ListIndex <> -1 Then
       CurrComboData = cbo.ItemData(cbo.ListIndex)
    Else
       CurrComboData = -1
    End If

 End Function

Now, instead of writing

 cboTest.AddItem "Hello"
 cboTest.ItemData(cboTest.NewIndex) = 5

you can just write

 AddComboItem cboTest, "Hello",5

Instead of writing

 ID = cboTest.ItemData(cboTest.ListIndex)

you can write

 ID = CurrComboData( cboTest )

As an added bonus, CurrComboData protects you from the runtime error
generated if ListIndex is -1. Just be sure to check for a return of -1 from
CurrComboData.

****************************************************************************

Showing long ListBox entries as a ToolTip:

Sometimes the data you want to display in a list is too long for the size
of ListBox you can use. When this happens, you can use some simple code to
display the ListBox entries as ToolTips when the mouse passes over the
ListBox.

First, start a new VB project and add a ListBox to the default form. Then
declare the SendMessage API call and the constant (LB_ITEMFROMPOINT) needed
for the operation:

Option Explicit

'Declare the API function call.
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
' Add API constant
Private Const LB_ITEMFROMPOINT = &H1A9

Next, add some code to the form load event to fill the ListBox with data:

Private Sub Form_Load()
    '
    ' load some items in the list box
    With List1
        .AddItem "Michael Clifford Amundsen"
        .AddItem "Walter P.K. Smithworthy, III"
        .AddItem "Alicia May Sue McPherson-Pennington"
    End With
    '
End Sub

Finally, in the MouseMove event of the ListBox, put the following code:

Private Sub List1_MouseMove(Button As Integer, Shift As Integer, _
X As Single, Y As Single)
    '
    ' present related tip message
    '
    Dim lXPoint As Long
    Dim lYPoint As Long
    Dim lIndex As Long
    '
    If Button = 0 Then ' if no button was pressed
        lXPoint = CLng(X / Screen.TwipsPerPixelX)
        lYPoint = CLng(Y / Screen.TwipsPerPixelY)
        '
        With List1
            ' get selected item from list
            lIndex = SendMessage(.hwnd, _
              LB_ITEMFROMPOINT, _
              0, _
              ByVal ((lYPoint * 65536) + lXPoint))
            ' show tip or clear last one
            If (lIndex >= 0) And (lIndex <= .ListCount) Then
                .ToolTipText = .List(lIndex)
            Else
                .ToolTipText = ""
            End If
        End With '(List1)
    End If '(button=0)
    '
End Sub

****************************************************************************

Creating Short Arrays Using the Variant Data Type:

If you need to create a short list of items in an array, you can save a lot
of coding by using the Variant data type instead of a dimensioned standard
data type. This is especially handy when you need to create a list of short
phrases to support numeric output.

For example, add a button to a standard VB form and paste the following
code into the Click event of the button:

Private Sub Command1_Click()
    '
    ' create a quick array using variants
    '
    Dim aryList As Variant
    '
    aryList = Array("No Access", "Read-Only", "Update", "Delete")
    '
    MsgBox aryList(2)
    '
End Sub

****************************************************************************

Using GetRows to Quickly Save Data Fields to Memory Variables:

If you need to copy information from database fields into memory variables,
you can do it quickly using the GetRows method of the Recordset object. The
GetRows method copies one or more rows of data directly into a Variant data
type and stores the information as a two-dimensional array in the
formvarData(Field,Column).

To test the GetRow method, add a button to a VB form and paste the
following code into the Click event of the button.  Be sure to fix the
reference to location of the BIBLIO.MDB database in the OpenDatabase
method. Also be sure to set up a reference to the Microsoft DAO 3.5 Object
Library.

Private Sub cmdGetDataRow_Click()
    '
    ' show getrow method
    '
    Dim ws As Workspace
    Dim db As Database
    Dim rs As Recordset
    '
    Dim varDataRows As Variant
    Dim intRows As Integer
    Dim intColumns As Integer
    '
    Dim intLoopRow As Integer
    Dim intLoopCol As Integer
    Dim strMsg As String
    '
    Set ws = DBEngine.CreateWorkspace(App.EXEName, "admin", "")
    Set db = ws.OpenDatabase("e:\devstudio\vb\biblio.mdb")
    Set rs = db.OpenRecordset("SELECT * FROM Authors")
    '
    intRows = InputBox("How Many Rows?", "GetRows Example", 0)
    intColumns = rs.Fields.Count
    varDataRows = rs.GetRows(intRows)
    '
    For intLoopRow = 0 To intRows - 1
        strMsg = ""
        For intLoopCol = 0 To intColumns - 1
            strMsg = strMsg & varDataRows(intLoopCol, intLoopRow) & vbCrLf
        Next
        MsgBox strMsg
    Next
    '
    rs.Close
    db.Close
    ws.Close
    '
End Sub

****************************************************************************

Getting sensible Win32 API call errors:

Most of the Win32 API calls return extended error information when they
fail. To get this information in a sensible format, you can use the
GetLastError and FormatMessage APIs.

Add the following declarations and function to a BAS module in a VB project:

Option Explicit

Public Declare Function GetLastError _
  Lib "kernel32" () As Long
Public Declare Function FormatMessage _
  Lib "kernel32" Alias "FormatMessageA" _
 (ByVal dwFlags As Long, _
  lpSource As Any, _
  ByVal dwMessageId As Long, _
  ByVal dwLanguageId As Long, _
  ByVal lpBuffer As String, _
  ByVal nSize As Long, _
  Arguments As Long) As Long

Public Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000

Public Function LastSystemError() As String
    '
    ' better system error
    '
    Dim sError As String * 500
    Dim lErrNum As Long
    Dim lErrMsg As Long
    '
    lErrNum = GetLastError
    lErrMsg = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, _
      ByVal 0&, lErrNum, 0, sError, Len(sError), 0)
    LastSystemError = Trim(sError)
    '
End Function

Now place a command button on a standard VB form and call the
LastSystemError function:

Private Sub Command1_Click()
    '
    MsgBox LastSystemError
    '
End Sub

If there was no error registered, you'll see a message saying "The
operation completed successfully."

When using this function, keep these points in mind:

1. Many API calls reset the value of GetLastError when successful, so the
function must be called immediately after the API call that failed.

2. The last error value is kept on a per-thread basis, therefore the
function must be called from the same thread as the API call that failed.

****************************************************************************

Increment and decrement dates with the [+] and [-] keys:

If you've ever used Quicken, you've probably notice a handy little feature
in that program's date fields. You can press the [+] key to increment one
day, [-] to decrement one day, [PgUp] to increment one month, and [PgDn] to
decrement one month. In this tip, we'll show you how to emulate this
behavior with Visual Basic.

First, insert a text box on a form (txtDate). Set its text property to ""
and its Locked property to TRUE.

Now place the following code in the KeyDown event:

Private Sub txtDate_KeyDown(KeyCode As Integer, Shift As Integer)
    '
    ' 107 = "+" KeyPad
    ' 109 = "-" KeyPad
    ' 187 = "+" (Actually this is the "=" key, same as "+" w/o the=
 shift)
    ' 189 = "-"
    ' 33 = PgUp
    ' 34 = PgDn
    '
    Dim strYear As String
    Dim strMonth As String
    Dim strDay As String
    '
    If txtDate.Text = "" Then
        txtDate.Text = Format(Now, "m/d/yyyy")
        Exit Sub
    End If
    '
    strYear = Format(txtDate.Text, "yyyy")
    strMonth = Format(txtDate.Text, "mm")
    strDay = Format(txtDate.Text, "dd")
    '
    Select Case KeyCode
        Case 107, 187 ' add a day
            txtDate.Text = Format(DateSerial(strYear, strMonth, strDay) +
1, "m/d/yyyy")
        Case 109, 189 ' subtract a day
            txtDate.Text = Format(DateSerial(strYear, strMonth, strDay) -
1, "m/d/yyyy")
        Case 33 ' add a month
            txtDate.Text = Format(DateSerial(strYear, strMonth + 1,
strDay), "m/d/yyyy")
        Case 34 ' subtract a month
            txtDate.Text = Format(DateSerial(strYear, strMonth - 1,
strDay), "m/d/yyyy")
    End Select
    '
End Sub

The one nasty thing about this is that if you have characters that are not
the characters usually in a date (i.e., 1-9, Monday, Tuesday, or /) you get
errors in the format command. To overcome this, I set the Locked property
to True. This way, the user can't actually type a character in the field,
but the KeyDown event still fires.

			End of Help 3 of how many I do!!