Option Explicit

Dim mintColorShift As Integer

Private Sub Form_Load()
    `Center form on screen
    Me.Left = (Screen.Width - Me.Width) \ 2
    Me.Top = (Screen.Height - Me.Height) \ 2
End Sub

Private Sub Form_MouseDown(Button As Integer, _
Shift As Integer, X As Single, Y As Single)
    `Shift color bars based on mouse button
    mintColorShift = (mintColorShift - Button * 2 + 19) Mod 16
    `Activate timer to draw color bars
    tmrDrawBars.Enabled = True
End Sub

Private Sub Form_Resize()
    `Activate timer to draw color bars
    tmrDrawBars.Enabled = True
End Sub

Private Sub tmrDrawBars_Timer()
    Dim intX As Integer
    Dim intY As Integer
    `Deactivate timer so that color bars are drawn only once
    tmrDrawBars.Enabled = False
    `Scale form for convenience
    Scale (4, 4)-(0, 0)
    `Fill in colors
    For intX = 0 To 3
        For intY = 0 To 3
            mintColorShift = (mintColorShift + 1) Mod 16
            Line (intX, intY)-(intX + 1, intY + 1), _
                QBColor(mintColorShift), BF
        Next intY
    Next intX
End Sub

Option Explicit

Private Sub Form_Click()
    Dim strA As String
    Dim strT As String
    Dim intState As Integer
    Dim intI As Integer
    Dim intJ As Integer
    Dim intK As Integer
    Dim intN As Integer
    Print "WorkingDear John, How Do I... "
    Open App.Path & "\Win32api.txt" For Input As #1
    Open App.Path & "\W32cons.txt" For Output As #2
    Open App.Path & "\W32type.txt" For Output As #3
    Open App.Path & "\W32decl.txt" For Output As #4
    Do Until EOF(1)
        Line Input #1, strA
        If InStr(strA, "Const ") Then intState = 2
        If InStr(LTrim(strA), "Type ") = 1 Then
            strA = "Private " & strA
            intState = 3
        End If
        If InStr(LTrim(strA), "Declare ") = 1 Then
            intState = 4
        End If
        If intState = 2 Then
            intI = InStr(strA, "`")
            If intI > 0 Then
                strA = Trim(Left(strA, intI - 1))
            End If
            If strA <> "" Then
                intI = InStr(strA, "Public")
                If intI = 1 Then
                    Print #2, strA

                Else
                    Print #2, "Private " & strA
                End If
            End If
        End If
        If intState = 3 Then
            If Left(strA, 1) = " " Then
                strA = Space(4) & Trim(strA)
            End If
            intJ = InStr(strA, "`")
            If intJ > 0 Then
                strA = RTrim(Left(strA, intJ - 1))
            End If
            Print #3, strA
        End If
        If intState = 4 Then
            intN = 2
            If Trim(strA) = "" Then
                Print #4, ""
            Else
                `Lop off comments
                intI = InStr(strA, ")")
                intJ = InStr(intI, strA, "`")
                If intJ > intI Then strA = Trim(Left(strA, intJ - 1))
                `Drop Alias if not different from original function
                intI = InStr(strA, "Alias")
                If intI Then
                    intJ = InStr(intI, strA, Chr(34))
                    intK = InStr(intJ + 1, strA, Chr(34))
                    strT = Mid(strA, intJ + 1, intK - intJ - 1)
                    strT = Space(1) & strT & Space(1)
                    If InStr(strA, strT) Then
                        strA = Left(strA, intI - 1) & _
                            Mid(strA, intK + 1)

                    End If

                End If
                `Locate "Lib"
                intI = InStr(strA, " Lib")
                `Insert "Private"
                Print #4, "Private Declare " & _
                    Mid(strA, 9, intI - 8) & "_"
                strA = Mid(strA, intI + 1)
                `Locate left parenthesis
                intI = InStr(strA, "(")
                Print #4, Left(strA, intI) & " _"
                strA = Mid(strA, intI + 1)
                `Locate each parameter
                Do
                    intI = InStr(strA, ", ")
                    If intI = 0 Then Exit Do
                    Print #4, Space(4) & Left(strA, intI) & " _"
                    intN = intN + 1
                    strA = Mid(strA, intI + 2)
               Loop; 
                `Locate right parenthesis
                intI = InStr(strA, ")")
                    Print #4, Space(4) & Left(strA, intI - 1) & " _"
                Print #4, Mid(strA, intI)
            End If
        End If
        If intState = 2 Then intState = 0
        If intState = 3 And InStr(strA, "End Type") > 0 Then
            intState = 0
            Print #3, ""
        End If
        If intState = 4 Then
            intState = 0

            Print #4, ""
        End If
    Loop
    Close #1
    Close #2
    Close #3
    Close #4
    Print "Done"
End Sub

Option Explicit

Public FormDisplayed          As Boolean
Public VBInstance             As VBIDE.VBE
Dim mcbMenuCommandBar         As Office.CommandBarControl
Dim mfrmAPIAddin              As New frmAPIAddin
Public WithEvents MenuHandler As CommandBarEvents

Sub Hide()
    On Error Resume Next
    FormDisplayed = False
    mfrmAPIAddin.Hide
End Sub

Sub Show()
    On Error Resume Next
    If mfrmAPIAddin Is Nothing Then
        Set mfrmAPIAddin = New frmAPIAddin
    End If

    Set mfrmAPIAddin.VBInstance = VBInstance
    Set mfrmAPIAddin.Connect = Me
    FormDisplayed = True
    mfrmAPIAddin.Show
End Sub

`------------------------------------------------------
`This method adds the add-in to VB
`------------------------------------------------------
Private Sub AddinInstance_OnConnection(ByVal Application As Object, _
    ByVal ConnectMode As AddInDesignerObjects.ext_ConnectMode, _
    ByVal AddInInst As Object, custom() As Variant _
)
    On Error GoTo error_handler
    `Save the VB instance
    Set VBInstance = Application
    `This is a good place to set a breakpoint and
    `test various add-in objects, properties, and methods
    Debug.Print VBInstance.FullName
    If ConnectMode = ext_cm_External Then
        `Used by the wizard toolbar to start this wizard
        Me.Show
    Else
        Set mcbMenuCommandBar = AddToAddInCommandBar("API Addin")
        `Sink the event
        Set Me.MenuHandler = _
            VBInstance.Events.CommandBarEvents(mcbMenuCommandBar)
    End If

    If ConnectMode = ext_cm_AfterStartup Then
        If GetSetting(App.Title, "Settings", _
            "DisplayOnConnect", "0") = "1" Then
            `Set this to display the form on connect
            Me.Show

        End If
    End If
    Exit Sub
error_handler:
    MsgBox Err.Description
End Sub

`------------------------------------------------------
`This method removes the add-in from VB
`------------------------------------------------------
Private Sub AddinInstance_OnDisconnection(ByVal RemoveMode _
    As AddInDesignerObjects.ext_DisconnectMode, _
    custom() As Variant _
)
    On Error Resume Next
    `Delete the command bar entry
    mcbMenuCommandBar.Delete
    `Shut down the add-in
    If FormDisplayed Then
        SaveSetting App.Title, "Settings", "DisplayOnConnect", "1"
        FormDisplayed = False
    Else
        SaveSetting App.Title, "Settings", "DisplayOnConnect", "0"
    End If
    Unload mfrmAPIAddin
    Set mfrmAPIAddin = Nothing
End Sub

Private Sub IDTExtensibility_OnStartupComplete(custom() As Variant)
    If GetSetting(App.Title, "Settings", _
        "DisplayOnConnect", "0") = "1" Then
        `Set this to display the form on connect
        Me.Show
    End If

End Sub

`This event fires when the menu is clicked in the IDE
Private Sub MenuHandler_Click(ByVal CommandBarControl As Object, _
    handled As Boolean, CancelDefault As Boolean _
)
    Me.Show
End Sub

Function AddToAddInCommandBar(sCaption As String) As _
    Office.CommandBarControl
    Dim cbMenuCommandBar As Office.CommandBarControl  `command bar object
    Dim cbMenu As Object
    On Error GoTo AddToAddInCommandBarErr
    `See if we can find the Add-Ins menu
    Set cbMenu = VBInstance.CommandBars("Add-Ins")
    If cbMenu Is Nothing Then
        `Not available, so we fail
        Exit Function
    End If
    `Add it to the command bar
    Set cbMenuCommandBar = cbMenu.Controls.Add(1)
    `Set the caption
    cbMenuCommandBar.Caption = sCaption
    Set AddToAddInCommandBar = cbMenuCommandBar
    Exit Function
AddToAddInCommandBarErr:
End Function

Option Explicit

Public VBInstance As VBIDE.VBE
Public Connect As Connect

Private mstrCon As String
Private mstrTyp As String
Private mstrDec As String

Private Sub cmdCopy_Click()
    `Copy selected text to clipboard
    Clipboard.SetText rtfAPI.SelText
    `Return to user's project
    Unload Me
End Sub

Private Sub cmdFind_Click()
    Dim lngPtr As Long
    Dim strFind As String
    `Put focus on rich text box
    rtfAPI.SetFocus
    `Grab search string
    strFind = txtFind.Text
    `Determine where to begin search
    If rtfAPI.SelLength Then
        lngPtr = rtfAPI.SelStart + rtfAPI.SelLength
    Else
        lngPtr = 0
    End If
    `Use rich text box's Find method
    lngPtr = rtfAPI.Find(strFind, lngPtr)
    If lngPtr = -1 Then
        MsgBox "Search text not found"
    End If
End Sub

Private Sub Form_Load()
    `Startup showing declarations
    optAPI(2).Value = True
    txtFind.Text = ""
    Me.Show
    Me.ZOrder
End Sub

Private Sub optAPI_Click(Index As Integer)
    Select Case Index
    `Constants
    Case 0
        If mstrCon = "" Then
            LoadUp mstrCon, "W32cons.txt"
        End If
        rtfAPI.Text = mstrCon
    `Type structures
    Case 1
        If mstrTyp = "" Then
            LoadUp mstrTyp, "W32type.txt"
        End If
        rtfAPI.Text = mstrTyp
    `Declarations
    Case 2
        If mstrDec = "" Then
            LoadUp mstrDec, "W32decl.txt"
        End If
        rtfAPI.Text = mstrDec
    End Select
End Sub

Private Sub LoadUp(sA As String, sFile As String)

    Open App.Path & "\" & sFile For Binary As #1
    sA = Space(LOF(1))
    Get #1, , sA
    Close #1
End Sub

Private Sub rtfAPI_SelChange()
    If rtfAPI.SelLength Then
        cmdCopy.Enabled = True
    Else
        cmdCopy.Enabled = False
    End If
End Sub
Private Sub txtFind_Change()
    If Len(txtFind.Text) Then
        cmdFind.Enabled = True
    Else
        cmdFind.Enabled = False
    End If
End Sub

Option Explicit

Private Sub cmdOK_Click()
    MsgBox "This example quiz is not graded."
    Unload Me
End Sub

Option Explicit

Private Sub Form_Load()
    txtMeters.Text = "0"
    txtCentimeters.Text = "0"
End Sub

Private Sub txtCentimeters_Change()
    txtInches.Text = CStr(CDbl(txtCentimeters.Text) * 0.393700787402)
End Sub

Private Sub txtMeters_Change()
    txtFeet.Text = CStr(CDbl(txtMeters.Text) * 3.28083989501)
End Sub

Conversions:
{button Meters to feet, ExecProgram("Metric.exe M2F")} 
{button Centimeters to inches, ExecProgram("Metric.exe C2I")} To hear 
a {button Sound, ExecProgram("Metric.exe wav 1")} click this button, 
and to see a sample {button Video clip, 
ExecProgram("Metric.exe avi 1")} click here. When you're ready, 
click this {button Quiz, ExecProgram("Metric.exe QUIZ 1")} button.