Добавил:
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
Скачиваний:
28
Добавлен:
16.04.2013
Размер:
13.83 Кб
Скачать
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, StdCtrls, ComCtrls, ExtCtrls, Buttons, ToolWin;

type
TfmMain = class(TForm)
mmEditor: TMemo;
MainMenu1: TMainMenu;
PopupMenu1: TPopupMenu;
mmFile: TMenuItem;
mmEdit: TMenuItem;
mmFormat: TMenuItem;
mmCreate: TMenuItem;
mmOpen: TMenuItem;
mmSaveAs: TMenuItem;
mmExit: TMenuItem;
mmCut: TMenuItem;
mmCopy: TMenuItem;
mmPaste: TMenuItem;
mmFind: TMenuItem;
mmChange: TMenuItem;
mmFont: TMenuItem;
mmFontColor: TMenuItem;
N15: TMenuItem;
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
FontDialog1: TFontDialog;
ColorDialog1: TColorDialog;
PrintDialog1: TPrintDialog;
PrinterSetupDialog1: TPrinterSetupDialog;
FindDialog1: TFindDialog;
ReplaceDialog1: TReplaceDialog;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
PrintConfig: TMenuItem;
Print: TMenuItem;
StatusBar1: TStatusBar;
Panel1: TPanel;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
BitBtn3: TBitBtn;
BitBtn4: TBitBtn;
BitBtn6: TBitBtn;
BitBtn7: TBitBtn;
BitBtn8: TBitBtn;
BitBtn9: TBitBtn;
BitBtn10: TBitBtn;
BitBtn11: TBitBtn;
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
SpeedButton3: TSpeedButton;
BitBtn5: TBitBtn;
procedure mmExitClick(Sender: TObject);
procedure mmSaveAsClick(Sender: TObject);
procedure mmOpenClick(Sender: TObject);
procedure mmCreateClick(Sender: TObject);
procedure mmFontColorClick(Sender: TObject);
procedure mmFontClick(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure N3Click(Sender: TObject);
procedure N4Click(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure mmCutClick(Sender: TObject);
procedure mmCopyClick(Sender: TObject);
procedure mmPasteClick(Sender: TObject);
procedure PrintConfigClick(Sender: TObject);
procedure PrintClick(Sender: TObject);
procedure mmFindClick(Sender: TObject);
procedure FindDialog1Find(Sender: TObject);
procedure mmChangeClick(Sender: TObject);
procedure Replace(Sender: TObject);
procedure RealReplace(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure BitBtn3Click(Sender: TObject);
procedure BitBtn4Click(Sender: TObject);
procedure BitBtn6Click(Sender: TObject);
procedure BitBtn7Click(Sender: TObject);
procedure BitBtn8Click(Sender: TObject);
procedure BitBtn9Click(Sender: TObject);
procedure BitBtn10Click(Sender: TObject);
procedure BitBtn11Click(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
procedure SpeedButton3Click(Sender: TObject);
procedure fmCreate(Sender:TObject);
// procedure SpeedButton2Click(Sender: TObject);
// procedure fmMain.FindDialog1Find(Sender: TObject);
private

public

end;
var
fmMain: TfmMain;
FName:string;
Bold,Italic,Underline:boolean;
SPos,difference:integer;
implementation



{$R *.dfm}



procedure TfmMain.mmExitClick(Sender: TObject); //exit
begin
fmMain.Close;
end;



procedure TfmMain.mmSaveAsClick(Sender: TObject); //save as
begin
SaveDialog1.FileName:=FName;
if SaveDialog1.Execute then
begin
FName:= SaveDialog1.FileName;
mmEditor.Lines.SaveToFile(FName);
fmMain.Caption:=FName;
end;
end;



procedure TfmMain.mmOpenClick(Sender: TObject); //open
begin
OpenDialog1.FileName:=FName;
if OpenDialog1.Execute then
begin
FName:= OpenDialog1.FileName;
mmEditor.Lines.LoadfromFile(FName);
FName:= ExtractFileName(FName)+ ' - Пример интерфейса';
fmMain.Caption:=Fname;
end;
end;



procedure TfmMain.mmCreateClick(Sender: TObject); //create
begin
if mmEditor.Lines.Capacity <> 0 then
case Application.MessageBox(PChar('Текст в файле '+fname+
' был изменен.Сохранить изменения ?'),
'Пример интерфейса',MB_YESNOCANCEL ) of
6:
begin
SaveDialog1.FileName:=FName;
if SaveDialog1.Execute then
begin
FName:= SaveDialog1.FileName;
mmEditor.Lines.SaveToFile(FName);
FName:= ExtractFileName(FName)+ ' - Пример интерфейса';
fmMain.Caption:=Fname;
end;
mmEditor.Lines.Clear;
end;
7:
begin
mmEditor.Lines.Clear;
FName:=' Безымянный.txt - Пример интерфейса';
fmMain.Caption:=' Безымянный.txt - Пример интерфейса';
end;
end;
end;



procedure TfmMain.mmFontColorClick(Sender: TObject); //font color
begin
if ColorDialog1.Execute then
mmEditor.Color:=ColorDialog1.Color;
end;



procedure TfmMain.mmFontClick(Sender: TObject); //font style
begin
if(FontDialog1.Execute) then
mmEditor.Font.Assign(FontDialog1.Font);
end;



procedure TfmMain.N1Click(Sender: TObject); //popup- create
begin
if mmEditor.Lines.Capacity <> 0 then
case application.MessageBox(PChar('Текст в файле '+fname+
' был изменен.Сохранить изменения ?'),
'Пример интерфейса',MB_YESNOCANCEL ) of
6:
begin
SaveDialog1.FileName:=FName;
if SaveDialog1.Execute then
begin
FName:= SaveDialog1.FileName;
mmEditor.Lines.SaveToFile(FName);
FName:= ExtractFileName(FName)+ ' - Пример интерфейса';
fmMain.Caption:=FName;
end;
mmEditor.Lines.Clear;
end;
7:
begin
mmEditor.Lines.Clear;
FName:=' Безымянный.txt - Пример интерфейса';
fmMain.Caption:=' Безымянный.txt - Пример интерфейса';
end;
end;
end;




procedure TfmMain.N3Click(Sender: TObject); //popup -save as
begin
SaveDialog1.FileName:=FName;
if SaveDialog1.Execute then
begin
FName:= SaveDialog1.FileName;
mmEditor.Lines.SaveToFile(FName);
fmMain.Caption:=FName;
end;
end;



procedure TfmMain.N4Click(Sender: TObject); //popup- font style
begin
if(FontDialog1.Execute) then
mmEditor.Font.Assign(FontDialog1.Font);
end;

procedure TfmMain.N2Click(Sender: TObject); //popup- open
begin
OpenDialog1.FileName:=FName;
if OpenDialog1.Execute then
begin
FName:= OpenDialog1.FileName;
mmEditor.Lines.LoadfromFile(FName);
FName:= ExtractFileName(FName)+ ' - Пример интерфейса';
fmMain.Caption:=FName;
end;
end;



procedure TfmMain.mmCutClick(Sender: TObject); //cut
begin
fmMain.mmEditor.CutToClipboard;
end;



procedure TfmMain.mmCopyClick(Sender: TObject); //copy
begin
fmMain.mmEditor.CopyToClipboard;
end;

procedure TfmMain.mmPasteClick(Sender: TObject); //paste
begin
fmMain.mmEditor.PasteFromClipboard;
end;

procedure TfmMain.PrintConfigClick(Sender: TObject); //print config
begin
PrinterSetupDialog1.Execute;
end;

procedure TfmMain.PrintClick(Sender: TObject); //print
begin
PrintDialog1.Execute;
end;





procedure TfmMain.mmFindClick(Sender: TObject); //find
begin
SPos:=mmEditor.SelStart;
with FindDialog1 do
begin
FindText:=Trim(mmEditor.SelText);
Position:=Point(fmMain.Left,fmMain.Top+mmEditor.Top+mmEditor.Height);
Options:=Options + [frHideUpDown,frHideWholeWord];
Execute;
end;
end;

procedure TfmMain.FindDialog1Find(Sender: TObject); //for find
begin
with FindDialog1 do
begin
if frMatchCase in Options then
mmEditor.SelStart:=Pos(FindText,Copy(mmEditor.Lines.Text,SPos+1,
Length(mmEditor.Lines.Text)))+Spos-1
else
mmEditor.SelStart:=Pos(AnsiLowerCase(FindText),
AnsiLowerCase(Copy(mmEditor.Lines.Text,SPos+1,
Length(mmEditor.Lines.Text))))+Spos-1;
if mmEditor.SelStart >= Spos then
begin
mmEditor.SelLength:=Length( FindText);
SPos:=mmEditor.SelStart+mmEditor.SelLength;
end
else
if MessageDlg('Текст "'+FindText+'" не найден. Продолжать поиск?',
mtConfirmation,mbYesNoCancel,0) <> mrYes then
begin
mmEditor.SelStart:=spos-Length( FindText);
CloseDialog
end
else
begin
SPos:=0;
mmEditor.SelStart:=0;
end;
end;
mmEditor.SetFocus;
end;




procedure TfmMain.mmChangeClick(Sender: TObject); //replace
begin
SPos:=mmEditor.SelStart;
with ReplaceDialog1 do
begin
FindText:=trim(mmEditor.SelText);
Position:=Point(fmMain.Left,fmMain.Top+mmEditor.Top+mmEditor.Height );
Options:=Options + [frHideUpDown,frHideWholeWord];
Execute;
end;
end;



procedure TfmMain.Replace(Sender: TObject); //for replace onfind
begin
with replacedialog1 do
begin
if frMatchCase in Options then
mmEditor.SelStart:=Pos(FindText,Copy(mmEditor.Lines.Text,SPos+1,
Length(mmEditor.Lines.Text)))+Spos-1
else
mmEditor.SelStart:=Pos(AnsiLowerCase(FindText),
AnsiLowerCase(Copy(mmEditor.Lines.Text,SPos+1,
Length(mmEditor.Lines.Text))))+Spos-1;
if mmEditor.SelStart >= Spos then
begin
mmEditor.SelLength:=Length( FindText);
SPos:=mmEditor.SelStart+mmEditor.SelLength;
end
else
if MessageDlg('Текст "'+FindText+'" не найден. Продолжать поиск?',
mtConfirmation,mbYesNoCancel,0) <> mrYes then
begin
mmEditor.SelStart:=SPos-Length( FindText);;
CloseDialog
end
else
begin
SPos:=0;
mmEditor.SelStart:=0;
end;
end;
mmEditor.SetFocus;
end;


procedure TfmMain.RealReplace(Sender: TObject);
begin
with ReplaceDialog1 do
begin
if Length(findtext)> Length(ReplaceText) then
difference:=Length(ReplaceText)-Length(FindText)
else
difference:= Length(FindText)- Length(ReplaceText);
if frReplace in options then
begin
if mmEditor.SelLength > 0 then
begin
mmEditor.SelText:=ReplaceText;
SPos:=SPos+difference;
end
else
begin
ReplaceDialog1.OnFind(ReplaceDialog1);
if mmEditor.SelLength > 0 then
mmEditor.SelText:=ReplaceText;
SPos:=SPos+difference;
end;
end;
if frReplaceAll in Options then
begin
if frMatchCase in Options then
while Pos(FindText,Copy(mmEditor.Lines.Text,SPos+1,
Length(mmEditor.Lines.Text))) > 0 do
begin
if mmEditor.SelLength > 0 then
begin
mmEditor.SelText:=ReplaceText;
SPos:=SPos+difference;
end
else
begin
ReplaceDialog1.OnFind(ReplaceDialog1);
if mmEditor.SelLength > 0 then
mmEditor.SelText:=ReplaceText;
SPos:=SPos+difference;
end;
end
else
while Pos(AnsiLowerCase(FindText),
AnsiLowerCase(Copy(mmEditor.Lines.Text,SPos+1,
Length(mmEditor.Lines.Text))))> 0 do
begin
if mmEditor.SelLength > 0 then
begin
mmEditor.SelText:=ReplaceText;
SPos:=SPos+difference;
end
else
begin
ReplaceDialog1.OnFind(ReplaceDialog1);
if mmEditor.SelLength > 0 then
mmEditor.SelText:=ReplaceText;
SPos:=SPos+difference;
end;
end;
end
end;
end;


procedure TfmMain.BitBtn1Click(Sender: TObject);
begin
fmMain.mmCreateClick(mainmenu1)
end;

//begin
//FName:= ' Безымянный.txt ';
procedure TfmMain.BitBtn2Click(Sender: TObject);
begin
fmMain.mmOpenClick(mainmenu1)
end;

procedure TfmMain.BitBtn3Click(Sender: TObject);
begin
fmMain.mmSaveAsClick(mainmenu1)
end;

procedure TfmMain.BitBtn4Click(Sender: TObject);
begin
fmMain.PrintClick(mainmenu1)
end;

procedure TfmMain.BitBtn6Click(Sender: TObject);
begin
fmMain.mmCutClick(mainmenu1)
end;

procedure TfmMain.BitBtn7Click(Sender: TObject);
begin
fmMain.mmCopyClick(mainmenu1)
end;

procedure TfmMain.BitBtn8Click(Sender: TObject);
begin
fmMain.mmPasteClick(mainmenu1)
end;

procedure TfmMain.BitBtn9Click(Sender: TObject);
begin
fmMain.mmChangeClick(mainmenu1)
end;

procedure TfmMain.BitBtn10Click(Sender: TObject);
begin
fmMain.mmFindClick(mainmenu1)
end;

procedure TfmMain.BitBtn11Click(Sender: TObject);
begin
fmMain.mmFontClick(mainmenu1)
end;

procedure TfmMain.SpeedButton1Click(Sender: TObject);
begin
if bold then
mmEditor.Font.Style:= mmEditor.Font.Style+[fsBold]
else
mmEditor.Font.Style:= mmEditor.Font.Style-[fsBold];
bold:=not bold;
end;



procedure TfmMain.SpeedButton2Click(Sender: TObject);
begin
if italic then
mmEditor.Font.Style:= mmEditor.Font.Style+[fsitalic]
else
mmEditor.Font.Style:= mmEditor.Font.Style-[fsItalic];
italic:=not italic;
end;


procedure TfmMain.SpeedButton3Click(Sender: TObject);
begin
if Underline then
mmEditor.Font.Style:= mmEditor.Font.Style+[fsUnderline]
else
mmEditor.Font.Style:= mmEditor.Font.Style-[fsUnderline];
Underline:=not Underline;
end;

procedure TfmMain.fmCreate(Sender:TObject);
begin
fmMain.StatusBar1.Panels.Items[1].Text:= IntToStr(fmMain.mmEditor.CaretPos.Y + 1);
fmMain.StatusBar1.Panels.Items[1].Text:=fmMain.StatusBar1.Panels.Items[1].Text+':'+IntToStr(fmMain.mmEditor.CaretPos.X + 1);

end;



begin
italic:=true;
underline:=true;
bold:=true;
Fname:='Безымянный.txt';




end.
Соседние файлы в папке laba6,7(interface)
  • #
    16.04.2013370 б29find.bmp
  • #
    16.04.20131.89 Кб29replace.bmp
  • #
    16.04.201319.44 Кб26Unit1.dcu
  • #
    16.04.201351 б26Unit1.ddp
  • #
    16.04.201330.66 Кб26Unit1.dfm
  • #
    16.04.201313.83 Кб28Unit1.pas
  • #
    16.04.201351 б27Unit1.~ddp
  • #
    16.04.201330.66 Кб26Unit1.~dfm
  • #
    16.04.201313.83 Кб26Unit1.~pas
  • #
    16.04.2013434 б26_my_interface.cfg
  • #
    16.04.20132.03 Кб26_my_interface.dof