📄 storetype.frm
字号:
VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form StoreType
AutoRedraw = -1 'True
BorderStyle = 3 'Fixed Dialog
Caption = "仓库类型配置"
ClientHeight = 3060
ClientLeft = 45
ClientTop = 330
ClientWidth = 6480
Icon = "StoreType.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 3060
ScaleWidth = 6480
ShowInTaskbar = 0 'False
Begin VB.PictureBox Picture2
AutoRedraw = -1 'True
Height = 2640
Left = 165
ScaleHeight = 2580
ScaleWidth = 4215
TabIndex = 5
Top = 240
Visible = 0 'False
Width = 4275
Begin VB.CommandButton Command1
Caption = "取消(&C)"
Height = 405
Index = 1
Left = 2190
TabIndex = 8
Top = 1620
Width = 1155
End
Begin VB.CommandButton Command1
Caption = "保存(&S)"
Enabled = 0 'False
Height = 405
Index = 0
Left = 1050
TabIndex = 7
Top = 1620
Width = 1155
End
Begin VB.TextBox StoreName
Height = 300
Left = 585
TabIndex = 6
Top = 930
Width = 2760
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "新仓库名称："
ForeColor = &H00808000&
Height = 180
Left = 555
TabIndex = 9
Top = 570
Width = 1080
End
End
Begin VB.PictureBox Picture1
BackColor = &H00808000&
Height = 2670
Left = 4620
ScaleHeight = 2610
ScaleWidth = 1650
TabIndex = 4
Top = 225
Width = 1710
Begin VB.CommandButton ExitButton
Cancel = -1 'True
Caption = "关闭退出"
Height = 870
Left = 0
Picture = "StoreType.frx":08CA
Style = 1 'Graphical
TabIndex = 3
Top = 1740
Width = 1650
End
Begin VB.CommandButton StoreDelete
Caption = "删除仓库"
Height = 870
Left = 0
Picture = "StoreType.frx":0BD4
Style = 1 'Graphical
TabIndex = 2
Top = 870
Width = 1650
End
Begin VB.CommandButton AddStore
Caption = "添加仓库"
Height = 870
Left = 0
Picture = "StoreType.frx":149E
Style = 1 'Graphical
TabIndex = 1
Top = 0
Width = 1650
End
End
Begin MSFlexGridLib.MSFlexGrid Grid1
Height = 2715
Left = 135
TabIndex = 0
Top = 210
Width = 4425
_ExtentX = 7805
_ExtentY = 4789
_Version = 393216
Rows = 10
Cols = 4
BackColor = 16777215
BackColorSel = 8421376
BackColorBkg = 12632256
AllowBigSelection= 0 'False
FocusRect = 0
ScrollBars = 2
SelectionMode = 1
End
End
Attribute VB_Name = "StoreType"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub AddStore_Click()
Grid1.Visible = False
AddStore.Enabled = False
StoreDelete.Enabled = False
ExitButton.Enabled = False
Picture2.Visible = True
StoreName.SetFocus
End Sub
Private Sub Command1_Click(Index As Integer)
If Index = 1 Then
AddStore.Enabled = True
StoreDelete.Enabled = True
ExitButton.Enabled = True
Picture2.Visible = False
Grid1.Visible = True
StoreName.Text = ""
Exit Sub
End If
'保存记录
Dim DB As Database, Ef As Recordset, RecStr As String
Set DB = OpenDatabase(App.Path & "\Sys\Store.mdb", 0, 0, Constr)
Set Ef = DB.OpenRecordset("CKLX", dbOpenDynaset)
RecStr = "仓库类型='" & Trim(StoreName.Text) & "'"
Ef.FindFirst RecStr
If Ef.NoMatch Then
RecStr = "Insert into CKLX (仓库类型) values('" & Trim(StoreName.Text) & "')"
DB.Execute RecStr
DB.Close
StoreName.Text = ""
Else
DB.Close
MsgBox "您添加的仓库已经存在!", vbOKOnly + 64, "重复仓库名称"
StoreName.Text = ""
StoreName.SetFocus
Exit Sub
End If
'配置网格
Grid1.Visible = False
Grid1.Clear
Grid1.Cols = 2
Grid1.FormatString = "^ 序号 |^ 仓 库 名 称 "
Grid1.ColWidth(0) = 830
Grid1.ColWidth(1) = 3500
Dim HH As Integer
Set DB = OpenDatabase(App.Path & "\Sys\Store.mdb", 0, 0, Constr)
Set Ef = DB.OpenRecordset("CKLX", dbOpenTable)
Grid1.Rows = Ef.RecordCount + 4
Set Ef = DB.OpenRecordset("Select * From CKLX", dbOpenDynaset)
HH = 1
Do While Not Ef.EOF()
Grid1.Row = HH
Grid1.Col = 1
Grid1.CellAlignment = 1
If Not IsNull(Ef.Fields(0).Value) Then
Grid1.Text = Ef.Fields(0).Value
End If
Ef.MoveNext
HH = HH + 1
Loop
DB.Close
For HH = 1 To Grid1.Rows - 1
Grid1.Row = HH
Grid1.Col = 0
Grid1.Text = HH
If Len(Grid1.Text) = 1 Then
Grid1.Text = "0" + Grid1.Text
End If
Next
Grid1.Col = 1
Grid1.Row = 1
Grid1.ColSel = 1
Grid1.Visible = True
AddStore.Enabled = True
StoreDelete.Enabled = True
ExitButton.Enabled = True
Picture2.Visible = False
End Sub
Private Sub ExitButton_Click()
Unload Me
End Sub
Private Sub Form_Load()
StoreType.Left = (MDIForm1.Width - StoreType.Width) / 2
StoreType.Top = (MDIForm1.Height - StoreType.Height) / 2 - 1000
Picture2.Visible = False
'配置网格
Grid1.Visible = False
Grid1.Cols = 2
Grid1.FormatString = "^ 序号 |^ 仓 库 名 称 "
Grid1.ColWidth(0) = 830
Grid1.ColWidth(1) = 3500
Dim DB As Database, Ef As Recordset, HH As Integer
Set DB = OpenDatabase(App.Path & "\Sys\Store.mdb", 0, 0, Constr)
Set Ef = DB.OpenRecordset("CKLX", dbOpenTable)
Grid1.Rows = Ef.RecordCount + 4
Set Ef = DB.OpenRecordset("Select * From CKLX", dbOpenDynaset)
HH = 1
Do While Not Ef.EOF()
Grid1.Row = HH
Grid1.Col = 1
Grid1.CellAlignment = 1
If Not IsNull(Ef.Fields(0).Value) Then
Grid1.Text = Ef.Fields(0).Value
End If
Ef.MoveNext
HH = HH + 1
Loop
DB.Close
For HH = 1 To Grid1.Rows - 1
Grid1.Row = HH
Grid1.Col = 0
Grid1.Text = HH
If Len(Grid1.Text) = 1 Then
Grid1.Text = "0" + Grid1.Text
End If
Next
Grid1.Col = 1
Grid1.Row = 1
Grid1.ColSel = 1
Grid1.Visible = True
End Sub
Private Sub StoreDelete_Click()
If Grid1.Text = "" Or Grid1.MouseCol = 0 Or Grid1.MouseRow = 0 Then Exit Sub
Dim QR As Integer
QR = MsgBox("真的要删除仓库[" & Grid1.Text & "]吗？(Y/N)", vbYesNo + 16, "删除确认")
If QR = 7 Then
Exit Sub
End If
'删除记录
Dim DB As Database, RecStr As String
Set DB = OpenDatabase(App.Path & "\Sys\Store.mdb", 0, 0, Constr)
RecStr = "仓库类型='" & Grid1.Text & "'"
RecStr = "Delete * From CKLX Where " & RecStr
DB.Execute RecStr
DB.Close
'配置网格
Grid1.Visible = False
Grid1.Clear
Grid1.Cols = 2
Grid1.FormatString = "^ 序号 |^ 仓 库 名 称 "
Grid1.ColWidth(0) = 830
Grid1.ColWidth(1) = 3500
Dim HH As Integer
Set DB = OpenDatabase(App.Path & "\Sys\Store.mdb", 0, 0, Constr)
Set Ef = DB.OpenRecordset("CKLX", dbOpenTable)
Grid1.Rows = Ef.RecordCount + 4
Set Ef = DB.OpenRecordset("Select * From CKLX", dbOpenDynaset)
HH = 1
Do While Not Ef.EOF()
Grid1.Row = HH
Grid1.Col = 1
Grid1.CellAlignment = 1
If Not IsNull(Ef.Fields(0).Value) Then
Grid1.Text = Ef.Fields(0).Value
End If
Ef.MoveNext
HH = HH + 1
Loop
DB.Close
For HH = 1 To Grid1.Rows - 1
Grid1.Row = HH
Grid1.Col = 0
Grid1.Text = HH
If Len(Grid1.Text) = 1 Then
Grid1.Text = "0" + Grid1.Text
End If
Next
Grid1.Col = 1
Grid1.Row = 1
Grid1.ColSel = 1
Grid1.Visible = True
End Sub
Private Sub StoreName_Change()
If Trim(StoreName) <> "" Then
Command1(0).Enabled = True
Else
Command1(0).Enabled = False
End If
End Sub
Private Sub StoreName_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{tab}"
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -