unit codefrm;
{$IFDEF FPC}
  {$MODE DELPHI}{$H+}
{$ENDIF}
(***************************************)
(* Copyright (C) 2013, SHIRAISHI Kazuo *)
(***************************************)


interface

uses SysUtils, Types, Classes, Clipbrd, Graphics, Forms, Controls, Menus,
  StdCtrls, Dialogs, ComCtrls, ExtCtrls, LResources, SynEdit, SynHighlighterPas;

type

  { TCodeForm }

  TCodeForm = class(TForm)
    copy2: TMenuItem;
    Cut2: TMenuItem;
    Delete2: TMenuItem;

    MainMenu1: TMainMenu;
    Edit1: TMenuItem;
    Cut1: TMenuItem;
    Copy1: TMenuItem;
    N12: TMenuItem;
    Paste1: TMenuItem;
    Delete1: TMenuItem;
    N4: TMenuItem;
    paste2: TMenuItem;
    PopupMenu1: TPopupMenu;
    PopUpRun1: TMenuItem;
    SelectAll1: TMenuItem;
    File1: TMenuItem;
    Exit1: TMenuItem;
    N1: TMenuItem;
    Print1: TMenuItem;
    N2: TMenuItem;
    SaveAs1: TMenuItem;
    Save1: TMenuItem;
    N3: TMenuItem;
    Close1: TMenuItem;
    SaveDialog1: TSaveDialog;
    FontDialog1: TFontDialog;

    Run1: TMenuItem;
    FindDialog1: TFindDialog;
    ReplaceDialog1: TReplaceDialog;
    Find1: TMenuItem;
    Repalce1: TMenuItem;
    FindNext1: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    Memo1: TSynEdit;
    SelectAll2: TMenuItem;
    SynFreePascalSyn1: TSynFreePascalSyn;
    WordWrap1: TMenuItem;
    Run2: TMenuItem;
    Option1: TMenuItem;
    Font1: TMenuItem;
    Undo1: TMenuItem;
    protected1: TMenuItem;
    StatusBar1: TStatusBar;
    Show1: TMenuItem;
    E1: TMenuItem;

    procedure copy2Click(Sender: TObject);
    procedure Cut2Click(Sender: TObject);
    procedure Delete2Click(Sender: TObject);
    procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure Memo1Change(Sender: TObject);
    procedure Memo1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure paste2Click(Sender: TObject);
    procedure PopUpRun1Click(Sender: TObject);
    procedure Save1Click(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
    procedure Close1Click(Sender: TObject);
    procedure Cut1Click(Sender: TObject);
    procedure Copy1Click(Sender: TObject);
    procedure Paste1Click(Sender: TObject);
    procedure Delete1Click(Sender: TObject);
    procedure SelectAll1Click(Sender: TObject);
    procedure SaveAs1Click(Sender: TObject);
    procedure Print1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure SelectAll2Click(Sender: TObject);
    procedure WordWrap1Click(Sender: TObject);
    procedure Run2Click(Sender: TObject);
    procedure Find1Click(Sender: TObject);
    procedure Repalce1Click(Sender: TObject);
    procedure FindNext1Click(Sender: TObject);
    procedure FindDialog1Find(Sender: TObject);
    procedure ReplaceDialog1Find(Sender: TObject);
    procedure ReplaceDialog1Replace(Sender: TObject);
    procedure Font1Click(Sender: TObject);
    procedure Undo1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure protected1Click(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure E1Click(Sender: TObject);
    procedure Memo1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);

  private
    overwriteMode:boolean;
    searchLength:integer;

    backup:ansistring;
    UnDoFromBackUp:boolean;
    procedure Find(Sender: TObject);
    procedure Replace(Sender: TObject);
    function search(const FText:ansistring; Options1:TFindOptions):boolean;
    procedure PrepareSearch;
    procedure UpdateCursorPos;
    procedure setStatusBar;
  public
    function FileFilter:string;virtual;
    function FileExt:string;virtual;
    procedure setReadOnly(s:boolean);
    procedure AppendString(const s:string);
  end;


var
   CodeForm:TCodeForm;
var
   InitialMargin:integer=1600;

implementation
uses
     //IniFiles,
     myutils,base,base0,sconsts,
     {$IFNDEF LclGTK}printdlg,{$ENDIF}
      findtext,mainfrm,compiler;
{$R *.lfm}


function TCodeForm.FileFilter:string;
begin
   result:=s_TextFile+'|*.lpr'
end;

function TCodeForm.FileExt:string;
begin
   result:='.lpr'
end;



procedure TCodeForm.Save1Click(Sender: TObject);
begin
  if (Caption = '') then
    SaveAs1Click(Sender)
  else
  begin
    Memo1.Lines.SaveToFile(Caption);
    Memo1.Modified := false;
  end;
end;

procedure TCodeForm.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
begin

end;

procedure TCodeForm.Memo1Change(Sender: TObject);
begin

end;

procedure TCodeForm.Delete2Click(Sender: TObject);
begin
  Delete1Click(sender)
end;

procedure TCodeForm.copy2Click(Sender: TObject);
begin
  Copy1Click(sender)
end;

procedure TCodeForm.Cut2Click(Sender: TObject);
begin
  Cut1Click(sender)
end;

procedure TCodeForm.Memo1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
   UpdateCursorPos
end;

procedure TCodeForm.paste2Click(Sender: TObject);
begin
  Paste1Click(sender)
end;

procedure TCodeForm.PopUpRun1Click(Sender: TObject);
begin
    Run2Click(sender)
end;

procedure TCodeForm.SaveAs1Click(Sender: TObject);
begin
     SaveDialog1.Filter:=FileFilter;
     SaveDialog1.FileName :=ChangeFileExt(Caption,FileExt);
     SaveDiaLog1.DefaultExt:='lpr';
     if SaveDialog1.Execute then
     begin
         Caption := SaveDialog1.FileName;
         Save1Click(Sender);
     end;
end;

procedure TCodeForm.Exit1Click(Sender: TObject);
begin
  FrameForm.Close1Click(Sender);
end;

procedure TCodeForm.Close1Click(Sender: TObject);
begin
  Close; { Close the edit form }
end;



procedure TCodeForm.Cut1Click(Sender: TObject);
begin
  Memo1.CutToClipBoard;
end;

procedure TCodeForm.Copy1Click(Sender: TObject);
begin
  Memo1.CopyToClipBoard;
end;

procedure TCodeForm.Paste1Click(Sender: TObject);
begin
  Memo1.PasteFromClipBoard;
end;

procedure TCodeForm.Delete1Click(Sender: TObject);
begin
  Memo1.ClearSelection;
end;

procedure TCodeForm.SelectAll1Click(Sender: TObject);
begin
  Memo1.SelectAll;
end;

procedure TCodeForm.Print1Click(Sender: TObject);
begin
  {$IFNDEF LclGtk}
  with TPrintDialog1.Create(self) do
    begin
      Execute(memo1);
      free
    end;
  {$ENDIF}
end;

procedure TCodeForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
      Action:={$IFDEF Linux}caHide {$ELSE} caMiniMize{$ENDIF}
end;

procedure TCodeForm.SelectAll2Click(Sender: TObject);
begin
    SelectAll2Click(sender)
end;






procedure TCodeForm.WordWrap1Click(Sender: TObject);
begin
(*
  with Memo1 do begin
    WordWrap := not WordWrap;
    if WordWrap then
      ScrollBars := ssVertical
    else
      ScrollBars := ssBoth;
    WordWrap1.Checked := WordWrap;
  end;
*)
end;



procedure TCodeForm.Run2Click(Sender: TObject);
var
   FName:string;
begin
   FName:=MakeFileName;
   if InvokeCompiler(FName,true) then
        ExecuteFile(FName);
end;

procedure TCodeForm.PrepareSearch;
var
  s:string;
begin
  s:=Memo1.seltext;
  if MultiLine(s) then
     SearchLength:=Memo1.selend - memo1.SelStart -1
  else
     begin
        SearchLength:=Length(Memo1.text)-1;
        memo1.selstart:=0;
        FindDialog1.FindText:=s;
        ReplaceDialog1.FindText:=s;
     end;
  //Memo1.sellength:=0;
end;

procedure TCodeForm.Find1Click(Sender: TObject);
begin
   PrepareSearch;
   FindDialog1.Execute;
   FindNext1.Enabled :=True;
end;

procedure TCodeForm.Repalce1Click(Sender: TObject);
begin
   backUp:=Memo1.lines.text;
   UnDoFromBackUp:=true;

   PrepareSearch;
   ReplaceDialog1.Execute;
   FindNext1.Enabled := False;

end;

procedure TCodeForm.FindNext1Click(Sender: TObject);
begin
  Find(FindDialog1);
end;

procedure TCodeForm.FindDialog1Find(Sender: TObject);
begin
     Find(Sender);
end;

procedure TCodeForm.ReplaceDialog1Find(Sender: TObject);
begin
      Find(Sender)
end;

procedure TCodeForm.ReplaceDialog1Replace(Sender: TObject);
begin
    Replace(Sender);
end;

procedure TCodeForm.Font1Click(Sender: TObject);
begin
    FontDialog1.Font:=Memo1.Font;
    if FontDialog1.execute then
        Memo1.Font:=FontDialog1.Font;
end;


function TCodeForm.search(const FText:ansistring; Options1:TFindOptions):boolean;
var
   p:integer;
   s:TFindOptions;
   InitialPos:integer;
begin
  s:=[];
  if frMatchCase in Options1 then s:=s+[frMatchCase];
  with memo1 do
        begin
          InitialPos:=SelEnd;  //selstart+selLength;
          if frWholeWord in Options1 then
             p:=findword(memo1,FText,InitialPos,SearchLength,s)
          else
             //p:=findtext(FText,InitialPos,SearchLength,s);
             p:=SearchText(memo1,FText,InitialPos,SearchLength,s);
          if p>=0 then
            begin
               selstart:=p;
               Selend:=p+Length(FText);   //selLength:=length(FText);
               searchLength:=searchlength-(p-initialPos)-length(FText);
               result:=true;
            end
          else
             begin
               selStart:=SelStart+length(FText);
               SelEnd:=SelStart;   //selLength:=0;
               result:=false;
             end;
        end;
end;

procedure TCodeForm.Find(Sender: TObject);
begin
    with (Sender as TFindDialog) do
    if Search( FindText, Options) then
    else
       CloseDialog //ShowMessage( FindText + EOL + s_NotFound);
end;

procedure TCodeForm.Replace(Sender: TObject);
var
  Found: Boolean;
begin
  with ReplaceDialog1 do
  begin
    if (Memo1.SelText=FindText)
       or not(frMatchcase in options)
       and ( AnsiCompareText(Memo1.SelText, FindText) = 0)  then
         Memo1.SelText := ReplaceText;
    Found := Search( FindText, Options);
    while Found and (frReplaceAll in Options) do
    begin
      Memo1.SelText := ReplaceText;
      Found := Search( FindText, Options);
    end;
    if (not Found) {and (frReplace in Options)} then
      CloseDialog //ShowMessage( FindText + EOL + s_NotFound);
  end;

end;



procedure TCodeForm.Undo1Click(Sender: TObject);
begin
  if UnDoFromBackup then
    memo1.lines.text:=backUp
  else
    Memo1.Undo;
  UnDoFromBackup:=false;
    //SendMessage(Memo1.Handle,WM_UNDO,0,0);

end;

procedure TCodeForm.FormCreate(Sender: TObject);
begin
    SaveDialog1.Title:=s_SaveFile;
    //Visible:=false;
    //WindowState:=wsMinimized;
    //Run2.ShortCut:=ShortCut(Word('R'), [ssCtrl]);
    //Memo1.Perform(EM_SETOPTIONS, ECOOP_OR, ECO_SELECTIONBAR);

    with TMyIniFile.create('Code') do
    begin
      RestoreFont(Memo1.Font);
      free
    end;
    Application.ProcessMessages;
end;


procedure TCodeForm.FormDestroy(Sender: TObject);
begin
    with TMyIniFile.create('Code') do
      begin
        StoreFont(Memo1.Font);
        WriteInteger('InitialMargin',InitialMargin);
        free;
      end;
end;

procedure TCodeForm.setStatusBar;
begin
   if memo1.readonly then
            begin
              StatusBar1.Panels[0].text:=s_Protected;
              StatusBar1.Panels[0].Bevel:=pbNone;
            end
   else if OverWriteMode then
            begin
              StatusBar1.Panels[0].text:=s_OverWrite;
              StatusBar1.Panels[0].Bevel:=pbRaised;
            end
   else
            begin
              StatusBar1.Panels[0].text:=s_Insert;
              StatusBar1.Panels[0].Bevel:=pbLowered;
            end;
end;

procedure TCodeForm.setReadOnly(s:boolean);
begin
    protected1.checked:=s;
    memo1.readonly:=s;
    SetStatusBar;
end;

procedure TCodeForm.protected1Click(Sender: TObject);
begin
   setReadOnly(not protected1.checked)
end;

procedure TCodeForm.FormResize(Sender: TObject);
begin
   memo1.refresh;
end;

procedure TCodeForm.E1Click(Sender: TObject);
begin
   //FrameForm.bringToFront
end;

procedure TCodeForm.UpdateCursorPos;
var
  CPos: TPoint;
begin
  CPos.Y := Memo1.CaretY;
  CPos.X := Memo1.CaretX;
  //Inc(CPos.y);
  //Inc(CPos.x);
  StatusBar1.Panels[1].Text := Format('%6d:%4d', [CPos.y, CPos.x]);
  StatusBar1.update;
end;


procedure TCodeForm.Memo1KeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
    UpdateCursorPos
end;

procedure TCodeForm.AppendString(const s:string);
begin
    with memo1 do
     begin
        //Lines.BeginUpdate;
        //SelStart:=Length(text);
        //SelLength:=0;
        SelText:=s;
        //Lines.EndUpdate;
     end;
end;

initialization


end.
