frmtext.frm

超经典的打印预览动态库源码 版权： 本资源版权归作者所有 说明： 本资源由源码天空搜集,仅提供学习参考

            Caption         =   "设置"
            Key             =   "set"
            ImageVarType    =   2
         EndProperty
         BeginProperty Tab3 {1EFB659A-857C-11D1-B16A-00C0F0283628} 
            Caption         =   "大小"
            Key             =   "size"
            ImageVarType    =   2
         EndProperty
         BeginProperty Tab4 {1EFB659A-857C-11D1-B16A-00C0F0283628} 
            Caption         =   "字体"
            Key             =   "font"
            ImageVarType    =   2
         EndProperty
      EndProperty
   End
End
Attribute VB_Name = "frmText"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit

Public cText                As clsText

Public bSelect              As Boolean      '*是否确定还是取消

Public bEditStringX         As Boolean      '*是否修改字符串

Public bEditWidth           As Boolean      '*是否修改宽度

Public bEditHeight          As Boolean      '*是否修改高度

Public bEditRowHeight       As Boolean      '*是否修改行高度


Private mText               As clsText      '*暂时存放设置



Private Sub chkAutoTrim_Click()
    mText.autotrim = chkAutoTrim.Value
    Preview
End Sub

Private Sub chkAutoWrap_Click()
    mText.autowrap = chkAutoWrap.Value
    Preview
End Sub

Private Sub chkShowZero_Click()
    mText.showzero = chkShowZero.Value
    Preview
End Sub

Private Sub chkUseSpe_Click()
    mText.usesperator = chkUseSpe.Value
    Preview
End Sub

Private Sub cmbAlign_Click()
    mText.Align = cmbAlign.ListIndex
    Preview
End Sub

Private Sub cmbField_Click()
'*改变TEXT类型
    chkAutoWrap.Enabled = False
    chkAutoTrim.Enabled = False
    chkUseSpe.Enabled = False
    chkShowZero.Enabled = False
    udDecNum.Enabled = False
    
    Select Case cmbField.ListIndex
        Case tyText
            chkAutoWrap.Enabled = True
            chkAutoTrim.Enabled = True
        Case tyNumeric
            chkUseSpe.Enabled = True
            chkShowZero.Enabled = True
            udDecNum.Enabled = True
        Case tyDateTime
            chkAutoWrap.Enabled = True
    End Select
    
    mText.fieldtype = cmbField.ListIndex
    Preview
End Sub

Private Sub cmdCancel_Click()
    bSelect = False
    Unload Me
End Sub

Private Sub cmdConfirm_Click()
'*确定，保存结果
Dim mstr        As String
Dim mWidth      As Single
Dim mHeight     As Single
Dim mRowHeight  As Single

    mstr = txtString.text
    mWidth = txtWidth.text * UNIT
    mHeight = txtHeight.text * UNIT
    mRowHeight = txtRowHeight.text * UNIT
    mText.Clone cText
    
    With cText
        .stringX = mstr
        .width = mWidth
        .height = mHeight
        .rowheight = mRowHeight
    End With
    
    bSelect = True
    
    Unload Me
End Sub

Private Sub cmdFont_Click()
'*显示字体对话框

    On Error GoTo exit_entry
    With cFont
        .CancelError = False
        .Flags = &H3 Or &H100

        CopyFontColor mText, cFont
        .ShowFont

        CopyFontColor cFont, mText
        CopyFontColor cFont, picPreview

    End With
    Preview
exit_entry:

End Sub

Private Sub Form_Load()

    '*初始化
    Init
    
    fraText.ZOrder 0
    
    '*对控件进行赋值
    Assign
    
    '*进行预览
    Preview
    
End Sub


'**************************************************************
'*名称：Init
'*功能：初始化
'*传入参数：
'*
'*作者：chlf78
'*日期：2002-04-15 16:32:12
'***************************************************************
Private Sub Init()
    
    Set mText = New clsText
    
    cText.Clone mText
    With mText
        .width = picPreview.width - 100
        .height = picPreview.height
        .rowheight = .height / 2
        .left = 0
        .Top = 0
    End With
    
    With cmbField
        .AddItem "文本"
        .AddItem "数字"
        .AddItem "日期"
    End With
  
    If cText.orient = Landscape Then
        With cmbAlign
            .AddItem "左对齐"
            .AddItem "居中对齐"
            .AddItem "右对齐"
        End With
    Else
        With cmbAlign
            .AddItem "顶对齐"
            .AddItem "居中对齐"
            .AddItem "底对齐"
        End With
    End If
End Sub


'**************************************************************
'*名称：Assign
'*功能：对控件进行赋值
'*传入参数：
'*
'*作者：chlf78
'*日期：2002-04-15 16:12:47
'***************************************************************
Private Sub Assign()
    With mText
        txtString.text = cText.stringX
        cmbField.text = cmbField.List(.fieldtype)
        cmbAlign.text = cmbAlign.List(.Align)
        chkAutoWrap.Value = .autowrap
        chkAutoTrim.Value = .autotrim
        chkUseSpe.Value = .usesperator
        chkShowZero.Value = .showzero
        txtDecNum.text = .decimalnumber + 1
        udDecNum.Value = .decimalnumber + 1
        txtWidth.text = cText.width / UNIT
        txtHeight.text = cText.height / UNIT
        txtRowHeight.text = cText.rowheight / UNIT
        CopyFontColor mText, picPreview
        
        '*设置一些可选的编辑项
        txtString.Visible = bEditStringX
        txtWidth.Enabled = bEditWidth
        txtHeight.Enabled = bEditHeight
        txtRowHeight.Enabled = bEditRowHeight
        
        '*初始化要输入数值的文本框
        InitText txtWidth, 1
        InitText txtHeight, 1
        InitText txtRowHeight, 1
    End With
End Sub




'**************************************************************
'*名称：Preview
'*功能：预览
'*传入参数：
'*
'*作者：chlf78
'*日期：2002-04-15 16:48:28
'***************************************************************
Private Sub Preview()
    picPreview.Cls
    With mText
    
        Select Case .fieldtype
            Case tyText
                .stringX = "ABCDEFGabcdefg文本测试"
            Case tyNumeric
                .stringX = "1023.456789"
            Case tyDateTime
                .stringX = "2002/06/01"
        End Select
        
        .PrintIt picPreview, 1
    End With
End Sub


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

Private Sub TabStrip1_Click()

End Sub

Private Sub tbBK_Click()
    Select Case tbBK.SelectedItem.key
        Case "text"
            fraText.ZOrder 0
        Case "set"
            fraSet.ZOrder 0
        Case "size"
            fraSize.ZOrder 0
        Case "font"
            fraFont.ZOrder 0
    End Select
End Sub

Private Sub txtHeight_GotFocus()
    SelAllTxt txtHeight
End Sub

Private Sub txtHeight_Validate(Cancel As Boolean)
    fmtTxtData txtHeight, 1, 2000, 2
End Sub

Private Sub txtRowHeight_GotFocus()
    SelAllTxt txtRowHeight
End Sub

Private Sub txtRowHeight_Validate(Cancel As Boolean)
    fmtTxtData txtRowHeight, 1, 2000, 2
End Sub

Private Sub txtWidth_GotFocus()
    SelAllTxt txtWidth
End Sub

Private Sub txtWidth_Validate(Cancel As Boolean)
    fmtTxtData txtWidth, 1, 2000, 2
End Sub

Private Sub udDecNum_Change()
    txtDecNum.text = udDecNum.Value - 1
    mText.decimalnumber = udDecNum.Value - 1
    Preview
End Sub

Private Sub CopyFontColor(Source As Object, Destination As Object)
'*拷贝字体和颜色
    On Error Resume Next
    With Destination
        .FontName = Source.FontName
        .fontsize = Source.fontsize
        .FontBold = Source.FontBold
        .FontItalic = Source.FontItalic
        .FontStrikeThru = Source.FontStrikeThru
        .FontUnderLine = Source.FontUnderLine
        .Color = Source.ForeColor
        .ForeColor = Source.Color
        .Color = Source.Color
        .ForeColor = Source.ForeColor
    End With
    
End Sub