tjb.frm

煤炭销售管理系统.完成煤炭销售的日常管理工作,和重车计量系统空车计量系统配合使用.

    If KeyAscii = 13 Then Command1_Click
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, Label2.Caption
    'FromDirectPrint MSHFlexGrid1, "FromDirectPrint--MSFlexGrid控件内容，表格起始水平坐标为10", , , 10
    strr = Str(Val(Format(Val(Text2.Text) / 1000, "00000000000.000")))
    .TextOut Label3.Caption & Space(10) & DataCombo1.Text
    '& Space(50) & Label4.Caption & Space(6) & strr & "吨"
    
    '结束打印
    .EndDoc
    End With
End Sub
'##################################################################
'## 过程名称：mnuExit_Click
'## 参数： 无
'##################################################################
Private Sub mnuExit_Click()
Me.CurtPrinter1.Visible = False
End Sub
    
    '预览的代码
'##################################################################
'## 过程名称：mnuPreview_Click
'## 参数： 无
'##################################################################
Private Sub mnuPreview_Click()
    CurtPrinter1.Visible = True
    mnuManual.Enabled = True
    PrintContent
End Sub
    '两行代码可选，一个会调用打印对话框，一个直接打印了。
'##################################################################
'## 过程名称：mnuPrint_Click
'## 参数： 无
'##################################################################
Private Sub mnuPrint_Click()
    'CurtPrinter1.ShowPrinter
    PrintContent Printer
End Sub
    
    '点击了预览控件上的关闭，引发该事件，关闭预览窗体
'##################################################################
'## 过程名称：curtprinter1_ClosePreview
'## 参数： 无
'##################################################################
Private Sub curtprinter1_ClosePreview()
    CurtPrinter1.Visible = False
    mnuManual.Enabled = False
End Sub
    '如果每次调整预览比例好重新生成预览的话，请将AutoRedraw设置为FALSE，然后在下面的事件添入要重画的代码
'##################################################################
'## 过程名称：curtprinter1_NeedRedraw
'## 参数： 无
'##################################################################
Private Sub CurtPrinter1_NeedRedraw()
    PrintContent
End Sub
    '写入打印叶脚的代码
'##################################################################
'## 过程名称：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型
'##################################################################
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
'## 参数： 无
'##################################################################
Private Sub curtprinter1_RealPrint()
    PrintContent Printer
End Sub
    '如果隐藏工具条，仍可以通过简单的编程控制预览
'##################################################################
'## 过程名称：mnuPageDown_Click
'## 参数： 无
'##################################################################
Private Sub mnuPageDown_Click()
    CurtPrinter1.PageDown
End Sub
'##################################################################
'## 过程名称：mnuPageSetup_Click
'## 参数： 无
'##################################################################
Private Sub mnuPageSetup_Click()
    CurtPrinter1.PageSetup
End Sub
'##################################################################
'## 过程名称：mnuPageUp_Click
'## 参数： 无
'##################################################################
Private Sub mnuPageUp_Click()
    CurtPrinter1.PageUp
End Sub
'##################################################################
'## 过程名称：mnuZoom_Click
'## 参数： 无
'##################################################################
Private Sub mnuZoom_Click()
    CurtPrinter1.Zoom = Val(InputBox("请输入0-200之间的数字")) '0代表整页预览
End Sub
    
'##################################################################
'## 过程名称：mnuOrientation_Click
'## 参数： 无
'##################################################################
Private Sub mnuOrientation_Click()
    CurtPrinter1.Orientation = IIf(CurtPrinter1.Orientation = 1, 2, 1)
End Sub
    
'##################################################################
'## 过程名称：mnuPaperSize_Click
'## 参数： 无
'##################################################################
Private Sub mnuPaperSize_Click()
    Dim pager
    pager = InputBox("请输入打印纸型号：")
    If pager = 0 Then
        Exit Sub
    Else
        CurtPrinter1.PaperSize = Val(InputBox("请输入打印纸型号："))
    End If
End Sub
    
    '预览控件尺寸根据窗口调整
    
    
'##################################################################
'## 过程名称：Form_Unload
'## 参数：Cancel 为Integer型
'##################################################################
Private Sub Form_Unload(Cancel As Integer)
    If CurtPrinter1.Busy = True Then '打印预览控件忙则取消打印任务，然后就可以退出了
        CurtPrinter1.CancelPrint
        MsgBox "打印控件忙，稍后重试。", vbInformation
        Cancel = True
    End If
    '
    
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型
'##################################################################
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型
'##################################################################
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
 
     Private Sub js()
'On Error Resume Next
Dim cols1
Dim rows1
Dim je, i, jryl
Dim ljje
Dim yfl, wfl, htl
Dim pjje
Dim ljjryl
Dim ljhtl
Dim ljyfl
Dim ljwfl
'clos1 = datPrimaryRS.Recordset.Fields.Count
rows1 = Me.Adodc1.Recordset.RecordCount
'rest.MoveFirst
''debug.Print rows1
For i = 1 To rows1
   jryl = jryl + Adodc1.Recordset.Fields(5) / 1000
   ljhtl = ljhtl + Adodc1.Recordset.Fields(2) / 1000
    yfl = yfl + Adodc1.Recordset.Fields(6) / 1000
  wfl = wfl + Adodc1.Recordset.Fields(7) / 1000
 
   Adodc1.Recordset.MoveNext

Next i
With Me.MSHFlexGrid1
.Rows = rows1 + 2
.Row = rows1 + 1
.Col = 0
.Text = "合计(吨）"
.Col = 2
.Text = ljhtl
.Col = 5
.Text = jryl
.Col = 6
.Text = yfl
.Col = 7
.Text = wfl
End With

End Sub
 
Private Sub neuoutput_Click()
Dim filename As String
Dim filenanmber As Integer
Dim jj As Integer
Dim ii As Integer
filenanmber = FreeFile
Me.CommonDialog1.Filter = "*.txt|*.txt"
Me.CommonDialog1.ShowOpen
If Me.CommonDialog1.filename <> "" Then
Open Me.CommonDialog1.filename For Output As #filenanmber
'Call Command9_Click
Me.Adodc1.refresh
Me.Adodc1.Recordset.MoveFirst
For ii = 0 To 10
            Print #filenanmber, Me.Adodc1.Recordset.Fields(ii).Name, ";",
      Next ii
 Print #filenanmber, Chr(13)
   For jj = 1 To Me.Adodc1.Recordset.RecordCount
     For ii = 0 To 10
            Print #filenanmber, Me.Adodc1.Recordset.Fields(ii), ";",
 
     Next ii
Print #filenanmber, Chr(10)
Me.Adodc1.Recordset.MoveNext
   Next jj
Close #filenanmber
End If

End Sub