Delphi 记事本 TMemo

Windows记事本记事本

描述：

用Delphi模仿的Windows记事本界面和功能都和Windows的记事本一样,是用Memo实现的而不是RichEdit

可以执行以下功能文件打开,保存,打印，页面设置，撤销,复制，粘贴，查找，替换，插入时间日期，转到行，

保存窗体大小位置和读取配置信息支持拖拽文件到记事本中...

下载地址：http://download.csdn.net/detail/teststudio/6414215

难点

对文件的新建打开保存另存退出文件件是否保存的判断

TMemo的打印和页面设置

TMemo的文字查找和替换

Memo的常用属性

    property Align;
    property Enabled;
    property Font;
    property HideSelection;  当其值为False时 当Memo不是Active时 选中的文本任然可以看见。这个在FindDialog ReplaceDialog中有用，因为不用这样Memo1.SetFocus;
    property Lines;
    property PopupMenu;
    property ReadOnly;
    property ScrollBars;
    property TabOrder;
    property TabStop;
    property Visible;
    property WantReturns; //按回车是否自动换行
    property WantTabs;//当其什为True时 在Memo里面按Tab键会自动增加8个空格
    property WordWrap;//自动换行

Memo的常用事件

    property OnChange;
    property OnClick;
    property OnContextPopup;
    property OnEnter;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;

Memo的常用方法

TCustomEdit 
    procedure Clear; //清空
    procedure ClearSelection;//删除选中的文本
    procedure CopyToClipboard;//复制到剪切板
    procedure CutToClipboard;//剪切到剪切板
    procedure PasteFromClipboard;//粘贴
    procedure Undo;//撤销
    procedure ClearUndo;//清除撤销
    procedure SetSelText(const Value: string);//设置选中的文本
    procedure SelectAll;//全选
    property CanUndo;//是否可以撤销
    property Modified;//文档是否被 修改
    property SelStart;//被选中文本的开始位置
    property SelLength; //选中的文本长度(字符个数)
    property SelText;//选中的文本

文件操作

新建,打开,保存,另存传送门 http://www.cnblogs.com/xe2011/p/3374003.html

新建

  Memo1.Lines.Clear;
  Memo1.Modified := False;

打开

procedure TForm1.Button1Click(Sender: TObject);
begin
  with TOpenDialog.Create(nil) do
  begin
    Filter := '文本文档(*.txt)|*.txt|所有文件(*.*)|*.*';
    FileName := '*.txt';
    if Execute then
    begin
      Memo1.Lines.LoadFromFile(FileName);
      Memo1.ReadOnly := ofReadOnly in Options;
    end;
  end;
end;

保存

     Memo1.Lines.SaveToFile(FileName);
     Memo1.Modified := False;

另存

procedure TForm1.Button1Click(Sender: TObject);
begin
  with TSaveDialog.Create(nil) do
  begin
    Filter := '文本文档(*.txt)|*.txt|所有文件(*.*)|*.*';
    FileName := '*.txt';
    if Execute then
    begin
      if FileExists(FileName) then
        if MessageBox(Handle, PWideChar(Format('%s 已存在。' + #13#10 + '要替换它吗？', [FileName])),
          PWideChar('提示'), MB_YESNO + MB_ICONINFORMATION) <> idYes then
          Exit;
      Memo1.Lines.SaveToFile(FileName);
      Memo1.Modified := False;
    end;
  end;
end;

打印

页面设置

       我认为这句代码只显示出样式而实际上没有任何作用
       With TPageSetupDialog.Create(nil) do
            Execute;

打印

传送门 http://www.cnblogs.com/xe2011/p/3374229.html

退出

编辑

撤销

剪切

复制

粘贴

删除

全选

    Memo1.Undo;  //撤销
    Memo1.CutToClipboard;//剪切
    Memo1.CopyToClipboard;//复制
    Memo1.PasteFromClipboard;//粘贴
    Memo1.ClearSelection;//删除
    Memo1.SelectAll;//全选
    Memo1.Clear; //清空

注

这里为了设置快捷键的时候菜单的快捷键不要设置用字符串否则在

调用查找对话框的时候再使用Ctrl+V ,Ctrl+X,Ctrl+C行快捷键就无效了

撤销问题

delphi Memo的撤销问题
当手动修改Memo里面的文本时使用Ctrl+Z可以撤销
当使用代码设置Memo文本时如 Memo1.text:='aaaaa';设置后 Ctrl+Z 撤销就无效了
请问如何让使用代码设置的文本 Ctrl+Z撤销有效

需要引用Commctrl单元，代码如下：
var
  NewText: PChar;
begin
  NewText := 'aaaaa';
  //全选Memo1的所有文本
  SendMessage(Memo1.Handle,EM_SETSEL,0,-1);
  //将Memo1的所选文本替换为新文本
  SendMessage(Memo1.Handle,EM_REPLACESEL,-1,LPARAM(NewText));
end;
详细原因可以参考msdn中关于EM_REPLACESEL的相关描述

查找/替换

传送门 http://www.cnblogs.com/xe2011/p/3370865.html

转到

在Windows记事本中当Memo不能自动换行时才能使用转到的功能

procedure TForm1.GoToMemoLineDialog(Memo: TMemo);
var
  LineIndex1, LineLength1, selStart1, Line, i: Integer;
begin
  selStart1 := 0;
  Line := strtoint(inputbox(sGoToTitle, sGoToTips,
    inttostr(Memo.CaretPos.Y + 1))) - 1;
 
  if (Line > 0) and (Line <= Memo.Lines.Count) then
    for i := 0 to Line - 1 do
    begin
      LineIndex1 := SendMessage(Memo.Handle, EM_LINEINDEX, i, 0);
      LineLength1 := SendMessage(Memo.Handle, EM_LINELENGTH, LineIndex1, 0) + 2;
      selStart1 := selStart1 + LineLength1;
    end
  else if Line = 0 then
    Memo.SelStart := selStart1
  else
    Application.MessageBox(PWideChar('行数超出了总行数'), PWideChar('记事本 - 跳行'), 0);
    Memo.SelStart := selStart1;
end;
 
  GoToMemoLineDialog(Memo1);

时间/日期

Memo1.SetSelText((FormatDateTime('hh:mm yyyy/m/dd', now))); // 插入时间/日期

自动换行

Memo1.ScrollBars := ssVertical; // 自动换行
Memo1.WordWrap:=False;
Memo1.ScrollBars := ssBoth; // 取消自动换行
Memo1.WordWrap:=True;

使用代码设置Edit的滚动条的出现垂直的和水平的

字体...

应该调出像Window7的记事本那样的样式的字体对话框的

with TFontDialog.Create(nil) do
  begin
    Font := Memo1.Font;
    Options := [fdApplyButton];
    if Execute() then
      Memo1.Font := Font;
  end;

查看

状态栏

查看帮助

在Win7中打开一个Windows程序按下 F1 就会打开 Windows帮助和支持并且会转到相应的界面

关于记事本

ShellAbout(Form1.Handle, PWideChar('记事本'), '', Application.Icon.Handle);

隐藏属性

拖拽打开文件

private
    { Private declarations }
    procedure WMDropFiles(var Msg: TWMDropFiles); message WM_DROPFILES;
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
uses ShellApi;
{$R *.dfm}
 
procedure TForm1.FormCreate(Sender: TObject);
begin
    DragAcceptFiles(Handle, True);
end;
 
procedure TForm1.WMDropFiles(var Msg: TWMDropFiles);
var
  CFileName: array [0 .. MAX_PATH] of Char;
begin
  try
    if DragQueryFile(Msg.Drop, 0, CFileName, MAX_PATH) > 0 then
    begin
      Memo1.lines.loadFromFile(CFileName);
      Msg.Result := 0;
    end;
  finally
    DragFinish(Msg.Drop);
  end;
end;

Windows系统语言的判断

function GetUserDefaultUILanguage(): Integer; external 'Kernel32.DLL';
 
 if GetUserDefaultUILanguage() = $0804 then
   Caption:='简体中文'
  else
    Caption:='英文';

窗体的位置大小保存注册表

uses Registry;
{$R *.dfm}
 
procedure ReadConfig();
var
  reg: TRegistry;
begin
  reg := TRegistry.Create;
  reg.RootKey := HKEY_LOCAL_MACHINE;
  if reg.OpenKey('SoftWare\Testudo\Notepad', False) then
  begin
    // Form Size& Position
    Form1.Width := reg.ReadInteger('Width');
    Form1.Height := reg.ReadInteger('Height');
    Form1.Left := reg.ReadInteger('Left');
    Form1.Top := reg.ReadInteger('Top');
 
    reg.CloseKey;
    reg.Free;
  end;
  // else ShowMessage('Faild');
end;
 
procedure WriteConfig();
var
  reg: TRegistry;
begin
  reg := TRegistry.Create;
  reg.RootKey := HKEY_LOCAL_MACHINE;
  reg.CreateKey('SoftWare\Testudo\Notepad');
  reg.OpenKey('SoftWare\Testudo\Notepad', False);
  // Form Size& Position
  reg.WriteInteger('Width', Form1.Width);
  reg.WriteInteger('Height', Form1.Height);
  reg.WriteInteger('Left', Form1.Left);
  reg.WriteInteger('Top', Form1.Top);
 
  reg.CloseKey;
  reg.Free;
end;
 
 
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
    WriteConfig();
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
    ReadConfig();
end;

Windows记事本的完整代码

主窗体单元
unit Unit1;
 
interface
 
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Menus, Vcl.StdCtrls, Vcl.ComCtrls,
  Vcl.StdActns, Vcl.ActnList, Vcl.ExtActns, System.Actions, Vcl.ExtCtrls,
  Vcl.ExtDlgs;
 
function GetUserDefaultUILanguage(): Integer; external 'Kernel32.DLL';
 
type
  TForm1 = class(TForm)
    Memo1: TMemo;
    StatusBar1: TStatusBar;
    MainMenu1: TMainMenu;
    mni_File: TMenuItem;
    FileNew: TMenuItem;
    FileOpen: TMenuItem;
    FileSave: TMenuItem;
    FileSaveAs: TMenuItem;
    mni_PageSetup: TMenuItem;
    mni_Print: TMenuItem;
    mni_Exit: TMenuItem;
    mni_Edit: TMenuItem;
    mni_Undo: TMenuItem;
    mni_Cut: TMenuItem;
    mni_Copy: TMenuItem;
    mni_Paste: TMenuItem;
    mni_Delete: TMenuItem;
    mni_Find: TMenuItem;
    mni_FindNext: TMenuItem;
    mni_Replace: TMenuItem;
    mni_GoTo: TMenuItem;
    mni_SelectAll: TMenuItem;
    mni_DateTime: TMenuItem;
    mni_Format: TMenuItem;
    mni_Font: TMenuItem;
    mni_WordWrap: TMenuItem;
    mni_View: TMenuItem;
    mni_StatusBar: TMenuItem;
    mni_Help: TMenuItem;
    mni_ViewHelp: TMenuItem;
    mni_About: TMenuItem;
    mni_SetTopMoset: TMenuItem;
    FindDialog1: TFindDialog;
    ReplaceDialog1: TReplaceDialog;
    procedure FormResize(Sender: TObject);
    procedure mni_WordWrapClick(Sender: TObject);
    procedure mni_AboutClick(Sender: TObject);
    procedure mni_FontClick(Sender: TObject);
    procedure mni_DateTimeClick(Sender: TObject);
    procedure mni_GoToClick(Sender: TObject);
    procedure mni_StatusBarClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure act_WriteConfigExecute(Sender: TObject);
    procedure act_ReadConfigExecute(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure mni_PrintClick(Sender: TObject);
    procedure mni_SetTopMosetClick(Sender: TObject);
    procedure Memo1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure act_SetCaretPosExecute(Sender: TObject);
    procedure Memo1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure FindDialog1Find(Sender: TObject);
    procedure mni_DeleteClick(Sender: TObject);
    procedure mni_PasteClick(Sender: TObject);
    procedure mni_CopyClick(Sender: TObject);
    procedure mni_CutClick(Sender: TObject);
    procedure ReplaceDialog1Replace(Sender: TObject);
    procedure ReplaceDialog1Find(Sender: TObject);
    procedure mni_FindNextClick(Sender: TObject);
    procedure mni_FindClick(Sender: TObject);
    procedure mni_ReplaceClick(Sender: TObject);
    procedure mni_EditClick(Sender: TObject);
    procedure mni_UndoClick(Sender: TObject);
    procedure mni_PageSetupClick(Sender: TObject);
    procedure mni_ExitClick(Sender: TObject);
    procedure Memo1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure mni_SelectAllClick(Sender: TObject);
    procedure Memo1KeyPress(Sender: TObject; var Key: Char);
    procedure FileNewClick(Sender: TObject);
    procedure FileOpenClick(Sender: TObject);
    procedure FileSaveClick(Sender: TObject);
    procedure FileSaveAsClick(Sender: TObject);
    procedure mni_ViewHelpClick(Sender: TObject);
  private
    { Private declarations }
    FFileName: string;
    procedure CheckFileSave;
    procedure SetFileName(const FileName: String);
    procedure PerformFileOpen(const AFileName: string);
    procedure WMDropFiles(var Msg: TWMDropFiles); message WM_DROPFILES;
 
    // ------------------------------------------------------------------------------
    // procedure WMDROPFILES(var MSg: TMessage); message WM_DROPFILES;
    procedure GoToMemoLineDialog(Memo: TMemo);
    procedure SetUiCHS();
    procedure SetUiEN();
    procedure MemoPrinter(Memo: TMemo; TitleStr: string = '无标题');
    // ------------------------------------------------------------------------------
 
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
  FindStr: string;
  bStatueBar: Boolean = False;
  // ------------------------------------------------------------------------------
 
implementation
 
uses
  ShellApi, Registry, Printers, Clipbrd, StrUtils,
  Unit2, Search;
{$R *.dfm}
 
resourcestring
  sSaveChanges = '是否将未更改保存到 %s?';
  sOverWrite = '%s 已存在。' + #13#10 + '要替换它吗？';
  sTitle = '记事本';
  sUntitled = '未命名';
  sColRowInfo = '行: %3d   列: %3d';
  sLine = '行'; //
  scol = '列';
  sGoToTitle = '转到指定行'; // 轮到行的 输入对话框的标题
  sGoToTips = '行号(&L):'; //
  sMsgBoxTitle = '行数超过了总行数';
  sFileDlgFilter = '文本文档(*.txt)|*.txt|所有文件(*.*)|*.*'; // 打开和保存的文本是一样的
 
procedure TForm1.CheckFileSave;
var
  SaveRespond: Integer;
begin
  if not Memo1.Modified then
    Exit;
  SaveRespond := MessageBox(Handle, PWideChar(Format(sSaveChanges, [FFileName])
    ), PWideChar(sTitle), MB_YESNOCANCEL + MB_ICONINFORMATION);
  case SaveRespond of
    idYes:
      FileSave.click;
    idNo:
      ; { Nothing }
    idCancel:
      Abort;
  end;
end;
 
procedure TForm1.SetFileName(const FileName: String);
begin
  FFileName := FileName;
  Caption := Format('%s - %s', [ExtractFileName(FileName), sTitle]);
end;
 
procedure TForm1.PerformFileOpen(const AFileName: string);
begin
  Memo1.Lines.LoadFromFile(AFileName);
  SetFileName(AFileName);
  Memo1.SetFocus;
  Memo1.Modified := False;
end;
 
procedure TForm1.WMDropFiles(var Msg: TWMDropFiles);
var
  CFileName: array [0 .. MAX_PATH] of Char;
begin
  try
    if DragQueryFile(Msg.Drop, 0, CFileName, MAX_PATH) > 0 then
    begin
      CheckFileSave;
      PerformFileOpen(CFileName);
      Msg.Result := 0;
    end;
  finally
    DragFinish(Msg.Drop);
  end;
end;
 
{ ReplaceDialog Find }
procedure TForm1.ReplaceDialog1Find(Sender: TObject);
begin
  with Sender as TReplaceDialog do
    if not SearchMemo(Memo1, FindText, Options) then
      MessageBox(Handle, PWideChar(Concat('找不到"', FindText, '"')), '记事本',
        MB_ICONINFORMATION);
end;
 
{ ReplaceDialog Replace }
procedure TForm1.ReplaceDialog1Replace(Sender: TObject);
var
  Found: Boolean;
begin
  with ReplaceDialog1 do
  begin
    { Replace }
    if (frReplace in Options) and (Memo1.SelText = FindText) then
      Memo1.SelText := ReplaceText;
    Found := SearchMemo(Memo1, FindText, Options);
 
    { Replace All }
    if (frReplaceAll in Options) then
    begin
      Memo1.SelStart := 0;
      while Found do
      begin
        if (Memo1.SelText = FindText) then
          Memo1.SelText := ReplaceText;
        Found := SearchMemo(Memo1, FindText, Options);
      end;
      if not Found then
        SendMessage(Form1.Memo1.Handle, WM_VSCROLL, SB_TOP, 0);
    end;
 
    if (not Found) and (frReplace in Options) then
      MessageBox(Handle, PWideChar(Concat('找不到"', FindText, '"')), '记事本',
        MB_ICONINFORMATION);
  end;
 
end;
 
procedure TForm1.FileNewClick(Sender: TObject);
begin
  CheckFileSave;
  SetFileName(sUntitled);
 
  Memo1.Lines.Clear;
  Memo1.Modified := False;
end;
 
procedure TForm1.FileOpenClick(Sender: TObject);
begin
  CheckFileSave;
 
  with TOpenDialog.Create(nil) do
  begin
    Filter := sFileDlgFilter;
    FileName := '*.txt';
    if Execute then
    begin
      PerformFileOpen(FileName);
      Memo1.ReadOnly := ofReadOnly in Options;
    end;
  end;
end;
 
procedure TForm1.FileSaveClick(Sender: TObject);
begin
  if FFileName = sUntitled then
    FileSaveAs.click
  else
  begin
    Memo1.Lines.SaveToFile(FFileName);
    Memo1.Modified := False;
  end;
end;
 
procedure TForm1.FileSaveAsClick(Sender: TObject);
begin
  with TSaveDialog.Create(nil) do
  begin
    Filter := sFileDlgFilter;
    FileName := '*.txt';
    if Execute then
    begin
      if FileExists(FileName) then
        if MessageBox(Handle, PWideChar(Format(sOverWrite, [FFileName])),
          PWideChar(sTitle), MB_YESNOCANCEL + MB_ICONINFORMATION) <> idYes then
          Exit;
      Memo1.Lines.SaveToFile(FileName);
      SetFileName(FileName);
      Memo1.Modified := False;
    end;
  end;
end;
 
procedure TForm1.FindDialog1Find(Sender: TObject);
begin
  with Sender as TFindDialog do
  begin
    FindStr := FindText;
    if not SearchMemo(Memo1, FindText, Options) then
      MessageBox(Handle, PWideChar(Concat('找不到"', FindText, '"')), '记事本',
        MB_ICONINFORMATION);
  end;
end;
 
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if WindowState = wsMaximized then
    Exit;
  act_WriteConfigExecute(Sender);
  Action := caFree;
 
  CheckFileSave;
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  SetFileName(sUntitled);
  DragAcceptFiles(Handle, True);
  // FindDialog1.Options := [frDown, frHideWholeWord];
  // ReplaceDialog1.Options := [frDown, frHideWholeWord];
  with Memo1 do
  begin
    HideSelection := False;
    ScrollBars := ssVertical;
    Align := alClient;
  end;
 
  act_SetCaretPosExecute(Sender);
 
  if GetUserDefaultUILanguage() = $0804 then
    SetUiCHS // Caption:='简体中文';
  else
    SetUiEN; // Caption:='英文';
 
  // Caption := Form1Title;
  act_ReadConfigExecute(Sender);
  bStatueBar := mni_StatusBar.Checked;
 
  if mni_WordWrap.Checked then
  begin
    mni_WordWrap.click;
    mni_WordWrap.Checked := True;
    // 可以自动换行
    Memo1.ScrollBars := ssVertical;
    Memo1.WordWrap := True;
    mni_GoTo.Enabled := False;
    mni_StatusBar.Checked := False;
    mni_StatusBar.Enabled := False;
    StatusBar1.Visible := False;
  end
  else
  begin
    // 不能换行
    Memo1.ScrollBars := ssBoth;
    Memo1.WordWrap := False;
    mni_GoTo.Enabled := True;
    mni_StatusBar.Enabled := True;
    StatusBar1.Visible := bStatueBar;
  end;
 
  bStatueBar := mni_StatusBar.Checked;
  mni_StatusBar.Checked := bStatueBar;
  StatusBar1.Panels[0].Width := (75 * StatusBar1.Width) div 100;
end;
 
procedure TForm1.FormResize(Sender: TObject);
begin
  StatusBar1.Panels[0].Width := (75 * StatusBar1.Width) div 100;
  // act_WriteConfigExecute(Sender);
end;
 
procedure TForm1.GoToMemoLineDialog(Memo: TMemo);
var
  LineIndex1, LineLength1, selStart1, Line, i: Integer;
begin
  selStart1 := 0;
  Line := strtoint(inputbox(sGoToTitle, sGoToTips,
    inttostr(Memo.CaretPos.Y + 1))) - 1;
 
  if (Line > 0) and (Line <= Memo.Lines.Count) then
    for i := 0 to Line - 1 do
    begin
      LineIndex1 := SendMessage(Memo.Handle, EM_LINEINDEX, i, 0);
      LineLength1 := SendMessage(Memo.Handle, EM_LINELENGTH, LineIndex1, 0) + 2;
      selStart1 := selStart1 + LineLength1;
    end
  else if Line = 0 then
    Memo.SelStart := selStart1
  else
    MessageBox(Handle,PWideChar('行数超出了总行数'), PWideChar('记事本 - 跳行'), 0);
    Memo.SelStart := selStart1;
end;
 
procedure TForm1.Memo1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  { 你猜在编辑菜单中为何不使用系统的HotKey而在这里用手动来实现快捷键
    去除声音
  }
  if (Shift = [ssCtrl]) and (Key = $46) then // 按下<Ctrl+F>
    mni_Find.click;
 
  if (Key = vk_F3) and mni_FindNext.Enabled then // F3
    mni_FindNext.click;
 
  if (Shift = [ssCtrl]) and (Key = $48) then // Ctrl+H
    mni_Replace.click;
 
  if (Shift = [ssCtrl]) and (Key = $47) and (not Memo1.WordWrap) then // Ctrl+G
    mni_GoTo.click;
 
  if (Shift = [ssCtrl]) and (Key = $41) then // Ctrl+A
    mni_SelectAll.click;
 
  if (Key = vk_F5) then // F5
    mni_DateTime.click;
end;
 
procedure TForm1.Memo1KeyPress(Sender: TObject; var Key: Char);
begin
  // F,H,G,A
  if (Key = #6) or (Key = #1) {or (Key = #8)} or (Key = #7) then
    Key := #0;
end;
 
procedure TForm1.Memo1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  act_SetCaretPosExecute(Sender);
end;
 
procedure TForm1.Memo1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  act_SetCaretPosExecute(Sender);
end;
 
// ------------------------------------------------------------------------------
{ Edit Menu Item Enable }
procedure TForm1.mni_EditClick(Sender: TObject);
begin
  mni_Find.Enabled := (Memo1.Text <> '');
  mni_FindNext.Enabled := (Memo1.Text <> '') and (FindStr <> '');
  mni_Replace.Enabled := (Memo1.Text <> '');
 
  mni_GoTo.Enabled := not Memo1.WordWrap;
  mni_Undo.Enabled := Memo1.Modified;
  mni_Cut.Enabled := (Memo1.SelLength > 0);
  mni_Copy.Enabled := (Memo1.SelLength > 0);
  mni_Paste.Enabled := Clipboard.HasFormat(CF_TEXT);
  mni_Delete.Enabled := (Memo1.Text <> '');
  // mni_SelectAll.Enabled:= ( Memo1.SelLength <> Length(Memo1.Text) );
end;
 
procedure TForm1.mni_AboutClick(Sender: TObject);
begin
  ShellAbout(Form1.Handle, PWideChar('记事本'),
    'Roman E-Main:450640526@qq.com 2013年6月15日17:46:18',
    Application.Icon.Handle);
end;
 
procedure TForm1.mni_CopyClick(Sender: TObject);
begin
  Memo1.CopyToClipboard
end;
 
procedure TForm1.mni_CutClick(Sender: TObject);
begin
  Memo1.CutToClipboard;
end;
 
procedure TForm1.mni_DeleteClick(Sender: TObject);
begin
  // 没选中也能删除的
  // 快捷键del去掉就可以正常使用了
  Memo1.ClearSelection;
end;
 
procedure TForm1.mni_SelectAllClick(Sender: TObject);
begin
  Memo1.SelectAll;
end;
 
procedure TForm1.mni_DateTimeClick(Sender: TObject);
begin
  Memo1.SetSelText((FormatDateTime('hh:mm yyyy/m/dd', now))); // 插入时间/日期
end;
 
procedure TForm1.mni_ExitClick(Sender: TObject);
begin
  Close;
end;
 
// 调用查找对话框
procedure TForm1.mni_FindClick(Sender: TObject);
begin
  with FindDialog1 do
  begin
    Left := Self.Left + 100;
    Top := Self.Top + 150;
    FindText := Memo1.SelText;
    Execute;
  end;
end;
 
{ ReplaceDialog1.Execute }
procedure TForm1.mni_ReplaceClick(Sender: TObject);
begin
  with ReplaceDialog1 do
  begin
    Left := Self.Left + 100;
    Top := Self.Top + 150;
    FindText := Memo1.SelText;
    Execute;
  end;
end;
 
{ Find Next }
procedure TForm1.mni_FindNextClick(Sender: TObject);
begin
  if not SearchMemo(Memo1, FindStr, FindDialog1.Options) then
    MessageBox(Handle, PWideChar(Concat('找不到"', FindStr, '"')), '记事本',
      MB_ICONINFORMATION);
end;
 
procedure TForm1.mni_FontClick(Sender: TObject);
begin
  with TFontDialog.Create(nil) do
  begin
    Font := Memo1.Font;
    Options := [fdApplyButton];
    if Execute() then
      Memo1.Font := Font;
  end;
end;
 
procedure TForm1.mni_GoToClick(Sender: TObject);
begin
  GoToMemoLineDialog(Memo1);
end;
 
procedure TForm1.mni_PageSetupClick(Sender: TObject);
begin
  With TPageSetupDialog.Create(nil) do
    Execute;
end;
 
procedure TForm1.mni_PasteClick(Sender: TObject);
begin
  Memo1.PasteFromClipboard;
end;
 
procedure TForm1.mni_PrintClick(Sender: TObject);
begin
  MemoPrinter(Memo1); // 标题修改为文件名
end;
 
procedure TForm1.mni_StatusBarClick(Sender: TObject);
begin
  if mni_StatusBar.Checked then
  begin
    bStatueBar := True;
    StatusBar1.Visible := True;
  end
 
  else
  begin
    StatusBar1.Visible := False;
    bStatueBar := False;
  end;
end;
 
procedure TForm1.mni_UndoClick(Sender: TObject);
begin
  Memo1.Undo;
end;
 
procedure TForm1.mni_ViewHelpClick(Sender: TObject);
begin
  ShowMessage('在Win7中 打开一个Windows程序按下 F1 就会打开 Windows帮助和支持 并且会转到相应的界面' + #13#10
    + '如果你会写请告诉我');
end;
 
procedure TForm1.mni_WordWrapClick(Sender: TObject);
begin
  if mni_WordWrap.Checked then
  begin
    Memo1.ScrollBars := ssVertical; // 自动换行
    Memo1.WordWrap := True;
 
    // 转到 和  状态栏不可用  和状态栏菜单不可用 check为false
    mni_GoTo.Enabled := False;
 
    // ----------------------------------------
    mni_StatusBar.Enabled := False;
    mni_StatusBar.Checked := False;
    StatusBar1.Visible := False;
  end
  else
  begin
    Memo1.ScrollBars := ssBoth; // 取消自动换行
    Memo1.WordWrap := False;
 
    mni_GoTo.Enabled := True;
 
    // ----------------------------------------
    mni_StatusBar.Enabled := True;
    mni_StatusBar.Checked := bStatueBar;
    StatusBar1.Visible := bStatueBar;
  end;
  // if bStatueBar=True then Caption:='True';
  // if bStatueBar=False then Caption:='False';
 
end;
 
procedure TForm1.mni_SetTopMosetClick(Sender: TObject);
begin
  if mni_SetTopMoset.Checked then
    FormStyle := fsStayOnTop
  else
    FormStyle := fsNormal;
end;
 
procedure TForm1.SetUiCHS();
begin
  // SetUICH
  // ------------------------------------------
  mni_File.Caption := '文件(&F)';
  FileNew.Caption := '新建(&N)';
  FileOpen.Caption := '打开(&O)...';
  FileSave.Caption := '保存(&S)';
  FileSaveAs.Caption := '另存为(&A)...';
  mni_PageSetup.Caption := '页面设置(&U)...';
  mni_Print.Caption := '打印(&P)...';
  mni_Exit.Caption := '退出(&X)';
  // ------------------------------------------
  mni_Edit.Caption := '编辑(&E)';
  mni_Undo.Caption := '撤消(&U)           Ctrl+Z';
  mni_Cut.Caption := '剪切(&T)           Ctrl+X';
  mni_Copy.Caption := '复制(&C)           Ctrl+C';
  mni_Paste.Caption := '粘贴(&P)           Ctrl+V';
  mni_Delete.Caption := '删除(&L))          Del';
  mni_Find.Caption := '查找(F)...        Ctrl+F';
  mni_FindNext.Caption := '查找下一个(&N)     F3';
  mni_Replace.Caption := '替换(&R)...        Ctrl+H';
  mni_GoTo.Caption := '转到(&G)...        Ctrl+G';
  mni_SelectAll.Caption := '全选(&A)           Ctrl+A';
  mni_DateTime.Caption := '时间/日期(&D)      F5';
  // ------------------------------------------
  mni_Format.Caption := '格式(&O)';
  mni_WordWrap.Caption := '自动换行(&W)';
  mni_Font.Caption := '字体(&F)...';
  // ------------------------------------------
  mni_View.Caption := '查看(&V)';
  mni_StatusBar.Caption := '状态栏(&S)';
  mni_SetTopMoset.Caption := '置顶(&T)';
  // ------------------------------------------
  mni_Help.Caption := '帮助(&H)';
  mni_ViewHelp.Caption := '查看帮助(&H)';
  mni_About.Caption := '关于记事本(&A)';
 
  // // ------------------------------------------
  // Form1Title := '无标题 - 记事本';
  // Line := '行'; //
  // col := '列';
  // sGoToTitle := '转到指定行'; // 轮到行的 输入对话框的标题
  // sGoToTips := '行号(&L):'; //
  // MsgBoxTitle := '行数超过了总行数';
  // MsgBoxHint := '记事本 - 跳行';
  // shellAboutText := '关于 - 记事本';
  // FileDialogFilter := '文本文档(*.txt)|*.txt|所有文件(*.*)|*.*';
 
end;
 
procedure TForm1.SetUiEN();
begin
  // SetUIENGLISH
  // ------------------------------------------
  mni_File.Caption := '&File';
  FileNew.Caption := '&New';
  FileOpen.Caption := '&Open...';
  FileSave.Caption := '&Save';
  FileSaveAs.Caption := 'Save &As...';
  mni_PageSetup.Caption := 'Page Set&up...';
  mni_Print.Caption := '&Print...';
  mni_Exit.Caption := 'E&xit';
  // ------------------------------------------
  mni_Edit.Caption := '&Edit';
  mni_Undo.Caption := '&Undo           Ctrl+Z';
  mni_Cut.Caption := 'Cu&t           Ctrl+X';
  mni_Copy.Caption := '&Copy           Ctrl+C';
  mni_Paste.Caption := '&Paste)           Ctrl+V';
  mni_Delete.Caption := '&Delete          Del';
  mni_Find.Caption := '&Find...        Ctrl+F';
  mni_FindNext.Caption := 'Find &Next     F3';
  mni_Replace.Caption := '&Replace...        Ctrl+H';
  mni_GoTo.Caption := '&Go To...        Ctrl+G';
  mni_SelectAll.Caption := 'Select &All           Ctrl+A';
  mni_DateTime.Caption := 'Time/&Date      F5';
  // ------------------------------------------
  mni_Format.Caption := 'F&ormat';
  mni_WordWrap.Caption := '&Word Wrap';
  mni_Font.Caption := '&Font...';
  // ------------------------------------------
  mni_View.Caption := '&View';
  mni_StatusBar.Caption := '&StatueBar';
  mni_SetTopMoset.Caption := '&TopMost';
  // ------------------------------------------
  mni_Help.Caption := '&Help';
  mni_ViewHelp.Caption := 'View H&elp';
  mni_About.Caption := '&About Notepad';
 
  // // ------------------------------------------
  // Form1Title := 'Untitled - Notepad';
  // Line := 'Ln'; //
  // col := 'Col';
  // sGoToTitle := 'Go To Line'; // 轮到行的 输入对话框的标题
  // sGoToTips := '&Line Number:'; //
  // MsgBoxTitle := 'The line number is beyond the total number of lines';
  // MsgBoxHint := 'Notepad - Goto Line';
  // shellAboutText := ' - Notepad';
  // FileDialogFilter := 'Text File(*.txt)|*.txt|All File(*.*)|*.*';
end;
 
// Printers
procedure TForm1.MemoPrinter(Memo: TMemo; TitleStr: string = '无标题');
var
  Left: Integer;
  Top: Integer;
  i, j, X, Y: Integer; // PageHeight,
  PagesStr: String;
  posX, posY, Posx1, posY1: Integer;
  PrintDialog1: TPrintDialog;
begin
  Left := 500;
  Top := 800;
  Y := Top; // 40
  X := Left; // 80
  j := 1;
  PrintDialog1 := TPrintDialog.Create(Application);
  if PrintDialog1.Execute then
  begin
    if Memo1.Text = '' then
      Exit; // 文本为空 本次操作不会被执行
 
    With Printer do
    begin
      BeginDoc; // 另存的打印的文件名 如何实现  默认为 .jnt
      // Form2.Show;
      Canvas.Font := Memo.Font;
      // -------------------------------------------------------------------------
      // 打印文件名的标题
      // TitleStr:='无标题';
      posX := (PageWidth div 2) - Length(TitleStr) * 50; // x+1800;
      posY := (PageHeight * 6) div 100;
 
      // 第N页的标题
      PagesStr := Format('第 %d 页', [Printer.PageNumber]);
      Posx1 := (PageWidth div 2) - Length(PagesStr) * 50;
      posY1 := (PageHeight * 92) div 100;
      // -------------------------------------------------------------------------
      for i := 0 to Memo.Lines.Count - 1 do
      begin
        Canvas.TextOut(X, Y, Memo.Lines[i]); // TextOut(Left,Top,string);
        Y := Y + Memo.Font.Size * 10;
        // Memo.Font.Size*10为行间距 第1行与第2行的间距,2和3,3与4,...
 
        if (Y > PageHeight - Top) then
        begin
          Canvas.TextOut(posX, posY, TitleStr);
          for j := 1 to Printer.PageNumber do
          begin
            PagesStr := Format('第 %d 页', [j]);
            Canvas.TextOut(Posx1, posY1, PagesStr);
            // Form2.Label1.Caption := System.Concat(' 正在打印', #13#10, TitleStr,
            // #13#10, Format('第 %d 页', [j]));
            // if Form2.Tag = 1 then
            // begin
            // Abort;
            // Exit;
            // end;
          end;
          NewPage;
          Y := Top;
        end;
      end;
      Canvas.TextOut(posX, posY, TitleStr);
      Canvas.TextOut(Posx1, posY1, Format('第 %d 页', [j]));
      // Form2.Close;
      EndDoc;
    end;
  end;
end;
 
procedure TForm1.act_ReadConfigExecute(Sender: TObject);
// Read Config
var
  reg: TRegistry;
begin
  reg := TRegistry.Create;
  reg.RootKey := HKEY_LOCAL_MACHINE;
  if reg.OpenKey('SoftWare\Testudo\Notepad', False) then
  begin
    // Form Size& Position
    Form1.Width := reg.ReadInteger('Width');
    Form1.Height := reg.ReadInteger('Height');
    Form1.Left := reg.ReadInteger('Left');
    Form1.Top := reg.ReadInteger('Top');
 
    // Font
    Memo1.Font.Name := reg.ReadString('FontName');
    Memo1.Font.Size := reg.ReadInteger('FontSize');
 
    // Memo1.Font.Color:=reg.ReadString('FontColor','');
    // Memo1.Font.Style:=reg.ReadString('FontStyle','');
    // Memo1.Font.Charset:=reg.ReadString('FontCharset','');
 
    // Other
    mni_StatusBar.Checked := reg.ReadBool('StatueBarChecked');
    mni_WordWrap.Checked := reg.ReadBool('WordWrapChecked');
    reg.CloseKey;
    reg.Free;
  end;
  // else ShowMessage('Faild');
end;
 
procedure TForm1.act_WriteConfigExecute(Sender: TObject);
// WriteConfig
var
  reg: TRegistry;
begin
  reg := TRegistry.Create;
  reg.RootKey := HKEY_LOCAL_MACHINE;
  reg.CreateKey('SoftWare\Testudo\Notepad');
  reg.OpenKey('SoftWare\Testudo\Notepad', False);
  // Form Size& Position
  reg.WriteInteger('Width', Form1.Width);
  reg.WriteInteger('Height', Form1.Height);
  reg.WriteInteger('Left', Form1.Left);
  reg.WriteInteger('Top', Form1.Top);
 
  // Font
  reg.WriteString('FontName', Memo1.Font.Name);
  reg.WriteInteger('FontSize', Memo1.Font.Size);
 
  // reg.WriteString('FontColor','');
  // reg.WriteString('FontStyle','');
  // reg.WriteString('FontCharset','');
 
  // Other
  reg.WriteBool('StatueBarChecked', mni_StatusBar.Checked);
  reg.WriteBool('WordWrapChecked', mni_WordWrap.Checked);
  reg.CloseKey;
  reg.Free;
end;
 
procedure TForm1.act_SetCaretPosExecute(Sender: TObject);
begin
  if GetUserDefaultUILanguage() = $0804 then // SetUiCHS // Caption:='简体中文';
    StatusBar1.Panels[1].Text := Format('  %s %d %s,%s %d %s ',
      [sLine, Memo1.CaretPos.Y + 1, scol, sLine, Memo1.CaretPos.X + 1, scol])
  else
    // SetUiEN;  //Caption:='英文';
    StatusBar1.Panels[1].Text := Format('  %s %d ,%s %d ',
      [sLine, Memo1.CaretPos.Y + 1, scol, Memo1.CaretPos.X + 1]);
end;
 
end.

Search单元
 
///////////////////////////////////////////////////////////////////////////////////////////
//Search单元 SearchMemo
///////////////////////////////////////////////////////////////////////////////////////////
 
unit Search;
 
interface
 
uses
  SysUtils, StdCtrls, Dialogs, StrUtils;
 
function SearchMemo(Memo: TCustomEdit; const SearchString: string; Options: TFindOptions): Boolean;
 
implementation
 
function SearchMemo(Memo: TCustomEdit; const SearchString: string; Options: TFindOptions): Boolean;
var
  Buffer, P: PChar;
  Size: Word;
begin
  Result := False;
  if Length(SearchString) = 0 then
    Exit;
 
  Size := Memo.GetTextLen;
  if (Size = 0) then
    Exit;
 
  Buffer := SysUtils.StrAlloc(Size + 1);
  try
    Memo.GetTextBuf(Buffer, Size + 1);
 
    if frDown in Options then
      P := SearchBuf(Buffer, Size, Memo.SelStart, Memo.SelLength,SearchString, [soDown])
 
    else
      P := SearchBuf(Buffer, Size, Memo.SelStart, Memo.SelLength,SearchString, []);
 
    if (frMatchCase in Options) then
      P := SearchBuf(Buffer, Size, Memo.SelStart, Memo.SelLength, SearchString,[soMatchCase]);
 
    if (frWholeWord in Options) then
      P := SearchBuf(Buffer, Size, Memo.SelStart, Memo.SelLength, SearchString,[soWholeWord]);
 
    if P <> nil then
    begin
      Memo.SelStart := P - Buffer;
      Memo.SelLength := Length(SearchString);
      Result := True;
    end;
 
  finally
    SysUtils.StrDispose(Buffer);
  end;
end;
 
end.

注：

在VCL中有个ActionList控件用它可以轻松实现常用的功能并且不用一句代码

D:\Administrator\PublicDocuments\RAD Studio\11.0\Samples\Delphi

来自为知笔记(Wiz)

posted @ 2013-10-17 16:28 XE2011 阅读(3485) 评论(6) 编辑收藏举报

会员力量，点亮园子希望

刷新页面返回顶部

Testudo

每天要进步一点点。

Delphi 记事本 TMemo

描述：

难点

Memo的常用属性

Memo的常用事件

Memo的常用方法

文件操作

新建

打开

保存

另存

打印

打印

退出

编辑

撤销问题

查找/替换

转到

时间/日期

自动换行

字体...

查看

查看帮助

关于记事本

隐藏属性

拖拽打开文件

Windows系统语言的判断

窗体的位置大小保存注册表

Windows记事本的完整代码

公告

Testudo

每天要进步一点点。

Delphi 记事本 TMemo

描述：

难点

Memo的常用属性

Memo的常用事件

Memo的常用方法

文件操作

新建

打开

保存

另存

打印

打印

退出

编辑

撤销问题

查找/替换

转到

时间/日期

自动换行

字体...

查看

查看帮助

关于记事本

隐藏属性

拖拽打开文件

Windows系统语言的判断

窗体的位置大小保存 注册表

Windows记事本的完整代码

公告

窗体的位置大小保存注册表