frmcus.frm

用VB6.0编写的关于车辆运输调度的系统

Private Sub vascus_Click(ByVal Col As Long, ByVal Row As Long)
Dim cuscode, Entcode As String
Dim rstcus As Recordset
Dim sSQL As String
Dim i As Long
Dim status As String
If Row = 0 Then
Else
    frminput.Enabled = False
    With vascus
    .Col = 1
    .Row = Row
    Entcode = gsEntCode
    .Col = 2
    cuscode = vascus.Text
    End With
    If Entcode <> "" And cuscode <> "" Then
        txtentc.Text = gsEntCode
        txtcusc.Text = GetValue(vascus, Row, cusdetail.cuscode)
        Text1.Text = GetValue(vascus, Row, cusdetail.cuscode)
        txtcusd.Text = GetValue(vascus, Row, cusdetail.Cusdesc)
        txtaltn.Text = GetValue(vascus, Row, cusdetail.Altname)
        txtmain.Text = GetValue(vascus, Row, cusdetail.Mainame)
        txtadd1.Text = GetValue(vascus, Row, cusdetail.Addres1)
        txtadd2.Text = GetValue(vascus, Row, cusdetail.Addres2)
        txtadd3.Text = GetValue(vascus, Row, cusdetail.Addres3)
        txtadd4.Text = GetValue(vascus, Row, cusdetail.Addres4)
        txtcitc.Text = GetValue(vascus, Row, cusdetail.Citcode)
        status = GetValue(vascus, Row, cusdetail.Astatus)
        
        For i = 0 To cbostatus.ListCount - 1
            cbostatus.ListIndex = i
            If status = cbostatus.Text Then
            Exit For
            End If
        Next
        lCurRow = vascus.Row
        lCurCol = vascus.Col
        
    Else
    End If
End If
End Sub


Private Sub SetToolBar(ByVal mkey As String)
        Select Case mkey
                 
        Case "modify"
            With UserControl1
                .DisplayButton "Modify", "Modify", False, , "Modify"
                .DisplayButton "Find", "Find", False, , "Find"
                .DisplayButton "Save", "Save", True, , "Save"
                .DisplayButton "Cancel", "Cancel", True, , "Cancel"
                .DisplayButton "Upload", "Upload", False, , "Upload"
                .DisplayButton "Close", "Close", False, , "Close"
            End With
            vascus.Enabled = False
            frminput.Enabled = True
            txtentc.Enabled = False
            txtcusc.Enabled = False
            txtcusd.Enabled = False
            txtaltn.Enabled = False
            txtmain.Enabled = False
            txtadd1.Enabled = False
            txtadd2.Enabled = False
            txtadd3.Enabled = False
            txtadd4.Enabled = False
            txtcitc.Enabled = False
            cbostatus.Enabled = True
            cbostatus.SetFocus
            Text1.Visible = False
           
        Case "cancel"
            With UserControl1
                .DisplayButton "Find", "Find", True, , "Find"
                .DisplayButton "Modify", "Modify", True, , "Modify"
                .DisplayButton "Save", "Save", False, , "Save"
                .DisplayButton "Cancel", "Cancel", False, , "Cancel"
                .DisplayButton "Upload", "Upload", True, , "Upload"
                .DisplayButton "Close", "Close", True, , "Close"
            End With
            
            vascus.Enabled = True
            frminput.Enabled = False
            Text1.Visible = False
            
        Case "find"
            With UserControl1
                .DisplayButton "Find", "Find", False, , "Find"
                .DisplayButton "Save", "Save", False, , "Save"
                .DisplayButton "Modify", "Modify", True, , "Modify"
                .DisplayButton "Cancel", "Cancel", True, , "Cancel"
                .DisplayButton "Upload", "Upload", True, , "Upload"
                .DisplayButton "Close", "Close", False, , "Close"
            End With
            vascus.Enabled = True
            frminput.Enabled = True
            txtentc.Enabled = False
            txtcusc.Enabled = False
            txtcusd.Enabled = False
            txtaltn.Enabled = False
            txtmain.Enabled = False
            txtadd1.Enabled = False
            txtadd2.Enabled = False
            txtadd3.Enabled = False
            txtadd4.Enabled = False
            txtcitc.Enabled = False
            cbostatus.Enabled = False
            Text1.Visible = True
            Text1.Enabled = True
            Text1.Text = ""
            Text1.SetFocus
        Case "save"
            With UserControl1
                .DisplayButton "Find", "Find", True, , "Find"
                .DisplayButton "Save", "Save", False, , "Save"
                .DisplayButton "Modify", "Modify", True, , "Modify"
                .DisplayButton "Cancel", "Cancel", False, , "Cancel"
                .DisplayButton "Upload", "Upload", True, , "Upload"
                .DisplayButton "Close", "Close", True, , "Close"
            End With
            vascus.Enabled = True
            frminput.Enabled = False
       Case "upload"
           With UserControl1
                .DisplayButton "Save", "Save", False, , "Save"
                .DisplayButton "Cancel", "Cancel", False, , "Cancel"
                .DisplayButton "Upload", "Upload", False, , "Upload"
                .DisplayButton "Find", "Find", False, , "Find"
                .DisplayButton "Modify", "Modify", False, , "Modify"
                '.DisplayButton "Print", "Print", True, , "Print"
                .DisplayButton "Close", "Close", False, , "Close"
            End With

        End Select

End Sub

Private Sub UserControl1_ButtonClick(ByVal Button As MSComctlLib.Button)
    On Error Resume Next
    mkey = LCase(Button.Key)
    
    Select Case LCase(Button.Key)
       
        Case "save"
            
            Call cusmodify
            Call display
            Call vasshow
            
       Case "modify"
            lblstatus.Caption = mkey
       Case "find"
            lblstatus.Caption = "search"
       Case "close"
            Unload Me
            Exit Sub
       Case "upload"
            Call down_sub
     
    End Select
    
    Call SetToolBar(mkey)
    
End Sub

Private Sub cusmodify()
Dim sSQL As String
Dim cuscode As Long
Dim Astatus As String
     
    
    cuscode = CLng(txtcusc.Text)
    Astatus = cbostatus.Text
    
    sSQL = "update appcus set astatus = '" & Astatus & "' where cuscode = " & cuscode & ""
    Acs_cnt.BeginTrans
    Acs_cnt.Execute (sSQL)
    Acs_cnt.CommitTrans
End Sub

Private Sub display()

    SetColHead vascus, cusdetail.Addres1, "Address1", 16
    SetColHead vascus, cusdetail.Addres2, "Address2", 16
    SetColHead vascus, cusdetail.Addres3, "Address3", 16
    SetColHead vascus, cusdetail.Addres4, "Address4", 16
    SetColHead vascus, cusdetail.Citcode, "City Code", 14
    SetColHead vascus, cusdetail.Astatus, "Active Status", 8
End Sub

Private Sub down_sub()
   Dim i As Integer
   PrBar1.Visible = True
   Cmd_ok.Visible = True
   Cmd_no.Visible = True
  
   i = 0
   DBFC ("upload")
   DBF_Rec.Open "select * from customer "
   ReDim Preserve Cusrc(0) As Cusrc
   PrBar1.max = DBF_Rec.RecordCount
   DBF_Rec.MoveFirst
   vascus.MaxCols = 10
   vascus.MaxRows = 0
   PrBar1.Value = 0
   With vascus
     
     SetColHead vascus, 1, "Is Select", 10
     SetColHead vascus, 2, "Customer Code", 12
     SetColHead vascus, 3, "Customer Description", 16
     SetColHead vascus, 4, "Customer Alternate Name", 16
     SetColHead vascus, 5, "Customer Mail Name", 16
     SetColHead vascus, 6, "Address1", 12, True
     SetColHead vascus, 7, "Address2", 12, True
     SetColHead vascus, 8, "Address3", 12, True
     SetColHead vascus, 9, "Address4", 12, True
     SetColHead vascus, 10, "City Code", 12, True
     'SetColHead vascus, 10, "Active Status", 8, True
        
    End With
    Do
        i = i + 1
       PrBar1.Value = i
       Cusrc(UBound(Cusrc)).Entcode = "" & "'" & gsEntCode & "'"
       If IsNull(DBF_Rec!aban8) Or Trim(DBF_Rec!aban8) = "" Then
           Cusrc(UBound(Cusrc)).cuscode = 0  ' numeric
       Else
            Cusrc(UBound(Cusrc)).cuscode = DBF_Rec!aban8
        End If
       Cusrc(UBound(Cusrc)).Cusdesc = "" & DBF_Rec!abalph
       Cusrc(UBound(Cusrc)).Altname = "" & DBF_Rec!abalp1
       Cusrc(UBound(Cusrc)).Mainame = "" & DBF_Rec!wwmlnm
       Cusrc(UBound(Cusrc)).Addres1 = "" & DBF_Rec!aladd1
       Cusrc(UBound(Cusrc)).Addres2 = "" & DBF_Rec!aladd2
       Cusrc(UBound(Cusrc)).Addres3 = "" & DBF_Rec!aladd3 '
       Cusrc(UBound(Cusrc)).Addres4 = "" & DBF_Rec!aladd4 '
       Cusrc(UBound(Cusrc)).Citcode = "" & DBF_Rec!alcty1 '
       Cusrc(UBound(Cusrc)).Astatus = "N"
       vascus.MaxRows = i
       SetValue vascus, i, 2, Cusrc(UBound(Cusrc)).cuscode
       SetValue vascus, i, 3, Cusrc(UBound(Cusrc)).Cusdesc
       SetValue vascus, i, 4, Cusrc(UBound(Cusrc)).Altname
       SetValue vascus, i, 5, Cusrc(UBound(Cusrc)).Mainame
       SetValue vascus, i, 6, Cusrc(UBound(Cusrc)).Addres1
       SetValue vascus, i, 7, Cusrc(UBound(Cusrc)).Addres2
       SetValue vascus, i, 8, Cusrc(UBound(Cusrc)).Addres3
       SetValue vascus, i, 9, Cusrc(UBound(Cusrc)).Addres4
       SetValue vascus, i, 10, Cusrc(UBound(Cusrc)).Citcode
       
       ReDim Preserve Cusrc(UBound(Cusrc) + 1) As Cusrc
      

       DBF_Rec.MoveNext
  Loop Until DBF_Rec.EOF
       Cmd_ok.Visible = True
       Cmd_no.Visible = True
       
       Call LockCell(vascus, 1, False)
   '    MSFlexGrid1.Visible = True
       DBFD
       PrBar1.Value = 0
       PrBar1.Visible = False
End Sub
Private Sub cmd_ok_click()
   Dim i As Integer
   Dim acs_rec As Recordset
   Dim sSQL As String
   With UserControl1
        .DisplayButton "Save", "Save", False, , "Save"
        .DisplayButton "Cancel", "Cancel", False, , "Cancel"
        .DisplayButton "Upload", "Upload", True, , "Upload"
        .DisplayButton "Find", "Find", True, , "Find"
        .DisplayButton "Modify", "Modify", True, , "Modify"
        .DisplayButton "Close", "Close", True, , "Close"
    End With
    vascus.Enabled = True
    frminput.Enabled = False

   Cmd_ok.Visible = False
   Cmd_no.Visible = False
   PrBar1.Visible = True
   PrBar1.max = UBound(Cusrc) - 1

   Set acs_rec = Acs_cnt.Execute("select * from appcus ")
   If acs_rec.EOF = False Then
       For i = 0 To UBound(Cusrc) - 1
       
          PrBar1.Value = i
           acs_rec.MoveFirst
       
          
          If GetValue(vascus, i + 1, cusdetail.IsSelect) = 1 Then
          Do
               If acs_rec!cuscode = Cusrc(i).cuscode Then
                  sSQL = "delete * from appcus where cuscode = " & Cusrc(i).cuscode
                  Acs_cnt.Execute (sSQL)
                  Exit Do
               End If
               acs_rec.MoveNext
          Loop Until acs_rec.EOF
          End If
       Next i
       acs_rec.Close
       Set acs_rec = Acs_cnt.Execute("select * from appcus")
          If acs_rec.EOF Then
               For i = 0 To UBound(Cusrc) - 1
                PrBar1.Value = i
               Acs_cnt.Execute "insert into appcus (entcode,cuscode,cusdesc,altname,mainame,addres1,addres2,addres3,addres4,citcode,astatus)" _
                                  & "values ( '" & gsEntCode & "' ," & Cusrc(i).cuscode & "," _
                                  & "'" & Cusrc(i).Cusdesc & "'," & "'" & Cusrc(i).Altname & "'," _
                                  & "'" & Cusrc(i).Mainame & "'," & "'" & Cusrc(i).Addres1 & "'," _
                                  & "'" & Cusrc(i).Addres2 & "'," & "'" & Cusrc(i).Addres3 & "'," _
                                  & "'" & Cusrc(i).Addres4 & "'," & "'" & Cusrc(i).Citcode & "'," _
                                  & "'Y')"
              Next i
          Else
              Acs_cnt.Execute "update appcus set astatus = 'N' "
              For i = 0 To UBound(Cusrc) - 1
                PrBar1.Value = i
               If GetValue(vascus, i + 1, cusdetail.IsSelect) = 1 Then
                    Acs_cnt.Execute "insert into appcus (entcode,cuscode,cusdesc,altname,mainame,addres1,addres2,addres3,addres4,citcode,astatus)" _
                                       & "values ( '" & gsEntCode & "' ," & Cusrc(i).cuscode & "," _
                                       & "'" & Cusrc(i).Cusdesc & "'," & "'" & Cusrc(i).Altname & "'," _
                                       & "'" & Cusrc(i).Mainame & "'," & "'" & Cusrc(i).Addres1 & "'," _
                                       & "'" & Cusrc(i).Addres2 & "'," & "'" & Cusrc(i).Addres3 & "'," _
                                       & "'" & Cusrc(i).Addres4 & "'," & "'" & Cusrc(i).Citcode & "'," _
                                       & "'Y')"
                End If
              Next i
          End If
          acs_rec.Close
      PrBar1.Value = 0
  Else
           acs_rec.Close

           For i = 0 To UBound(Cusrc) - 1
           PrBar1.max = UBound(Cusrc)
           PrBar1.Value = i
           If GetValue(vascus, i + 1, cusdetail.IsSelect) = 1 Then
                Acs_cnt.Execute "insert into appcus (entcode,cuscode,cusdesc,altname,mainame,addres1,addres2,addres3,addres4,citcode,astatus)" _
                                & "values( '" & gsEntCode & "' ," & Cusrc(i).cuscode & "," _
                                 & "'" & Cusrc(i).Cusdesc & "'," & "'" & Cusrc(i).Altname & "'," _
                                 & "'" & Cusrc(i).Mainame & "'," & "'" & Cusrc(i).Addres1 & "'," _
                                & "'" & Cusrc(i).Addres2 & "'," & "'" & Cusrc(i).Addres3 & "'," _
                                & "'" & Cusrc(i).Addres4 & "'," & "'" & Cusrc(i).Citcode & "'," _
                                & "'Y')"
            End If
            Next i
            PrBar1.Value = 0
             
 End If

    Set acs_rec = Nothing
    PrBar1.Visible = False
    Call initspread

    Call vasshow
End Sub

Private Sub cmd_no_click()
   Cmd_ok.Visible = False
   Cmd_no.Visible = False
    PrBar1.Visible = False
    Call initspread
    Call vasshow
   With UserControl1
        .DisplayButton "Save", "Save", False, , "Save"
        .DisplayButton "Cancel", "Cancel", False, , "Cancel"
        .DisplayButton "Upload", "Upload", True, , "Upload"
        .DisplayButton "Find", "Find", True, , "Find"
        .DisplayButton "Modify", "Modify", True, , "Modify"
        .DisplayButton "Close", "Close", True, , "Close"
    End With
    vascus.Enabled = True
    frminput.Enabled = False


End Sub


Private Sub vascus_KeyUp(KeyCode As Integer, Shift As Integer)
Dim lrow As Long
Dim lcol As Long
    lrow = vascus.ActiveRow
    lcol = vascus.ActiveCol
    If KeyCode = vbKeyDown Then
        
        Call vascus_Click(lcol, lrow)
    ElseIf KeyCode = vbKeyUp Then
        
        Call vascus_Click(lcol, lrow)
        
    End If
End Sub