注册 | 登录
收藏 | 帮助
热门文章
编辑推荐
相关文章  
消息称雅虎计划拒绝微软收购报价
雅虎公司董事会打算回绝微软收购
微软出价446亿美元洽购雅虎
微软推出OS X平台PS的HD Photo格
Microsoft AntiSpyware微软出品的
微软反间谍软件与恶意移除工具的
微软官方解读Vista安全性: 全面的
微软警告:SQL Server发现新安全
微软发表SQL Server的数据库认证
SQL Server 2000升级 微软发布SP
您现在的位置: 顶尖设计 >> IT学院 >> 编程开发 >> VB >> 文章正文
和微软一模一样的记事本的源代码(1)
作者:deak  来源:CSDN  点击:  更新:2006-12-19
简介:

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 Long

Dim Changed As Boolean

Dim Button As Integer
Private Type Rect
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private 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 Type

Private 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 POINTAPI

Private 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 = False

mnuDelete.Enabled = False
If Clipboard.GetText() <> "" Then
    mnuPaste.Enabled = True
Else
    mnuPaste.Enabled = False
End If
'Text1.SelAlignment = Null
Changed = False

End Sub

Private 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 If

End Sub

Private Sub Form_resize()
Text1.Top = ScaleTop
Text1.Left = ScaleLeft
Text1.Width = ScaleWidth
Text1.Height = ScaleHeight

End Sub


Private Sub mnuAbout_Click()
Form4.Show
End Sub

Private Sub mnuAll_Click()
Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)
End Sub

Private Sub mnuCline_Click()

mnuCline.Checked = Not mnuCline.Checked
If mnuCline.Checked = True Then
    Text1.RightMargin = 0
Else
    Text1.RightMargin = 2500
End If
End Sub

Private Sub mnuCopy_Click()

SendKeys "^{insert}"


End Sub

Private Sub mnuDate_Click()
Dstring = FormatDateTime(Now, 4) + Space(2) + FormatDateTime(Now, 2)
SendKeys Dstring
End Sub

Private Sub mnuDelete_Click()
Text1.SelText = ""
End Sub

Private 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 Sub

Private Sub mnuFind_Click()
Form2.Show
End Sub

Private 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.FontStrikethru

Text1.Font.Bold = CommonDialog1.FontBold
Text1.Font.Italic = CommonDialog1.FontItalic
Text1.Font.Name = CommonDialog1.FontName
Text1.Font.Size = CommonDialog1.FontSize


End Sub

Private Sub mnuGoto_Click()
Form3.Show
'Form3.SetFocus = Form3.Text1.Text
End Sub

Private 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 Sub

Private Sub mnuJian_Click()

SendKeys "+{del}"


End Sub

Private Sub mnuline7_Click(Index As Integer)
Dim i As Integer
CommonDialog1.ShowOpen

End Sub

Private 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 If

End Sub

Private 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.FileName

If 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 Sub

Private 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 Sub

Private Sub mnuPaste_Click()
SendKeys "+{insert}"
End Sub

Private 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 Sub

Private Sub mnuReplace_Click()
FrmReplace.Show
End Sub

Private Sub mnuSave_Click()
If Form1.Caption = "NoTitled-notePad" Then

CommonDialog1.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 If

Else
    file = Form1.Caption
    Open file For Output As #1
    Print #1, Text1.Text
    Close #1
End If
End Sub

Private 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 Sub

Private Sub mnuUndo_Click()
SendKeys "^{z}"
End Sub

Private Sub Text1_Change()
Changed = True
mnuUndo.Enabled = True

End Sub

 

Private Sub Text1_SelChange()
If Text1.SelLength

[1] [2] 下一页






  • 上一篇文章:
  • 下一篇文章:
  • 分享此文:该页面添加到 Mister Wong 添加到雅虎Yahoo!收藏 Add to:Del.icio.us Post to Furl Digg this 添加到Google书签 reddit spurl blogmarks 365Key 评论  收藏  分享  打印
     我来说两句
    姓名:       验证码:   
    主页: 
    评分: 1分 2分 3分 4分 5分
    本频道近期热评文章:
      关于我们 | 联系我们 | 站点地图 | 广告投放 | 友情链接 | 在线留言 | 版权申明
    版权所有 © 2004-2007 顶尖设计(bobd.cn)
    未经授权禁止转载,摘编,复制本站内容或建立镜像. 沪ICP备07504942号 
    网络110
    报警服务