modfunction.bas

来自「中专学校的学生操行分管理系统,包含了网络查询的功能」· BAS 代码 · 共 121 行

Attribute VB_Name = "modFunction"
Option Explicit

Public Type Point
    X As Long
    Y As Long
End Type

Public Type Rectangle
    Left As Long
    Top As Long
    Height As Long
    Width As Long
End Type

Public pitStart As Point, pitEnd As Point  '鼠标移动开始的点和结束的点
Public recHeader As Rectangle  '页首区
Public recFooter As Rectangle  '页尾区
Public objSelect As Object     '被选中对象

'======================================
'判断点是否在一个方形内
'======================================
Public Function PInRec(pit As Point, rec As Rectangle) As Boolean
    PInRec = False
    If (pit.X >= rec.Left And pit.X <= (rec.Left + rec.Width)) _
            And (pit.Y >= rec.Top And pit.Y <= (rec.Top + rec.Height)) Then PInRec = True
End Function

'======================================
'判断点是在哪个区域内
'======================================
Public Function PInArea(pit As Point) As String
    If PInRec(pit, recHeader) Then PInArea = "Header"
    If PInRec(pit, recFooter) Then PInArea = "Footer"
End Function

'======================================
'移动Band时对Band的位置合理性进行判断
'======================================
Public Sub MoveMyBand(ByVal Index As Integer, ByVal intBandHeight As Long, cltObject As Collection)
    Dim objObject As Object
    Select Case Index
        Case 0
            For Each objObject In cltObject
                If objObject.Visible And objObject.Tag = "Header" Then
                    If (recHeader.Top + recHeader.Height) + (pitEnd.Y - pitStart.Y) < (objObject.Top + objObject.Height) Then _
                        pitEnd.Y = (objObject.Top + objObject.Height) - (recHeader.Top + recHeader.Height) + pitStart.Y
                End If
            Next objObject
            If (recHeader.Top + recHeader.Height) + (pitEnd.Y - pitStart.Y) + 2 * intBandHeight > recFooter.Top Then _
                pitEnd.Y = recFooter.Top - ((recHeader.Top + recHeader.Height) + 2 * intBandHeight) + pitStart.Y
            If recHeader.Height + (pitEnd.Y - pitStart.Y) < 0 Then pitEnd.Y = pitStart.Y - recHeader.Height
        Case 1
            For Each objObject In cltObject
                If objObject.Visible And objObject.Tag = "Footer" Then
                    If recFooter.Top + (pitEnd.Y - pitStart.Y) > objObject.Top Then _
                        pitEnd.Y = objObject.Top - recFooter.Top + pitStart.Y
                End If
            Next objObject
            If (recFooter.Top - 2 * intBandHeight) + (pitEnd.Y - pitStart.Y) < (recHeader.Top + recHeader.Height) Then _
                pitEnd.Y = (recHeader.Top + recHeader.Height) + pitStart.Y - (recFooter.Top - 2 * intBandHeight)
            If (pitEnd.Y - pitStart.Y) > recFooter.Height Then pitEnd.Y = pitStart.Y + recFooter.Height
    End Select
End Sub

'======================================
'生成Object时对Object的位置合理性进行判断
'======================================
Public Sub CreateMyObject()
    If pitEnd.X <= pitStart.X Then pitEnd.X = pitStart.X + 1
    If pitEnd.Y <= pitStart.Y Then pitEnd.Y = pitStart.Y + 1
    Select Case PInArea(pitStart)
        Case "Header"
            If pitEnd.X > (recHeader.Left + recHeader.Width) Then pitEnd.X = (recHeader.Left + recHeader.Width)
            If pitEnd.Y > (recHeader.Top + recHeader.Height) Then pitEnd.Y = (recHeader.Top + recHeader.Height)
        Case "Footer"
            If pitEnd.X > (recFooter.Left + recFooter.Width) Then pitEnd.X = (recFooter.Left + recFooter.Width)
            If pitEnd.Y > (recFooter.Top + recFooter.Height) Then pitEnd.Y = (recFooter.Top + recFooter.Height)
    End Select
End Sub

'======================================
'改变Object大小时对Object的位置合理性进行判断
'======================================
Public Sub ResizeMyObject(ByVal Tag As String, ByVal Left As Long, ByVal Top As Long, ByVal Height As Long, ByVal Width As Long)
    If Width + (pitEnd.X - pitStart.X) < 0 Then pitEnd.X = pitStart.X - Width + 1
    If Height + (pitEnd.Y - pitStart.Y) < 0 Then pitEnd.Y = pitStart.Y - Height + 1
    Select Case Tag
        Case "Header"
            If Width + (pitEnd.X - pitStart.X) > (recHeader.Width - Left) Then pitEnd.X = (recHeader.Width - Left) + pitStart.X - Width
            If Height + (pitEnd.Y - pitStart.Y) > (recHeader.Top + recHeader.Height - Top) Then pitEnd.Y = (recHeader.Top + recHeader.Height - Top) + pitStart.Y - Height
        Case "Footer"
            If Width + (pitEnd.X - pitStart.X) > (recFooter.Width - Left) Then pitEnd.X = (recFooter.Width - Left) + pitStart.X - Width
            If Height + (pitEnd.Y - pitStart.Y) > (recFooter.Top + recFooter.Height - Top) Then pitEnd.Y = (recFooter.Top + recFooter.Height - Top) + pitStart.Y - Height
    End Select
End Sub

'======================================
'移动Object时对Object的位置合理性进行判断
'======================================
Public Sub MoveMyObject(ByVal Tag As String, ByVal Left As Long, ByVal Top As Long, ByVal Height As Long, ByVal Width As Long)
    Select Case Tag
        Case "Header"
            If Left + (pitEnd.X - pitStart.X) < recHeader.Left Then pitEnd.X = recHeader.Left - Left + pitStart.X
            If (Left + Width) + (pitEnd.X - pitStart.X) > (recHeader.Left + recHeader.Width) Then _
                pitEnd.X = (recHeader.Left + recHeader.Width) - (Left + Width) + pitStart.X
            If Top + (pitEnd.Y - pitStart.Y) < recHeader.Top Then pitEnd.Y = recHeader.Top - Top + pitStart.Y
            If (Top + Height) + (pitEnd.Y - pitStart.Y) > (recHeader.Top + recHeader.Height) Then _
                pitEnd.Y = (recHeader.Top + recHeader.Height) - (Top + Height) + pitStart.Y
        Case "Footer"
            If Left + (pitEnd.X - pitStart.X) < recFooter.Left Then pitEnd.X = recFooter.Left - Left + pitStart.X
            If (Left + Width) + (pitEnd.X - pitStart.X) > (recFooter.Left + recFooter.Width) Then _
                pitEnd.X = (recFooter.Left + recFooter.Width) - (Left + Width) + pitStart.X
            If Top + (pitEnd.Y - pitStart.Y) < recFooter.Top Then pitEnd.Y = recFooter.Top - Top + pitStart.Y
            If (Top + Height) + (pitEnd.Y - pitStart.Y) > (recFooter.Top + recFooter.Height) Then _
                pitEnd.Y = (recFooter.Top + recFooter.Height) - (Top + Height) + pitStart.Y
    End Select
End Sub