frmdata.frm

这是本人用vb配合access数据库开发的一个部门人事管理的一个小软件的源码。

'点击了预览控件上的关闭，引发该事件，关闭预览窗体
Private Sub curtprinter1_ClosePreview()
    CurtPrinter1.Visible = False
    mnuManual.Enabled = False
End Sub
'如果每次调整预览比例好重新生成预览的话，请将AutoRedraw设置为FALSE，然后在下面的事件添入要重画的代码
Private Sub curtprinter1_NeedRedraw()
    PrintContent
End Sub
'写入打印叶脚的代码
Private Sub curtprinter1_PrintFooter(CurrentPage As Long)
    CurtPrinter1.FooterOut "tubPrinter打印/预览控件", "页脚测试", "其他信息"
End Sub
'写入打印页眉的代码
Private Sub curtprinter1_PrintHeader(CurrentPage As Long)
    CurtPrinter1.HeaderOut "tubPrinter打印/预览控件", "页眉测试", "第" & CurrentPage & "页"
End Sub
'点击了预览窗体或直接调用ShowPrinter后，点击了打印机窗口的确定，引发打印代码，打印到打印机上！
Private Sub curtprinter1_RealPrint()
    PrintContent Printer
End Sub
'如果隐藏工具条，仍可以通过简单的编程控制预览
Private Sub mnuPageDown_Click()
    CurtPrinter1.PageDown
End Sub
Private Sub mnuPageSetup_Click()
    CurtPrinter1.PageSetup
End Sub
Private Sub mnuPageUp_Click()
    CurtPrinter1.PageUp
End Sub
Private Sub mnuZoom_Click()
    CurtPrinter1.Zoom = Val(InputBox("请输入0-200之间的数字")) '0代表整页预览
End Sub

Private Sub mnuOrientation_Click()
    CurtPrinter1.Orientation = IIf(CurtPrinter1.Orientation = 1, 2, 1)
End Sub

Private Sub mnuPaperSize_Click()
    CurtPrinter1.PaperSize = InputBox("请输入打印纸型号：")
End Sub

'预览控件尺寸根据窗口调整
Private Sub Form_Resize()
    CurtPrinter1.Move 0, 0, ScaleWidth, ScaleHeight
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If CurtPrinter1.busy = True Then '打印预览控件忙则取消打印任务，然后就可以退出了
        CurtPrinter1.CancelPrint
        MsgBox "打印控件忙，稍后重试。", vbInformation
        Cancel = True
    End If
        
End Sub

'添加数据到控件，以测试打印预览
Private Sub Form_Load()
Dim I As Long, J As Long, K As Long
Dim mListItem As ListItem
    CurtPrinter1.Visible = False
    CurtPrinter1.Zoom = 100 '0代表整页预览
    With MSFlexGrid1
        .Rows = 34: .Cols = 9
        .Width = 1200 * 9 + 100
        For I = 0 To 33
            .Row = I
            For J = 0 To 8
                .Col = J
                .ColWidth(J) = 1200
                .ColAlignment(J) = J
                .Text = "Item " & I & " * " & J
            Next J
        Next I
    End With
    With MSHFlexGrid1
        .Rows = 34: .Cols = 9
        .Width = 1200 * 9 + 100
        For I = 0 To 33
            .Row = I
            For J = 0 To 8
                .Col = J
                .ColWidth(J) = 1200
                .ColAlignment(J) = J
                .Text = "Item " & I & " * " & J
            Next J
        Next I
    End With
    With ListView1
        .View = lvwReport
        .Width = 1200 * 9 + 100
        .GridLines = True
        For J = 0 To 8
            .ColumnHeaders.Add , , "ColHeader" & J, 1200
        Next J
        For I = 0 To 33
            Set mListItem = .ListItems.Add(, I & " ID", "Row " & I, "icon1", "icon1")
            For J = 1 To 8
                mListItem.ListSubItems.Add , "ComHeader" & J, I & " * " & J
                
            Next J
        Next I
        Set mListItem = Nothing
    End With
End Sub


'大家打印自己的控件可参考下面代码(从DirectPrint修改而来）
Private Sub RefDirectPrint(objToPrint As Object, Optional TITLE As String, _
                        Optional tFontSize As Long = 12, Optional titleAlignment As AlignmentConstants = vbCenter)
Dim I As Long, J As Long, K As Long, oldFont As New StdFont
    
    '保存打印控件使用的字体，并使用新字体
    CloneFont oldFont, CurtPrinter1.Font
    CloneFont CurtPrinter1.Font, objToPrint.Font
    If Not CurtPrinter1.IsPrinter Then CurtPrinter1.Font.Size = CurtPrinter1.FontSize * CurtPrinter1.Zoom / 100
    
    With objToPrint
        If TypeName(objToPrint) = "ListView" Then
            '先打印ColumnHeaders
            If .ListItems.Count < 1 Or .View < 3 Then GoTo EndP
            CurtPrinter1.CellOut .ColumnHeaders(1).Text, .ColumnHeaders(1).Width, vbLeftJustify, "4422", vbButtonFace '边缘单元格
            For J = 2 To .ColumnHeaders().Count - 1
                CurtPrinter1.CellOut .ColumnHeaders(J).Text, .ColumnHeaders(J).Width, vbCenter, "2422", vbButtonFace '边缘单元格
            Next J
            CurtPrinter1.CellOut .ColumnHeaders(J).Text, .ColumnHeaders(J).Width, vbCenter, "2442", vbButtonFace '边缘单元格
            CurtPrinter1.NewCellRow
            
            '打印实际表格部分
            For I = 1 To .ListItems.Count - 1
                If CurtPrinter1.CurrentY + TextHeight("人") * 3 > CurtPrinter1.ScaleHeight - CurtPrinter1.TopMargin - CurtPrinter1.BottomMargin Then
                    
                    '最后一行的单元格
                    CurtPrinter1.CellOut .ListItems(I).Text, .ColumnHeaders(1).Width, vbLeftJustify, "4224"
                    For J = 1 To .ListItems(I).ListSubItems().Count - 1
                        CurtPrinter1.CellOut .ListItems(I).ListSubItems(J).Text, .ColumnHeaders(J + 1).Width, vbCenter, "2224"
                    Next J
                    CurtPrinter1.CellOut .ListItems(I).ListSubItems(J).Text, .ColumnHeaders(J + 1).Width, vbCenter, "2244"
                    
                    '重新打印表头
                    CurtPrinter1.NewPage
                    If TITLE <> "" Then CurtPrinter1.TitleOut TITLE, tFontSize, titleAlignment
                    CurtPrinter1.CellOut .ColumnHeaders(1).Text, .ColumnHeaders(1).Width, vbLeftJustify, "4422", vbButtonFace   '边缘单元格
                    For J = 2 To .ColumnHeaders().Count - 1
                        CurtPrinter1.CellOut .ColumnHeaders(J).Text, .ColumnHeaders(J).Width, vbCenter, "2422", vbButtonFace  '边缘单元格
                    Next J
                    CurtPrinter1.CellOut .ColumnHeaders(J).Text, .ColumnHeaders(J).Width, vbCenter, "2442", vbButtonFace  '边缘单元格
                Else
                    
                    '打印非边缘的单元格
                    CurtPrinter1.CellOut .ListItems(I).Text, .ColumnHeaders(1).Width, vbLeftJustify, "4222"
                    For J = 1 To .ListItems(I).ListSubItems().Count - 1
                        CurtPrinter1.CellOut .ListItems(I).ListSubItems(J).Text, .ColumnHeaders(J + 1).Width, vbCenter, "2222"
                    Next J
                    CurtPrinter1.CellOut .ListItems(I).ListSubItems(J).Text, .ColumnHeaders(J + 1).Width, vbCenter, "2242"
                End If
                CurtPrinter1.NewCellRow
            Next I
            '打印最后一行
            CurtPrinter1.CellOut .ListItems(I).Text, .ColumnHeaders(1).Width, vbLeftJustify, "4224"
            For J = 1 To .ListItems(I).ListSubItems().Count - 1
                CurtPrinter1.CellOut .ListItems(I).ListSubItems(J).Text, .ColumnHeaders(J + 1).Width, vbCenter, "2224"
            Next J
            CurtPrinter1.CellOut .ListItems(I).ListSubItems(J).Text, .ColumnHeaders(J + 1).Width, vbCenter, "2244"
        End If
    End With
    
EndP:
    '恢复打印控件原来使用的字体
    CloneFont CurtPrinter1.Font, oldFont
    Set oldFont = Nothing
End Sub
'复制字体属性
Private Sub CloneFont(Dest As StdFont, Src As StdFont)
    With Dest
        .Bold = Src.Bold
        .Charset = Src.Charset
        .Italic = Src.Italic
        .Name = Src.Name
        .Size = Src.Size
        .Strikethrough = Src.Strikethrough
        .Underline = Src.Underline
        .Weight = Src.Weight
    End With
End Sub


'********************************************************************************************************
'   CurtPrinter v1.0.0  有条件免费使用！本控件可任意传播，但请保留本内容！
'   版权所有: 刘立志    保留一切权利!
'   本人不想将时间用于控件的版权的保护，请大家自觉遵守下面的用户协议：
'
'   如果您未将本控件用与商业目的，可以免费使用本控件！否则请象作者付费：个人用户￥29，单位用户￥99。
'   联系方式：  Email：[e-mail]      Mobile：[phone]     QQ：121728839
'   开户行：深圳招商银行振华路分行 帐号：0755-36387681
'   地址：深圳市福田区振华路78号电子器材大厦东418  邮编：518031
'   欢迎您对本控件提出宝贵意见，我将认真改正！
'********************************************************************************************************
'-----最新更新记录-----
'2002-01-04：增加PaperSize属性，增加IsPrinter属性。测试结束，控件发布为1.0版本！
'
'2001-12-31：更改了DirectPrint DataGrid的BUG，更改了向下翻页的一个BUG
'
'2001-12-27：支持多达999页的预览；预览的接近时实显示；单元格的背景打印；增加PaperColor属性；
'            增加CancelPrint方法；增加Busy属性；增加ZoomIn、ZoomOut方法；
'********************************************************************************************************
'本控件的目的是解决烦琐的报表打印问题，具有如下功能（具体使用请参考后面的使用说明部分）：
'    1-直接打印四种常见报表控件：DataGrid、ListView、MsFlexGrid、MsHFlexGrid。
'    2-页眉页脚的打印。
'    3-打印标题栏，并可以设定字体和对齐方式。
'    4-直接打印单元格以及里面的文本，并可设置对齐方式和文本距离边框的边界以及单元格背景
'    5-支持页面设置，结果直接作用于打印机，无须二次调整
'    6-支持打印机对话框，无须再调用CommanDialog控件（ShowPrinter)
'    7-预览翻页和缩放
'    8-支持众多打印函数和控制属性
'    9-内置工具栏，无须编写代码变直接控制页面
'   10-工具栏可隐藏，允许您用控件提供的控制函数定义自己喜欢的工具栏
'********************************************************************************************************

'====================================使用说明===================================================
' -----打印输出方法-----
' StartPrint初始化打印设备，缺省表示预览到本控件，Printer表示打印到打印机
' newPage开始打印一个页面
' HeaderOut打印页眉
' TitleOut打印标题
' TextOut打印一个字符串
' NewRow重新开始一行
' DotOut打印一个点
' LineOut打印一条线
' BoxOut打印一个方框（无文字）
' FilledBoxOut打印一个填充颜色的方框（无文字）
' CircleOut打印一个圆
' PictureOut打印控件内图片
' CurtPrinter1.CellOut打印带字符串的单元格（可设置边框,文字对齐方式，填充颜色）
' FooterOut打印页脚
' DirectPrint直接打印一个GRID控件的所有内容（目前支持：DataGrid,MSFlexGrid,MSHFlexGrid,ListView）
' EndDoc结束打印
' CancelPrint取消打印任务

' -----控件事件-----
' NeedRedraw() ' 如果AutoRedraw属性为假，那么需要在该事件里写入需要重新打印的代码
' ClosePreview() ' 点了关闭预览的按钮
' RealPrint() ' 点了打印机对话框的确定按钮，引发此事件，需要在本事件内写入打印到打印机的代码
' PrintHeader(CurrentPage As Long) ' 需要打印页眉
' PrintFooter(CurrentPage As Long) ' 需要打印页脚

' -----外观设置-----
' ToolBarVisible设置/返回工具栏的可见性
' BorderStyle设置/返回控件边框类型
' BackColor设置/返回控件的背景颜色
' PaperColor设置/返回预览时纸张的颜色

' -----纸张和边距设置-----
' PaperSize设置/返回打印纸的型号（如果打印机不支持用户输入的型号，将用默认型号替代）
' Orientation设置/返回打印纸的放置方向
' PaperWidth设置/返回打印纸的宽度，单位是mm
' PaperHeight设置/返回打印纸的高度，单位是mm
' LeftMargin设置/返回打印纸的左边界，单位是mm
' TopMargin设置/返回打印纸上边界，单位是mm
' RightMargin设置/返回打印纸右边界，单位是mm
' BottomMargin设置/返回打印纸下边界，单位是mm
' LeftCellMargin设置/返回表格内字距离左边框的尺寸，单位是mm
' TopCellMargin设置/返回表格内字距离上边框的尺寸，单位是mm
' RightCellMargin设置/返回表格内字距离右边框的尺寸，单位是mm
' BottomCellMargin设置/返回表格内字距离下边框的尺寸，单位是mm

' -----关于绘图的基本设置-----
' DrawWidth设置/返回打印线条的宽度
' DrawStyle设置/返回打印线类型
' DrawMode设置/返回打印图形用到的模式
' ForeColor设置/返回打印使用的前景颜色
' Font设置/返回打印使用的字体
' FontSize设置/返回打印使用的字体大小

' -----只有运行时可用的属性-----
' PageCount返回生成预览后总的页数（设计时不可用）
' CurrentPage返回当前预览的页码（设计时不可用）
' ScaleHeight返回页面可打印的最大高度（设计时不可用）
' ScaleWidth返回页面可打印的最大宽度（设计时不可用）
' CurrentX设置/返回画笔在页面内的X坐标（设计时不可用）
' CurrentY设置/返回画笔在页面内的Y坐标（设计时不可用）
' Busy返回控件的状态，如果上次任务未完成，该值为真.想进行新的打印操作应先调用CancelPrint（设计时不可用）
' IsPrinter返回当前的打印设备是否是打印机
' -----工具拦使用的控制函数或属性（您可以用它们构造自己工具栏）-----
' PageSetup页面设置函数
' ShowPrinter调出打印机对话框如果用户点击确定按钮，将引发RealPrint事件，把写在这个事件中的代码打印到打印机
' SetViewPage设置当前显示的页面
' PageDown显示下一个页面
' PageUp显示上一个页面
' Zoom设置/取得预览比例(25-200是合法值，其余将视为整页显示)
' ZoomOut将预览比例放大
' ZoomIn将预览比例缩小
' ClosePreview将引发ClosePreview事件,具体操作由用户在该事件内自定义
' AutoRedraw设置/返回重新显示预览页面的更新方式若设置为假需要在NeedRedraw()事件中加入要重画的代码

'=====================================谢谢您阅读本文件==============================================