Windows記事本記事本

描述:
用Delphi模仿的Windows記事本 界面和功能都和Windows的記事本一樣,是用Memo實現的而不是RichEdit
可以執行以下功能 文件 打開,保存,打印, 頁面設置,撤銷,復制,粘貼,查找,替換,插入時間日期,轉到行,
保存窗體大小 位置 和讀取配置信息支持拖拽文件到記事本中...
難點
對文件的新建 打開 保存 另存 退出文件件是否保存的判斷
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;//選中的文本
文件操作
新建
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;
打印
退出
Close
編輯
撤銷
剪切
復制
粘貼
刪除
全選
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撤銷有效
當手動修改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的相關描述
查找/替換
轉到
在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;

字體...
應該調出像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控件 用它可以輕松實現常用的功能並且不用一句代碼
