meetcarbill.frm

来自「一个关于电脑管理汽车的软件」· FRM 代码 · 共 1,949 行 · 第 1/5 页

      Left            =   10320
      Top             =   8280
      _ExtentX        =   6588
      _ExtentY        =   1085
   End
End
Attribute VB_Name = "MeetCarBill"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public ModifyBS As Boolean
Private OrgRS(0 To 3) As ChangeHistory
Public BillStateBS As Integer

Private Sub Combo1_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
 Combo1(Index).Text = ""
End Sub

Private Sub Combo1_KeyUp(Index As Integer, KeyCode As Integer, Shift As Integer)
 Combo1(Index).Text = ""
End Sub

Private Sub Command1_Click(Index As Integer)
 Dim i As Integer
 Dim TempRS As MYSQL_RS
 Dim TempSQL As String
 Dim TempVar As Long, VarFind As Long
 Select Case Index
  Case 1
   ClearFrame
   For i = 0 To 3
   With Command3(i)
     .left = Command1(i).left
     .top = Command1(i).top
     .Visible = True
    End With
   Next i
   For i = 0 To 9
    Command1(i).Visible = False
   Next i
   Frame1.Enabled = True
   BillStateBS = 1
   Label4 = ""
   
   
  Case 2
   If Label2(0) <> "" Then
    TempSQL = VarInitData.DisplaySQLVal(33) & " Where billnum = " & Quote(Trim(Label2(0)))
    Set TempRS = New MYSQL_RS
    TempRS.OpenRs TempSQL, gCnn
    With TempRS
     If .RecordCount > 0 Then
      If .Fields("typebs") >= 2 Then
       MsgBox "此单已在施工作业项目中审核，不能进行修改了！", , VarInitData.SysPrompt
       .CloseRecordset
       .ReleaseMemory
       Set TempRS = Nothing
       Exit Sub
      End If
     End If
     .CloseRecordset
     .ReleaseMemory
    End With
    Set TempRS = Nothing
    
    For i = 0 To 3
     With Command3(i)
      .left = Command1(i).left
      .top = Command1(i).top
      .Visible = True
     End With
    Next i
    For i = 0 To 9
     Command1(i).Visible = False
    Next i
    Frame1.Enabled = True
    
    For i = 0 To 2
     TempSQL = VarInitData.DisplaySQLVal(i + 34) & " Where billnum = " & Quote(Label2(0))
     VarInitData.LoadData2 lstBillDocu(i), TempSQL, OrgRS(i)
    Next i
    
    BillStateBS = 2
   End If
  Case 3
   If Label2(0) <> "" Then
    If MsgBox("确定删除吗？", vbOKCancel) = vbOK Then
     
  '   TempSQL = "Delete From historyitem Where billnum = " & Quote(Label2(0))
  '   gCnn.Execute TempSQL
     TempSQL = "Delete From maintainitem Where billnum = " & Quote(Label2(0))
     gCnn.Execute TempSQL
     TempSQL = "Delete From partitem Where billnum = " & Quote(Label2(0))
     gCnn.Execute TempSQL
     TempSQL = "Delete From otheritem Where billnum = " & Quote(Label2(0))
     gCnn.Execute TempSQL
     
     Set TempRS = New MYSQL_RS
     TempSQL = VarInitData.DisplaySQLVal(33) '& " Where billnum = " & Quote(Label2(0))
     TempRS.OpenRs TempSQL, gCnn
     With TempRS
      .MovePrevious
      .FindNext "billnum", Label2(0)
      .Delete
      .Update
      ClearFrame
      If .RecordCount > 0 Then
       .MoveFirst
       LoadTableToText TempRS
      End If
       .CloseRecordset
       .ReleaseMemory
     End With
     Set TempRS = Nothing
    
    End If
   End If
  Case 4 '审核
   Set TempRS = New MYSQL_RS
   TempSQL = VarInitData.DisplaySQLVal(33) & " Where billnum = " & Quote(Label2(0))
   TempRS.OpenRs TempSQL, gCnn
   With TempRS
    If .EOF Then Exit Sub
    If .Fields("typebs") >= 2 Then
     MsgBox "此单已在施工作业项目中审核，不能进行审核了！", , VarInitData.SysPrompt
     .CloseRecordset
     .ReleaseMemory
     Set TempRS = Nothing
     Exit Sub
    End If
    .Fields("typebs") = 1
    .Update
    .CloseRecordset
    .ReleaseMemory
   End With
   Set TempRS = Nothing
   
    Set TempRS = New MYSQL_RS
    TempSQL = VarInitData.DisplaySQLVal(34) & " Where billnum = " & Quote(Label2(0))
    TempRS.OpenRs TempSQL, gCnn
    With TempRS
     Do Until .EOF
      .Fields("typebs") = 1
      .Update
      .MoveNext
     Loop
     .CloseRecordset
     .ReleaseMemory
    End With
    Set TempRS = Nothing
    Label4 = "正在施工"
  Case 5
  
  Case 6 To 9
   ClearFrame
   TempSQL = VarInitData.DisplaySQLVal(33) & "Where typebs <= " & Quote("2")
   Set TempRS = New MYSQL_RS
   TempRS.OpenRs TempSQL, gCnn
   With TempRS
    If .RecordCount > 0 Then
    .MovePrevious
    VarFind = .FindNext("billnum", Label2(0))
    If VarFind > -1 Then
     If .RecordCount > 0 Then
      Select Case Index
       Case 6
        .MoveFirst
       Case 7
        .MovePrevious
        If .BOF Then
         .MoveFirst
        End If
       Case 8
        .MoveNext
        If .EOF Then .MoveLast
       Case 9
        .MoveLast
      End Select
     End If
    Else
     .MoveFirst
    End If
    LoadTableToText TempRS
    End If
    .CloseRecordset
    .ReleaseMemory
   End With
   Set TempRS = Nothing
 End Select
End Sub

Private Sub Command3_Click(Index As Integer)
 Dim TempIndex As Long
 Dim TempIndex2 As Long
 Dim TempRS As MYSQL_RS
 Dim TempSQL As String
 Dim i As Long, j As Long, K As Long
 Dim TempFindIndex As Long, TempCount As Long

 TempIndex = SSTab1.Tab
 Select Case Index
  Case 0 '新增
   Select Case TempIndex
    Case 0
     AddRow7.Show 1
    Case 1
     AddRow8.Show 1
    Case 2
     AddRow9.Show 1
   ' Case 3
   '  AddRow10.Show 1
   End Select
  Case 1 '删除
   If lstBillDocu(TempIndex).SelectedItem Is Nothing Then Exit Sub
    Select Case TempIndex
     Case 0
      i = 5
     Case 1
      i = 8
     Case 4
      i = 4
    End Select
   TempIndex2 = TempIndex + 1
   Label2(TempIndex2 * 2 - 1) = Format(Val(Label2(TempIndex2 * 2 - 1)) - Val(lstBillDocu(TempIndex).SelectedItem.SubItems(i)), "0.00")
   If TempIndex <> 3 Then lstBillDocu(TempIndex).ListItems.Remove (lstBillDocu(TempIndex).SelectedItem.Index)
   
  Case 2 '保存
   If Label4 = "" Then Label4 = "进厂待修"
   SaveToMeetCarBill
   For K = 0 To 2
    i = 0
    If lstBillDocu(K).ListItems.Count > 0 Then
    If OrgRS(K).KeyCount > 0 Or OrgRS(K).DelKeyCount > 0 Then
     TempSQL = VarInitData.DisplaySQLVal(34 + K) & " Where billnum = " & Quote(Trim(Label2(0)))
     Set TempRS = New MYSQL_RS
     TempRS.OpenRs TempSQL, gCnn
     With TempRS
      If OrgRS(K).DelKeyCount > 0 Then
       .MoveFirst
       .MovePrevious
       For j = 1 To OrgRS(K).DelKeyCount
        TempFindIndex = .FindNext("AKey", CStr(OrgRS(K).DelKeyRSValue(j)))
        If TempFindIndex > -1 Then
          .Delete
          .Update
        End If
       Next j
      End If
      i = 0
      If OrgRS(K).KeyCount > 0 Then
       .MoveFirst
       .MovePrevious
       For j = 1 To OrgRS(K).KeyCount
         TempFindIndex = .FindNext("AKey", CStr(OrgRS(K).KeyRSValue(j)))
         If TempFindIndex > -1 Then
          i = i + 1
          SaveToMeetCarBillDocu TempRS, lstBillDocu(K), i, K
         End If
       Next j
      End If
      .CloseRecordset
      .ReleaseMemory
      Set TempRS = Nothing
     End With
     OrgRS(K).Clear
    End If
    TempSQL = VarInitData.DisplaySQLVal(34 + K) '& " Where billnum = " & Quote(Trim(lblBillNum.Caption))
    Set TempRS = New MYSQL_RS
    TempRS.OpenRs TempSQL, gCnn
    With TempRS
     If .RecordCount > 0 Then
      .MoveLast
      .MoveNext
     End If
     i = i + 1
     TempCount = lstBillDocu(K).ListItems.Count
     If i <= TempCount Then
      For j = i To TempCount
      ' .MoveNext
       SaveToMeetCarBillDocu TempRS, lstBillDocu(K), j, K
      Next j
     End If
     .CloseRecordset
     .ReleaseMemory
     Set TempRS = Nothing
    End With
   End If
  Next K
   Frame1.Enabled = False
   BillStateBS = 0
   For i = 0 To 3
    Command3(i).Visible = False
   Next i
   For i = 0 To 9
    Command1(i).Visible = True
   Next i
  Case 3 '放弃
   For i = 0 To 3
    With Command3(i)
     .Visible = False
    End With
   Next i
   For i = 0 To 9
    Command1(i).Visible = True
   Next i
   ClearFrame
   Frame1.Enabled = False
    For i = 0 To 2
     OrgRS(i).Clear
    Next i
   Set TempRS = New MYSQL_RS
   TempSQL = VarInitData.DisplaySQLVal(33) & "Where typebs <= " & Quote("2")
   TempRS.OpenRs TempSQL, gCnn
   LoadTableToText TempRS
   TempRS.CloseRecordset
   TempRS.ReleaseMemory
   Set TempRS = Nothing
   BillStateBS = 0
 End Select
End Sub

Private Sub Form_Load()
 Dim i As Integer
 Dim TempRS As MYSQL_RS
 Dim TempSQL As String
 VarInitData.InitBSE BSE1
 Frame1.Enabled = False
 TempSQL = "Select name From workertable "
 For i = 0 To 2
  VarInitData.LoadData Combo1(i), TempSQL, 1
 Next i
 For i = 0 To 3
  With Command3(i)
   .Visible = False
  End With
 Next i
 lstBillDocu(0).ZOrder 0
 InitListView
 Set TempRS = New MYSQL_RS
 TempSQL = VarInitData.DisplaySQLVal(33) & "Where typebs <= " & Quote("2")
 TempRS.OpenRs TempSQL, gCnn
 LoadTableToText TempRS
 TempRS.CloseRecordset
 TempRS.ReleaseMemory
 Set TempRS = Nothing
 
 For i = 0 To 2
  Set OrgRS(i) = New ChangeHistory
 Next i
 
End Sub

Private Sub Form_Resize()
Dim i As Integer
 If Me.ScaleHeight > 0 And Me.ScaleWidth > 0 Then
  frameInfo.left = Me.ScaleLeft
  frameInfo.top = Me.ScaleTop
  frameInfo.Width = Me.ScaleWidth
  Frame1.left = frameInfo.left
  Frame1.top = frameInfo.top + frameInfo.Height
  Frame1.Width = Me.ScaleWidth
  SSTab1.top = Frame1.top + Frame1.Height
  SSTab1.left = Me.ScaleLeft + 70
  SSTab1.Width = Me.ScaleWidth - 140
  SSTab1.Height = Me.ScaleHeight - frameInfo.Height - Frame1.Height     'Screen.Height - 2650
  For i = 0 To 3
   lstBillDocu(i).top = 400
   lstBillDocu(i).left = 70
   lstBillDocu(i).Width = SSTab1.Width - 140
   lstBillDocu(i).Height = IIf(SSTab1.Height - 500 > 0, SSTab1.Height - 500, 0)
  Next i
  Text2.top = 400
  Text2.left = 70
  Text2.Width = SSTab1.Width - 140
  Text2.Height = IIf(SSTab1.Height - 500 > 0, SSTab1.Height - 500, 0)
 End If
End Sub
Private Sub LoadTableToText(VarRS As MYSQL_RS)
 Dim i As Long
 'ClearFrame
 With VarRS
 If .RecordCount > 0 Then
  Label2(0) = .Fields("billnum")
  Combo1(0) = .Fields("meetcarman")
  DTPicker1(0) = .Fields("meetcardate")
  DTPicker1(1) = .Fields("plandate")
  Combo1(1) =