svn/view/codefrm.pas

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


interface

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

type

  { TCodeForm }

  TCodeForm = class(TForm)

    MainMenu1: TMainMenu;
    Edit1: TMenuItem;
    Cut1: TMenuItem;
    Copy1: TMenuItem;
    Paste1: TMenuItem;
    Delete1: TMenuItem;
    N4: 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;
    SynFreePascalSyn1: TSynFreePascalSyn;
    WordWrap1: TMenuItem;
    Run2: TMenuItem;
    Option1: TMenuItem;
    Font1: TMenuItem;
    KS1: TMenuItem;
    FromTop: TMenuItem;
    FromCurrent: TMenuItem;
    Undo1: TMenuItem;
    protected1: TMenuItem;
    StatusBar1: TStatusBar;
    Show1: TMenuItem;
    E1: TMenuItem;

    procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
    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 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 FromTopClick(Sender: TObject);
    procedure FromCurrentClick(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;
    procedure Find(Sender: TObject);
    procedure Replace(Sender: TObject);
    function search(const FText:ansistring; Options1:TFindOptions):boolean;
    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.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:=caMiniMize
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);
begin
   RunCode(self)
end;

procedure TCodeForm.Find1Click(Sender: TObject);
begin
  FindDialog1.FindText:=Memo1.seltext;
  //Memo1.sellength:=0;
  if fromTop.checked then
     memo1.selstart:=0;
  FindDialog1.Execute;
  FindNext1.Enabled := True;
end;

procedure TCodeForm.Repalce1Click(Sender: TObject);
begin
  ReplaceDialog1.FindText:=Memo1.seltext;
  //Memo1.sellength:=0;
  if fromTop.checked then
     memo1.selstart:=0;
  ReplaceDialog1.Execute;

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,length(Memo1.text)-InitialPos-1,s)
          else
             //p:=findtext(FText,InitialPos,SearchLength,s);
             p:=SearchText(memo1,FText,InitialPos,length(Memo1.text)-InitialPos-1,s);
          if p>=0 then
            begin
               selstart:=p;
               Selend:=p+Length(FText);   //selLength:=length(FText);
               result:=true;
            end
          else
             begin
               selStart:=SelStart+length(FText);
               SelEnd:=SelStart;   //selLength:=0;
               result:=false;
             end;
        end;
   Application.Processmessages;
end;

procedure TCodeForm.Find(Sender: TObject);
begin
    with (Sender as TFindDialog) do
    if Search( FindText, Options) then

    else
       ShowMessage(FindText + EOL + S_NotFound);
end;

procedure TCodeForm.Replace(Sender: TObject);
var
  Found: Boolean;
begin
  with ReplaceDialog1 do
  begin
    if 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
      ShowMessage( FindText + EOL +s_NotFound);
  end;
end;

procedure TCodeForm.FromTopClick(Sender: TObject);
begin
   FromTop.checked:=true;
   FromCurrent.checked:=false;
end;

procedure TCodeForm.FromCurrentClick(Sender: TObject);
begin
   FromTop.checked:=false;
   FromCurrent.checked:=true;
end;

procedure TCodeForm.Undo1Click(Sender: TObject);
begin
      Memo1.Undo;
      //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 := SendMessage(Memo1.Handle, EM_EXLINEFROMCHAR, 0,Memo1.SelStart);
  //CPos.X := (Memo1.SelStart -
  //                     SendMessage(memo1.Handle, EM_LINEINDEX, CPos.Y, 0));
(*
// CaretPos������������
  CPos.Y := LineFromChar(Memo1, Memo1.SelStart);
  CPos.X := Memo1.SelStart -LineIndex(memo1, CPos.Y );
*)
  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]);
  //FrameForm.StatusBar1.Panels[1].Bevel:=pbLowered;
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.