mfrm_prop.frm

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

      End
      Begin VB.Label Label2 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "宽度(&W):"
         Height          =   180
         Left            =   2550
         TabIndex        =   2
         Top             =   660
         Width           =   720
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "高度(&H):"
         Height          =   180
         Left            =   540
         TabIndex        =   0
         Top             =   660
         Width           =   720
      End
   End
   Begin MSComctlLib.TabStrip Tab1 
      Height          =   3615
      Left            =   60
      TabIndex        =   8
      Top             =   30
      Width           =   5235
      _ExtentX        =   9234
      _ExtentY        =   6376
      TabWidthStyle   =   2
      TabMinWidth     =   1764
      _Version        =   393216
      BeginProperty Tabs {1EFB6598-857C-11D1-B16A-00C0F0283628} 
         NumTabs         =   3
         BeginProperty Tab1 {1EFB659A-857C-11D1-B16A-00C0F0283628} 
            Caption         =   "大小/位置"
            Key             =   "size/post"
            ImageVarType    =   2
         EndProperty
         BeginProperty Tab2 {1EFB659A-857C-11D1-B16A-00C0F0283628} 
            Caption         =   "样式/颜色"
            Key             =   "style/color"
            ImageVarType    =   2
         EndProperty
         BeginProperty Tab3 {1EFB659A-857C-11D1-B16A-00C0F0283628} 
            Caption         =   "文字/效果"
            Key             =   "text"
            ImageVarType    =   2
         EndProperty
      EndProperty
   End
   Begin VB.Label LabTmp 
      Caption         =   "LabTmp"
      Height          =   465
      Left            =   5490
      TabIndex        =   41
      Top             =   1680
      Visible         =   0   'False
      Width           =   585
   End
End
Attribute VB_Name = "mFrm_Prop"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Const mc_ShowMode = vbMillimeters

Dim meType As ObjType
Dim mCurID As Integer, mOldSale As Integer

Private Sub ChkAutoSize_Click()
    If ChkAutoSize.Value = 1 Then ChkClip.Value = 0
End Sub

Private Sub ChkClip_Click()
    If ChkClip.Value = 1 And meType = mObjText Then ChkAutoSize.Value = 0
End Sub

Private Sub ChkScroll_Click()
    ChkSumAll.Enabled = (ChkScroll.Value = 0)
    ChkSumPage.Enabled = ChkSumAll.Enabled
    If Not ChkSumAll.Enabled Then ChkSumAll.Value = 0
    If Not ChkSumPage.Enabled Then ChkSumPage.Value = 0
End Sub

Private Sub ChkSumAll_Click()
    If ChkSumAll.Value = 1 Then ChkSumPage.Value = 0
End Sub

Private Sub ChkSumPage_Click()
    If ChkSumPage.Value = 1 Then ChkSumAll.Value = 0
End Sub

Private Sub CmbKey_Click()
    ChkScroll.Enabled = (CmbKey.ListIndex <> 0)
    ChkSumAll.Enabled = ChkScroll.Enabled
    ChkSumPage.Enabled = ChkScroll.Enabled
    TxtCaption.Enabled = Not ChkScroll.Enabled
    CmbFormat.Enabled = ChkScroll.Enabled
    LabFormat.Enabled = CmbFormat.Enabled
    If CmbFormat.Enabled Then
    End If
End Sub

Private Sub CmdCancel_Click()
   Unload Me
End Sub

Private Sub CmdFont_Click()
On Error GoTo Er
    With Cdlg
        .CancelError = True
        .FontBold = LabTmp.FontBold
        .FontItalic = LabTmp.FontItalic
        .FontUnderline = LabTmp.FontUnderline
        .FontName = LabTmp.FontName
        .FontSize = LabTmp.FontSize
        .Color = LabColor.BackColor
        
        Cdlg.Flags = cdlCFBoth + cdlCFForceFontExist + cdlCFEffects
        Cdlg.ShowFont
        
        LabTmp.FontName = .FontName
        LabTmp.FontSize = .FontSize
        LabTmp.FontBold = .FontBold
        LabTmp.FontItalic = .FontItalic
        LabTmp.FontUnderline = .FontUnderline
        LabColor.BackColor = .Color
        
        CmdFont.ToolTipText = Cdlg.FontName & " " & Cdlg.FontSize
        
    End With
    Exit Sub
Er:
    If Err.Number = 32755 Then Exit Sub
End Sub

Private Sub CmdOK_Click()
   Call SavedProp
   Call CmdCancel_Click
End Sub

Private Sub SavedProp()
    With g_ActFrm.mObjs("Obj" & mCurID).ObjCtl
        If meType = mObjLine Then
            Debug.Print .x1, .y1, .x2, .y2
            .x1 = g_ActFrm.ScaleX(TxtLeft.Text, mc_ShowMode, mOldSale)
            .y1 = g_ActFrm.ScaleY(TxtTop.Text, mc_ShowMode, mOldSale)
            .x2 = g_ActFrm.ScaleX(Val(TxtLeft.Text) + Val(TxtWidth.Text), mc_ShowMode, mOldSale)
            .y2 = g_ActFrm.ScaleY(Val(TxtTop.Text) + Val(TxtHeight.Text), mc_ShowMode, mOldSale)
            .BorderColor = LabColor.BackColor
            .BorderWidth = TxtLineWidth.Text
            .BorderStyle = CmbLineStyle.ItemData(CmbLineStyle.ListIndex)
        ElseIf meType = mObjImg Then
            .Left = g_ActFrm.ScaleX(TxtLeft.Text, mc_ShowMode, mOldSale)
            .Top = g_ActFrm.ScaleY(TxtTop.Text, mc_ShowMode, mOldSale)
            .Width = g_ActFrm.ScaleX(TxtWidth.Text, mc_ShowMode, mOldSale)
            .Height = g_ActFrm.ScaleY(TxtHeight.Text, mc_ShowMode, mOldSale)
            .Stretch = (ChkAutoSize.Value = 1)
            .BorderStyle = IIf((CmbLineStyle.ListIndex = 0), 0, 1)
            g_ActFrm.mObjs("Obj" & mCurID).BStyle = CmbLineStyle.ItemData(CmbLineStyle.ListIndex)
            g_ActFrm.mObjs("Obj" & mCurID).BWidth = TxtLineWidth.Text
            g_ActFrm.mObjs("Obj" & mCurID).FColor = LabColor.BackColor
        ElseIf meType = mObjText Then
            .Left = g_ActFrm.ScaleX(TxtLeft.Text, mc_ShowMode, mOldSale)
            .Top = g_ActFrm.ScaleY(TxtTop.Text, mc_ShowMode, mOldSale)
            .Width = g_ActFrm.ScaleX(TxtWidth.Text, mc_ShowMode, mOldSale)
            .Height = g_ActFrm.ScaleY(TxtHeight.Text, mc_ShowMode, mOldSale)
            .ForeColor = LabColor.BackColor
             .Alignment = CmbAlign.ItemData(CmbAlign.ListIndex)
            If CmbKey.ListIndex = 0 Then
                .Caption = TxtCaption.Text
                .Tag = .Caption
            Else
                .Caption = CmbKey.List(CmbKey.ListIndex)
                .Tag = CmbSave.List(CmbKey.ListIndex)
            End If
            .FontName = LabTmp.FontName
            .FontSize = LabTmp.FontSize
            .FontBold = LabTmp.FontBold
            .FontItalic = LabTmp.FontItalic
            .FontUnderline = LabTmp.FontUnderline
            .AutoSize = ChkAutoSize.Value
            With g_ActFrm.mObjs("Obj" & mCurID)
                .IsFix = (CmbKey.ListIndex = 0)
                If ChkAutoSize.Value = 0 Then .Clip = ChkClip.Value
                If CmbKey.ListIndex <> 0 Then
                    .DataType = CmbSave.ItemData(CmbKey.ListIndex)
                    .IsScroll = ChkScroll.Value
                    .SumedPage = ChkSumPage.Value
                    .Sumed = ChkSumPage.Value Or ChkSumAll.Value
                    If .Sumed Then
                        .ObjCtl.Caption = IIf(.SumedPage, "[小计]", "[总计]") & .ObjCtl.Caption
                    ElseIf .IsScroll Then
                        .ObjCtl.Caption = "^" & .ObjCtl.Caption
                    Else
                        .ObjCtl.Caption = "#" & .ObjCtl.Caption
                    End If
                    .Format = CmbFormat.Text
                    .ObjCtl.ToolTipText = CmbFormat.Text
                End If
            End With
       End If
    End With
    With g_ActFrm.mObjs("Obj" & mCurID)
        If .EditFlag = -1 Then .EditFlag = 1
        .Locked = (ChkLock.Value = 1)
        .Printed = (ChkPrint.Value = 0)
        .MoveHd
    End With

End Sub

Private Sub Form_Load()
    mOldSale = g_ActFrm.ScaleMode
    Call LoadField
End Sub

Private Sub LoadField()
    CmbKey.AddItem "（固定文本）"
    With CmbKey
        .AddItem "[页号]"
        .AddItem "[总页号]"
        .AddItem "[当前日期]"
        .AddItem "[当前时间]"
    End With
    With CmbSave
        .AddItem "#P"
        .ItemData(.ListCount - 1) = 2
        .AddItem "#N"
        .ItemData(.ListCount - 1) = 2
        .AddItem "#D"
        .ItemData(.ListCount - 1) = 1
        .AddItem "#T"
        .ItemData(.ListCount - 1) = 1
    End With
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set mFrm_Prop = Nothing
End Sub

Private Sub LabColor_DblClick()
On Error GoTo Er
    With Cdlg
        .CancelError = True
        .Color = LabColor.BackColor
        .ShowColor
        LabColor.BackColor = .Color
    End With
    Exit Sub
Er:
    If Err.Number = 32755 Then Exit Sub
End Sub

Private Sub Tab1_Click()
Dim i As Integer
    If Tab1.SelectedItem.Index = 3 And meType <> mObjText Then: Exit Sub
    For i = 0 To Pic.UBound
        Pic(i).Visible = False
        Pic(i).BorderStyle = 0
    Next
    With Tab1.SelectedItem
        Pic(.Index - 1).Top = 450
        Pic(.Index - 1).Left = 180
        Pic(.Index - 1).Visible = True
    End With
End Sub

Public Sub Init()
    mCurID = g_ActFrm.mObjs.nCurID
    With g_ActFrm.mObjs("Obj" & mCurID)
        meType = .eType
        ChkLock.Value = IIf(.Locked, 1, 0)
        ChkPrint.Value = IIf(.Printed, 0, 1)
    End With
    With g_ActFrm.mObjs("Obj" & mCurID).ObjCtl
        'Left,Right,Height,Width
        If meType = mObjLine Then
            TxtWidth.Text = Format(g_ActFrm.ScaleX(Abs(.x1 - .x2), mOldSale, mc_ShowMode), "0.0#")
            TxtHeight.Text = Format(g_ActFrm.ScaleY(Abs(.y1 - .y2), mOldSale, mc_ShowMode), "0.0#")
            TxtLeft.Text = Format(g_ActFrm.ScaleX(IIf(.x1 > .x2, .x2, .x1), mOldSale, mc_ShowMode), "0.0#")
            TxtTop.Text = Format(g_ActFrm.ScaleY(IIf(.y1 > .y2, .y2, .y1), mOldSale, mc_ShowMode), "0.0#")
        Else
            TxtWidth.Text = Format(g_ActFrm.ScaleX(.Width, mOldSale, mc_ShowMode), "0.0#")
            TxtHeight.Text = Format(g_ActFrm.ScaleY(.Height, mOldSale, mc_ShowMode), "0.0#")
            TxtTop.Text = Format(g_ActFrm.ScaleY(.Top, mOldSale, mc_ShowMode), "0.0#")
            TxtLeft.Text = Format(g_ActFrm.ScaleX(.Left, mOldSale, mc_ShowMode), "0.0#")
        End If
        'Color,Style,
        If meType = mObjLine Then
            Label10.Enabled = True
            LabColor.BackColor = .BorderColor
            CmbLineStyle.ListIndex = ListFind(CmbLineStyle, .BorderStyle)
            TxtLineWidth.Text = .BorderWidth
            CmbLineStyle.Enabled = True
            ChkPrint.Value = IIf(g_ActFrm.mObjs("Obj" & mCurID).Printed, 0, 1)
            ChkAutoSize.Enabled = False
            ChkClip.Enabled = False
        ElseIf meType = mObjImg Then
            CmbLineStyle.AddItem "（无）", 0
            Label10.Enabled = True
            LabColor.Enabled = True
            LabColor.BackColor = g_ActFrm.mObjs("Obj" & mCurID).FColor
            CmbLineStyle.Enabled = True
            CmbLineStyle.ListIndex = ListFind(CmbLineStyle, g_ActFrm.mObjs("Obj" & mCurID).BStyle)
            TxtLineWidth.Text = g_ActFrm.mObjs("Obj" & mCurID).BWidth
            ChkClip.Enabled = False
            ChkAutoSize.Enabled = True
            ChkAutoSize.Value = IIf(.Stretch, 1, 0)
            ChkPrint.Value = IIf(g_ActFrm.mObjs("Obj" & mCurID).Printed, 0, 1)
            ChkClip.Value = .BorderStyle
        ElseIf meType = mObjText Then
            Label10.Enabled = True
            LabColor.BackColor = .ForeColor
            CmbLineStyle.Enabled = False
            ChkClip.Enabled = True
            ChkAutoSize.Enabled = True
            CmbAlign.ListIndex = ListFind(CmbAlign, .Alignment, True)
            CmdFont.ToolTipText = .FontName & " " & .FontSize
            LabTmp.FontName = .FontName
            LabTmp.FontSize = .FontSize
            LabTmp.FontBold = .FontBold
            LabTmp.FontItalic = .FontItalic
            LabTmp.FontUnderline = .FontUnderline
            ChkClip.Value = IIf(g_ActFrm.mObjs("Obj" & mCurID).Clip, 1, 0)
            ChkPrint.Value = IIf(g_ActFrm.mObjs("Obj" & mCurID).Printed, 0, 1)
            If g_ActFrm.mObjs("Obj" & mCurID).IsFix Then
                CmbKey.ListIndex = 0
                TxtCaption.Text = .Caption
                TxtCaption.Enabled = True
                CmbFormat.Enabled = False
            Else
                TxtCaption.Enabled = False
                CmbFormat.Enabled = True
                TxtCaption.Text = ""
                CmbKey.ListIndex = ListFind(CmbSave, .Tag)
                ChkAutoSize.Value = IIf(.AutoSize, 1, 0)
                With g_ActFrm.mObjs("Obj" & mCurID)
                    If ChkAutoSize.Value = 0 Then ChkClip.Value = IIf(.Clip, 1, 0)
                    If .IsScroll Then
                        ChkScroll.Value = 1
                    ElseIf .Sumed Then
                        ChkSumPage.Value = IIf(.SumedPage, 1, 0)
                        ChkSumAll.Value = IIf(ChkSumPage.Value = 0, 1, 0)
                    Else
                    End If
                End With
                CmbFormat.Text = g_ActFrm.mObjs("Obj" & mCurID).Format
            End If
        End If
        TxtLineWidth.Enabled = CmbLineStyle.Enabled
        VScrLineWidth.Enabled = TxtLineWidth.Enabled
    End With
    Call Tab1_Click
End Sub

Private Sub TxtLineWidth_Change()
    With TxtLineWidth
        .Text = Val(.Text)
        If .Text = 0 Then .Text = 1
        VScrLineWidth.Value = .Text
    End With
End Sub

Private Sub TxtLeft_GotFocus()
    With TxtTop
        .SelStart = 0
        .SelLength = Len(.Text)
    End With
End Sub

Private Sub TxtLeft_LostFocus()
    TxtLeft.Text = Val(TxtLeft.Text)
End Sub

Private Sub TxtHeight_GotFocus()
    With TxtHeight
        .SelStart = 0
        .SelLength = Len(.Text)
    End With
End Sub

Private Sub TxtHeight_LostFocus()
    TxtHeight.Text = Val(TxtHeight.Text)
End Sub

Private Sub TxtWidth_GotFocus()
    With TxtWidth
        .SelStart = 0
        .SelLength = Len(.Text)
    End With
End Sub

Private Sub TxtWidth_LostFocus()
    TxtWidth.Text = Val(TxtWidth.Text)
End Sub

Private Sub TxtTop_GotFocus()
    With TxtTop
        .SelStart = 0
        .SelLength = Len(.Text)
    End With
End Sub

Private Sub TxtTop_LostFocus()
    TxtTop.Text = Val(TxtTop.Text)
End Sub

Private Sub VScrLineWidth_Change()
    TxtLineWidth.Text = VScrLineWidth.Value
End Sub