📄 frmunittype1.frm
字号:
VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form frmUnitType1
BorderStyle = 3 'Fixed Dialog
Caption = "单位分类"
ClientHeight = 3060
ClientLeft = 45
ClientTop = 330
ClientWidth = 6480
Icon = "frmUnitType1.frx":0000
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3060
ScaleWidth = 6480
ShowInTaskbar = 0 'False
Begin VB.PictureBox Picture1
BackColor = &H00808000&
Height = 2670
Left = 4620
ScaleHeight = 2610
ScaleWidth = 1650
TabIndex = 6
Top = 225
Width = 1710
Begin VB.CommandButton AddStore
Caption = "添加新类别"
Height = 870
Left = 0
Picture = "frmUnitType1.frx":08CA
Style = 1 'Graphical
TabIndex = 0
Top = 0
Width = 1650
End
Begin VB.CommandButton StoreDelete
Caption = "删除旧类别"
Height = 870
Left = 0
Picture = "frmUnitType1.frx":0BD4
Style = 1 'Graphical
TabIndex = 1
Top = 870
Width = 1650
End
Begin VB.CommandButton ExitButton
Cancel = -1 'True
Caption = "关闭<=>返回"
Height = 870
Left = 0
Picture = "frmUnitType1.frx":149E
Style = 1 'Graphical
TabIndex = 2
Top = 1740
Width = 1650
End
End
Begin VB.PictureBox Picture2
AutoRedraw = -1 'True
Height = 2640
Left = 255
ScaleHeight = 2580
ScaleWidth = 4215
TabIndex = 7
Top = 255
Visible = 0 'False
Width = 4275
Begin VB.TextBox StoreName
Height = 300
Left = 585
MaxLength = 20
TabIndex = 3
Top = 930
Width = 2760
End
Begin VB.CommandButton Command1
Caption = "保存(&S)"
Enabled = 0 'False
Height = 405
Index = 0
Left = 1035
TabIndex = 4
Top = 1620
Width = 1155
End
Begin VB.CommandButton Command1
Caption = "取消(&C)"
Height = 405
Index = 1
Left = 2190
TabIndex = 5
Top = 1620
Width = 1155
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "新单位名称："
ForeColor = &H00808000&
Height = 180
Left = 555
TabIndex = 8
Top = 570
Width = 1080
End
End
Begin MSFlexGridLib.MSFlexGrid Grid1
Height = 2715
Left = 135
TabIndex = 9
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
Begin VB.Menu MnuOperate
Caption = "操作(&O)"
Visible = 0 'False
Begin VB.Menu MnuNew
Caption = "添加 ..."
Shortcut = ^N
End
Begin VB.Menu Line01
Caption = "-"
End
Begin VB.Menu MnuDelete
Caption = "删除 ..."
Shortcut = +{DEL}
End
End
End
Attribute VB_Name = "frmUnitType1"
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(ConData, False, False, Constr)
Set EF = DB.OpenRecordset("UnitType", dbOpenDynaset)
RecStr = "SiteName='" & Trim(StoreName.Text) & "'"
EF.FindFirst RecStr
If EF.NoMatch Then
RecStr = "Insert into UnitType (SiteName) values('" & Trim(StoreName.Text) & "')"
DB.Execute RecStr
DB.Close
sUnit = StoreName '新建类型
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(ConData, False, False, Constr)
Set EF = DB.OpenRecordset("UnitType", dbOpenTable)
Grid1.Rows = EF.RecordCount + 1
If Grid1.Rows < 11 Then
Grid1.Rows = 11
End If
Set EF = DB.OpenRecordset("Select * From UnitType", dbOpenDynaset)
HH = 1
Do While Not EF.EOF()
Grid1.Row = HH
Grid1.Col = 1
Grid1.CellAlignment = 1
If Not IsNull(EF.Fields(1).Value) Then
Grid1.Text = EF.Fields(1).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()
GetFormSet Me, frmMain
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(ConData, False, False, Constr)
Set EF = DB.OpenRecordset("UnitType", dbOpenTable)
Grid1.Rows = EF.RecordCount + 1
If Grid1.Rows < 11 Then
Grid1.Rows = 11
End If
Set EF = DB.OpenRecordset("Select * From UnitType", dbOpenDynaset)
HH = 1
Do While Not EF.EOF()
Grid1.Row = HH
Grid1.Col = 1
Grid1.CellAlignment = 1
If Not IsNull(EF.Fields(1).Value) Then
Grid1.Text = EF.Fields(1).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
If Grid1.Text = "" Then
MnuDelete.Enabled = False
Else
MnuDelete.Enabled = True
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
SaveFormSet Me
End Sub
Private Sub Grid1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Grid1.Text = "" Then
MnuDelete.Enabled = False
Else
MnuDelete.Enabled = True
End If
If Button = 2 Then
PopupMenu MnuOperate
End If
End Sub
Private Sub MnuDelete_Click()
StoreDelete.Value = True
End Sub
Private Sub MnuNew_Click()
AddStore.Value = 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(ConData, False, False, Constr)
RecStr = "SiteName='" & Grid1.Text & "'"
RecStr = "Delete * From UnitType Where " & RecStr
DB.Execute RecStr
RecStr = "Delete * From UnitType Where SiteName='" & Grid1.Text & "'"
DB.Execute RecStr
DB.Close
'配置网格
CurRow = Grid1.Row
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(ConData, False, False, Constr)
Set EF = DB.OpenRecordset("UnitType", dbOpenTable)
Grid1.Rows = EF.RecordCount + 1
If Grid1.Rows < 11 Then
Grid1.Rows = 11
End If
Set EF = DB.OpenRecordset("Select * From UnitType", dbOpenDynaset)
HH = 1
Do While Not EF.EOF()
Grid1.Row = HH
Grid1.Col = 1
Grid1.CellAlignment = 1
If Not IsNull(EF.Fields(1).Value) Then
Grid1.Text = EF.Fields(1).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 = CurRow
Grid1.ColSel = 1
Grid1.Visible = True
If Grid1.Text = "" Then
MnuDelete.Enabled = False
Else
MnuDelete.Enabled = True
End If
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 + -