frmdlgwindow.frm

来自「多种图表的绘制及其运用」· FRM 代码 · 共 1,075 行 · 第 1/3 页

            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   240
         Left            =   15
         TabIndex        =   22
         Top             =   -30
         Visible         =   0   'False
         Width           =   1065
      End
      Begin VB.CommandButton cmdAdd 
         Caption         =   "Text Area"
         Height          =   450
         Index           =   1
         Left            =   2549
         TabIndex        =   10
         Top             =   255
         Width           =   1260
      End
      Begin VB.CommandButton cmdAdd 
         Caption         =   "Button"
         Height          =   450
         Index           =   0
         Left            =   3876
         TabIndex        =   11
         Top             =   255
         Width           =   780
      End
      Begin VB.Label lblFuncOnResize 
         Alignment       =   1  'Right Justify
         AutoSize        =   -1  'True
         Caption         =   "On Resize:"
         Height          =   195
         Left            =   150
         TabIndex        =   33
         Top             =   915
         Width           =   780
      End
      Begin VB.Line Line2 
         BorderColor     =   &H80000010&
         X1              =   75
         X2              =   5490
         Y1              =   755
         Y2              =   755
      End
      Begin VB.Line Line1 
         BorderColor     =   &H80000005&
         X1              =   105
         X2              =   5490
         Y1              =   760
         Y2              =   760
      End
      Begin VB.Label lblFuncOnLoad 
         Alignment       =   1  'Right Justify
         AutoSize        =   -1  'True
         Caption         =   "On Load:"
         Height          =   195
         Left            =   2880
         TabIndex        =   32
         Top             =   915
         Width           =   660
      End
   End
End
Attribute VB_Name = "frmDlgWindow"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' =========================================================
'  === Project of Data-flow Visual Programming Language ===
' =========================================================
' Copyright Emu8086, Inc. Free Code !
'
'
' URL: http://www.emu8086.com/vb/


' [e-mail]




Option Explicit

Dim DO_NOT_RESIZE As Boolean

' collection of all GUI objects on form:
Public theGUI As GUI_Collection

' currently selected GUI object:
Public selectedGUI As cGUI_obj

' used for moving controls:
Dim MOUSE_DOWN_X As Single
Dim MOUSE_DOWN_Y As Single
Dim MOUSE_PRESSED As Boolean


' used for moving selectors (to resize):
Dim sel_mDown_X As Single
Dim sel_mDown_Y As Single
Dim sel_mPressed As Boolean

' true when changes are accepted:
Dim ACCEPT_CHANGES As Boolean

'============ resize constrains:
Dim fraProperties_X As Single
Dim fraEvents_X As Single
Dim cmdOK_X As Single
Dim cmdOK_Y As Single
Dim fraToolBar_Y As Single
Dim picWin_W As Single
Dim picWin_H As Single
'==============================

' keep the minimum size of this window:
Dim myMinWidth As Single
Dim myMinHeight As Single



Private Sub Form_Activate()
    frmLists.fillCombo_func cmbFunction1
    frmLists.fillCombo_func cmbFunction2
    frmLists.fillCombo_func cmbFuncOnLoad
    frmLists.fillCombo_func cmbFuncOnResize
End Sub

Private Sub processRecentFunc()
    ' IMPR: (not very important)
    '  on this form only recent for last selected object is added,
    '  since when focus is lost by one of the controls the content
    '  of combo boxes changes.
    
    frmLists.addRecentFunc cmbFunction1.Text
    frmLists.addRecentFunc cmbFunction2.Text
    frmLists.addRecentFunc cmbFuncOnLoad.Text
    frmLists.addRecentFunc cmbFuncOnResize.Text
End Sub




Private Sub cmdAdd_Click(Index As Integer)
    Dim cg As cGUI_obj
    
    ' names are checked (for duplicates) on "OK" click.
    
    Select Case Index
    Case 0
        Set cg = theGUI.Add("Button" & objBUTTON.Count, "BUTTON")
    Case 1
        Set cg = theGUI.Add("TextArea" & objTAREA.Count, "TAREA")
    Case 2
        Set cg = theGUI.Add("Picture" & objPIC.Count, "PIC")
    Case 3
        Set cg = theGUI.Add("TextBox" & objTBOX.Count, "TBOX")
    End Select
    
    Set selectedGUI = cg
    
    showProperties selectedGUI
    setSelector selectedGUI
End Sub

Private Sub cmdJavaTest_Click()
    cmdOK_Click
    frmJavaTest.Show 1, Me
End Sub

Private Sub Form_Load()

    DO_NOT_RESIZE = False

    '============ set resize constrains:
    fraProperties_X = Me.ScaleWidth - fraProperties.Left
    fraEvents_X = Me.ScaleWidth - fraEvents.Left
    cmdOK_X = Me.ScaleWidth - cmdOK.Left
    cmdOK_Y = Me.ScaleHeight - cmdOK.Top
    fraToolBar_Y = Me.ScaleHeight - fraToolBar.Top
    picWin_W = Me.ScaleWidth - picWin.Width
    picWin_H = Me.ScaleHeight - picWin.Height
    '====================================

    ' keep minimum size of the window:
    myMinWidth = Me.Width
    myMinHeight = Me.Height

    ' initialize the collection:
    Set theGUI = New GUI_Collection
    Set theGUI.Parent = Me

    MOUSE_PRESSED = False
    ACCEPT_CHANGES = True
    
    Me.Icon = frmMain.Icon
End Sub

' checks that names are not duplicated.
' when everything OK returns True, otherwise shows
'  an error message and returns False:
Private Function ValidateNames() As Boolean
    Dim iCounter As Integer
    Dim s As String

    Dim cg As cGUI_obj
    Dim cRunner As cGUI_obj
    
    For Each cg In theGUI
        s = cg.sID
        If s <> "<DELETED>" Then   ' ignore deleted controls!
            iCounter = 0
            
            ' count number of components that have this name:
            For Each cRunner In theGUI
                ' compare, ignore case:
                If StrComp(s, cRunner.sID, vbTextCompare) = 0 Then
                    iCounter = iCounter + 1
                End If
            Next cRunner
            
            ' there should be only 1 such name:
            If iCounter > 1 Then
                MsgBox "There are " & iCounter & _
                       " components with name: " & s & vbNewLine & _
                       "All components should have unique names!"
                ValidateNames = False
                Exit Function
            End If
        End If
    Next cg
        
    ' all OK:
    ValidateNames = True
End Function

Private Sub cmdOK_Click()

    If Not ValidateNames() Then Exit Sub
    

    Dim cg As cGUI_obj
    
    With frmMain.theBlockCollection(frmMain.shp(SELECTED_SHAPE).Tag)
        .zAction = "WINDOW"

        ' store window size:
        .zParam1 = picWin.Width & "|" & picWin.Height & "|"

        ' store all controls on window:
        .zParam2 = ""
 
        For Each cg In theGUI
            If cg.sID <> "<DELETED>" Then   ' do not store deleted controls!
                .zParam2 = .zParam2 _
                            & cg.sTYPE & "|" _
                            & cg.sID & "|" _
                            & cg.sText & "|" _
                            & cg.X & "|" _
                            & cg.Y & "|" _
                            & cg.w & "|" _
                            & cg.h & "|" _
                            & cg.sFunction1 & "|" _
                            & cg.sFunction2 & "|"
            End If
        Next cg
        
        ' store functions that execute when
        '   window is loaded, and when is resized:
        .zParam3 = cmbFuncOnLoad.Text & "|" & cmbFuncOnResize.Text & "|"
        
        .setCaptionToAction
    End With
    
    Me.Hide
    
    processRecentFunc
    
    bIS_MODIFIED = True
End Sub




''''''''''''   moving buttons:


Private Sub objBUTTON_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    MOUSE_DOWN_X = X
    MOUSE_DOWN_Y = Y
    MOUSE_PRESSED = True
    ' selected:
    Set selectedGUI = theGUI.getObjectFromIndex(Index, "BUTTON")
    'show properties:
    showProperties selectedGUI
    setSelector selectedGUI
End Sub

Private Sub objBUTTON_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    If MOUSE_PRESSED Then
        objBUTTON(Index).Move objBUTTON(Index).Left + X - MOUSE_DOWN_X, objBUTTON(Index).Top + Y - MOUSE_DOWN_Y
        setSelectorVisible False
    End If
End Sub

Private Sub objBUTTON_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    MOUSE_PRESSED = False
    setSelector selectedGUI
End Sub





''''''''''' moving TAREAs:


Private Sub objTAREA_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    MOUSE_DOWN_X = X
    MOUSE_DOWN_Y = Y
    MOUSE_PRESSED = True
    ' selected:
    Set selectedGUI = theGUI.getObjectFromIndex(Index, "TAREA")
    'show properties:
    showProperties selectedGUI
    setSelector selectedGUI
End Sub

Private Sub objTAREA_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    If MOUSE_PRESSED Then
        objTAREA(Index).Move objTAREA(Index).Left + X - MOUSE_DOWN_X, objTAREA(Index).Top + Y - MOUSE_DOWN_Y
        setSelectorVisible False
    End If
End Sub

Private Sub objTAREA_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    MOUSE_PRESSED = False
    setSelector selectedGUI
End Sub



''''''''''' moving TBOXes:


Private Sub objTBOX_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    MOUSE_DOWN_X = X
    MOUSE_DOWN_Y = Y
    MOUSE_PRESSED = True
    ' selected:
    Set selectedGUI = theGUI.getObjectFromIndex(Index, "TBOX")
    'show properties:
    showProperties selectedGUI
    setSelector selectedGUI
End Sub

Private Sub objTBOX_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)