📄 mdlmdimenus.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 + -