unit paintfrm;

{$IFDEF FPC}
  {$MODE DELPHI}{$H+}
{$ENDIF}

(***************************************)
(* Copyright (C) 2017, SHIRAISHI Kazuo *)
(***************************************)


interface

uses Types,Classes, Graphics, Forms, Controls, Menus,
  StdCtrls, Dialogs,  SysUtils, Clipbrd,  ComCtrls,  ExtCtrls,
  LResources,lclintf,  LclType,  FileUtil;


type

  { TPaintForm }

  TPaintForm = class(TForm)
    Copy2: TMenuItem;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    Exit1: TMenuItem;
    PopupMenu1: TPopupMenu;
    Resume1: TMenuItem;
    N2: TMenuItem;
    Print1: TMenuItem;
    N3: TMenuItem;
    SaveAs1: TMenuItem;
    Save1: TMenuItem;
    N4: TMenuItem;
    Close1: TMenuItem;
    Edit1: TMenuItem;
    Copy1: TMenuItem;
    Run1: TMenuItem;
    Break1: TMenuItem;
    SaveDialog1: TSaveDialog;
    OpenDialog1: TOpenDialog;
    Open1: TMenuItem;
    Paste1: TMenuItem;
    Show1: TMenuItem;
    TextWindow1: TMenuItem;
    StatusBar1: TStatusBar;
    PaintBox1: TPaintBox;
    procedure Copy2Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure Resume1Click(Sender: TObject);
    procedure Open1Click(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
    procedure Close1Click(Sender: TObject);
    procedure Print1Click(Sender: TObject);
    procedure Copy1Click(Sender: TObject);
    procedure Break1Click(Sender: TObject);
    procedure SaveAs1Click(Sender: TObject);
    procedure Save1Click(Sender: TObject);
    procedure FormResize(Sender: TObject);
    {
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    }
    procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);

    procedure PaintBox1Click(Sender: TObject);
    procedure E1Click(Sender: TObject);
    procedure PaintBox1Paint(Sender: TObject);
    procedure StatusBar1Resize(Sender: TObject);



  private
      mouseX,mouseY:integer;
      MouseClick:boolean;
      mousestate:TShiftState;
    procedure SizeAdjust;
    //procedure CMMouseLeave(var Message:TMessage);message CM_MOUSELEAVE;
 public
      mouseXIntf, mouseYIntf:integer;
    procedure setsize2;
    procedure getpoint;
    procedure MoveMouse;
    procedure MousePol(var a,b:integer; var l,r:boolean);
    function OpenFile(FileName: string):boolean;
    function SaveFile(FileName: string):boolean;
  end;

var
    paintform:TPaintForm;

implementation
uses
     base,base2, myutils, arithmet, sconsts,
     textfrm, printbmp,  graphsys;
{$R *.lfm}

var
   RightMargin:integer=8;
   BottomMargin:integer=32{$IFDEF Darwin}*2{$ENDIF};
   ScreenClientWidth,ScreenClientHeight:integer;

procedure TPaintForm.FormCreate(Sender: TObject);
begin
   OpenDialog1.Title:=s_OpenFile;
   SaveDialog1.Title:=s_SaveFile;
   Break1.ShortCut:=ShortCut(Word(BreakKey), [ssCtrl]);
   with Font do
        begin
           //CharSet:=OEM_CHARSET;
           style:=[];
        end;

   with TMyIniFile.create('PaintForm') do
       begin
         RightMargin:=ReadInteger('RightMargin',RightMargin);
         BottomMargin:=ReadInteger('BottomMargin',BottomMargin);
         free
       end;
    Visible:=false;   //Windowstate:=wsMinimized;
    //Application.ProcessMessages;

    //ScreenClientWidth:= GetSystemMetrics(SM_CXFULLSCREEN);
    //ScreenClientHeight:= GetSystemMetrics(SM_CYFULLSCREEN);
    ScreenClientWidth:= Monitor.WorkareaRect.Right
                       -Monitor.WorkareaRect.Left;
    ScreenClientHeight:=Monitor.WorkareaRect.Bottom
                       -Monitor.WorkareaRect.Top;

end;

procedure TPaintForm.FormDestroy(Sender: TObject);
begin
   Rightmargin:=ScreenClientwidth-width-left;
   Bottommargin:=ScreenClientHeight-Height-top;
   with TMyIniFile.create('PaintForm') do
     begin
        WriteInteger('RightMargin',RightMargin);
        WriteInteger('BottomMargin',BottomMargin);
        free
     end;
end;

procedure TPaintForm.FormCloseQuery(Sender: TObject; var CanClose: boolean);
begin
   CanClose:=true;
   if ExecutingNow and (Application.mainform=self) then
      if MessageDlg('Application terminate ?', mtConfirmation, [mbYes,mbCancel], 0)= mrYes then
         StopRequest :=true
      else
         CanClose:=false;
end;



procedure TPaintForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   if Application.mainform=self then
      Action:=caFree
   else
      Action:={$IFDEF Linux}caHide {$ELSE} caMiniMize{$ENDIF};
end;




procedure TPaintForm.Copy2Click(Sender: TObject);
begin
      Copy1Click(Sender);
end;


procedure TPaintForm.Exit1Click(Sender: TObject);
begin
   Application.terminate;
end;

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

procedure TPaintForm.Print1Click(Sender: TObject);
begin
    PrintBitMap(ScreenBMPGraphSys.BitMap1);
end;


procedure TPaintForm.Copy1Click(Sender: TObject);
begin
   ClipBoard.Assign(ScreenBMPGraphSys.BitMap1);
end;

procedure TPaintForm.FormShow(Sender: TObject);
begin
       setsize2;
end;



procedure TPaintForm.setsize2;
begin
    PaintBox1.Width:=Bitmapwidth;
    PaintBox1.Height:=BitmapHeight ;

    ClientWidth := BitmapWidth +2; { Adjust clientwidth to match }
    ClientHeight := BitmapHeight + 1 + Statusbar1.height;   { Adjust clientheight to match }
    sizeadjust;
end;



procedure TPaintForm.SizeAdjust;
var
   //h:integer;
   left0,top0:integer;
 begin
   if ScreenClientwidth>width+RightMargin then
      left0:=ScreenClientwidth-(width+Rightmargin)
   else
      left0:=100;
   if ScreenClientHeight>Height+Bottommargin then
      top0:=ScreenClientHeight-(Height+Bottommargin)
   else
      top0:=0;
   left:=left0+Monitor.Left;
   top:=top0+Monitor.top;
end;

procedure TPaintForm.FormResize(Sender: TObject);
var
  h,w:integer;
begin

   w:=BitmapWidth + 2;
   h:=BitMapHeight + 1 + StatusBar1.height;
   if ClientWidth>w then
                   ClientWidth:=w;
   if ClientHeight>h then
                   ClientHeight:=h;
   refresh;
   //Application.Processmessages;   //Harmful on Fedora19
end;


procedure TPaintForm.Break1Click(Sender: TObject);
begin
    CtrlBreakHit:=true ;
    File1.enabled:=true;
    Edit1.enabled:=true;
    Break1.Visible:=false;
    Resume1.Visible:=true;
end;

procedure TPaintForm.Resume1Click(Sender: TObject);
begin
   CtrlBreakHit:=True;
   File1.enabled:=false;
   Edit1.enabled:=false;
   Break1.Visible:=true;
   Resume1.Visible:=false;
end;

procedure TPaintForm.PaintBox1Click(Sender: TObject);
begin
    MouseClick:=true;
end;




procedure TPaintForm.Open1Click(Sender: TObject);
begin
  with OpenDialog1 do
  begin
    options:=[ofPathMustExist,ofFileMustExist];
    Filter :=
    {$IFDEF Linux}
       'Image Files|*.BMP;*.PNG;*.JPG;*.JPEG;*.GIF;*.TIFF;*.TIF;*.XPM;*.bmp;*.png;*.jpg;*.jpeg;*.gif;*.tiff;*.tif;*.xpm';
    {$ELSE}
       'Image Files|*.BMP;*.PNG;*.JPG;*.JPEG;*.GIF;*.TIFF;*.TIF;*.XPM';
    {$ENDIF}
    DefaultExt:='bmp';
    if Execute then
       if OpenFile(FileName) then
          Caption :=FileName
       else
          showMessage('unknown format') ;
  end;
end;

function TPaintForm.OpenFile(FileName: string):boolean;
var
  ext:string;
  gra:TGraphic;
begin
  Paintbox1.visible:=false;
  result:=ScreenBMPGraphSys.OpenFile(FileName);
  Paintbox1.visible:=true;
end;



procedure TPaintForm.Save1Click(Sender: TObject);
begin
    if Caption = s_DefaultAppName then
       SaveAs1Click(Sender)
    else
       begin
        if Caption=ExtractFileName(AppName) then
           Caption:=ChangeFileExt(AppName,'.bmp');
         SaveFile(Caption)
       end;
end;

procedure TPaintForm.SaveAs1Click(Sender: TObject);
var
  Fname:string;
begin
    SaveDialog1.Filter:='BitMap|*.bmp|PNG|*.png|JPEG|*.jpg|TIFF|*.tiff';
    if Caption<>s_DefaultAppName then
        begin
          SaveDialog1.InitialDir:=ExtractFileDir(AppName);
          SaveDialog1.FileName:=ChangeFileExt(ExtractFilename(AppName),'');
        end
    else
         begin
           SaveDialog1.FileName:='';
         end;
    if SaveDialog1.Execute and (SaveDialog1.Filename<>'') then
      begin
        Fname:=SaveDialog1.FileName;
        if ExtractFileExt(FName)='' then
          case SaveDialog1.FilterIndex of
             0: Fname:=FName+'.bmp';
             1: Fname:=FName+'.png';
             2: Fname:=FName+'.jpg';
             3: Fname:=FName+'.tiff';
          end;
        if SaveFile(FName) then
           Caption:=FName
        else
           showMessage('unknown format');
      end;
    refresh;
end;


function TPaintForm.SaveFile(FileName: string):boolean;
 var
    gra:TGraphic;
    ext:string;
 begin
    result:=true;
    ext:=UpperCase( ExtractFileExt(FileName));
    with ScreenBMPGraphsys do
    begin
    if ext='' then
         Bitmap1.SaveToFile(FileName+'.bmp')
    else if (ext='.BMP') then
         Bitmap1.SaveToFile(FileName)
    else
       begin
          gra:=nil;
          if ext='.PNG' then
               gra:=TPortableNetworkGraphic.create
          else if (ext='.JPG') or (ext='.JPEG') or (ext='.JPE') then
               gra:=TJpegImage.Create
          else if (ext='.TIFF') or (ext='.TIF') then
               gra:=TTiffImage.create
          //else if ext='.GIF' then
          //     gra:=TGifImage.create
          else if ext='.XPM' then
               gra:=TPixmap.create
          else
               result:=false;
          if gra<>nil then
          begin
             gra.assign(Bitmap1);
             gra.SaveToFile(FileName);
             gra.free;
          end;
       end;
    end;
    refresh;
end;



procedure TPaintForm.E1Click(Sender: TObject);
begin
   TextForm.Visible:=true;
   TextForm.BringToFront
end;

procedure TPaintForm.PaintBox1Paint(Sender: TObject);
begin
    //if not hiddendrawmode then
    ScreenBMPGraphSys.PaintPaintbox;
end;
(*
var
  svPM:TPenMode;
begin
   with ScreenBMPGraphsys.Bitmap1.canvas do
       begin
          //EnterCriticalSection(PixelCriticalSection);
          {$IFDEF Windows} repeat  until trylock; {$ENDIF}
           svPM:=Pen.Mode;
           Pen.Mode:=pmCopy;
          //if PaintBox1.Canvas.TryLock then
          //begin
             PaintBox1.Canvas.Draw(0,0,ScreenBMPGraphsys.BitMap1);
          //   PaintBox1.Canvas.unlock;
          //end;
          Pen.Mode:=svPM;
          {$IFDEF Windows} unlock; {$ENDIF}
          //LeaveCriticalSection(PixelCriticalSection);
      end;

end;
*)

procedure TPaintForm.StatusBar1Resize(Sender: TObject);
begin
end;






procedure TPaintForm.GetPoint;
var
   svCtrlBreakHit:boolean;
begin
   svCtrlBreakHit:=CtrlBreakHit;
   CtrlBreakHit:=false;
   MouseClick:=false;
   repeat
       Application.ProcessMessages;
       if CtrlBreakHit then
          if MessageDlg(s_ConfirmToBreak,mtConfirmation,[mbOk,mbAbort],0)=mrAbort then
             raise EParStop.create
          else
             begin
                CtrlBreakHit:=false;
                svCtrlBreakHit:=true;
             end;
   until MouseClick ;
   mouseXIntf:=mouseX;
   mouseYIntf:=mouseY;
   CtrlBreakHit:=CtrlBreakHit or svCtrlBreakHit;
end;


procedure TPaintForm.MoveMouse;
var
   P:TPoint;
begin
  P.X:= mouseXIntf;
  P.Y:= mouseYIntf;
  Mouse.CursorPos:=PaintBox1.ClientToScreen(P);
end;


procedure TPaintForm.MousePol(var a,b:integer; var l,r:boolean); //BASIC program Thread から直接呼ぶ。
begin
   a:=mouseX;
   b:=mouseY;
   l:=ssleft in mousestate;
   r:=ssright in mousestate;
end;




procedure TPaintForm.PaintBox1MouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
var
   a,b:number;
begin
    MouseX:=x;
    MouseY:=y;

    if (sender=Paintbox1) and not invalidCoordinate  then
     begin
      convert(ScreenBMPGraphSys.Virtualx(x),a);
      convert(ScreenBMPGraphSys.Virtualy(y),b);
      round9(a);
      round9(b);
      StatusBar1.Panels[0].text:=DStr(a);
      StatusBar1.Panels[1].text:=DStr(b);
     end
     else
     begin
      StatusBar1.Panels[0].text:='';
      StatusBar1.Panels[1].text:='';
     end;
end;


procedure TPaintForm.PaintBox1MouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
    mousestate:=shift;
    mouseX:=x;
    mouseY:=y;
{$IFDEF LclGTK2} //Bug?
    MouseState:=[];
{$ENDIF}
{$IFDEF LclCarbon} //Bug?
    MouseState:=[];
{$ENDIF}
end;

procedure TPaintForm.PaintBox1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
    mousestate:=shift;
    mouseX:=x;
    mouseY:=y;
end;

initialization


finalization

end.
