frmdlgwindow.frm

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

    If MOUSE_PRESSED Then
        objTBOX(Index).Move objTBOX(Index).Left + X - MOUSE_DOWN_X, objTBOX(Index).Top + Y - MOUSE_DOWN_Y
        setSelectorVisible False
    End If
End Sub

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




''''''''''' moving pics:

Private Sub objPIC_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    ' picture has PIXEL scale-mode so convert to twips,
    ' since moving can be done only in TWIPS scale mode:
    MOUSE_DOWN_X = X * Screen.TwipsPerPixelX
    MOUSE_DOWN_Y = Y * Screen.TwipsPerPixelY
    MOUSE_PRESSED = True
    ' selected:
    Set selectedGUI = theGUI.getObjectFromIndex(Index, "PIC")
    'show properties:
    showProperties selectedGUI
    setSelector selectedGUI
End Sub

Private Sub objPIC_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    ' picture has PIXEL scale-mode so convert to twips,
    ' since moving can be done only in TWIPS scale mode:
    X = X * Screen.TwipsPerPixelX
    Y = Y * Screen.TwipsPerPixelY
    If MOUSE_PRESSED Then
        objPIC(Index).Move objPIC(Index).Left + X - MOUSE_DOWN_X, objPIC(Index).Top + Y - MOUSE_DOWN_Y
        setSelectorVisible False
    End If
End Sub

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




Private Sub showProperties(objGUI As cGUI_obj)
    If objGUI Is Nothing Then Exit Sub

    ACCEPT_CHANGES = False

    txtName.Text = objGUI.sID
    txtCaption.Text = replaceALL(objGUI.sText, vbNewLine, "\n")
    cmbFunction1.Text = objGUI.sFunction1
    cmbFunction2.Text = objGUI.sFunction2

    ACCEPT_CHANGES = True
End Sub

Private Sub setSelector(objGUI As cGUI_obj)
    If objGUI Is Nothing Then Exit Sub
    
    Dim X As Integer
    Dim Y As Integer
    
    Dim sSIZE As Integer
    
    ' width and height of all selectors
    '   is the same:
    sSIZE = pSel(0).Width
    
    
    
    ' left top:
    X = objGUI.X - sSIZE
    Y = objGUI.Y - sSIZE
    pSel(0).Move X, Y
    
    ' middle top:
    X = objGUI.X + objGUI.w / 2 - sSIZE / 2
    Y = objGUI.Y - sSIZE
    pSel(1).Move X, Y
    
    ' right top:
    X = objGUI.X + objGUI.w
    Y = objGUI.Y - sSIZE
    pSel(2).Move X, Y
    
    ' middle right:
    X = objGUI.X + objGUI.w
    Y = objGUI.Y + objGUI.h / 2 - sSIZE / 2
    pSel(3).Move X, Y
    
    ' right bottom:
    X = objGUI.X + objGUI.w
    Y = objGUI.Y + objGUI.h
    pSel(4).Move X, Y
    
    ' middle bottom:
    X = objGUI.X + objGUI.w / 2 - sSIZE / 2
    Y = objGUI.Y + objGUI.h
    pSel(5).Move X, Y
    
    ' left bottom:
    X = objGUI.X - sSIZE
    Y = objGUI.Y + objGUI.h
    pSel(6).Move X, Y
    
    ' middle left:
    X = objGUI.X - sSIZE
    Y = objGUI.Y + objGUI.h / 2 - sSIZE / 2
    pSel(7).Move X, Y
    
   
   
    ' make sure it's visible and
    '   put it over all other components:
   
    Dim i As Integer
    
    For i = 0 To 7
        pSel(i).ZOrder 0
    Next i
    
    setSelectorVisible True
    
End Sub

Private Sub setSelectorVisible(b As Boolean)
    Dim i As Integer

    For i = 0 To 7
        If pSel(i).Visible <> b Then
            pSel(i).Visible = b
        End If
    Next i
End Sub


Private Sub txtName_Change()
    If selectedGUI Is Nothing Then Exit Sub
    If Not ACCEPT_CHANGES Then Exit Sub
    
    ' names are checked (for duplicates) on "OK" click.
    
    selectedGUI.sID = txtName.Text
End Sub

Private Sub txtCaption_Change()
    If selectedGUI Is Nothing Then Exit Sub
    If Not ACCEPT_CHANGES Then Exit Sub
    
    selectedGUI.sText = replaceALL(txtCaption.Text, "\n", vbNewLine)
End Sub

Private Sub cmbFunction1_Change()
    If selectedGUI Is Nothing Then Exit Sub
    If Not ACCEPT_CHANGES Then Exit Sub

    selectedGUI.sFunction1 = cmbFunction1.Text
End Sub

Private Sub cmbFunction1_Click()
    cmbFunction1_Change
End Sub

Private Sub cmbFunction2_Change()
    If selectedGUI Is Nothing Then Exit Sub
    If Not ACCEPT_CHANGES Then Exit Sub

    selectedGUI.sFunction2 = cmbFunction2.Text
End Sub

Private Sub cmbFunction2_Click()
    cmbFunction2_Change
End Sub

Public Sub setWindowPARAMS(ByVal sSIZE As String, ByVal sWIN_EVENTS As String)
    
    '========== set window size:
    
    ' borders were taken in calculation...
    '  but this caused problems, so removed.
    
    picWin.Width = Val(rcToken(sSIZE, "|")) ' + (picWin.Width - picWin.ScaleWidth)
    picWin.Height = Val(rcToken(sSIZE, "|")) ' + (picWin.Height - picWin.ScaleHeight)
    
    ' allow on resize operations only after height is also set
    DO_NOT_RESIZE = True
    Me.Width = picWin.Width + picWin_W + (Me.Width - Me.ScaleWidth)
    DO_NOT_RESIZE = False
    Me.Height = picWin.Height + picWin_H + (Me.Height - Me.ScaleHeight)
    
    
    '=========== set "ON LOAD" function:
    cmbFuncOnLoad.Text = rcToken(sWIN_EVENTS, "|") ' sONLOAD
    '=========== set "ON RESIZE" function:
    cmbFuncOnResize.Text = rcToken(sWIN_EVENTS, "|")
End Sub

Private Sub Form_Resize()
    
    If DO_NOT_RESIZE Then Exit Sub
    
On Error GoTo err1
    
    ' do only if size is OK:
    If (Me.Width >= myMinWidth) And (Me.Height >= myMinHeight) Then
        '============ re-set resize constrains:
            fraProperties.Left = Me.ScaleWidth - fraProperties_X
            fraEvents.Left = Me.ScaleWidth - fraEvents_X
            cmdOK.Left = Me.ScaleWidth - cmdOK_X
            cmdOK.Top = Me.ScaleHeight - cmdOK_Y
            fraToolBar.Top = Me.ScaleHeight - fraToolBar_Y
            picWin.Width = Me.ScaleWidth - picWin_W
            picWin.Height = Me.ScaleHeight - picWin_H
        '====================================
    Else
        ' check the size (if required make it bigger):
        '   "-30" has no real meaning, but window can
        '   be made smaller for about 2 pixels of minimum
        '   size (that is recorded):
        If Me.Width < (myMinWidth - 30) Then
             Me.Width = myMinWidth
        End If
        If Me.Height < (myMinHeight - 30) Then
            Me.Height = myMinHeight
        End If
    End If
    
Exit Sub
err1:
Debug.Print "Error on resize: " & Err.Description
End Sub




''''' moving selector:

Private Sub pSel_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    sel_mDown_X = X
    sel_mDown_Y = Y
    sel_mPressed = True
End Sub

Private Sub pSel_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
   
    If sel_mPressed Then
  
        Dim oldX As Integer
        Dim oldY As Integer
        Dim oldW As Integer
        Dim oldH As Integer
                  
        Dim sSIZE As Integer
        ' width and height of all selectors
        '   is the same:
        sSIZE = pSel(0).Width
       
        oldX = selectedGUI.X
        oldY = selectedGUI.Y
        oldW = selectedGUI.w
        oldH = selectedGUI.h
        
        Select Case Index
         
        Case 0      ' left top
             pSel(Index).Move pSel(Index).Left + X - sel_mDown_X, pSel(Index).Top + Y - sel_mDown_Y
             
             selectedGUI.X = pSel(0).Left + sSIZE
             selectedGUI.Y = pSel(0).Top + sSIZE
             
             selectedGUI.w = (oldX - selectedGUI.X) + oldW
             selectedGUI.h = (oldY - selectedGUI.Y) + oldH
              
        Case 1      ' middle top
             pSel(Index).Top = pSel(Index).Top + Y - sel_mDown_Y
        
             selectedGUI.Y = pSel(1).Top + sSIZE
             
             selectedGUI.h = (oldY - selectedGUI.Y) + oldH
             
        Case 2      ' right top
             pSel(Index).Move pSel(Index).Left + X - sel_mDown_X, pSel(Index).Top + Y - sel_mDown_Y

             selectedGUI.w = pSel(2).Left - oldX
             
             selectedGUI.Y = pSel(2).Top + sSIZE
             
             selectedGUI.h = (oldY - selectedGUI.Y) + oldH
              
        Case 3      ' middle right
            pSel(Index).Left = pSel(Index).Left + X - sel_mDown_X

            selectedGUI.w = pSel(3).Left - oldX
            
        Case 4      ' right bottom
            pSel(Index).Move pSel(Index).Left + X - sel_mDown_X, pSel(Index).Top + Y - sel_mDown_Y

            selectedGUI.w = pSel(4).Left - oldX
            selectedGUI.h = pSel(4).Top - oldY
            
        Case 5      ' middle bottom
            pSel(Index).Top = pSel(Index).Top + Y - sel_mDown_Y

            selectedGUI.h = pSel(5).Top - oldY
            
        Case 6      ' left bottom
            pSel(Index).Move pSel(Index).Left + X - sel_mDown_X, pSel(Index).Top + Y - sel_mDown_Y

            selectedGUI.h = pSel(6).Top - oldY
             
            selectedGUI.X = pSel(6).Left + sSIZE
             
            selectedGUI.w = (oldX - selectedGUI.X) + oldW
              
        Case 7      ' middle left
            pSel(Index).Left = pSel(Index).Left + X - sel_mDown_X

            selectedGUI.X = pSel(7).Left + sSIZE
             
            selectedGUI.w = (oldX - selectedGUI.X) + oldW
             
        End Select
        
        setSelector selectedGUI
        picWin.Refresh
    End If

End Sub

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

Private Sub pSel_Paint(Index As Integer)
    'pSel(Index).Line (10, 10)-(30, 30), , BF
    pSel(Index).Line (0, 0)-(pSel(Index).ScaleWidth - Screen.TwipsPerPixelX, pSel(Index).ScaleHeight - Screen.TwipsPerPixelY), , B
End Sub

Private Sub cmdDelete_Click()
    If selectedGUI Is Nothing Then Exit Sub
    
    ' mark it as deleted (won't be stored):
    selectedGUI.sID = "<DELETED>"
    
    ' hide the object:
    selectedGUI.objGUI.Visible = False
    
    ' hide selector:
    setSelectorVisible False
End Sub