unit main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, Menus, XPMan, ToolWin, Printers, Buttons;
type
TForm1 = class(TForm)
stat1: TStatusBar;
tlb1: TToolBar;
XPManifest1: TXPManifest;
mm1: TMainMenu;
N1: TMenuItem;
N2: TMenuItem;
redt1: TRichEdit;
N3: TMenuItem;
N4: TMenuItem;
N5: TMenuItem;
N6: TMenuItem;
N7: TMenuItem;
N8: TMenuItem;
N9: TMenuItem;
N10: TMenuItem;
N11: TMenuItem;
N12: TMenuItem;
N13: TMenuItem;
N14: TMenuItem;
N15: TMenuItem;
N16: TMenuItem;
N17: TMenuItem;
N18: TMenuItem;
N19: TMenuItem;
N20: TMenuItem;
N21: TMenuItem;
N22: TMenuItem;
N23: TMenuItem;
N25: TMenuItem;
pm1: TPopupMenu;
N26: TMenuItem;
N27: TMenuItem;
N28: TMenuItem;
N29: TMenuItem;
N30: TMenuItem;
N31: TMenuItem;
dlgFind1: TFindDialog;
dlgReplace1: TReplaceDialog;
dlgOpen1: TOpenDialog;
dlgSave1: TSaveDialog;
dlgPnt1: TPrintDialog;
dlgPntSet1: TPrinterSetupDialog;
N32: TMenuItem;
dlgFont1: TFontDialog;
dlgColor1: TColorDialog;
btn1: TSpeedButton;
procedure N2Click(Sender: TObject);
procedure StatusBar(Sender: TObject; var Done:Boolean);
procedure FormCreate(Sender: TObject);
procedure N13Click(Sender: TObject);
procedure N14Click(Sender: TObject);
procedure N15Click(Sender: TObject);
procedure N18Click(Sender: TObject);
procedure N17Click(Sender: TObject);
procedure N19Click(Sender: TObject);
procedure dlgFind1Find(Sender: TObject);
procedure N20Click(Sender: TObject);
procedure dlgReplace1Find(Sender: TObject);
procedure dlgReplace1Replace(Sender: TObject);
procedure N3Click(Sender: TObject);
procedure N6Click(Sender: TObject);
procedure N4Click(Sender: TObject);
procedure N7Click(Sender: TObject);
procedure N32Click(Sender: TObject);
procedure N9Click(Sender: TObject);
procedure N23Click(Sender: TObject);
procedure N25Click(Sender: TObject);
private
public
end;
var
Form1: TForm1;
EditFile:string;
implementation
{$R *.dfm}
procedure TForm1.N2Click(Sender: TObject);
begin
Close;
end;
procedure TForm1.StatusBar(Sender: TObject; var Done:Boolean);
var
MS: TMemoryStatus;
begin
stat1.Panels[0].Text:=' ' + Application.Hint;
stat1.Panels[2].Text:=' Время: ' + TimeToStr(Time);
if GetKeyState(VK_Numlock)=1
then stat1.Panels[1].Text:=' ' + '"Num Lock" Включен'
else stat1.Panels[1].Text:=' ' + '"Num Lock" Выключен';
if GetKeyState(VK_Insert)=1
then stat1.Panels[3].Text:=' ' + 'Режим замены'
else stat1.Panels[3].Text:=' ' + 'Режим вставки';
GlobalMemoryStatus(MS);
stat1.Panels[4].Text:=' Память загружена на: ' + Format('%d %%', [MS.dwMemoryLoad]);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Application.OnIdle:=StatusBar;
end;
procedure TForm1.N13Click(Sender: TObject);
begin
redt1.CutToClipboard;
end;
procedure TForm1.N14Click(Sender: TObject);
begin
redt1.CopyToClipboard;
end;
procedure TForm1.N15Click(Sender: TObject);
begin
redt1.PasteFromClipboard;
end;
procedure TForm1.N18Click(Sender: TObject);
begin
redt1.ClearSelection;
end;
procedure TForm1.N17Click(Sender: TObject);
begin
redt1.SelectAll;
end;
procedure TForm1.N19Click(Sender: TObject);
begin
dlgFind1.Execute;
end;
procedure TForm1.dlgFind1Find(Sender: TObject);
var
Buff,P,FT: PChar;
BuffLen: Word;
begin
with Sender as TFindDialog do
begin
GetMem(FT, Length(FindText) + 1);
StrPCopy(FT, FindText);
BuffLen:= redt1.GetTextLen + 1;
GetMem(Buff, BuffLen);
redt1.GetTextBuf(Buff, BuffLen);
P:= Buff + redt1.SelStart + redt1.SelLength;
P:= StrPos(P, FT);
if P=nil then MessageBeep(0)
else
begin
redt1.SelStart:= P - Buff;
redt1.SelLength:= Length(FindText);
end;
FreeMem(FT, Length(FindText) + 1);
FreeMem(Buff, BuffLen);
end;
end;
procedure TForm1.N20Click(Sender: TObject);
begin
dlgReplace1.Execute;
end;
procedure TForm1.dlgReplace1Find(Sender: TObject);
begin
with Sender as TReplaceDialog do
while True do
begin
if redt1.SelText <> FindText then
dlgFind1Find(Sender);
if redt1.SelLength = 0 then Break;
redt1.SelText:= ReplaceText;
if not (frReplaceAll in Options) then Break;
end;
end;
procedure TForm1.dlgReplace1Replace(Sender: TObject);
label 10;
begin
redt1.HideSelection:=true;
10:
if pos(dlgReplace1.FindText,redt1.Text)<>0 then
begin
redt1.SelStart:=pos(dlgReplace1.FindText,redt1.Text)-1;
redt1.SelLength:=Length(dlgReplace1.FindText);
redt1.SelText:=dlgReplace1.ReplaceText;
goto 10;
end;
redt1.HideSelection:=false;
end;
procedure TForm1.N3Click(Sender: TObject);
begin
redt1.Lines.Clear;
end;
procedure TForm1.N4Click(Sender: TObject);
begin
if dlgOpen1.Execute then
begin
EditFile:=dlgOpen1.FileName;
redt1.Lines.LoadFromFile(EditFile);
Form1.Caption:='Документ - '+ExtractFileName(EditFile);
end;
end;
procedure TForm1.N6Click(Sender: TObject);
begin
if dlgSave1.Execute then
redt1.Lines.SaveToFile(EditFile);
if redt1.Modified then redt1.Modified:=false;
end;
procedure TForm1.N7Click(Sender: TObject);
begin
if dlgSave1.Execute then
begin
EditFile:=dlgSave1.FileName;
redt1.Lines.SaveToFile(EditFile);
Form1.Caption:='Документ - '+ExtractFileName(EditFile);
if redt1.Modified then redt1.Modified:=false;
end;
end;
procedure TForm1.N32Click(Sender: TObject);
begin
dlgPntSet1.Execute;
end;
procedure TForm1.N9Click(Sender: TObject);
var
Stroka:System.TextFile;
i:integer;
begin
if dlgPnt1.Execute then
begin
AssignPrn(Stroka);
Rewrite(Stroka);
Printer.Canvas.Font:=redt1.Font;
for i:=0 to redt1.Lines.Count-1 do
Writeln(Stroka,redt1.Lines[i]);
System.CloseFile(Stroka);
end;
end;
procedure TForm1.N23Click(Sender: TObject);
begin
if dlgFont1.Execute then redt1.Font:=dlgFont1.Font;
end;
procedure TForm1.N25Click(Sender: TObject);
begin
if dlgColor1.Execute then redt1.Color:=dlgColor1.Color;
end;
end.
02.05.2011, 19:17
Курсовой проект
Линейный вид
