A couple useful class modules

[Grok]

I wrote these about two years ago while controlling some vendor's application directly from my VB app.  There are two classes, just copy each into their own class module and save.  One is for an EDIT control (TextBox for us VBers), the other is for a ComboBox.

The Edit class:

Code Select Expand


Option Explicit

Private ghWnd As Long
Private gdlgID As Long

Public Property Get hwnd() As Long
    hwnd = ghWnd
End Property

Public Property Let hwnd(ByVal hwnd As Long)
    ghWnd = hwnd
End Property

Public Property Get dlgID() As Long
    dlgID = gdlgID
End Property

Public Property Let dlgID(ByVal dlgID As Long)
    gdlgID = dlgID
End Property

Public Function GetText(ByRef EditText As String, Optional ByVal dlgID As Long, Optional ByVal hwnd As Long) As Long
    Dim hItem As Long
    Dim ret As Long
    Dim sMsg As String
   
    GetText = -1
    If hwnd = 0 Then hwnd = ghWnd
    If hwnd = 0 Then
        If IsMissing(dlgID) = True Then Exit Function       'no way to get hWnd if no dlgID
        hwnd = GetDlgItem(ghWnd, dlgID)
    End If
    If hwnd = 0 Then Exit Function                          'still 0, unable to continue
    sMsg = Space(255)
    GetText = SendMessageSTR(hwnd, WM_GETTEXT, Len(sMsg), sMsg)
    EditText = StripNulls(sMsg)
End Function

Public Function SetText(ByVal TextToSet As String, Optional ByVal dlgID As Long, Optional ByVal hwnd As Long) As Long
   
    Dim hItem As Long, ret As Long
   
    If IsMissing(hwnd) = True Then hwnd = ghWnd             'no edit handle provided, use module copy
    If hwnd <> 0 Then ghWnd = hwnd                          'if hWnd is now nonzero, save to module var
    If IsMissing(dlgID) = True Then dlgID = gdlgID          'if no control ID passed, use module copy
    If dlgID <> 0 Then gdlgID = dlgID                       'if control ID is now nonzero, save to module var
    If ghWnd = 0 Then Exit Function                         'still no valid handle
    SetText = SendMessageSTR(ghWnd, WM_SETTEXT, Len(TextToSet), TextToSet)
   
End Function



The Combo class:

Code Select Expand

Option Explicit

Private ghWnd As Long
Private gdlgID As Long

Public Property Get hwnd() As Long
    hwnd = ghWnd
End Property

Public Property Let hwnd(ByVal hwnd As Long)
    ghWnd = hwnd
End Property

Public Property Get dlgID() As Long
    dlgID = gdlgID
End Property

Public Property Let dlgID(ByVal dlgID As Long)
    gdlgID = dlgID
End Property

Public Function AddString(ByVal NewString As String, Optional ByVal dlgID As Long, Optional ByVal hwnd As Long) As Long
    Dim ret As Long
    AddString = CB_ERR
    If hwnd = 0 Then hwnd = ghWnd
    If hwnd = 0 Then
        If IsMissing(dlgID) = True Then Exit Function       'no way to get hWnd if no dlgID
        hwnd = GetDlgItem(ghWnd, dlgID)
    End If
    If hwnd = 0 Then Exit Function                          'still 0, unable to continue
    AddString = SendMessageSTR(hwnd, CB_ADDSTRING, 0, NewString)
End Function

Public Function FindString(ByRef SearchString As String, Optional ByVal dlgID As Long, Optional ByVal hwnd As Long) As Long
    Dim ret As Long
    FindString = CB_ERR
    If hwnd = 0 Then hwnd = ghWnd
    If hwnd = 0 Then
        If IsMissing(dlgID) = True Then Exit Function       'no way to get hWnd if no dlgID
        hwnd = GetDlgItem(ghWnd, dlgID)
    End If
    If hwnd = 0 Then Exit Function                          'still 0, unable to continue
    FindString = SendMessageSTR(hwnd, CB_FINDSTRING, -1, SearchString)
End Function

Public Function SelectString(ByVal SearchString As String, Optional ByVal dlgID As Long, Optional ByVal hwnd As Long) As Long
    Dim ret As Long
    SelectString = CB_ERR
    If hwnd = 0 Then hwnd = ghWnd
    If hwnd = 0 Then
        If IsMissing(dlgID) = True Then Exit Function       'no way to get hWnd if no dlgID
        hwnd = GetDlgItem(ghWnd, dlgID)
    End If
    If hwnd = 0 Then Exit Function                          'still 0, unable to continue
    SelectString = SendMessageSTR(hwnd, CB_SELECTSTRING, -1, SearchString)
End Function

'CB_SELECTSTRING
'An application sends a CB_SELECTSTRING message to search the list of a combo box for an item that begins with the characters in a specified string. If a matching item is found, it is selected and copied to the edit control.
'
'To send this message, call the SendMessage function with the following parameters.
'
'SendMessage(
'  (HWND) hWnd,         // handle to destination window
'  CB_SELECTSTRING,     // message to send
'  (WPARAM) wParam,     // item of item preceding start
'  (LPARAM) lParam      // search string
');
'Parameters
'wParam
'Specifies the zero-based index of the item preceding the first item to be searched. When the search reaches the bottom of the list, it continues from the top of the list back to the item specified by the wParam parameter. If wParam is –1, the entire list is searched from the beginning.
'lParam
'Pointer to the null-terminated string that contains the characters for which to search. The search is not case sensitive, so this string can contain any combination of uppercase and lowercase letters.
'Return Values
'If the string is found, the return value is the index of the selected item. If the search is unsuccessful, the return value is CB_ERR and the current selection is not changed.
'


[Grok]

Oh you'll need these:

Code Select Expand


Public Declare Function GetDlgItem Lib "user32" (ByVal hDlg As Long, ByVal nIDDlgItem As Long) As Long

Public Declare Function SendMessageSTR Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal WMSG As Long, ByVal wParam As Long, ByVal lParam As String) As Long

Public Function StripNulls(ByVal string1 As String) As String
    If Len(string1) > 0 Then
        StripNulls = Split(string1, Chr(0))(0)
    Else
        StripNulls = ""
    End If
End Function