-
Notifications
You must be signed in to change notification settings - Fork 10
/
Copy pathDarkEdit.ctl
366 lines (316 loc) · 13.5 KB
/
DarkEdit.ctl
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
VERSION 5.00
Begin VB.UserControl DarkEdit
BackColor = &H00463F3F&
ClientHeight = 375
ClientLeft = 0
ClientTop = 0
ClientWidth = 1935
MousePointer = 3 'I-Beam
ScaleHeight = 375
ScaleWidth = 1935
ToolboxBitmap = "DarkEdit.ctx":0000
Begin VB.Timer tmrSetColor
Enabled = 0 'False
Interval = 10
Left = 1080
Top = 0
End
Begin VB.TextBox edMain
Appearance = 0 'Flat
BackColor = &H00373333&
BorderStyle = 0 'None
BeginProperty Font
Name = "Microsoft YaHei UI"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C8C8C8&
Height = 375
Left = 0
TabIndex = 0
Text = "Boy¡áNext¡áDoor"
Top = 0
Width = 1815
End
End
Attribute VB_Name = "DarkEdit"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'Dark¡áEdit by IceLolly
'Date: 2018.8.9
'Border R G B
'Normal: 63, 63, 70
'Mouse in: 0, 122, 204
'Edit back R G B
'Normal: 51, 51, 55
'Mouse in: 63, 63, 70
'Edit text R G B
'Normal: 119, 153, 137
'Mouse in: 255, 255, 255
Private Const SZ_BORDER = 10
Private Const BACK_NORMAL_R = 51, BACK_NORMAL_G = 51, BACK_NORMAL_B = 55
Private Const BACK_MOUSEIN_R = 63, BACK_MOUSEIN_G = 63, BACK_MOUSEIN_B = 70
Dim BackR As Integer
Dim BackG As Integer
Dim BackB As Integer
Dim bFocused As Boolean
'Event Declarations:
Event Change() 'MappingInfo=edMain,edMain,-1,Change
Attribute Change.VB_Description = "Occurs when the contents of a control have changed."
Event Click() 'MappingInfo=edMain,edMain,-1,Click
Attribute Click.VB_Description = "Occurs when the user presses and then releases a mouse button over an object."
Event DblClick() 'MappingInfo=edMain,edMain,-1,DblClick
Attribute DblClick.VB_Description = "Occurs when the user presses and releases a mouse button and then presses and releases it again over an object."
Event KeyDown(KeyCode As Integer, Shift As Integer) 'MappingInfo=edMain,edMain,-1,KeyDown
Attribute KeyDown.VB_Description = "Occurs when the user presses a key while an object has the focus."
Event KeyPress(KeyAscii As Integer) 'MappingInfo=edMain,edMain,-1,KeyPress
Attribute KeyPress.VB_Description = "Occurs when the user presses and releases an ANSI key."
Event KeyUp(KeyCode As Integer, Shift As Integer) 'MappingInfo=edMain,edMain,-1,KeyUp
Attribute KeyUp.VB_Description = "Occurs when the user releases a key while an object has the focus."
Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=edMain,edMain,-1,MouseMove
Attribute MouseMove.VB_Description = "Occurs when the user moves the mouse."
Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=edMain,edMain,-1,MouseUp
Attribute MouseUp.VB_Description = "Occurs when the user releases the mouse button while an object has the focus."
Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=edMain,edMain,-1,MouseDown
Attribute MouseDown.VB_Description = "Occurs when the user presses the mouse button while an object has the focus."
Private Sub edMain_GotFocus()
bFocused = True
UserControl.tmrSetColor.Enabled = True
UserControl.BackColor = RGB(0, 122, 204)
UserControl.edMain.ForeColor = RGB(255, 255, 255)
End Sub
Private Sub edMain_LostFocus()
bFocused = False
UserControl.tmrSetColor.Enabled = False
UserControl.BackColor = RGB(63, 63, 70)
UserControl.edMain.ForeColor = RGB(200, 200, 200)
UserControl.tmrSetColor.Enabled = True
End Sub
Private Sub tmrSetColor_Timer()
On Error Resume Next
Dim pt As POINT
Dim Target As Long
GetCursorPos pt
Target = WindowFromPoint(pt.X, pt.Y)
If GetForegroundWindow() <> UserControl.Parent.hWnd Then
bFocused = False
End If
If GetFocus() = UserControl.edMain.hWnd Then
bFocused = True
End If
If Target = UserControl.hWnd Or Target = UserControl.edMain.hWnd Or bFocused Then
UserControl.BackColor = RGB(0, 122, 204)
UserControl.edMain.ForeColor = RGB(255, 255, 255)
BackR = BackR + 1
BackG = BackG + 1
BackB = BackB + 1
If BackR > BACK_MOUSEIN_R Or BackG > BACK_MOUSEIN_G Or BackB > BACK_MOUSEIN_B Then
BackR = BACK_MOUSEIN_R
BackG = BACK_MOUSEIN_G
BackB = BACK_MOUSEIN_B
End If
Else
UserControl.BackColor = RGB(63, 63, 70)
UserControl.edMain.ForeColor = RGB(200, 200, 200)
BackR = BackR - 1
BackG = BackG - 1
BackB = BackB - 1
If BackR < BACK_NORMAL_R Or BackG < BACK_NORMAL_G Or BackB < BACK_NORMAL_B Then
BackR = BACK_NORMAL_R
BackG = BACK_NORMAL_G
BackB = BACK_NORMAL_B
End If
End If
UserControl.edMain.BackColor = RGB(BackR, BackG, BackB)
End Sub
Private Sub edMain_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
UserControl.edMain.ToolTipText = Extender.ToolTipText
RaiseEvent MouseMove(Button, Shift, X, Y)
Call UserControl_MouseMove(Button, 0, 0, 0)
End Sub
Private Sub UserControl_GotFocus()
On Error Resume Next
UserControl.edMain.SetFocus
UserControl.tmrSetColor.Enabled = True
End Sub
Private Sub UserControl_Initialize()
BackR = BACK_NORMAL_R
BackG = BACK_NORMAL_G
BackB = BACK_NORMAL_B
End Sub
Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
UserControl.tmrSetColor.Enabled = True
UserControl.BackColor = RGB(0, 122, 204)
UserControl.edMain.ForeColor = RGB(255, 255, 255)
End Sub
Private Sub UserControl_Resize()
On Error Resume Next
UserControl.edMain.Left = SZ_BORDER
UserControl.edMain.Top = SZ_BORDER
UserControl.edMain.Width = UserControl.Width - SZ_BORDER * 3
UserControl.edMain.Height = UserControl.Height - SZ_BORDER * 3
End Sub
Private Sub edMain_Change()
RaiseEvent Change
End Sub
Private Sub edMain_Click()
RaiseEvent Click
End Sub
Private Sub edMain_DblClick()
RaiseEvent DblClick
End Sub
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,Enabled
Public Property Get Enabled() As Boolean
Attribute Enabled.VB_Description = "Returns/sets a value that determines whether an object can respond to user-generated events."
Enabled = UserControl.Enabled
End Property
Public Property Let Enabled(ByVal New_Enabled As Boolean)
UserControl.Enabled() = New_Enabled
PropertyChanged "Enabled"
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=edMain,edMain,-1,Font
Public Property Get Font() As Font
Attribute Font.VB_Description = "Returns a Font object."
Attribute Font.VB_UserMemId = -512
Set Font = edMain.Font
End Property
Public Property Set Font(ByVal New_Font As Font)
Set edMain.Font = New_Font
PropertyChanged "Font"
End Property
Private Sub edMain_KeyDown(KeyCode As Integer, Shift As Integer)
RaiseEvent KeyDown(KeyCode, Shift)
End Sub
Private Sub edMain_KeyPress(KeyAscii As Integer)
RaiseEvent KeyPress(KeyAscii)
End Sub
Private Sub edMain_KeyUp(KeyCode As Integer, Shift As Integer)
RaiseEvent KeyUp(KeyCode, Shift)
End Sub
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=edMain,edMain,-1,Locked
Public Property Get Locked() As Boolean
Attribute Locked.VB_Description = "Determines whether a control can be edited."
Locked = edMain.Locked
End Property
Public Property Let Locked(ByVal New_Locked As Boolean)
edMain.Locked() = New_Locked
PropertyChanged "Locked"
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=edMain,edMain,-1,MaxLength
Public Property Get MaxLength() As Long
Attribute MaxLength.VB_Description = "Returns/sets the maximum number of characters that can be entered in a control."
MaxLength = edMain.MaxLength
End Property
Public Property Let MaxLength(ByVal New_MaxLength As Long)
edMain.MaxLength() = New_MaxLength
PropertyChanged "MaxLength"
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=edMain,edMain,-1,MultiLine
Public Property Get MultiLine() As Boolean
Attribute MultiLine.VB_Description = "Returns/sets a value that determines whether a control can accept multiple lines of text."
MultiLine = edMain.MultiLine
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=edMain,edMain,-1,Text
Public Property Get Text() As String
Attribute Text.VB_Description = "Returns/sets the text contained in the control."
Text = edMain.Text
End Property
Public Property Let Text(ByVal New_Text As String)
edMain.Text() = New_Text
PropertyChanged "Text"
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=edMain,edMain,-1,PasswordChar
Public Property Get PasswordChar() As String
Attribute PasswordChar.VB_Description = "Returns/sets a value that determines whether characters typed by a user or placeholder characters are displayed in a control."
PasswordChar = edMain.PasswordChar
End Property
Public Property Let PasswordChar(ByVal New_PasswordChar As String)
edMain.PasswordChar() = New_PasswordChar
PropertyChanged "PasswordChar"
End Property
Private Sub edMain_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
RaiseEvent MouseUp(Button, Shift, X, Y)
End Sub
Private Sub edMain_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
RaiseEvent MouseDown(Button, Shift, X, Y)
End Sub
'Load property values from storage
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
UserControl.Enabled = PropBag.ReadProperty("Enabled", True)
Set edMain.Font = PropBag.ReadProperty("Font", Ambient.Font)
edMain.Locked = PropBag.ReadProperty("Locked", False)
edMain.MaxLength = PropBag.ReadProperty("MaxLength", 0)
edMain.Text = PropBag.ReadProperty("Text", "Boy¡áNext¡áDoor")
edMain.PasswordChar = PropBag.ReadProperty("PasswordChar", "")
edMain.SelLength = PropBag.ReadProperty("SelLength", 0)
edMain.SelStart = PropBag.ReadProperty("SelStart", 0)
edMain.SelText = PropBag.ReadProperty("SelText", "")
edMain.MousePointer = PropBag.ReadProperty("MousePointer", 0)
End Sub
'Write property values to storage
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
Call PropBag.WriteProperty("Enabled", UserControl.Enabled, True)
Call PropBag.WriteProperty("Font", edMain.Font, Ambient.Font)
Call PropBag.WriteProperty("Locked", edMain.Locked, False)
Call PropBag.WriteProperty("MaxLength", edMain.MaxLength, 0)
Call PropBag.WriteProperty("Text", edMain.Text, "Boy¡áNext¡áDoor")
Call PropBag.WriteProperty("PasswordChar", edMain.PasswordChar, "")
Call PropBag.WriteProperty("SelLength", edMain.SelLength, 0)
Call PropBag.WriteProperty("SelStart", edMain.SelStart, 0)
Call PropBag.WriteProperty("SelText", edMain.SelText, "")
Call PropBag.WriteProperty("MousePointer", edMain.MousePointer, 0)
End Sub
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=edMain,edMain,-1,SelLength
Public Property Get SelLength() As Long
Attribute SelLength.VB_Description = "Returns/sets the number of characters selected."
SelLength = edMain.SelLength
End Property
Public Property Let SelLength(ByVal New_SelLength As Long)
edMain.SelLength() = New_SelLength
PropertyChanged "SelLength"
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=edMain,edMain,-1,SelStart
Public Property Get SelStart() As Long
Attribute SelStart.VB_Description = "Returns/sets the starting point of text selected."
SelStart = edMain.SelStart
End Property
Public Property Let SelStart(ByVal New_SelStart As Long)
edMain.SelStart() = New_SelStart
PropertyChanged "SelStart"
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=edMain,edMain,-1,SelText
Public Property Get SelText() As String
Attribute SelText.VB_Description = "Returns/sets the string containing the currently selected text."
SelText = edMain.SelText
End Property
Public Property Let SelText(ByVal New_SelText As String)
edMain.SelText() = New_SelText
PropertyChanged "SelText"
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=edMain,edMain,-1,MousePointer
Public Property Get MousePointer() As MousePointerConstants
Attribute MousePointer.VB_Description = "Returns/sets the type of mouse pointer displayed when over part of an object."
MousePointer = edMain.MousePointer
End Property
Public Property Let MousePointer(ByVal New_MousePointer As MousePointerConstants)
edMain.MousePointer() = New_MousePointer
PropertyChanged "MousePointer"
End Property