frmmain.frm

很好的学习资料可供参考有实例从图书馆着的希望有帮祝

         Checked         =   -1  'True
      End
      Begin VB.Menu mnuWindowStatusBar 
         Caption         =   "状态栏(&B)"
         Checked         =   -1  'True
      End
      Begin VB.Menu mnuWindowBar1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuWindowTileVertical 
         Caption         =   "平铺窗口(&V)"
      End
      Begin VB.Menu mnuWindowCascade 
         Caption         =   "层叠窗口(&C)"
      End
   End
   Begin VB.Menu mnuHelp 
      Caption         =   "帮助(&H)"
      Begin VB.Menu mnuHelpSearch 
         Caption         =   "帮助主题(&S)"
      End
      Begin VB.Menu mnuHelpBar1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuHelpAbout 
         Caption         =   "关于“图书借阅系统”(&A)"
      End
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub MDIForm_Load()
    '从 Windows 注册表返回主窗体状态值,设置主窗体打开后的位置、大小
    Left = GetSetting(App.Title, "Settings", "MainLeft", 1000)
    Top = GetSetting(App.Title, "Settings", "MainTop", 1000)
    Width = GetSetting(App.Title, "Settings", "MainWidth", 6500)
    Height = GetSetting(App.Title, "Settings", "MainHeight", 6500)
    If Left(gbytAccredit, 1) = 1 Then Exit Sub
    
    mnuSysAdminRegister.Enabled = False
    tbToolBar.Buttons(1).Enabled = False
    mnuSysBookSort.Enabled = CBool(Mid(gbytAccredit, 2, 1))
    mnuSysBookRegister.Enabled = CBool(Mid(gbytAccredit, 3, 1))
    mnuSysTransactLibraryCard.Enabled = CBool(Mid(gbytAccredit, 4, 1))
    mnuSysDelData.Enabled = CBool(Mid(gbytAccredit, 5, 1))
    mnuBookBorrowRestore.Enabled = CBool(Mid(gbytAccredit, 6, 1))
    mnuSysBookInformation.Enabled = CBool(Mid(gbytAccredit, 7, 1))
    mnuBookStatistic.Enabled = CBool(Mid(gbytAccredit, 8, 1))
    
    Dim I As Integer
    For I = 2 To 8
        tbToolBar.Buttons(I).Enabled = CBool(Mid(gbytAccredit, I, 1))
    Next
End Sub

Private Sub MDIForm_Unload(Cancel As Integer)
    '在 Windows 注册表中保存主窗体状态
    If WindowState <> vbMinimized Then
        SaveSetting App.Title, "Settings", "MainLeft", Left
        SaveSetting App.Title, "Settings", "MainTop", Top
        SaveSetting App.Title, "Settings", "MainWidth", Width
        SaveSetting App.Title, "Settings", "MainHeight", Height
    End If
    EndApp '退出应用程序
End Sub

Private Sub mnuBookBorrowRestore_Click()
    frmBorrowRestore.SetFocus  '显示读者借书还书窗
End Sub

Private Sub mnuBookStatistic_Click()
    frmStatistic.SetFocus  '显示图书借阅统计窗
End Sub

Private Sub mnuSysBookInformation_Click()
    frmBookInformation.SetFocus  '显示图书信息查询窗
End Sub

Private Sub mnuSysDelData_Click()
    Dim frmNewWin As New frmDelData
    frmNewWin.Show vbModal  '显示删除冗余数据窗
    Set frmNewWin = Nothing
End Sub

Private Sub mnuWindowStatusBar_Click()
    '显示或隐藏状态栏
    If mnuWindowStatusBar.Checked Then
        sbStatusBar.Visible = False
        mnuWindowStatusBar.Checked = False
    Else
        sbStatusBar.Visible = True
        mnuWindowStatusBar.Checked = True
    End If
End Sub

Private Sub mnuWindowTileVertical_Click()
    Arrange vbTileVertical   '平铺子窗口
End Sub

Private Sub mnuWindowToolbar_Click()
    '显示或隐藏工具栏
    If mnuWindowToolbar.Checked Then
        tbToolBar.Visible = False
        mnuWindowToolbar.Checked = False
    Else
        tbToolBar.Visible = True
        mnuWindowToolbar.Checked = True
    End If
End Sub

Private Sub mnuSysTransactLibraryCard_Click()
    frmTransactCard.SetFocus  '显示读者办证窗
End Sub

Private Sub mnuXtExit_Click()
    Unload Me '退出系统
End Sub

Private Sub mnuSysAdminRegister_Click()
    Dim frmNewWin As New frmAdminRegister
    frmNewWin.Show vbModal  '显示管理员登记窗
    Set frmNewWin = Nothing
End Sub

Private Sub mnuWindowCascade_Click()
    Arrange vbCascade  '层叠子窗口
End Sub

Private Sub mnuHelpAbout_Click()
    Dim fAbout As New frmAbout
    frmAbout.Show vbModal  '显示“关于……”对话框
    Set frmAbout = Nothing
End Sub

Private Sub mnuHelpSearch_Click()
    On Error GoTo ERRB
    '打开帮助文件
    dlgCommonDialog.HelpCommand = &HB&
    dlgCommonDialog.ShowHelp
ERRB:
End Sub

Public Function File_Open(ByVal DFfilter As String, ByVal Title As String) As String
    '显示“打开文件”对话框,搜索文件路径
    On Error GoTo ERRB
    dlgCommonDialog.CancelError = True
    dlgCommonDialog.Filter = DFfilter
    dlgCommonDialog.FilterIndex = 0
    dlgCommonDialog.Flags = cdlOFNHideReadOnly
    dlgCommonDialog.DialogTitle = Title
    dlgCommonDialog.ShowOpen
    File_Open = Trim(dlgCommonDialog.FileName)
    If Dir(File_Open, vbNormal + vbReadOnly + vbHidden + vbSystem) = "" Then
        MsgBox "找不到文件：" & File_Open, vbOKOnly + vbDefaultButton1 + vbExclamation
        File_Open = ""
    End If
ERRB:
End Function

Public Sub RsNumber(strTag As String)
    sbStatusBar.Panels(1).Text = strTag
End Sub

Private Sub mnuSysBookRegister_Click()
    frmBookRegister.SetFocus  '显示图书编码入册窗
End Sub

Private Sub mnuSysBookSort_Click()
    Dim frmNewWin As New frmBookSort
    frmNewWin.Show vbModal  '显示图书类别编目设置窗
    Set frmNewWin = Nothing
End Sub

Private Sub tbToolBar_ButtonClick(ByVal Button As MSComctlLib.Button)
    '选择执行工具栏命令
    Select Case Button.Index
        Case 1
            mnuSysAdminRegister_Click
        Case 2
            mnuSysBookSort_Click
        Case 3
            mnuSysBookRegister_Click
        Case 4
            mnuSysTransactLibraryCard_Click
        Case 5
            mnuSysDelData_Click
        Case 6
            mnuBookBorrowRestore_Click
        Case 7
            mnuSysBookInformation_Click
        Case 8
            mnuBookStatistic_Click
    End Select
End Sub

Public Sub SavePhoto(ByVal strFieldName As String, rs As ADODB.Recordset, ByVal strPhotoFile As String)
    '保存图片到数据库
    On Error Resume Next
    Dim DataFile As Integer, FileLong As Long, Chunks As Integer
    Dim Fragment As Integer, Chunk() As Byte, I As Integer
    Const ChunkSize As Integer = 16384
    
    If strPhotoFile = "" Then Exit Sub
    
    DataFile = 1
    Open strPhotoFile For Binary Access Read As DataFile
        FileLong = LOF(DataFile)    ' 文件中数据长度
        If FileLong = 0 Then
            Close DataFile
            Exit Sub
        End If
        
        Chunks = FileLong \ ChunkSize
        Fragment = FileLong Mod ChunkSize
        
        ReDim Chunk(Fragment)
        Get DataFile, , Chunk()
        rs(strFieldName).AppendChunk Chunk()
        ReDim Chunk(ChunkSize)
        For I = 1 To Chunks
            Get DataFile, , Chunk()
            rs(strFieldName).AppendChunk Chunk()
        Next I
    Close DataFile
    rs.Update
End Sub

Public Sub SetPrint()
    On Error Resume Next
    '打印设置
    fMain.dlgCommonDialog.Flags = cdlPDPrintSetup
    fMain.dlgCommonDialog.ShowPrinter
End Sub