📄 frmreservationlist.frm
字号:
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 "Reservation", "ReservationNo", "", 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!"
Else
MsgBox err.Number & " " & err.Description
End If
Me.MousePointer = vbDefault
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 rsRooms
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 "ttfftttt", False
Call lvList_Click
End Sub
Private Sub Form_Deactivate()
mdiMain.HideTBButton "", True
End Sub
Private Sub Form_Load()
' mdiMain.AddToWin Me.Caption, Name
'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 = "ReservationNo, Customer, Company, Address, DateIn, ReservationNo"
.Tables = "qry_Reservation"
.wCondition = "Status = 'Reserved'"
.SortOrder = "ReservationNo ASC"
.SaveStatement
End With
If rsRooms.State = 1 Then rsRooms.Close
rsRooms.CursorLocation = adUseClient
Debug.Print CN
rsRooms.Open SQLParser.SQLStatement, CN, adOpenStatic, adLockReadOnly
With RecordPage
.Start rsRooms, 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, rsRooms, RecordPage.PageStart, RecordPage.PageEnd, 15, 2, False, True, , , , "ReservationNo")
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 frmReservationList = 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)
If lvList.SelectedItem.SubItems(2) = "Occupied" Then
mdiMain.tbMenu.Buttons(2).Visible = False
Else
mdiMain.tbMenu.Buttons(2).Visible = True
End If
Exit Sub
err:
lblCurrentRecord.Caption = "Selected Record: NONE"
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 lvList_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
' MsgBox lvList.SelectedItem.SubItems(2)
DoEvents
' lvList.ToolTipText = lvList.SelectedItem.SubItems(2)
End Sub
Private Sub lvList_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
' If Button = 2 Then PopupMenu mnuAction
End Sub
Private Sub Picture1_Resize()
Picture2.Left = Picture1.ScaleWidth - Picture2.ScaleWidth
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -