progmain.bas

guan yu pai ke xi tong de ruan jian

Attribute VB_Name = "ProgMain"
'数据集表格定义顺序:
'0班级名称表,1教师姓名表,2科目名称表,3排课时段表,4分布特性表,5资源名称表,6教学日名称表,7系统参数表,8课程安排表.
'系统参数分别建立字段:
'早上节数,上午节数,中午节数,下午节数,晚上节数.
'纸张名称与类型：
'A3                             8
'A3 Transverse 420 x 297 mm     120
'A4                             9
'A4 Transverse 297x 210 mm      121
'A5                             11
'B4(JIS)                        12
'B5(JIS)                        13
'Fanfold 15 x 11 inch           124
'Fanfold 15 x 12 inch           123
'Fanfold 9 x 11 inch            122
'Letter                         1
'Letter Transverse 11 x 8.5 in  119


Option Explicit
Public PassWord As Boolean
Public Const MAX_FILENAME_LEN = 260
Public Const MAXLENG As Integer = 250 '字符串最大长度。
Public Declare Function FindExecutable Lib "shell32.dll" Alias "FindExecutableA" (ByVal lpFile As String, ByVal lpDirectory As String, ByVal lpResult As String) As Long '用于搜索与文档关联的程序。
Public Const LOGON_REG_PATH = "ClassDisplay\ComeProg\Logon\Windows"
Public Const LOGON_REG_LOGON = "Windows\Explorer\Field"
Public Const LOGON_REG_APPLY = "Software\Helper\Apply"
Public Const REG_SZ = 1 ' Unicode nul terminated string
Public Const REG_BINARY = 3
Public Const HKEY_CURRENT_USER = &H80000001
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Public Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Public Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
Public Declare Function timeGetTime Lib "winmm.dll" () As Long
'列表选择框自动查找。
Public Declare Function ReleaseCapture Lib "user32" () As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Const HTCAPTION = 2
Public Const CB_FINDSTRING = &H14C
Public Const LB_FINDSTRING = &H18F
'以下是用于文件操作的API函数及数据类型和常数定义。
Public Declare Function OpenFile Lib "kernel32" (ByVal lpFileName As String, lpReOpenBuff As OFSTRUCT, ByVal wStyle As Long) As Long
Public Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long
Public Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As OVERLAPPED) As Long
Public Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, lpOverlapped As OVERLAPPED) As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) As Long
Public Const OFS_MAXPATHNAME = 128
Public Type OFSTRUCT
        cBytes As Byte
        fFixedDisk As Byte
        nErrCode As Integer
        Reserved1 As Integer
        Reserved2 As Integer
        szPathName(OFS_MAXPATHNAME) As Byte
End Type
Public Type OVERLAPPED
        Internal As Long
        InternalHigh As Long
        offset As Long
        OffsetHigh As Long
        hEvent As Long
End Type
Public Const OF_CREATE = &H1000
Public Const OF_DELETE = &H200
Public Const OF_EXIST = &H4000
Public Const OF_READ = &H0
Public Const OF_READWRITE = &H2
'填充矩形.
Public Declare Function GetTextAlign Lib "gdi32" (ByVal hdc As Long) As Long
Public Declare Function SetTextAlign Lib "gdi32" (ByVal hdc As Long, ByVal wFlags As Long) As Long
Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Public Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Public Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode As Long) As Long
Public 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) As Long
Public Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long
Public Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Public Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Public Const TA_CENTER = 6
Public Const TA_LEFT = 0
Public Const TA_RIGHT = 2
Public Const TA_BASELINE = 24
Public Const TA_BOTTOM = 8
Public Const TA_TOP = 0
Public Const TA_NOUPDATECP = 0
Public Const TA_UPDATECP = 1

Public Const DT_CENTER = &H1
Public Const DT_BOTTOM = &H8
Public Const DT_LEFT = &H0
Public Const DT_TOP = &H0
Public Const DT_RIGHT = &H2
Public Const DT_VCENTER = &H4
Public Const DT_WORDBREAK = &H10
Public Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
Public Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
Public MyDataSet As New MDD_Data    '此数据结构与所有子窗口共享。
Public Const CCHFORMNAME = 32
Public Const CCHDEVICENAME = 32
Public Const DM_COPY = 2
Public Const DM_PROMPT = 4
Public Const DM_MODIFY = 8
Public Const DM_OUT_BUFFER = DM_COPY
Public Const DM_IN_BUFFER = DM_MODIFY
Public Const DM_IN_PROMPT = DM_PROMPT
Public Const DM_COPIES = &H100&
Public Const DM_DUPLEX = &H1000&
Public Const DM_ORIENTATION = &H1&
Public Const DM_DEFAULTSOURCE = &H200&
Public Const DM_PAPERSIZE = &H2&
Public Const DM_PRINTQUALITY = &H400&
Public Const DM_PAPERWIDTH = &H8&
Public Const DM_PAPERLENGTH = &H4&
Public Type DEVMODE
        dmDeviceName As String * CCHDEVICENAME
        dmSpecVersion As Integer
        dmDriverVersion As Integer
        dmSize As Integer
        dmDriverExtra As Integer
        dmFields As Long
        dmOrientation As Integer
        dmPaperSize As Integer
        dmPaperLength As Integer
        dmPaperWidth As Integer
        dmScale As Integer
        dmCopies As Integer
        dmDefaultSource As Integer
        dmPrintQuality As Integer
        dmColor As Integer
        dmDuplex As Integer
        dmYResolution As Integer
        dmTTOption As Integer
        dmCollate As Integer
        dmFormName As String * CCHFORMNAME
        dmUnusedPadding As Integer
        dmBitsPerPel As Long
        dmPelsWidth As Long
        dmPelsHeight As Long
        dmDisplayFlags As Long
        dmDisplayFrequency As Long
End Type
Public Type PRINTER_DEFAULTS
        pDataType As String
        pDevMode As DEVMODE
        DesiredAccess As Long
End Type
Public Declare Function OpenPrinter Lib "winspool.drv" Alias "OpenPrinterA" (ByVal pPrinterName As String, phPrinter As Long, pDefault As PRINTER_DEFAULTS) As Long
Public Declare Function DocumentProperties Lib "winspool.drv" Alias "DocumentPropertiesA" (ByVal hWnd As Long, ByVal hPrinter As Long, ByVal pDeviceName As String, pDevModeOutput As DEVMODE, pDevModeInput As DEVMODE, ByVal fMode As Long) As Long
Public PrintDevMode As DEVMODE
Public OutPaperInfo As PaperInfo '用于保存当前的打印纸张信息
Sub Main()
    If App.PrevInstance = True Then
        MsgBox "程序已经处于运行中！", vbOKOnly, "程序运行中..."
        Exit Sub
    End If
On Error Resume Next
    Dim FileName As String
    Dim TemStr As String
    '写入版本信息。
    If Screen.Width / Screen.TwipsPerPixelX < 800 Then
        MsgBox "重要提示：本系统要求显示器分辨率只少达到800X600！" & Chr(13) & "否则有些界面会显示不全！" & Chr(13) & "请调整你的显示器分辨率。", vbOKOnly, "显示器分辨率低..."
    End If
    FileName = Command '取命令行参数（文件名）。
    If Asc(Left(FileName, 1)) = 34 Then FileName = Right(FileName, Len(FileName) - 1) '如果命令行参数两端有双引号，则将它去掉。