quotebill.frm

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

    For i = 0 To 3
     Command3(i).Visible = False
    Next i
    VarInitData.LoadData lstAddress, VarInitData.DisplaySQLVal(27)
    Set OrgRS = New ChangeHistory
    
    cmbInvoiceType.AddItem ""
    cmbInvoiceType.AddItem "普通发票"
    cmbInvoiceType.AddItem "增值税票"
    
    TempSQL = VarInitData.DisplayDynSQLVal(VarInitData.SureNameFrIndex(6))
    VarInitData.LoadData CmbPayWay, TempSQL, 1
    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
   AddRow5.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 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 6
   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(28) & " Where billnum = " & 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)
      QuoteBillTable.lblBillNum = .Text
      QuoteBillTable.lblProvide = .SubItems(1)
      DTDate.Value = .SubItems(2)
      QuoteBillTable.CmbPayWay = .SubItems(3)
      QuoteBillTable.cmbPrincipal = .SubItems(4)
      QuoteBillTable.cmbCheckMan = .SubItems(5)
      QuoteBillTable.lblGCount = .SubItems(6)
      QuoteBillTable.lblGMoney = .SubItems(7)
      QuoteBillTable.lblGMoney2 = .SubItems(8)
      QuoteBillTable.lblGItemCount = .SubItems(9)
      QuoteBillTable.lblOperateMan = .SubItems(11)
      'Set TempRS = New MYSQL_RS
      'SQL = "Select * From quotebilltable Where billnum = " & Quote(Trim(.Text))
      'TempRS.OpenRs SQL, gCnn
      QuoteBillTable.cmbInvoiceType = .SubItems(12) 'TempRS.Fields("invoicetype").Value
      QuoteBillTable.texInvoiceNo = .SubItems(13) 'TempRS.Fields("invoiceno").Value
      Text1.Text = .SubItems(10)
      TempBillType = Val(.SubItems(14)) 'TempRS.Fields("billtype").Value
      If TempBillType = 1 Then
       QuoteBillTable.Option1(0).Value = True
      ElseIf TempBillType = 2 Then
       QuoteBillTable.Option1(1).Value = True
      End If
  '    TempRS.CloseRecordset
   '   Set TempRS = Nothing
    End With
   End If
  End If

 End If
End Sub
Private Sub ClearFrame2()
 With QuoteBillTable
  .lblBillNum = ""
  .lblProvide = ""
  .lblGCount = "0"
  .lblGItemCount = "0"
  .lblOperateMan = ""
  .lblGMoney = "0"
  .cmbCheckMan = ""
  .cmbInvoiceType = ""
  .texInvoiceNo = ""
  .CmbPayWay = ""
  .cmbPrincipal = ""
  .DTDate = Date
  .Option1(0).Value = False
  .Option1(1).Value = False
  VarOption = 0
 End With
End Sub

Private Sub SaveToSellBill()
 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 quotebilltable Where billnum = " & 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, "BJ")
     TempRS.Update
     TempRS.CloseRecordset
     TempRS.ReleaseMemory
     Set TempRS = Nothing
     
     Set TempRS = New MYSQL_RS
     TempSQL = "Select * From quotebilltable" '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("billnum") = lblBillNum.Caption
     .Fields("askpriceunit") = QuoteBillTable.lblProvide
     .Fields("quotedate") = QuoteBillTable.DTDate
     .Fields("payway") = QuoteBillTable.CmbPayWay
     .Fields("principal") = QuoteBillTable.cmbPrincipal
     .Fields("sendgoodsman") = QuoteBillTable.cmbCheckMan
     .Fields("gcount") = Val(QuoteBillTable.lblGCount)
     .Fields("gsellmoney") = Val(QuoteBillTable.lblGMoney)
     .Fields("grealsellmoney") = Val(QuoteBillTable.lblGMoney2)
     .Fields("gitemcount") = Val(QuoteBillTable.lblGItemCount)
     .Fields("operateman") = QuoteBillTable.lblOperateMan
     .Fields("invoicetype") = QuoteBillTable.cmbInvoiceType
     .Fields("invoiceno") = QuoteBillTable.texInvoiceNo
     .Fields("billtype") = VarOption
     .Fields("billfavour") = Text1
     .Update
     .CloseRecordset
     .ReleaseMemory
    End With
    Set TempRS = Nothing
    TempSQL = VarInitData.DisplaySQLVal(27)
    VarInitData.LoadData lstAddress, TempSQL
End Sub
Private Sub SaveToSellBillDocu(VarRS As MYSQL_RS, lstBillDocu As ListView, ByVal i As Long)
  With VarRS
   If .EOF Then .AddNew
   .Fields("billnum") = 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("sellmoney") = lstBillDocu.ListItems(i).SubItems(5)
   .Fields("realsellmoney") = lstBillDocu.ListItems(i).SubItems(6)
   .Fields("goodspos") = lstBillDocu.ListItems(i).SubItems(7)
   .Fields("sellprice") = lstBillDocu.ListItems(i).SubItems(8)
   .Fields("realsellprice") = lstBillDocu.ListItems(i).SubItems(9)
   .Fields("brand") = lstBillDocu.ListItems(i).SubItems(10)
   .Fields("goodssort") = lstBillDocu.ListItems(i).SubItems(11)
   .Fields("producehere") = lstBillDocu.ListItems(i).SubItems(12)
   .Fields("replacecoding") = lstBillDocu.ListItems(i).SubItems(13)
 '  .Fields("orgprice") = lstBillDocu.ListItems(i).SubItems(14)
  ' .Fields("replacecoding") = ""
   .Update
  End With
  
End Sub
Private Sub ChangeToSellBill()
 Dim TempRS As MYSQL_RS
 Dim TempRS2 As MYSQL_RS
 Dim TempVar As Long
 Dim i As Integer
 Dim TempSQL As String, TempStr As String
 Dim StrBillNum As String
 If lstAddress.SelectedItem Is Nothing Then Exit Sub
  StrBillNum = lstAddress.ListItems(lstAddressIndex).Text
  Set TempRS = New MYSQL_RS
  TempSQL = "Select * From quotebilltable2 Where billnum = " & Quote(Trim(StrBillNum))
  TempRS.OpenRs TempSQL, gCnn
 If TempRS.RecordCount > 0 Then
  TempRS.CloseRecordset
  TempRS.ReleaseMemory
  Set TempRS = Nothing
  
  Set TempRS = New MYSQL_RS
  TempSQL = "Select * From quotebilltable Where billnum = " & Quote(Trim(StrBillNum))
  TempRS.OpenRs TempSQL, gCnn
  
  Set TempRS2 = New MYSQL_RS
  TempSQL = "Select * From counttable where countname =" & Quote("销售单号")
  TempRS2.OpenRs TempSQL, gCnn
  TempVar = TempRS2.Fields(1).Value
  TempRS2.Fields(1) = TempVar + 1
  TempRS2.Update
  TempStr = VarInitData.DealVarNo(CStr(TempVar), 6, "XS")
  TempRS2.CloseRecordset
  TempRS2.ReleaseMemory
  Set TempRS2 = Nothing
    
    Set TempRS2 = New MYSQL_RS
    TempSQL = "Select * From selltable" 'Where AKey = " & Val(txtAKey)
    TempRS2.OpenRs TempSQL, gCnn
    If TempRS2.RecordCount > 0 Then
      TempRS2.MoveLast
      TempRS2.MoveNext
    End If
    With TempRS2
     If .EOF Then .AddNew
     .Fields("billnum") = TempStr
     .Fields("buygoodsunit") = TempRS.Fields("askpriceunit")
     .Fields("selldate") = Date
     .Fields("payway") = TempRS.Fields("payway")
     .Fields("principal") = TempRS.Fields("principal")
     .Fields("sendgoodsman") = TempRS.Fields("sendgoodsman")
     .Fields("gcount") = TempRS.Fields("gcount")
     .Fields("gsellmoney") = TempRS.Fields("gsellmoney")
     .Fields("grealsellmoney") = TempRS.Fields("grealsellmoney")
     .Fields("gitemcount") = TempRS.Fields("gitemcount")
     .Fields("operateman") = TempRS.Fields("operateman")
     .Fields("invoicetype") = TempRS.Fields("invoicetype")
     .Fields("invoiceno") = TempRS.Fields("invoiceno")
     .Fields("billtype") = TempRS.Fields("billtype")
     .Fields("billfavour") = TempRS.Fields("billfavour")
     .Update
     .CloseRecordset
     .ReleaseMemory
    End With
    Set TempRS2 = Nothing
    TempRS.CloseRecordset
    TempRS.ReleaseMemory
    Set TempRS = Nothing
    ChangeToSellBillDocu TempStr
    TempSQL = "Delete From quotebilltable Where billnum = " & Quote(Trim(StrBillNum))
    gCnn.Execute TempSQL
    TempSQL = "Delete From quotebilltable2 Where billnum = " & Quote(Trim(StrBillNum))
    gCnn.Execute TempSQL
    TempSQL = VarInitData.DisplaySQLVal(15)
    VarInitData.LoadData SellTable.lstAddress, TempSQL
    
    VarInitData.LoadData lstAddress, VarInitData.DisplaySQLVal(27)
    VarInitData.LoadData lstBillDocu, VarInitData.DisplaySQLVal(28)
 Else
  MsgBox "货品编码不能为空", , VarInitData.SysPrompt
 End If
End Sub
Private Sub ChangeToSellBillDocu(ByVal BillNum As String)
 Dim TempRS As MYSQL_RS
 Dim TempRS2 As MYSQL_RS
 Dim TempVar As Long
 Dim i As Integer
 Dim TempSQL As String, TempStr As String
  Set TempRS = New MYSQL_RS
  TempSQL = "Select * From quotebilltable2 Where billnum = " & Quote(Trim(lstAddress.ListItems(lstAddressIndex).Text))
  TempRS.OpenRs TempSQL, gCnn
  
    Set TempRS2 = New MYSQL_RS
    TempSQL = "Select * From selltable2" 'Where AKey = " & Val(txtAKey)
    TempRS2.OpenRs TempSQL, gCnn
    If TempRS2.RecordCount > 0 Then
      TempRS2.MoveLast
      TempRS2.MoveNext
    End If
   Do Until TempRS.EOF
    With TempRS2
     If .EOF Then .AddNew
     .Fields("billnum") = BillNum
     .Fields("goodscoding") = TempRS.Fields("goodscoding")
     .Fields("goodsname") = TempRS.Fields("goodsname")
     .Fields("goodsstandard") = TempRS.Fields("goodsstandard")
     .Fields("goodscount") = TempRS.Fields("goodscount")
     .Fields("unit") = TempRS.Fields("unit")
     .Fields("sellmoney") = TempRS.Fields("sellmoney")
     .Fields("realsellmoney") = TempRS.Fields("realsellmoney")
     .Fields("goodspos") = TempRS.Fields("goodspos")
     .Fields("sellprice") = TempRS.Fields("sellprice")
     .Fields("realsellprice") = TempRS.Fields("realsellprice")
     .Fields("brand") = TempRS.Fields("brand")
     .Fields("goodssort") = TempRS.Fields("goodssort")
     .Fields("producehere") = TempRS.Fields("producehere")
     .Fields("replacecoding") = TempRS.Fields("replacecoding")
     .Update
    End With
    TempRS.MoveNext
   Loop
   
   TempRS2.CloseRecordset
   TempRS2.ReleaseMemory
   Set TempRS2 = Nothing
   TempRS.CloseRecordset
   TempRS.ReleaseMemory
   Set TempRS = Nothing

End Sub