frmset.frm

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

    End If
End Sub

Private Sub cmdContentPre_Click()
    If cpContent > 1 Then
        cpContent = cpContent - 1
        ShowContent
    End If
End Sub

Private Sub cmdCollectionAdd_Click()
'*增加
    Select Case cmbCollection.ListIndex
        Case 0      '*表头
            AddText rpt.Header
            LoadCollection rpt.Header, Landscape
        Case 1      '*表尾
            AddText rpt.Footer
            LoadCollection rpt.Footer, Landscape
        Case 2      '*页头
            AddText rpt.Title
            LoadCollection rpt.Title, Landscape
        Case 3      '*页尾
            AddText rpt.Tail
            LoadCollection rpt.Tail, Landscape
        Case 4      '*页左
            AddText rpt.LeftSection
            LoadCollection rpt.LeftSection, Portrait
        Case 5      '*页右
            AddText rpt.RightSection
            LoadCollection rpt.RightSection, Portrait
    End Select
    
End Sub

Private Sub cmdCollectionDelete_Click()
'*删除
    Select Case cmbCollection.ListIndex
        Case 0      '*表头
            DelText rpt.Header
            LoadCollection rpt.Header, Landscape
        Case 1      '*表尾
            DelText rpt.Footer
            LoadCollection rpt.Footer, Landscape
        Case 2      '*页头
            DelText rpt.Title
            LoadCollection rpt.Title, Landscape
        Case 3      '*页尾
            DelText rpt.Tail
            LoadCollection rpt.Tail, Landscape
        Case 4      '*页左
            DelText rpt.LeftSection
            LoadCollection rpt.LeftSection, Portrait
        Case 5      '*页右
            DelText rpt.RightSection
            LoadCollection rpt.RightSection, Portrait
    End Select
    
End Sub

Private Sub cmdTemLoad_Click()
'*装载模板文件

    With dlg
        .CancelError = True
        .DialogTitle = "装载模板文件"
        .Flags = &H1000 + &H4 + &H8
        .DefaultExt = "txt"
        .Filter = "模板文件(*.txt)|*.txt"
        On Error GoTo cancel_exit
        .ShowOpen
        On Error GoTo 0
        On Error GoTo err_proc
        If rpt.ReadTemplate(.FileName) Then
            MsgBox "装载模板文件成功！", vbInformation, Caption
            rpt.TemplateFile = .FileName
            '*装载页面信息
            LoadPageInfo
        End If
    End With
    
cancel_exit:

    Exit Sub
    
err_proc:
    MsgBox "装载模板文件失败!", vbExclamation, Caption
    LoadTemplate
    
End Sub


Private Sub cmdTemSaveAs_Click()
'*另存模板文件
    With dlg
        .CancelError = True
        .DefaultExt = "txt"
        .Filter = "模板文件(*.txt)|*.txt"
        .DialogTitle = "保存模板文件"
        .Flags = &H2 + &H8
        On Error GoTo cancel_exit
        .ShowSave
        On Error GoTo 0
        On Error GoTo err_proc
        If rpt.SaveTemplate(.FileName) Then
            MsgBox "保存模板文件成功！", vbInformation, Caption
            rpt.TemplateFile = .FileName
        End If
    End With
    
cancel_exit:
    Exit Sub
    
err_proc:
    MsgBox "只在模板文件失败!", vbExclamation, Caption
    LoadTemplate
    
End Sub



Private Sub Form_Load()
    '*窗体居中
    CenterForm Me
    
    '*初始化列头和正文预览的显示当前页
    cpColHeader = 1
    cpContent = 1
    
    fraPage.ZOrder 0
    
    '*判断页面设置是否更改以便于重新分页
    preTab = "page"
    bDirty = False
    
    '*初始化
    Init
    
    '*装载页面信息
    LoadPageInfo
    
    '*平滑列头
    FlatLv lvCollection.hWnd
    FlatLv lvContent.hWnd
    FlatLv lvTip.hWnd
    
    '*是否确定了设置
    bConfirm = False
    
    '*保存当前设置，以备于取消设置时进行恢复
    SaveCurSet
End Sub


Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    If Not bConfirm Then
        '*恢复设置
        Me.Enabled = False
        prg.Visible = True
        
        rpt.ReadTemplate bakFile
        
        prg.Visible = False
        Me.Enabled = True
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set rpt = Nothing
    '*删除临时文件
    On Error Resume Next
    Close #fn
    Kill bakFile
End Sub

Private Sub HColheader_Change()
    picColHeader.Cls
    rpt.ColHeader.PrintIt picColHeader, cpColHeader, -CLng(HColheader.Value) * 10, 0, 1
End Sub

Private Sub HContent_Change()
    picContent.Cls
    rpt.ColHeader.PrintIt picContent, cpContent, -CLng(HContent.Value) * 10, 0, 1
    rpt.Content.PrintIt picContent, 1, cpContent, -CLng(HContent.Value) * 10, rpt.ColHeader.GetHeight, 1
End Sub




Private Sub lvCollection_DblClick()
'*双击进行修改
    Select Case cmbCollection.ListIndex
        Case 0      '*表头
            EditText rpt.Header
            LoadCollection rpt.Header, Landscape
        Case 1      '*表尾
            EditText rpt.Footer
            LoadCollection rpt.Footer, Landscape
        Case 2      '*页头
            EditText rpt.Title
            LoadCollection rpt.Title, Landscape
        Case 3      '*页尾
            EditText rpt.Tail
            LoadCollection rpt.Tail, Landscape
        Case 4      '*页左
            EditText rpt.LeftSection
            LoadCollection rpt.LeftSection, Portrait
        Case 5      '*页右
            EditText rpt.RightSection
            LoadCollection rpt.RightSection, Portrait
    End Select
End Sub

Private Sub lvContent_DblClick()
    If lvContent.SelectedItem Is Nothing Then
        Exit Sub
    End If
    
    Call cmdContent_Click
End Sub

Private Sub lvContent_ItemClick(ByVal item As MSComctlLib.ListItem)
'*针对选中的列，决定按钮状态
    bCode = True
    chkMerge.Value = rpt.Content.GetMergeCol(item.Index)
    bCode = False
End Sub


Private Sub rpt_InitProgress(Value As Integer)

    prg.Value = Value

End Sub

Private Sub tabBK_Click()

    If preTab = "page" And bDirty Then
        SavePageInfo
        bDirty = False
    End If
    
    Select Case tabBK.SelectedItem.key
        Case "page"             '*页面信息
            fraPage.ZOrder 0
        Case "collection"       '*标签集合
            fraCollection.ZOrder 0
        Case "colheader"        '*列头
            ShowColheader
            fraColHeader.ZOrder 0
        Case "content"          '*正文
            LoadContent
            ShowContent
            fraContent.ZOrder 0
        Case "template"         '*模板
            LoadTemplate
            fraTemplate.ZOrder 0
    End Select
    
    preTab = tabBK.SelectedItem.key
    
End Sub


'**************************************************************
'*名称：Init
'*功能：初始化
'*传入参数：
'*
'*作者：chlf78
'*日期：2002-04-15 21:37:46
'***************************************************************
Private Sub Init()
    cmbOrient.AddItem "纵向"
    cmbOrient.AddItem "横向"
    
    With cmbPageAlign
        .AddItem "左对齐"
        .AddItem "居中对齐"
        .AddItem "右对齐"
    End With

    With lvCollection.ColumnHeaders
        .Add , , "文本", 1950
        .Add , , "对齐", 600
        .Add , , "字体", 1000
    End With
        
    With cmbCollectionAlign
        .AddItem "表体对齐"
        .AddItem "页面对齐"
    End With
    
    With cmbCollection
        .AddItem "表头"
        .AddItem "表尾"
        .AddItem "页头"
        .AddItem "页尾"
        .AddItem "页左"
        .AddItem "页右"
    End With

    cmbCollection.text = "表头"
    
    With lvContent.ColumnHeaders
        .Add , , "文本", 2620
        .Add , , "对齐", 600
        .Add , , "合并", 600
    End With
    
    With lvTip.ColumnHeaders
        .Add , , "特殊字符"
        .Add , , "说明", 3400
    End With
    Dim itmX        As MSComctlLib.ListItem
    With lvTip.ListItems
        Set itmX = .Add(, , "|")
        itmX.SubItems(1) = "一行文本中识别左中右的分隔符"
        Set itmX = .Add(, , "||")
        itmX.SubItems(1) = "输出字符'|'"
        Set itmX = .Add(, , "&D或&d")
        itmX.SubItems(1) = "当前日期"
        Set itmX = .Add(, , "&T或&t")
        itmX.SubItems(1) = "当前时间"
        Set itmX = .Add(, , "&P或&p")
        itmX.SubItems(1) = "当前页"
        Set itmX = .Add(, , "&C或&c")
        itmX.SubItems(1) = "当前分页"
        Set itmX = .Add(, , "&S或&s")
        itmX.SubItems(1) = "总页数"
        Set itmX = .Add(, , "&A或&a")
        itmX.SubItems(1) = "总分页数"
        Set itmX = .Add(, , "&&")
        itmX.SubItems(1) = "输出字符'&'"
    End With
'    labInfo.Caption = "双击列表可以对标签进行编辑" & vbCrLf & vbCrLf _
'                    & "特殊字符(不区分大小写)" & vbCrLf & vbCrLf _
'                    & "     &&D    当前日期    &&T    当前时间" & vbCrLf _
'                    & "     &&P    当前页      &&C    当前分页" & vbCrLf _
'                    & "     &&S    总页数      &&A    总分页数"
End Sub


'**************************************************************
'*名称：ShowColheader
'*功能：显示列头
'*传入参数：
'*
'*作者：chlf78
'*日期：2002-04-19 11:06:51
'***************************************************************
Private Sub ShowColheader()
    
    On Error Resume Next
    
    picColHeader.Cls
    rpt.ColHeader.PrintIt picColHeader, cpColHeader, 0, 0, 1
    
    '*滚动条
    '*横向的处理
Dim aWidth      As Single
Dim uWidth      As Single
    
    
    '*页的宽度
    aWidth = rpt.ColHeader.GetWidth(cpColHeader)
    uWidth = picColHeader.width
    
    '*300作为一个大的change，而一个小的change为10
    If aWidth <= uWidth Then
        HColheader.Max = 0
    Else
        If CLng((aWidth - uWidth) / 10) <> (aWidth - uWidth) / 10 Then
            HColheader.Max = CLng((aWidth - uWidth) / 10 + 0.499999999)
        Else
            HColheader.Max = (aWidth - uWidth) / 10
        End If
    End If
    
    HColheader.SmallChange = 10
    HColheader.LargeChange = 300
    HColheader.Value = 0
End Sub


'**************************************************************
'*名称：ShowContent
'*功能：显示正文预览
'*传入参数：
'*