initdata.cls

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

    Set TempRS = Nothing
 End Sub
 Public Sub SaveToBillStore(rs As MYSQL_RS, ByVal StrBillNum As String, Optional GoodsPriceMoney As Double = 0)
 
    On Error Resume Next
     
    Dim TempRS As New MYSQL_RS
    Dim TempSQL As String
    Dim TempBillNum As Long
    
    Set TempRS = New MYSQL_RS
     
   
    TempSQL = "Select * From stockhistory2 " '& " Where goodscoding = " & Quote(rs.Fields("goodscoding").Value)
    TempRS.OpenRs TempSQL, gCnn
       
    With TempRS
      .MoveLast
      .MoveNext
      .AddNew

      .Fields("billnum").Value = StrBillNum  'rs.Fields("billnum")
      .Fields("goodscoding") = rs.Fields("goodscoding")
      .Fields("goodsname") = rs.Fields("goodsname")
      .Fields("goodsstandard") = rs.Fields("goodsstandard")
      .Fields("goodsprice") = rs.Fields("goodsprice")
      .Fields("goodscount") = rs.Fields("goodscount")
      .Fields("money") = rs.Fields("money")
      .Fields("sellprice") = rs.Fields("sellprice")
      .Fields("changeprice") = rs.Fields("changeprice")
      .Fields("goodspos") = rs.Fields("goodspos")
      .Fields("goodssort") = rs.Fields("goodssort")
      .Fields("brand") = rs.Fields("brand")
      .Fields("producehere") = rs.Fields("producehere")
      .Fields("orgprice") = rs.Fields("orgprice")
      .Fields("unit") = rs.Fields("unit")
   '   If GoodsPriceMoney > 0 Then .Fields("goodspricemoney") = GoodsPriceMoney
     ' .Fields("replacecoding") = ""
      .Update
      .CloseRecordset
      .ReleaseMemory
    End With
    Set TempRS = Nothing
 End Sub
Public Sub CheckSendBackGoods(ctllstAddress As ctlListViewGraphical)
 Dim i As Long
 Dim Lcount As Long
 Dim MyItim As ListItems
 Dim TempBS As Boolean
 ctllstAddress.ClearAllColors
 Lcount = ctllstAddress.lv.ListItems.Count
 Set MyItim = ctllstAddress.lv.ListItems
 If Lcount > 0 Then
 For i = 1 To Lcount
  With MyItim(i)
   If Mid(.Text, 2, 1) = "T" Then
    ctllstAddress.SetBackRowColor i, &HFF33
    TempBS = True
   End If
  End With
 Next i
 End If
 If TempBS = False Then ctllstAddress.SetBackRowColor 0, &HFFFFFF
End Sub
Public Sub SaveToSellData(rs As MYSQL_RS, Optional ByVal GoodsPriceMoney As Double, Optional ByVal StrBillNum As String)
 
    On Error Resume Next
     
    Dim TempRS As New MYSQL_RS
    Dim TempSQL As String
    Set TempRS = New MYSQL_RS
    TempSQL = "Select * From sellhistory2 " '& " Where goodscoding = " & Quote(rs.Fields("goodscoding").Value)
    TempRS.OpenRs TempSQL, gCnn
       
    With TempRS
     If .RecordCount > 0 Then
      .MoveLast
      .MoveNext
     End If
      .AddNew
      .Fields("billnum") = StrBillNum 'rs.Fields("billnum")
      .Fields("goodscoding") = rs.Fields("goodscoding")
      .Fields("goodsname") = rs.Fields("goodsname")
      .Fields("goodsstandard") = rs.Fields("goodsstandard")
      .Fields("goodscount") = rs.Fields("goodscount")
      .Fields("sellprice") = rs.Fields("sellprice")
      .Fields("goodspos") = rs.Fields("goodspos")
      .Fields("goodssort") = rs.Fields("goodssort")
      .Fields("brand") = rs.Fields("brand")
      .Fields("producehere") = rs.Fields("producehere")
      .Fields("unit") = rs.Fields("unit")
      .Fields("sellmoney") = rs.Fields("sellmoney")
      .Fields("realsellmoney") = rs.Fields("realsellmoney")
      .Fields("realsellprice") = rs.Fields("realsellprice")
      .Fields("goodspricemoney") = GoodsPriceMoney 'rs.Fields("goodsprice")
     ' .Fields("replacecoding") = ""
      .Update
      .CloseRecordset
      .ReleaseMemory
    End With
    Set TempRS = Nothing
 End Sub
Public Sub SaveToSellBill(rs As MYSQL_RS, ByVal TableNum As Integer, ByVal StrBillNum As String)
 
    On Error Resume Next
     
    Dim TempRS As New MYSQL_RS
    Dim TempSQL As String
    Set TempRS = New MYSQL_RS
    TempSQL = DisplaySQLVal(TableNum) '& " Where billnum = " & Quote(rs.Fields("billnum").Value)
    TempRS.OpenRs TempSQL, gCnn
    With TempRS
      .MoveLast
      .MoveNext
      .AddNew
     .Fields("billnum") = StrBillNum 'rs.Fields("billnum")
     .Fields("buygoodsunit") = rs.Fields("buygoodsunit")
     .Fields("selldate") = rs.Fields("selldate")
     .Fields("payway") = rs.Fields("payway")
     .Fields("principal") = rs.Fields("principal")
     .Fields("sendgoodsman") = rs.Fields("sendgoodsman")
     .Fields("gcount") = rs.Fields("gcount")
     .Fields("gsellmoney") = rs.Fields("gsellmoney")
     .Fields("grealsellmoney") = rs.Fields("grealsellmoney")
     .Fields("gitemcount") = rs.Fields("gitemcount")
     .Fields("operateman") = rs.Fields("operateman")
     .Fields("invoicetype") = rs.Fields("invoicetype")
     .Fields("invoiceno") = rs.Fields("invoiceno")
     .Fields("billtype") = rs.Fields("billtype")
     .Fields("lookthrough") = Date
    ' .Fields("replacecoding") = ""
      .Update
      .CloseRecordset
      .ReleaseMemory
    End With
    Set TempRS = Nothing
 End Sub
 Public Function DealFrStore(rs As MYSQL_RS, Optional ByVal CheckSuccBS As Boolean = False) As Boolean
 
    On Error Resume Next
     
    Dim TempRS As New MYSQL_RS
    Dim TempSQL As String
    Dim TempVar As Long
    
    Set TempRS = New MYSQL_RS
    
    TempSQL = VarInitData.DisplaySQLVal(10) & " Where goodscoding = " & Quote(rs.Fields("goodscoding").Value) ' _
    '& " or goodscoding like " & Quote(rs.Fields("goodscoding").Value & "_%") & ")" _
    '& " and goodsprice = " & Quote(rs.Fields("costunit"))  '& " and lastdate = " & VarDate
    TempRS.OpenRs TempSQL, gCnn
    With TempRS
     If .RecordCount > 0 Then
       TempVar = CLng(.Fields("goodscount")) + CLng(rs.Fields("profitlosscount"))
       DealFrStore = True
       If CheckSuccBS = True Then
        If .Fields("goodsprice") <> rs.Fields("goodsprice") Then
         .Fields("goodsprice") = (Val(.Fields("goodsprice") * .Fields("goodscount")) + Val(rs.Fields("goodsprice") * rs.Fields("profitlosscount"))) / TempVar
        End If
         .Fields("goodscount") = TempVar
       End If
    Else
      DealFrStore = False
    End If
     If CheckSuccBS = True Then
      .Fields("lastdate") = Date
      .Update
     End If
      .CloseRecordset
      .ReleaseMemory
    End With
    Set TempRS = Nothing
 End Function

 Public Sub SaveToDealBill(rs As MYSQL_RS, ByVal StrBillNum As String)
 
    On Error Resume Next
     
    Dim TempRS As New MYSQL_RS
    Dim TempSQL As String
    Set TempRS = New MYSQL_RS
    TempSQL = DisplaySQLVal(31) '& " Where goodscoding = " & Quote(rs.Fields("goodscoding").Value)
    TempRS.OpenRs TempSQL, gCnn
       
    With TempRS
      .MoveLast
      .MoveNext
      .AddNew
      .Fields("billnum") = StrBillNum 'rs.Fields("billnum")
      .Fields("date") = rs.Fields("date")
      .Fields("lookthroughman") = rs.Fields("lookthroughman")
      .Fields("profitlosscount") = rs.Fields("profitlosscount")
      .Fields("profitlossmoney") = rs.Fields("profitlossmoney")
      .Fields("gitemcount") = rs.Fields("gitemcount")
      .Fields("operateman") = rs.Fields("operateman")
      .Update
      .CloseRecordset
      .ReleaseMemory
    End With
    Set TempRS = Nothing
 End Sub
 Public Sub SaveToDealBillStore(rs As MYSQL_RS, ByVal StrBillNum As String)
 
    On Error Resume Next
     
    Dim TempRS As New MYSQL_RS
    Dim TempSQL As String
    Set TempRS = New MYSQL_RS
    TempSQL = DisplaySQLVal(32) '& " Where goodscoding = " & Quote(rs.Fields("goodscoding").Value)
    TempRS.OpenRs TempSQL, gCnn
       
    With TempRS
      .MoveLast
      .MoveNext
      .AddNew
      .Fields("billnum") = StrBillNum 'rs.Fields("billnum")
      .Fields("goodscoding") = rs.Fields("goodscoding")
      .Fields("goodsname") = rs.Fields("goodsname")
      .Fields("goodsstandard") = rs.Fields("goodsstandard")
      .Fields("orgcount") = rs.Fields("orgcount")
      .Fields("profitlosscount") = rs.Fields("profitlosscount")
      .Fields("unit") = rs.Fields("unit")
      .Fields("orgcost") = rs.Fields("orgcost")
      .Fields("costunit") = rs.Fields("costunit")
      .Fields("orggoodspos") = rs.Fields("orggoodspos")
      .Fields("goodspos") = rs.Fields("goodspos")
      .Fields("brand") = rs.Fields("brand")
      .Fields("goodssort") = rs.Fields("goodssort")
      .Fields("producehere") = rs.Fields("producehere")
      .Fields("sellprice") = rs.Fields("sellprice")
      .Fields("modifyreason") = rs.Fields("modifyreason")
      .Update
      .CloseRecordset
      .ReleaseMemory
    End With
    Set TempRS = Nothing
 End Sub
Public Sub InitializePulllDownMenu()
   ' Call frm_Main.ctrl_SkinableForm.LoadSkin(frm_Main)
        
   ' Call frmMain.ctrl_PullDownMenu.AddItem("维护")
   ' Call frmMain.ctrl_PullDownMenu.AddItem("数据")
   ' Call frmMain.ctrl_PullDownMenu.AddItem("进货")
  '  Call frmMain.ctrl_PullDownMenu.AddItem("库存")
  '  Call frmMain.ctrl_PullDownMenu.AddItem("销售")
  '  Call frmMain.ctrl_PullDownMenu.AddItem("维护")
   ' Call frmMain.ctrl_PullDownMenu.AddItem("统计")
  '  Call frmMain.ctrl_PullDownMenu.AddItem("帐务")
End Sub
Public Function SureWeekDay() As String
 Dim TempVar As Long
 Dim TempStr As String
  TempVar = Weekday(Date)
  Select Case TempVar
   Case 2
    TempStr = "一"
   Case 3
    TempStr = "二"
   Case 4
    TempStr = "三"
   Case 5
    TempStr = "四"
   Case 6
    TempStr = "五"
   Case 7
    TempStr = "六"
   Case 1
    TempStr = "日"
  End Select
  SureWeekDay = TempStr
End Function
Public Sub InitString()
 SysPrompt = "系统提示"
 OKSymbol = "√"
 MoneyFormat = "0.00"
 EachPageRSCount = 10
End Sub
Public Sub lstSort(lstBillDocu As ListView)
 If lstBillDocu.ListItems.Count > 1 Then
  lstBillDocu.SortKey = 0
  lstBillDocu.SortOrder = 0
  lstBillDocu.Sorted = True
  lstBillDocu.Sorted = False
 End If
End Sub