Skip to content

Commit 5a2bc89

Browse files
authored
Add files via upload
1 parent 76c3716 commit 5a2bc89

22 files changed

+1813
-0
lines changed

AutoListFrm.frm

+174
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,174 @@
1+
VERSION 5.00
2+
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
3+
Begin VB.Form AutoCodeFrm
4+
AutoRedraw = -1 'True
5+
BorderStyle = 3 'Fixed Dialog
6+
ClientHeight = 2415
7+
ClientLeft = 45
8+
ClientTop = 45
9+
ClientWidth = 2790
10+
ControlBox = 0 'False
11+
LinkTopic = "Form1"
12+
MaxButton = 0 'False
13+
MinButton = 0 'False
14+
ScaleHeight = 2415
15+
ScaleWidth = 2790
16+
ShowInTaskbar = 0 'False
17+
Visible = 0 'False
18+
Begin VB.PictureBox Picture1
19+
AutoRedraw = -1 'True
20+
BackColor = &H00FFFFFF&
21+
BorderStyle = 0 'None
22+
Height = 345
23+
Left = 1470
24+
ScaleHeight = 345
25+
ScaleWidth = 1275
26+
TabIndex = 1
27+
Top = 1830
28+
Visible = 0 'False
29+
Width = 1275
30+
End
31+
Begin MSComctlLib.ImageList ImageList1
32+
Left = 2085
33+
Top = 1710
34+
_ExtentX = 1005
35+
_ExtentY = 1005
36+
BackColor = -2147483643
37+
ImageWidth = 16
38+
ImageHeight = 16
39+
MaskColor = 16711935
40+
_Version = 393216
41+
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
42+
NumListImages = 4
43+
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
44+
Picture = "AutoListFrm.frx":0000
45+
Key = ""
46+
Object.Tag = "函数"
47+
EndProperty
48+
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
49+
Picture = "AutoListFrm.frx":0112
50+
Key = ""
51+
Object.Tag = "窗体"
52+
EndProperty
53+
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
54+
Picture = "AutoListFrm.frx":0224
55+
Key = ""
56+
Object.Tag = "控件"
57+
EndProperty
58+
BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
59+
Picture = "AutoListFrm.frx":0336
60+
Key = ""
61+
Object.Tag = "语句"
62+
EndProperty
63+
EndProperty
64+
End
65+
Begin MSComctlLib.ListView ATlv
66+
Height = 2490
67+
Left = -30
68+
TabIndex = 0
69+
Top = -30
70+
Width = 2850
71+
_ExtentX = 5027
72+
_ExtentY = 4392
73+
View = 3
74+
LabelEdit = 1
75+
Sorted = -1 'True
76+
LabelWrap = -1 'True
77+
HideSelection = -1 'True
78+
HideColumnHeaders= -1 'True
79+
FullRowSelect = -1 'True
80+
_Version = 393217
81+
SmallIcons = "ImageList1"
82+
ForeColor = -2147483640
83+
BackColor = -2147483643
84+
BorderStyle = 1
85+
Appearance = 1
86+
NumItems = 1
87+
BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
88+
Text = "name"
89+
Object.Width = 4375
90+
EndProperty
91+
End
92+
End
93+
Attribute VB_Name = "AutoCodeFrm"
94+
Attribute VB_GlobalNameSpace = False
95+
Attribute VB_Creatable = False
96+
Attribute VB_PredeclaredId = True
97+
Attribute VB_Exposed = False
98+
'////////////////////////////////////////////////////////////////
99+
'
100+
'插件名称:
101+
'
102+
'插件作者:人闲花落 QQ:449806776
103+
'
104+
'版权声明:您可以修改或共享发布此插件,但必须注明原创作者信息
105+
'
106+
'VB爱好者:交流QQ群——19871152
107+
'
108+
'////////////////////////////////////////////////////////////////
109+
110+
Option Explicit
111+
112+
Private Sub ATlv_DblClick()
113+
Dim ls As String
114+
ls = "{BACKSPACE " & Len(JS_Frm.Text1) & "}" & ATlv.SelectedItem.Text
115+
Call NoTextInput '清空输入文本,停止AutoCode
116+
FKinput = True
117+
SendKeys ls, True
118+
FKinput = False
119+
End Sub
120+
121+
Private Sub ATlv_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
122+
SetListItemColor ATlv, Picture1
123+
VBInstance.ActiveCodePane.Window.SetFocus
124+
End Sub
125+
126+
Private Sub Form_Load()
127+
Me.Visible = False
128+
End Sub
129+
130+
Sub SetLIC()
131+
SetListItemColor ATlv, Picture1
132+
End Sub
133+
134+
Private Sub SetListItemColor(lv As ListView, picBg As PictureBox)
135+
136+
Dim i As Integer
137+
Dim mItem As ListItems
138+
picBg.Cls
139+
lv.Parent.ScaleMode = vbTwips
140+
141+
picBg.Width = lv.ColumnHeaders(1).Width
142+
143+
picBg.Height = lv.ListItems(1).Height * (lv.ListItems.Count)
144+
145+
picBg.ScaleHeight = lv.ListItems.Count
146+
147+
picBg.ScaleWidth = 1
148+
149+
picBg.DrawWidth = 1
150+
151+
'If TS <> "" Then MsgBox "4"
152+
'-----------------------------
153+
154+
'custom.such as
155+
156+
'------------------------------
157+
Set mItem = lv.ListItems
158+
159+
For i = 1 To lv.ListItems.Count
160+
161+
If mItem(i).Selected = False Then
162+
picBg.Line (0, i - 1)-(1, i), RGB(255, 255, 255), BF
163+
mItem(i).ForeColor = &H0&
164+
Else
165+
picBg.Line (0, i - 1)-(1, i), RGB(15, 66, 145), BF
166+
mItem(i).ForeColor = &HFFFFFF
167+
End If
168+
169+
Next
170+
171+
lv.Picture = picBg.Image
172+
173+
End Sub
174+

AutoListFrm.frx

1.07 KB
Binary file not shown.

ClsHook.cls

+68
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,68 @@
1+
VERSION 1.0 CLASS
2+
BEGIN
3+
MultiUse = -1 'True
4+
Persistable = 0 'NotPersistable
5+
DataBindingBehavior = 0 'vbNone
6+
DataSourceBehavior = 0 'vbNone
7+
MTSTransactionMode = 0 'NotAnMTSObject
8+
END
9+
Attribute VB_Name = "ClsHook"
10+
Attribute VB_GlobalNameSpace = False
11+
Attribute VB_Creatable = True
12+
Attribute VB_PredeclaredId = False
13+
Attribute VB_Exposed = False
14+
Option Explicit
15+
16+
Public Event KeyDown(KeyCode As Integer, Shift As Integer)
17+
18+
Private Type EVENTMSG
19+
wMsg As Long
20+
lParamLow As Long
21+
lParamHigh As Long
22+
msgTime As Long
23+
hWndMsg As Long
24+
End Type
25+
26+
Private Const WH_JOURNALRECORD = 0
27+
28+
Private Const WM_KEYDOWN = &H100
29+
30+
Private Declare Function SetWindowsHookEx Lib "user32.dll " Alias "SetWindowsHookExA " (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
31+
Private Declare Function UnhookWindowsHookEx Lib "user32.dll " (ByVal hHook As Long) As Long
32+
Private Declare Function GetAsyncKeyState Lib "user32.dll " (ByVal vKey As Long) As Integer
33+
34+
Public Sub SetHook()
35+
OldHook = SetWindowsHookEx(WH_JOURNALRECORD, AddressOf BackHook, App.hInstance, 0)
36+
End Sub
37+
38+
Public Sub UnHook()
39+
Call UnhookWindowsHookEx(OldHook)
40+
End Sub
41+
42+
Friend Function RiseEvent(ByVal lparam As Long) As Long
43+
Dim Msg As EVENTMSG
44+
Dim IntShift As Integer
45+
Dim IntCode As Integer
46+
47+
CopyMemory Msg, ByVal lparam, Len(Msg)
48+
49+
IntShift = 0
50+
Select Case Msg.wMsg
51+
Case WM_KEYDOWN
52+
If GetAsyncKeyState(vbKeyShift) Then IntShift = (IntShift Or 1)
53+
If GetAsyncKeyState(vbKeyControl) Then IntShift = (IntShift Or 2)
54+
If GetAsyncKeyState(vbKeyMenu) Then IntShift = (IntShift Or 4)
55+
56+
IntCode = Msg.lParamLow And &HFF
57+
Debug.Print Msg.lParamLow
58+
Debug.Print &HFF
59+
RaiseEvent KeyDown(IntCode, IntShift)
60+
End Select
61+
End Function
62+
63+
Private Sub Class_Initialize()
64+
LngClsPtr = ObjPtr(Me)
65+
MsgBox LngClsPtr
66+
End Sub
67+
68+

Connect.DCA

3.85 KB
Binary file not shown.

0 commit comments

Comments
 (0)