modcontrols.bas

一款VB 工具

Attribute VB_Name = "modControls"


'#############################################
'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