📄 frmctype.frm
字号:
VERSION 5.00
Object = "{E3AE1957-12AC-4DB7-8CE4-EB281F9E0359}#1.0#0"; "XPButton.ocx"
Object = "{FDAC2480-F4ED-4632-AA78-DCA210A74E49}#6.0#0"; "SPR32X60.ocx"
Object = "{4932CEF1-2CAA-11D2-A165-0060081C43D9}#2.0#0"; "Actbar2.ocx"
Begin VB.Form frmctype
AutoRedraw = -1 'True
Caption = "Form2"
ClientHeight = 6015
ClientLeft = 1680
ClientTop = 2655
ClientWidth = 5850
LinkTopic = "Form2"
MDIChild = -1 'True
ScaleHeight = 6015
ScaleWidth = 5850
Begin ActiveBar2LibraryCtl.ActiveBar2 Abar
Align = 1 'Align Top
Height = 6015
Left = 0
TabIndex = 0
Top = 0
Width = 5850
_LayoutVersion = 1
_ExtentX = 10319
_ExtentY = 10610
_DataPath = ""
Bands = "frmCType.frx":0000
Begin VB.PictureBox Pic
Height = 5835
Left = 30
ScaleHeight = 5775
ScaleWidth = 5805
TabIndex = 1
Top = 210
Width = 5865
Begin VB.Data siteData
Caption = "Data1"
Connect = "Access"
DatabaseName = ""
DefaultCursorType= 0 '缺省游标
DefaultType = 2 '使用 ODBC
Exclusive = 0 'False
Height = 285
Left = 420
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = ""
Top = 6540
Width = 1140
End
Begin FPSpread.vaSpread fpsp
Bindings = "frmCType.frx":0260
Height = 5385
Left = 180
TabIndex = 7
Top = 240
Width = 2805
_Version = 393216
_ExtentX = 4948
_ExtentY = 9499
_StockProps = 64
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
SpreadDesigner = "frmCType.frx":0277
End
Begin VB.Frame Fredit
Caption = "座位"
Enabled = 0 'False
Height = 5655
Left = 3120
TabIndex = 2
Top = 0
Width = 2565
Begin VB.TextBox Tname
Appearance = 0 'Flat
BackColor = &H00E0E0E0&
ForeColor = &H00000000&
Height = 345
Left = 180
TabIndex = 3
Top = 960
Width = 2055
End
Begin XPButton.Button cok
Height = 345
Left = 240
TabIndex = 4
Top = 4680
Width = 945
_ExtentX = 1667
_ExtentY = 609
caption = "确认"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin XPButton.Button ccancle
Height = 345
Left = 1350
TabIndex = 5
Top = 4680
Width = 945
_ExtentX = 1667
_ExtentY = 609
caption = "放弃"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "计量单位名称名称："
Height = 180
Index = 1
Left = 180
TabIndex = 6
Top = 645
Width = 1620
End
End
End
End
End
Attribute VB_Name = "frmctype"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim rst As Recordset
Dim dbs As Database
Private Sub ABar_ToolClick(ByVal Tool As ActiveBar2LibraryCtl.Tool)
'On Error GoTo er
Select Case Tool.Name
Case "m_add"
CurrOp = "add"
Fredit.Enabled = True
fpsp.Enabled = False
Tname.Enabled = True
Abar.Tools("m_add").Enabled = False
Abar.Tools("m_modify").Enabled = False
Abar.Tools("m_del").Enabled = False
Abar.Tools("m_print").Enabled = False
Tname.SetFocus
Case "m_del"
If MsgBox("是否删除消费品：" & Tname.Text & "?", vbQuestion + vbYesNo, "消费品删除") = vbYes Then
dbs.Execute "delete from menutype where MenuName = '" & Tname.Text & "'"
rst.Requery
InitGrid
End If
Case "m_modify"
CurrOp = "modify"
Fredit.Enabled = True
fpsp.Enabled = False
Abar.Tools("m_add").Enabled = False
Abar.Tools("m_modify").Enabled = False
Abar.Tools("m_del").Enabled = False
Abar.Tools("m_print").Enabled = False
Tname.SetFocus
Case "m_print"
InitGrid
tmp = "消费品名称"
Printer.Print tmp
Printer.Print "========================================="
Do While Not rst.EOF
tmp = rst!menuname
Printer.Print tmp
rst.MoveNext
Loop
Case "m_exit"
Unload Me
End Select
Exit Sub
er:
ErrorHandle ""
End Sub
Private Sub Form_Load()
Dim t As ActiveBar2LibraryCtl.Tool
Dim b As ActiveBar2LibraryCtl.Band
Dim keys(0) As New ShortCut
GetFormSet Me, frmMain
Debug.Print Me.Width
Abar.ClientAreaControl = Pic
Me.Icon = LoadResPicture(227, vbResIcon)
Me.Caption = "消费品管理"
Set Tool = Abar.Tools.Add(0, "Separator")
With Tool
.Caption = ""
.Category = "Format"
.ControlType = ddTTSeparator
End With
Set b = Abar.Bands.Add("toolsMain")
b.Type = ddBTNormal
b.Caption = "工具条"
b.DisplayMoreToolsButton = False
b.DockingArea = ddDATop
b.MouseTracking = ddTSBevel
b.GrabHandleStyle = ddGSNormal
Set t = Abar.Tools.Add(GetUniqueToolID(), "m_add")
With t
.Caption = "增加"
.SetPicture ddITNormal, LoadResPicture(101, vbResBitmap)
.ControlType = ddTTButton
keys(0) = "Control+A"
.ShortCuts = keys
.ToolTipText = "增加消费品"
.CaptionPosition = ddCPBelow
.Style = ddSIconText
End With
Set t = Abar.Tools.Add(GetUniqueToolID(), "m_modify")
With t
.Caption = "修改"
.SetPicture ddITNormal, LoadResPicture(200, vbResBitmap)
.ControlType = ddTTButton
keys(0) = "Control+E"
.ShortCuts = keys
.ToolTipText = "修改消费品信息"
.CaptionPosition = ddCPBelow
.Style = ddSIconText
End With
Set t = Abar.Tools.Add(GetUniqueToolID(), "m_del")
With t
.Caption = "删除"
.SetPicture ddITNormal, LoadResPicture(102, vbResBitmap)
.ControlType = ddTTButton
keys(0) = "Control+D"
.ShortCuts = keys
.ToolTipText = "删除消费品"
.CaptionPosition = ddCPBelow
.Style = ddSIconText
End With
Set t = Abar.Tools.Add(GetUniqueToolID(), "m_print")
With t
.Caption = "打印"
.SetPicture ddITNormal, LoadResPicture(106, vbResBitmap)
.ControlType = ddTTButton
keys(0) = "Control+Q"
.ShortCuts = keys
.ToolTipText = "打印"
.CaptionPosition = ddCPBelow
.Style = ddSIconText
End With
Set t = Abar.Tools.Add(GetUniqueToolID(), "m_exit")
With t
.Caption = "关闭": Tool.Category = "m_sys"
.SetPicture ddITNormal, LoadResPicture(103, vbResBitmap)
.ControlType = ddTTButton
keys(0) = "Control+C"
.ShortCuts = keys
.ToolTipText = "关闭本窗口"
.CaptionPosition = ddCPBelow
.Style = ddSIconText
End With
With b.Tools
.Insert .Count, Abar.Tools("m_add")
.Insert .Count, Abar.Tools("m_del")
.Insert .Count, Abar.Tools("m_modify")
.Insert .Count, Abar.Tools("Separator")
.Insert .Count, Abar.Tools("m_print")
.Insert .Count, Abar.Tools("Separator")
.Insert .Count, Abar.Tools("m_exit")
End With
Abar.RecalcLayout
Abar.Refresh
Set dbs = OpenDatabase(ConData, False, False, Constr)
Set rst = dbs.OpenRecordset("Select MenuName from menutype", dbOpenDynaset)
Set siteData.Recordset = rst
fpsp.OperationMode = OperationModeRow
fpsp.SelBackColor = &HFFC0C0
InitGrid
Debug.Print Me.Width
End Sub
Private Sub InitGrid()
With rst
If .RecordCount > 0 Then
.MoveLast
.MoveFirst
Tname.Text = !menuname
Else
VSrs.Value = 2
VSrs.Value = 2
End If
End With
With fpsp
.UnitType = UnitTypeTwips
.RowHeight(0) = 500
.MaxRows = rst.RecordCount
.MaxCols = rst.Fields.Count
.Row = 0
.Row2 = .MaxRows
.Col = 1
.Col2 = .MaxCols
.BlockMode = True
.Protect = True
.FontName = "宋体"
.FontSize = "9.25"
.Lock = True
.BlockMode = False
.Row = 0
.Row2 = 0
.Col = 1
.Col2 = .MaxCols
.Clip = "消费品名称"
.ColWidth(1) = 1500
End With
End Sub
Private Sub Form_Unload(Cancel As Integer)
rst.Close
Set rst = Nothing
dbs.Close
Set dbs = Nothing
SaveFormSet Me
End Sub
Private Sub ccancle_Click()
Fredit.Enabled = False
fpsp.Enabled = True
With fpsp
.Row = .ActiveRow
.Col = 1
Tname.Text = fpsp.Text
End With
Abar.Tools("m_add").Enabled = True
Abar.Tools("m_modify").Enabled = True
Abar.Tools("m_del").Enabled = True
Abar.Tools("m_print").Enabled = True
End Sub
Private Sub cok_Click()
'On Error GoTo er
If CheckOK() Then
If CurrOp = "add" Then
sqlstr = "Insert into menutype (MenuName) values('" & Trim(Tname.Text) & "')"
dbs.Execute sqlstr
Else
fpsp.Row = fpsp.ActiveRow
fpsp.Col = 1
t = fpsp.Text
dbs.Execute "update menutype set MenuName ='" & Tname.Text & "' where MenuName = '" & t & "';"
dbs.Execute "update eatlist set MenuType ='" & Tname.Text & "' where MenuType = '" & t & "';"
End If
rst.Requery
InitGrid
Fredit.Enabled = False
fpsp.Enabled = True
Abar.Tools("m_add").Enabled = True
Abar.Tools("m_modify").Enabled = True
Abar.Tools("m_del").Enabled = True
Abar.Tools("m_print").Enabled = True
End If
Exit Sub
er:
ErrorHandle ""
Fredit.Enabled = False
fpsp.Enabled = True
Abar.Tools("m_add").Enabled = True
Abar.Tools("m_modify").Enabled = True
Abar.Tools("m_del").Enabled = True
Abar.Tools("m_print").Enabled = True
End Sub
Private Sub fpsp_LeaveRow(ByVal Row As Long, ByVal RowWasLast As Boolean, ByVal RowChanged As Boolean, ByVal AllCellsHaveData As Boolean, ByVal NewRow As Long, ByVal NewRowIsLast As Long, Cancel As Boolean)
With fpsp
.Row = NewRow
.Col = 1
Tname.Text = .Text
End With
End Sub
Private Sub Pic_Resize()
'On Error Resume Next
fpsp.Left = 0
fpsp.Top = 0
fpsp.Height = Pic.Height - 50
Fredit.Height = fpsp.Height - Fredit.Top
Fredit.Left = Pic.Width - Fredit.Width - 100
fpsp.Width = Fredit.Left - 50
cok.Top = Fredit.Top + Fredit.Height - 350 - cok.Height
ccancle.Top = cok.Top
End Sub
Private Sub Tsp_Validate(Cancel As Boolean)
If Not IsNumeric(Tsp.Text) Then
MsgBox Tsp.Text & "不是有效的台位费,‘台位费’必须为数字！", vbCritical, "提示"
Cancel = True
Tsp.SetFocus
End If
End Sub
Private Sub VSrs_Change()
Trs.Text = VSrs.Value
End Sub
Private Function CheckOK() As Boolean
CheckOK = False
If Len(Trim(Tname.Text)) = 0 Then
MsgBox "消费品名称不能为空！", vbCritical, "提示"
Tname.SetFocus
End If
CheckOK = True
End Function
Private Sub Tname_GotFocus()
SendKeys "{Home}+{End}"
End Sub
Private Sub Tsp_GotFocus()
SendKeys "{Home}+{End}"
End Sub
Private Sub Tname_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Call cok_Click
ElseIf KeyAscii = 27 Then
Call ccancle_Click
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -