maintainpartbill.frm

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

FRM
1,169
字号
         .CloseRecordset
         .ReleaseMemory
         Set TempRS = Nothing
         MsgBox "所需退的货品已经超过库存量,操作失败", , VarInitData.SysPrompt
         Exit Sub
        End If
        .MoveNext
       Loop
     End With

     With TempRS
      .MoveFirst
      Do Until .EOF
        VarInitData.SellReduceFrStore TempRS, True
        .MoveNext
      Loop
     End With
     TempRS.CloseRecordset
     TempRS.ReleaseMemory
     Set TempRS = Nothing
     
     TempSQL = "Delete from stocktable2 Where billnum = " & Quote(Trim(StockTable.lstAddress.ListItems(StockTable.lstAddressIndex).Text))
     gCnn.Execute TempSQL
     TempSQL = "Delete from stocktable Where billnum = " & Quote(Trim(StockTable.lstAddress.ListItems(StockTable.lstAddressIndex).Text))
     gCnn.Execute TempSQL
     TempSQL = VarInitData.DisplaySQLVal(1)
     VarInitData.LoadData lstAddress, TempSQL
    Else
     MsgBox "货物单据为空,操作失败", , VarInitData.SysPrompt
    End If

    
  Case 6
  'If lstAddress.SelectedItem Is Nothing Then Exit Sub
  'VarCrystal.DispalySellReport lstAddress.SelectedItem.Text, 15

 ' rptReport.Show
 End Select
 VarInitData.DealListView lstAddress, lstAddressIndex
End Sub



Private Sub Command3_Click(Index As Integer)
 Dim TempSQL As String
 Dim TempCount As Long, TempMoney As Long
 Dim TempMoney2 As Long, TemplstCount As Long
 Dim i As Long, j As Long, TempFindIndex As Long
 Dim TempRS As MYSQL_RS, MyItems As ListItems
 Dim GoodsPriceMoney As Double
 Select Case Index
  Case 0 '增加新的记录"
  ' If lblBillNum.Caption <> "" Then
    AddRow10.Show 1
  ' End If
  Case 1 '删除记录
   If lstBillDocu.ListItems.Count > 0 And lstBillDocuIndex > 0 Then
    If MsgBox("确定删除这条记录吗?", vbOKCancel, VarInitData.SysPrompt) = vbOK Then
     lstBillDocu.ListItems.Remove lstBillDocuIndex
     OrgRS.DeleteKeyRS lstBillDocuIndex
     With MaintainPartBill
      TemplstCount = .lstBillDocu.ListItems.Count
      .lblGItemCount = TemplstCount
      TempCount = 0
      TempMoney = 0
      For i = 1 To TemplstCount
       TempCount = TempCount + Val(.lstBillDocu.ListItems(i).SubItems(3))
       TempMoney = TempMoney + Val(.lstBillDocu.ListItems(i).SubItems(6))
      Next i
      .lblGCount = TempCount
      .lblGMoney = TempMoney
     End With
    End If
   End If
  Case 2 '保存
   
   If lstBillDocu.ListItems.Count > 0 And lstBillDocuIndex > 0 Then
    If lblProvide = "" Then
     MsgBox "工作单号不能为空", , VarInitData.SysPrompt
     Exit Sub
    End If
    TempCount = lstBillDocu.ListItems.Count
    Set MyItems = lstBillDocu.ListItems
    For i = 1 To TempCount
     If VarInitData.DrawReduceFrStore(MyItems(i), False) = False Then
      If Val(MyItems(i).Text) >= 0 Then
       MsgBox "领用的货品在库存没有,操作失败", , VarInitData.SysPrompt
       Exit Sub
      Else
       MsgBox "库存中无此货物,入库失败", , VarInitData.SysPrompt
      End If
     End If
    Next i
   SaveToDrawBill
   VarOption = 0
    TempSQL = "select * from maintainpartbill2" '& " 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
     For i = 1 To TempCount
     ' If Val(MyItems(i).SubItems(3)) >= 0 Then
       VarInitData.DrawReduceFrStore MyItems(i), True, GoodsPriceMoney
     ' Else
     ' VarInitData.DrawSaveToStore MyItems(i), True, GoodsPriceMoney
    '  End If
       SaveToDrawBillDocu TempRS, lstBillDocu, i, GoodsPriceMoney
     Next i
     .CloseRecordset
     .ReleaseMemory
     Set TempRS = Nothing
    End With
   End If
   
   Frame2.Enabled = False
   BillStateBS = 0
   For i = 0 To 3
    Command3(i).Visible = False
   Next i
   For i = 0 To 5
    Command1(i).Visible = True
   Next i
   SSStock.TabEnabled(0) = True
   SSStock.Tab = 0
  Case 3
   VarOption = 0
   Frame2.Enabled = False
   BillStateBS = 0
   For i = 0 To 3
    Command3(i).Visible = False
   Next i
   For i = 0 To 5
    Command1(i).Visible = True
   Next i
   SSStock.TabEnabled(0) = True
   SSStock.Tab = 0
   OrgRS.Clear
   VarInitData.LoadData lstBillDocu, VarInitData.DisplaySQLVal(39)

 End Select
 VarInitData.DealListView lstBillDocu, lstBillDocuIndex

End Sub

Private Sub Form_Activate()
    VarInitData.DealListView lstAddress, lstAddressIndex

End Sub

Private Sub Form_Load()
  Dim i As Integer
  Dim TempSQL As String
  
    VarInitData.InitBSE BSE1
    Frame2.Visible = False
    Frame2.Enabled = False
    lstBillDocu.Visible = False
    lstAddress.Visible = True
    For i = 0 To 3
     Command3(i).Visible = False
    Next i
    Command1(2).Enabled = False
    Command1(5).Enabled = False
    VarInitData.LoadData lstAddress, VarInitData.DisplaySQLVal(38)
    Set OrgRS = New ChangeHistory
    
    TempSQL = "Select name From workertable "
    VarInitData.LoadData cmbPrincipal, TempSQL, 1
    VarInitData.LoadData cmbCheckMan, TempSQL, 1

End Sub


Private Sub Form_Resize()
 If Me.ScaleHeight > 0 And Me.ScaleWidth > 0 Then
  frameInfo.left = Me.ScaleLeft
  frameInfo.top = Me.ScaleTop
  frameInfo.Width = Me.ScaleWidth
  SSStock.top = frameInfo.top + frameInfo.Height
  SSStock.left = Me.ScaleLeft + 70
  SSStock.Width = Me.ScaleWidth - 140
  SSStock.Height = Me.ScaleHeight - frameInfo.Height - 50    'Screen.Height - 2650
  lstAddress.top = 450
  lstAddress.left = 70
  lstAddress.Width = SSStock.Width - 140
  lstAddress.Height = SSStock.Height - 550
  Frame2.left = 70
  Frame2.top = 450
  Frame2.Width = SSStock.Width - 140
  lstBillDocu.top = Frame2.top + Frame2.Height
  lstBillDocu.left = 70
  lstBillDocu.Width = SSStock.Width - 140
  lstBillDocu.Height = SSStock.Height - Frame2.Height - 550
 End If
End Sub


Private Sub Form_Unload(Cancel As Integer)
 If BSE1.EngineStarted Then BSE1.EndSubClassing

End Sub




Private Sub lstAddress_DblClick()
    If lstAddress.SelectedItem Is Nothing Then Exit Sub
   ' LoadRecord Val(lstAddress.SelectedItem.Text)
End Sub








Private Sub lstAddress_ItemClick(ByVal Item As MSComctlLib.ListItem)
'Dim templong As Long
'Stop
lstAddressIndex = Item.Index
'templong = Item.Text
End Sub

Private Sub lstBillDocu_DblClick()
If BillStateBS > 0 Then
  If lstBillDocu.SelectedItem Is Nothing Then Exit Sub
   ModifyBS = True
   lstBillDocuIndex = lstBillDocu.SelectedItem.Index
   AddRow10.Show 1
 End If
End Sub

Private Sub lstBillDocu_ItemClick(ByVal Item As MSComctlLib.ListItem)
 lstBillDocuIndex = Item.Index
 
End Sub

Private Sub Option1_Click(Index As Integer)
 VarOption = Index + 1
End Sub

Private Sub Picture1_Click()
 MeetCarBillFind.Show 1
 
End Sub

Private Sub SSStock_Click(PreviousTab As Integer)
 Dim TempSQL As String
 Dim TempStr As String
 Dim TempRS As MYSQL_RS
 Dim TempBillType As Integer
 Dim i As Integer
 If PreviousTab <> 0 Then
  For i = 0 To 5
   Command1(i).Visible = True
  Next i
  For i = 0 To 3
   Command3(i).Visible = False
  Next i
  Frame2.Visible = False
  lstBillDocu.Visible = False
  lstAddress.Visible = True
  VarInitData.DealListView lstAddress, lstAddressIndex
 Else
  Frame2.Visible = True
  If BillStateBS > 0 Then
   Frame2.Enabled = True
  Else
   Frame2.Enabled = False
  End If
  lstBillDocu.Visible = True
  lstAddress.Visible = False
  If BillStateBS <> 1 Then ClearFrame2
  If lstAddress.ListItems.Count > 0 Then
   TempStr = lstAddress.ListItems(lstAddressIndex).Text
  Else
   TempStr = ""
  End If
   If BillStateBS = 1 Then TempStr = ""
  TempSQL = VarInitData.DisplaySQLVal(39) & " Where drawbillnum = " & Quote(TempStr)
  VarInitData.LoadData2 lstBillDocu, TempSQL, OrgRS
  VarInitData.DealListView lstBillDocu, lstBillDocuIndex
  If lstAddressIndex > 0 And lstAddress.ListItems.Count > 0 Then
   If BillStateBS <> 1 Then
    With lstAddress.ListItems(lstAddressIndex)
      MaintainPartBill.lblBillNum = .Text
      MaintainPartBill.lblProvide = .SubItems(1)
      DTDate.Value = .SubItems(2)
      MaintainPartBill.cmbPrincipal = .SubItems(3)
      MaintainPartBill.cmbCheckMan = .SubItems(4)
      MaintainPartBill.lblGCount = .SubItems(5)
      MaintainPartBill.lblGMoney = .SubItems(6)
      MaintainPartBill.lblGItemCount = .SubItems(7)
      MaintainPartBill.lblOperateMan = .SubItems(8)
      lblCarno = .SubItems(9)
    End With
   End If
  End If

 End If
End Sub
Private Sub ClearFrame2()
 With MaintainPartBill
  .lblBillNum = ""
  .lblProvide = ""
  .lblGCount = "0"
  .lblGItemCount = "0"
  .lblOperateMan = ""
  .lblGMoney = "0"
  .cmbCheckMan = ""
  .cmbPrincipal = ""
  .DTDate = Date
 End With
End Sub

Private Sub SaveToDrawBill()
 Dim TempRS As MYSQL_RS
 Dim i As Integer
 Dim TempSQL As String
    Set TempRS = New MYSQL_RS
    If BillStateBS = 2 Then
     TempSQL = "Select * From maintainpartbill Where drawbillnum = " & Quote(Trim(lblBillNum))
    ElseIf BillStateBS = 1 Then
     TempSQL = "Select * From counttable where countname =" & Quote("维修领用单")
     TempRS.OpenRs TempSQL, gCnn
     TempRS.Fields("count").Value = CLng(TempRS.Fields("count").Value) + 1
     lblBillNum = VarInitData.DealVarNo(CStr(TempRS.Fields("count")), 6, "L")
     TempRS.Update
     TempRS.CloseRecordset
     TempRS.ReleaseMemory
     Set TempRS = Nothing
     
     Set TempRS = New MYSQL_RS
     TempSQL = "Select * From maintainpartbill" 'Where AKey = " & Val(txtAKey)
    End If
    TempRS.OpenRs TempSQL, gCnn
    If BillStateBS <> 2 Then
     If TempRS.RecordCount > 0 Then
      TempRS.MoveLast
      TempRS.MoveNext
     End If
    End If
    With TempRS
     If .EOF Then .AddNew
     .Fields("drawbillnum") = lblBillNum.Caption
     .Fields("workbillnum") = MaintainPartBill.lblProvide
     .Fields("drawdate") = MaintainPartBill.DTDate
     .Fields("drawman") = MaintainPartBill.cmbPrincipal
     .Fields("sendgoodsman") = MaintainPartBill.cmbCheckMan
     .Fields("gcount") = Val(MaintainPartBill.lblGCount)
     .Fields("gmoney") = Val(MaintainPartBill.lblGMoney)
     .Fields("gitemcount") = Val(MaintainPartBill.lblGItemCount)
     .Fields("operateman") = MaintainPartBill.lblOperateMan
     .Fields("carno") = MaintainPartBill.lblCarno
     .Update
     .CloseRecordset
     .ReleaseMemory
    End With
    Set TempRS = Nothing
    TempSQL = VarInitData.DisplaySQLVal(38)
    VarInitData.LoadData lstAddress, TempSQL
End Sub
Private Sub SaveToDrawBillDocu(VarRS As MYSQL_RS, lstBillDocu As ListView, ByVal i As Long, ByVal GoodsPriceMoney As Double)
  With VarRS
   If .EOF Then .AddNew
   .Fields("drawbillnum") = lblBillNum
   .Fields("goodscoding") = lstBillDocu.ListItems(i).Text
   .Fields("goodsname") = lstBillDocu.ListItems(i).SubItems(1)
   .Fields("goodsstandard") = lstBillDocu.ListItems(i).SubItems(2)
   .Fields("goodscount") = lstBillDocu.ListItems(i).SubItems(3)
   .Fields("unit") = lstBillDocu.ListItems(i).SubItems(4)
   .Fields("money") = lstBillDocu.ListItems(i).SubItems(5)
   .Fields("sellprice") = lstBillDocu.ListItems(i).SubItems(6)
   .Fields("brand") = lstBillDocu.ListItems(i).SubItems(7)
   .Fields("goodssort") = lstBillDocu.ListItems(i).SubItems(8)
   .Fields("producehere") = lstBillDocu.ListItems(i).SubItems(9)
   .Fields("replacecoding") = lstBillDocu.ListItems(i).SubItems(10)
   .Fields("goodspricemoney") = GoodsPriceMoney
   .Update
  End With
  
End Sub


⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?