|
1鱼币
- unit Unit1;
- interface
- uses
- Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
- Dialogs, StdCtrls, Menus,ShellAPI;
- type
- TForm1 = class(TForm)
- mm1: TMainMenu;
- film1: TMenuItem;
- New1: TMenuItem;
- Open1: TMenuItem;
- Save1: TMenuItem;
- N1: TMenuItem;
- Exit1: TMenuItem;
- edit1: TMenuItem;
- Undo1: TMenuItem;
- N2: TMenuItem;
- Copy1: TMenuItem;
- Paste1: TMenuItem;
- Cut1: TMenuItem;
- Delete1: TMenuItem;
- N3: TMenuItem;
- All1: TMenuItem;
- N4: TMenuItem;
- Find1: TMenuItem;
- Replace1: TMenuItem;
- N5: TMenuItem;
- Datetime1: TMenuItem;
- O1: TMenuItem;
- Font1: TMenuItem;
- BackGround1: TMenuItem;
- Help1: TMenuItem;
- About1: TMenuItem;
- mmo1: TMemo;
- dlgOpen1: TOpenDialog;
- dlgSave1: TSaveDialog;
- dlgFind1: TFindDialog;
- dlgReplace1: TReplaceDialog;
- dlgFont1: TFontDialog;
- dlgColor1: TColorDialog;
- procedure Open1Click(Sender: TObject);
- procedure Save1Click(Sender: TObject);
- procedure Undo1Click(Sender: TObject);
- procedure Cut1Click(Sender: TObject);
- procedure Copy1Click(Sender: TObject);
- procedure Paste1Click(Sender: TObject);
- procedure Delete1Click(Sender: TObject);
- procedure All1Click(Sender: TObject);
- procedure Datetime1Click(Sender: TObject);
- procedure Font1Click(Sender: TObject);
- procedure BackGround1Click(Sender: TObject);
- procedure About1Click(Sender: TObject);
- procedure Find1Click(Sender: TObject);
- procedure dlgFind1Find(Sender: TObject);
- procedure Replace1Click(Sender: TObject);
- procedure dlgReplace1Replace(Sender: TObject);
- private
- { Private declarations }
- public
- { Public declarations }
- end;
- var
- Form1: TForm1;
- implementation
- {$R *.dfm}
- var
- FileName:String;
- procedure TForm1.Open1Click(Sender: TObject);
- begin
- dlgOpen1.filter :='文本文档(*.txt)|*.TXT';
- if dlgOpen1.Execute then
- begin
- FileName:=dlgOpen1.FileName;
- mmo1.Lines.LoadFromFile(FileName);
- end
- else
- Exit;
- end;
- procedure TForm1.Save1Click(Sender: TObject);
- begin
- dlgSave1.Filter:= '文本文档(*.txt)|*.TXT';
- if dlgSave1.Execute then
- begin
- FileName:= dlgSave1.FileName+'.txt';
- mmo1.Lines.SaveToFile(FileName);
- end;
- end;
- procedure TForm1.Undo1Click(Sender: TObject);
- begin
- mmo1.Undo;
- end;
- procedure TForm1.Cut1Click(Sender: TObject);
- begin
- mmo1.CutToClipboard;
- end;
- procedure TForm1.Copy1Click(Sender: TObject);
- begin
- mmo1.CopyToClipboard;
- end;
- procedure TForm1.Paste1Click(Sender: TObject);
- begin
- mmo1.PasteFromClipboard;
- end;
- procedure TForm1.Delete1Click(Sender: TObject);
- begin
- mmo1.ClearSelection;
- end;
- procedure TForm1.All1Click(Sender: TObject);
- begin
- mmo1.SelectAll;
- end;
- procedure TForm1.Datetime1Click(Sender: TObject);
- begin
- mmo1.SelText:= DateTimeToStr(Now());
- end;
- procedure TForm1.Font1Click(Sender: TObject);
- begin
- if dlgFont1.Execute then
- mmo1.Font:=dlgFont1.Font
- else
- Exit;
- end;
- procedure TForm1.BackGround1Click(Sender: TObject);
- begin
- if dlgColor1.Execute then
- mmo1.Color:=dlgColor1.Color
- else
- Exit;
- end;
- procedure TForm1.About1Click(Sender: TObject);
- begin
- ShellAbout(Self.Handle,
- PChar('鱼c编程日记本 V1.0'),
- PChar('制作人: so、so'),
- HICON(nil));
- end;
- procedure TForm1.Find1Click(Sender: TObject);
- begin
- dlgFind1.FindText:=mmo1.SelText;
- dlgFind1.Execute;
- end;
- procedure TForm1.dlgFind1Find(Sender: TObject);
- var
- i,j, PosReturn,SkipChars: Integer;
- begin
- for i:=0 to mmo1.Lines.Count do
- begin
- PosReturn:= Pos(dlgFind1.FindText,mmo1.Lines[i]);
- if PosReturn <> 0 then
- begin
- SkipChars:=0;
- for j:=0 to i-1 do
- SkipChars:= SkipChars + Length(mmo1.Lines[j]);
- SkipChars:= SkipChars + (i*2);
- SkipChars:= SkipChars + PosReturn - 1;
- mmo1.SetFocus;
- mmo1.SelStart:= SkipChars;
- mmo1.SelLength:=Length(dlgFind1.FindText);
- Break;
- end;
- end;
- end;
- procedure TForm1.Replace1Click(Sender: TObject);
- begin
- dlgReplace1.ReplaceText:=mmo1.SelText;
- dlgReplace1.Execute;
- end;
- procedure TForm1.dlgReplace1Replace(Sender: TObject);
- var
- SelPos:Integer;
- begin
- with TReplaceDialog(Sender) do
- begin
- SelPos := Pos(FindText,mmo1.Lines.Text);
- if SelPos > 0 then
- begin
- mmo1.SelStart := SelPos - 1;
- mmo1.SelLength:= Length(FindText);
- mmo1.SelText := ReplaceText;
- end
- else
- MessageBox(0,'抱歉找不到需要替换的文件!','通知',MB_OK or MB_ICONWARNING);
- end;
- end;
- end.
复制代码 发不了图、、、
|
|