ddwordpadmdi.frm

文档编程软件,类似WORD的一个编辑工具.

VERSION 5.00
Object = "{4932CEF1-2CAA-11D2-A165-0060081C43D9}#2.0#0"; "Actbar2.OCX"
Begin VB.MDIForm frmDDWordPadMDI 
   AutoShowChildren=   0   'False
   BackColor       =   &H8000000C&
   Caption         =   "Data Dynamics 写字板"
   ClientHeight    =   7140
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   9765
   Icon            =   "DDWordPadMDI.frx":0000
   LinkTopic       =   "MDIForm1"
   StartUpPosition =   3  '窗口缺省
   Begin ActiveBar2LibraryCtl.ActiveBar2 abDDWordPad 
      Align           =   1  'Align Top
      Height          =   7140
      Left            =   0
      TabIndex        =   0
      TabStop         =   0   'False
      Top             =   0
      Width           =   9765
      _LayoutVersion  =   1
      _ExtentX        =   17224
      _ExtentY        =   12594
      _DataPath       =   ""
      Bands           =   "DDWordPadMDI.frx":0452
   End
End
Attribute VB_Name = "frmDDWordPadMDI"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private moMRU As New cMRUFileList           '最近使用的文件
Public cdlg As New GCommonDialog            '功用对话的类

'帮助常亮和函数声明
Private Const HELP_CONTEXT = &H1            '1
Private Const HELP_QUIT = &H2               '2
Private Const HELP_INDEX = &H3              '3
Private Const HELP_CONTENTS = &H3           '3
Private Const HELP_HELPONHELP = &H4         '4
Private Const HELP_SETINDEX = &H5           '5
Private Const HELP_SETCONTENTS = &H5        '5
Private Const HELP_CONTEXTPOPUP = &H8       '8
Private Const HELP_FORCEFILE = &H9          '9
Private Const HELP_KEY = &H101              '257
Private Const HELP_COMMAND = &H102          '258
Private Const HELP_PARTIALKEY = &H105       '261

'设置当前的活动控件是否是 RichEdit 或者在入坞区的查找文本框
Public currentCtl As Control

Private Declare Function WinHelp Lib "USER32" Alias "WinHelpA" (ByVal hWnd As Long, ByVal lpHelpFile As String, ByVal wCommand As Long, ByVal dwData As Long) As Long

Private iDoc As Integer

Private m_bFontsLoaded As Boolean

Private Sub abDDWordPad_ComboDrop(ByVal tool As ActiveBar2LibraryCtl.tool)
    If tool.Name = "miFoFontName" Or tool.Name = "miFoFontSize" Then
        If Not m_bFontsLoaded Then
            FillFontCombos
            m_bFontsLoaded = True
        End If
    End If
End Sub

Private Sub abDDWordPad_ComboSelChange(ByVal tool As ActiveBar2LibraryCtl.tool)
    If TypeOf ActiveForm Is IMDIDocument Then
        If tool.Name = "miFoFontName" Then
            ActiveForm.rtf.SelFontName = tool.Text
        ElseIf tool.Name = "miFoFontSize" Then
            ActiveForm.rtf.SelFontSize = Val(tool.Text)
        End If
        
    End If
End Sub

Private Sub abDDWordPad_ToolClick(ByVal tool As ActiveBar2LibraryCtl.tool)
Dim doc As IMDIDocument
    If Not currentCtl Is Nothing Then
        If TypeOf currentCtl Is RichTextBox Then
            If Not ActiveForm Is Nothing Then
                If TypeOf ActiveForm Is IMDIDocument Then
                    Set doc = ActiveForm
                    If doc.CommandHandler(tool) Then Exit Sub
                End If
            End If
        ElseIf TypeOf currentCtl Is TextBox Then
            Select Case tool.Name
            Case "miECut"
                Clipboard.SetText currentCtl.SelText
                currentCtl.SelText = ""
            Case "miEPaste"
                currentCtl.SelText = Clipboard.GetText
            Case "miEClear"
                    SendKeys "{Del}"
            Case "miECopy"
                Clipboard.SetText currentCtl.SelText
            End Select
        End If
    End If
    
    Select Case tool.Name
    '文件
    Case "miFNew": FileNew
    Case "miFOpen": FileOpen
    Case "miFMRU1", "miFMRU2", "miFMRU3", "miFMRU4":
        FileMRU moMRU.file(tool.TagVariant)
    Case "miFExit":
        FileExit
        Exit Sub
    
    '视图
    Case "miVStandardToolbar": ViewStandard
    Case "miVFormatToolbar": ViewFormat
    Case "miVStatusBar": ViewStatusBar
    Case "miVOptions": ViewOptions
    
    '窗口
    Case "miWNew": FileNew
    Case "miWTileH": WindowTileH
    Case "miWTileV": WindowTileH
    Case "miWCascade": WindowCascade
    Case "miWArrangeIcons": WindowArrangeIcons
    
    '帮助
    Case "miHContents": HelpContents
    Case "miHWhatsThis": HelpWhatsThis tool
    Case "miHAbout": HelpAbout
    End Select
    UpdateToolbar
End Sub

Private Sub MDIForm_Load()
Dim cR As New cRegistry
    cR.ClassKey = HKEY_CURRENT_USER
    cR.SectionKey = "Software\Data Dynamics\ActiveBar\2.0\DDWordPad\MDI\MRU"
    moMRU.Load cR
    moMRU.MaxFileCount = 4

    App.HelpFile = App.Path & "\DDWordPad.HLP"
    
    Set abDDWordPad.Bands("barFind").Tools("frmFind").Custom = frmDockFind
    ' FillFontCombos
    FileNew
    UpdateToolbar
End Sub


Private Sub FileNew()
Dim f As frmMDIDoc
    Set f = New frmMDIDoc
    Dim doc As IMDIDocument
    Set doc = f
    iDoc = iDoc + 1
    
    '初始化文档并且显示窗体
    doc.InitDoc abDDWordPad, "文档 " & CStr(iDoc), True
End Sub

Private Sub FileOpen()
Dim sFile As String
    On Error GoTo ehFileOpen             '设置捕获错误
    If cdlg.VBGetOpenFileName(sFile, "RichEdit Document", True, False, False, False, "RichText Files (*.rtf)|*.rtf", , App.Path, "Open Document...", "RTF", Me.hWnd) Then
        If UCase(Right(sFile, 4)) <> ".RTF" Then
            '可能不是 RTF 文件，提示
            If MsgBox("无论如何要打开这个文件吗？", _
                vbYesNo + vbQuestion, "这个文件不是一个 RTF 文件") _
                = vbNo Then
                Exit Sub
            End If
        End If
        Dim f As New frmMDIDoc
        Dim doc As IMDIDocument
        Set doc = f

        '加载文件并且显示窗体
        doc.InitDoc abDDWordPad, sFile, False
        moMRU.AddFile sFile
        DisplayMRU
        
        '转让控制权
        DoEvents
    End If
    
ehFileOpen:
    Exit Sub
End Sub

Private Function FileMRU(sfileName As String)
    '打开文件
    ActiveForm.rtf.LoadFile sfileName
    moMRU.AddFile sfileName
    DisplayMRU
    ActiveForm.rtf.DataChanged = False
End Function


Private Sub FileExit()
    Unload Me
End Sub


Private Sub ViewStandard()
    abDDWordPad.Bands("barStandard").Visible = Not abDDWordPad.Bands("barStandard").Visible
    abDDWordPad.RecalcLayout
End Sub

Private Sub ViewFormat()
    abDDWordPad.Bands("barFormat").Visible = Not abDDWordPad.Bands("barFormat").Visible
    abDDWordPad.RecalcLayout
End Sub

Private Sub ViewStatusBar()
    abDDWordPad.Bands("sb").Visible = Not abDDWordPad.Bands("sb").Visible
    abDDWordPad.RecalcLayout
End Sub

Private Sub ViewOptions()

End Sub

Private Sub WindowTileH()
    Arrange vbTileHorizontal
End Sub

Private Sub WindowTileV()
    Arrange vbTileVertical
End Sub

Private Sub WindowCascade()
    Arrange vbCascade
End Sub

Private Sub WindowArrangeIcons()
    Arrange vbArrangeIcons
End Sub

Private Sub HelpContents()
Dim hr As Long
    hr = WinHelp(Me.hWnd, App.HelpFile, HELP_CONTENTS, 0&)
End Sub

Private Sub HelpWhatsThis(tool As ActiveBar2LibraryCtl.tool)
    tool.Checked = True
    abDDWordPad.WhatsThisHelpMode = True
End Sub

Private Sub HelpAbout()
    frmAbout.Show vbModal
End Sub


Private Sub DisplayMRU()
Dim iFile As Long
    For iFile = 1 To moMRU.FileCount
        If (moMRU.FileExists(iFile)) Then
            With abDDWordPad.Bands("mnuFile").Tools("miFMRU" & Trim$(Str(iFile)))
                If iFile = 1 Then .Checked = True
                .Visible = True
                .Caption = moMRU.MenuCaption(iFile)
                .TagVariant = CStr(iFile)
            End With
        End If
    Next iFile
    ' Debug.Print (moMRU.FileCount > 0)
    abDDWordPad.Bands("mnuFile").Tools("miFMRUSep").Visible = (moMRU.FileCount > 0)
End Sub

Private Sub UpdateToolbar()
    With abDDWordPad
        .Tools("miVStandardToolbar").Checked = .Bands("barStandard").Visible
        .Tools("miVFormatToolbar").Checked = .Bands("barFormat").Visible
        .Tools("miVStatusBar").Checked = .Bands("sb").Visible
    End With
End Sub

Private Sub FillFontCombos()
Dim i As Integer
    With abDDWordPad.Tools("miFoFontName")
        For i = 1 To Screen.FontCount
            .CBAddItem Screen.Fonts(i)
        Next
    End With
    With abDDWordPad.Tools("miFoFontSize")
        .CBAddItem " 8"
        .CBAddItem " 9"
        .CBAddItem "10"
        .CBAddItem "11"
        .CBAddItem "12"
        .CBAddItem "14"
        .CBAddItem "16"
        .CBAddItem "18"
        .CBAddItem "20"
        .CBAddItem "22"
        .CBAddItem "24"
        .CBAddItem "26"
        .CBAddItem "28"
        .CBAddItem "36"
        .CBAddItem "48"
        .CBAddItem "72"
    End With
End Sub