jxcstat.frm

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

FRM
1,141 行
字号
123
Private Sub LoadStockData(ByVal SearchGoodsKey As String, ByVal VarIndex As Integer)
 Dim TempSQL As String
 Dim TempRS As MYSQL_RS, TempStr() As Variant, TempBillStr() As String
 Dim TempRS2 As MYSQL_RS
 Dim i As Long, TempCount As Long, TempMoney As Double, j As Long, K As Long, m As Long, TempCount2 As Long, TempMoney2 As Double, TempMoney3 As Double, TempMoney4 As Double
 Dim TempIndex As Long
 Dim TempSQLTable As Integer, TempKey As String, TempKey2 As String, TempKey3 As String
 Dim VarFind As Long, FindGoodsBS As Boolean
 Dim TempText As String, TempText2(0 To 5) As String, TempPrice As Double
 
  If VarIndex <= 3 Then
   TempSQLTable = 14
   TempKey = "goodscount"
   TempKey2 = "money"
  Else
   TempSQLTable = 13
   TempKey = "gcount"
   TempKey2 = "gmoney"
  End If
  If VarIndex = -1 Then
   TempSQL = VarInitData.DisplaySQLVal(13) & "Where stockdate < " & Quote(DTPicker1(0).Value) '& " and selldate <= " & Quote(DTPicker1(1).Value)
  Else
   TempSQL = VarInitData.DisplaySQLVal(13) & "Where stockdate >= " & Quote(DTPicker1(0).Value) & " and stockdate <= " & Quote(DTPicker1(1).Value)
  End If
  Set TempRS = New MYSQL_RS
  TempRS.OpenRs TempSQL, gCnn
  With TempRS
   If .RecordCount > 0 Then
    ReDim TempStr(1 To .RecordCount)
    ReDim TempBillStr(1 To .RecordCount)
   End If
   i = 0
   K = 0
   Do Until .EOF
    If VarIndex > 3 Then
     If VarFunction.FindSameVariant(.Fields(SearchGoodsKey), TempStr, .RecordCount) = False Then
      i = i + 1
      TempStr(i) = .Fields(SearchGoodsKey)
     End If
    End If
    K = K + 1
    TempBillStr(K) = .Fields("billnum")
    .MoveNext
   Loop
   .CloseRecordset
   .ReleaseMemory
  End With
  Set TempRS = Nothing
  If K > 0 Then
   If VarIndex <= 3 Then
    TempSQL = VarInitData.DisplaySQLVal(14) '& "Where stockdate >= " & Quote(DTPicker1(0).Value) & " and stockdate <= " & Quote(DTPicker1(1).Value)
    Set TempRS = New MYSQL_RS
    TempRS.OpenRs TempSQL, gCnn
    With TempRS
     If .RecordCount > 0 Then
      ReDim TempStr(1 To .RecordCount)
     End If
     i = 0
     Do Until .EOF
      If VarFunction.FindSameVariant(.Fields(SearchGoodsKey), TempStr, .RecordCount) = False Then
       i = i + 1
       TempStr(i) = .Fields(SearchGoodsKey)
      End If
      .MoveNext
     Loop
     .CloseRecordset
     .ReleaseMemory
    End With
    Set TempRS = Nothing
   End If
  End If
  
  If i > 0 And K > 0 Then
   ReDim VarJXC(1 To i)
   ReDim StockGoodsPrice(1 To i)
   For j = 1 To i
    TempSQL = VarInitData.DisplaySQLVal(TempSQLTable) & " Where " & SearchGoodsKey & " = " & Quote(TempStr(j)) '& " and stockdate >= " & Quote(DTPicker1(0).Value) & " and stockdate <= " & Quote(DTPicker1(1).Value)
    Set TempRS = New MYSQL_RS
    TempRS.OpenRs TempSQL, gCnn
    With TempRS
     TempText = .Fields(SearchGoodsKey)
     TempCount = 0
     TempMoney = 0
     TempMoney3 = 0
    ' TempMoney4 = 0
     FindGoodsBS = False
    For m = 1 To K
     .MoveFirst
     .MovePrevious
     Do Until .EOF
      VarFind = .FindNext("billnum", TempBillStr(m))
      If VarFind > -1 Then
       TempCount2 = .Fields(TempKey)
       TempMoney2 = .Fields(TempKey2)
       If Mid(TempBillStr(m), 2, 1) = "T" Then
        TempCount2 = -TempCount2
        'TempMoney3 = .Fields("goodspricemoney") - TempMoney2
        TempMoney2 = -TempMoney2
       End If
       TempCount = TempCount + TempCount2
       TempMoney = TempMoney + TempMoney2
       'TempMoney4 = TempMoney4 + TempMoney3
       If FindGoodsBS = False Then
        'TempPrice = .Fields("goodsprice")
        TempText2(0) = .Fields("goodsname")
        TempText2(1) = .Fields("goodsstandard")
        TempText2(2) = .Fields("brand")
        TempText2(3) = .Fields("goodssort")
        TempText2(4) = .Fields("producehere")
        TempText2(5) = .Fields("unit")
       End If
       FindGoodsBS = True
      Else
       Exit Do
      End If
     Loop
    Next m
     .CloseRecordset
     .ReleaseMemory
    End With
    Set TempRS = Nothing
    
    If FindGoodsBS = True Then
     lstBillDocu.ListItems.Add
     TempIndex = lstBillDocu.ListItems.Count
     'StockGoodsPrice(TempIndex) = TempPrice
     With lstBillDocu.ListItems(TempIndex)
      .Text = TempText
      For m = 0 To 5
       .SubItems(m + 11) = TempText2(m)
      Next m
      VarJXC(j).StockCount = TempCount
      VarJXC(j).StockMoney = TempMoney
      'VarJXC(j).GoodsPriceMoney = -TempMoney4
     End With
    End If
   Next j
  End If
End Sub
Private Sub LoadStockData2(ByVal SearchGoodsKey As String, ByVal VarIndex As Integer)
 Dim TempSQL As String
 Dim TempRS As MYSQL_RS, TempStr() As Variant, TempBillStr() As String
 Dim TempRS2 As MYSQL_RS
 Dim i As Long, TempCount As Long, TempMoney As Double, j As Long, K As Long, m As Long, TempCount2 As Long, TempMoney2 As Double, TempMoney3 As Double, TempMoney4 As Double
 Dim TempIndex As Long
 Dim TempSQLTable As Integer, TempKey As String, TempKey2 As String
 Dim VarFind As Long, FindGoodsBS As Boolean, FindBS As Long
 Dim TempText As String, TempText2(0 To 6) As String, TempPrice As Double
 
  If VarIndex <= 3 Then
   TempSQLTable = 14
   TempKey = "goodscount"
   TempKey2 = "money"
  End If
  If VarIndex = -1 Then
   TempSQL = VarInitData.DisplaySQLVal(13) & "Where stockdate < " & Quote(DTPicker1(0).Value) '& " and selldate <= " & Quote(DTPicker1(1).Value)
  Else
   TempSQL = VarInitData.DisplaySQLVal(13) & "Where stockdate >= " & Quote(DTPicker1(0).Value) & " and stockdate <= " & Quote(DTPicker1(1).Value)
  End If
  Set TempRS = New MYSQL_RS
  TempRS.OpenRs TempSQL, gCnn
  With TempRS
   If .RecordCount > 0 Then
    ReDim TempStr(1 To .RecordCount)
    ReDim TempBillStr(1 To .RecordCount)
   End If
   i = 0
   K = 0
   Do Until .EOF
    If VarIndex > 3 Then
     If VarFunction.FindSameVariant(.Fields(SearchGoodsKey), TempStr, .RecordCount) = False Then
      i = i + 1
      TempStr(i) = .Fields(SearchGoodsKey)
     End If
    End If
    K = K + 1
    TempBillStr(K) = .Fields("billnum")
    .MoveNext
   Loop
   .CloseRecordset
   .ReleaseMemory
  End With
  Set TempRS = Nothing
  If K > 0 Then
   If VarIndex <= 3 Then
    TempSQL = VarInitData.DisplaySQLVal(14) '& "Where stockdate >= " & Quote(DTPicker1(0).Value) & " and stockdate <= " & Quote(DTPicker1(1).Value)
    Set TempRS = New MYSQL_RS
    TempRS.OpenRs TempSQL, gCnn
    With TempRS
     If .RecordCount > 0 Then
      ReDim TempStr(1 To .RecordCount)
     End If
     i = 0
     Do Until .EOF
      If VarFunction.FindSameVariant(.Fields(SearchGoodsKey), TempStr, .RecordCount) = False Then
       i = i + 1
       TempStr(i) = .Fields(SearchGoodsKey)
      End If
      .MoveNext
     Loop
     .CloseRecordset
     .ReleaseMemory
    End With
    Set TempRS = Nothing
   End If
  End If
  
  If i > 0 And K > 0 Then
   ReDim VarJXC(1 To i + lstBillDocu.ListItems.Count)
   ReDim StockGoodsPrice(1 To i)
   For j = 1 To i
    TempSQL = VarInitData.DisplaySQLVal(TempSQLTable) & " Where " & SearchGoodsKey & " = " & Quote(TempStr(j)) '& " and stockdate >= " & Quote(DTPicker1(0).Value) & " and stockdate <= " & Quote(DTPicker1(1).Value)
    Set TempRS = New MYSQL_RS
    TempRS.OpenRs TempSQL, gCnn
    With TempRS
     TempText = .Fields(SearchGoodsKey)
     TempCount = 0
     TempMoney = 0
    ' TempMoney4 = 0
    ' TempMoney3 = 0
     FindGoodsBS = False
     FindBS = FindCoding(TempText)
    For m = 1 To K
     .MoveFirst
     .MovePrevious
     Do Until .EOF
      VarFind = .FindNext("billnum", TempBillStr(m))
      If VarFind > -1 Then
       TempCount2 = .Fields(TempKey)
       TempMoney2 = .Fields(TempKey2)
       If Mid(TempBillStr(m), 2, 1) = "T" Then
        TempCount2 = -TempCount2
        'TempMoney3 = .Fields("goodspricemoney") - TempMoney2
        TempMoney2 = -TempMoney2
       End If
       TempCount = TempCount + TempCount2
       TempMoney = TempMoney + TempMoney2
      ' TempMoney4 = TempMoney4 + TempMoney3

       If FindGoodsBS = False And FindBS <= 0 Then
        'TempPrice = .Fields("goodsprice")
        TempText2(0) = TempText
        TempText2(1) = .Fields("goodsname")
        TempText2(2) = .Fields("goodsstandard")
        TempText2(3) = .Fields("brand")
        TempText2(4) = .Fields("goodssort")
        TempText2(5) = .Fields("producehere")
        TempText2(6) = .Fields("unit")
       End If
       FindGoodsBS = True
      Else
       Exit Do
      End If
     Loop
    Next m
     .CloseRecordset
     .ReleaseMemory
    End With
    Set TempRS = Nothing
    
    If FindGoodsBS = True Then
     If FindBS <= 0 Then
      lstBillDocu.ListItems.Add
      TempIndex = lstBillDocu.ListItems.Count
    '  StockGoodsPrice(TempIndex) = TempPrice
      With lstBillDocu.ListItems(TempIndex)
       .Text = TempText2(0)
       For m = 1 To 6
        .SubItems(m + 10) = TempText2(m)
       Next m
      End With
     Else
      TempIndex = FindBS
     End If
      With lstBillDocu.ListItems(TempIndex)
       .SubItems(3) = TempCount
       .SubItems(6) = VarFunction.DefFormat(TempMoney)
      ' VarJXC(TempIndex).GoodsPriceMoney = -TempMoney4
      End With
    End If
   Next j
  End If
End Sub



Private Sub Form_Unload(Cancel As Integer)
 If BSE1.EngineStarted Then BSE1.EndSubClassing
End Sub
Private Function FindCoding(ByVal GoodsCoding As String) As Long
 Dim TempCount As Long
 Dim m As Long
  TempCount = lstBillDocu.ListItems.Count
  FindCoding = 0
  If TempCount > 0 Then
   For m = 1 To TempCount
    With lstBillDocu.ListItems(m)
     If .Text = GoodsCoding Then
       FindCoding = m
       Exit Function
     End If
    End With
   Next m
  End If

End Function
Private Sub InitDateSQL()
 PreDateSQL = "Where selldate < " & Quote(DTPicker1(0).Value)
 CurrentDateSQL = "Where selldate < " & Quote(DTPicker1(0).Value) & " and selldate <= " & Quote(DTPicker1(1).Value)
End Sub
Private Sub DealPreValue()
 Dim i As Long
 Dim TempCount As Long
 TempCount = lstBillDocu.ListItems.Count
 If TempCount > 0 Then
  For i = 1 To TempCount
   With lstBillDocu.ListItems(i)
    .SubItems(1) = VarJXC(i).StockCount - VarJXC(i).SellCount + VarJXC(i).ProfitLossCount
    .SubItems(2) = VarJXC(i).StockMoney + VarJXC(i).GoodsPriceMoney 'VarFunction.DefFormat(Val(.SubItems(1)) * StockGoodsPrice(i)) '(VarJXC(i).StockMoney - VarJXC(i).SellMoney + VarJXC(i).ProfitLossMoney)
   End With
  Next i
 End If
End Sub
Private Sub DealCurrentValue()
 Dim i As Long
 Dim TempCount As Long
 TempCount = lstBillDocu.ListItems.Count
 If TempCount > 0 Then
  For i = 1 To TempCount
   With lstBillDocu.ListItems(i)
    .SubItems(9) = Val(.SubItems(1)) + Val(.SubItems(3)) - Val(.SubItems(4)) + Val(.SubItems(5))
    .SubItems(10) = VarFunction.DefFormat(Val(.SubItems(2)) + Val(.SubItems(6)) + VarJXC(i).GoodsPriceMoney) 'VarFunction.DefFormat(Val(.SubItems(2)) + Val(.SubItems(6)) - Val(.SubItems(7)) + Val(.SubItems(8)))
   End With
  Next i
 End If
End Sub
Private Sub DealAssembleValue()
 Dim i As Long
 Dim TempCount As Long
 Dim TempMoneys() As Double
 TempCount = lstBillDocu.ListItems.Count
  For i = 0 To 4
   Label1(i) = ""
  Next i

 ReDim TempMoneys(0 To 4)
 If TempCount > 0 Then
  For i = 1 To TempCount
   With lstBillDocu.ListItems(i)
    TempMoneys(0) = TempMoneys(0) + Val(.SubItems(6))
    TempMoneys(1) = TempMoneys(1) + Val(.SubItems(7))
    TempMoneys(2) = TempMoneys(2) + Val(.SubItems(8))
    TempMoneys(3) = TempMoneys(3) + Val(.SubItems(1))
    TempMoneys(4) = TempMoneys(4) + Val(.SubItems(2))
   End With
  Next i
  For i = 0 To 4
   Label1(i) = VarFunction.DefFormat(TempMoneys(i))
  Next i
 End If
End Sub
Private Sub DealJXC()
 lstBillDocu.ListItems.Clear
 LoadStockData SearchGoodsKey, -1
 LoadSellData SearchGoodsKey, -1
 LoadMaintainData SearchGoodsKey, -1
 LoadProfitData SearchGoodsKey, -1
 DealPreValue
 LoadStockData2 SearchGoodsKey, 0
 LoadSellData SearchGoodsKey, 0
 LoadMaintainData SearchGoodsKey, 0
 LoadProfitData SearchGoodsKey, 0
 DealCurrentValue
 DealAssembleValue
 VarInitData.lstSort lstBillDocu
End Sub
123

jxcstat.frm - 源码说明

本页面展示了「一个关于电脑管理汽车的软件」中的 jxcstat.frm 源码文件，采用 FRM 编程语言编写，共 1,141 行代码。您可以在线阅读完整代码内容，也可以返回资源详情页下载完整源码包进行本地学习和开发。

虫虫下载站收录了大量与电脑相关的技术资源，包括源代码、技术文档、电路图等，是电子工程师和嵌入式开发者的专业学习平台。

⌨️ 快捷键说明

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