searchgoods14.frm

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

            Name            =   "宋体"
            Size            =   10.5
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00800000&
         Height          =   495
         Index           =   5
         Left            =   240
         TabIndex        =   9
         Top             =   2520
         Width           =   1455
      End
      Begin VB.Label Label2 
         Caption         =   "到"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Index           =   3
         Left            =   3240
         TabIndex        =   26
         Top             =   3600
         Width           =   255
      End
      Begin VB.Label Label2 
         Caption         =   "到"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Index           =   2
         Left            =   3240
         TabIndex        =   25
         Top             =   3240
         Width           =   255
      End
      Begin VB.Label Label2 
         Caption         =   "今天之前                天"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Index           =   1
         Left            =   1680
         TabIndex        =   23
         Top             =   3960
         Width           =   2775
      End
      Begin VB.Label Label2 
         Caption         =   "参考销售天数："
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Index           =   0
         Left            =   240
         TabIndex        =   22
         Top             =   3960
         Width           =   1575
      End
      Begin VB.Label Label1 
         Caption         =   "请输入搜索货物的条件："
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   375
         Left            =   240
         TabIndex        =   15
         Top             =   360
         Width           =   2535
      End
   End
   Begin VB.CommandButton Command1 
      Caption         =   "确 定"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   1800
      TabIndex        =   1
      Top             =   5400
      Width           =   1095
   End
   Begin VB.CommandButton Command2 
      Caption         =   "放 弃"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   3720
      TabIndex        =   0
      Top             =   5400
      Width           =   1095
   End
   Begin BSE_Engine.BSE BSE1 
      Left            =   1560
      Top             =   5280
      _ExtentX        =   6588
      _ExtentY        =   1085
   End
End
Attribute VB_Name = "SearchGoods14"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub Combo1_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
 Combo1(Index).Text = ""
End Sub

Private Sub Combo1_KeyUp(Index As Integer, KeyCode As Integer, Shift As Integer)
 Combo1(Index).Text = ""
End Sub

Private Sub Command1_Click()
 Dim Filters As String
 Dim TempSQL As String, TypeBS As Integer
    GoodsReference.lstBillDocu.ListItems.Clear
    If Val(Text1(7)) <= 0 Then
     MsgBox "之前多少天必须>0", , VarInitData.SysPrompt
     Exit Sub
    End If
    If Check1(0).Value = 1 Then
        'Filter by name
        If Filters <> "" Then Filters = Filters & " and " Else Filters = Filters & " Where "
        Filters = Filters & "goodscoding = " & Quote(Text1(0).Text)
    End If
        
   If Check1(1).Value = 1 Then
        'Filter by name
        If Filters <> "" Then Filters = Filters & " and " Else Filters = Filters & " Where "
        Filters = Filters & "goodsname = " & Quote(Text1(1).Text)
   End If
   If Check1(2).Value = 1 Then
        'Filter by name
        If Filters <> "" Then Filters = Filters & " and " Else Filters = Filters & " Where "
        Filters = Filters & "goodsstandard = " & Quote(Text1(2).Text)
   End If
   If Check1(3).Value = 1 Then
        'Filter by name
        If Filters <> "" Then Filters = Filters & " and " Else Filters = Filters & " Where "
        Filters = Filters & "goodssort = " & Quote(Combo1(0).Text)
   End If
   If Check1(4).Value = 1 Then
        'Filter by name
        If Filters <> "" Then Filters = Filters & " and " Else Filters = Filters & " Where "
        Filters = Filters & "brand = " & Quote(Combo1(1).Text)
   End If
   If Check1(5).Value = 1 Then
        'Filter by name
        If Filters <> "" Then Filters = Filters & " and " Else Filters = Filters & " Where "
        Filters = Filters & "producehere = " & Quote(Combo1(2).Text)
   End If
   If Check1(6).Value = 1 Then
    TypeBS = 1
   End If
   If Check1(7).Value = 1 Then
    If TypeBS = 1 Then
     TypeBS = 3
    Else
     TypeBS = 2
    End If
   End If
   SureGoods TypeBS, Filters
   
End Sub

Private Sub Command2_Click()
 Unload Me
End Sub

Private Sub Form_Load()
 Dim i As Integer
 Dim TempSQL As String
 VarInitData.InitBSE BSE1, 0
 Text1(7) = 180
 For i = 2 To 4
  TempSQL = VarInitData.DisplayDynSQLVal(VarInitData.SureNameFrIndex(i))
  VarInitData.LoadData Combo1(i - 2), TempSQL, 1
 Next i
End Sub

Private Sub Form_Unload(Cancel As Integer)
 If BSE1.EngineStarted Then BSE1.EndSubClassing

End Sub
Private Sub SureGoods(ByVal TypeBS As Integer, ByVal Filters As String)
 Dim TempSQL As String
 Dim TempRS As MYSQL_RS
 Dim TempRS2 As MYSQL_RS
 Dim VarFind As Long, i As Long
 Dim TempStr() As Variant
 Dim j As Long, TempIndex As Long, BillCount As Long
 Dim TempCount As Long, TempCount2 As Long, TempMonth As Long
 Dim OKBS As Boolean
 Dim TempPos As Integer
    
    TempSQL = VarInitData.DisplaySQLVal(10) & Filters
    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("goodscoding"), TempStr, .RecordCount) = False Then
       TempPos = InStr(1, .Fields("goodscoding"), "_", vbTextCompare)
       If TempPos <= 0 Then
        i = i + 1
        TempStr(i) = .Fields("goodscoding")
       End If
      End If
      .MoveNext
     Loop
     .CloseRecordset
     .ReleaseMemory
    End With
    Set TempRS = Nothing
    If i > 0 Then
     For j = 1 To i
      TempCount = 0
      TempSQL = VarInitData.DisplaySQLVal(10) & " Where goodscoding = " & Quote(TempStr(j)) & " or goodscoding like " & Quote(TempStr(j) & "_%")
      Set TempRS = New MYSQL_RS
      TempRS.OpenRs TempSQL, gCnn
      With TempRS
       
       Do Until .EOF
        TempCount = TempCount + .Fields("goodscount")
        .MoveNext
       Loop
       
        TempSQL = VarInitData.DisplaySQLVal(20) & " Where goodscoding = " & Quote(TempStr(j))
        Set TempRS2 = New MYSQL_RS
        TempRS2.OpenRs TempSQL, gCnn
        With TempRS2
         TempCount2 = 0
         Do Until .EOF
          If Mid(.Fields("billnum"), 2, 1) <> "T" Then
           TempCount2 = TempCount2 + .Fields("goodscount")
          Else
           TempCount2 = TempCount2 - .Fields("goodscount")
          End If
          .MoveNext
         Loop
         .CloseRecordset
         .ReleaseMemory
        End With
        Set TempRS2 = Nothing
        TempMonth = Val(Text1(7)) \ 30
        If TempMonth <> Val(Text1(7)) / 30 Then
         TempMonth = TempMonth + 1
        End If
        TempCount2 = TempCount2 \ TempMonth
        OKBS = False
        Select Case TypeBS
         Case 1
          If TempCount2 >= Val(Text1(3)) And TempCount2 <= Val(Text1(4)) Then
           OKBS = True
          End If
         Case 2
          If TempCount >= Val(Text1(5)) And TempCount <= Val(Text1(6)) Then
           OKBS = True
          End If
         Case 3
          If (TempCount2 >= Val(Text1(3)) And TempCount2 <= Val(Text1(4))) And (TempCount >= Val(Text1(5)) And TempCount <= Val(Text1(6))) Then
           OKBS = True
          End If
        End Select
        If OKBS = True Or TypeBS = 0 Then
         GoodsReference.lstBillDocu.ListItems.Add
         TempIndex = GoodsReference.lstBillDocu.ListItems.Count
         .MoveFirst
         With GoodsReference.lstBillDocu.ListItems(TempIndex)
          .Text = TempRS.Fields("goodscoding").Value
          .SubItems(1) = TempRS.Fields("goodsname")
          .SubItems(2) = TempRS.Fields("goodsstandard")
          .SubItems(3) = TempCount
          .SubItems(4) = TempCount2
          .SubItems(5) = TempRS.Fields("unit")
          .SubItems(6) = TempRS.Fields("brand")
          .SubItems(7) = TempRS.Fields("goodssort")
          .SubItems(8) = TempRS.Fields("producehere")
          .SubItems(9) = TempRS.Fields("replacecoding")
          .SubItems(10) = TempRS.Fields("orgprice")
          .SubItems(11) = TempRS.Fields("sellprice")
         End With
        End If
       .CloseRecordset
       .ReleaseMemory
      End With
      Set TempRS = Nothing
    Next j
   End If
   Unload Me
End Sub