📄 frm_type.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form Frm_Type
BorderStyle = 1 'Fixed Single
Caption = "出入库类型添加"
ClientHeight = 4155
ClientLeft = 4110
ClientTop = 2010
ClientWidth = 3630
Icon = "Frm_Type.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4155
ScaleWidth = 3630
StartUpPosition = 2 '屏幕中心
Begin VB.OptionButton Option2
Caption = "入库"
Height = 195
Left = 2100
TabIndex = 5
Top = 180
Width = 735
End
Begin VB.OptionButton Option1
Caption = "出库"
Height = 180
Left = 540
TabIndex = 4
Top = 180
Width = 795
End
Begin VB.CommandButton Command1
Caption = "添加"
Height = 375
Left = 2760
TabIndex = 3
Top = 600
Width = 735
End
Begin MSComctlLib.ListView ListView1
Height = 2835
Left = 60
TabIndex = 2
Top = 1260
Width = 3495
_ExtentX = 6165
_ExtentY = 5001
View = 3
LabelEdit = 1
LabelWrap = -1 'True
HideSelection = -1 'True
FullRowSelect = -1 'True
GridLines = -1 'True
_Version = 393217
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
NumItems = 1
BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Text = "类型"
Object.Width = 2540
EndProperty
End
Begin VB.TextBox Text1
Height = 300
Left = 960
TabIndex = 1
Top = 600
Width = 1455
End
Begin VB.Label Label1
Caption = "类型名"
Height = 255
Left = 180
TabIndex = 0
Top = 660
Width = 615
End
End
Attribute VB_Name = "Frm_Type"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
On Error GoTo myerr
Dim cn As ADODB.Connection
Dim rst As New ADODB.Recordset
If Trim(Text1) = "" Then
MsgBox "类型不能为空!", vbExclamation, "提示"
Text1.SetFocus
Exit Sub
End If
If Len(Text1) > 50 Then
MsgBox "类型超长!", vbExclamation, "提示"
Text1.SetFocus
Exit Sub
End If
Set cn = GetCn
If Option1.Value Then
rst.Open "select * from out_type where type_name='" & Trim(Text1) & "'", cn, 0, 1
Else
rst.Open "select * from in_type where type_name='" & Trim(Text1) & "'", cn, 0, 1
End If
If Not (rst.BOF And rst.EOF) Then
MsgBox "已存在该类型!", vbExclamation, "提示"
Exit Sub
End If
rst.Close
cn.Execute "insert into " & Text1.Tag & " (type_name) values ('" & Trim(Text1) & "')"
MsgBox "保存成功!", vbExclamation, "提示"
cn.Close
ListView1.ListItems.Add , , Text1
Text1 = ""
Exit Sub
myerr:
MsgBox Error, vbExclamation, "提示"
End Sub
Private Sub Form_Load()
Option1.Value = True
End Sub
Private Sub Option1_Click()
Dim cn As ADODB.Connection
Dim rst As New ADODB.Recordset
Set cn = GetCn
ListView1.ListItems.Clear
rst.Open "select type_name from out_type ", cn, 0, 1
If rst.BOF And rst.EOF Then Exit Sub
Do While Not rst.EOF
ListView1.ListItems.Add , , rst(0)
rst.MoveNext
Loop
rst.Close
cn.Close
Text1.Tag = "out_type"
End Sub
Private Sub Option2_Click()
Dim cn As ADODB.Connection
Dim rst As New ADODB.Recordset
Set cn = GetCn
ListView1.ListItems.Clear
rst.Open "select type_name from in_type ", cn, 0, 1
If rst.BOF And rst.EOF Then Exit Sub
Do While Not rst.EOF
ListView1.ListItems.Add , , rst(0)
rst.MoveNext
Loop
rst.Close
cn.Close
Text1.Tag = "in_type"
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -