📄 printfrm.frm

📁 guan yu pai ke xi tong de ruan jian
💻 FRM
📖 第 1 页 / 共 4 页
字号:
    Else
        PrintCom(2).Enabled = False
    End If
    If PageIndex > 0 Then
        PrintCom(3).Enabled = True
    Else
        PrintCom(3).Enabled = False
    End If
    '判断用户对打印表格的设置是否有错误。
    If MyDataSet.Tables(7).Rows(0).Items(21).Value < 1 Or MyDataSet.Tables(7).Rows(0).Items(22).Value < 1 Then
        MsgBox "你对表格的页面设置有问题：" & Chr(13) & "纵向或横向的表格数量至少应为1！" & Chr(13) & "请进入[页面设置]窗口进行相应设置。", vbOKOnly, "页面设置错误..."
        Exit Sub
    End If
    '计算行高。
    TemNum = 0
    For ForIndex = 0 To 4 '取得每天总节数。
        TemNum = TemNum + MyDataSet.Tables(7).Rows(0).Items(ForIndex).Value
    Next
    TemNum = TemNum + 1 '表格列标题占一行。
    OneTableRowCount = TemNum '一个表格所占的行数。
    '计算除各行高度总和之外的空间大小。
    TemNum = (MyDataSet.Tables(7).Rows(0).Items(25).Value + MyDataSet.Tables(7).Rows(0).Items(26).Value) * MyDataSet.Tables(7).Rows(0).Items(21).Value '加上表格标题和脚注的高度。
    TemNum = TemNum + MyDataSet.Tables(7).Rows(0).Items(23).Value * (MyDataSet.Tables(7).Rows(0).Items(21).Value - 1) '加上纵向表格之间的间距。
    TemNum = TemNum + MyDataSet.Tables(7).Rows(0).Items(9).Value + MyDataSet.Tables(7).Rows(0).Items(10).Value '加上上边距及下边距。
    '计算一行的高度。
    RowHeight = (TemPage.ScaleHeight - TemNum) / (OneTableRowCount * MyDataSet.Tables(7).Rows(0).Items(21).Value)
    '计算列宽。
    TemNum = 0
    TemNum = MyDataSet.Tables(6).RowCount '总天数。
    TemNum = TemNum + 1 '行标题占一列。
    OneTableColCount = TemNum '一个表格所占的列数。
    '计算除各列宽度总和之外的空间大小。
    TemNum = (MyDataSet.Tables(7).Rows(0).Items(22).Value - 1) * MyDataSet.Tables(7).Rows(0).Items(24).Value  '加上横向表格之间的间距。
    TemNum = TemNum + MyDataSet.Tables(7).Rows(0).Items(11).Value + MyDataSet.Tables(7).Rows(0).Items(12).Value '加上左边距及右边距。
    '计算一列的宽度。
    ColWidth = (TemPage.ScaleWidth - TemNum) / (OneTableColCount * MyDataSet.Tables(7).Rows(0).Items(22).Value)
    '表格左上角坐标。
    '刷新显示。
    For TableY = 0 To MyDataSet.Tables(7).Rows(0).Items(21).Value - 1
        For TableX = 0 To MyDataSet.Tables(7).Rows(0).Items(22).Value - 1
            TableLeft = MyDataSet.Tables(7).Rows(0).Items(11).Value + (OneTableColCount * ColWidth + MyDataSet.Tables(7).Rows(0).Items(24).Value) * TableX
            TableTop = MyDataSet.Tables(7).Rows(0).Items(9).Value + (OneTableRowCount * RowHeight + MyDataSet.Tables(7).Rows(0).Items(23).Value + MyDataSet.Tables(7).Rows(0).Items(25).Value + MyDataSet.Tables(7).Rows(0).Items(26).Value) * TableY
            DataIndex = PageIndex * MyDataSet.Tables(7).Rows(0).Items(21).Value * MyDataSet.Tables(7).Rows(0).Items(22).Value + TableY * MyDataSet.Tables(7).Rows(0).Items(22).Value + TableX
            If DataIndex < MyDataSet.Tables(DataMode Mod 2 + Abs(DataMode = 4) * 3).RowCount Then
                MyDataSet.PrintTableOne TemPage, TableLeft, TableTop, ColWidth, RowHeight, DataMode, DataIndex, MyDataSet.Tables(7).Rows(0).Items(25).Value, MyDataSet.Tables(7).Rows(0).Items(26).Value, True
            End If
        Next
    Next
End Sub
Public Sub PagereRefresh(Optional ByVal PrintMode As Boolean = False)
On Error Resume Next
    Dim TemStr As String
    Dim TemPage As Object
    If PrintMode = True Then
        Set TemPage = Printer
    Else
        Set TemPage = Me.PrintPage
        TemPage.Cls
    End If
    '显示页眉。
    TemStr = MyDataSet.Tables(7).Rows(0).Items(17).Value
    If TemStr <> "" Then
        '字体设置。
        TemPage.FontName = MyDataSet.Tables(7).Rows(0).Items(32).Value '字体名称。
        TemPage.FontSize = MyDataSet.Tables(7).Rows(0).Items(33).Value '字体大小
        TemPage.FontBold = MyDataSet.Tables(7).Rows(0).Items(34).Value \ 1000 '粗体.
        TemPage.FontItalic = (MyDataSet.Tables(7).Rows(0).Items(34).Value Mod 1000) \ 100 '斜体.
        TemPage.FontStrikethru = (MyDataSet.Tables(7).Rows(0).Items(34).Value Mod 100) \ 10 '下划线.
        TemPage.FontUnderline = (MyDataSet.Tables(7).Rows(0).Items(34).Value Mod 10) \ 1 '删除线.
        TemPage.ForeColor = MyDataSet.Tables(7).Rows(0).Items(35).Value '颜色.
        TemPage.FillColor = MyDataSet.Tables(7).Rows(0).Items(35).Value '颜色.
        '对齐方式。
        Select Case MyDataSet.Tables(7).Rows(0).Items(19).Value
        Case 0: '居左显示。
            TemPage.CurrentX = MyDataSet.Tables(7).Rows(0).Items(11).Value
        Case 2: '居右显示。
            TemPage.CurrentX = MyDataSet.Tables(7).Rows(0).Items(11).Value + (TemPage.ScaleWidth - MyDataSet.Tables(7).Rows(0).Items(11).Value - MyDataSet.Tables(7).Rows(0).Items(12).Value - TemPage.TextWidth(TemStr))
        Case Else: '默认居中显示。
            TemPage.CurrentX = MyDataSet.Tables(7).Rows(0).Items(11).Value + (TemPage.ScaleWidth - MyDataSet.Tables(7).Rows(0).Items(11).Value - MyDataSet.Tables(7).Rows(0).Items(12).Value - TemPage.TextWidth(TemStr)) / 2
        End Select
        TemPage.CurrentY = MyDataSet.Tables(7).Rows(0).Items(13).Value + (MyDataSet.Tables(7).Rows(0).Items(14).Value - TemPage.TextHeight(TemStr)) / 2
        TemPage.Print TemStr
    End If
    '显示页脚。
    TemStr = MyDataSet.Tables(7).Rows(0).Items(18).Value
    If TemStr <> "" Then
        '字体设置。
        TemPage.FontName = MyDataSet.Tables(7).Rows(0).Items(36).Value '字体名称。
        TemPage.FontSize = MyDataSet.Tables(7).Rows(0).Items(37).Value '字体大小
        TemPage.FontBold = MyDataSet.Tables(7).Rows(0).Items(38).Value \ 1000 '粗体.
        TemPage.FontItalic = (MyDataSet.Tables(7).Rows(0).Items(38).Value Mod 1000) \ 100 '斜体.
        TemPage.FontStrikethru = (MyDataSet.Tables(7).Rows(0).Items(38).Value Mod 100) \ 10 '下划线.
        TemPage.FontUnderline = (MyDataSet.Tables(7).Rows(0).Items(38).Value Mod 10) \ 1 '删除线.
        TemPage.ForeColor = MyDataSet.Tables(7).Rows(0).Items(39).Value '颜色.
        TemPage.FillColor = MyDataSet.Tables(7).Rows(0).Items(39).Value '颜色.
        Select Case MyDataSet.Tables(7).Rows(0).Items(20).Value
        Case 0: '居左显示。
            TemPage.CurrentX = MyDataSet.Tables(7).Rows(0).Items(11).Value
        Case 2: '居右显示。
            TemPage.CurrentX = MyDataSet.Tables(7).Rows(0).Items(11).Value + (TemPage.ScaleWidth - MyDataSet.Tables(7).Rows(0).Items(11).Value - MyDataSet.Tables(7).Rows(0).Items(12).Value - TemPage.TextWidth(TemStr))
        Case Else: '默认居中显示。
            TemPage.CurrentX = MyDataSet.Tables(7).Rows(0).Items(11).Value + (TemPage.ScaleWidth - MyDataSet.Tables(7).Rows(0).Items(11).Value - MyDataSet.Tables(7).Rows(0).Items(12).Value - TemPage.TextWidth(TemStr)) / 2
        End Select
        TemPage.CurrentY = (TemPage.ScaleHeight - MyDataSet.Tables(7).Rows(0).Items(15).Value - MyDataSet.Tables(7).Rows(0).Items(16).Value) + (MyDataSet.Tables(7).Rows(0).Items(16).Value - TemPage.TextHeight(TemStr)) / 2
        TemPage.Print TemStr
    End If
    If DataMode < 5 Then Call OutDispart(PrintMode) '说明是打印分表。
    If DataMode >= 5 And DataMode <= 6 Then Call OutGather(PrintMode) '说明是打印汇总表。
    StretchBlt ViewPage.hdc, 0, 0, PrintPage.Width / RoomNum, PrintPage.Height / RoomNum, PrintPage.hdc, 0, 0, PrintPage.Width, PrintPage.Height, vbSrcCopy
    ViewPage.Refresh
End Sub

Private Sub MenuDataRecor_Click(Index As Integer)
    If Index < 5 Then '0~4是分课表.
        DataMode = Index
    Else '5~6是汇总表.
        DataMode = Index - 1
        PrintCom(2).Enabled = False
        PrintCom(3).Enabled = False
    End If
    PageIndex = 0 '当前页为第一页。
    Me.PagereRefresh
End Sub

Private Sub MenuPageSet_Click()
On Error Resume Next
    SetPage.Show 1 '显示页面设置窗口。
    '使打印机设置与文件一致。
    Printer.PaperSize = MyDataSet.Tables(7).Rows(0).Items(5).Value
    Printer.Orientation = MyDataSet.Tables(7).Rows(0).Items(6).Value
    If Err.Number <> 0 Then '说明打印机错误。
        MsgBox "无法获取打印机设置！" & Chr(13) & "请确认是否已经安装并设置好打印机！", vbOKOnly, "错误..."
        '默认以A4纸张大小进行预览。
        OutPaperInfo.PaperHeight = 2970
        OutPaperInfo.PaperWidth = 2100
        OutPaperInfo.PaperName = "A4"
        OutPaperInfo.PaperSize = 9
        If MyDataSet.Tables(7).Rows(0).Items(6).Value = 1 Then
            PrintPage.Height = OutPaperInfo.PaperHeight * 6
            PrintPage.Width = OutPaperInfo.PaperWidth * 6
        Else
            PrintPage.Height = OutPaperInfo.PaperWidth * 6
            PrintPage.Width = OutPaperInfo.PaperHeight * 6
        End If
    Else
        OutPaperInfo.PaperListIndex = 0 '表示取打印机当前纸张设置信息。
        GetPaperInfo OutPaperInfo
        '确定显示页大小(与打印机一致)。
        PrintPage.Height = Printer.Height
        PrintPage.Width = Printer.Width
    End If
    '根据纸张大小设置显示页坐标系统(以毫米为单位)。
    If Printer.Orientation = 1 Then '纵向打印。
        PrintPage.Scale (0, 0)-(OutPaperInfo.PaperWidth / 10, OutPaperInfo.PaperHeight / 10)
    Else '横向打印。
        PrintPage.Scale (0, 0)-(OutPaperInfo.PaperHeight / 10, OutPaperInfo.PaperWidth / 10)
    End If
    ViewPage.Height = PrintPage.Height / RoomNum
    ViewPage.Width = PrintPage.Width / RoomNum
    ViewPage.ScaleWidth = PrintPage.ScaleWidth
    ViewPage.ScaleHeight = PrintPage.ScaleHeight
    Form_Resize '根据页面调整相应控件位置等。
    Me.PagereRefresh
End Sub

Private Sub MenuPrintOut_Click()
    '调试通过
    Call PrintCom_Click(1)
End Sub
Private Sub MenuPrintClose_Click()
    '调试通过
    Call PrintCom_Click(0)
End Sub
Private Sub Form_Load()
    '调试通过。
On Error Resume Next
    Dim ForIndex As Integer
    '使打印机设置与文件一致。
    Printer.PaperSize = MyDataSet.Tables(7).Rows(0).Items(5).Value
    Printer.Orientation = MyDataSet.Tables(7).Rows(0).Items(6).Value
    If Err.Number <> 0 Then '说明打印机错误。
        MsgBox "无法获取打印机设置！" & Chr(13) & "请确认是否已经安装并设置好打印机！", vbOKOnly, "错误..."
        '默认以A4纸张大小进行预览。
        OutPaperInfo.PaperHeight = 2970
        OutPaperInfo.PaperWidth = 2100
        OutPaperInfo.PaperName = "A4"
        OutPaperInfo.PaperSize = 9
        If MyDataSet.Tables(7).Rows(0).Items(6).Value = 1 Then
            PrintPage.Height = OutPaperInfo.PaperHeight * 6.6
            PrintPage.Width = OutPaperInfo.PaperWidth * 6.6
        Else
            PrintPage.Height = OutPaperInfo.PaperWidth * 6.6
            PrintPage.Width = OutPaperInfo.PaperHeight * 6.6
        End If
    Else
        OutPaperInfo.PaperListIndex = 0 '表示取打印机当前纸张设置信息。
        GetPaperInfo OutPaperInfo
💿 文件大小 355 K
👤 上传用户 jaysdy1117
📂 所属分类 Internet/网络编程
🏷️ 相关标签

#guan #jian #tong #ruan
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -