⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 mdlmdimenus.bas

📁 Simple Word Document...
💻 BAS
字号:
Attribute VB_Name = "MdlMDIMenus"
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const WM_PASTE = &H302
Public Function OpenDocument(Dlg_ As CommonDialog)
    On Error GoTo Cancelled_
    
Dim FileName_ As String
Dim FileData_ As Variant
    With Dlg_
        .CancelError = True
        .Flags = &H1000&
        .DialogTitle = "My Wordy " & App.Major & "." & App.Minor & " Open Files "
        .Filter = "My Wordy Files (*.myw)|*.myw|Text Files(*.txt)|*.txt"
        .ShowOpen
        
        Screen.MousePointer = 11
        
        
        NewDocument
        MDIfrm.ActiveForm.Caption = .FileName
        MDIfrm.ActiveForm.Document_.LoadFile (.FileName), rtfRTF
        
        Screen.MousePointer = 0
    End With
    
    Exit Function
Cancelled_:
    'MsgBox Err.Description
    Screen.MousePointer = 0
End Function

Public Function SaveDocument(Dlg_ As CommonDialog, Obj As Form)
    On Error GoTo Cancelled_

Dim FileName_ As String

If Not UCase(Left(Obj.Caption, 8)) = UCase("Document") Then
    FileName_ = Obj.Caption
    Set FWrite = FOpen.CreateTextFile(FileName_, ForWriting)
    FWrite.Write Obj.ActiveControl.TextRTF
    FWrite.Close
    Set FWrite = Nothing
    Exit Function
End If
    With Dlg_
        .CancelError = True
        .DialogTitle = "My Wordy " & App.Major & "." & App.Minor & " Save Files "
        .Filter = "My Wordy Files (*.myw)|*.myw"
        .ShowSave
        Screen.MousePointer = 11
        FileName_ = .FileName
        If Right(FileName_, 4) = ".myw" Then
            Set FWrite = FOpen.CreateTextFile(FileName_, ForWriting)
            FWrite.Write Obj.ActiveControl.TextRTF
            FWrite.Close
            Set FWrite = Nothing
        Else
            Set FWrite = FOpen.CreateTextFile(FileName_ & ".myw", ForWriting)
            FWrite.Write Obj.ActiveControl.TextRTF
            FWrite.Close
            Set FWrite = Nothing
        End If
        Obj.Caption = .FileName
        Screen.MousePointer = 0
    End With
    Exit Function
Cancelled_:
   'MsgBox Err.Description
    Screen.MousePointer = 0
End Function

Public Function SaveAsDocument(Dlg_ As CommonDialog, Obj As Form)
    On Error GoTo Cancelled_

Dim FileName_ As String

    With Dlg_
        .CancelError = True
        .DialogTitle = "My Wordy " & App.Major & "." & App.Minor & " Save as Files "
        .Filter = "My Wordy Files (*.myw)|*.myw"
        .ShowSave
        Screen.MousePointer = 11
        FileName_ = .FileName
        If Right(FileName_, 4) = ".myw" Then
            Set FWrite = FOpen.CreateTextFile(FileName_, ForWriting)
            FWrite.Write Obj.ActiveControl.TextRTF
            FWrite.Close
            Set FWrite = Nothing
        Else
            Set FWrite = FOpen.CreateTextFile(FileName_ & ".myw", ForWriting)
            FWrite.Write Obj.ActiveControl.TextRTF
            FWrite.Close
            Set FWrite = Nothing
        End If
        Obj.Caption = .FileName
        Screen.MousePointer = 0
    End With
    Exit Function
Cancelled_:
   'MsgBox Err.Description
    Screen.MousePointer = 0
End Function

Public Function OpenInsertFromFile(Dlg_ As CommonDialog)
    On Error GoTo Cancelled_
    
Dim FileName_ As String
Dim FileData_ As Variant
    With Dlg_
        .CancelError = True
        .Flags = &H1000&
        .DialogTitle = "My Wordy " & App.Major & "." & App.Minor & " Insert Picture "
        .Filter = "Bitmap Files (*.bmp)|*.bmp|JPEG Files(*.jpeg;*.jpg)|*.jpg;*.jpeg"
        .ShowOpen
            
        Screen.MousePointer = 11
        
        Clipboard.Clear
        Clipboard.SetData LoadPicture(.FileName)
    
        SendMessage MDIfrm.ActiveForm.ActiveControl.hwnd, WM_PASTE, 0, 0
        
        Clipboard.Clear
        Screen.MousePointer = 0
    End With
    
    Exit Function
Cancelled_:
    'MsgBox Err.Description
    Screen.MousePointer = 0
End Function

Public Function InsertFile(Dlg_ As CommonDialog)
    On Error GoTo Cancelled_
    
Dim FileName_ As String
Dim FileData_ As Variant
    With Dlg_
        .CancelError = True
        .Flags = &H1000&
        .DialogTitle = "My Wordy " & App.Major & "." & App.Minor & " Insert Files "
        .Filter = "My Wordy Files (*.myw)|*.myw|Text Files(*.txt)|*.txt"
        .ShowOpen
        
        Screen.MousePointer = 11
        FileName_ = .FileName
        Set FRead = FOpen.OpenTextFile(FileName_, ForReading, False)
        FileData_ = FRead.ReadAll()
        
        MDIfrm.ActiveForm.ActiveControl.SelRTF = FileData_
        Set FRead = Nothing
        Screen.MousePointer = 0
    End With
    
    Exit Function
Cancelled_:
    Screen.MousePointer = 0
    'MsgBox Err.Description
End Function


Public Function ShowFormatWindow(Dlg_ As CommonDialog)
    On Error GoTo Cancelled_

    With Dlg_
        .CancelError = True
        
        .Flags = &H101&
        
        .FontName = MDIfrm.ActiveForm.ActiveControl.SelFontName
        .FontBold = MDIfrm.ActiveForm.ActiveControl.SelBold
        .FontSize = MDIfrm.ActiveForm.ActiveControl.SelFontSize
        .FontItalic = MDIfrm.ActiveForm.ActiveControl.SelItalic
        .FontUnderline = MDIfrm.ActiveForm.ActiveControl.SelUnderline
        .FontStrikethru = MDIfrm.ActiveForm.ActiveControl.SelStrikeThru
        .Color = MDIfrm.ActiveForm.ActiveControl.SelColor
        
        .ShowFont
        
        Screen.MousePointer = 11
        
        MDIfrm.ActiveForm.ActiveControl.SelFontName = .FontName
        MDIfrm.ActiveForm.ActiveControl.SelBold = .FontBold
        MDIfrm.ActiveForm.ActiveControl.SelFontSize = .FontSize
        MDIfrm.ActiveForm.ActiveControl.SelItalic = .FontItalic
        MDIfrm.ActiveForm.ActiveControl.SelUnderline = .FontUnderline
        MDIfrm.ActiveForm.ActiveControl.SelStrikeThru = .FontStrikethru
        MDIfrm.ActiveForm.ActiveControl.SelColor = .Color
        
        Screen.MousePointer = 0
    End With
    
    Exit Function
Cancelled_:
    'MsgBox Err.Description
    Screen.MousePointer = 0
End Function



⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -