storealarmstat.frm

来自「一个关于电脑管理汽车的软件」· FRM 代码 · 共 280 行

FRM
280
字号
VERSION 5.00
Begin VB.Form StoreAlarmStat 
   Caption         =   "库存警报"
   ClientHeight    =   8520
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   11025
   LinkTopic       =   "Form1"
   MDIChild        =   -1  'True
   ScaleHeight     =   8520
   ScaleWidth      =   11025
   Begin VB.Frame frameInfo 
      Height          =   855
      Index           =   1
      Left            =   0
      TabIndex        =   4
      Top             =   7680
      Width           =   11775
      Begin VB.Label Label1 
         Height          =   255
         Index           =   0
         Left            =   4200
         TabIndex        =   5
         Top             =   360
         Width           =   1695
      End
      Begin VB.Label Label10 
         Caption         =   "总数量:"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   12
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00800000&
         Height          =   375
         Index           =   2
         Left            =   3360
         TabIndex        =   6
         Top             =   360
         Width           =   975
      End
   End
   Begin VB.Frame frameInfo 
      Height          =   855
      Index           =   0
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   11775
      Begin VB.CommandButton Command1 
         Height          =   495
         Index           =   0
         Left            =   4920
         Picture         =   "StoreAlarmStat.frx":0000
         Style           =   1  'Graphical
         TabIndex        =   8
         ToolTipText     =   "货品资料"
         Top             =   240
         Width           =   495
      End
      Begin VB.CommandButton Command1 
         Height          =   495
         Index           =   5
         Left            =   6840
         Picture         =   "StoreAlarmStat.frx":014A
         Style           =   1  'Graphical
         TabIndex        =   2
         ToolTipText     =   "打印"
         Top             =   240
         Width           =   495
      End
      Begin VB.CommandButton Command1 
         Height          =   495
         Index           =   4
         Left            =   6240
         Picture         =   "StoreAlarmStat.frx":0294
         Style           =   1  'Graphical
         TabIndex        =   1
         ToolTipText     =   "刷新"
         Top             =   240
         Width           =   495
      End
      Begin VB.Label Label10 
         Caption         =   "库存警报"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   14.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00800000&
         Height          =   375
         Index           =   0
         Left            =   120
         TabIndex        =   3
         Top             =   360
         Width           =   1935
      End
   End
   Begin QCJXC.ctlListViewGraphical lstBillDocu 
      Height          =   6495
      Left            =   0
      TabIndex        =   7
      Top             =   840
      Width           =   9615
      _ExtentX        =   16960
      _ExtentY        =   11456
   End
End
Attribute VB_Name = "StoreAlarmStat"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private SearchGoodsKey As String

Private Sub Command1_Click(Index As Integer)
Select Case Index
 Case 0
  CallGoodsData.Show 1
 Case 4
  lstBillDocu.lv.Sorted = False
  LoadData
  DealGCount
 Case 5
  
End Select
End Sub

Private Sub Form_Load()
 On Error GoTo eh
 Dim i As Integer
 InitListView
 LoadData
 DealGCount
 Exit Sub
eh:
 MsgBox "出错误了1"
End Sub

Private Sub Form_Resize()
 On Error Resume Next
 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()
 On Error GoTo eh
 lstBillDocu.lv.ColumnHeaders.Clear
 With lstBillDocu.lv.ColumnHeaders
  .Add , , "货物编码"
  .Add , , "货物数量"
  .Add , , "最高库存"
  .Add , , "最低库存"
 End With
 Exit Sub
eh:
  MsgBox "出错误了3"

End Sub
Private Sub LoadData()
 On Error GoTo eh
 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, TempCount2 As Long, TempCount3 As Long
 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
 Dim TempPos As Long, TempColor As Long
  lstBillDocu.lv.ListItems.Clear
  lstBillDocu.ClearAllColors
  lstBillDocu.SetBackRowColor 0, &HFFFFFF
  TempSQL = VarInitData.DisplaySQLVal(10) '& "Where stockdate >= " & Quote(DTPicker1(0).Value) & " and stockdate <= " & Quote(DTPicker1(1).Value)
  Set TempRS = New MYSQL_RS
  TempRS.OpenRs TempSQL, gCnn
  With TempRS
   Do Until .EOF
   
    TempPos = InStr(1, .Fields("goodscoding"), "_", vbTextCompare)
    If TempPos <= 0 Then
     TempKey = .Fields("goodscoding")
     TempCount = 0
     TempSQL = VarInitData.DisplaySQLVal(10) & "Where goodscoding = " & Quote(TempKey)
     Set TempRS2 = New MYSQL_RS
     TempRS2.OpenRs TempSQL, gCnn
     With TempRS2
      Do Until .EOF
       TempCount = TempCount + .Fields("goodscount")
       .MoveNext
      Loop
      .CloseRecordset
      .ReleaseMemory
     End With
     Set TempRS2 = Nothing
        
     TempSQL = VarInitData.DisplaySQLVal(3) & "Where goodscoding = " & Quote(TempKey)
     Set TempRS2 = New MYSQL_RS
     TempRS2.OpenRs TempSQL, gCnn
     With TempRS2
      If .RecordCount > 0 Then
       TempCount2 = .Fields("maxstore")
       TempCount3 = .Fields("minstore")
      End If
      .CloseRecordset
      .ReleaseMemory
     End With
     Set TempRS2 = Nothing
     
     If TempCount > TempCount2 Or TempCount < TempCount3 Then
      If TempCount2 <> 0 Or TempCount3 <> 0 Then
       lstBillDocu.lv.ListItems.Add
       TempIndex = lstBillDocu.lv.ListItems.Count
       With lstBillDocu.lv.ListItems(TempIndex)
        .Text = TempKey
        .SubItems(1) = TempCount
        .SubItems(2) = TempCount2
        .SubItems(3) = TempCount3
       End With
       If TempCount > TempCount2 Then
        TempColor = &HFF
       Else
        TempColor = &HFF00
       End If
       lstBillDocu.SetBackRowColor TempIndex, TempColor
      End If
     End If
     
    End If
    .MoveNext
  Loop
  .CloseRecordset
  .ReleaseMemory
 End With
 Set TempRS = Nothing
 VarInitData.lstSort lstBillDocu.lv
 Exit Sub
eh:
  MsgBox "出错误了4"

End Sub
Private Sub DealGCount()
 On Error GoTo eh
 Dim TempCount As Long, TempCount2 As Long
 Dim i As Long
 TempCount = lstBillDocu.lv.ListItems.Count
 If TempCount > 0 Then
  For i = 1 To TempCount
   With lstBillDocu.lv.ListItems(i)
    TempCount2 = TempCount2 + Val(.SubItems(1))
    Label1(0) = TempCount2
   End With
  Next i
 Else
  Label1(0) = 0
 End If
 Exit Sub
eh:
   MsgBox "出错误了5"

End Sub


⌨️ 快捷键说明

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