frmmain.frm

来自「能实现图书馆的图书操作」· FRM 代码 · 共 814 行 · 第 1/2 页

      End
      Begin VB.Menu mnuViewBar1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuViewArrangeIcons 
         Caption         =   "1024"
      End
      Begin VB.Menu mnuViewBar2 
         Caption         =   "-"
      End
      Begin VB.Menu mnuViewRefresh 
         Caption         =   "1025"
      End
      Begin VB.Menu mnuViewOptions 
         Caption         =   "1026"
      End
      Begin VB.Menu mnuViewWebBrowser 
         Caption         =   "1027"
      End
   End
   Begin VB.Menu mnuTools 
      Caption         =   "1028"
      Begin VB.Menu mnuToolsOptions 
         Caption         =   "1029"
      End
   End
   Begin VB.Menu mnuHelp 
      Caption         =   "1030"
      Begin VB.Menu mnuHelpContents 
         Caption         =   "1031"
      End
      Begin VB.Menu mnuHelpSearchForHelpOn 
         Caption         =   "1032"
      End
      Begin VB.Menu mnuHelpBar0 
         Caption         =   "-"
      End
      Begin VB.Menu mnuHelpAbout 
         Caption         =   "1033"
      End
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Const NAME_COLUMN = 0
Const TYPE_COLUMN = 1
Const SIZE_COLUMN = 2
Const DATE_COLUMN = 3
Private Declare Function OSWinHelp% Lib "user32" Alias "WinHelpA" (ByVal hwnd&, ByVal HelpFile$, ByVal wCommand%, dwData As Any)
  
Dim mbMoving As Boolean
Const sglSplitLimit = 500

Private Sub Form_Load()
    LoadResStrings Me
    Me.Left = GetSetting(App.Title, "Settings", "MainLeft", 1000)
    Me.Top = GetSetting(App.Title, "Settings", "MainTop", 1000)
    Me.Width = GetSetting(App.Title, "Settings", "MainWidth", 6500)
    Me.Height = GetSetting(App.Title, "Settings", "MainHeight", 6500)
End Sub


Private Sub Form_Paint()
    lvListView.View = Val(GetSetting(App.Title, "Settings", "ViewMode", "0"))
    Select Case lvListView.View
        Case lvwIcon
            tbToolBar.Buttons(LISTVIEW_MODE0).Value = tbrPressed
        Case lvwSmallIcon
            tbToolBar.Buttons(LISTVIEW_MODE1).Value = tbrPressed
        Case lvwList
            tbToolBar.Buttons(LISTVIEW_MODE2).Value = tbrPressed
        Case lvwReport
            tbToolBar.Buttons(LISTVIEW_MODE3).Value = tbrPressed
    End Select
End Sub


Private Sub Form_Unload(Cancel As Integer)
    Dim i As Integer


    'close all sub forms
    For i = Forms.Count - 1 To 1 Step -1
        Unload Forms(i)
    Next
    If Me.WindowState <> vbMinimized Then
        SaveSetting App.Title, "Settings", "MainLeft", Me.Left
        SaveSetting App.Title, "Settings", "MainTop", Me.Top
        SaveSetting App.Title, "Settings", "MainWidth", Me.Width
        SaveSetting App.Title, "Settings", "MainHeight", Me.Height
    End If
    SaveSetting App.Title, "Settings", "ViewMode", lvListView.View
End Sub



Private Sub Form_Resize()
    On Error Resume Next
    If Me.Width < 3000 Then Me.Width = 3000
    SizeControls imgSplitter.Left
End Sub


Private Sub imgSplitter_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    With imgSplitter
        picSplitter.Move .Left, .Top, .Width \ 2, .Height - 20
    End With
    picSplitter.Visible = True
    mbMoving = True
End Sub


Private Sub imgSplitter_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim sglPos As Single
    

    If mbMoving Then
        sglPos = X + imgSplitter.Left
        If sglPos < sglSplitLimit Then
            picSplitter.Left = sglSplitLimit
        ElseIf sglPos > Me.Width - sglSplitLimit Then
            picSplitter.Left = Me.Width - sglSplitLimit
        Else
            picSplitter.Left = sglPos
        End If
    End If
End Sub


Private Sub imgSplitter_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    SizeControls picSplitter.Left
    picSplitter.Visible = False
    mbMoving = False
End Sub


Private Sub TreeView1_DragDrop(Source As Control, X As Single, Y As Single)
    If Source = imgSplitter Then
        SizeControls X
    End If
End Sub


Sub SizeControls(X As Single)
    On Error Resume Next
    

    '设置 Width 属性
    If X < 1500 Then X = 1500
    If X > (Me.Width - 1500) Then X = Me.Width - 1500
    tvTreeView.Width = X
    imgSplitter.Left = X
    lvListView.Left = X + 40
    lvListView.Width = Me.Width - (tvTreeView.Width + 140)
    lblTitle(0).Width = tvTreeView.Width
    lblTitle(1).Left = lvListView.Left + 20
    lblTitle(1).Width = lvListView.Width - 40


    '设置 Top 属性
  

    If tbToolBar.Visible Then
        tvTreeView.Top = tbToolBar.Height + picTitles.Height
    Else
        tvTreeView.Top = picTitles.Height
    End If

  lvListView.Top = tvTreeView.Top
    

    '设置 height 属性
    If sbStatusBar.Visible Then
        tvTreeView.Height = Me.ScaleHeight - (picTitles.Top + picTitles.Height + sbStatusBar.Height)
    Else
        tvTreeView.Height = Me.ScaleHeight - (picTitles.Top + picTitles.Height)
    End If
    

    lvListView.Height = tvTreeView.Height
    imgSplitter.Top = tvTreeView.Top
    imgSplitter.Height = tvTreeView.Height
End Sub

Private Sub tbToolBar_ButtonClick(ByVal Button As MSComCtlLib.Button)
    On Error Resume Next
    Select Case Button.Key
        Case "返回"
            '应做:添加 '返回' 按钮代码。
            MsgBox "添加 '返回' 按钮代码。"
        Case "向前"
            '应做:添加 '向前' 按钮代码。
            MsgBox "添加 '向前' 按钮代码。"
        Case "剪切"
            mnuEditCut_Click
        Case "复制"
            mnuEditCopy_Click
        Case "粘贴"
            mnuEditPaste_Click
        Case "删除"
            mnuFileDelete_Click
        Case "属性"
            mnuFileProperties_Click
        Case "大图标"
            lvListView.View = lvwIcon
        Case "小图标"
            lvListView.View = lvwSmallIcon
        Case "列表"
            lvListView.View = lvwList
        Case "详细资料"
            lvListView.View = lvwReport
    End Select
End Sub

Private Sub mnuHelpAbout_Click()
    frmAbout.Show vbModal, Me
End Sub

Private Sub mnuHelpSearchForHelpOn_Click()
    Dim nRet As Integer


    '如果这个工程没有帮助文件，显示消息给用户
    '可以在“工程属性”对话框中为应用程序设置帮助文件
    If Len(App.HelpFile) = 0 Then
        MsgBox "无法显示帮助目录，该工程没有相关联的帮助。", vbInformation, Me.Caption
    Else

    On Error Resume Next
        nRet = OSWinHelp(Me.hwnd, App.HelpFile, 261, 0)
        If Err Then
            MsgBox Err.Description
        End If
    End If

End Sub

Private Sub mnuHelpContents_Click()
    Dim nRet As Integer


    '如果这个工程没有帮助文件，显示消息给用户
    '可以在“工程属性”对话框中为应用程序设置帮助文件
    If Len(App.HelpFile) = 0 Then
        MsgBox "无法显示帮助目录，该工程没有相关联的帮助。", vbInformation, Me.Caption
    Else
        On Error Resume Next
        nRet = OSWinHelp(Me.hwnd, App.HelpFile, 3, 0)
        If Err Then
            MsgBox Err.Description
        End If
    End If

End Sub


Private Sub mnuToolsOptions_Click()
    '应做:添加 'mnuToolsOptions_Click' 代码。
    MsgBox "添加 'mnuToolsOptions_Click' 代码。"
End Sub

Private Sub mnuViewWebBrowser_Click()
    '应做:添加 'mnuViewWebBrowser_Click' 代码。
    MsgBox "添加 'mnuViewWebBrowser_Click' 代码。"
End Sub

Private Sub mnuViewOptions_Click()
    '应做:添加 'mnuViewOptions_Click' 代码。
    MsgBox "添加 'mnuViewOptions_Click' 代码。"
End Sub

Private Sub mnuViewRefresh_Click()
    '应做:添加 'mnuViewRefresh_Click' 代码。
    MsgBox "添加 'mnuViewRefresh_Click' 代码。"
End Sub



