Private Declare Function htmlhelp Lib _
"hhctrl.ocx" Alias "HtmlHelpA" _
(ByVal hwndCaller As Long, _
ByVal pszFile As String, ByVal _
uCommand As Long, ByVal dwData As Long) As LongDim Changed As BooleanDim Button As Integer
Private Type Rect
Left As Long
Top As Long
Right As Long
Bottom As Long
End TypePrivate Type POINTAPI
X As Long
Y As Long
End Type
Private Type PageSetupDlg
lStructSize As Long
hwndOwner As Long
hDevMode As Long
hDevNames As Long
FLAGS As Long
ptPaperSize As POINTAPI
rtMinMargin As Rect
rtMargin As Rect
hInstance As Long
lCustData As Long
lpfnPageSetupHook As Long
lpfnPagePaintHook As Long
lpPageSetupTemplateName As String
hPageSetupTemplate As Long
End TypePrivate Declare Function PageSetupDlg Lib "comdlg32.dll" Alias "PageSetupDlgA" _
(pPagesetupdlg As PageSetupDlg) As Long
Dim PageSetup As PageSetupDlg
Dim Pflag As Long
Dim Pmode As Long
Dim Psize As POINTAPIPrivate Sub Form_Load()
Form1.Caption = "NoTitled-notePad"mnuUndo.Caption = "撤消(&U)" + Chr(9) + "Ctrl+Z"
mnuJian.Caption = "剪切(&T)" + Chr(9) + "Ctrl+X"
mnuCopy.Caption = "复制(&C)" + Chr(9) + "Ctrl+C"
mnuPaste.Caption = "粘贴(&P)" + Chr(9) + "Ctrl+V"
mnuJian.Enabled = False
mnuUndo.Enabled = False
mnuCopy.Enabled = FalsemnuDelete.Enabled = False
If Clipboard.GetText() <> "" Then
mnuPaste.Enabled = True
Else
mnuPaste.Enabled = False
End If
'Text1.SelAlignment = Null
Changed = FalseEnd SubPrivate Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If Changed = True Then
Button = MsgBox(Form1.Caption + "file has changed," + Chr(13) + "do you save?", vbYesNoCancel + vbExclamation)
If Button = vbYes Then
mnuSave_Click
End
ElseIf Button = vbNo Then
End
End If
Cancel = True
Else
End
End IfEnd SubPrivate Sub Form_resize()
Text1.Top = ScaleTop
Text1.Left = ScaleLeft
Text1.Width = ScaleWidth
Text1.Height = ScaleHeightEnd Sub
Private Sub mnuAbout_Click()
Form4.Show
End SubPrivate Sub mnuAll_Click()
Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)
End SubPrivate Sub mnuCline_Click()mnuCline.Checked = Not mnuCline.Checked
If mnuCline.Checked = True Then
Text1.RightMargin = 0
Else
Text1.RightMargin = 2500
End If
End SubPrivate Sub mnuCopy_Click()SendKeys "^{insert}"
End SubPrivate Sub mnuDate_Click()
Dstring = FormatDateTime(Now, 4) + Space(2) + FormatDateTime(Now, 2)
SendKeys Dstring
End SubPrivate Sub mnuDelete_Click()
Text1.SelText = ""
End SubPrivate Sub mnuExit_Click()
If Changed = True Then
Button = MsgBox(Form1.Caption + "file has changed," + Chr(13) + "do you save?", vbYesNoCancel + vbExclamation)
If Button = vbYes Then
mnuSave_Click
ElseIf Button = vbNo Then
End
End If
Else
End
End If
End SubPrivate Sub mnuFind_Click()
Form2.Show
End SubPrivate Sub mnuFont_Click()
CommonDialog1.FontName = Text1.SelFontName
CommonDialog1.FLAGS = FontsConstants.cdlCFScreenFonts
CommonDialog1.FontStrikethru = Text1.SelStrikeThru
CommonDialog1.FontBold = Text1.SelBold
CommonDialog1.FontItalic = Text1.SelItalic
CommonDialog1.FontUnderline = Text1.SelUnderline
CommonDialog1.FontSize = Text1.SelFontSize
CommonDialog1.FontStrikethru = Text1.SelStrikeThru
CommonDialog1.Color = Text1.SelColor
CommonDialog1.ShowFont
'Text1.SelFontName = CommonDialog1.FontName
'Text1.SelStrikeThru = CommonDialog1.FontStrikethru
'Text1.SelBold = CommonDialog1.FontBold
'Text1.SelColor = CommonDialog1.Color
'Text1.SelItalic = CommonDialog1.FontItalic
'Text1.SelUnderline = CommonDialog1.FontUnderline
'Text1.SelFontSize = CommonDialog1.FontSize
'Text1.SelStrikeThru = CommonDialog1.FontStrikethruText1.Font.Bold = CommonDialog1.FontBold
Text1.Font.Italic = CommonDialog1.FontItalic
Text1.Font.Name = CommonDialog1.FontName
Text1.Font.Size = CommonDialog1.FontSize
End SubPrivate Sub mnuGoto_Click()
Form3.Show
'Form3.SetFocus = Form3.Text1.Text
End SubPrivate Sub mnuHelpTopic_Click()'App.HelpFile = "e:\notepad\note.CHM"
'SendKeys "{F1}"
'yeah = shellExecute(Form1.hwnd, "open", "e:\notepad\note.CHM", Null, Null, SW_SHOWNORMAL)
'Shell "e:\notepad\note.chm", vbNormalFocus
'Shell "hh " + App.Path + "\note.chm", vbNormalFocus
'Shell "e:\notepad\note.CHM", vbNormalFocus
htmlhelp hwnd, "d:\notepad\note.CHM", 0, 0
End SubPrivate Sub mnuJian_Click()SendKeys "+{del}"
End SubPrivate Sub mnuline7_Click(Index As Integer)
Dim i As Integer
CommonDialog1.ShowOpenEnd SubPrivate Sub mnuNew_Click()
If Changed = True Then
Button = MsgBox(Form1.Caption + "file has changed," + Chr(13) + "do you save?", vbYesNoCancel + vbExclamation)
If Button = vbYes Then
mnuSave_Click
End If
End If
Text1.Text = ""
Form1.Caption = "NoTitled-notePad"
Changed = False
End Sub Private Sub mnuNext_Click()If Gstring <> "" Then
Form2.Visible = False
Form2.Command1_Click
Else
Form2.Visible = True
End IfEnd SubPrivate Sub mnuOpen_Click()
If Changed = True Then
Button = MsgBox(Form1.Caption + "file has changed," + Chr(13) + "do you save?", vbYesNoCancel + vbExclamation)
If Button = vbYes Then
mnuSave_Click
End If
End If
CommonDialog1.ShowOpen
file = CommonDialog1.FileNameIf file <> "" Then
Form1.Caption = file
Open file For Input As #1
If Not EOF(file) Then Text1.Text = Input(LOF(1), #1)
Close #1
Changed = False
End If
End SubPrivate Sub mnuPage_Click()
With PageSetup
.lStructSize = Len(PageSetup)
.hwndOwner = hwnd
PageSetupDlg PageSetup
Pflag = .FLAGS
Psize = .ptPaperSize
Pmode = .hDevMode
End With
'Pflag = PageSetupDlg(PageSetup)
'Text1.SetFocus
End SubPrivate Sub mnuPaste_Click()
SendKeys "+{insert}"
End SubPrivate Sub mnuPrint_Click()
CommonDialog1.FLAGS = Pmode
'If Text1.SelLength = 0 Then
' CommonDialog1.FLAGS = cdlPDReturnDC + cdlPDAllPages
'Else
' CommonDialog1.FLAGS = cdlPDReturnDC + cdlPDSelection
'End If
CommonDialog1.ShowPrinter
On Error GoTo trip
Printer.Print ""If CommonDialog1.hDC > 0 Then Text1.Print CommonDialog1.hDC
Printer.EndDoc
trip: End SubPrivate Sub mnuReplace_Click()
FrmReplace.Show
End SubPrivate Sub mnuSave_Click()
If Form1.Caption = "NoTitled-notePad" ThenCommonDialog1.DialogTitle = "save"
CommonDialog1.ShowSave
file = CommonDialog1.FileName
If file <> "" Then
Form1.Caption = file
Open file For Output As #1
Print #1, Text1.Text
Close #1
End IfElse
file = Form1.Caption
Open file For Output As #1
Print #1, Text1.Text
Close #1
End If
End SubPrivate Sub mnuSaveAs_Click()
CommonDialog1.DialogTitle = "save as "
CommonDialog1.ShowSave
file = CommonDialog1.FileName
If file <> "" Then
Form1.Caption = file
Open file For Output As #1
Print #1, Text1.Text
Close #1
End If
End SubPrivate Sub mnuUndo_Click()
SendKeys "^{z}"
End SubPrivate Sub Text1_Change()
Changed = True
mnuUndo.Enabled = TrueEnd Sub Private Sub Text1_SelChange()
If Text1.SelLength <> 0 Then
mnuJian.Enabled = True
mnuCopy.Enabled = True
mnuDelete.Enabled = True
Else
mnuJian.Enabled = False
mnuCopy.Enabled = False
mnuDelete.Enabled = False
End If
End Sub
"hhctrl.ocx" Alias "HtmlHelpA" _
(ByVal hwndCaller As Long, _
ByVal pszFile As String, ByVal _
uCommand As Long, ByVal dwData As Long) As LongDim Changed As BooleanDim Button As Integer
Private Type Rect
Left As Long
Top As Long
Right As Long
Bottom As Long
End TypePrivate Type POINTAPI
X As Long
Y As Long
End Type
Private Type PageSetupDlg
lStructSize As Long
hwndOwner As Long
hDevMode As Long
hDevNames As Long
FLAGS As Long
ptPaperSize As POINTAPI
rtMinMargin As Rect
rtMargin As Rect
hInstance As Long
lCustData As Long
lpfnPageSetupHook As Long
lpfnPagePaintHook As Long
lpPageSetupTemplateName As String
hPageSetupTemplate As Long
End TypePrivate Declare Function PageSetupDlg Lib "comdlg32.dll" Alias "PageSetupDlgA" _
(pPagesetupdlg As PageSetupDlg) As Long
Dim PageSetup As PageSetupDlg
Dim Pflag As Long
Dim Pmode As Long
Dim Psize As POINTAPIPrivate Sub Form_Load()
Form1.Caption = "NoTitled-notePad"mnuUndo.Caption = "撤消(&U)" + Chr(9) + "Ctrl+Z"
mnuJian.Caption = "剪切(&T)" + Chr(9) + "Ctrl+X"
mnuCopy.Caption = "复制(&C)" + Chr(9) + "Ctrl+C"
mnuPaste.Caption = "粘贴(&P)" + Chr(9) + "Ctrl+V"
mnuJian.Enabled = False
mnuUndo.Enabled = False
mnuCopy.Enabled = FalsemnuDelete.Enabled = False
If Clipboard.GetText() <> "" Then
mnuPaste.Enabled = True
Else
mnuPaste.Enabled = False
End If
'Text1.SelAlignment = Null
Changed = FalseEnd SubPrivate Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If Changed = True Then
Button = MsgBox(Form1.Caption + "file has changed," + Chr(13) + "do you save?", vbYesNoCancel + vbExclamation)
If Button = vbYes Then
mnuSave_Click
End
ElseIf Button = vbNo Then
End
End If
Cancel = True
Else
End
End IfEnd SubPrivate Sub Form_resize()
Text1.Top = ScaleTop
Text1.Left = ScaleLeft
Text1.Width = ScaleWidth
Text1.Height = ScaleHeightEnd Sub
Private Sub mnuAbout_Click()
Form4.Show
End SubPrivate Sub mnuAll_Click()
Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)
End SubPrivate Sub mnuCline_Click()mnuCline.Checked = Not mnuCline.Checked
If mnuCline.Checked = True Then
Text1.RightMargin = 0
Else
Text1.RightMargin = 2500
End If
End SubPrivate Sub mnuCopy_Click()SendKeys "^{insert}"
End SubPrivate Sub mnuDate_Click()
Dstring = FormatDateTime(Now, 4) + Space(2) + FormatDateTime(Now, 2)
SendKeys Dstring
End SubPrivate Sub mnuDelete_Click()
Text1.SelText = ""
End SubPrivate Sub mnuExit_Click()
If Changed = True Then
Button = MsgBox(Form1.Caption + "file has changed," + Chr(13) + "do you save?", vbYesNoCancel + vbExclamation)
If Button = vbYes Then
mnuSave_Click
ElseIf Button = vbNo Then
End
End If
Else
End
End If
End SubPrivate Sub mnuFind_Click()
Form2.Show
End SubPrivate Sub mnuFont_Click()
CommonDialog1.FontName = Text1.SelFontName
CommonDialog1.FLAGS = FontsConstants.cdlCFScreenFonts
CommonDialog1.FontStrikethru = Text1.SelStrikeThru
CommonDialog1.FontBold = Text1.SelBold
CommonDialog1.FontItalic = Text1.SelItalic
CommonDialog1.FontUnderline = Text1.SelUnderline
CommonDialog1.FontSize = Text1.SelFontSize
CommonDialog1.FontStrikethru = Text1.SelStrikeThru
CommonDialog1.Color = Text1.SelColor
CommonDialog1.ShowFont
'Text1.SelFontName = CommonDialog1.FontName
'Text1.SelStrikeThru = CommonDialog1.FontStrikethru
'Text1.SelBold = CommonDialog1.FontBold
'Text1.SelColor = CommonDialog1.Color
'Text1.SelItalic = CommonDialog1.FontItalic
'Text1.SelUnderline = CommonDialog1.FontUnderline
'Text1.SelFontSize = CommonDialog1.FontSize
'Text1.SelStrikeThru = CommonDialog1.FontStrikethruText1.Font.Bold = CommonDialog1.FontBold
Text1.Font.Italic = CommonDialog1.FontItalic
Text1.Font.Name = CommonDialog1.FontName
Text1.Font.Size = CommonDialog1.FontSize
End SubPrivate Sub mnuGoto_Click()
Form3.Show
'Form3.SetFocus = Form3.Text1.Text
End SubPrivate Sub mnuHelpTopic_Click()'App.HelpFile = "e:\notepad\note.CHM"
'SendKeys "{F1}"
'yeah = shellExecute(Form1.hwnd, "open", "e:\notepad\note.CHM", Null, Null, SW_SHOWNORMAL)
'Shell "e:\notepad\note.chm", vbNormalFocus
'Shell "hh " + App.Path + "\note.chm", vbNormalFocus
'Shell "e:\notepad\note.CHM", vbNormalFocus
htmlhelp hwnd, "d:\notepad\note.CHM", 0, 0
End SubPrivate Sub mnuJian_Click()SendKeys "+{del}"
End SubPrivate Sub mnuline7_Click(Index As Integer)
Dim i As Integer
CommonDialog1.ShowOpenEnd SubPrivate Sub mnuNew_Click()
If Changed = True Then
Button = MsgBox(Form1.Caption + "file has changed," + Chr(13) + "do you save?", vbYesNoCancel + vbExclamation)
If Button = vbYes Then
mnuSave_Click
End If
End If
Text1.Text = ""
Form1.Caption = "NoTitled-notePad"
Changed = False
End Sub Private Sub mnuNext_Click()If Gstring <> "" Then
Form2.Visible = False
Form2.Command1_Click
Else
Form2.Visible = True
End IfEnd SubPrivate Sub mnuOpen_Click()
If Changed = True Then
Button = MsgBox(Form1.Caption + "file has changed," + Chr(13) + "do you save?", vbYesNoCancel + vbExclamation)
If Button = vbYes Then
mnuSave_Click
End If
End If
CommonDialog1.ShowOpen
file = CommonDialog1.FileNameIf file <> "" Then
Form1.Caption = file
Open file For Input As #1
If Not EOF(file) Then Text1.Text = Input(LOF(1), #1)
Close #1
Changed = False
End If
End SubPrivate Sub mnuPage_Click()
With PageSetup
.lStructSize = Len(PageSetup)
.hwndOwner = hwnd
PageSetupDlg PageSetup
Pflag = .FLAGS
Psize = .ptPaperSize
Pmode = .hDevMode
End With
'Pflag = PageSetupDlg(PageSetup)
'Text1.SetFocus
End SubPrivate Sub mnuPaste_Click()
SendKeys "+{insert}"
End SubPrivate Sub mnuPrint_Click()
CommonDialog1.FLAGS = Pmode
'If Text1.SelLength = 0 Then
' CommonDialog1.FLAGS = cdlPDReturnDC + cdlPDAllPages
'Else
' CommonDialog1.FLAGS = cdlPDReturnDC + cdlPDSelection
'End If
CommonDialog1.ShowPrinter
On Error GoTo trip
Printer.Print ""If CommonDialog1.hDC > 0 Then Text1.Print CommonDialog1.hDC
Printer.EndDoc
trip: End SubPrivate Sub mnuReplace_Click()
FrmReplace.Show
End SubPrivate Sub mnuSave_Click()
If Form1.Caption = "NoTitled-notePad" ThenCommonDialog1.DialogTitle = "save"
CommonDialog1.ShowSave
file = CommonDialog1.FileName
If file <> "" Then
Form1.Caption = file
Open file For Output As #1
Print #1, Text1.Text
Close #1
End IfElse
file = Form1.Caption
Open file For Output As #1
Print #1, Text1.Text
Close #1
End If
End SubPrivate Sub mnuSaveAs_Click()
CommonDialog1.DialogTitle = "save as "
CommonDialog1.ShowSave
file = CommonDialog1.FileName
If file <> "" Then
Form1.Caption = file
Open file For Output As #1
Print #1, Text1.Text
Close #1
End If
End SubPrivate Sub mnuUndo_Click()
SendKeys "^{z}"
End SubPrivate Sub Text1_Change()
Changed = True
mnuUndo.Enabled = TrueEnd Sub Private Sub Text1_SelChange()
If Text1.SelLength <> 0 Then
mnuJian.Enabled = True
mnuCopy.Enabled = True
mnuDelete.Enabled = True
Else
mnuJian.Enabled = False
mnuCopy.Enabled = False
mnuDelete.Enabled = False
End If
End Sub
要相互尊重。
Hook
playyuer(女㊣爱)大哥,可否详细说明一下?
'粘贴
toolbar.buttons(1).Enabled =(Clipboard <>"")以此例推