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 + -
显示快捷键?