fydg.frm

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

'##################################################################
Private Sub cmdDelete_Click()
    On Error GoTo DeleteErr
    With datPrimaryRS.Recordset
    .delete
    .MoveNext
    Call cmdNext_Click
    If .EOF Then .MoveLast
    End With
    Exit Sub
DeleteErr:
    MsgBox err.Description
End Sub
    
'##################################################################
'## 过程名称：cmdRefresh_Click
'## 参数： 无
'##################################################################
Private Sub cmdRefresh_Click()
    '只有多用户应用程序需要
    On Error GoTo RefreshErr
    datPrimaryRS.refresh
    'mbDataChanged = False
    Text2.text = datPrimaryRS.Recordset.Fields("sj")
    txtFields(0) = datPrimaryRS.Recordset.Fields("hth")
    txtFields(1) = datPrimaryRS.Recordset.Fields("htl")
    txtFields(3) = datPrimaryRS.Recordset.Fields("fhr")
    txtFields(4) = datPrimaryRS.Recordset.Fields("fhdw")
    txtFields(5) = datPrimaryRS.Recordset.Fields("dj")
    txtFields(7) = datPrimaryRS.Recordset.Fields("je")
    Label2.text = datPrimaryRS.Recordset.Fields("htldx")
    Label4.text = datPrimaryRS.Recordset.Fields("jedx")
    Combo1.text = datPrimaryRS.Recordset.Fields("ysfs")
    txtFields(9) = datPrimaryRS.Recordset.Fields("bz")
    txtFields(10) = datPrimaryRS.Recordset.Fields("tbr")
    txtFields(11) = datPrimaryRS.Recordset.Fields("fzr")
    DBCombo1.text = datPrimaryRS.Recordset.Fields("hwm")
    Text1.text = datPrimaryRS.Recordset.Fields("fphm")
    Combo2.text = datPrimaryRS.Recordset.Fields("jsfs")
    Text3.text = datPrimaryRS.Recordset.Fields("yfl")
    Text4.text = datPrimaryRS.Recordset.Fields("wfl")
    
    
    Exit Sub
RefreshErr:
    MsgBox err.Description
End Sub
    
'##################################################################
'## 过程名称：cmdUpdate_Click
'## 参数： 无
'##################################################################
Private Sub cmdUpdate_Click()
    On Error GoTo UpdateErr
    'datPrimaryRS.Recordset.AddNew
    datPrimaryRS.Recordset.Fields("sj") = Trim(Text2.text)
    datPrimaryRS.Recordset.Fields("hth") = txtFields(0)
    datPrimaryRS.Recordset.Fields("htl") = Val(txtFields(1))
    datPrimaryRS.Recordset.Fields("fhr") = txtFields(3).text
    datPrimaryRS.Recordset.Fields("fhdw") = txtFields(4).text
    'datPrimaryRS.Recordset.Fields("yfl") = 0
    'datPrimaryRS.Recordset.Fields("wfl") = Val(txtFields(1))
    datPrimaryRS.Recordset.Fields("dj") = Val(txtFields(5))
    datPrimaryRS.Recordset.Fields("je") = Val(txtFields(7))
    datPrimaryRS.Recordset.Fields("htldx") = Label2.text
    datPrimaryRS.Recordset.Fields("jedx") = Label4.text
    datPrimaryRS.Recordset.Fields("ysfs") = Combo1.text
    datPrimaryRS.Recordset.Fields("jsfs") = Combo2.text
    datPrimaryRS.Recordset.Fields("bz") = txtFields(9)
    datPrimaryRS.Recordset.Fields("tbr") = txtFields(10)
    datPrimaryRS.Recordset.Fields("hwm") = DBCombo1.text
    datPrimaryRS.Recordset.Fields("fphm") = Text1.text
    Text2.text = Format(DTPicker1.Value, "yyyy-mm-dd")
    datPrimaryRS.Recordset.Fields("yfl") = Val(Text3.text)
    datPrimaryRS.Recordset.Fields("wfl") = Val(Text4.text)
    
    
    datPrimaryRS.Recordset.UpdateBatch adAffectAllChapters
UpdateErr:
    MsgBox err.Description
End Sub
    
'##################################################################
'## 过程名称：cmdClose_Click
'## 参数： 无
'##################################################################
Private Sub cmdClose_Click()
    Unload Me
End Sub
    
'##################################################################
'## 过程名称：Label2_KeyPress
'## 参数：KeyAscii 为Integer型
'##################################################################
Private Sub Label2_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        txtFields(5).SetFocus
    End If
End Sub
    
'##################################################################
'## 过程名称：Text1_KeyPress
'## 参数：KeyAscii 为Integer型
'##################################################################
Private Sub text1_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        txtFields(1).SetFocus
    End If
    
End Sub
    
'##################################################################
'## 过程名称：Text2_Change
'## 参数： 无
'##################################################################
Private Sub Text2_Change()
    
    'DTPicker1.Value = Text2.text
End Sub
    
'##################################################################
'## 过程名称：Text2_DblClick
'## 参数： 无
'##################################################################
Private Sub Text2_DblClick()
    DTPicker1.Visible = True
    Text2.Visible = False
    
End Sub
    
'##################################################################
'## 过程名称：txtFields_Change
'## 参数：Index 为Integer型
'##################################################################
Private Sub txtFields_Change(Index As Integer)
    'Call txtFields_LostFocus(Index)
End Sub
    
'##################################################################
'## 过程名称：txtFields_KeyPress
'## 参数：Index 为Integer型
'## 参数：KeyAscii 为Integer型
'##################################################################
Private Sub txtFields_KeyPress(Index As Integer, KeyAscii As Integer)
    If KeyAscii = 13 Then
        
        Select Case Index
            Case 0
                txtFields(4).SetFocus
                
            Case 1
                Label2.SetFocus
                
                
            Case 2
            Case 3
                DBCombo1.SetFocus
            Case 4
                txtFields(3).SetFocus
            Case 5
                Combo2.SetFocus
                txtFields(7).text = Val(txtFields(5)) * Val(txtFields(1)) / 1000
              'sl = Val(Format(txtFields(7).text, "000000000.00"))
              Label4.text = Up(txtFields(7).text)
           
            Case 6
            Case 7
        End Select
    End If
    
End Sub
'##################################################################
'## 过程名称：dwdy
'## 参数： 无
'##################################################################
Private Sub dwdy()
    Dim lab(4) As String
    Dim i, jj, j
    lab(2) = "磅房"
    lab(3) = "用户"
    lab(1) = "留存"
    Printer.FontSize = 11
    'F 'or jj = 0 To 2
    Printer.FontSize = 14
    Printer.Print Tab(14); jl_qym & "发运单"
    'printer.Print
    Printer.FontSize = 11 ''''
    Printer.Print Tab(30); Format(Now, "yyyy年mm月dd日"); Tab(60); ; txtFields(0)
    Printer.Print "┏━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━┓"
    Printer.Print "┃"; "合同号:"; jl_hth;
    Printer.Print Spc(20); "检斤时间:  "
    Printer.Print Tab(85); "┃"
    Printer.Print "┠";
    For i = 0 To 2
       Printer.Print String(6, "─");
        Printer.Print "┬";
    Next
    Printer.Print String(17, "─");
    'Call teb("─", 17, (i))
    Printer.Print "┨"
    
    Printer.Print "┃"; Space(14); "│"; Space(14); "│"; Space(14); "│"; Space(12); "重      量"; Space(12); "┃"
    Printer.Print "┃"; Space(4); "发货人"; Space(4); "│"; Space(4); "车  号"; Space(4); "│"; Space(5); "煤  种"; Space(3); "├";
    Printer.Print String(5, "─"); "┬"; String(5, "─"); "┬"; String(5, "─"); "┨"
    'Call teb("─", 17, (i))
    'printer.Print "┨"
    Printer.Print "┃"; Space(14); "│"; Space(14); "│"; Space(14); "│"; "   毛重"; Space(3); "│"; "   皮重"; Space(3); "│"; "   净重"; Space(3); "┃"
    Printer.Print "┠"; String(7, "─"); "┼"; String(7, "─"); "┼"; String(7, "─"); "┼"; String(5, "─"); "┼"; String(5, "─"); "┼"; String(5, "─"); "┨"
    Printer.Print "┃"; jl_fhr;
    Printer.Print Tab(17); "│";
    Printer.Print Spc(5); jl_ch;
    Printer.Print Tab(33); "│"; Spc(3); jl_hwm;
    Printer.Print Tab(49); "│"; Spc(2); jl_mz; Tab(61); "│"; Spc(2); jl_pz; Tab(73); "│"; Spc(2); jl_jz; Tab(85); "┃"
    Printer.Print "┠"; String(7, "─"); "┴"; String(7, "─"); "┼"; String(7, "─"); "┴"; String(5, "─"); "┴"; String(5, "─"); "┴"; String(5, "─"); "┨"
    
    Printer.Print "┃"; "到货地点:  "; jl_dhdd; Tab(33); "│"; "备注:   "; jl_bz; Tab(85); "┃"
    
    Printer.Print "┗"; String(15, "━"); "┷"; String(25, "━"); "┛"
    Printer.Print "负责人："; jl_zg; Spc(10); "司磅员:  "; jl_sby; Spc(12); "收货人:  "; jl_shr
    Printer.Print
    Printer.Print
    'Next j
    'printer.NewPage
    Printer.EndDoc
End Sub
    
'##################################################################
'## 过程名称：dy
'## 参数： 无
'##################################################################
Private Sub dy()
    On Error Resume Next
    Dim fil As String
    'Dim xlapp As Excel.Application
   ' Dim xlbook As Excel.Workbooks
   ' Dim xlsheet As Excel.Worksheet
    'Dim gm
    'fil = App.Path & "\temp.xls"
   ' If Dir(fil) <> "" Then
   '     Kill fil
  '      FileCopy App.Path & "\fygl.xls", fil
  '  Else
 ' '      FileCopy App.Path & "\fygl.xls", fil
  '  End If
  '
   ' Set xlapp = CreateObject("Excel.Application")
    
  '  xlapp.Workbooks().Add fil
 '   Set xlsheet = xlapp.Worksheets(2)
  '  xlsheet.Cells(2, 14) = Format(DTPicker1.Value, "yyyy年m月d日")
   ' For gm = 0 To 2
       ' xlsheet.Cells(Trim(Str(gm * 10 + 1)), 1) = Label6.Caption
      '  xlsheet.Cells(Trim(Str(gm * 10 + 2)), 2) = Format(DTPicker1.Value, "yyyy年m月d日")
      '  xlsheet.Cells(Trim(Str(gm * 10 + 3)), 2) = txtFields(4)
      '  xlsheet.Cells(Trim(Str(gm * 10 + 4)), 2) = DBCombo1.text
      '  xlsheet.Cells(Trim(Str(gm * 10 + 5)), 2) = txtFields(1)
      '  xlsheet.Cells(Trim(Str(gm * 10 + 6)), 2) = txtFields(5)
      '  xlsheet.Cells(Trim(Str(gm * 10 + 7)), 6) = Combo2.text
     '   xlsheet.Cells(Trim(Str(gm * 10 + 7)), 2) = Text3.text
      '  xlsheet.Cells(Trim(Str(gm * 10 + 7)), 4) = Text4.text
     '   xlsheet.Cells(Trim(Str(gm * 10 + 8)), 9) = txtFields(9)
     '   xlsheet.Cells(Trim(Str(gm * 10 + 3)), 5) = txtFields(3)
     '   xlsheet.Cells(Trim(Str(gm * 10 + 4)), 4) = Combo1.text
     '   xlsheet.Cells(Trim(Str(gm * 10 + 5)), 4) = Label2.text
      '  xlsheet.Cells(Trim(Str(gm * 10 + 6)), 4) = txtFields(7)
     '   xlsheet.Cells(Trim(Str(gm * 10 + 9)), 2) = txtFields(10)
      '  xlsheet.Cells(Trim(Str(gm * 10 + 9)), 5) = txtFields(11)
     '   xlsheet.Cells(Trim(Str(gm * 10 + 6)), 5) = Label4.text
     '   xlsheet.Cells(Trim(Str(gm * 10 + 2)), 6) = txtFields(0)
   ' Next gm
   ' xlsheet.PrintOut
   ' xlsheet.PrintPreview
  '  xlapp.quit
    ' Kill fil
   ' Set xlbook = Nothing
   ' Set xlapp = Nothing
End Sub
'##################################################################
'## 函数名称：return1
'## 参数：s 为String型
'As String'## 返回类型：As String
'##################################################################
Function return1(s As String) As String
    return1 = zw(CInt(s))
End Function
'##################################################################
'## 函数名称：return2
'## 参数：d 为Integer型
'As String'## 返回类型：As String
'##################################################################
Function return2(d As Integer) As String
    If i <= 2 Then
        return2 = dw(d - 1)
    Else
        return2 = dw(d - 2)
    End If
End Function
    
'##################################################################
'## 过程名称：txtFields_LostFocus
'## 参数：Index 为Integer型
'##################################################################
Private Sub txtFields_LostFocus(Index As Integer)
    'On Error GoTo err
    Dim line_all As Double
    Dim sl As Double
    Dim jgtemp As String
    Dim hth
    Dim jg As String
    Dim line_zensu As Integer
    Dim dot As Integer
    Dim zensu As Integer
    Dim mon As String
    Select Case Index
            
        Case 0
            'MsgBox "sjkhf"
            'datPrimaryRS.refresh
            'If datPrimaryRS.Recordset.EOF Then Exit Sub
            ' datPrimaryRS.RecordSource = "select * from htk where hth='" & txtFields(0) & "' order by hth"
            'datPrimaryRS.refresh
            'If datPrimaryRS.Recordset.EOF = False Then
            
            'datPrimaryRS.RecordSource = "select * from htk  order by id"
            'datPrimaryRS.refresh
            'datPrimaryRS.Recordset.MoveLast
            '  hth = datPrimaryRS.Recordset.Fields("hth")
            
            'MsgBox "该发货票号已存在，最后一个号码为:   " + Chr(10) + "   " & hth
            'Exit Sub
            'End If
            
            
        Case 1
            
              
            sl = Val(Format(Val(txtFields(1).text), "00000000000.00"))
          
            'End If
            Label2.text = ChMoney2(sl)
           
            
        Case 5
            
            txtFields(7).text = Val(txtFields(5)) * Val(txtFields(1)) / 1000
              'sl = Val(Format(txtFields(7).text, "000000000.00"))
              Label4.text = Up(txtFields(7).text)
           
            
    End Select
    
    'MsgBox jg
    
err:
    'MsgBox err.Number
    If err.Number = 13 Then MsgBox "非法字符", vbExclamation
    Exit Sub
End Sub