📄 frmroomtypelist.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmRoomTypeList
Caption = "Room Type"
ClientHeight = 5805
ClientLeft = 60
ClientTop = 345
ClientWidth = 8940
LinkTopic = "Form2"
MDIChild = -1 'True
ScaleHeight = 5805
ScaleWidth = 8940
Begin VB.PictureBox Picture1
Align = 2 'Align Bottom
BorderStyle = 0 'None
Height = 375
Left = 0
ScaleHeight = 375
ScaleWidth = 8940
TabIndex = 2
Top = 5430
Width = 8940
Begin VB.PictureBox Picture2
BorderStyle = 0 'None
Height = 345
Left = 3000
ScaleHeight = 345
ScaleWidth = 4155
TabIndex = 3
Top = 0
Width = 4150
Begin VB.CommandButton btnFirst
Height = 315
Left = 2760
Style = 1 'Graphical
TabIndex = 7
ToolTipText = "First 250"
Top = 10
Width = 315
End
Begin VB.CommandButton btnPrev
Height = 315
Left = 3075
Style = 1 'Graphical
TabIndex = 6
ToolTipText = "Previous 250"
Top = 10
Width = 315
End
Begin VB.CommandButton btnLast
Height = 315
Left = 3705
Style = 1 'Graphical
TabIndex = 5
ToolTipText = "Last 250"
Top = 10
Width = 315
End
Begin VB.CommandButton btnNext
Height = 315
Left = 3390
Style = 1 'Graphical
TabIndex = 4
ToolTipText = "Next 250"
Top = 10
Width = 315
End
Begin VB.Label lblPageInfo
Alignment = 1 'Right Justify
BackStyle = 0 'Transparent
Caption = "0 - 0 of 0"
Height = 255
Left = 120
TabIndex = 8
Top = 60
Width = 2535
End
End
Begin VB.Label lblCurrentRecord
AutoSize = -1 'True
Caption = "Selected Record: 0"
Height = 195
Left = 120
TabIndex = 9
Top = 60
Width = 1365
End
End
Begin VB.PictureBox picLine
Align = 2 'Align Bottom
BackColor = &H80000014&
BorderStyle = 0 'None
Height = 15
Index = 0
Left = 0
ScaleHeight = 15
ScaleWidth = 8940
TabIndex = 1
Top = 5400
Width = 8940
End
Begin VB.PictureBox picLine
Align = 2 'Align Bottom
BackColor = &H80000010&
BorderStyle = 0 'None
Height = 15
Index = 1
Left = 0
ScaleHeight = 15
ScaleWidth = 8940
TabIndex = 0
Top = 5415
Width = 8940
End
Begin MSComctlLib.ListView lvList
Height = 3435
Left = 0
TabIndex = 10
Top = 480
Width = 7260
_ExtentX = 12806
_ExtentY = 6059
View = 3
LabelEdit = 1
LabelWrap = 0 'False
HideSelection = 0 'False
FullRowSelect = -1 'True
GridLines = -1 'True
_Version = 393217
Icons = "ImageList1"
SmallIcons = "ImageList1"
ForeColor = -2147483640
BackColor = -2147483643
Appearance = 1
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
NumItems = 1
BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Text = "Category"
Object.Width = 6288
EndProperty
End
Begin VB.Label lblTitle
BackStyle = 0 'Transparent
Caption = "Room Type"
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000014&
Height = 210
Left = 75
TabIndex = 11
Top = 180
Width = 4815
End
Begin VB.Shape shpBar
BackColor = &H80000010&
BackStyle = 1 'Opaque
BorderColor = &H80000010&
Height = 240
Left = 0
Top = 180
Width = 6915
End
End
Attribute VB_Name = "frmRoomTypeList"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim CURR_COL As Integer
Dim rsRoomType As New Recordset
Dim RecordPage As New clsPaging
Dim SQLParser As New clsSQLSelectParser
'Procedure used to filter records
Public Sub FilterRecord(ByVal srcCondition As String)
SQLParser.RestoreStatement
SQLParser.wCondition = srcCondition
ReloadRecords SQLParser.SQLStatement
End Sub
Public Sub CommandPass(ByVal srcPerformWhat As String)
On Error GoTo err
Select Case srcPerformWhat
Case "New"
frmRoomType.State = adStateAddMode
frmRoomType.Show vbModal
Case "Edit"
If lvList.ListItems.Count > 0 Then
If isRecordExist("[Room Type]", "RoomTypeID", CLng(LeftSplitUF(lvList.SelectedItem.Tag))) = False Then
MsgBox "This record has been removed by other user.Click 'OK' button to refresh the records.", vbExclamation
RefreshRecords
Exit Sub
Else
With frmRoomType
.State = adStateEditMode
.PK = CLng(LeftSplitUF(lvList.SelectedItem.Tag))
.Show vbModal
End With
End If
End If
Case "Search"
With frmSearch
Set .srcForm = Me
Set .srcColumnHeaders = lvList.ColumnHeaders
.Show vbModal
End With
Case "Delete"
If lvList.ListItems.Count > 0 Then
If isRecordExist("[Room Type]", "RoomTypeID", CLng(LeftSplitUF(lvList.SelectedItem.Tag))) = False Then
MsgBox "This record has been removed by other user.Click 'OK' button to refresh the records.", vbExclamation
RefreshRecords
Exit Sub
Else
Dim ANS As Integer
ANS = MsgBox("Are you sure you want to delete the selected record?" & vbCrLf & vbCrLf & "WARNING: You cannot undo this operation.", vbCritical + vbYesNo, "Confirm Record Delete")
Me.MousePointer = vbHourglass
If ANS = vbYes Then
DelRecwSQL "Room Type", "RoomTypeID", "", True, CLng(LeftSplitUF(lvList.SelectedItem.Tag))
RefreshRecords
MsgBox "Record has been successfully deleted.", vbInformation, "Confirm"
End If
ANS = 0
Me.MousePointer = vbDefault
End If
Else
MsgBox "No record to delete.", vbExclamation
End If
Case "Refresh"
RefreshRecords
Case "Print"
Case "Close"
Unload Me
End Select
Exit Sub
'Trap the error
err:
If err.Number = -2147467259 Then
MsgBox "You cannot delete this record because it was used by other records! If you want to delete this record" & vbCrLf & _
"you will first have to delete or change the records that currenly used this record as shown bellow." & vbCrLf & vbCrLf & _
err.Description, , "Delete Operation Failed!"
Me.MousePointer = vbDefault
Else
MsgBox err.Description
End If
End Sub
Public Sub RefreshRecords()
SQLParser.RestoreStatement
ReloadRecords SQLParser.SQLStatement
End Sub
'Procedure for reloadingrecords
Public Sub ReloadRecords(ByVal srcSQL As String)
'-In this case I used SQL because it is faster than Filter function of VB
'-when hundling millions of records.
On Error GoTo err
With rsRoomType
If .State = adStateOpen Then .Close
.Open srcSQL
End With
RecordPage.Refresh
FillList 1
Exit Sub
err:
If err.Number = -2147217913 Then
srcSQL = Replace(srcSQL, "'", "", , , vbTextCompare)
Resume
ElseIf err.Number = -2147217900 Then
MsgBox "Invalid search operation.", vbExclamation
SQLParser.RestoreStatement
srcSQL = SQLParser.SQLStatement
Resume
Else
prompt_err err, Name, "ReloadRecords"
End If
End Sub
Private Sub btnClose_Click()
Unload Me
End Sub
Private Sub btnFirst_Click()
If RecordPage.PAGE_CURRENT <> 1 Then FillList 1
End Sub
Private Sub btnLast_Click()
If RecordPage.PAGE_CURRENT <> RecordPage.PAGE_TOTAL Then FillList RecordPage.PAGE_TOTAL
End Sub
Private Sub btnNext_Click()
If RecordPage.PAGE_CURRENT <> RecordPage.PAGE_TOTAL Then FillList RecordPage.PAGE_NEXT
End Sub
Private Sub btnPrev_Click()
If RecordPage.PAGE_CURRENT <> 1 Then FillList RecordPage.PAGE_PREVIOUS
End Sub
Private Sub Form_Activate()
HighlightInWin Me.Name: mdiMain.ShowTBButton "tttttft"
End Sub
Private Sub Form_Deactivate()
mdiMain.HideTBButton "", True
End Sub
Private Sub Form_Load()
'Set the graphics for the controls
With mdiMain
'For listview
Set lvList.SmallIcons = .i16x16
Set lvList.Icons = .i16x16
btnFirst.Picture = .i16x16.ListImages(3).Picture
btnPrev.Picture = .i16x16.ListImages(4).Picture
btnNext.Picture = .i16x16.ListImages(5).Picture
btnLast.Picture = .i16x16.ListImages(6).Picture
btnFirst.DisabledPicture = .i16x16g.ListImages(3).Picture
btnPrev.DisabledPicture = .i16x16g.ListImages(4).Picture
btnNext.DisabledPicture = .i16x16g.ListImages(5).Picture
btnLast.DisabledPicture = .i16x16g.ListImages(6).Picture
End With
With SQLParser
.Fields = "RoomType,RoomTypeID"
.Tables = "[Room Type]"
.SortOrder = "RoomType ASC"
.SaveStatement
End With
rsRoomType.CursorLocation = adUseClient
rsRoomType.Open SQLParser.SQLStatement, CN, adOpenStatic, adLockReadOnly
With RecordPage
.Start rsRoomType, 75
FillList 1
End With
End Sub
Private Sub FillList(ByVal whichPage As Long)
RecordPage.CurrentPosition = whichPage
Screen.MousePointer = vbHourglass
Me.Enabled = False
Call pageFillListView(lvList, rsRoomType, RecordPage.PageStart, RecordPage.PageEnd, 2, 2, False, True, , , , "RoomTypeID")
Me.Enabled = True
Screen.MousePointer = vbDefault
SetNavigation
'Display the page information
lblPageInfo.Caption = "Record " & RecordPage.PageInfo
'Display the selected record
lvList_Click
End Sub
Private Sub Form_Resize()
On Error Resume Next
If WindowState <> vbMinimized Then
If Me.Width < 9195 Then Me.Width = 9195
If Me.Height < 4500 Then Me.Height = 4500
shpBar.Width = ScaleWidth
lvList.Width = Me.ScaleWidth
lvList.Height = (Me.ScaleHeight - Picture1.Height) - lvList.Top
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
mdiMain.RemoveChild Me.Name
mdiMain.HideTBButton "", True
Set frmRoomTypeList = Nothing
End Sub
Private Sub SetNavigation()
With RecordPage
If .PAGE_TOTAL = 1 Then
btnFirst.Enabled = False
btnPrev.Enabled = False
btnNext.Enabled = False
btnLast.Enabled = False
ElseIf .PAGE_CURRENT = 1 Then
btnFirst.Enabled = False
btnPrev.Enabled = False
btnNext.Enabled = True
btnLast.Enabled = True
ElseIf .PAGE_CURRENT = .PAGE_TOTAL And .PAGE_CURRENT > 1 Then
btnFirst.Enabled = True
btnPrev.Enabled = True
btnNext.Enabled = False
btnLast.Enabled = False
Else
btnFirst.Enabled = True
btnPrev.Enabled = True
btnNext.Enabled = True
btnLast.Enabled = True
End If
End With
End Sub
Private Sub lvList_Click()
On Error GoTo err
lblCurrentRecord.Caption = "Selected Record: " & RightSplitUF(lvList.SelectedItem.Tag)
Exit Sub
err:
lblCurrentRecord.Caption = "Selected Record: NONE"
End Sub
Private Sub lvList_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then PopupMenu mdiMain.mnuRecA
End Sub
Private Sub lvList_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
'Sort the listview
If ColumnHeader.Index - 1 <> CURR_COL Then
lvList.SortOrder = 0
Else
lvList.SortOrder = Abs(lvList.SortOrder - 1)
End If
lvList.SortKey = ColumnHeader.Index - 1
lvList.Sorted = True
CURR_COL = ColumnHeader.Index - 1
End Sub
Private Sub lvList_DblClick()
CommandPass "Edit"
End Sub
Private Sub lvList_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode = 38 Or KeyCode = 40 Or KeyCode = 33 Or KeyCode = 34 Then lvList_Click
End Sub
Private Sub Picture1_Resize()
Picture2.Left = Picture1.ScaleWidth - Picture2.ScaleWidth
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -