VB6高级版API浏览器

实例介绍

【实例简介】VB6高级版API浏览器，可替代内置的WINAPI浏览器，功能更强大，有分类筛选功能，实现快速精准定位，并且附带了几个WIN10风格的控件。
【实例截图】
【核心代码】
Option Explicit
 
Private Type apiEntry
    DisplayName As String   ' Displayed name (Searchable)
    Library As String       ' Library in which a Sub/Function is located
    Code As String          ' Complete entry code
    EntryType As Integer    ' 1 = Constant, 2 = Declare, 3 = Type
End Type
 
Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
Private Declare Function LockWindowUpdate Lib "user32" (ByVal hWndLock As Long) As Long
 
Private Const COLOR_BTNSHADOW = 16
Private Const COLOR_BTNFACE = 15
Private Const COLOR_WINDOW = 5
 
Private Const WM_KEYDOWN = &H100
 
Private vCategories As Variant
Private vCategoryDeclares(61) As Variant
 
Private APIEntries() As apiEntry
Private DLLEntries() As String
 
Private APIFileLoaded As Boolean
Private ListSearchIndex As Long
 
Private Sub chkNoComments_Click()
    UpdateFullTextView
End Sub
 
Private Sub chkScope_Click(Index As Integer)
    UpdateFullTextView
End Sub
 
Private Sub cmbCategories_Click()
    ChangeListingType cmbEntryType.ListIndex
End Sub
 
Private Sub cmbEntryType_Click()
    SetCategoriesEnabled cmbEntryType.ListIndex = 1
    ChangeListingType cmbEntryType.ListIndex
End Sub
 
Private Sub cmbLibraryList_Click()
    ChangeListingType cmbEntryType.ListIndex
End Sub
 
Private Sub cmdClear_Click()
    lstSelectedItems.Clear
 
    cmdClear.Enabled = False
    cmdCopy.Enabled = False
    cmdInsert.Enabled = False
    cmdRemove.Enabled = False
 
    UpdateFullTextView
End Sub
 
Private Sub cmdCopy_Click()
    Clipboard.SetText CStr(txtItemText.Text), vbCFText
End Sub
 
Private Sub cmdLoadFile_Click()
    LoadAPIFile App.Path & "\win32api.txt"
End Sub
 
Private Sub cmdRemove_Click()
    Dim dwSelIndex As Long
 
    dwSelIndex = lstSelectedItems.ListIndex
    If dwSelIndex > -1 Then
        lstSelectedItems.RemoveItem dwSelIndex
        If dwSelIndex > 0 And lstSelectedItems.ListCount > 0 Then
            dwSelIndex = dwSelIndex - 1
        ElseIf lstSelectedItems.ListCount > 0 Then
            dwSelIndex = 0
        Else
            dwSelIndex = -1
        End If
 
        If dwSelIndex > -1 Then
            lstSelectedItems.ListIndex = dwSelIndex
        Else
            cmdClear.Enabled = False
            cmdCopy.Enabled = False
            cmdInsert.Enabled = False
            cmdRemove.Enabled = False
        End If
 
        UpdateFullTextView
    End If
End Sub
 
Private Sub cmdShow_Click()
    PopupMenu menu_showpopup, , cmdShow.Left, cmdShow.Top   cmdShow.Height
End Sub
 
Private Sub Form_Load()
    On Local Error Resume Next
 
    Dim intIndex As Integer
 
    vCategories = Array("(None)", "Accessibility", "Audio", "Bitmaps", "Brushes", "Console", "Common Controls", "Common Dialog", "Communication", "Cursor", "Devices", "Dialog Boxes", "Errors", "Events", "Event Logs", "Files & Directories", "File System", "Filled Shapes", "Fonts & Text", "Handles", "Help", "Icons", "INI Files", "Input (General)", "Joysticks", "Keyboard", "Lines & Curves", "Libraries", "Math", "Media Control Interface (MCI)", "Memory", "Menus", "Messages", "Mouse", "National Language Support", "OLE", "Painting & Drawing", "Pens", "Pointers", "Printers", "Pipes", "Processes & Threads", "Rectangles", "Regions", "Registry", "Resources", "Shell", "Shutdown", "Strings", "SIDs", "Synchronization", "System Information", "Tape Devices", "Time", "Timers", "Tool Help", "Tokens", "Window Classes", "Window Procedures", "Window Properties", "Windows", "Winsock", "Other")
 
    vCategoryDeclares(0) = " getsystemmetrics systemparametersinfo "
    vCategoryDeclares(1) = " auxgetdevcaps auxgetnumdevs auxgetvolume auxsetvolume playsound sndplaysound waveoutgetdevcaps waveoutgetnumdevs waveoutgetvolume waveoutsetvolume "
    vCategoryDeclares(2) = " bitblt extfloodfill getpixel setpixel setpixelv stretchblt "
    vCategoryDeclares(3) = " createhatchbrush createsolidbrush getbrushorgex setbrushorgex "
    vCategoryDeclares(4) = " readconsoleoutput writeconsoleoutput readconsoleoutputcharacter readconsoleoutputattribute writeconsoleoutputcharacter writeconsoleoutputattribute fillconsoleoutputcharacter fillconsoleoutputattribute getconsolemode getnumberofconsoleinputevents getconsolescreenbufferinfo getlargestconsolewindowsize getconsolecursorinfo getnumberofconsolemousebuttons setconsolemode setconsoleactivescreenbuffer flushconsoleinputbuffer setconsolescreenbuffersize setconsolecursorposition setconsolecursorinfo scrollconsolescreenbuffer setconsolewindowinfo setconsoletextattribute setconsolectrlhandler generateconsolectrlevent allocconsole freeconsole getconsoletitle setconsoletitle readconsole writeconsole createconsolescreenbuffer getconsolecp setconsolecp getconsoleoutputcp setconsoleoutputcp "
    vCategoryDeclares(5) = " initcommoncontrolsex "
    vCategoryDeclares(6) = " choosecolor choosefont commdlgextendederror getopenfilename getsavefilename printdlg "
    vCategoryDeclares(7) = " setcommstate setcommtimeouts getcommstate getcommtimeouts purgecomm buildcommdcb buildcommdcbandtimeouts transmitcommchar setcommbreak setcommmask clearcommbreak clearcommerror setupcomm escapecommfunction getcommmask getcommproperties getcommmodemstatus waitcommevent "
    vCategoryDeclares(8) = " clipcursor createcursor destroycursor getclipcursor getcursor getcursorpos loadcursor loadcursorfromfile setcursor setcursorpos setsystemcursor showcursor "
    vCategoryDeclares(9) = " createdc deletedc deleteobject getdc getstockobject releasedc selectobject "
    vCategoryDeclares(10) = " messagebox messageboxex messageboxindirect "
    vCategoryDeclares(11) = " beep getlasterror messagebeep setlasterror setlasterrorex "
    vCategoryDeclares(12) = " setevent resetevent pulseevent deregistereventsource registereventsource reportevent "
    vCategoryDeclares(13) = " cleareventlog backupeventlog closeeventlog openeventlog openbackupeventlog readeventlog getnumberofeventlogrecords getoldesteventlogrecord "
    vCategoryDeclares(14) = " copyfile createdirectory createdirectoryex createfile deletefile findclose findfirstfile findnextfile getdiskfreespace getdiskfreespaceex getdrivetype getfileattributes getfileinformationbyhandle getfilesize getfiletime getfileversioninfo getfileversioninfosize getfullpathname getlogicaldrives getlogicaldrivestrings getshortpathname gettempfilename movefile readfile removedirectory setfileattributes setfilepointer setfiletime verqueryvalue writefile openfile sethandlecount lockfile unlockfile lockfileex unlockfileex getfiletype getstdhandle setstdhandle flushfilebuffers deviceiocontrol setendoffile duplicatehandle setcurrentdirectory getcurrentdirectory movefileex findfirstchangenotification findnextchangenotification findclosechangenotification lopen lclose lcreat llseek lread lwrite hread hwrite "
    vCategoryDeclares(15) = " getvolumeinformation setvolumelabel "
    vCategoryDeclares(16) = " chord ellipse fillrect framerect invertrect pie polygon polypolygon rectangle roundrect "
    vCategoryDeclares(17) = " createfont createfontindirect enumfontfamilies enumfontfamiliesex gettextalign settextalign textout "
    vCategoryDeclares(18) = " closehandle "
    vCategoryDeclares(19) = " winhelp "
    vCategoryDeclares(20) = " destroyicon drawicon drawiconex extracticon extracticonex "
    vCategoryDeclares(21) = " getprivateprofileint getprivateprofilestring getprofileint getprofilestring writeprivateprofilestring writeprofilestring getprofilesection writeprofilesection getprivateprofilesection writeprivateprofilesection "
    vCategoryDeclares(22) = " sendinput "
    vCategoryDeclares(23) = " joygetdevcaps joygetnumdevs joygetpos "
    vCategoryDeclares(24) = " getasynckeystate getkeyboardstate getkeystate keybd_event setkeyboardstate "
    vCategoryDeclares(25) = " anglearc arc arcto getarcdirection lineto movetoex polybezier polybezierto polyline polylineto polypolyline setarcdirection "
    vCategoryDeclares(26) = " loadlibrary loadlibraryex loadmodule freelibrary "
    vCategoryDeclares(27) = " muldiv "
    vCategoryDeclares(28) = " mcigeterrorstring mcisendstring "
    vCategoryDeclares(29) = " copymemory fillmemory globalalloc globalfree globallock globalmemorystatus globalmemorystatusex globalunlock movememory zeromemory globalhandle globalrealloc globalsize globalflags localalloc localfree localhandle locallock localrealloc localsize localunlock localflags virtualalloc virtualfree virtualprotect virtualquery virtualprotectex virtualqueryex heapcreate heapdestroy heapalloc heaprealloc heapfree heapsize "
    vCategoryDeclares(30) = " createpopupmenu destroymenu getmenu getmenuitemcount getmenuiteminfo getsystemmenu insertmenuitem removemenu setmenuiteminfo trackpopupmenu trackpopupmenuex "
    vCategoryDeclares(31) = " sendmessage "
    vCategoryDeclares(32) = " getcapture getdoubleclicktime mouse_event releasecapture setcapture setdoubleclicktime swapmousebutton "
    vCategoryDeclares(33) = " getcurrencyformat getdateformat getnumberformat getthreadlocale gettimeformat setthreadlocale "
    vCategoryDeclares(34) = " cotaskmemfree "
    vCategoryDeclares(35) = " getwindowrgn setwindowrgn "
    vCategoryDeclares(36) = " createpen createpenindirect "
    vCategoryDeclares(37) = " isbadreadptr isbadwriteptr isbadstringptr isbadhugereadptr isbadhugewriteptr "
    vCategoryDeclares(38) = " closeprinter enddoc endpage enumjobs enumprinters openprinter startdoc startpage "
    vCategoryDeclares(39) = " createnamedpipe getnamedpipehandlestate callnamedpipe waitnamedpipe createpipe connectnamedpipe disconnectnamedpipe setnamedpipehandlestate getnamedpipeinfo peeknamedpipe transactnamedpipe "
    vCategoryDeclares(40) = " getenvironmentvariable setenvironmentvariable createprocess setprocessshutdownparameters getprocessshutdownparameters getmodulefilename getmodulehandle getprocessheap getprocesstimes openprocess getcurrentprocess getcurrentprocessid exitprocess terminateprocess getexitcodeprocess readprocessmemory writeprocessmemory getthreadcontext setthreadcontext suspendthread resumethread openprocesstoken openthreadtoken createthread createremotethread getcurrentthread getcurrentthreadid setthreadpriority getthreadpriority getthreadtimes exitthread terminatethread getexitcodethread getthreadselectorentry "
    vCategoryDeclares(41) = " copyrect equalrect inflaterect intersectrect isrectempty offsetrect ptinrect setrect setrectempty subtractrect unionrect "
    vCategoryDeclares(42) = " combinergn createellipticrgn createellipticrgnindirect createpolygonrgn createpolypolygonrgn createrectrgn createrectrgnindirect createroundrectrgn equalrgn fillrgn framergn getpolyfillmode getrgnbox invertrgn offsetrgn ptinregion rectinregion setpolyfillmode "
    vCategoryDeclares(43) = " regclosekey regcreatekeyex regdeletekey regdeletevalue regenumkeyex regenumvalue regopenkeyex regqueryvalueex regsetvalueex "
    vCategoryDeclares(44) = " findresource findresourceex beginupdateresource updateresource endupdateresource loadresource lockresource sizeofresource "
    vCategoryDeclares(45) = " exitwindowsdialog pickicondlg restartdialog shaddtorecentdocs shbrowseforfolder shell_notifyicon shellexecute shellexecuteex shemptyrecyclebin shfileoperation shfreenamemappings shgetfileinfo shgetfolderlocation shgetfolderpath shgetpathfromidlist shgetspecialfolderlocation shgetspecialfolderpath shqueryrecyclebin shupdaterecyclebinicon "
    vCategoryDeclares(46) = " lockworkstation "
    vCategoryDeclares(47) = " charlower charupper comparestring lstrcmp lstrcmpi lstrcpy lstrcpyn lstrlen "
    vCategoryDeclares(48) = " isvalidsid equalsid equalprefixsid getsidlengthrequired allocateandinitializesid freesid initializesid getsididentifierauthority getsidsubauthority getsidsubauthoritycount getlengthsid copysid "
    vCategoryDeclares(49) = " waitforsingleobject "
    vCategoryDeclares(50) = " getcomputername getsyscolor getsystemdirectory gettemppath getusername getversionex getwindowsdirectory setsyscolors "
    vCategoryDeclares(51) = " settapeposition gettapeposition preparetape erasetape createtapepartition writetapemark gettapestatus gettapeparameters settapeparameters "
    vCategoryDeclares(52) = " comparefiletime filetimetolocalfiletime filetimetosystemtime getlocaltime getsystemtime getsystemtimeasfiletime gettickcount gettimezoneinformation localfiletimetofiletime setsystemtime systemtimetofiletime getcurrenttime setlocaltime getsysteminfo settimezoneinformation filetimetodosdatetime dosdatetimetofiletime enumtimeformats enumdateformats "
    vCategoryDeclares(53) = " killtimer queryperformancecounter queryperformancefrequency settimer "
    vCategoryDeclares(54) = " createtoolhelp32snapshot process32first process32next "
    vCategoryDeclares(55) = " duplicatetoken gettokeninformation settokeninformation adjusttokenprivileges adjusttokengroups "
    vCategoryDeclares(56) = " getclassinfo getclassinfoex getclasslong getclassname getwindowlong registerclass registerclassex setclasslong setwindowlong unregisterclass "
    vCategoryDeclares(57) = " callwindowproc defwindowproc "
    vCategoryDeclares(58) = " enumpropsex getprop removeprop setprop "
    vCategoryDeclares(59) = " bringwindowtotop createwindowex destroywindow enablewindow enumchildwindows enumthreadwindows enumwindows findwindow findwindowex flashwindow getactivewindow getdesktopwindow getfocus getforegroundwindow getparent gettopwindow getwindow getwindowrect getwindowtext getwindowtextlength getwindowthreadprocessid ischild isiconic iswindow iswindowenabled iszoomed movewindow setactivewindow setfocus setforegroundwindow setparent setwindowpos setwindowtext showwindow windowfrompoint "
    vCategoryDeclares(60) = " closesocket connect gethostbyaddr gethostbyname gethostname htonl htons inet_addr inet_nota recv send socket wsacleanup wsagetlasterror wsastartup "
    vCategoryDeclares(61) = " exitwindowsex sleep sleepex "
 
    For intIndex = 0 To UBound(vCategories)
        cmbCategories.AddItem vCategories(intIndex)
    Next
 
    cmbLibraryList.AddItem "(None)"
    cmbLibraryList.ListIndex = 0
    cmbCategories.ListIndex = 0
    cmbEntryType.ListIndex = 1
 
    menu_showpopup.Visible = False
    LoadAPIFile App.Path & "\win32api.txt"
 
    Call menu_showpopup_show_Click(1)
End Sub
 
Private Sub SetCategoriesEnabled(State As Boolean)
    lblInfo(4).ForeColor = IIf(State, 0, GetSysColor(COLOR_BTNSHADOW))
    cmbCategories.BackColor = IIf(State, GetSysColor(COLOR_WINDOW), GetSysColor(COLOR_BTNFACE))
    cmbCategories.Enabled = State
 
    lblInfo(5).ForeColor = lblInfo(4).ForeColor
    cmbLibraryList.BackColor = cmbCategories.BackColor
    cmbLibraryList.Enabled = State
End Sub
 
Private Sub SetCategoriesVisible(State As Boolean)
    cmbCategories.Visible = State
    cmbLibraryList.Visible = State
 
    lblInfo(4).Visible = State
    lblInfo(5).Visible = State
End Sub
 
Private Sub Form_Resize()
    On Local Error Resume Next
 
    freDeclareScope.Move Me.ScaleWidth - freDeclareScope.Width - 90, lstItems.Top
     
    lstItems.Width = freDeclareScope.Left - (lstItems.Left * 2) - 60
    txtItemText.Width = lstItems.Width
    txtItemText.Height = Me.ScaleHeight - txtItemText.Top - 90
 
    txtSearch.Width = lstItems.Width
 
    cmdLoadFile.Move freDeclareScope.Left, (lstItems.Top   lstItems.Height) - cmdLoadFile.Height
 
    cmdRemove.Move freDeclareScope.Left, txtItemText.Top
    cmdClear.Move freDeclareScope.Left, cmdRemove.Top   cmdRemove.Height   30
    cmdInsert.Move freDeclareScope.Left, cmdClear.Top   cmdClear.Height   30
    cmdCopy.Move freDeclareScope.Left, cmdInsert.Top   cmdInsert.Height   30
 
    cmdShow.Move freDeclareScope.Left, (txtItemText.Top   txtItemText.Height) - cmdShow.Height
 
    lblInfo(6).Move (lstItems.Left   lstItems.Width) - lblInfo(6).Width, lblInfo(2).Top
    lstSelectedItems.Move txtItemText.Left, txtItemText.Top, txtItemText.Width, txtItemText.Height
     
    chkNoComments.Move (lstSelectedItems.Left   lstSelectedItems.Width) - chkNoComments.Width, lblInfo(3).Top
    lblCopyright.Move frmMain.ScaleWidth - lblCopyright.Width - 60, lblInfo(0).Top
End Sub
 
Private Sub ChangeListingType(intListingType As Integer)
    Dim intIndex As Integer
    Dim dwViewCount As Long, dwTotalCount As Long
    Dim strLibraryFilter As String
    Dim intCatID As Integer
    Dim blnAddItem As Boolean
 
    If APIFileLoaded Then
        lstItems.Clear
        Call LockWindowUpdate(lstItems.hWnd)
 
        strLibraryFilter = DLLEntries(cmbLibraryList.ItemData(cmbLibraryList.ListIndex))
        intCatID = cmbCategories.ListIndex
 
        For intIndex = 0 To UBound(APIEntries)
            If APIEntries(intIndex).EntryType = intListingType   1 Then
                blnAddItem = True
 
                If strLibraryFilter <> "(None)" Then blnAddItem = (APIEntries(intIndex).Library = strLibraryFilter)
                If intCatID > 0 Then blnAddItem = blnAddItem And (InStr(vCategoryDeclares(intCatID - 1), " " & LCase(APIEntries(intIndex).DisplayName) & " ") > 0)
 
                If blnAddItem Then
                    lstItems.AddItem APIEntries(intIndex).DisplayName
                    lstItems.ItemData(lstItems.NewIndex) = intIndex
                    dwViewCount = dwViewCount   1
                End If
 
                dwTotalCount = dwTotalCount   1
            End If
        Next
 
        Call LockWindowUpdate(0)
         
        Dim strCaption  As String
        strCaption = "Displaying " & dwViewCount & " items"
 
        If strLibraryFilter <> "(None)" Then
            strCaption = strCaption & " in """ & cmbLibraryList.Text & """"
            If intCatID > 0 Then strCaption = strCaption & ", """ & cmbCategories.Text & """"
        Else
            If intCatID > 0 Then strCaption = strCaption & " in """ & cmbCategories.Text & """"
        End If
 
        lblInfo(2).Caption = strCaption & ":"
    End If
End Sub
 
Private Sub LoadAPIFile(strFile As String)
    If Dir$(strFile) = "" Then
        MsgBox "Selected file does not exist!"
        Exit Sub
    End If
 
    Dim intFH As Integer, intPos As Integer, intCommentPos As Integer, intQuotePos As Integer
    Dim intDLLIndex As Integer
    Dim strLine As String, strToken As String, strRest As String, strLibraries As String
    Dim blnAdvanceNext As Boolean
    Dim dwEntryIndex As Long
    Dim vDeclare
 
    dwEntryIndex = 0
    intDLLIndex = 1
    strLibraries = "|"
    intFH = FreeFile
 
    Open strFile For Input As #intFH
    ReDim APIEntries(100) As apiEntry
    ReDim DLLEntries(50) As String
 
    DLLEntries(0) = "(None)"
 
    frmMain.MousePointer = vbHourglass
    Do Until EOF(intFH)
        Line Input #1, strLine
        strLine = Trim(strLine)
 
        If Not (Left(strLine, 1) = "'" Or Left(strLine, 1) = "") Then
            intPos = InStr(strLine, " ")
            If intPos > 0 Then
                strToken = Left(strLine, intPos - 1)
                strRest = Right(strLine, Len(strLine) - intPos)
                intCommentPos = InStrRev(strRest, "'")
 
                If intCommentPos > 0 Then
                    intQuotePos = InStrRev(strRest, Chr(34))
                    If intCommentPos > intQuotePos Or intQuotePos = 0 Then
                        strRest = Left(strRest, intCommentPos - 1)
                    End If
                End If
 
                blnAdvanceNext = False
                Select Case LCase(strToken)
                    Case "const":
                        ' Const SHUTDOWN_NORETRY = &H1
 
                        With APIEntries(dwEntryIndex)
                            .DisplayName = strRest
                            .Code = strLine
                            .EntryType = 1
                        End With
 
                    Case "declare":
                        ' Declare Function CreateMutex Lib "kernel32" Alias "CreateMutexA" (lpMutexAttributes As SECURITY_ATTRIBUTES, ByVal bInitialOwner As Long, ByVal lpName As String) As Long
 
                        vDeclare = Split(strLine, " ", 6)
                        vDeclare(4) = Replace(LCase(UnQuote(vDeclare(4))), ".dll", "")
                        If InStr(strLibraries, "|" & vDeclare(4) & "|") = 0 Then
                            strLibraries = strLibraries & vDeclare(4) & "|"
                            DLLEntries(intDLLIndex) = vDeclare(4)
 
                            intDLLIndex = intDLLIndex   1
                            If intDLLIndex > UBound(DLLEntries) Then
                                ReDim Preserve DLLEntries(UBound(DLLEntries)   50) As String
                            End If
                        End If
                         
                        With APIEntries(dwEntryIndex)
                            .DisplayName = vDeclare(2)
                            .Library = vDeclare(4)
                            .Code = strLine
                            .EntryType = 2
                        End With
 
                    Case "type":
                        ' Type WIN32_FIND_DATA
 
                        With APIEntries(dwEntryIndex)
                            .DisplayName = strRest
                            .Code = strLine & vbCrLf
                            .EntryType = 3
                        End With
 
                    Case Else:
                        ' Continued code
 
                        If LCase(strLine) = "end type" Then blnAdvanceNext = True
                        APIEntries(dwEntryIndex).Code = APIEntries(dwEntryIndex).Code & IIf(blnAdvanceNext, "", Space$(4)) & Trim(strLine) & vbCrLf
                End Select
                 
                If APIEntries(dwEntryIndex).EntryType <> 3 Or blnAdvanceNext Then
                    dwEntryIndex = dwEntryIndex   1
                    If dwEntryIndex > UBound(APIEntries) Then ReDim Preserve APIEntries(UBound(APIEntries)   100) As apiEntry
                End If
            End If
        End If
         
        DoEvents
    Loop
 
    ReDim Preserve APIEntries(dwEntryIndex - 1) As apiEntry
    Dim intIndex As Integer
 
    cmbLibraryList.Clear
 
    For intIndex = 0 To intDLLIndex - 1
        cmbLibraryList.AddItem DLLEntries(intIndex) & IIf(InStr(DLLEntries(intIndex), ".") = 0 And Left(DLLEntries(intIndex), 1) <> "(", ".dll", "")
        cmbLibraryList.ItemData(cmbLibraryList.NewIndex) = intIndex
    Next
 
    ReDim Preserve DLLEntries(intDLLIndex - 1) As String
 
    strLibraries = ""
    cmbLibraryList.ListIndex = 0
    frmMain.MousePointer = vbDefault
    APIFileLoaded = True
     
    Call cmbEntryType_Click
 
    Close #intFH
End Sub
 
Private Function UnQuote(ByVal strStr As String) As String
    If Left(strStr, 1) = Chr(34) And Right(strStr, 1) = Chr(34) Then
        strStr = Mid(strStr, 2, Len(strStr) - 2)
    End If
 
    UnQuote = strStr
End Function
 
Private Sub lstItems_DblClick()
    Dim dwIndex As Long
    Dim blnAddItem As Boolean
    Dim szPrefix As String, szText As String
    Dim vSplit As Variant
     
    Select Case cmbEntryType.ListIndex
        Case 0: szPrefix = "Const: "
        Case 1: szPrefix = "Declare: "
        Case 2: szPrefix = "Type: "
    End Select
 
    szText = lstItems.List(lstItems.ListIndex)
    If InStr(szText, " ") > 0 Then
        vSplit = Split(szText, " ", 5)
        szText = vSplit(IIf(LCase(vSplit(1)) = "declare", 2, 0))
    End If
     
    blnAddItem = True
    For dwIndex = 0 To lstSelectedItems.ListCount - 1
        If lstSelectedItems.List(dwIndex) = szPrefix & szText Then
            blnAddItem = False
            Exit For
        End If
    Next
     
    If blnAddItem Then
        lstSelectedItems.AddItem szPrefix & szText
        lstSelectedItems.ItemData(lstSelectedItems.NewIndex) = lstItems.ItemData(lstItems.ListIndex)
    End If
 
    cmdClear.Enabled = True
    cmdCopy.Enabled = True
    cmdInsert.Enabled = True
    cmdRemove.Enabled = True
 
    UpdateFullTextView
End Sub
 
Private Sub lstItems_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn Then Call lstItems_DblClick
End Sub
 
Private Sub menu_showpopup_show_Click(Index As Integer)
    menu_showpopup_show(0).Checked = (Index = 0)
    menu_showpopup_show(1).Checked = (Index = 1)
 
    cmdShow.Caption = "Show [" & IIf(Index = 0, "Line", "Full") & "]"
 
    Select Case Index
        Case 0: lstSelectedItems.ZOrder
        Case 1: txtItemText.ZOrder
    End Select
End Sub
 
Private Sub txtSearch_Change()
    Dim dwIndex As Long, dwIdx As Long
 
    For dwIndex = ListSearchIndex To lstItems.ListCount - 1
        If LCase(Left(lstItems.List(dwIndex), Len(txtSearch.Text))) = LCase(txtSearch.Text) Then
            If dwIndex   9 < lstItems.ListCount - 1 Then dwIdx = dwIndex   9 Else dwIdx = dwIndex
 
            lstItems.ListIndex = dwIdx
            Exit For
        End If
    Next
 
    If dwIndex >= lstItems.ListCount Then Exit Sub
 
    ' Set search index (optimized searching)
    ListSearchIndex = dwIndex - 1
    lstItems.ListIndex = dwIndex
End Sub
 
Private Sub txtSearch_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyDown Or KeyCode = vbKeyUp Or KeyCode = vbKeyPageDown Or KeyCode = vbKeyPageUp Then
        Call SendMessage(lstItems.hWnd, WM_KEYDOWN, KeyCode, &O0)
        KeyCode = 0
    ElseIf KeyCode = vbKeyReturn Then
        Call lstItems_DblClick
    ElseIf KeyCode = vbKeyBack Then
        ' Reset search index
        ListSearchIndex = 0
    End If
End Sub
 
Private Sub UpdateFullTextView()
    Dim dwIndex As Long, dwCodeID As Long, dwCodeIdx As Long
    Dim szScope As String, szCodeView As String
    Dim intCommentPos As Integer, intQuotePos As Integer
    Dim vCode As Variant
 
    szScope = IIf(chkScope(0).Checked, "Public ", "Private ")
    txtItemText.Text = ""
 
    If lstSelectedItems.ListCount > -1 Then
        For dwIndex = 0 To lstSelectedItems.ListCount - 1
            dwCodeID = lstSelectedItems.ItemData(dwIndex)
            vCode = Split(APIEntries(dwCodeID).Code, vbCrLf)
 
            For dwCodeIdx = 0 To UBound(vCode)
                vCode(dwCodeIdx) = LTrimNL(RTrimNL(CStr(vCode(dwCodeIdx))))
                 
                If chkNoComments.Checked Then
                    intCommentPos = InStrRev(vCode(dwCodeIdx), "'")
 
                    If intCommentPos > 0 Then
                        intQuotePos = InStrRev(vCode(dwCodeIdx), Chr(34))
                        If intCommentPos > intQuotePos Or intQuotePos = 0 Then
                            vCode(dwCodeIdx) = Left(vCode(dwCodeIdx), intCommentPos - 1)
                        End If
                    End If
                End If
 
                vCode(dwCodeIdx) = RTrim(vCode(dwCodeIdx))
            Next
             
            szCodeView = szCodeView & szScope & RTrimNL(Join(vCode, vbCrLf)) & vbCrLf & vbCrLf
        Next
    End If
 
    txtItemText.Text = szCodeView
    txtItemText.SelStart = Len(txtItemText.Text)
End Sub
 
Private Sub txtItemText_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    On Local Error Resume Next
 
    Dim szText As String, szPrefix As String, szScope As String
    Dim intPos As Integer
    Dim vSplit As Variant
 
    szScope = IIf(chkScope(0).Checked, "Public ", "Private ")
    szText = txtItemText.Text
 
    If szText > "" Then
        intPos = InStr(txtItemText.SelStart, szText, vbCrLf)
        intPos = IIf(intPos > 0, intPos, Len(txtItemText.Text))
        szText = RTrimNL(Left(szText, intPos   1))
         
        intPos = InStrRev(szText, szScope)
        szText = RTrimNL(Right(szText, Len(szText) - intPos   1))
         
        intPos = InStr(szText, vbCrLf)
        intPos = IIf(intPos > 0, intPos - 1, Len(szText))
        szText = Left(szText, intPos)
 
        vSplit = Split(szText, " ", 6)
 
        szText = vSplit(IIf(LCase(vSplit(1)) = "declare", 3, 2))
        szText = StrConv(vSplit(1), vbProperCase) & ": " & RTrimNL(szText)
 
        For intPos = 0 To lstSelectedItems.ListCount - 1
            If lstSelectedItems.List(intPos) = szText Then Exit For
        Next
 
        lstSelectedItems.ListIndex = intPos
    End If
End Sub
 
Private Function RTrimNL(szStr As String) As String
    Dim intPos As Integer
 
    If Len(szStr) > 0 Then
        For intPos = Len(szStr) To 1 Step -1
            If Asc(Mid(szStr, intPos, 1)) > 31 Then Exit For
        Next
     
        RTrimNL = IIf(intPos > 0, Left(szStr, intPos), szStr)
    Else
        RTrimNL = ""
    End If
End Function
 
Private Function LTrimNL(szStr As String) As String
    Dim intPos As Integer
 
    For intPos = 1 To Len(szStr)
        If Asc(Mid(szStr, intPos, 1)) > 31 Then
            Exit For
        End If
    Next
 
     
    LTrimNL = IIf(intPos > 1, Right(szStr, Len(szStr) - intPos   1), szStr)
End Function
标签： 浏览器 API VB6 浏览 vb
实例下载地址

点此下载实例
不能下载？内容有错？点击这里报错 + 投诉 + 提问
好例子网口号：伸出你的我的手 — 分享！
网友评论

我要评论
第 1 楼 罗雨 发表于: 2022-05-11 09:20 29: 下载后，是一堆文件，怎么操作能你预览一样呢？求大神
支持(0) 盖楼(回复)
小贴士

感谢您为本站写下的评论，您的评论对其它用户来说具有重要的参考价值，所以请认真填写。
类似“顶”、“沙发”之类没有营养的文字，对勤劳贡献的楼主来说是令人沮丧的反馈信息。
相信您也不想看到一排文字/表情墙，所以请不要反馈意义不大的重复字符，也请尽量不要纯表情的回复。
提问之前请再仔细看一遍楼主的说明，或许是您遗漏了。
请勿到处挖坑绊人、招贴广告。既占空间让人厌烦，又没人会搭理，于人于己都无利。
关于好例子网

本站旨在为广大IT学习爱好者提供一个非营利性互相学习交流分享平台。本站所有资源都可以被免费获取学习研究。本站资源来自网友分享，对搜索内容的合法性不具有预见性、识别性、控制性，仅供学习研究，请务必在下载后24小时内给予删除，不得用于其他任何用途，否则后果自负。基于互联网的特殊性，平台无法对用户传输的作品、信息、内容的权属或合法性、安全性、合规性、真实性、科学性、完整权、有效性等进行实质审查；无论平台是否已进行审查，用户均应自行承担因其传输的作品、信息、内容而可能或已经产生的侵权或权属纠纷等法律责任。本站所有资源不代表本站的观点或立场，基于网友分享，根据中国法律《信息网络传播权保护条例》第二十二与二十三条之规定，若资源存在侵权或相关问题请联系本站客服人员，点此联系我们。关于更多版权及免责申明参见版权及免责申明
VB6高级版API浏览器

同类人气实例

实例介绍

实例下载地址
