📄 frmmain.frm
字号:
Width = 8390
Begin VB.Timer tmrUpdate
Interval = 1000
Left = 3360
Top = 0
End
Begin VB.Label StatusMessage
BackStyle = 0 'Transparent
BeginProperty Font
Name = "Times New Roman"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 240
TabIndex = 12
Top = 135
Width = 6735
End
Begin VB.Label Clock
BackStyle = 0 'Transparent
BeginProperty Font
Name = "Times New Roman"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 6960
TabIndex = 11
Top = 140
Width = 1455
End
End
Begin VB.PictureBox titleBar
BorderStyle = 0 'None
Height = 375
Left = 120
ScaleHeight = 375
ScaleWidth = 11655
TabIndex = 6
Top = 90
Width = 11655
Begin VB.PictureBox Closed
Appearance = 0 'Flat
AutoRedraw = -1 'True
BackColor = &H00CCCCCC&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 280
Left = 0
MouseIcon = "frmMain.frx":531E
MousePointer = 99 'Custom
ScaleHeight = 285
ScaleWidth = 315
TabIndex = 9
Top = 60
Width = 315
End
Begin VB.PictureBox Minimized
Appearance = 0 'Flat
AutoRedraw = -1 'True
BackColor = &H00CCCCCC&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 280
Left = 11335
MouseIcon = "frmMain.frx":5628
MousePointer = 99 'Custom
ScaleHeight = 285
ScaleWidth = 315
TabIndex = 8
Top = 60
Width = 315
End
Begin VB.PictureBox Maximized
Appearance = 0 'Flat
AutoRedraw = -1 'True
BackColor = &H00CCCCCC&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 280
Left = 11065
MouseIcon = "frmMain.frx":5932
MousePointer = 99 'Custom
ScaleHeight = 285
ScaleWidth = 315
TabIndex = 7
Top = 60
Width = 315
End
End
Begin VB.PictureBox MenuContainer
BackColor = &H00C0C0C0&
BorderStyle = 0 'None
Height = 8055
Left = 240
ScaleHeight = 8055
ScaleWidth = 3015
TabIndex = 1
Top = 600
Width = 3015
Begin VB.Timer Timer1
Interval = 1000
Left = 2040
Top = 0
End
Begin VB.PictureBox cmdAbout
Appearance = 0 'Flat
AutoRedraw = -1 'True
BackColor = &H00CCCCCC&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 450
Left = 360
MouseIcon = "frmMain.frx":5C3C
MousePointer = 99 'Custom
ScaleHeight = 450
ScaleWidth = 2355
TabIndex = 14
Top = 6840
Width = 2355
End
Begin VB.PictureBox cmdShutdown
Appearance = 0 'Flat
AutoRedraw = -1 'True
BackColor = &H00CCCCCC&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 450
Left = 360
MouseIcon = "frmMain.frx":5F46
MousePointer = 99 'Custom
ScaleHeight = 450
ScaleWidth = 2355
TabIndex = 5
Top = 7440
Width = 2355
End
Begin VB.PictureBox cmdChangeUser
Appearance = 0 'Flat
AutoRedraw = -1 'True
BackColor = &H00CCCCCC&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 450
Left = 360
MouseIcon = "frmMain.frx":6250
MousePointer = 99 'Custom
ScaleHeight = 450
ScaleWidth = 2355
TabIndex = 4
Top = 6240
Width = 2355
End
Begin VB.ListBox MenuList
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 5520
Left = 240
TabIndex = 3
Top = 600
Width = 2535
End
Begin VB.PictureBox MenuHeader
BackColor = &H00C0C0C0&
BorderStyle = 0 'None
Height = 375
Left = 120
ScaleHeight = 375
ScaleWidth = 2775
TabIndex = 2
Top = 90
Width = 2775
Begin Crystal.CrystalReport ReportIt
Left = 600
Top = 0
_ExtentX = 741
_ExtentY = 741
_Version = 348160
WindowLeft = 230
WindowTop = 45
WindowWidth = 552
WindowHeight = 494
WindowBorderStyle= 0
WindowControlBox= 0 'False
WindowMaxButton = 0 'False
WindowMinButton = 0 'False
PrintFileLinesPerPage= 60
End
End
End
End
Begin VB.Shape Shape1
BorderColor = &H00FFFFFF&
BorderWidth = 2
Height = 8985
Left = 20
Top = 20
Width = 11990
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'##############################################
'# Coded by Walter A. Narvasa #
'# POS2000 - Point of Sales System #
'# #
'# area : frmMain #
'# description : Main Menu-Command Center #
'# e-mail : walter@wancom.8k.com #
'# url : http://wancom.8k.com #
'# #
'##############################################
Public What_Rpt As String
Private Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, lpSectorsPerCluster As Long, lpBytesPerSector As Long, lpNumberOfFreeClusters As Long, lpTotalNumberOfClusters As Long) As Long
Private Declare Function GetVolumeInformation Lib "kernel32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Dim i, intDiskSize, intfreeKB, intUsedKB As Long
Dim nReturnValue, SectorsPerCluster, BytesPerSector As Long
Dim TotalClusters, FreeClusters As Long
'Dim pnlError As Panel
Dim sDriveLetter, sDrive As String
Dim fs, abc, dc As Integer
Private Const SR = 0
Private Const GDI = 1
Private Const USR = 2
Private Const VER_PLATFORM_WIN32s = 0
Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Const VER_PLATFORM_WIN32_NT = 2
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
Private Type MEMORYSTATUS
dwLength As Long
dwMemoryLoad As Long
dwTotalPhys As Long
dwAvailPhys As Long
dwTotalPageFile As Long
dwAvailPageFile As Long
dwTotalVirtual As Long
dwAvailVirtual As Long
End Type
Private Declare Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As MEMORYSTATUS)
Private Declare Function pBGetFreeSystemResources Lib "rsrc32.dll" Alias "_MyGetFreeSystemResources32@4" (ByVal iResType As Integer) As Integer
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
Private mIsWin32 As Boolean
Dim datprimary As DAO.Recordset
Dim datsecondary As DAO.Recordset
Dim datthirdary As DAO.Recordset
Private Sub Closed_Click()
UnloadAllForms
End Sub
Private Sub Closed_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call BitBlt(frmMain.Closed.hDC, 0, 0, 73, 50, frmLogin.Source.hDC, 18, 107, SRCCOPY)
frmMain.Closed.Refresh
End Sub
Private Sub Closed_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call BitBlt(frmMain.Closed.hDC, 0, 0, 73, 50, frmLogin.Source.hDC, 0, 107, SRCCOPY)
frmMain.Closed.Refresh
End Sub
Private Sub cmdAbout_Click()
frmAbout.Show
End Sub
Private Sub cmdAbout_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call MacButton(" About", frmMain.cmdAbout, 0, 0, 170, 30, frmLogin.Source, 182, 30, 2)
End Sub
Private Sub cmdAbout_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call MacButton(" About", frmMain.cmdAbout, 0, 0, 170, 30, frmLogin.Source, 147, 0, 2)
End Sub
Private Sub cmdChangeUser_Click()
frmLogin.txtUserName = ""
frmLogin.txtPassword = ""
frmLogin.Show
frmLogin.txtUserName.SetFocus
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -