📄 frm_part_inorout.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomct2.ocx"
Begin VB.Form Frm_Part_InorOut
Caption = "出入库查询"
ClientHeight = 6435
ClientLeft = 60
ClientTop = 345
ClientWidth = 8775
Icon = "Frm_Part_InorOut.frx":0000
LinkTopic = "Form1"
MDIChild = -1 'True
ScaleHeight = 6435
ScaleWidth = 8775
WindowState = 2 'Maximized
Begin MSComctlLib.ListView ListView1
Height = 5775
Left = 0
TabIndex = 0
Top = 600
Width = 8655
_ExtentX = 15266
_ExtentY = 10186
View = 3
LabelEdit = 1
LabelWrap = -1 'True
HideSelection = -1 'True
FullRowSelect = -1 'True
GridLines = -1 'True
_Version = 393217
Icons = "ImageList1"
SmallIcons = "ImageList1"
ColHdrIcons = "ImageList1"
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
NumItems = 10
BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Text = "药品名"
Object.Width = 2540
EndProperty
BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 1
Text = "供应商"
Object.Width = 2540
EndProperty
BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 2
Text = "药种"
Object.Width = 2117
EndProperty
BeginProperty ColumnHeader(4) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 3
Text = "规格"
Object.Width = 2540
EndProperty
BeginProperty ColumnHeader(5) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 4
Text = "包装"
Object.Width = 2540
EndProperty
BeginProperty ColumnHeader(6) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 5
Text = "单位"
Object.Width = 1587
EndProperty
BeginProperty ColumnHeader(7) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 6
Text = "类型"
Object.Width = 1764
EndProperty
BeginProperty ColumnHeader(8) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Alignment = 1
SubItemIndex = 7
Text = "数量"
Object.Width = 1588
EndProperty
BeginProperty ColumnHeader(9) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Alignment = 1
SubItemIndex = 8
Text = "价格"
Object.Width = 1588
EndProperty
BeginProperty ColumnHeader(10) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 9
Text = "日期"
Object.Width = 1940
EndProperty
End
Begin MSComctlLib.Toolbar Toolbar1
Align = 1 'Align Top
Height = 570
Left = 0
TabIndex = 1
Top = 0
Width = 8775
_ExtentX = 15478
_ExtentY = 1005
ButtonWidth = 820
ButtonHeight = 953
Appearance = 1
Style = 1
ImageList = "ImageList1"
_Version = 393216
BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628}
NumButtons = 2
BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "刷新"
Key = "renovate"
ImageIndex = 1
EndProperty
BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "退出"
Key = "exit"
ImageIndex = 7
EndProperty
EndProperty
Begin VB.OptionButton Option4
Caption = "退回"
Height = 195
Left = 4080
TabIndex = 11
Top = 180
Width = 735
End
Begin VB.OptionButton Option3
Caption = "退货"
Height = 195
Left = 3300
TabIndex = 10
Top = 180
Width = 735
End
Begin VB.OptionButton Option2
Caption = "入库"
Height = 195
Left = 2580
TabIndex = 9
Top = 180
Width = 735
End
Begin VB.OptionButton Option1
Caption = "出库"
Height = 195
Left = 1800
TabIndex = 8
Top = 180
Value = -1 'True
Width = 675
End
Begin MSComCtl2.DTPicker DTPicker2
Height = 315
Left = 8220
TabIndex = 7
Top = 120
Width = 1395
_ExtentX = 2461
_ExtentY = 556
_Version = 393216
CustomFormat = "yyyy-MM-dd"
Format = 23789571
CurrentDate = 38813
End
Begin VB.Frame Frame2
BorderStyle = 0 'None
Caption = "Frame2"
Height = 255
Left = 7740
TabIndex = 5
Top = 180
Width = 435
Begin VB.Label Label2
Caption = "到"
Height = 195
Left = 120
TabIndex = 6
Top = 0
Width = 315
End
End
Begin VB.Frame Frame1
BorderStyle = 0 'None
Caption = "Frame1"
Height = 315
Left = 5340
TabIndex = 3
Top = 120
Width = 855
Begin VB.Label Label1
Caption = "出库日期"
Height = 255
Left = 60
TabIndex = 4
Top = 60
Width = 735
End
End
Begin MSComCtl2.DTPicker DTPicker1
Height = 315
Left = 6240
TabIndex = 2
Top = 120
Width = 1395
_ExtentX = 2461
_ExtentY = 556
_Version = 393216
CustomFormat = "yyyy-MM-dd"
Format = 23789571
CurrentDate = 38813
End
Begin MSComctlLib.ImageList ImageList1
Left = 6480
Top = 0
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 16
ImageHeight = 16
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 8
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "Frm_Part_InorOut.frx":014A
Key = ""
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "Frm_Part_InorOut.frx":02A4
Key = ""
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "Frm_Part_InorOut.frx":03FE
Key = ""
EndProperty
BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "Frm_Part_InorOut.frx":0558
Key = ""
EndProperty
BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "Frm_Part_InorOut.frx":06B2
Key = ""
EndProperty
BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "Frm_Part_InorOut.frx":080C
Key = ""
EndProperty
BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "Frm_Part_InorOut.frx":0966
Key = ""
EndProperty
BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "Frm_Part_InorOut.frx":0AC0
Key = ""
EndProperty
EndProperty
End
End
End
Attribute VB_Name = "Frm_Part_InorOut"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Form_Load()
DTPicker1.Value = Date
DTPicker2.Value = Date
End Sub
Private Sub Option1_Click()
ListView1.ListItems.Clear
Label1.Caption = "出库日期"
End Sub
Private Sub Option2_Click()
ListView1.ListItems.Clear
Label1.Caption = "入库日期"
End Sub
Private Sub Option3_Click()
ListView1.ListItems.Clear
Label1.Caption = "退货日期"
End Sub
Private Sub Option4_Click()
ListView1.ListItems.Clear
Label1.Caption = "退回日期"
End Sub
Private Sub Form_Resize()
If Me.Height > 1000 Then ListView1.Height = Me.Height - 1000
If Me.Width > 120 Then ListView1.Width = Me.Width - 120
End Sub
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Key
Case "renovate"
ListView1.ListItems.Clear
Renovate
Case "exit"
Unload Me
End Select
End Sub
Private Sub Renovate()
On Error GoTo myerr
Dim cn As ADODB.Connection
Dim rst As New ADODB.Recordset
Dim lt As ListItem
ListView1.ListItems.Clear
Set cn = GetCn
Select Case True
Case Option1.Value
rst.Open "select a.name,b.short_name,a.model,a.normal,a.packing,a.unit,d.type_name,c.amount,c.price,c.date_out from ((standard a inner join supply b on a.supply_id=b.supply_id) inner join part_out c on a.part_id=c.part_id) inner join out_type d on c.type=d.id where d.type_name<>'退货' and c.date_out>=#" & DTPicker1.Value & "# and c.date_out<=#" & DTPicker2.Value & "# order by 1", cn, 0, 1
Case Option2.Value
rst.Open "select a.name,b.short_name,a.model,a.normal,a.packing,a.unit,d.type_name,c.amount,c.price,c.date_in from ((standard a inner join supply b on a.supply_id=b.supply_id) inner join part_in c on a.part_id=c.part_id) inner join in_type d on c.type=d.id where d.type_name<>'退回' and c.date_in>=#" & DTPicker1.Value & "# and c.date_in<=#" & DTPicker2.Value & "# order by 1", cn, 0, 1
Case Option3.Value
rst.Open "select a.name,b.short_name,a.model,a.normal,a.packing,a.unit,d.type_name,c.amount,c.price,c.date_out from ((standard a inner join supply b on a.supply_id=b.supply_id) inner join part_out c on a.part_id=c.part_id) inner join out_type d on c.type=d.id where d.type_name='退货' and c.date_out>=#" & DTPicker1.Value & "# and c.date_out<=#" & DTPicker2.Value & "# order by 1", cn, 0, 1
Case Option4.Value
rst.Open "select a.name,b.short_name,a.model,a.normal,a.packing,a.unit,d.type_name,c.amount,c.price,c.date_in from ((standard a inner join supply b on a.supply_id=b.supply_id) inner join part_in c on a.part_id=c.part_id) inner join in_type d on c.type=d.id where d.type_name='退货' and c.date_in>=#" & DTPicker1.Value & "# and c.date_in<=#" & DTPicker2.Value & "# order by 1", cn, 0, 1
End Select
If rst.BOF And rst.EOF Then Exit Sub
Do While Not rst.EOF
Set lt = ListView1.ListItems.Add(, , rst(0), 8, 8)
For I = 1 To rst.Fields.Count - 1
lt.SubItems(I) = Trim(rst(I) & "")
Next I
rst.MoveNext
Loop
rst.Close
cn.Close
Exit Sub
myerr:
Select Case Err
Case -2147217904
If rst.State = 1 Then rst.Close
rst.Open "select count(*) from part_out", cn, 0, 1
If rst(0) = 0 Then
Exit Sub
Else
MsgBox Error, vbExclamation, "提示"
End If
Case Else
MsgBox Error, vbExclamation, "提示"
End Select
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -