Dan Appleman's Visual Bas…s Guide to the Win32 API/Dan.Applmans.Visual.Basic.5.0.Programmers.Guide.To.The.Win32.API.1997.Ziff-Davis.Press.CD/VB5PG32.mdf/desaware/apitools/listapi.frm

Visual Basic Form | 1997-02-13 | 29.0 KB | 855 lines

VERSION 5.00
Object = "{FAEEE763-117E-101B-8933-08002B2F4F5A}#1.1#0"; "DBLIST32.OCX"
Begin VB.Form frmAPI
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "API Copier"
   ClientHeight    =   6690
   ClientLeft      =   1275
   ClientTop       =   1680
   ClientWidth     =   7755
   Icon            =   "LISTAPI.frx":0000
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   6690
   ScaleWidth      =   7755
   Begin VB.CommandButton cmdQuery
      Caption         =   "&Select..."
      Height          =   495
      Left            =   6540
      TabIndex        =   9
      Top             =   2220
      Width           =   1095
   End
   Begin VB.CommandButton cmdCopy
      Caption         =   "&Insert"
      Height          =   495
      Index           =   1
      Left            =   6540
      TabIndex        =   12
      Top             =   5760
      Visible         =   0   'False
      Width           =   1095
   End
   Begin VB.CommandButton cmdClear
      Caption         =   "C&lear All"
      Height          =   495
      Left            =   6540
      TabIndex        =   10
      Top             =   4080
      Width           =   1095
   End
   Begin VB.CommandButton cmdOptions
      Caption         =   "&Options..."
      Height          =   495
      Left            =   6540
      TabIndex        =   8
      Top             =   900
      Width           =   1095
   End
   Begin VB.ComboBox cmbCategory
      Height          =   300
      Left            =   2880
      Sorted          =   -1  'True
      Style           =   2  'Dropdown List
      TabIndex        =   4
      Top             =   420
      Width           =   2175
   End
   Begin VB.PictureBox pctStatus
      Height          =   255
      Left            =   180
      ScaleHeight     =   225
      ScaleWidth      =   7425
      TabIndex        =   16
      TabStop         =   0   'False
      Top             =   6360
      Width           =   7455
      Begin VB.Label Status
         BackStyle       =   0  'Transparent
         Height          =   255
         Left            =   0
         TabIndex        =   0
         Top             =   0
         Width           =   7455
      End
   End
   Begin VB.Timer Timer1
      Enabled         =   0   'False
      Interval        =   1750
      Left            =   5700
      Top             =   1020
   End
   Begin VB.TextBox txtSearch
      Height          =   375
      Left            =   180
      TabIndex        =   6
      Top             =   1080
      Width           =   3375
   End
   Begin VB.Data dataAPI2
      Caption         =   "dataAPI2"
      Connect         =   "Access"
      DatabaseName    =   ""
      DefaultCursorType=   0  'DefaultCursor
      DefaultType     =   2  'UseODBC
      Exclusive       =   -1  'True
      Height          =   300
      Left            =   5400
      Options         =   0
      ReadOnly        =   -1  'True
      RecordsetType   =   1  'Dynaset
      RecordSource    =   "SELECT * FROM [WIN32 Functions] ORDER BY NAME"
      Top             =   420
      Visible         =   0   'False
      Width           =   2295
   End
   Begin VB.Data dataAPI
      Caption         =   "dataAPI Data Control"
      Connect         =   "Access"
      DatabaseName    =   ""
      DefaultCursorType=   0  'DefaultCursor
      DefaultType     =   2  'UseODBC
      EOFAction       =   1  'EOF
      Exclusive       =   -1  'True
      Height          =   300
      Left            =   5400
      Options         =   0
      ReadOnly        =   -1  'True
      RecordsetType   =   1  'Dynaset
      RecordSource    =   "SELECT * FROM [WIN32 Functions] ORDER BY Name"
      Top             =   60
      Visible         =   0   'False
      Width           =   2295
   End
   Begin VB.CommandButton cmdCopy
      Caption         =   "&Copy"
      Height          =   495
      Index           =   0
      Left            =   6540
      TabIndex        =   13
      Top             =   5220
      Width           =   1095
   End
   Begin VB.CommandButton cmdAdd
      Caption         =   "&Add"
      Default         =   -1  'True
      Height          =   495
      Left            =   6540
      TabIndex        =   7
      Top             =   1620
      Width           =   1095
   End
   Begin VB.CommandButton cmdRemove
      Caption         =   "&Remove"
      Height          =   495
      Left            =   6540
      TabIndex        =   11
      Top             =   4620
      Width           =   1095
   End
   Begin VB.ListBox lstSelected
      Height          =   2175
      Left            =   180
      MultiSelect     =   2  'Extended
      Sorted          =   -1  'True
      TabIndex        =   15
      Top             =   4080
      Width           =   6255
   End
   Begin VB.ComboBox cmbType
      Height          =   300
      ItemData        =   "LISTAPI.frx":030A
      Left            =   240
      List            =   "LISTAPI.frx":0317
      Style           =   2  'Dropdown List
      TabIndex        =   2
      Top             =   420
      Width           =   2055
   End
   Begin MSDBCtls.DBList lstAPI
      Bindings        =   "LISTAPI.frx":0338
      DataField       =   "NAME"
      DataSource      =   "dataAPI2"
      Height          =   2205
      Left            =   180
      TabIndex        =   17
      Top             =   1620
      Width           =   6255
      _ExtentX        =   11033
      _ExtentY        =   3889
      _Version        =   327680
      MatchEntry      =   -1  'True
      BackColor       =   -2147483643
      ForeColor       =   -2147483640
      ListField       =   "Name"
      BoundColumn     =   "NAME"
   End
   Begin VB.Label lblType
      Caption         =   "&API Functions:"
      Height          =   195
      Left            =   180
      TabIndex        =   5
      Top             =   840
      Width           =   3015
      WordWrap        =   -1  'True
   End
   Begin VB.Label lblSelected
      Caption         =   "S&elected Definitions:"
      Height          =   195
      Left            =   180
      TabIndex        =   14
      Top             =   3840
      Width           =   1695
   End
   Begin VB.Label Label2
      Caption         =   "View &Type:"
      Height          =   195
      Left            =   240
      TabIndex        =   1
      Top             =   180
      Width           =   975
   End
   Begin VB.Label lblCategory
      Caption         =   "&Declare Category: "
      Height          =   195
      Left            =   3000
      TabIndex        =   3
      Top             =   180
      Width           =   1335
   End
   Begin VB.Menu mnuFile
      Caption         =   "&File"
      Begin VB.Menu mnuFileOptions
         Caption         =   "&Options..."
         Shortcut        =   ^O
      End
      Begin VB.Menu mnuSep1
         Caption         =   "-"
         Index           =   0
      End
      Begin VB.Menu mnuFileAddin
         Caption         =   "&Make ListAPI an Add-In"
         Shortcut        =   ^M
      End
      Begin VB.Menu mnuSep2
         Caption         =   "-"
      End
      Begin VB.Menu mnuFileExit
         Caption         =   "E&xit"
         Shortcut        =   ^X
      End
   End
   Begin VB.Menu mnuEdit
      Caption         =   "&Edit"
      Begin VB.Menu mnuEditAdd
         Caption         =   "A&dd"
         Shortcut        =   ^D
      End
      Begin VB.Menu mnuEditSelect
         Caption         =   "&Select..."
         Shortcut        =   ^S
      End
      Begin VB.Menu mnuSep3
         Caption         =   "-"
      End
      Begin VB.Menu mnuEditCopy
         Caption         =   "&Copy"
         Shortcut        =   ^C
      End
      Begin VB.Menu mnuEditInsert
         Caption         =   "&Insert"
         Shortcut        =   ^I
         Visible         =   0   'False
      End
      Begin VB.Menu mnuSep
         Caption         =   "-"
      End
      Begin VB.Menu mnuEditRemove
         Caption         =   "&Remove"
         Shortcut        =   ^R
      End
      Begin VB.Menu mnuEditClear
         Caption         =   "C&lear All"
         Shortcut        =   ^A
      End
   End
   Begin VB.Menu mnuHelp
      Caption         =   "&Help"
      Begin VB.Menu mnuHelpAbout
         Caption         =   "&About"
      End
   End
   Begin VB.Menu mnuRightButton
      Caption         =   "Right button"
      Visible         =   0   'False
      Begin VB.Menu mnuRightAdd
         Caption         =   "&Add"
      End
      Begin VB.Menu mnuRightSelect
         Caption         =   "&Select"
      End
      Begin VB.Menu mnuRightSep1
         Caption         =   "-"
      End
      Begin VB.Menu mnuRightRemove
         Caption         =   "&Remove"
      End
      Begin VB.Menu mnuRightClear
         Caption         =   "C&lear All"
      End
      Begin VB.Menu mnuRightSep2
         Caption         =   "-"
      End
      Begin VB.Menu mnuRightCopy
         Caption         =   "&Copy"
      End
      Begin VB.Menu mnuRightInsert
         Caption         =   "&Insert"
      End
   End
Attribute VB_Name = "frmAPI"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' Copyright
 1996 by Desaware Inc.
' Part of the Desaware API Toolkit
' All Rights Reserved
Option Explicit
Option Compare Text
Public Sub Initialize()
    Dim tableName$
    which% = cmbType.ListIndex ' Figure out which type the user selected.
    Select Case cmbType.ListIndex
    Case CMB_TYPES:
        lblCategory.Visible = False
        cmbCategory.Visible = False
        lblType = "Windows Types:" ' Set the listbox label.
        ' Get the end of the table name. The WIN32/16 will be filled in later.
        tableName$ = "Types]"
        ReloadSelectedList TypesSelected(), TypesNo& ' Reload the lstSelected box.
    Case CMB_CONSTANTS:
        lblCategory.Visible = False
        cmbCategory.Visible = False
        lblType = "Windows Constants:"
        tableName$ = "Constants]"
        ReloadSelectedList ConstantsSelected(), ConstantsNo&
    Case Else: 'CMB_DECLARES
        lblCategory.Visible = True
        cmbCategory.Visible = True
        lblType = "API Functions:"
        tableName$ = "Functions]"
        ReloadSelectedList DeclaresSelected(), DeclaresNo&
        ' Query the database to show only entries of the selected category.
        If cmbCategory.ItemData(cmbCategory.ListIndex) > 0 Then
            tableName$ = tableName$ + "WHERE CATEGORY = " & cmbCategory.ItemData(cmbCategory.ListIndex)
        End If
    End Select
    'Check if it's WIN16 or WIN32 stuff we're copying.
    If options% = OPT_WIN16 Then
        tableName$ = "[WIN16 " + tableName$
    Else
        tableName$ = "[WIN32 " + tableName$
    End If
    dataAPI.RecordSource = "SELECT * FROM " + tableName$ + " ORDER BY Name"
    dataAPI2.RecordSource = "SELECT * FROM " + tableName$ + " ORDER BY Name"
    dataAPI.Refresh
    dataAPI2.Refresh
End Sub
Public Sub cmbCategory_Click()
    Initialize
End Sub
Public Sub cmbType_Click()
    Initialize
End Sub
' Runs the AAddItem function with the correct array and count as an argument.
' Sets the alreadycopied flag to false because the selected items have changed.
Public Sub cmdAdd_Click()
    AlreadyCopied% = False
    Select Case which%
    Case CMB_DECLARES:
        AAddItem DeclaresSelected(), DeclaresNo&
    Case CMB_TYPES:
        AAddItem TypesSelected(), TypesNo&
    Case CMB_CONSTANTS:
       AAddItem ConstantsSelected, ConstantsNo&
    End Select
End Sub
Private Sub cmdAdd_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Status = "Click to add the currently selected item to the lower listbox."
End Sub
Public Sub cmdClear_Click()
    Dim i&
    Screen.MousePointer = 11
    Me.Enabled = False
    'Remove every single item in the list box
    While lstSelected.ListCount
        lstSelected.RemoveItem 0
    Wend
    'set every element of every array as free
    For i& = 0 To TypesNo& - 1
        TypesSelected(i&).Free = True
    Next i&
    For i& = 0 To ConstantsNo& - 1
        ConstantsSelected(i&).Free = True
    Next i&
    For i& = 0 To DeclaresNo& - 1
        DeclaresSelected(i&).Free = True
    Next i&
    AlreadyCopied% = True
    Screen.MousePointer = 0
    Me.Enabled = True
End Sub
Public Sub cmdClear_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Status = "Click to clear ALL select items."
End Sub
' Runs through all of the FOOBARselected() arrays and copies all the selected
' types, functions, and constants to the clipboard.
Public Sub cmdCopy_Click(Index As Integer)
    Dim clipstring$, i&, j%, pstring$, smthCopied%, fStatus%, tstring$
    Dim tableName$
    Me.Enabled = False
    Status.Visible = False
    On Error GoTo handler:
    If TypesNo& = 0 And DeclaresNo& = 0 And ConstantsNo& = 0 Then
        Beep
        MsgBox "Nothing to copy!", 0 + 48, "API Copier Error"
        Exit Sub
    End If
    Screen.MousePointer = 11
    Me.Enabled = True
    If options% = OPT_WIN16 Then
        tableName$ = "WIN16"
    Else
        tableName$ = "WIN32"
    End If
'**************************************************
'*** WINDOWS TYPES
    If Comments% Then
        tstring$ = tstring$ & NL & "'**********************************" & NL
        tstring$ = tstring$ & "'**  Type Definitions: " & NL & NL
    End If
    tstring$ = tstring$ & "#if " & tableName$ & " Then" & NL
    fStatus% = CopyTypes%(tableName$, tstring$)
    If options% = OPT_BOTH Then
        tstring$ = tstring$ & "#else " & NL
        If fStatus% Or CopyTypes%("WIN16", tstring$) Then
            smthCopied% = True
            tstring$ = tstring$ + "#endif 'WIN32 Types" & NL
            clipstring$ = clipstring$ + tstring$
        End If
    Else
        If fStatus% Then
            smthCopied% = True
            tstring$ = tstring$ + "#endif '" & tableName$ & " Types" & NL
            clipstring$ = clipstring$ + tstring$
        End If
    End If
'**************************************************
'*** WINDOWS Constants
    tstring$ = ""
    If Comments% Then
        tstring$ = tstring$ & NL & "'**********************************" & NL
        tstring$ = tstring$ & "'**  Constant Definitions: " & NL & NL
    End If
    tstring$ = tstring$ & "#if " & tableName$ & " Then " & NL
    fStatus% = CopyConstants%(tableName$, tstring$)
    If options% = OPT_BOTH Then
        tstring$ = tstring$ & "#else " & NL
        If fStatus% Or CopyConstants%("WIN16", tstring$) Then
            smthCopied% = True
            clipstring$ = clipstring$ + tstring$
            clipstring$ = clipstring$ + "#endif 'WIN32 " & NL
        End If
    Else
        If fStatus% Then
            smthCopied% = True
            tstring$ = tstring$ + "#endif '" & tableName$ & NL
            clipstring$ = clipstring$ + tstring$
        End If
    End If
'**************************************************
'*** WINDOWS Functions
    tstring$ = ""
    If Comments% Then
        tstring$ = tstring$ & NL & "'**********************************" & NL
        tstring$ = tstring$ & "'**  Function Declarations: " & NL & NL
    End If
    tstring$ = tstring$ & "#if " & tableName$ & " Then" & NL
    fStatus% = CopyFunctions%(tableName$, tstring$)
    If options% = OPT_BOTH Then
        tstring$ = tstring$ & "#else " & NL
        If fStatus% Or CopyFunctions%("WIN16", tstring$) Then
            smthCopied% = True
            tstring$ = tstring$ + "#endif 'WIN32" & NL
            clipstring$ = clipstring$ + tstring$
        End If
    Else
        If fStatus% Then
            smthCopied% = True
            tstring$ = tstring$ + "#endif '" & tableName$ & NL
            clipstring$ = clipstring$ + tstring$
        End If
    End If
 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''' Copy The actual text to the clipboard.
    If smthCopied = False Then
        Beep
        MsgBox "Nothing to copy!", 0 + 48, "API Copier Error"
        Screen.MousePointer = 0
        Me.Enabled = True
        Status.Visible = True
        Status = ""
        Exit Sub
    Else
        If IsAddin% And Index = 1 Then 'Insert Button
            Status = "Inserting Declarations..."
            j% = FreeFile
            Open App.Path & "\temp.txt" For Output As j%
            Print #j%, clipstring$
            Close #j%
            objVBInst.ActiveProject.SelectedComponents(0).InsertFile App.Path & "\temp.txt"
            Kill App.Path & "\temp.txt"
            pctStatus.Line (0, 0)-(pctStatus.Width, pctStatus.Height), QBColor(9), BF
            Screen.MousePointer = 0
        Else 'Copy Button
            Status = "Copying Declarations..."
            Clipboard.Clear
            Clipboard.SetText clipstring$
            pctStatus.Line (0, 0)-(pctStatus.Width, pctStatus.Height), QBColor(9), BF
            Screen.MousePointer = 0
        End If
        AlreadyCopied% = True
        Beep
        If IsAddin% And Index = 1 Then 'Insert Button
            MsgBox "Inserted Declarations into " & objVBInst.ActiveProject.SelectedComponents(0).Name & ".", 0 + 64, "API Copier"
        Else 'Copy Button
            MsgBox "Copying finished.", 0 + 64, "API Copier"
        End If
    End If
    Me.Enabled = True
    Status.Visible = True
    Status = ""
    Exit Sub
handler:
MsgBox Error$
Screen.MousePointer = 0
Exit Sub
End Sub
Public Sub cmdCopy_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    Select Case Index
        Case 0:
            Status = "Click to copy all lower listbox items to clipboard."
        Case 1:
            Status = "Click to insert all lower listbox items into the current form."
    End Select
End Sub
Public Sub cmdOptions_Click()
    frmOptions.Show 1
End Sub
Public Sub cmdOptions_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Status = "Click to select options..."
End Sub
' Selects all entries from the database that match the criteria for the "NAME"
' field. The criteria are supplied by the user and the "like" operator is used
' to compare the name and the criteria.
Public Sub cmdQuery_Click()
    Dim s$, t$
    Dim myRecSet As Recordset
    Me.Enabled = False
    'Find out from which part of the database we are selecting.
    Select Case which%
    Case CMB_DECLARES:
        t$ = "Functions"
    Case CMB_TYPES:
        t$ = "Types"
    Case CMB_CONSTANTS:
        t$ = "Constants"
    End Select
    s$ = "Please enter the NAME criteria for all the functions you want to select:" & NL
    s$ = s$ & NL & "Wilcards:" & NL & NL
    s$ = s$ & "*                      Any number of any characters" & NL
    s$ = s$ & "?                      Any One Character" & NL
    s$ = s$ & "#                      Any one Digit" & NL
    s$ = s$ & "[a-zA-Z12]       Any character in the range 'A'-'Z', 'a'-'z', " & NL
    s$ = s$ & "                             and the characters '1' and '2'" & NL
    s$ = s$ & "[!a-zA-Z12]      Any character NOT matching above" & NL
    s$ = s$ & "                             criteria" & NL
    s$ = InputBox(s$, "Enter Criteria", "")
    Screen.MousePointer = 11
    If s$ = "" Then
        Screen.MousePointer = 0
        Me.Enabled = True
        Exit Sub
    End If
    s$ = "SELECT * FROM [Win32 " & t$ & "] WHERE NAME LIKE """ & s$ & """"
    Set myRecSet = dataAPI2.Database.OpenRecordset(s$, dbOpenDynaset, 0)
    While Not myRecSet.EOF
        AlreadyCopied% = False
        Select Case which%
        Case CMB_DECLARES:
            QueryAddItem DeclaresSelected(), DeclaresNo&, myRecSet("NAME")
        Case CMB_TYPES:
            QueryAddItem TypesSelected(), TypesNo&, myRecSet("NAME")
        Case CMB_CONSTANTS:
            QueryAddItem ConstantsSelected, ConstantsNo&, myRecSet("NAME")
        End Select
        myRecSet.MoveNext
    Wend
    Screen.MousePointer = 0
    Me.Enabled = True
End Sub
Private Sub cmdQuery_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Status = "Click to selected all entries matching a criteria..."
End Sub
' Runs the ARemoveItem function with the correct array and count as argument.
' Sets the alreadycopied flag to false because the selected items have changed.
Public Sub cmdRemove_Click()
    Dim i&, j&
    AlreadyCopied% = False
    j& = lstSelected.ListCount - 1
    Select Case which%
        Case CMB_DECLARES:
            While i& <= j&
                If lstSelected.Selected(i&) Then
                    ARemoveItem DeclaresSelected(), DeclaresNo&, i&
                    j& = j& - 1
                Else
                    i& = i& + 1
                End If
            Wend
        Case CMB_TYPES:
            While i& <= j&
                If lstSelected.Selected(i&) Then
                    ARemoveItem TypesSelected(), TypesNo&, i&
                    j& = j& - 1
                Else
                    i& = i& + 1
                End If
            Wend
        Case CMB_CONSTANTS:
            While i& <= j&
                If lstSelected.Selected(i&) Then
                    ARemoveItem ConstantsSelected, ConstantsNo&, i&
                    j& = j& - 1
                Else
                    i& = i& + 1
                End If
            Wend
    End Select
    If lstSelected.ListCount = 0 Then
        AlreadyCopied% = True
    End If
End Sub
Private Sub cmdRemove_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Status = "Click to remove the selected item(s) from the listbox."
End Sub
Public Sub Form_Load()
    Dim tblCat As Object
    Load frmAbout
    Me.Top = (Screen.Height - Me.Height) / 2
    Me.Left = (Screen.Width - Me.Width) / 2
    frmAbout.Caption = ""
    frmAbout!Command1.Visible = False
    frmAbout.Show
    frmAbout.MousePointer = 11
    DoEvents
    dataAPI.DatabaseName = App.Path & "\apidata.mdb"
    dataAPI2.DatabaseName = dataAPI.DatabaseName
    NL = Chr$(13) + Chr$(10)  ' Make a NewLine string.
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ''''''' Set status bar
    Status = "Choose the 'Add' Button to select an item."
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ''''''' Update the data controls, open the database, and load the Categories
    ''''''' Combo box
    dataAPI.Refresh
    dataAPI2.Refresh
    Set tblCat = dataAPI.Database.OpenTable("CATEGORIES")
    While Not tblCat.EOF
        cmbCategory.AddItem tblCat("DESCRIPTION")
        cmbCategory.ItemData(cmbCategory.NewIndex) = tblCat("ID")
        tblCat.MoveNext
    Wend
    cmbCategory.AddItem "All Categories", 0
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ''''''' Restore the previous settings.
    options% = Val(GetSetting("ListAPI", "Copying", "Options", OPT_BOTH))
'    options% = OPT_BOTH
    Comments% = Val(GetSetting("ListAPI", "Copying", "Comments", -1))
'    Comments% = True
    Glbl% = Val(GetSetting("ListAPI", "Copying", "Global", -1))
'    Glbl% = False
    AlreadyCopied% = True
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ''''''' Set the beginning values of the TYPES combo and the CATEGORY combo.
    cmbCategory.ListIndex = 0  ' All categories
    cmbType.ListIndex = CMB_DECLARES
    If IsAddin% Then
        mnuEditInsert.Enabled = True
    End If
    Load frmOptions
    Me.Show
    frmAbout.MousePointer = 0
    Unload frmAbout
    lstAPI.SetFocus
    lstHwnd = GetFocus&()
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button And vbRightButton Then
        mnuRightRemove.Visible = True
        mnuRightClear.Visible = True
        mnuRightAdd.Visible = True
        mnuRightSelect.Visible = True
        mnuRightSep2.Visible = True
        mnuRightSep1.Visible = True
        PopupMenu mnuRightButton, vbPopupMenuRightButton, X, Y
    End If
End Sub
Public Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'    If Y < 4000 Then
'        status = "Choose the 'Add' Button to select an item."
'    Else
'        status = "Choose the 'Remove' Button de-select an item or press the 'Copy' Button to send it all to the clipboard."
'    End If
    Status = ""
End Sub
Public Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    If Not AlreadyCopied% Then ' If the information wasn't saved....
        Beep
        Select Case MsgBox("Copy selected items to Clipboard?", 3 + 32, "API Copier")
        Case 7: 'No
        Case 6: 'yes
            cmdCopy_Click 0
        Case 2: 'cancel
            Cancel = True
            Exit Sub
        End Select
    End If
    SaveSetting "ListAPI", "Copying", "Options", "" & options%
    SaveSetting "ListAPI", "Copying", "Global", "" & Glbl%
    SaveSetting "ListAPI", "Copying", "Comments", "" & Comments%
    End
End Sub
Public Sub lstAPI_Click()
    ' UpdateBoundField lstAPI.Text
    ' Changed to defer the update, since updating immediately
    ' causes the keyboard matching to fail 4/14/96 DSA
End Sub
Public Sub lstAPI_DblClick()
    cmdAdd_Click
End Sub
Public Sub lstAPI_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Status = "Choose the 'Add' Button to select an item."
End Sub
Public Sub lstSelected_DblClick()
    cmdRemove_Click
End Sub
Private Sub lstSelected_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button And vbRightButton Then
        mnuRightRemove.Visible = True
        mnuRightClear.Visible = True
        mnuRightAdd.Visible = False
        mnuRightSelect.Visible = True
        mnuRightSep2.Visible = True
        mnuRightSep1.Visible = True
        PopupMenu mnuRightButton, vbPopupMenuRightButton, X + lstSelected.Left, Y + lstSelected.Top
    End If
End Sub
Public Sub lstSelected_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Status = "Choose the 'Remove' Button de-select an item or press the 'Copy' Button to send it all to the clipboard."
End Sub
Public Sub mnuEditClear_Click()
    cmdClear_Click
End Sub
Public Sub mnuEditCopy_Click()
    cmdCopy_Click 0
End Sub
Public Sub mnuEditInsert_Click()
    cmdCopy_Click 1
End Sub
Public Sub mnuEditRemove_Click()
    cmdRemove_Click
End Sub
Public Sub mnuEditSelect_Click()
    cmdQuery_Click
End Sub
Public Sub mnuFileAddin_Click()
  On Error Resume Next
  Dim sOSVer As String
#If Win16 Then
  sOSVer = "16"
  Dim X As Integer
#Else
  sOSVer = "32"
  Dim X As Long
#End If
  'try to register the ListAPI add-in stub
  X = Shell(App.Path & "\LSTADDIN.EXE /regserver")
  If Err Then
    MsgBox "Error: " & Error$
    Exit Sub
  End If
  'try to register VisData
  X = Shell(App.Path & "\" & App.EXEName & ".EXE /regserver")
  If Err Then
    MsgBox "You must run this from an EXE!", 48
    Exit Sub
  End If
  'only add it if the registration was successful
  ' VB4 here
  X = OSWritePrivateProfileString("Add-Ins" & sOSVer, "lstaddin.ListAPIAddInClass", "1", "VB.INI")
  ' VB5 here
  X = OSWritePrivateProfileString("Add-Ins32" & sOSVer, "lstaddin.ListAPIAddInClass", "1", "VBADDIN.INI")
End Sub
Public Sub mnuFileExit_Click()
    Unload Me
End Sub
Public Sub mnuFileOptions_Click()
    frmOptions.Show 1
End Sub
Public Sub mnuHelpAbout_Click()
    frmAbout.Show 1
End Sub
Private Sub mnuRightAdd_Click()
    cmdAdd_Click
End Sub
Private Sub mnuRightClear_Click()
    cmdClear_Click
End Sub
Private Sub mnuRightCopy_Click()
    cmdCopy_Click 0
End Sub
Private Sub mnuRightInsert_Click()
    cmdCopy_Click 1
End Sub
Private Sub mnuRightRemove_Click()
    cmdRemove_Click
End Sub
Private Sub mnuRightSelect_Click()
    cmdQuery_Click
End Sub
' 1.75 seconds after the last keystroke was entered, reset the textbox
'      and the search string.
Public Sub Timer1_Timer()
     txtSearch = ""
     Timer1.Enabled = False
End Sub
Public Sub txtSearch_KeyPress(KeyAscii As Integer)
    Dim dl&
    If KeyAscii <> 8 Then
'        KeyAscii = 0
'        txtSearch = ""
        dl& = SendMessage&(lstHwnd, WM_CHAR, KeyAscii, 0)
    End If
    ' Restart the timer
    Timer1.Enabled = False
    Timer1.Enabled = True
End Sub
Public Sub txtSearch_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
        Status = "Enter the text to search for. Text will reset after 1.75 seconds."
End Sub