jxcstat.frm

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

Private Sub Command1_Click(Index As Integer)
Select Case Index
 Case 4
  DealJXC
 Case 5
End Select
End Sub

Private Sub DTPicker1_CallbackKeyDown(Index As Integer, ByVal KeyCode As Integer, ByVal Shift As Integer, ByVal CallbackField As String, CallbackDate As Date)
 DealJXC
End Sub

Private Sub Form_Load()
 Dim i As Integer
 VarInitData.InitBSE BSE1
 SearchGoodsKey = "goodscoding"
 For i = 0 To 1
  DTPicker1(i) = Date
 Next i
 InitListView
 DealJXC
End Sub

Private Sub Form_Resize()
 If Me.ScaleHeight > 0 And Me.ScaleWidth > 0 Then
  frameInfo(0).Width = Me.ScaleWidth
  lstBillDocu.top = frameInfo(0).top + frameInfo(0).Height + 50
  lstBillDocu.left = 100
  lstBillDocu.Width = Me.ScaleWidth - 200
  lstBillDocu.Height = Me.ScaleHeight - frameInfo(0).Height - frameInfo(1).Height
  frameInfo(1).top = lstBillDocu.top + lstBillDocu.Height
  frameInfo(1).Width = Me.ScaleWidth
 End If
End Sub
Private Sub InitListView()
 lstBillDocu.ColumnHeaders.Clear
 With lstBillDocu.ColumnHeaders
  .Add , , "货物编码"
  .Add , , "上期结存数"
  .Add , , "上期结存额"
  .Add , , "本期进数"
  .Add , , "本期销数"
  .Add , , "本期盈亏数"
  .Add , , "本期进额"
  .Add , , "本期销额"
  .Add , , "本期盈亏额"
  .Add , , "本期结余数"
  .Add , , "本期结余额"
  .Add , , "货品名称"
  .Add , , "规格型号"
  .Add , , "商标品牌"
  .Add , , "货品分类"
  .Add , , "产地"
  .Add , , "单位"
 End With
 LoadStockData "goodscoding", 0
End Sub
Private Sub LoadSellData(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, BackGoodsBS As Boolean, FindBS As Long
 Dim VarItem As ListItems
 
  If VarIndex <= 3 Then
   TempSQLTable = 20
   TempKey = "goodscount"
   TempKey2 = "realsellmoney"
   TempKey3 = "goodspricemoney"
  End If
  If VarIndex = -1 Then
   TempSQL = VarInitData.DisplaySQLVal(19) & "Where selldate < " & Quote(DTPicker1(0).Value) '& " and selldate <= " & Quote(DTPicker1(1).Value)
  Else
   TempSQL = VarInitData.DisplaySQLVal(19) & "Where selldate >= " & Quote(DTPicker1(0).Value) & " and selldate <= " & 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
   Set VarItem = lstBillDocu.ListItems
   i = VarItem.Count
  End If
  
  If i > 0 And K > 0 Then
   For j = 1 To i
    TempSQL = "Select * From sellhistory2 " & " Where " & SearchGoodsKey & " = " & Quote(VarItem(j).Text)  '& " and stockdate >= " & Quote(DTPicker1(0).Value) & " and stockdate <= " & Quote(DTPicker1(1).Value)
    Set TempRS = New MYSQL_RS
    TempRS.OpenRs TempSQL, gCnn
   If TempRS.RecordCount > 0 Then
    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
      BackGoodsBS = False
      VarFind = .FindNext("billnum", TempBillStr(m))
      If VarFind > -1 Then
       TempCount2 = .Fields(TempKey)
       TempMoney2 = .Fields(TempKey2)
       TempMoney3 = .Fields(TempKey3)
       If Mid(TempBillStr(m), 2, 1) = "T" Then BackGoodsBS = True
       If BackGoodsBS = True Then
        TempCount2 = -TempCount2
        TempMoney2 = -TempMoney2
        TempMoney3 = -TempMoney3
       End If
       TempCount = TempCount + TempCount2
       TempMoney = TempMoney + TempMoney2
       TempMoney4 = TempMoney4 + TempMoney3
       FindGoodsBS = True
      Else
       Exit Do
      End If
     Loop
    Next m
     .CloseRecordset
     .ReleaseMemory
    End With
    Set TempRS = Nothing
    
    If FindGoodsBS = True Then
     FindBS = FindCoding(TempText)
     TempIndex = FindBS
     If TempIndex > 0 Then
      With lstBillDocu.ListItems(TempIndex)
       If VarIndex = -1 Then
        VarJXC(TempIndex).SellCount = TempCount
        VarJXC(TempIndex).SellMoney = TempMoney
        VarJXC(TempIndex).GoodsPriceMoney = -TempMoney4
       Else
        .SubItems(4) = TempCount
        .SubItems(7) = VarFunction.DefFormat(TempMoney)
        VarJXC(TempIndex).GoodsPriceMoney = -TempMoney4
       End If
      End With
     End If
    End If
   End If
   Next j
  End If
End Sub
Private Sub LoadMaintainData(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
 Dim TempText As String, BackGoodsBS As Boolean, FindBS As Long
 Dim VarItem As ListItems
 
  If VarIndex <= 3 Then
   TempKey = "goodscount"
   TempKey2 = "money"
  End If
  If VarIndex = -1 Then
   TempSQL = VarInitData.DisplaySQLVal(38) & "Where drawdate < " & Quote(DTPicker1(0).Value) '& " and drawdate <= " & Quote(DTPicker1(1).Value)
  Else
   TempSQL = VarInitData.DisplaySQLVal(38) & "Where drawdate >= " & Quote(DTPicker1(0).Value) & " and drawdate <= " & 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("drawbillnum")
    .MoveNext
   Loop
   .CloseRecordset
   .ReleaseMemory
  End With
  Set TempRS = Nothing
  If K > 0 Then
   Set VarItem = lstBillDocu.ListItems
   i = VarItem.Count
  End If
  
  If i > 0 And K > 0 Then
   For j = 1 To i
    TempSQL = "Select * From maintainpartbill2 " & " Where " & SearchGoodsKey & " = " & Quote(VarItem(j).Text)  '& " and stockdate >= " & Quote(DTPicker1(0).Value) & " and stockdate <= " & Quote(DTPicker1(1).Value)
    Set TempRS = New MYSQL_RS
    TempRS.OpenRs TempSQL, gCnn
   If TempRS.RecordCount > 0 Then
    With TempRS
     TempText = .Fields(SearchGoodsKey)
     TempCount = 0
     TempMoney = 0
     TempMoney4 = 0
     FindGoodsBS = False
    For m = 1 To K
     .MoveFirst
     .MovePrevious
     Do Until .EOF
      BackGoodsBS = False
      VarFind = .FindNext("drawbillnum", TempBillStr(m))
      If VarFind > -1 Then
       TempCount2 = .Fields(TempKey)
       TempMoney2 = Val(.Fields(TempKey2))
       If TempCount2 >= 0 Then
       ' TempMoney2 = .Fields(TempKey2)
        TempMoney3 = .Fields("goodspricemoney")
       Else
        TempMoney3 = -.Fields("goodspricemoney")
       End If
       TempCount = TempCount + TempCount2
       TempMoney = TempMoney + TempMoney2
       TempMoney4 = TempMoney4 + TempMoney3
       FindGoodsBS = True
      Else
       Exit Do
      End If
     Loop
    Next m
     .CloseRecordset
     .ReleaseMemory
    End With
    Set TempRS = Nothing
    
    If FindGoodsBS = True Then
     FindBS = FindCoding(TempText)
     TempIndex = FindBS
     If TempIndex > 0 Then
      With lstBillDocu.ListItems(TempIndex)
       If VarIndex = -1 Then
        VarJXC(TempIndex).SellCount = VarJXC(TempIndex).SellCount + TempCount
        VarJXC(TempIndex).SellMoney = VarJXC(TempIndex).SellMoney + TempMoney
        VarJXC(TempIndex).GoodsPriceMoney = VarJXC(TempIndex).GoodsPriceMoney - TempMoney4
       Else
        .SubItems(4) = Val(.SubItems(4)) + TempCount
        .SubItems(7) = VarFunction.DefFormat(Val(.SubItems(7)) + TempMoney)
        VarJXC(TempIndex).GoodsPriceMoney = VarJXC(TempIndex).GoodsPriceMoney - TempMoney4
       End If
      End With
     End If
    End If
   End If
   Next j
  End If
End Sub
Private Sub LoadProfitData(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
 Dim TempIndex As Long
 Dim TempSQLTable As Integer, TempKey As String, TempKey2 As String
 Dim VarFind As Long, FindGoodsBS As Boolean
 Dim TempText As String, BackGoodsBS As Boolean, FindBS As Long
 Dim VarItem As ListItems
 
  TempSQLTable = 32
  TempKey = "profitlosscount"
  TempKey2 = "costunit"
  If VarIndex = -1 Then
   TempSQL = VarInitData.DisplaySQLVal(31) & "Where date < " & Quote(DTPicker1(0).Value) '& " and selldate <= " & Quote(DTPicker1(1).Value)
  Else
   TempSQL = VarInitData.DisplaySQLVal(31) & "Where date >= " & Quote(DTPicker1(0).Value) & " and date <= " & 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
    K = K + 1
    TempBillStr(K) = .Fields("billnum")
    .MoveNext
   Loop
   .CloseRecordset
   .ReleaseMemory
  End With
  Set TempRS = Nothing
  If K > 0 Then
   Set VarItem = lstBillDocu.ListItems
   i = VarItem.Count
  End If
  
  If i > 0 And K > 0 Then
   For j = 1 To i
    TempSQL = VarInitData.DisplaySQLVal(TempSQLTable) & " Where " & SearchGoodsKey & " = " & Quote(VarItem(j).Text)  '& " and stockdate >= " & Quote(DTPicker1(0).Value) & " and stockdate <= " & Quote(DTPicker1(1).Value)
    Set TempRS = New MYSQL_RS
    TempRS.OpenRs TempSQL, gCnn
   If TempRS.RecordCount > 0 Then
    With TempRS
     TempText = .Fields(SearchGoodsKey)
     TempCount = 0
     TempMoney = 0
     TempMoney3 = 0
     FindGoodsBS = False
    For m = 1 To K
     .MoveFirst
     .MovePrevious
     Do Until .EOF
      BackGoodsBS = False
      VarFind = .FindNext("billnum", TempBillStr(m))
      If VarFind > -1 Then
       TempCount2 = .Fields(TempKey)
       TempMoney2 = .Fields(TempKey2)
       TempCount = TempCount + TempCount2
       TempMoney = TempMoney + TempMoney2 * TempCount2
       FindGoodsBS = True
      Else
       Exit Do
      End If
     Loop
    Next m
     .CloseRecordset
     .ReleaseMemory
    End With
    Set TempRS = Nothing
    
    If FindGoodsBS = True Then
     FindBS = FindCoding(TempText)
     TempIndex = FindBS
     If TempIndex > 0 Then
      With lstBillDocu.ListItems(TempIndex)
       If VarIndex = -1 Then
        VarJXC(TempIndex).ProfitLossCount = TempCount
        VarJXC(TempIndex).ProfitLossMoney = TempMoney
       Else
        .SubItems(5) = TempCount
        .SubItems(8) = VarFunction.DefFormat(TempMoney)
       End If
      End With
     End If
    End If
   End If
   Next j
  End If
End Sub