frmform.frm

用VB实现的编译器的源代码

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form frmForm 
   AutoRedraw      =   -1  'True
   Caption         =   "Visual B++"
   ClientHeight    =   3195
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4680
   BeginProperty Font 
      Name            =   "Tahoma"
      Size            =   8.25
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "frmForm.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   213
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   312
   StartUpPosition =   2  'Bildschirmmitte
   Begin MSComDlg.CommonDialog cdlOpen 
      Index           =   0
      Left            =   1800
      Top             =   2400
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
      CancelError     =   -1  'True
      DialogTitle     =   "Open Form..."
      Filter          =   "Resource File (*.res)|*.res|all files (*.*)|*.*"
   End
   Begin VB.TextBox TextArea 
      Height          =   615
      Index           =   0
      Left            =   840
      MultiLine       =   -1  'True
      TabIndex        =   9
      Text            =   "frmForm.frx":0A02
      Top             =   480
      Visible         =   0   'False
      Width           =   735
   End
   Begin VB.Timer Timer 
      Index           =   0
      Left            =   0
      Top             =   1920
   End
   Begin VB.ListBox ListBox 
      Height          =   450
      Index           =   0
      Left            =   1680
      TabIndex        =   8
      Top             =   1200
      Visible         =   0   'False
      Width           =   735
   End
   Begin VB.ComboBox ComboBox 
      Height          =   315
      Index           =   0
      Left            =   840
      TabIndex        =   7
      Text            =   "Combo"
      Top             =   1200
      Visible         =   0   'False
      Width           =   735
   End
   Begin VB.OptionButton OptionButton 
      Caption         =   "Click"
      Height          =   615
      Index           =   0
      Left            =   0
      TabIndex        =   6
      Top             =   1200
      Visible         =   0   'False
      Width           =   735
   End
   Begin VB.CheckBox CheckBox 
      Caption         =   "OnOff"
      Height          =   615
      Index           =   0
      Left            =   3360
      TabIndex        =   5
      Top             =   480
      Visible         =   0   'False
      Width           =   735
   End
   Begin VB.CommandButton CommandButton 
      Caption         =   "Click"
      Height          =   615
      Index           =   0
      Left            =   2520
      TabIndex        =   4
      Top             =   480
      Visible         =   0   'False
      Width           =   735
   End
   Begin VB.Frame Frame 
      Caption         =   "Frame"
      Height          =   615
      Index           =   0
      Left            =   2520
      TabIndex        =   3
      Top             =   1200
      Visible         =   0   'False
      Width           =   735
   End
   Begin VB.TextBox TextBox 
      Height          =   615
      Index           =   0
      Left            =   3360
      TabIndex        =   2
      Top             =   1200
      Visible         =   0   'False
      Width           =   735
   End
   Begin VB.PictureBox PictureBox 
      Height          =   615
      Index           =   0
      Left            =   0
      ScaleHeight     =   555
      ScaleWidth      =   675
      TabIndex        =   1
      Top             =   480
      Visible         =   0   'False
      Width           =   735
   End
   Begin VB.PictureBox picCursor 
      Appearance      =   0  '2D
      BackColor       =   &H80000005&
      ForeColor       =   &H80000008&
      Height          =   375
      Left            =   3480
      ScaleHeight     =   23
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   63
      TabIndex        =   0
      Top             =   2640
      Visible         =   0   'False
      Width           =   975
   End
   Begin VB.Label lblInfo 
      AutoSize        =   -1  'True
      Caption         =   "Please drag the shape of the control you want to create."
      Height          =   195
      Left            =   120
      TabIndex        =   11
      Top             =   120
      Width           =   4110
   End
   Begin VB.Label Label 
      Caption         =   "<No Caption>"
      Height          =   615
      Index           =   0
      Left            =   1680
      TabIndex        =   10
      Top             =   480
      Visible         =   0   'False
      Width           =   735
   End
   Begin VB.Shape shpDrag 
      BorderColor     =   &H00DC8652&
      BorderStyle     =   2  'Strich
      FillColor       =   &H00FE5C45&
      FillStyle       =   7  'Diagonalkreuz
      Height          =   615
      Left            =   3360
      Top             =   2520
      Visible         =   0   'False
      Width           =   1215
   End
   Begin VB.Menu mnuContext 
      Caption         =   "Context"
      Visible         =   0   'False
      Begin VB.Menu mnuContextCaption 
         Caption         =   "Set caption..."
      End
   End
End
Attribute VB_Name = "frmForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public MyProp As frmProperties
Dim GridType As Integer
Dim GridSize As Integer
Dim Objects(1024) As Object
Dim Code(1024) As String
Dim SelectedControl As Object
Public SelectedID As Integer
Dim ControlsCount As Integer
Dim MinusX, MinusY

Public Sub Save()
    Open frmMain.txtProject & "\" & Me.Tag For Output As #1
        Print #1, Me.Caption
        Print #1, Me.Width
        Print #1, Me.Height
        Print #1, Me.Left
        Print #1, Me.Top
        For f = 0 To ControlsCount - 1
            Print #1, "Control " & Objects(f).Tag
            Print #1, Code(f)
            Print #1, "End Control"
        Next f
    Close #1
End Sub

Public Sub fLoad(Optional Path)
    On Error GoTo Cp
    If IsMissing(Path) Then cdlOpen(0).ShowOpen Else cdlOpen(0).FileName = Path
    For f = 0 To ControlsCount - 1
        Objects(f).Visible = False
    Next f
    ControlsCount = 0
    Open cdlOpen(0).FileName For Input As #1
        Line Input #1, tCaption
        Line Input #1, tWidth
        Line Input #1, tHeight
        Line Input #1, tLeft
        Line Input #1, tTop
        Me.Caption = tCaption
        Me.Width = tWidth
        Me.Height = tHeight
        Me.Left = tLeft
        Me.Top = tTop
        Do Until EOF(1)
            Line Input #1, ControlID$
            ControlID = Mid(ControlID, 9)
            AddAControl ControlID
            Code(ControlsCount - 1) = ""
            Do Until LP = "End Control"
                Line Input #1, LP
                If Not LP = "End Control" Then
                    Code(ControlsCount - 1) = Code(ControlsCount - 1) & LP & vbCrLf
                End If
            Loop
            LP = ""
        Loop
    Close #1
    RedrawAllControls
Cp:
End Sub

Public Function GetVN(ControlName As String) As String
    X = Mid(ControlName, 4)
    X = LCase(Left(X, 1)) & Mid(X, 2)
    GetVN = X
End Function

Public Function GetCN(ControlID) As String
    P = Split(Code(ControlID), vbCrLf)
    GetCN = CStr(P(0))
End Function

Public Sub Convert()
    Dim P As New frmEditor
    NewClass = Me.Tag
    NewClass = Left(NewClass, InStrRev(NewClass, ".") - 1)
    P.Tag = NewClass & ".bis"
    P.Show
    P.Caption = P.Tag & " - Source Code"
    With P
        .AppendLine "class " & NewClass
        .AppendLine ""
        .AppendLine "  <definitions>"
        .AppendLine ""
        .AppendLine "  variable form"
        .AppendLine "    MetaVariable;;"
        .AppendLine "    [""""];;"
        .AppendLine "  end variable"
        .AppendLine ""
        For f% = 0 To ControlsCount - 1
            .AppendLine "  variable " & GetVN(GetCN(f))
            .AppendLine "    Control <controlling " & GetCN(f) & ">;;"
            .AppendLine "    [""""];;"
            .AppendLine "  end variable"
            .AppendLine ""
        Next f
        .AppendLine "  variable mainForm"
        .AppendLine "    Boolean <is this the main form?>;;"
        .AppendLine "    [!false];;"
        .AppendLine "  end variable"
        .AppendLine ""
        .AppendLine "  method assignEventListener"
        .AppendLine "    1;;"
        .AppendLine "    NewHandler;;"
        .AppendLine "  end method"
        .AppendLine ""
        .AppendLine "  <methods>"
        .AppendLine ""
        .AppendLine "  method void assignEventListener"
        .AppendLine "    actionHandler [#NewHandler];;"
        .AppendLine "  end method"
        .AppendLine ""
        .AppendLine "  method void showAsMain"
        .AppendLine "    set this.mainForm [!true];;"
        .AppendLine "    > this.show;;"
        .AppendLine "  end method"
        .AppendLine ""
        .AppendLine "  method void show"
        .AppendLine "    assignForm fixed [""" & Me.Caption & """] [@" & CInt(Me.Width / Screen.TwipsPerPixelX) & "] [@" & CInt(Me.Height / Screen.TwipsPerPixelY) & "];;"
        .AppendLine "    //setFormIcon [""C:\Path\Icon.Ico""];;"
        For f = 0 To ControlsCount - 1
            .AppendLine "    addControl " & Objects(f).Tag & " " & GetCN(f) & ";;"
        Next f
        .AppendLine ""
        .AppendLine "    set this.form [?R:Form];;"
        For f = 0 To ControlsCount - 1
            .AppendLine "    set this." & GetVN(GetCN(f)) & " [?R:" & GetCN(f) & "];;"
        Next f
        .AppendLine ""
        For f = 0 To ControlsCount - 1
            S = Code(f)
            S = Replace(S, vbCrLf, vbLf)
            Q = Split(S, vbLf)
            For g = LBound(Q) To UBound(Q)
                If Not Q(g) = "" And Not InStr(Q(g), "=") = 0 Then
                    R = Split(Q(g), "=")
                    .AppendLine "    :this." & GetVN(GetCN(f)) & "." & _
                        R(0) & " = [" & R(1) & "];;"
                End If
            Next g