📄 form1.frm
字号:
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form Form1
Caption = "API 浏览器"
ClientHeight = 6000
ClientLeft = 60
ClientTop = 345
ClientWidth = 7635
Icon = "Form1.frx":0000
LinkTopic = "Form1"
ScaleHeight = 6000
ScaleWidth = 7635
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton Command5
Caption = "删除(&R)"
Height = 375
Left = 6420
TabIndex = 11
Top = 3990
Width = 1095
End
Begin VB.CommandButton Command4
Caption = "搜索(&S)"
Height = 375
Left = 6420
TabIndex = 7
Top = 1560
Width = 1095
End
Begin VB.CommandButton Command3
Caption = "复制(&C)"
Height = 375
Left = 6420
TabIndex = 6
Top = 4560
Width = 1095
End
Begin VB.CommandButton Command2
Caption = "清空(&D)"
Height = 375
Left = 6420
TabIndex = 5
Top = 3570
Width = 1095
End
Begin VB.TextBox Text2
Height = 375
Left = 120
TabIndex = 4
Top = 840
Width = 6165
End
Begin VB.TextBox Text1
Height = 2235
Left = 120
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 3
Top = 3540
Width = 6165
End
Begin VB.ListBox List1
Height = 1680
Left = 120
TabIndex = 2
Top = 1560
Width = 6165
End
Begin VB.ComboBox Combo1
Height = 300
ItemData = "Form1.frx":030A
Left = 120
List = "Form1.frx":0317
Style = 2 'Dropdown List
TabIndex = 1
Top = 480
Width = 2895
End
Begin MSComDlg.CommonDialog com
Left = 6600
Top = 5040
_ExtentX = 847
_ExtentY = 847
_Version = 393216
CancelError = -1 'True
DefaultExt = "mdb"
Filter = "*.mdb|*.mdb|*.*|*.*"
Flags = 2
End
Begin VB.CommandButton Command1
Caption = "打开(&O)"
Height = 615
Left = 6420
TabIndex = 0
Top = 540
Width = 1095
End
Begin VB.Data Data1
Caption = "Data1"
Connect = "Access"
DatabaseName = ""
DefaultCursorType= 0 'DefaultCursor
DefaultType = 2 'UseODBC
Exclusive = 0 'False
Height = 375
Left = 120
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = ""
Top = 5760
Visible = 0 'False
Width = 2415
End
Begin VB.Label Label3
Caption = "选定项："
Height = 255
Left = 120
TabIndex = 10
Top = 3300
Width = 855
End
Begin VB.Label Label2
Caption = "API类型："
Height = 255
Left = 120
TabIndex = 9
Top = 240
Width = 1275
End
Begin VB.Label Label1
Caption = "可用项："
Height = 255
Left = 120
TabIndex = 8
Top = 1320
Width = 975
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
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
Const LB_ADDSTRING = &H180
Const LB_SELECTSTRING = &H18C
Private Sub Combo1_Click()
If Data1.RecordSource <> "" Then
If Combo1.Text = "声明" Then Source = "Declares"
If Combo1.Text = "常数" Then Source = "Constants"
If Combo1.Text = "类型" Then Source = "Types"
loaddb
End If
End Sub
Private Sub Command1_Click()
On Error Resume Next
com.ShowOpen
If Error = "" Then
loaddb
End If
End Sub
Private Sub Command2_Click()
Text1.Text = ""
End Sub
Private Sub Command3_Click()
Clipboard.Clear
Clipboard.SetText Text1.Text
End Sub
Private Sub Command4_Click()
Dim s As String
s = InputBox("查找")
If s <> "" Then
Form2.Show
Dim a As Integer
'Dim b As Integer
'Dim ind As Integer
For a = 0 To List1.ListCount - 1
If InStr(1, List1.List(a), s, vbTextCompare) <> 0 Then
'ReDim Preserve c(b)
'ind = ind + 1
Form2.List1.AddItem List1.List(a)
Form2.List1.ItemData(Form2.List1.NewIndex) = List1.ItemData(a)
'c(b) = a
'b = b + 1
End If
Next
Else
End If
End Sub
Private Sub Command5_Click()
On Error Resume Next
Dim sta As Long
Dim selend As Long
sta = Text1.SelStart
selend = sta
Do Until Mid(Text1.Text, sta, 4) = Chr(13) & Chr(10) & Chr(13) & Chr(10)
sta = sta - 1
If sta < 1 Then Exit Do
Loop
Do Until Mid(Text1.Text, selend, 4) = Chr(13) & Chr(10) & Chr(13) & Chr(10) 'Or selend > Len(Text1.Text)
selend = selend + 1
If selend > Len(Text1.Text) Then Exit Do
Loop
Text1.Text = Left(Text1.Text, sta) & Right(Text1.Text, Len(Text1.Text) - selend)
'Text1.SelStart = sta
'Text1.SelLength = selend - sta + 1
'Text1.SelText = ""
'If Len(Text1) < 5 Then Text1 = "" 'If Left(Text1, 1) = Chr(13) Then Text1.Text = "" ' Right(Text1.Text, Len(Text1.Text) - 4)
End Sub
Private Sub Form_Load()
Combo1.Text = "声明"
Source = "Declares"
End Sub
Private Sub loaddb()
On Error Resume Next
List1.Clear
MousePointer = 11
Data1.DatabaseName = com.filename
Form1.Caption = "API 浏览器 - " & com.filename
Data1.RecordSource = Source
Data1.Refresh
If Error <> "" Then
MsgBox Error
Error = ""
MousePointer = 0
Exit Sub
End If
Data1.Recordset.MoveFirst
While Not Data1.Recordset.EOF
If CStr(Data1.Recordset!ChunkNum) = "1" Then
SendMessage List1.hwnd, LB_ADDSTRING, 0, ByVal CStr(Data1.Recordset!Name)
List1.ItemData(List1.ListCount - 1) = Data1.Recordset.AbsolutePosition
End If
Data1.Recordset.MoveNext
'If Error <> "" Then
'MsgBox Error
'Exit Sub
'End If
DoEvents
Wend
MousePointer = 0
End Sub
Private Sub Form_Resize()
On Error Resume Next
Text1.Width = Form1.Width - 1590
List1.Width = Text1.Width
Text2.Width = Text1.Width
Command1.Left = Form1.Width - 1335
Command2.Left = Command1.Left
Command3.Left = Command1.Left
Command4.Left = Command1.Left
Command5.Left = Command1.Left
Text1.Height = Form1.Height - Text1.Top - 655
End Sub
Private Sub Form_Unload(Cancel As Integer)
Unload Form2
End Sub
Private Sub List1_DblClick()
On Error Resume Next
If Source = "Declares" Or Source = "Constants" Then
Data1.Recordset.AbsolutePosition = List1.ItemData(List1.ListIndex)
If InStr(1, Text1.Text, Data1.Recordset!FullName, vbTextCompare) > 0 Then Exit Sub
Text1.Text = Text1.Text & Data1.Recordset!FullName ' & Chr(13) & Chr(10) & Chr(13) & Chr(10)
Data1.Recordset.MoveNext
If CStr(Data1.Recordset!ChunkNum) = "2" Then Text1.Text = Text1.Text & Data1.Recordset!FullName ' & Chr(13) & Chr(10) & Chr(13) & Chr(10)
Text1.Text = Text1.Text & Chr(13) & Chr(10) & Chr(13) & Chr(10)
End If
If Source = "Types" Then
If InStr(1, Text1.Text, "Type " & List1.Text & Chr(13) & Chr(10), vbTextCompare) > 0 Then Exit Sub
Data1.RecordSource = Source
Data1.Refresh
Data1.Recordset.MoveFirst
Data1.Recordset.Move List1.ListIndex
Typeid = Data1.Recordset!ID
Data1.RecordSource = "TypeItems"
Data1.Refresh
Data1.Recordset.MoveFirst
Text1.Text = Text1.Text & "Type " & List1.Text & Chr(13) & Chr(10)
Do While Not Data1.Recordset.EOF
If Data1.Recordset!Typeid = Typeid Then
Text1.Text = Text1.Text & Data1.Recordset!TypeItem & Chr(13) & Chr(10)
End If
Data1.Recordset.MoveNext
Loop
Text1.Text = Text1.Text & "End Type " & Chr(13) & Chr(10)
Text1.Text = Text1.Text & Chr(13) & Chr(10)
End If
End Sub
Private Sub List1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then List1_DblClick
End Sub
Private Sub List1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Text2.Text = List1.Text
End Sub
Private Sub Text2_Change()
Dim st As Long
Dim l As Long
st = Text2.SelStart
l = Len(Text2.Text)
SendMessage List1.hwnd, LB_SELECTSTRING, -1, ByVal Text2.Text
'Text2.Text = List1.Text
'Text2.SelStart = st
'Text2.SelLength = Len(Text2.Text) - 1
End Sub
Private Sub Text2_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then List1_DblClick
End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then KeyAscii = 0
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -