📄 基本信息窗口.frm
字号:
VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form wzxx
Caption = "基本信息窗口"
ClientHeight = 5760
ClientLeft = 4995
ClientTop = 2985
ClientWidth = 6810
LinkTopic = "Form1"
ScaleHeight = 5760
ScaleWidth = 6810
Begin VB.Frame Frame2
Caption = "基本信息列表窗口"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 2895
Left = 120
TabIndex = 16
Top = 2760
Width = 6615
Begin MSFlexGridLib.MSFlexGrid msglist
Height = 2415
Left = 120
TabIndex = 17
Top = 360
Width = 6375
_ExtentX = 11245
_ExtentY = 4260
_Version = 393216
End
End
Begin VB.Frame Frame1
Caption = "基本信息编辑窗口"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 2535
Left = 120
TabIndex = 0
Top = 120
Width = 6615
Begin VB.CommandButton Command3
Caption = "删除"
Height = 375
Left = 4680
TabIndex = 20
Top = 2040
Width = 1215
End
Begin VB.CommandButton Command2
Caption = "修改"
Height = 375
Left = 2760
TabIndex = 19
Top = 2040
Width = 1215
End
Begin VB.CommandButton Command1
Caption = "添加"
Height = 375
Left = 720
TabIndex = 18
Top = 2040
Width = 1215
End
Begin VB.TextBox Text1
Height = 375
Index = 4
Left = 1920
TabIndex = 6
Top = 1440
Width = 2295
End
Begin VB.TextBox Text1
Height = 375
Index = 3
Left = 4080
TabIndex = 5
Top = 840
Width = 1215
End
Begin VB.TextBox Text1
Height = 375
Index = 2
Left = 960
TabIndex = 4
Top = 840
Width = 1215
End
Begin VB.TextBox Text1
Height = 375
Index = 1
Left = 4080
TabIndex = 3
Top = 240
Width = 1215
End
Begin VB.TextBox Text1
Height = 375
Index = 0
Left = 960
TabIndex = 2
Top = 240
Width = 1215
End
Begin VB.Label Label2
Caption = "字母或汉字"
ForeColor = &H00FF0000&
Height = 375
Index = 4
Left = 4560
TabIndex = 15
Top = 1440
Width = 735
End
Begin VB.Label Label2
Caption = "字母或汉字"
ForeColor = &H00FF0000&
Height = 375
Index = 3
Left = 5400
TabIndex = 14
Top = 840
Width = 735
End
Begin VB.Label Label2
Caption = "无限制"
ForeColor = &H00FF0000&
Height = 375
Index = 2
Left = 2280
TabIndex = 13
Top = 840
Width = 735
End
Begin VB.Label Label2
Caption = "字母或汉字"
ForeColor = &H00FF0000&
Height = 375
Index = 1
Left = 5400
TabIndex = 12
Top = 240
Width = 735
End
Begin VB.Label Label2
Caption = "格式如""0001"""
ForeColor = &H00FF0000&
Height = 375
Index = 0
Left = 2280
TabIndex = 11
Top = 240
Width = 735
End
Begin VB.Label Label1
Caption = "计量单位"
Height = 375
Index = 4
Left = 960
TabIndex = 10
Top = 1560
Width = 735
End
Begin VB.Label Label1
Caption = "类别"
Height = 375
Index = 3
Left = 3360
TabIndex = 9
Top = 960
Width = 735
End
Begin VB.Label Label1
Caption = "规格型号"
Height = 375
Index = 2
Left = 120
TabIndex = 8
Top = 960
Width = 735
End
Begin VB.Label Label1
Caption = "物资名称"
Height = 375
Index = 1
Left = 3240
TabIndex = 7
Top = 360
Width = 735
End
Begin VB.Label Label1
Caption = "物资编号"
Height = 375
Index = 0
Left = 120
TabIndex = 1
Top = 360
Width = 735
End
End
End
Attribute VB_Name = "wzxx"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public a As String
Private Sub Command1_Click()
Dim intCount As Integer
Dim sMsg As String
Dim MsgText As String
Dim AddMsg As Boolean
AddMsg = True
'判断文本框内容是否为空
For intCount = 0 To 4
If Trim$(Text1(intCount).Text) = "" Then
sMsg = Replace(Label2(intCount).Caption, " ", "")
sMsg = sMsg & "不能为空"
MsgBox sMsg, vbOKOnly + vbExclamation, "警告"
Text1(intCount).SetFocus
AddMsg = False
Exit For
Exit Sub
End If
Next
Dim rs As ADODB.Recordset
txtSQL = "select * from material where wzid='" & Trim$(Text1(0).Text) & "'"
Set rs = ExecuteSQL(txtSQL, txtmsg)
If rs.EOF = False Then
sMsg = "已经存在此物资编号的记录,请重新输入物资编号!"
MsgBox sMsg, vbOKOnly + vbExclamation, "警告"
Text1(0).Text = ""
Text1(0).SetFocus
AddMsg = False
Exit Sub
End If
rs.Close
txtSQL = "select * from material where wzname='" & Trim$(Text1(1).Text) & "' and wzspec='" & Trim$(Text1(2).Text) & "'"
Set rs = ExecuteSQL(txtSQL, txtmsg)
If rs.EOF = False Then
sMsg = "已经存在相同物资类容的记录,请重新输入物资名称和规格型号!"
MsgBox sMsg, vbOKOnly + vbExclamation, "警告"
Text1(1).Text = ""
Text1(2).Text = ""
Text1(1).SetFocus
AddMsg = False
Exit Sub
End If
rs.Close
If AddMsg = True Then
txtSQL = "select * from material"
Set rs = ExecuteSQL(txtSQL, txtmsg)
rs.AddNew
For intCount = 0 To 4
rs(intCount) = Text1(intCount)
Next
rs.Update
rs.Close
sMsg = "添加记录成功!是否继续添加记录 "
If MsgBox(sMsg, vbOKCancel + vbExclamation, "提示") = vbOK Then
For intCount = 0 To 4
Text1(intCount).Text = ""
Next
ShowData
End If
End If
Set rs = Nothing
End Sub
Private Sub Form_Load()
ShowTitle
ShowData
End Sub
Private Sub ShowTitle()
Dim i As Integer
With msglist
.Cols = 6
.TextMatrix(0, 1) = "物资编号"
.TextMatrix(0, 2) = "物资名称"
.TextMatrix(0, 3) = "规格型号"
.TextMatrix(0, 4) = "类别"
.TextMatrix(0, 5) = "计量单位"
.FixedRows = 1
For i = 0 To 5
.ColAlignment(i) = 0
Next i
.FillStyle = flexFillRepeat
.Col = 0
.RowSel = 1
.ColSel = .Cols - 1
.CellAlignment = 4
.ColWidth(0) = 260
.ColWidth(1) = 1200
.ColWidth(2) = 1200
.ColWidth(3) = 1200
.ColWidth(4) = 1200
.ColWidth(5) = 1200
.Row = 1
End With
End Sub
Public Sub ShowData()
Dim j As Integer
Dim i As Integer
Dim rs As ADODB.Recordset
If txtSQL = "" Then
txtSQL = "select * from material"
End If
Set rs = ExecuteSQL(txtSQL, txtmsg)
If rs.EOF = False Then
With msglist
.Rows = 1
Do While Not rs.EOF
.Rows = .Rows + 1
For i = 1 To rs.Fields.Count - 1
Select Case rs.Fields(i).Type
Case adDBDate
.TextMatrix(.Rows - 1, i) = Format(rs.Fields(i - 1), "yyyy-m-d")
Case Else
.TextMatrix(.Rows - 1, i) = rs.Fields(i - 1)
End Select
Next i
.TextMatrix(.Rows - 1, i) = rs.Fields(i - 1)
rs.MoveNext
Loop
End With
End If
rs.Close
End Sub
Private Sub Command2_Click()
Dim intCount As Integer
Dim sMsg As String
Dim MsgText As String
Dim AddMsg As Boolean
AddMsg = True
For intCount = 0 To 4
If Trim$(Text1(intCount).Text) = "" Then
sMsg = Replace(Label2(intCount).Caption, " ", "")
sMsg = sMsg & "不能为空"
MsgBox sMsg, vbOKOnly + vbExclamation, "警告"
Text1(intCount).SetFocus
AddMsg = False
Exit For
Exit Sub
End If
Next
Dim rs As ADODB.Recordset
txtSQL = "select * from material where wzname='" & Trim$(Text1(1).Text) & "' and wzspec='" & Trim$(Text1(2).Text) & "'"
Set rs = ExecuteSQL(txtSQL, txtmsg)
If rs.EOF = False Then
sMsg = "已经存在相同物资类容的记录,请重新输入物资名称和规格型号!"
MsgBox sMsg, vbOKOnly + vbExclamation, "警告"
Text1(1).SetFocus
AddMsg = False
Exit Sub
End If
rs.Close
If MsgBox("保存当前记录的变化吗 ", vbOKCancel + vbExclamation, "提示") = vbOK Then
AddMsg = True
Else
AddMsg = False
End If
If AddMsg = True Then
txtSQL = "select * from material where wzid='" & Trim(a) & "'"
Set rs = ExecuteSQL(txtSQL, txtmsg)
For intCount = 0 To 4
rs(intCount) = Text1(intCount)
Next
rs.Update
rs.Close
a = Format(Text1(0), "0000")
sMsg = "修改记录成功!"
MsgBox sMsg, vbOKOnly + vbExclamation, "警告"
ShowData
End If
Set rs = Nothing
End Sub
Private Sub Msglist_Click()
For i = 0 To 4
Text1(i) = msglist.TextMatrix(msglist.RowSel, i + 1)
Next i
a = Format(Text1(0), "0000")
End Sub
Private Sub Command3_Click()
Dim intCount As Integer
Dim sMsg As String
Dim AddMsg As Boolean
Dim rs As ADODB.Recordset
If MsgBox("删除当前记录吗 ", vbOKCancel + vbExclamation, "提示") = vbOK Then
AddMsg = True
Else
AddMsg = False
End If
If AddMsg = True Then
txtSQL = "delete * from material where wzid='" & Trim(Text1(0).Text) & "'"
Set rs = ExecuteSQL(txtSQL, txtmsg)
sMsg = "删除记录成功!"
MsgBox sMsg, vbOKOnly + vbExclamation, "警告"
ShowData
End If
Set rs = Nothing
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -