📄 frmseat.frm
字号:
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 585
Index = 14
Left = 1920
TabIndex = 15
Top = 2160
Visible = 0 'False
Width = 735
End
Begin VB.Label lblSeat
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 1 'Fixed Single
Caption = "16"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 585
Index = 15
Left = 2640
TabIndex = 14
Top = 2040
Visible = 0 'False
Width = 735
End
Begin VB.Label lblSeat
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 1 'Fixed Single
Caption = "13"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 585
Index = 12
Left = 480
TabIndex = 13
Top = 2400
Visible = 0 'False
Width = 735
End
Begin VB.Label lblSeat
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 1 'Fixed Single
Caption = "12"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 585
Index = 11
Left = 8400
TabIndex = 12
Top = 3240
Visible = 0 'False
Width = 735
End
Begin VB.Label lblSeat
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 1 'Fixed Single
Caption = "11"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 585
Index = 10
Left = 7680
TabIndex = 11
Top = 3120
Visible = 0 'False
Width = 735
End
Begin VB.Label lblSeat
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 1 'Fixed Single
Caption = "10"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 585
Index = 9
Left = 6960
TabIndex = 10
Top = 3000
Visible = 0 'False
Width = 735
End
Begin VB.Label lblSeat
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 1 'Fixed Single
Caption = "9"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 585
Index = 8
Left = 6240
TabIndex = 9
Top = 2880
Visible = 0 'False
Width = 735
End
Begin VB.Label lblSeat
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 1 'Fixed Single
Caption = "8"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 585
Index = 7
Left = 5520
TabIndex = 8
Top = 2760
Visible = 0 'False
Width = 735
End
Begin VB.Label lblSeat
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 1 'Fixed Single
Caption = "7"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 585
Index = 6
Left = 4800
TabIndex = 7
Top = 2760
Visible = 0 'False
Width = 735
End
Begin VB.Label lblSeat
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 1 'Fixed Single
Caption = "6"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 585
Index = 5
Left = 4080
TabIndex = 6
Top = 2760
Visible = 0 'False
Width = 735
End
Begin VB.Label lblSeat
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 1 'Fixed Single
Caption = "5"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 585
Index = 4
Left = 3360
TabIndex = 5
Top = 2760
Visible = 0 'False
Width = 735
End
Begin VB.Label lblSeat
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 1 'Fixed Single
Caption = "1"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 585
Index = 0
Left = 480
TabIndex = 0
Top = 3240
Visible = 0 'False
Width = 735
End
Begin VB.Label lblSeat
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 1 'Fixed Single
Caption = "4"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 585
Index = 3
Left = 2640
TabIndex = 3
Top = 2880
Visible = 0 'False
Width = 735
End
Begin VB.Label lblSeat
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 1 'Fixed Single
Caption = "3"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 585
Index = 2
Left = 1920
TabIndex = 2
Top = 3000
Visible = 0 'False
Width = 735
End
Begin VB.Label lblSeat
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 1 'Fixed Single
Caption = "2"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 585
Index = 1
Left = 1200
TabIndex = 1
Top = 3120
Visible = 0 'False
Width = 735
End
Begin VB.Menu mnuFile
Caption = "&File"
Begin VB.Menu mnuFileNew
Caption = "&New..."
Shortcut = ^N
End
Begin VB.Menu mnuFileOpen
Caption = "&Open..."
Shortcut = ^O
End
Begin VB.Menu Hyphen1
Caption = "-"
End
Begin VB.Menu mnuFileExit
Caption = "E&xit"
End
End
End
Attribute VB_Name = "frmSeat"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub Form_Unload(Cancel As Integer)
Unload frmPatron
Close #1
End Sub
Private Sub lblSeat_Click(Index As Integer)
Dim intSeat As Integer, udtPatronRec As PatronStruc
intSeat = Index + 1
frmPatron.Show
frmPatron.lblNum.Caption = intSeat
If lblSeat(Index).BackColor = vbRed Then
Get #1, intSeat, udtPatronRec
frmPatron.txtName.Text = udtPatronRec.strName
frmPatron.txtPhone.Text = udtPatronRec.strPhone
Else
frmPatron.txtName.Text = ""
frmPatron.txtPhone.Text = ""
End If
End Sub
Private Sub mnuFileExit_Click()
Unload frmSeat
End Sub
Private Sub mnuFileNew_Click()
On Error GoTo NewErrHandler 'turn error trapping on
dlgSeat.CancelError = True 'treat Cancel button as an error
dlgSeat.Flags = cdlOFNOverwritePrompt 'display overwrite prompt if file exists
dlgSeat.Filter = "Data (*.txt) | *.txt" 'display only files ending in .dat
dlgSeat.ShowSave 'display Save As dialog box
Call Initialize(dlgSeat.FileName)
Exit Sub 'prevent error handler from being
'processed when no error occurs
NewErrHandler:
End Sub
Private Sub mnuFileOpen_Click()
Dim intSeat As Integer, udtPatronRec As PatronStruc
On Error GoTo OpenErrHandler 'turn error trapping on
dlgSeat.CancelError = True 'treat Cancel button as an error
dlgSeat.Flags = cdlOFNFileMustExist 'accept existing filenames only
dlgSeat.Filter = "Data (*.txt) | *.txt" 'display only files ending in .dat
dlgSeat.FileName = "" 'clear filename from dialog box
dlgSeat.ShowOpen 'display Open dialog box
Close #1
Open dlgSeat.FileName For Random As #1 Len = Len(udtPatronRec)
frmSeat.Caption = dlgSeat.FileName & " - Cole's Playhouse"
For intSeat = 0 To 47
lblSeat(intSeat).Visible = True
Get #1, intSeat + 1, udtPatronRec
If udtPatronRec.strName <> Space(20) Then
lblSeat(intSeat).BackColor = vbRed
Else
lblSeat(intSeat).BackColor = vbWhite
End If
Next intSeat
Exit Sub 'prevent error handler from being
'processed when no error occurs
OpenErrHandler:
End Sub
Private Sub Initialize(strFileName As String)
Dim intSeat As Integer, udtPatronRec As PatronStruc
udtPatronRec.strName = Space(8)
udtPatronRec.strPhone = Space(20)
Close #1
Open strFileName For Random As #1 Len = Len(udtPatronRec)
For intSeat = 0 To 47
Put #1, intSeat + 1, udtPatronRec
lblSeat(intSeat).BackColor = vbWhite
lblSeat(intSeat).Visible = True
Next intSeat
frmSeat.Caption = strFileName & "-Cole's playhouse"
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -