frmdraw.frm

中专学校的学生操行分管理系统,包含了网络查询的功能

    End If
    For i = 0 To 7
        lblPoint(i).Visible = bIsShow
        lblPoint(i).ZOrder
    Next i
End Sub

'============================================
'移动页首和页尾的高度
'============================================
Private Sub cmdBand_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = vbLeftButton And Shift = 0 Then
        Dim i As Integer
        For i = 1 To shapeCount
            cltObject.Add shpLine(i)
        Next i
        For i = 1 To labelCount
            cltObject.Add lblLabel(i)
        Next i
        For i = 1 To textCount
            cltObject.Add lblText(i)
        Next i
        bIsResize = True
        pitStart.Y = Y
    End If
End Sub

Private Sub cmdBand_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    If bIsResize Then
        pitEnd.X = X: pitEnd.Y = Y
        MoveMyBand Index, cmdBand(0).Height, cltObject
        cmdBand(Index).Move cmdBand(Index).Left, cmdBand(Index).Top + (pitEnd.Y - pitStart.Y)
        picHead.Top = cmdBand(0).Top + cmdBand(0).Height
        picHead.Height = IIf((cmdBand(1).Top - picHead.Top) > 0, cmdBand(1).Top - picHead.Top, 0)
        recHeader.Height = cmdBand(0).Top - tb.Height
        recFooter.Top = cmdBand(1).Top + cmdBand(1).Height
        recFooter.Height = sb.Top - cmdBand(1).Top - cmdBand(1).Height
        cmdBand(0).Caption = "页首  " & "( 高度：" & CStr(recHeader.Height) & " )"
        cmdBand(1).Caption = "页尾  " & "( 高度：" & CStr(recFooter.Height) & " )"
    End If
End Sub

Private Sub cmdBand_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    If bIsResize Then
        Dim i As Integer, intCount As Integer
        intCount = cltObject.Count
        For i = 1 To intCount
            cltObject.Remove 1
        Next i
        bIsResize = False
        pitStart.X = 0: pitStart.Y = 0
        pitEnd.X = 0: pitEnd.Y = 0
        picHead.SetFocus
    End If
End Sub

'============================================
'取消对象的被选中状态
'============================================
Private Sub Form_Click()
    If Not bSelected Then
        SetPoint False, 0, 0, 0, 0
        Set objSelect = Nothing
    End If
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyDelete And Not (objSelect Is Nothing) Then
        objSelect.Visible = False
        SetPoint False, 0, 0, 0, 0
        Set objSelect = Nothing
    End If
End Sub

Private Sub Form_Load()
    stCurType = shpSelect
End Sub

'============================================
'在Form上按下鼠标，有两种情况：
'   1、开始画对象
'   2、选择shape对象并且移动，因为shape控件没有鼠标事件，
'      所以只能在这里判断是否有shape对象被选中
'============================================
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = vbLeftButton And Shift = 0 Then
        pitStart.X = X: pitStart.Y = Y
        Select Case stCurType
            Case shpSelect
                Dim i As Integer
                bSelected = False
                For i = 1 To shapeCount
                    If shpLine(i).Visible Then
                        recShape.Left = shpLine(i).Left: recShape.Top = shpLine(i).Top
                        recShape.Height = shpLine(i).Height: recShape.Width = shpLine(i).Width
                        If PInRec(pitStart, recShape) Then
                            Set objSelect = shpLine(i)
                            SetPoint True, recShape.Top, recShape.Left, recShape.Height, recShape.Width
                            bSelected = True
                            bIsMove = True
                            Me.MousePointer = 5
                            Exit For
                        End If
                    End If
                Next i
            Case shpLabel, shpText, shpShape
                bIsMove = True
                Me.MousePointer = 2
        End Select
    End If
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If bIsMove Then
        pitEnd.X = X: pitEnd.Y = Y
        Select Case stCurType
            Case shpSelect
                If bSelected Then
                    MoveMyObject objSelect.Tag, objSelect.Left, objSelect.Top, objSelect.Height, objSelect.Width
                    objSelect.Move objSelect.Left + (pitEnd.X - pitStart.X), objSelect.Top + (pitEnd.Y - pitStart.Y)
                    SetPoint True, objSelect.Top, objSelect.Left, objSelect.Height, objSelect.Width
                    pitStart.X = pitEnd.X: pitStart.Y = pitEnd.Y
                End If
            Case shpLabel, shpText, shpShape
                CreateMyObject
                shpLine(0).ZOrder
                shpLine(0).Left = pitStart.X
                shpLine(0).Top = pitStart.Y
                shpLine(0).Height = pitEnd.Y - pitStart.Y
                shpLine(0).Width = pitEnd.X - pitStart.X
                shpLine(0).Visible = True
        End Select
    End If
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    shpLine(0).ZOrder 1
    shpLine(0).Visible = False
    pitEnd.X = X: pitEnd.Y = Y
    CreateMyObject
    Select Case stCurType
        Case shpSelect
        Case shpLabel
            stCurType = shpSelect
            tb.Buttons(1).Value = tbrPressed
            sb.Panels(1).Text = "Select"
            labelCount = labelCount + 1
            Load lblLabel(labelCount)
            lblLabel(labelCount).Tag = PInArea(pitStart)
            lblLabel(labelCount).Caption = "Label" & CStr(labelCount)
            lblLabel(labelCount).Left = pitStart.X
            lblLabel(labelCount).Top = pitStart.Y
            lblLabel(labelCount).Height = pitEnd.Y - pitStart.Y
            lblLabel(labelCount).Width = pitEnd.X - pitStart.X
            lblLabel(labelCount).AutoSize = True
            lblLabel(labelCount).ZOrder
            lblLabel(labelCount).Visible = True
'            SetPoint True, lblLabel(labelCount).Top, lblLabel(labelCount).Left, _
'                    lblLabel(labelCount).Height, lblLabel(labelCount).Width
        Case shpText
            stCurType = shpSelect
            tb.Buttons(1).Value = tbrPressed
            sb.Panels(1).Text = "Select"
            textCount = textCount + 1
            Load lblText(textCount)
            lblText(textCount).Tag = PInArea(pitStart)
            lblText(textCount).Caption = "Text" & CStr(textCount)
            lblText(textCount).Left = pitStart.X
            lblText(textCount).Top = pitStart.Y
            lblText(textCount).Height = pitEnd.Y - pitStart.Y
            lblText(textCount).Width = pitEnd.X - pitStart.X
            lblText(textCount).ZOrder
            lblText(textCount).Visible = True
'            SetPoint True, lblText(textCount).Top, lblText(textCount).Left, _
'                    lblText(textCount).Height, lblText(textCount).Width
        Case shpShape
            stCurType = shpSelect
            tb.Buttons(1).Value = tbrPressed
            sb.Panels(1).Text = "Select"
            shapeCount = shapeCount + 1
            Load shpLine(shapeCount)
            shpLine(shapeCount).Tag = PInArea(pitStart)
            shpLine(shapeCount).Left = pitStart.X
            shpLine(shapeCount).Top = pitStart.Y
            shpLine(shapeCount).Height = pitEnd.Y - pitStart.Y
            shpLine(shapeCount).Width = pitEnd.X - pitStart.X
            shpLine(shapeCount).ZOrder
            shpLine(shapeCount).Visible = True
'            SetPoint True, shpLine(shapeCount).Top, shpLine(shapeCount).Left, _
'                    shpLine(shapeCount).Height, shpLine(shapeCount).Width
    End Select
    bIsMove = False
    pitStart.X = 0: pitStart.Y = 0
    pitEnd.X = 0: pitEnd.Y = 0
    Me.MousePointer = 0
End Sub

'============================================
'调整页首和页尾的位置关系
'============================================
Private Sub Form_Resize()
    cmdBand(0).Width = Me.Width - 120
    cmdBand(1).Width = Me.Width - 120
    recHeader.Left = 0
    recHeader.Width = Me.Width - 120
    recHeader.Top = tb.Height
    recFooter.Left = 0
    recFooter.Width = Me.Width - 120
    picHead.Width = Me.Width - 120
    picHead.Top = cmdBand(0).Top + cmdBand(0).Height
    picHead.Height = IIf((cmdBand(1).Top - picHead.Top) > 0, cmdBand(1).Top - picHead.Top, 0)
    recHeader.Height = cmdBand(0).Top - tb.Height
    recFooter.Top = cmdBand(1).Top + cmdBand(1).Height
    recFooter.Height = sb.Top - cmdBand(1).Top - cmdBand(1).Height
    cmdBand(0).Caption = "页首  " & "( 高度：" & CStr(recHeader.Height) & " )"
    cmdBand(1).Caption = "页尾  " & "( 高度：" & CStr(recFooter.Height) & " )"
End Sub

'============================================
'移动被选Label对象的位置
'============================================
Private Sub lblLabel_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    SetPoint True, lblLabel(Index).Top, lblLabel(Index).Left, lblLabel(Index).Height, lblLabel(Index).Width
    Set objSelect = lblLabel(Index)
    If Button = vbLeftButton And Shift = 0 And stCurType = shpSelect Then
        bIsMove = True
        pitStart.X = X: pitStart.Y = Y
        Me.MousePointer = 5
    End If
End Sub

Private Sub lblLabel_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    If bIsMove And stCurType = shpSelect Then
        pitEnd.X = X: pitEnd.Y = Y
        MoveMyObject objSelect.Tag, objSelect.Left, objSelect.Top, objSelect.Height, objSelect.Width
        lblLabel(Index).Move lblLabel(Index).Left + (pitEnd.X - pitStart.X), lblLabel(Index).Top + (pitEnd.Y - pitStart.Y)
        SetPoint True, lblLabel(Index).Top, lblLabel(Index).Left, lblLabel(Index).Height, lblLabel(Index).Width
    End If
End Sub

Private Sub lblLabel_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    If bIsMove And stCurType = shpSelect Then
        bIsMove = False
        pitStart.X = 0: pitStart.Y = 0
        pitEnd.X = 0: pitEnd.Y = 0
        Me.MousePointer = 0
    End If
End Sub

'============================================
'移动状态点来改变被选对象的大小
'============================================
Private Sub lblPoint_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    Select Case Index
        Case 3, 4, 5
            If Button = vbLeftButton And Shift = 0 And stCurType = shpSelect Then
                bIsResize = True
                pitStart.X = X: pitStart.Y = Y
            End If
        Case Else
    End Select
End Sub

Private Sub lblPoint_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    pitEnd.X = X: pitEnd.Y = Y
    ResizeMyObject objSelect.Tag, objSelect.Left, objSelect.Top, objSelect.Height, objSelect.Width
    Select Case Index
        Case 3
            If bIsResize And stCurType = shpSelect Then
                objSelect.Width = objSelect.Width + (pitEnd.X - pitStart.X)
                pitStart.X = pitEnd.X
            End If
        Case 4
            If bIsResize And stCurType = shpSelect Then
                objSelect.Height = objSelect.Height + (pitEnd.Y - pitStart.Y)
                objSelect.Width = objSelect.Width + (pitEnd.X - pitStart.X)
                pitStart.X = pitEnd.X: pitStart.Y = pitEnd.Y
            End If
        Case 5
            If bIsResize And stCurType = shpSelect Then
                objSelect.Height = objSelect.Height + (pitEnd.Y - pitStart.Y)
                pitStart.Y = pitEnd.Y
            End If
        Case Else
    End Select
End Sub

Private Sub lblPoint_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    SetPoint True, objSelect.Top, objSelect.Left, objSelect.Height, objSelect.Width
    Select Case Index
        Case 3, 4, 5
            If bIsResize And stCurType = shpSelect Then bIsResize = False
            If objSelect.Name = "lblLabel" Or objSelect.Name = "lblText" Then objSelect.AutoSize = objSelect.AutoSize
        Case Else
    End Select
    SetPoint True, objSelect.Top, objSelect.Left, objSelect.Height, objSelect.Width
    pitStart.X = 0: pitStart.Y = 0
    pitEnd.X = 0: pitEnd.Y = 0
End Sub

'============================================
'移动被选Text对象的位置
'============================================
Private Sub lblText_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    SetPoint True, lblText(Index).Top, lblText(Index).Left, lblText(Index).Height, lblText(Index).Width
    Set objSelect = lblText(Index)
    If Button = vbLeftButton And Shift = 0 And stCurType = shpSelect Then
        bIsMove = True
        pitStart.X = X: pitStart.Y = Y
        Me.MousePointer = 5
    End If
End Sub

Private Sub lblText_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    If bIsMove And stCurType = shpSelect Then
        pitEnd.X = X: pitEnd.Y = Y
        MoveMyObject objSelect.Tag, objSelect.Left, objSelect.Top, objSelect.Height, objSelect.Width
        lblText(Index).Move lblText(Index).Left + (pitEnd.X - pitStart.X), lblText(Index).Top + (pitEnd.Y - pitStart.Y)
        SetPoint True, lblText(Index).Top, lblText(Index).Left, lblText(Index).Height, lblText(Index).Width
    End If
End Sub

Private Sub lblText_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    If bIsMove And stCurType = shpSelect Then
        bIsMove = False
        pitStart.X = 0: pitStart.Y = 0
        pitEnd.X = 0: pitEnd.Y = 0
        Me.MousePointer = 0
    End If
End Sub

'============================================
'工具栏按钮状态
'============================================
Private Sub tb_ButtonClick(ByVal Button As MSComCtlLib.Button)
    On Error Resume Next
    Select Case Button.Key
        Case "Select"
            stCurType = shpSelect
            sb.Panels(1).Text = "Select"
        Case "Label"
            stCurType = shpLabel
            sb.Panels(1).Text = "Label"
        Case "Text"
            stCurType = shpText
            sb.Panels(1).Text = "Text"
        Case "Shape"
            stCurType = shpShape
            sb.Panels(1).Text = "Shape"
    End Select
End Sub