frmhtk.frm

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

   ' Next ii
   ' End With
    Me.datPrimaryRS.ConnectionString = connetstr
     datPrimaryRS.RecordSource = "select hth as 票号,htl as  合同量,yfl as 已发量,wfl as 欠存量,hwm as 货物名,fhr as 发货人,fhdw as 发货单位,dj as 单价,je as 金额,sj as 发货时间,ysfs as 运输方式,jsfs as 结算方式,bz as 备注 from htk  where  sj>='" & Format(DTPicker1.Value, "yyyy-mm-dd") & "' and  sj <= '" & Format(DTPicker2.Value, "yyyy-mm-dd") & "'and je>0 order by sj"
  
    Set Me.MSHFlexGrid1.DataSource = Me.datPrimaryRS
    Me.MSHFlexGrid1.refresh
End Sub
    
Private Sub Form_Resize()
    On Error Resume Next
    '当窗体调整时会调整网格
    SSTab1.Width = Me.Width - SSTab1.Left * 2
    'DataGrid1.DefColWidth = 1000
    Me.MSHFlexGrid1.Width = SSTab1.Width
    Me.CurtPrinter1.Move 0, 0, Me.Width, Me.Height
End Sub
    
Private Sub Form_Unload(Cancel As Integer)
    'Screen.MousePointer = vbDefault
End Sub
    
Private Sub datPrimaryRS_Error(ByVal ErrorNumber As Long, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, fCancelDisplay As Boolean)
    '错误处理程序代码置于此处
    '想要忽略错误，注释掉下一行
    '想要捕获它们，在此添加代码以处理它们
    MsgBox "Data error event hit err:" & Description
End Sub
    
Private Sub datPrimaryRS_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
    '为这个 recordset 显示当前记录位置
    datPrimaryRS.Caption = "Record: " & CStr(datPrimaryRS.Recordset.AbsolutePosition)
End Sub
    
Private Sub datPrimaryRS_WillChangeRecord(ByVal adReason As ADODB.EventReasonEnum, ByVal cRecords As Long, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
    '验证代码置于此处
    '下列动作发生时该事件被调用
    Dim bCancel As Boolean
    
    Select Case adReason
        Case adRsnAddNew
        Case adRsnClose
        Case adRsnDelete
        Case adRsnFirstChange
        Case adRsnMove
        Case adRsnRequery
        Case adRsnResynch
        Case adRsnUndoAddNew
        Case adRsnUndoDelete
        Case adRsnUndoUpdate
        Case adRsnUpdate
    End Select
    
    If bCancel Then adStatus = adStatusCancel
End Sub
    
Private Sub cmdAdd_Click()
    On Error GoTo AddErr
    datPrimaryRS.Recordset.MoveLast
    
    SendKeys "{down}"
    
    Exit Sub
AddErr:
    MsgBox err.Description
End Sub
    
Private Sub cmdDelete_Click()
    On Error GoTo DeleteErr
    With datPrimaryRS.Recordset
    .delete
    .MoveNext
    If .EOF Then .MoveLast
    End With
    Exit Sub
DeleteErr:
    MsgBox err.Description
End Sub
    
Private Sub cmdRefresh_Click()
    '只有多用户应用程序需要
    On Error GoTo RefreshErr
    datPrimaryRS.refresh
    Exit Sub
RefreshErr:
    MsgBox err.Description
End Sub
    
Private Sub cmdUpdate_Click()
    On Error GoTo UpdateErr
    
    datPrimaryRS.Recordset.UpdateBatch adAffectAll
    Exit Sub
UpdateErr:
    MsgBox err.Description
End Sub
    
Private Sub cmdClose_Click()
Unload Me
End Sub
    
Private Sub MSHFlexGrid1_Click()
Me.MSHFlexGrid1.Col = 7
Me.MSHFlexGrid1.Row = Me.MSHFlexGrid1.RowSel
jl_fhdw = Me.MSHFlexGrid1.Text
Text5.Text = jl_fhdw
Text2.Text = jl_fhdw
'MsgBox jl_fhdw
End Sub

Private Sub MSHFlexGrid1_DblClick()

'If bdd = True Then
'Me.MSHFlexGrid1.Col = Me.MSHFlexGrid1.ColSel
'Me.MSHFlexGrid1.Row = Me.MSHFlexGrid1.RowSel
'Text5.Text = Me.MSHFlexGrid1.Text
'Text2.Text = Me.MSHFlexGrid1.Text
'jl_fhdw = Text5.Text

   ' End If
End Sub


Private Sub SSTab1_Click(PreviousTab As Integer)
If Me.SSTab1.Tab = 5 Then
bdd = True
Else
bdd = False
End If
End Sub

Private Sub Text1_Change()
    Dim dar As String
    dar = Text1.Text
    datPrimaryRS.RecordSource = "select hth as 票号,htl as  合同量,yfl as 已发量,wfl as 欠存量,hwm as 货物名,fhr as 发货人,fhdw as 发货单位,dj as 单价,je as 金额,sj as 发货时间,ysfs as 运输方式,jsfs as 结算方式,bz as 备注 from htk   where    hth like '%" & dar & "%'and je>0  order by sj"
    datPrimaryRS.refresh
    'DataGrid1.refresh
    Call js
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
    ljhtl = 0
    ljjryl = 0
    
    ljyfl = 0
    ljwfl = 0
    'clos1 = datPrimaryRS.Recordset.Fields.Count
    rows1 = Me.datPrimaryRS.Recordset.RecordCount
    
    With Me.MSHFlexGrid1
    .Row = rows1 + 2
    For i = 0 To rows1
        .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
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
    Private Sub mnuExit_Click()
    Me.CurtPrinter1.Visible = False
End Sub
    
Private Sub mnuPreview_Click()
    CurtPrinter1.Visible = True
    mnuManual.Enabled = True
    
    PrintContent
End Sub
    
Private Sub mnuPrint_Click()
    'CurtPrinter1.ShowPrinter
    PrintContent Printer
End Sub
    
Private Sub curtprinter1_ClosePreview()
    CurtPrinter1.Visible = False
    mnuManual.Enabled = False
End Sub
    
Private Sub CurtPrinter1_NeedRedraw()
    PrintContent
End Sub
   
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
    
   
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
    
    
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 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 Text2_Click()
 datPrimaryRS.RecordSource = "select hth as 票号,htl as  合同量,yfl as 已发量,wfl as 欠存量,hwm as 货物名,fhr as 发货人,fhdw as 发货单位,dj as 单价,je as 金额,sj as 发货时间,ysfs as 运输方式,jsfs as 结算方式,bz as 备注 from htk  where   fhdw like '%" & Trim(Text2.Text) & "%' and je>0 order by sj"
        datPrimaryRS.refresh

End Sub

Private Sub Text2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
datPrimaryRS.RecordSource = "select hth as 票号,htl as  合同量,yfl as 已发量,wfl as 欠存量,hwm as 货物名,fhr as 发货人,fhdw as 发货单位,dj as 单价,je as 金额,sj as 发货时间,ysfs as 运输方式,jsfs as 结算方式,bz as 备注 from htk  where   fhdw like '%" & Trim(Text2.Text) & "%' and je>0 order by sj"
        datPrimaryRS.refresh
End If
End Sub

Private Sub Text5_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Dim sqllstr As String
sqllstr = "sj>'" & Format(Me.DTPicker3.Value, "yyyy-mm-dd") & "' and sj<'" & Format(Me.DTPicker5.Value, "yyyy-mm-dd") & "'"
sqllstr = sqllstr & " and dj" & Trim(Me.Combo3.Text) & Val(Me.Text6.Text)
sqllstr = sqllstr & " and fhdw like '%" & Trim(Text5.Text) & "%'  order by sj"

datPrimaryRS.RecordSource = "select hth as 票号,htl as  合同量,yfl as 已发量,wfl as 欠存量,hwm as 货物名,fhr as 发货人,fhdw as 发货单位,dj as 单价,je as 金额,sj as 发货时间,ysfs as 运输方式,jsfs as 结算方式,bz as 备注 from htk   where  " & sqllstr
    datPrimaryRS.refresh
    'DataGrid1.refresh
    Set Me.MSHFlexGrid1.DataSource = Me.datPrimaryRS
    Me.MSHFlexGrid1.refresh
    Call js
    End If
End Sub

Private Sub viweth_Click()
Dim frm As Form
Set frm = New flxs
   
     frm.Label1.Caption = jl_fhdw & "合同执行情况"
    
    frm.Caption = jl_fhdw & "合同执行情况"
     frm.Show
      Call KeepOnTop(frm)
End Sub