Private Sub mnuVAIByDate_Click()
    'ToDo: 添加 'mnuVAIByDate_Click' 代码
'  lvListView.SortKey = DATE_COLUMN
End Sub


Private Sub mnuVAIByName_Click()
    'ToDo: 添加 'mnuVAIByName_Click' 代码
'  lvListView.SortKey = NAME_COLUMN
End Sub


Private Sub mnuVAIBySize_Click()
    'ToDo: 添加 'mnuVAIBySize_Click' 代码
'  lvListView.SortKey = SIZE_COLUMN
End Sub


Private Sub mnuVAIByType_Click()
    'ToDo: 添加 'mnuVAIByType_Click' 代码
'  lvListView.SortKey = TYPE_COLUMN
End Sub

Private Sub mnuViewStatusBar_Click()
    mnuViewStatusBar.Checked = Not mnuViewStatusBar.Checked
    sbStatusBar.Visible = mnuViewStatusBar.Checked
    SizeControls imgSplitter.Left
End Sub

Private Sub mnuViewToolbar_Click()
    mnuViewToolbar.Checked = Not mnuViewToolbar.Checked
    tbToolBar.Visible = mnuViewToolbar.Checked
    SizeControls imgSplitter.Left
End Sub

Private Sub mnuEditInvertSelection_Click()
    '应做:添加 'mnuEditInvertSelection_Click' 代码。
    MsgBox "添加 'mnuEditInvertSelection_Click' 代码。"
End Sub

Private Sub mnuEditSelectAll_Click()
    '应做:添加 'mnuEditSelectAll_Click' 代码。
    MsgBox "添加 'mnuEditSelectAll_Click' 代码。"
End Sub

Private Sub mnuEditPasteSpecial_Click()
    '应做:添加 'mnuEditPasteSpecial_Click' 代码。
    MsgBox "添加 'mnuEditPasteSpecial_Click' 代码。"
End Sub

Private Sub mnuEditPaste_Click()
    '应做:添加 'mnuEditPaste_Click' 代码。
    MsgBox "添加 'mnuEditPaste_Click' 代码。"
End Sub

Private Sub mnuEditCopy_Click()
    '应做:添加 'mnuEditCopy_Click' 代码。
    MsgBox "添加 'mnuEditCopy_Click' 代码。"
End Sub

Private Sub mnuEditCut_Click()
    '应做:添加 'mnuEditCut_Click' 代码。
    MsgBox "添加 'mnuEditCut_Click' 代码。"
End Sub

Private Sub mnuEditUndo_Click()
    '应做:添加 'mnuEditUndo_Click' 代码。
    MsgBox "添加 'mnuEditUndo_Click' 代码。"
End Sub

Private Sub mnuFileClose_Click()
    '卸载窗体
    Unload Me

End Sub

Private Sub mnuFileProperties_Click()
    '应做:添加 'mnuFileProperties_Click' 代码。
    MsgBox "添加 'mnuFileProperties_Click' 代码。"
End Sub

Private Sub mnuFileRename_Click()
    '应做:添加 'mnuFileRename_Click' 代码。
    MsgBox "添加 'mnuFileRename_Click' 代码。"
End Sub

Private Sub mnuFileDelete_Click()
    '应做:添加 'mnuFileDelete_Click' 代码。
    MsgBox "添加 'mnuFileDelete_Click' 代码。"
End Sub

Private Sub mnuFileNew_Click()
    '应做:添加 'mnuFileNew_Click' 代码。
    MsgBox "添加 'mnuFileNew_Click' 代码。"
End Sub

Private Sub mnuFileSendTo_Click()
    '应做:添加 'mnuFileSendTo_Click' 代码。
    MsgBox "添加 'mnuFileSendTo_Click' 代码。"
End Sub

Private Sub mnuFileFind_Click()
    '应做:添加 'mnuFileFind_Click' 代码。
    MsgBox "添加 'mnuFileFind_Click' 代码。"
End Sub

Private Sub mnuFileOpen_Click()
    Dim sFile As String


    With dlgCommonDialog
        .DialogTitle = "打开"
        .CancelError = False
        'ToDo: 设置 common dialog 控件的标志和属性
        .Filter = "所有文件 (*.*)|*.*"
        .ShowOpen
        If Len(.FileName) = 0 Then
            Exit Sub
        End If
        sFile = .FileName
    End With
    'ToDo: 添加处理打开的文件的代码

End Sub