⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmsitesataus.frm

📁 星级酒店管理系统(附带系统自写控件源码)
💻 FRM
📖 第 1 页 / 共 3 页
字号:
VERSION 5.00
Begin VB.Form frmSites 
   AutoRedraw      =   -1  'True
   BackColor       =   &H8000000A&
   Caption         =   "餐桌分布及当前使用状态"
   ClientHeight    =   6045
   ClientLeft      =   60
   ClientTop       =   630
   ClientWidth     =   9150
   Icon            =   "frmSiteSataus.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MDIChild        =   -1  'True
   ScaleHeight     =   403
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   610
   WindowState     =   2  'Maximized
   Begin VB.PictureBox picCheck 
      AutoSize        =   -1  'True
      Height          =   1860
      Left            =   7335
      Picture         =   "frmSiteSataus.frx":08CA
      ScaleHeight     =   120
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   120
      TabIndex        =   18
      Top             =   4095
      Visible         =   0   'False
      Width           =   1860
   End
   Begin VB.PictureBox picMaintenance 
      AutoSize        =   -1  'True
      Height          =   1860
      Left            =   5475
      Picture         =   "frmSiteSataus.frx":B1CC
      ScaleHeight     =   120
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   120
      TabIndex        =   17
      Top             =   4110
      Visible         =   0   'False
      Width           =   1860
   End
   Begin VB.PictureBox picIde 
      AutoSize        =   -1  'True
      Height          =   1860
      Left            =   -105
      Picture         =   "frmSiteSataus.frx":15ACE
      ScaleHeight     =   120
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   120
      TabIndex        =   16
      Top             =   4110
      Visible         =   0   'False
      Width           =   1860
   End
   Begin VB.PictureBox PicBusy 
      AutoSize        =   -1  'True
      Height          =   1860
      Left            =   1755
      Picture         =   "frmSiteSataus.frx":203D0
      ScaleHeight     =   120
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   120
      TabIndex        =   15
      Top             =   4110
      Visible         =   0   'False
      Width           =   1860
   End
   Begin VB.PictureBox PicBook 
      AutoSize        =   -1  'True
      Height          =   1860
      Left            =   3615
      Picture         =   "frmSiteSataus.frx":2ACD2
      ScaleHeight     =   120
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   120
      TabIndex        =   14
      Top             =   4110
      Visible         =   0   'False
      Width           =   1860
   End
   Begin VB.PictureBox picProgress 
      AutoRedraw      =   -1  'True
      BackColor       =   &H000000FF&
      Height          =   270
      Left            =   60
      ScaleHeight     =   14
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   100
      TabIndex        =   4
      Top             =   795
      Visible         =   0   'False
      Width           =   1560
      Begin VB.PictureBox picProgressSlide 
         Appearance      =   0  'Flat
         AutoRedraw      =   -1  'True
         BackColor       =   &H00400000&
         BorderStyle     =   0  'None
         ForeColor       =   &H80000008&
         Height          =   210
         Left            =   0
         ScaleHeight     =   14
         ScaleMode       =   3  'Pixel
         ScaleWidth      =   17
         TabIndex        =   5
         Top             =   0
         Width           =   255
      End
   End
   Begin VB.Frame Frame1 
      Height          =   735
      Left            =   60
      TabIndex        =   12
      Top             =   -30
      Width           =   9630
      Begin VB.CommandButton cmdClose 
         Cancel          =   -1  'True
         Caption         =   "关闭(&Exit)"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   9.75
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   495
         Left            =   7380
         TabIndex        =   13
         Top             =   150
         Width           =   1410
      End
      Begin VB.OptionButton optSelect 
         BackColor       =   &H000040C0&
         Caption         =   "显示使用位(&U)"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   9.75
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00FFFFFF&
         Height          =   495
         Index           =   3
         Left            =   5475
         Style           =   1  'Graphical
         TabIndex        =   3
         Top             =   150
         Width           =   1845
      End
      Begin VB.OptionButton optSelect 
         BackColor       =   &H00800000&
         Caption         =   "显示预订位(&B)"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   9.75
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00FFFFFF&
         Height          =   495
         Index           =   2
         Left            =   3705
         Style           =   1  'Graphical
         TabIndex        =   2
         Top             =   150
         Width           =   1755
      End
      Begin VB.OptionButton optSelect 
         BackColor       =   &H0000C000&
         Caption         =   "显示空闲位(&I)"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   9.75
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   495
         Index           =   1
         Left            =   1935
         Style           =   1  'Graphical
         TabIndex        =   1
         Top             =   150
         Width           =   1755
      End
      Begin VB.OptionButton optSelect 
         BackColor       =   &H00FFFFFF&
         Caption         =   "显示所有座位(&A)"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   9.75
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   495
         Index           =   0
         Left            =   105
         Style           =   1  'Graphical
         TabIndex        =   0
         Top             =   150
         Value           =   -1  'True
         Width           =   1755
      End
   End
   Begin VB.PictureBox picFrame 
      BackColor       =   &H80000000&
      Height          =   2160
      Left            =   0
      ScaleHeight     =   140
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   131
      TabIndex        =   8
      Top             =   975
      Visible         =   0   'False
      Width           =   2025
      Begin VB.PictureBox picSlide 
         Appearance      =   0  'Flat
         BackColor       =   &H00FFC0C0&
         BorderStyle     =   0  'None
         ForeColor       =   &H80000008&
         Height          =   1635
         Left            =   90
         ScaleHeight     =   109
         ScaleMode       =   3  'Pixel
         ScaleWidth      =   98
         TabIndex        =   10
         Top             =   165
         Width           =   1470
         Begin VB.OptionButton optThumb 
            BackColor       =   &H80000000&
            BeginProperty Font 
               Name            =   "MS Sans Serif"
               Size            =   8.25
               Charset         =   0
               Weight          =   400
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   1440
            Index           =   0
            Left            =   60
            MouseIcon       =   "frmSiteSataus.frx":355D4
            MousePointer    =   99  'Custom
            Style           =   1  'Graphical
            TabIndex        =   11
            Top             =   60
            Width           =   1200
         End
      End
      Begin VB.VScrollBar vsbSlide 
         Height          =   2100
         Left            =   1755
         TabIndex        =   9
         Top             =   0
         Width           =   210
      End
   End
   Begin VB.PictureBox picThumb 
      Appearance      =   0  'Flat
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      BackColor       =   &H000080FF&
      BorderStyle     =   0  'None
      ForeColor       =   &H80000008&
      Height          =   750
      Left            =   3720
      ScaleHeight     =   50
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   55
      TabIndex        =   7
      Top             =   1440
      Visible         =   0   'False
      Width           =   825
   End
   Begin VB.PictureBox picLoad 
      Appearance      =   0  'Flat
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      BackColor       =   &H000080FF&
      BorderStyle     =   0  'None
      ForeColor       =   &H000000C0&
      Height          =   765
      Left            =   2850
      ScaleHeight     =   51
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   56
      TabIndex        =   6
      Top             =   1425
      Visible         =   0   'False
      Width           =   840
   End
   Begin VB.Menu mnuBook 
      Caption         =   "预订管理"
      Begin VB.Menu mnuBookthis 
         Caption         =   "预订该餐位(&Book)..."
         Enabled         =   0   'False
         Shortcut        =   ^{F2}
      End
      Begin VB.Menu mnuCancelBook 
         Caption         =   "取消预订(&Cancel)"
         Enabled         =   0   'False
      End
      Begin VB.Menu kkkkkkk 
         Caption         =   "-"
      End
      Begin VB.Menu mnuViewBOOK 
         Caption         =   "显示预订信息(&View) ..."
         Enabled         =   0   'False
         Shortcut        =   ^{F3}
      End
      Begin VB.Menu mnuInfo 
         Caption         =   "显示就餐信息(&Info) ..."
         Enabled         =   0   'False
         Shortcut        =   ^{F4}
      End
      Begin VB.Menu klllllllllll 
         Caption         =   "-"
      End
      Begin VB.Menu mnuOpen 
         Caption         =   "开台(&Table) .."
         Enabled         =   0   'False
         Shortcut        =   {F5}
      End
      Begin VB.Menu mnuTable 
         Caption         =   "点菜(&Menu)"
         Enabled         =   0   'False
         Shortcut        =   {F6}
      End
      Begin VB.Menu mnuClean 
         Caption         =   "清台(Clea&n)"
         Enabled         =   0   'False
         Shortcut        =   {F7}
      End
      Begin VB.Menu jlkiiijkj 
         Caption         =   "-"
      End
      Begin VB.Menu mnuCheckOut 
         Caption         =   "结帐(Chec&k) ..."
         Enabled         =   0   'False
         Shortcut        =   ^{F5}
      End
      Begin VB.Menu mnuChange 
         Caption         =   "换桌(&C&hange) .."
         Enabled         =   0   'False
         Shortcut        =   ^{F6}
      End
      Begin VB.Menu asdfd333 
         Caption         =   "-"
      End
      Begin VB.Menu mnuCopy 
         Caption         =   "同桌(C&opy) ..."
         Enabled         =   0   'False
         Shortcut        =   ^{F7}
      End
      Begin VB.Menu asdffsdf 
         Caption         =   "-"
      End
      Begin VB.Menu mnuMaintenans 
         Caption         =   "设置座位为维修状态(&M)"
         Enabled         =   0   'False
         Shortcut        =   ^{F8}
      End
      Begin VB.Menu mnuCancelMaintenans 
         Caption         =   "维修完毕,启用该座位(&S)"
         Enabled         =   0   'False
         Shortcut        =   ^{F9}
      End
   End
End
Attribute VB_Name = "frmSites"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit

Private Type PointAPI
    x  As Long
    y  As Long
End Type

Private mbActive                As Boolean
Private mlCurThumb              As Long
Private Const SRCCOPY           As Long = &HCC0020
Private Const STRETCH_HALFTONE  As Long = &H4&
Private Const SW_RESTORE        As Long = &H9&

Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function SetBrushOrgEx Lib "gdi32" (ByVal hdc As Long, ByVal nXOrg As Long, ByVal nYOrg As Long, lpPt As PointAPI) As Long
Private Declare Function SetStretchBltMode Lib "gdi32" (ByVal hdc As Long, ByVal nStretchMode As Long) As Long
Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Private Declare Function UnrealizeObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal Hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
'打印字幕
Private Declare Function TextOut& Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long)

Dim lCount As Long   '图片总数
Dim sWhere As String '条件字符串

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -