?? modcontrols.bas
字號:
Attribute VB_Name = "modControls"
'源碼收集:www.codefans.net
'#############################################
'modControls vbgamer45 2004
'##############################################
'Control Sepeartor Constatns
Public Const vbFormNewChildControl = 511 'FF01
Public Const vbFormExistingChildControl = 767 'FF02
Public Const vbFormChildControl = 1023 'FF03
Public Const vbFormEnd = 1279 'FF04
Public Const vbFormMenu = 1535 'FF05
'Control Header
Public Type ControlHeader
'Length As Integer
'unknown As Integer
length As Long
cId As Byte 'Used To link events
cName As String
un2 As Byte
cType As Byte
End Type
Public Type ControlArrayHeader
length As Integer
un1 As Byte
' Length As Long
ArrayFlag As Integer
cId As Byte
un2 As Byte
cName As String
un3 As Byte
cType As Byte
End Type
Public Type ControlSize
clientLeft As Integer
un1 As Integer
clientTop As Integer
un2 As Integer
clientWidth As Integer
un3 As Integer
clientHeight As Integer
un4 As Integer
End Type
'Used in cType
Public Enum ControlType
vbPictureBox = 0
vbLabel = 1
vbTextBox = 2
vbFrame = 3
vbCommandbutton = 4
vbCheckbox = 5
vbOptionbutton = 6
vbComboBox = 7
vbListbox = 8
vbHscroll = 9
vbVscroll = 10
vbTimer = 11
vbForm = 13
vbDriveListbox = 16
vbDirectoryListbox = 17
vbFileListbox = 18
vbMenu = 19
vbMDIForm = 20
vbShape = 22
vbLine = 23
vbImage = 24
vbData = 37
vbOLE = 38
vbUserControl = 40
vbPropertyPage = 41
vbUserDocument = 42
End Enum
'External Controls
Private Type OcxListType
strGuid As String
strocxName As String
strLibName As String
strName As String
End Type
Global gOcxList() As OcxListType
Public Type FontType
un1 As Byte
un2 As Byte
un3 As Byte
Action As Byte
Weight As Integer
Size As Long
FontLen As Byte
End Type
'Public Type tControlEventPointer
'Const1 As Byte ' 0x00
'Flag1 As Long ' 0x01
'Const2 As Integer ' 0x05 split up const2 into 2 ints
' Const3 As Integer ' 0x07
'Const4 As Byte ' 0x09 changed from const3
' aEvent As Long ' 0x0A
' 0x0E <-- Structure Size
'End Type
Public Type tControlEventLink
Const1 As Integer ' 0x00
CompileType As Byte ' 0x02 compileType According to Sarge[more info?]
aEvent As Long ' 0x03
' 0x07 <-- Structure Size
End Type
Public Type tControlEventPointer
Const1 As Byte ' 0x00
Flag1 As Long ' 0x01
Const2 As Integer ' 0x05
EventLink As tControlEventLink ' 0x07
' 0x0E <-- Structure Size
End Type
Public Type LineSizeType
X1 As Long
op1 As Byte
Y1 As Long
op2 As Byte
X2 As Long
op3 As Byte
Y2 As Long
End Type
Public Type DataFormatType
LCID As Integer
End Type
'##################################
'Begin Subs for Processing Special opcodes and properties for common controls
'##################################
Sub ProccessForm(f As Variant, Opcode As Byte)
End Sub
Sub ProccessPictureBox(f As Variant, Opcode As Byte)
End Sub
Sub ProccessLabel(f As Variant, Opcode As Byte)
End Sub
Sub ProccessTextBox(f As Variant, Opcode As Byte)
End Sub
Sub ProccessFrame(f As Variant, Opcode As Byte)
End Sub
Sub ProccessCommandButton(f As Variant, Opcode As Byte)
End Sub
Sub ProccessCheckBox(f As Variant, Opcode As Byte)
End Sub
Sub ProccessOption(f As Variant, Opcode As Byte)
End Sub
Sub ProccessComboBox(f As Variant, Opcode As Byte)
End Sub
Sub ProccessListBox(f As Variant, Opcode As Byte)
End Sub
Sub ProccessHscroll(f As Variant, Opcode As Byte)
End Sub
Sub ProccessVscroll(f As Variant, Opcode As Byte)
End Sub
Sub ProccessTimer(f As Variant, Opcode As Byte)
End Sub
Sub ProccessDriveListBox(f As Variant, Opcode As Byte)
End Sub
Sub ProccessDirListBox(f As Variant, Opcode As Byte)
End Sub
Sub ProccessFileListBox(f As Variant, Opcode As Byte)
End Sub
Sub ProccessShape(f As Variant, Opcode As Byte)
End Sub
Sub ProccessLine(f As Variant, Opcode As Byte)
End Sub
Sub ProccessImage(f As Variant, Opcode As Byte)
End Sub
'##################################
'End Subs for Processing Special opcodes and properties for common controls
'##################################
Sub GetControlProperties(offset As Long)
'*****************************
'Purpose: Used for Form Editor
'*****************************
Dim strCurrentForm As String
Dim fPos As Long 'Holds current location in the file used for controlheader
Dim cListIndex As Integer ' Used for COM
Dim cControlHeader As ControlHeader
Dim lForm As Integer
Dim FRXAddress As Long
Dim FileLen As Long
'Unload Old Controls
If frmMain.txtEditArray.UBound > 0 Then
For i = 1 To frmMain.txtEditArray.UBound
Unload frmMain.txtEditArray(i)
Unload frmMain.lblArrayEdit(i)
Next
End If
Set gVBFile = New clsFile
Call gVBFile.Setup(SFilePath)
f = gVBFile.FileNumber
Seek f, offset + 1
FRXAddress = 0
fPos = Loc(f)
Get #f, , cControlHeader
frmMain.lblObjectName.Caption = "ObjectName: " & cControlHeader.cName
Dim tliTypeInfo As TypeInfo 'Used for COM to find information about the properties of the control
'Used to caculate how much father to go in the control
'Select what type of control it is
Select Case cControlHeader.cType
Case vbPictureBox '= 0
cListIndex = 22
Case vbLabel '= 1
cListIndex = 14
Case vbTextBox ' = 2
cListIndex = 27
Case vbFrame '= 3
cListIndex = 10
Case vbCommandbutton '= 4
cListIndex = 4
Case vbCheckbox '= 5
cListIndex = 1
Case vbOptionbutton ' = 6
cListIndex = 21
Case vbComboBox ' = 7
cListIndex = 3
Case vbListbox '= 8
cListIndex = 17
Case vbHscroll '= 9
cListIndex = 12
Case vbVscroll '= 10
cListIndex = 32
Case vbTimer '= 11
cListIndex = 28
Case vbForm '= 13
cListIndex = 9
strCurrentForm = cControlHeader.cName
' MsgBox cControlHeader.cName
'Call modGlobals.LoadNewFormHolder(cControlHeader.cName)
'Call AddText("Begin VB.Form " & cControlHeader.cName)
' gIdentSpaces = 1
Case vbDriveListbox '= 16
cListIndex = 7
' Call AddText("Begin VB.DriveListbox " & cControlHeader.cName)
Case vbDirectoryListbox '= 17
cListIndex = 6
' Call AddText("Begin VB.DirectoryListbox " & cControlHeader.cName)
Case vbFileListbox '= 18
cListIndex = 8
' Call AddText("Begin VB.FileListBox " & cControlHeader.cName)
Case vbMenu '= 19
cListIndex = 19
' Call AddText("Begin VB.Menu " & cControlHeader.cName)
Case vbMDIForm '= 20
cListIndex = 18
'Call AddText("Begin VB.MDIForm " & cControlHeader.cName)
Case vbShape '= 22
cListIndex = 26
' Call AddText("Begin VB.Shape " & cControlHeader.cName)
Case vbLine '= 23
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -