sellstat.frm

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

FRM
795 行
字号
12
End Sub

Private Sub Form_Load()
 Dim i As Integer
 On Error GoTo eh

 VarInitData.InitBSE BSE1
 For i = 0 To 1
  DTPicker1(i) = Date
 Next i
 Combo1.AddItem "货品编码"
 Combo1.AddItem "货品分类"
 Combo1.AddItem "品牌商标"
 Combo1.AddItem "货品产地"
 Combo1.AddItem "购货单位"
 Combo1.AddItem "销售日期"
 Combo1.AddItem "销售单"
 Combo1.AddItem "发票类型"
 Combo1.AddItem "支付方式"
 SearchGoodsKey = "goodscoding"
 InitListView
 Combo1.ListIndex = 0
' LoadGData
 'LoadData SearchGoodsKey, Combo1.ListIndex
 Exit Sub
eh:
 MsgBox "出错误了1"
End Sub

Private Sub Form_Resize()
 'On Error Resume Next
 On Error GoTo eh
 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
 Exit Sub
eh:
 MsgBox "出错误了2"
End Sub
Private Sub InitListView()
 lstBillDocu.ColumnHeaders.Clear
 With lstBillDocu.ColumnHeaders
  .Add , , "统计对象"
  .Add , , "货物数量"
  .Add , , "销售额"
  .Add , , "成本额"
  .Add , , "毛利"
  .Add , , "比率（%）"
 End With
End Sub
Private Sub LoadData(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
  lstBillDocu.ListItems.Clear
  If VarIndex <= 3 Then
   TempSQLTable = 20
   TempKey = "goodscount"
   TempKey2 = "realsellmoney"
  Else
   TempSQLTable = 19
   TempKey = "gcount"
   TempKey2 = "grealsellmoney"
  End If
  TempSQL = VarInitData.DisplaySQLVal(19) & "Where selldate >= " & Quote(DTPicker1(0).Value) & " and selldate <= " & Quote(DTPicker1(1).Value)
  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(20) '& "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
   For j = 1 To i
    If VarIndex <= 3 Then
     TempSQL = "Select * From sellhistory2 " & " Where " & SearchGoodsKey & " = " & Quote(TempStr(j))
    Else
     TempSQL = VarInitData.DisplaySQLVal(TempSQLTable) & " Where " & SearchGoodsKey & " = " & Quote(TempStr(j)) '& " and stockdate >= " & Quote(DTPicker1(0).Value) & " and stockdate <= " & Quote(DTPicker1(1).Value)
    End If
    Set TempRS = New MYSQL_RS
    TempRS.OpenRs TempSQL, gCnn
    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)
       If Mid(TempBillStr(m), 2, 1) = "T" Then BackGoodsBS = True
       If BackGoodsBS = True Then
        TempCount2 = -TempCount2
        TempMoney2 = -TempMoney2
       End If
       TempCount = TempCount + TempCount2
       TempMoney = TempMoney + TempMoney2
       FindGoodsBS = True
       If VarIndex <= 3 Then
        If BackGoodsBS = False Then
         TempMoney3 = TempMoney3 + Val(.Fields("goodspricemoney"))
        Else
         TempMoney3 = TempMoney3 - Val(.Fields("goodspricemoney"))
        End If
       Else
        TempSQL = "Select * From sellhistory2 " & " Where goodscoding = " & Quote(.Fields("goodscoding"))
        Set TempRS2 = New MYSQL_RS
        TempRS2.OpenRs TempSQL, gCnn
        With TempRS
         Do Until .EOF
         If BackGoodsBS = False Then
          TempMoney3 = TempMoney3 + Val(.Fields("goodspricemoney"))
         Else
          TempMoney3 = TempMoney3 - Val(.Fields("goodspricemoney"))
         End If
          .MoveNext
         Loop
         .CloseRecordset
         .ReleaseMemory
        End With
        Set TempRS2 = Nothing
       End If

       
      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
     With lstBillDocu.ListItems(TempIndex)
      .Text = TempText
      .SubItems(1) = TempCount
      .SubItems(2) = VarFunction.DefFormat(TempMoney)
      .SubItems(3) = Format(TempMoney3, VarInitData.MoneyFormat)
      .SubItems(4) = Format(TempMoney - TempMoney3, VarInitData.MoneyFormat)
      If TempMoney <> 0 Then
       .SubItems(5) = Format((TempMoney - TempMoney3) / TempMoney * 100, VarInitData.MoneyFormat)
      Else
       .SubItems(5) = VarInitData.MoneyFormat
      End If
     End With
    End If
   Next j
  End If
  Label1(0) = 0
  Label1(1) = Format("0", VarInitData.MoneyFormat)
  Label1(2) = Format("0", VarInitData.MoneyFormat)
  Label1(3) = Format("0", VarInitData.MoneyFormat)

  TempCount = lstBillDocu.ListItems.Count
  If TempCount > 0 Then
   For i = 1 To TempCount
    With lstBillDocu.ListItems(i)
     Label1(0) = Val(Label1(0)) + Val(.SubItems(1))
     Label1(1) = VarFunction.DefFormat(Val(Label1(1)) + Val(.SubItems(3)))
     Label1(2) = VarFunction.DefFormat(Val(Label1(2)) + Val(.SubItems(2)))
     Label1(3) = VarFunction.DefFormat(Val(Label1(3)) + Val(.SubItems(4)))
    End With
   Next i
  End If
  VarInitData.lstSort lstBillDocu
End Sub


Private Sub Form_Unload(Cancel As Integer)
 If BSE1.EngineStarted Then BSE1.EndSubClassing
End Sub
Private Sub LoadData2Bak(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
  lstBillDocu.ListItems.Clear
  If VarIndex <= 3 Then
   TempSQLTable = 20
   TempKey = "goodscount"
   TempKey2 = "gmoney"
  Else
   TempSQLTable = 38
   TempKey = "gcount"
   TempKey2 = "gmoney"
  End If
  TempSQL = VarInitData.DisplaySQLVal(38) & "Where drawdate >= " & Quote(DTPicker1(0).Value) & " and drawdate <= " & Quote(DTPicker1(1).Value)
  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
   If VarIndex <= 3 Then
    TempSQL = VarInitData.DisplaySQLVal(20) '& "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
   For j = 1 To i
    If VarIndex <= 3 Then
     TempSQL = "Select * From maintainpartbill2 " & " Where " & SearchGoodsKey & " = " & Quote(TempStr(j))
    Else
     TempSQL = VarInitData.DisplaySQLVal(TempSQLTable) & " Where " & SearchGoodsKey & " = " & Quote(TempStr(j)) '& " and stockdate >= " & Quote(DTPicker1(0).Value) & " and stockdate <= " & Quote(DTPicker1(1).Value)
    End If
    Set TempRS = New MYSQL_RS
    TempRS.OpenRs TempSQL, gCnn
    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("drawbillnum", TempBillStr(m))
      If VarFind > -1 Then
       TempCount2 = .Fields(TempKey)
       TempMoney2 = .Fields(TempKey2)
       If Mid(TempBillStr(m), 2, 1) = "T" Then BackGoodsBS = True
       If BackGoodsBS = True Then
        TempCount2 = -TempCount2
        TempMoney2 = -TempMoney2
       End If
       TempCount = TempCount + TempCount2
       TempMoney = TempMoney + TempMoney2
       FindGoodsBS = True
       
       TempSQL = VarInitData.DisplaySQLVal(10) & " Where goodscoding = " & Quote(.Fields("goodscoding"))
       Set TempRS2 = New MYSQL_RS
       TempRS2.OpenRs TempSQL, gCnn
       With TempRS2
        Do Until .EOF
        If BackGoodsBS = False Then
         TempMoney3 = TempMoney3 + Val(.Fields("goodspricemoney"))
        Else
         TempMoney3 = TempMoney3 - Val(.Fields("goodspricemoney"))
        End If
         .MoveNext
        Loop
        .CloseRecordset
        .ReleaseMemory
       End With
       Set TempRS2 = Nothing
       
      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
     With lstBillDocu.ListItems(TempIndex)
      .Text = TempText
      .SubItems(1) = TempCount
      .SubItems(2) = VarFunction.DefFormat(TempMoney)
      .SubItems(3) = Format(TempMoney3, VarInitData.MoneyFormat)
      .SubItems(4) = Format(TempMoney - TempMoney3, VarInitData.MoneyFormat)
      If TempMoney <> 0 Then
       .SubItems(5) = Format((TempMoney - TempMoney3) / TempMoney * 100, VarInitData.MoneyFormat)
      Else
       .SubItems(5) = VarInitData.MoneyFormat
      End If
     End With
    End If
   Next j
  End If
  Label1(0) = 0
  Label1(1) = Format("0", VarInitData.MoneyFormat)
  Label1(2) = Format("0", VarInitData.MoneyFormat)
  Label1(3) = Format("0", VarInitData.MoneyFormat)

  TempCount = lstBillDocu.ListItems.Count
  If TempCount > 0 Then
   For i = 1 To TempCount
    With lstBillDocu.ListItems(i)
     Label1(0) = Val(Label1(0)) + Val(.SubItems(1))
     Label1(1) = VarFunction.DefFormat(Val(Label1(1)) + Val(.SubItems(3)))
     Label1(2) = VarFunction.DefFormat(Val(Label1(2)) + Val(.SubItems(2)))
     Label1(3) = VarFunction.DefFormat(Val(Label1(3)) + Val(.SubItems(4)))
    End With
   Next i
  End If
End Sub
12

sellstat.frm - 源码说明

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

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

⌨️ 快捷键说明

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