⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 frmhtk.frm

📁 电子衡自动计量系统.能对电子汽车衡进行自动计量.完成车皮存储,重车自动除皮等功能.
💻 FRM
📖 第 1 页 / 共 3 页
字号:
🔍
123 
        .Col = 2
        .Row = i
        htl = Val(.Text)
        .Col = 3
        yfl = Val(.Text)
        .Col = 4
        wfl = Val(.Text)
        .Col = 8
        je = Val(.Text)
        ljje = ljje + je * htl / 1000
        'ljjryl = ljjryl + jryl
        ljhtl = ljhtl + htl
        ljyfl = ljyfl + yfl
        ljwfl = ljwfl + wfl
    Next i
    .Row = i
    .Col = 0
    .Text = "合计(吨）"
    .Col = 2
    .Text = ljhtl / 1000
    .Col = 3
    .Text = ljyfl / 1000
    .Col = 4
    .Text = ljwfl / 1000
    .Col = 8
    .Text = FormatCurrency(ljje / (ljhtl / 1000))
    .Col = 9
    .Text = FormatCurrency(ljje)
    
    
    End With
    
End Sub
'##################################################################
'## 过程名称：PrintContent
'## 参数：Optional 为ntDevice As Printer型
'##################################################################
Public Sub PrintContent(Optional PrintDevice As Printer)
    Const TableStartX = 10
    
    If PrintDevice Is Nothing Then
        CurtPrinter1.StartPrint toPreview '预览
    Else
        CurtPrinter1.StartPrint toPrinter '打印到打印机
    End If
    Dim strr
    With CurtPrinter1
    
    
    
    '重新开始一页，直接打印报表，注意，它会自动换页，如果你设定了标题，它也自动打哦:)
    .NewPage
    
    '直接打印MSHFlexGrid
    .DirectPrint MSHFlexGrid1, "合同执行情况"
    'FromDirectPrint MSHFlexGrid1, "FromDirectPrint--MSFlexGrid控件内容，表格起始水平坐标为10", , , 10
    ' & Space(50) & Label4.Caption & Space(6) & strr & "吨"
    '结束打印
    .EndDoc
    End With
End Sub
    '##################################################################
    '## 过程名称：mnuExit_Click
    '## 参数： 无
    '##################################################################
'##################################################################
'## 过程名称：mnuExit_Click
'## 参数： 无
'##################################################################
Private Sub mnuExit_Click()
    Me.CurtPrinter1.Visible = False
End Sub
    
    '预览的代码
    '##################################################################
    '## 过程名称：mnuPreview_Click
    '## 参数： 无
    '##################################################################
'##################################################################
'## 过程名称：mnuPreview_Click
'## 参数： 无
'##################################################################
Private Sub mnuPreview_Click()
    CurtPrinter1.Visible = True
    mnuManual.Enabled = True
    
    PrintContent
End Sub
    '两行代码可选，一个会调用打印对话框，一个直接打印了。
    '##################################################################
    '## 过程名称：mnuPrint_Click
    '## 参数： 无
    '##################################################################
'##################################################################
'## 过程名称：mnuPrint_Click
'## 参数： 无
'##################################################################
Private Sub mnuPrint_Click()
    'CurtPrinter1.ShowPrinter
    PrintContent Printer
End Sub
    
    '点击了预览控件上的关闭，引发该事件，关闭预览窗体
    '##################################################################
    '## 过程名称：curtprinter1_ClosePreview
    '## 参数： 无
    '##################################################################
'##################################################################
'## 过程名称：curtprinter1_ClosePreview
'## 参数： 无
'##################################################################
Private Sub curtprinter1_ClosePreview()
    CurtPrinter1.Visible = False
    mnuManual.Enabled = False
End Sub
    '如果每次调整预览比例好重新生成预览的话，请将AutoRedraw设置为FALSE，然后在下面的事件添入要重画的代码
    '##################################################################
    '## 过程名称：curtprinter1_NeedRedraw
    '## 参数： 无
    '##################################################################
'##################################################################
'## 过程名称：curtprinter1_NeedRedraw
'## 参数： 无
'##################################################################
Private Sub CurtPrinter1_NeedRedraw()
    PrintContent
End Sub
    '写入打印叶脚的代码
    '##################################################################
    '## 过程名称：CurtPrinter1_PrintFooter
    '## 参数：CurrentPage 为Long型
    '## 参数：LeftText 为String型
    '## 参数：CenterText 为String型
    '## 参数：RightText 为String型
    '##################################################################
'##################################################################
'## 过程名称：CurtPrinter1_PrintFooter
'## 参数：CurrentPage 为Long型
'## 参数：LeftText 为String型
'## 参数：CenterText 为String型
'## 参数：RightText 为String型
'##################################################################
Private Sub CurtPrinter1_PrintFooter(CurrentPage As Long, LeftText As String, CenterText As String, RightText As String)
    'LeftText = jl_zgdw
    CenterText = Format(Now, "yyyy年m月d日")
    RightText = "其他信息"
End Sub
    
    '写入打印页眉的代码
    '##################################################################
    '## 过程名称：CurtPrinter1_PrintHeader
    '## 参数：CurrentPage 为Long型
    '## 参数：LeftText 为String型
    '## 参数：CenterText 为String型
    '## 参数：RightText 为String型
    '##################################################################
'##################################################################
'## 过程名称：CurtPrinter1_PrintHeader
'## 参数：CurrentPage 为Long型
'## 参数：LeftText 为String型
'## 参数：CenterText 为String型
'## 参数：RightText 为String型
'##################################################################
Private Sub CurtPrinter1_PrintHeader(CurrentPage As Long, LeftText As String, CenterText As String, RightText As String)
    LeftText = Date
    CenterText = jl_qym
    RightText = "这是第 " & CurrentPage & " 页"
End Sub
    
    '点击了预览窗体或直接调用ShowPrinter后，点击了打印机窗口的确定，引发打印代码，打印到打印机上！
    '##################################################################
    '## 过程名称：curtprinter1_RealPrint
    '## 参数： 无
    '##################################################################
'##################################################################
'## 过程名称：curtprinter1_RealPrint
'## 参数： 无
'##################################################################
Private Sub curtprinter1_RealPrint()
    PrintContent Printer
End Sub
    '如果隐藏工具条，仍可以通过简单的编程控制预览
    '##################################################################
    '## 过程名称：mnuPageDown_Click
    '## 参数： 无
    '##################################################################
'##################################################################
'## 过程名称：mnuPageDown_Click
'## 参数： 无
'##################################################################
Private Sub mnuPageDown_Click()
    CurtPrinter1.PageDown
End Sub
    '##################################################################
    '## 过程名称：mnuPageSetup_Click
    '## 参数： 无
    '##################################################################
'##################################################################
'## 过程名称：mnuPageSetup_Click
'## 参数： 无
'##################################################################
Private Sub mnuPageSetup_Click()
    CurtPrinter1.PageSetup
End Sub
    '##################################################################
    '## 过程名称：mnuPageUp_Click
    '## 参数： 无
    '##################################################################
'##################################################################
'## 过程名称：mnuPageUp_Click
'## 参数： 无
'##################################################################
Private Sub mnuPageUp_Click()
    CurtPrinter1.PageUp
End Sub
    '##################################################################
    '## 过程名称：mnuZoom_Click
    '## 参数： 无
    '##################################################################
'##################################################################
'## 过程名称：mnuZoom_Click
'## 参数： 无
'##################################################################
Private Sub mnuZoom_Click()
    CurtPrinter1.Zoom = Val(InputBox("请输入0-200之间的数字")) '0代表整页预览
End Sub
    
    '##################################################################
    '## 过程名称：mnuOrientation_Click
    '## 参数： 无
    '##################################################################
'##################################################################
'## 过程名称：mnuOrientation_Click
'## 参数： 无
'##################################################################
Private Sub mnuOrientation_Click()
    CurtPrinter1.Orientation = IIf(CurtPrinter1.Orientation = 1, 2, 1)
End Sub
    
    '##################################################################
    '## 过程名称：mnuPaperSize_Click
    '## 参数： 无
    '##################################################################
'##################################################################
'## 过程名称：mnuPaperSize_Click
'## 参数： 无
'##################################################################
Private Sub mnuPaperSize_Click()
    CurtPrinter1.PaperSize = InputBox("请输入打印纸型号：")
End Sub
    
    '预览控件尺寸根据窗口调整
    
    
    '添加数据到控件，以测试打印预览
    
    
    '大家打印自己的控件可参考下面代码(从DirectPrint修改而来）
    '特别提示：控件内部使用的坐标单位是Twips，而外部是毫米，Grid使用的是Twips，为了减少坐标转换带来的不必要消耗
    '         方便大家编写自己的DirectPrint，我将控件内部使用的两个接口：pCellOut（pNewCellRow）提供给大家使用。
    '         这两个接口不会出现在自动完成中，但能够正常使用，方法跟CellOut（NewCellRow）相同，不过单位不同而已，是Twips。
    '##################################################################
    '## 过程名称：FromDirectPrint
    '## 参数：GridToPrint 为Object型
    '## 参数：ptional 为LE As String型
    '## 参数：ptional 为leFontSize As Long = 12型
    '## 参数：ptional 为leAlignment As AlignmentConstants = vbCenter型
    '## 参数：ptional 为leStartX As Single型
    '##################################################################
'##################################################################
'## 过程名称：FromDirectPrint
'## 参数：GridToPrint 为Object型
'## 参数：Optional 为LE As String型
'## 参数：Optional 为leFontSize As Long = 12型
'## 参数：Optional 为leAlignment As AlignmentConstants = vbCenter型
'## 参数：Optional 为leStartX As Single型
'##################################################################
Private Sub FromDirectPrint(GridToPrint As Object, Optional TITLE As String, Optional TitleFontSize As Long = 12, Optional TitleAlignment As AlignmentConstants = vbCenter, Optional TableStartX As Single)
    Dim i As Long, j As Long, oldFont As New StdFont
    Dim RowHeight As Single
    On Error Resume Next
    
    '保存打印控件使用的字体，并使用新字体
    CloneFont oldFont, CurtPrinter1.Font
    CloneFont CurtPrinter1.Font, GridToPrint.Font
    '打印的画输出100%，而预览则是按比例输出
    If Not CurtPrinter1.IsPrinter Then CurtPrinter1.Font.Size = CurtPrinter1.FontSize * CurtPrinter1.Zoom / 100
    If TITLE <> "" Then CurtPrinter1.TitleOut TITLE, TitleFontSize, TitleAlignment
    CurtPrinter1.CurrentX = CurtPrinter1.CurrentX + TableStartX
    '对TableStartX进行坐标转换
    TableStartX = Round(TableStartX * 56.7, 2)
    With GridToPrint
    If TypeName(GridToPrint) = "MSFlexGrid" Or TypeName(GridToPrint) = "MSHFlexGrid" Then
        '打印第一行表格
        If .Rows < 1 Or .Cols < 1 Then GoTo EndP
        RowHeight = .CellHeight
        If .Rows > 1 Then
            .Row = 0: .Col = 0
            CurtPrinter1.pCellOut .Text, .ColWidth(0), RowHeight, .ColAlignment(0), "2211", .BackColorFixed
            For j = 1 To .Cols - 2
                .Col = j: CurtPrinter1.pCellOut .Text, .ColWidth(j), RowHeight, .ColAlignment(j), "1211", .BackColorFixed
            Next j
            .Col = j: CurtPrinter1.pCellOut .Text, .ColWidth(j), RowHeight, .ColAlignment(j), "1221", .BackColorFixed
            CurtPrinter1.pNewCellRow , TableStartX, RowHeight
            '打印一般单元格
            For i = 1 To .Rows - 2
                '                    If mCancel Then GoTo EndP  '如果打印被取消或未开始不执行任何代码
                .Row = i: .Col = 0
                If CurtPrinter1.CurrentY + RowHeight * 2 / 56.7 > CurtPrinter1.ScaleHeight Then
                    CurtPrinter1.pCellOut .Text, .ColWidth(0), RowHeight, .ColAlignment(0), "2112"
                    For j = 1 To .Cols - 2
                        .Col = j: CurtPrinter1.pCellOut .Text, .ColWidth(j), RowHeight, .ColAlignment(j), "1112"
                    Next j
                    .Col = j: CurtPrinter1.pCellOut .Text, .ColWidth(j), RowHeight, .ColAlignment(j), "1122"
                    '重新打印表头
                    CurtPrinter1.NewPage
                    If TITLE <> "" Then CurtPrinter1.TitleOut TITLE, TitleFontSize, TitleAlignment
                    CurtPrinter1.CurrentX = CurtPrinter1.CurrentX + TableStartX
                    .Row = 0: .Col = 0
                    CurtPrinter1.pCellOut .Text, .ColWidth(0), RowHeight, .ColAlignment(0), "2211", .BackColorFixed
                    For j = 1 To .Cols - 2
                        .Col = j: CurtPrinter1.pCellOut .Text, .ColWidth(j), RowHeight, .ColAlignment(j), "1211", .BackColorFixed
                    Next j
                    .Col = j: CurtPrinter1.pCellOut .Text, .ColWidth(j), RowHeight, .ColAlignment(j), "1221", .BackColorFixed
                Else
                    CurtPrinter1.pCellOut .Text, .ColWidth(0), RowHeight, .ColAlignment(0), "2111"
                    For j = 1 To .Cols - 2
                        .Col = j: CurtPrinter1.pCellOut .Text, .ColWidth(j), RowHeight, .ColAlignment(j), "1111"
                    Next j
                    .Col = j: CurtPrinter1.pCellOut .Text, .ColWidth(j), RowHeight, .ColAlignment(j), "1121"
                End If
                CurtPrinter1.pNewCellRow , TableStartX, RowHeight
            Next i
            '打印最后的单元格
            .Row = i: .Col = 0
            CurtPrinter1.pCellOut .Text, .ColWidth(0), RowHeight, .ColAlignment(0), "2112"
            For j = 1 To .Cols - 2
                .Col = j: CurtPrinter1.pCellOut .Text, .ColWidth(j), RowHeight, .ColAlignment(j), "1112"
            Next j
            .Col = j: CurtPrinter1.pCellOut .Text, .ColWidth(j), RowHeight, .ColAlignment(j), "1122"
        Else
            '只有一行单元格
            .Row = i: .Col = 0
            CurtPrinter1.pCellOut .Text, .ColWidth(0), RowHeight, .ColAlignment(0), "2212"
            For j = 1 To .Cols - 2
                .Col = j: CurtPrinter1.pCellOut .Text, .ColWidth(j), RowHeight, .ColAlignment(j), "1212"
            Next j
            .Col = j: CurtPrinter1.pCellOut .Text, .ColWidth(j), RowHeight, .ColAlignment(j), "1222"
        End If
        CurtPrinter1.pNewCellRow , TableStartX
    End If
    End With
    
EndP:
    '恢复打印控件原来使用的字体
    CloneFont CurtPrinter1.Font, oldFont
    Set oldFont = Nothing
End Sub
    '复制字体属性
    '##################################################################
    '## 过程名称：CloneFont
    '## 参数：Dest 为StdFont型
    '## 参数：Src 为StdFont型
    '##################################################################
'##################################################################
'## 过程名称：CloneFont
'## 参数：Dest 为StdFont型
'## 参数：Src 为StdFont型
'##################################################################
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
123

⌨️ 快捷键说明

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