Добавил:
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
Скачиваний:
29
Добавлен:
16.04.2013
Размер:
14 Кб
Скачать
☆
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.201331 Кб27Unit1.~dfm
  • #
    16.04.201314 Кб28Unit1.~pas
  • #
    16.04.201319 Кб27Unit1.dcu
  • #
    16.04.201351 б27Unit1.ddp
  • #
    16.04.201331 Кб27Unit1.dfm
  • #
    16.04.201314 Кб29Unit1.pas