frmite.frm

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

    lCurRow = 1
    lCurCol = 1
    vasite.Width = SpreadW
    vasite.Height = SpreadH
    Call InitToolBar
    Call initcombobox
    Call initspread
    Call vasshow
    
    lockspread vasite, True
    frminput.Enabled = False
    PrBar1.Visible = False
    Cmd_ok.Visible = False
    Cmd_no.Visible = False
End Sub

Private Sub initcombobox()
    cblstatus.AddItem "Y"
    cblstatus.AddItem "N"
    
End Sub

Private Sub initspread()
 
     With vasite
            .MaxRows = 0
            .MaxCols = 7 'enuDetailCols.MaxCols
            .ShadowColor = genuBACKCOLOR.CST_Grid_LostFocus
            .Row = -1: .Col = -1
            .BackColor = genuBACKCOLOR.CST_Grid_LostFocus
            .GridColor = vbBlack
     End With
    
     Call InitColHead
     lockspread vasite, True
                
End Sub


Private Sub InitColHead()

    With vasite
    SetColHead vasite, itedetail.IsSelect, "Is Select", 10, True
    SetColHead vasite, itedetail.Entcode, "Entity Code", 12
    SetColHead vasite, itedetail.Bracode, "Branch/Plant Code", 16
    SetColHead vasite, itedetail.Itecode, "Item Code", 14
    SetColHead vasite, itedetail.Itedesc, "Item Description", 16
    SetColHead vasite, itedetail.Meaunit, "Unit of Measurement", 16
    SetColHead vasite, itedetail.Astatus, "Active Status Code", 16
    End With
    
    Call SetBooleanType(vasite, -1, itedetail.IsSelect)
End Sub


Private Sub vasshow()
Dim rstite As Recordset
Dim sSQL As String
Dim lrow As Integer

sSQL = "select * from appite order by entcode,itecode"
Set rstite = Acs_cnt.Execute(sSQL)

With rstite
vasite.MaxRows = 0
lrow = 0
Do While Not .EOF
    vasite.MaxRows = vasite.MaxRows + 1
    lrow = lrow + 1
    SetValue vasite, lrow, itedetail.Entcode, gsEntCode
    SetValue vasite, lrow, itedetail.Bracode, rstite!Bracode
    SetValue vasite, lrow, itedetail.Itecode, rstite!Itecode
    SetValue vasite, lrow, itedetail.Itedesc, rstite!Itedesc
    SetValue vasite, lrow, itedetail.Meaunit, rstite!Meaunit
    SetValue vasite, lrow, itedetail.Astatus, rstite!Astatus
.MoveNext
Loop
End With
rstite.Close
Set rstite = Nothing
Call vasite_Click(lCurCol, lCurRow)

End Sub

Private Sub InitToolBar()
    With UserControl1
        .DisplayButton "Save", "Save", False, , "Save"
        .DisplayButton "Cancel", "Cancel", False, , "Cancel"
        '.DisplayButton "Redo", "Redo", False, , "Redo"
        .DisplayButton "Modify", "Modify", True, , "Modify"
        '.DisplayButton "Print", "Print", True, , "Print"
        .DisplayButton "Upload", "Upload", True, , "Upload"
        .DisplayButton "Close", "Close", True, , "Close"
    End With

End Sub




Private Sub txtitec_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn Then
        SendKeys "{tab}"
    End If
End Sub

Private Sub txtitec_LostFocus()
    If IsNumeric(txtitec.Text) Then
    Else
        MsgBox "Then input must be numeric!", vbOKOnly, "Information"
        txtitec.SetFocus
    End If
End Sub

Private Sub vasite_Click(ByVal Col As Long, ByVal Row As Long)
Dim status As String
Dim i As Long

    If Row = 0 Then
    Else
    txtentc.Text = gsEntCode
    txtbrac.Text = GetValue(vasite, Row, 3)
    txtitec.Text = GetValue(vasite, Row, 4)
    txtited.Text = GetValue(vasite, Row, 5)
    txtmeau.Text = GetValue(vasite, Row, 6)
    status = GetValue(vasite, Row, 7)
    For i = 0 To cblstatus.ListCount - 1
        cblstatus.ListIndex = i
        If status = cblstatus.Text Then
        Exit For
        End If
    Next
    
    lCurRow = Row
    lCurCol = Col
    End If

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 saveinfo
             Call vasshow
        Case "cancel"
            Call vasite_Click(vasite.ActiveCol, vasite.ActiveRow)
        Case "modify"
            lblstatus.Caption = mkey
        
        Case "close"
            
            Unload Me
            Exit Sub
        Case "upload"
            down_sub
    End Select
    
    Call SetToolBar(mkey)
    
End Sub


Private Sub SetToolBar(ByVal mkey As String)
        Select Case mkey
        
        Case "modify"
            With UserControl1
                '.DisplayButton "Print", "Print", False, , "Print"
                .DisplayButton "Modify", "Modify", False, , "Modify"
                .DisplayButton "Save", "Save", True, , "Save"
                .DisplayButton "Cancel", "Cancel", True, , "Cancel"
                '.DisplayButton "Redo", "Redo", True, , "Redo"
                .DisplayButton "Upload", "upload", True, , "upload"
                .DisplayButton "Close", "Close", False, , "Close"
            End With
            vasite.Enabled = False
            frminput.Enabled = True
            txtentc.Enabled = False
            txtbrac.Enabled = False
            txtitec.Enabled = False
            txtited.Enabled = False
            txtmeau.Enabled = False
            cblstatus.Enabled = True
            'cblstatus.Text = "N"
            cblstatus.SetFocus
        
        Case "cancel"
            With UserControl1
                '.DisplayButton "Print", "Print", True, , "Print"
                .DisplayButton "Modify", "Modify", True, , "Modify"
                .DisplayButton "Save", "Save", False, , "Save"
                .DisplayButton "Cancel", "Cancel", False, , "Cancel"
                '.DisplayButton "Redo", "Redo", False, , "Redo"
                .DisplayButton "Upload", "upload", True, , "upload"
                .DisplayButton "Close", "Close", True, , "Close"
            End With
            vasite.Enabled = True
            frminput.Enabled = False
            lblstatus.Caption = ""
        
         Case "save"
            With UserControl1
                '.DisplayButton "Print", "Print", True, , "Print"
                .DisplayButton "Save", "Save", False, , "Save"
                .DisplayButton "Modify", "Modify", True, , "Modify"
                .DisplayButton "Cancel", "Cancel", False, , "Cancel"
                '.DisplayButton "Redo", "Redo", False, , "Redo"
                .DisplayButton "Upload", "upload", True, , "upload"
                .DisplayButton "Close", "Close", True, , "Close"
            End With
            vasite.Enabled = True
            frminput.Enabled = False
        Case "upload"
            With UserControl1
                '.DisplayButton "Print", "Print", True, , "Print"
                .DisplayButton "Save", "Save", False, , "Save"
                .DisplayButton "Modify", "Modify", False, , "Modify"
                .DisplayButton "Cancel", "Cancel", False, , "Cancel"
                '.DisplayButton "Redo", "Redo", False, , "Redo"
                .DisplayButton "Upload", "upload", False, , "upload"
                .DisplayButton "Close", "Close", False, , "Close"
            End With
      
        End Select
End Sub


Private Sub saveinfo()
Dim Astatus As String
Dim Itecode As Integer
Dim sSQL As String
    
    Astatus = cblstatus.Text
    Itecode = CInt(txtitec.Text)
    
    
    sSQL = "update appite set astatus = '" & Astatus & "' where itecode = " & Itecode & ""
    Acs_cnt.BeginTrans
    Acs_cnt.Execute (sSQL)
    Acs_cnt.CommitTrans
    lCurRow = vasite.ActiveRow
    lCurCol = vasite.ActiveCol
    vasite.SelectBlockOptions = lCurRow
    
End Sub

Private Sub vasite_KeyUp(KeyCode As Integer, Shift As Integer)
Dim lrow, lcol As Long
    lrow = vasite.ActiveRow
    lcol = vasite.ActiveCol
    If KeyCode = vbKeyUp Or KeyCode = vbKeyDown Then
        Call vasite_Click(lcol, lrow)
    End If
End Sub
Private Sub down_sub()
    Dim i As Integer
    Dim sSQL As String
    Cmd_ok.Visible = True
    Cmd_no.Visible = True
    PrBar1.Visible = True
    
    ReDim Preserve ItemRc(0) As ItemC
    DBFC ("upload")
    DBF_Rec.Open "select * from item "
    PrBar1.max = DBF_Rec.RecordCount
    DBF_Rec.MoveFirst
   vasite.MaxCols = 5
   vasite.MaxRows = 0
   With vasite
     SetColHead vasite, 1, "Is Select", 10
     SetColHead vasite, 2, "Branch Code", 10
     SetColHead vasite, 3, "Item code", 10
     SetColHead vasite, 4, "Item description", 30
     SetColHead vasite, 5, "Measurement unit", 15
   End With
    i = 0
    Do While Not DBF_Rec.EOF
    PrBar1.Value = i
    vasite.MaxRows = vasite.MaxRows + 1
    ItemRc(UBound(ItemRc)).Bracode = DBF_Rec!ibmcu
    ItemRc(UBound(ItemRc)).Itecode = DBF_Rec!imitm
    ItemRc(UBound(ItemRc)).Itedesc = DBF_Rec!imdsc1 '
    ItemRc(UBound(ItemRc)).Meaunit = DBF_Rec!imuom1
    ItemRc(UBound(ItemRc)).Astatus = "Y"
   With vasite
      SetValue vasite, i + 1, 2, ItemRc(UBound(ItemRc)).Bracode
      SetValue vasite, i + 1, 3, ItemRc(UBound(ItemRc)).Itecode
      SetValue vasite, i + 1, 4, ItemRc(UBound(ItemRc)).Itedesc
      SetValue vasite, i + 1, 5, ItemRc(UBound(ItemRc)).Meaunit
    End With
     ReDim Preserve ItemRc(UBound(ItemRc) + 1) As ItemC
     i = i + 1
     DBF_Rec.MoveNext
    Loop
    
    Call LockCell(vasite, 1, False)
    
     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
   Cmd_ok.Visible = False
   Cmd_no.Visible = False
   PrBar1.Visible = True
   With UserControl1
        .DisplayButton "Save", "Save", False, , "Save"
        .DisplayButton "Cancel", "Cancel", False, , "Cancel"
        '.DisplayButton "Redo", "Redo", False, , "Redo"
        .DisplayButton "Modify", "Modify", True, , "Modify"
        '.DisplayButton "Print", "Print", True, , "Print"
        .DisplayButton "Upload", "Upload", True, , "Upload"
        .DisplayButton "Close", "Close", True, , "Close"
    End With
    vasite.Enabled = True
    frminput.Enabled = False

    PrBar1.max = UBound(ItemRc)
   
     sSQL = "select * from appite  order by ITECODE"
           
    Set acs_rec = Acs_cnt.Execute(sSQL)
If acs_rec.EOF = False Then
      For i = 0 To UBound(ItemRc) - 1
      acs_rec.MoveFirst
         If GetValue(vasite, i + 1, itedetail.IsSelect) = 1 Then
         Do
             If acs_rec!Itecode = ItemRc(i).Itecode Then
                 Acs_cnt.Execute ("delete * from appite where itecode = " & ItemRc(i).Itecode)
                Exit Do
               End If
               acs_rec.MoveNext
         Loop Until acs_rec.EOF
         End If
         PrBar1.Value = i
       Next
         acs_rec.Close
          Set acs_rec = Acs_cnt.Execute("select * from appite")
          If acs_rec.EOF Then
               For i = 0 To UBound(ItemRc) - 1
                 PrBar1.Value = i
                 Acs_cnt.Execute "insert into appite (entcode,bracode,itecode,itedesc,meaunit,astatus)" _
                               & "values ( '" & gsEntCode & "','" & ItemRc(i).Bracode & "'," & ItemRc(i).Itecode _
                               & ",'" & ItemRc(i).Itedesc & "','" & ItemRc(i).Meaunit _
                               & "'," & "'" & ItemRc(i).Astatus & "')"
               Next
               acs_rec.Close
               PrBar1.Value = 0
         Else
              Acs_cnt.Execute ("update appite set astatus = 'N'")
               For i = 0 To UBound(ItemRc) - 1
                 PrBar1.Value = i
                 If GetValue(vasite, i + 1, itedetail.IsSelect) = 1 Then
                        Acs_cnt.Execute "insert into appite (entcode,bracode,itecode,itedesc,meaunit,astatus)" _
                                      & "values ( '" & gsEntCode & "','" & ItemRc(i).Bracode & "'," & ItemRc(i).Itecode _
                                      & ",'" & ItemRc(i).Itedesc & "','" & ItemRc(i).Meaunit _
                                      & "'," & "'" & ItemRc(i).Astatus & "')"
                End If
               Next
               acs_rec.Close
               PrBar1.Value = 0
         End If
         
 Else
         acs_rec.Close
         For i = 0 To UBound(ItemRc) - 1
             PrBar1.Value = i
             If GetValue(vasite, i + 1, itedetail.IsSelect) = 1 Then
             Acs_cnt.Execute "insert into appite (entcode,bracode,itecode,itedesc,meaunit,astatus)" _
                        & "values ( '" & gsEntCode & "','" & ItemRc(i).Bracode & "'," & ItemRc(i).Itecode _
                        & ",'" & ItemRc(i).Itedesc & "','" & ItemRc(i).Meaunit _
                        & "'," & "'" & ItemRc(i).Astatus & "')"
            End If
          Next i
          PrBar1.Value = 0
 End If
        PrBar1.Visible = False
        
        Set acs_rec = Nothing
         vasite.MaxRows = 0
          Call initspread
    Call vasshow
End Sub
Private Sub cmd_no_click()
 Cmd_ok.Visible = False
 Cmd_no.Visible = False
 vasite.MaxRows = 0
 PrBar1.Value = 0
 PrBar1.Visible = False
 With UserControl1
        .DisplayButton "Save", "Save", False, , "Save"
        .DisplayButton "Cancel", "Cancel", False, , "Cancel"
        '.DisplayButton "Redo", "Redo", False, , "Redo"
        .DisplayButton "Modify", "Modify", True, , "Modify"
        '.DisplayButton "Print", "Print", True, , "Print"
        .DisplayButton "Upload", "Upload", True, , "Upload"
        .DisplayButton "Close", "Close", True, , "Close"
    End With
 vasite.Enabled = True
 frminput.Enabled = False

  Call initspread
    Call vasshow
End Sub