TImage Undo
lazarus / 39-Graphics

----------------------------------------------------------------------
Bazzao · 2019-07-13 09:30

I am trying to create an undo feature for a form TImage but have
struck a problem.

In the following test application, the conditional define
"PoorFontButUndo" has the undo working perfectly, but produces poor
font and colour.

The Modify button selects a random X,Y in a grid, writes the time and
underlines it with a FillRect.

The desired result is before modification, the current image is saved
to an array, and pressing the Undo button will result in restoring the
last save.

With PoorFontButUndo undefined, the undo button actually performs an
undo, however the modification seems to be not part of the save layer,
and the image seems to revert to the original.

fUndoImgs is the save array with element 0 being the most recent save,
and gcBigUndo the earliest. The logic is if it goes beyond gcBigUndo,
the image is reverted to when application is started.

There are some logic bugs, such as the Picked[] grid filling up, but
this is only a logic test application, and the Picked[] grid just
prevents too early an overwrite of the same area of the image.

Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i unit
Unit1; {$mode objfpc}{$H+} {.Define PoorFontButUndo} interface uses 
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
ExtCtrls,  StdCtrls; const  gcBigUndo=10; type   { TForm1 }   TForm1 =
class(TForm)    BackgroundImage1: TImage;    UndoButton1: TButton;   
ModifyButton1: TButton;    Panel1: TPanel;    procedure
FormClose(Sender: TObject; var CloseAction: TCloseAction);   
procedure FormCreate(Sender: TObject);    procedure FormShow(Sender:
TObject);    procedure ModifyButton1Click(Sender: TObject);   
procedure UndoButton1Click(Sender: TObject);  private    { private
declarations }    fInitBkgImg,    fTempImg0      :TImage;    fUndoImgs
     :array[0..gcBigUndo] of TImage;    function
RestoreUndoImg:TImage;    procedure SaveUndoImg(pImg:TImage);  public 
  { public declarations }  end; var  Form1: TForm1; implementation {$R
*.lfm} { TForm1 } const  gcBigX=4;  gcBigY=11; var  gPicked
:array[0..gcBigX,0..gcBigY] of boolean; function
TForm1.RestoreUndoImg:TImage;var I:integer;begin 
fTempImg0.Picture:=fUndoImgs[0].Picture;  for I:=1 to gcBigUndo do   
fUndoImgs[I-1].Picture:=fUndoImgs[I].Picture; 
fUndoImgs[gcBigUndo].Picture:=fInitBkgImg.Picture; 
RestoreUndoImg:=fTempImg0;end; procedure
TForm1.SaveUndoImg(pImg:TImage);var I:integer;begin  for
I:=gcBigUndo-1 downto 0 do   
fUndoImgs[I+1].Picture:=fUndoImgs[I].Picture; 
fUndoImgs[0].Picture:=pImg.Picture;end; procedure
TForm1.ModifyButton1Click(Sender: TObject);const  cWidth=200;
cHeight=50;  cColours:array[0..21] of
TColor=(clAqua,clBlack,clBlue,clCream,clDkGray,    clFuchsia,clGray,cl
Green,clLime,clLtGray,clMaroon,clMedGray,clMoneyGreen,    clNavy,clOli
ve,clPurple,clRed,clSilver,clSkyBlue,clTeal,clWhite,clYellow);var
X0,X1,X2,Y0,Y1,Y2,vCnt:integer; S:string; vColour:TColor;begin 
vCnt:=0;  repeat    X0:=Random(gcBigX);    Y0:=Random(gcBigY);   
inc(vCnt);  until (gPicked[X0,Y0]=false) or (vCnt>200); 
gPicked[X0,Y0]:=true;  X1:=X0*cWidth;  Y1:=Y0*cHeight; 
X2:=X1+cWidth-10;  Y2:=Y1+35;  SaveUndoImg(BackgroundImage1);  {$IfDef
 PoorFontButUndo}    with BackgroundImage1.Picture.Bitmap do begin   
 Canvas.Font.Name:='Arial';      Canvas.Font.Size:=20;     
vColour:=cColours[Random(22)];      Canvas.Font.Color:=vColour;     
Canvas.Brush.Style:=bsclear;     
S:=FormatDateTime('hh:mm:ss.zzz',now);      Canvas.TextOut(X1,Y1,S); 
   Canvas.Brush.Style:=bsSolid;      Canvas.Brush.Color:=vColour;    
Canvas.FillRect(X1,Y2,X2,Y2+10);    end;  {$Else   PoorFontButUndo}  
with BackgroundImage1.Canvas do begin      Canvas.Font.Name:='Arial
Black';      Canvas.Font.Size:=20;     
vColour:=cColours[Random(22)];      Canvas.Font.Color:=vColour;     
Canvas.Brush.Style:=bsclear;     
S:=FormatDateTime('hh:mm:ss.zzz',now);      Canvas.TextOut(X1,Y1,S); 
   Canvas.Brush.Style:=bsSolid;      Canvas.Brush.Color:=vColour;    
Canvas.FillRect(X1,Y2,X2,Y2+10);    end;  {$EndIf
 PoorFontButUndo}end; procedure TForm1.UndoButton1Click(Sender:
TObject);begin 
BackgroundImage1.Picture.Assign(RestoreUndoImg.Picture);end; procedure
TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);var
I:integer;begin  try    for I:=gcBigUndo downto 0 do begin      //
fUndoImgs[I].Picture.Assign(nil);      // fUndoImgs[I].Free;     
fUndoImgs[I].FreeOnRelease;    end;  except    ShowMessageFmt('Image
exception at %d.',[I]);  end;  fInitBkgImg.Free; 
fTempImg0.Free;end; procedure TForm1.FormShow(Sender: TObject);var
I:integer;begin 
fInitBkgImg.Picture.Assign(BackgroundImage1.Picture);  for I:=0 to
gcBigUndo do   
fUndoImgs[I].Picture.Assign(fInitBkgImg.Picture);end; procedure
TForm1.FormCreate(Sender: TObject);var I,J:integer;begin  Randomize; 
for I:=0 to gcBigX do    for J:=0 to gcBigY do     
gPicked[I,J]:=false;  fInitBkgImg:=TImage.Create(nil); 
fTempImg0:=TImage.Create(nil);  for I:=0 to gcBigUndo do   
fUndoImgs[I]:=TImage.Create(nil);end; end.
The final application will have user modifications to the image
including
text being added.

I can zip up the test application, if desired.

Bazza