objdraws.cls

print打印功能.实现套打,请下载查看具体的功能介绍.

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "ObjDraws"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Collection" ,"ObjDraw"
Attribute VB_Ext_KEY = "Member0" ,"ObjActs"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Attribute VB_Ext_KEY = "Member1" ,"ObjDraw"
Option Explicit

'局部变量(保存集合)
Private mCol As Collection
'保持属性值的局部变量(局部复制)
Private mvarnCurID As Long
Private mvarnActCount As Long
Private mvarnFirstID As Long

Public Enum AlignCur
    AlignNone = 0
    AlignLeft = 1
    AlignHCenter = 2
    AlignRight = 3
    AlignTop = 4
    AlignVCenter = 5
    AlignBottom = 6
End Enum

Public Enum SameSizeCur
    SameSizeNone = 0
    SameSizeWidth = 1
    SameSizeHeight = 2
    SameSizeAll = SameSizeWidth + SameSizeHeight
End Enum

Public Enum SameSpaceSel
    SameSpaceNone = 0
    SameHSpaceSel = 1
    SameVSpaceSel = 2
End Enum

'ObjActs
Public Property Get ObjActs() As ObjActs
Dim mvarObjActs As New ObjActs
Dim tmpobj As ObjDraw, i As Long
    For Each tmpobj In mCol
        If i > mvarnActCount Then Exit For
        If tmpobj.IsActive Then mvarObjActs.Add tmpobj: i = i + 1
    Next
    Set ObjActs = mvarObjActs
End Property

'nActCount
Public Property Let nActCount(ByVal vdata As Long)
Dim tmpobj As ObjDraw
    mvarnActCount = vdata
    If vdata = 0 Then
        For Each tmpobj In mCol: tmpobj.IsActive = False: Next
        nCurID = 0
    End If
End Property
Public Property Get nActCount() As Long
    nActCount = mvarnActCount
End Property

'nCurID
Public Property Let nCurID(ByVal vdata As Long)
    If vdata <> mvarnCurID And mvarnCurID <> 0 And vdata <> 0 Then mCol("Obj" & mvarnCurID).IsCurrent = False
    mvarnCurID = vdata
    If mvarnCurID <> 0 Then mCol("Obj" & mvarnCurID).IsCurrent = True
    If mvarnCurID <> 0 And mvarnActCount = 0 Then mvarnActCount = 1
End Property
Public Property Get nCurID() As Long
    nCurID = mvarnCurID
End Property

'AdjustPage
Public Sub AdjustPage()
Dim tmpobj As ObjDraw
Dim mrect As RECTAPI
Dim mintop As Single, minleft As Single, maxbottom As Single, maxright As Single
    For Each tmpobj In mCol
        With tmpobj.ObjCtl
            If .Visible Then
                If TypeOf tmpobj.ObjCtl Is Line Then
                    If .x1 < 0 Then .x2 = .x2 - .x1: .x1 = 0
                    If .x2 < 0 Then .x1 = .x1 - .x2: .x1 = 0
                    If .y1 < 0 Then .y2 = .y2 - .y1: .y1 = 0
                    If .y2 < 0 Then .y1 = .y1 - .y2: .y2 = 0
                Else
                    If .Top < 0 Then .Top = 0
                    If .Left < 0 Then .Left = 0
                End If
                tmpobj.MoveHd
            End If
        End With
    Next
    GetLimit mintop, maxbottom, 0, , True
    GetLimit minleft, maxright, 0
    With g_ActFrm.PicPage
        If .Width < maxright Then .Width = maxright
        If .Height < maxbottom Then .Height = maxbottom
    End With
End Sub

Public Sub LinkCtl(tmpID As Integer, tmpType As ObjType, tmpctl As Object, Optional Flag As Integer = -1)
Dim tmpobj As New ObjDraw
    With tmpobj
        .nID = tmpID
        .eType = tmpType
        .EditFlag = Flag
        Set .ObjCtl = tmpctl
    End With
    Call Add(tmpobj, "Obj" & tmpID)
    tmpobj.LoadHd
    tmpobj.MoveHd
End Sub

'GetLimit
Private Sub GetLimit(Top As Single, Bottom As Single, Optional SumHeight As Double = 0, Optional blnAct As Boolean = False, Optional blnV As Boolean = False)
Dim tmpobj As ObjDraw, bIsLine As Boolean, CurTop As Single, CurHeight As Single
Dim i As Long
    bIsLine = (mCol(1).eType = mObjLine)
    With mCol(1).ObjCtl
        If blnV Then
            If bIsLine Then Top = IIf(.y1 >= .y2, .y2, .y1) Else Top = .Top
            If bIsLine Then Bottom = IIf(.y1 >= .y2, .y1, .y2) Else Bottom = .Top + .Height
        Else
            If bIsLine Then Top = IIf(.x1 >= .x2, .x2, .x1) Else Top = .Left
            If bIsLine Then Bottom = IIf(.x1 > .x2, .x1, .x2) Else Bottom = .Left + .Width
        End If
    End With
    For Each tmpobj In mCol
        If i > mvarnActCount Then Exit For
        If tmpobj.IsActive Or Not blnAct Then
          bIsLine = (tmpobj.eType = mObjLine)
          With tmpobj.ObjCtl
                If blnV Then
                    If bIsLine Then CurTop = IIf(.y1 >= .y2, .y2, .y1) Else CurTop = .Top
                    If CurTop < Top Then Top = CurTop
                    If bIsLine Then CurHeight = IIf(.y1 >= .y2, .y1, .y2) Else CurHeight = .Top + .Height
                    If CurHeight > Bottom Then Bottom = CurHeight
                    If bIsLine Then SumHeight = SumHeight + Abs(.y1 - .y2) Else SumHeight = SumHeight + .Height
                Else
                    If bIsLine Then CurTop = IIf(.x1 >= .x2, .x2, .x1) Else CurTop = .Top
                    If CurTop < Top Then Top = CurTop
                    If bIsLine Then CurHeight = IIf(.x1 >= .x2, .x1, .x2) Else CurHeight = .Left + .Width
                    If CurHeight > Bottom Then Bottom = CurHeight
                    If bIsLine Then SumHeight = SumHeight + Abs(.x1 - .x2) Else SumHeight = SumHeight + .Width
                End If
            End With
        End If
        i = i + 1
    Next
End Sub

'MakeSameSize
Public Sub MakeSameSize(Optional SizePram As SameSizeCur = SameSizeNone)
Dim tmpobj As ObjDraw
Dim tmpw As Single, tmph As Single, tmpx As Single, tmpy As Single
Dim i As Long
Dim blnx As Boolean, blny As Boolean, bIsLine As Boolean
    If SizePram = SameSizeNone Then Exit Sub
    If mvarnActCount > 1 Then
        With mCol("Obj" & mvarnCurID).ObjCtl
            If mCol("Obj" & mvarnCurID).eType = mObjLine Then
                tmpw = Abs(.x1 - .x2)
                tmph = Abs(.y1 - .y2)
            Else
                tmpw = .Width
                tmph = .Height
            End If
        End With
        i = 1
        For Each tmpobj In ObjActs
            If i > mvarnActCount Then Exit For
            If tmpobj.nID <> mvarnCurID And tmpobj.ObjCtl.Visible Then
                bIsLine = (tmpobj.eType = mObjLine)
                With tmpobj.ObjCtl
                    If bIsLine Then
                        blnx = (.x1 > .x2)
                        tmpx = IIf(blnx, .x2, .x1)
                        blny = (.y1 > .y2)
                        tmpy = IIf(blny, .y2, .y1)
                    End If
                    If (SizePram And SameSizeWidth) = SameSizeWidth Then
                        If bIsLine Then
                            If blnx Then
                                .x1 = .x2 + tmpw
                            Else
                                .x2 = .x1 + tmpw
                            End If
                        Else
                            .Width = tmpw
                        End If
                    End If
                    If (SizePram And SameSizeHeight) = SameSizeHeight Then
                        If bIsLine Then
                            If blnx Then
                                .y1 = .y2 + tmph
                            Else
                                .y2 = .y1 + tmph
                            End If
                        Else
                            .Height = tmph
                        End If
                    End If
                End With
                tmpobj.MoveHd
                i = i + 1
            End If
        Next
        Call AdjustPage
    End If
    Set tmpobj = Nothing
End Sub

'AlginToCur
Public Sub AlginToCur(Optional AlignParm As AlignCur = AlignNone)
Dim tmpleft As Single, tmpright As Single, tmptop As Single, tmpbottom As Single, tmpvcenter As Single, tmphcenter As Single
Dim tmpobj As ObjDraw, tmpw As Single, tmph As Single
Dim blnx As Boolean, blny As Boolean, bIsLine As Boolean
Dim i As Integer
    If AlignParm = AlignNone Then Exit Sub
    If mvarnActCount > 1 Then
        With mCol("Obj" & mvarnCurID).ObjCtl
            If mCol("Obj" & mvarnCurID).eType = mObjLine Then
                blnx = (.x1 > .x2)
                blny = (.y1 > .y2)
                tmpleft = IIf(blnx, .x2, .x1)
                tmphcenter = tmpleft + Abs(.x1 - .x2) / 2
                tmpright = IIf(blnx, .x1, .x2)
                tmptop = IIf(blny, .y2, .y1)
                tmpvcenter = tmptop + Abs(.y1 - .y2) / 2
                tmpbottom = IIf(blny, .y1, .y2)
            Else
                tmpleft = .Left
                tmphcenter = .Left + .Width / 2
                tmpright = .Width + .Left
                tmptop = .Top
                tmpvcenter = .Top + .Height / 2
                tmpbottom = .Height + .Top
            End If
        End With
        i = 1
        For Each tmpobj In ObjActs
            If i > mvarnActCount Then Exit For
            If tmpobj.nID <> mvarnCurID And tmpobj.ObjCtl.Visible Then
                bIsLine = (tmpobj.eType = mObjLine)
                With tmpobj.ObjCtl
                    If bIsLine Then
                        blnx = (.x1 > .x2)
                        blny = (.y1 > .y2)
                        tmpw = Abs(.x1 - .x2)
                        tmph = Abs(.y1 - .y2)
                        Select Case AlignParm
                            Case AlignLeft:
                                If blnx Then
                                    .x1 = .x1 + (tmpleft - .x2): .x2 = tmpleft
                                Else
                                    .x2 = .x2 + (tmpleft - .x1): .x1 = tmpleft
                                End If
                            Case AlignHCenter:
                                If blnx Then
                                    .x1 = .x1 + (tmphcenter - tmpw / 2 - .x2)
                                    .x2 = tmphcenter - tmpw / 2
                                Else
                                    .x2 = .x2 + (tmphcenter - tmpw / 2 - .x1)
                                    .x1 = tmphcenter - tmpw / 2
                                End If
                            Case AlignRight: