Recent

Author Topic: TImage Undo  (Read 107 times)

Bazzao

  • Full Member
  • ***
  • Posts: 145
  • Pies are squared.
TImage Undo
« on: July 13, 2019, 11:30:36 am »
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]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. {.Define PoorFontButUndo}
  6.  
  7. interface
  8.  
  9. uses
  10.   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
  11.   StdCtrls;
  12.  
  13. const
  14.   gcBigUndo=10;
  15.  
  16. type
  17.  
  18.   { TForm1 }
  19.  
  20.   TForm1 = class(TForm)
  21.     BackgroundImage1: TImage;
  22.     UndoButton1: TButton;
  23.     ModifyButton1: TButton;
  24.     Panel1: TPanel;
  25.     procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
  26.     procedure FormCreate(Sender: TObject);
  27.     procedure FormShow(Sender: TObject);
  28.     procedure ModifyButton1Click(Sender: TObject);
  29.     procedure UndoButton1Click(Sender: TObject);
  30.   private
  31.     { private declarations }
  32.     fInitBkgImg,
  33.     fTempImg0      :TImage;
  34.     fUndoImgs      :array[0..gcBigUndo] of TImage;
  35.     function RestoreUndoImg:TImage;
  36.     procedure SaveUndoImg(pImg:TImage);
  37.   public
  38.     { public declarations }
  39.   end;
  40.  
  41. var
  42.   Form1: TForm1;
  43.  
  44. implementation
  45.  
  46. {$R *.lfm}
  47.  
  48. { TForm1 }
  49.  
  50. const
  51.   gcBigX=4;
  52.   gcBigY=11;
  53.  
  54. var
  55.   gPicked :array[0..gcBigX,0..gcBigY] of boolean;
  56.  
  57. function TForm1.RestoreUndoImg:TImage;
  58. var I:integer;
  59. begin
  60.   fTempImg0.Picture:=fUndoImgs[0].Picture;
  61.   for I:=1 to gcBigUndo do
  62.     fUndoImgs[I-1].Picture:=fUndoImgs[I].Picture;
  63.   fUndoImgs[gcBigUndo].Picture:=fInitBkgImg.Picture;
  64.   RestoreUndoImg:=fTempImg0;
  65. end;
  66.  
  67. procedure TForm1.SaveUndoImg(pImg:TImage);
  68. var I:integer;
  69. begin
  70.   for I:=gcBigUndo-1 downto 0 do
  71.     fUndoImgs[I+1].Picture:=fUndoImgs[I].Picture;
  72.   fUndoImgs[0].Picture:=pImg.Picture;
  73. end;
  74.  
  75. procedure TForm1.ModifyButton1Click(Sender: TObject);
  76. const
  77.   cWidth=200; cHeight=50;
  78.   cColours:array[0..21] of TColor=(clAqua,clBlack,clBlue,clCream,clDkGray,
  79.     clFuchsia,clGray,clGreen,clLime,clLtGray,clMaroon,clMedGray,clMoneyGreen,
  80.     clNavy,clOlive,clPurple,clRed,clSilver,clSkyBlue,clTeal,clWhite,clYellow);
  81. var X0,X1,X2,Y0,Y1,Y2,vCnt:integer; S:string; vColour:TColor;
  82. begin
  83.   vCnt:=0;
  84.   repeat
  85.     X0:=Random(gcBigX);
  86.     Y0:=Random(gcBigY);
  87.     inc(vCnt);
  88.   until (gPicked[X0,Y0]=false) or (vCnt>200);
  89.   gPicked[X0,Y0]:=true;
  90.   X1:=X0*cWidth;
  91.   Y1:=Y0*cHeight;
  92.   X2:=X1+cWidth-10;
  93.   Y2:=Y1+35;
  94.   SaveUndoImg(BackgroundImage1);
  95.   {$IfDef  PoorFontButUndo}
  96.     with BackgroundImage1.Picture.Bitmap do begin
  97.       Canvas.Font.Name:='Arial';
  98.       Canvas.Font.Size:=20;
  99.       vColour:=cColours[Random(22)];
  100.       Canvas.Font.Color:=vColour;
  101.       Canvas.Brush.Style:=bsclear;
  102.       S:=FormatDateTime('hh:mm:ss.zzz',now);
  103.       Canvas.TextOut(X1,Y1,S);
  104.       Canvas.Brush.Style:=bsSolid;
  105.       Canvas.Brush.Color:=vColour;
  106.       Canvas.FillRect(X1,Y2,X2,Y2+10);
  107.     end;
  108.   {$Else   PoorFontButUndo}
  109.     with BackgroundImage1.Canvas do begin
  110.       Canvas.Font.Name:='Arial Black';
  111.       Canvas.Font.Size:=20;
  112.       vColour:=cColours[Random(22)];
  113.       Canvas.Font.Color:=vColour;
  114.       Canvas.Brush.Style:=bsclear;
  115.       S:=FormatDateTime('hh:mm:ss.zzz',now);
  116.       Canvas.TextOut(X1,Y1,S);
  117.       Canvas.Brush.Style:=bsSolid;
  118.       Canvas.Brush.Color:=vColour;
  119.       Canvas.FillRect(X1,Y2,X2,Y2+10);
  120.     end;
  121.   {$EndIf  PoorFontButUndo}
  122. end;
  123.  
  124. procedure TForm1.UndoButton1Click(Sender: TObject);
  125. begin
  126.   BackgroundImage1.Picture.Assign(RestoreUndoImg.Picture);
  127. end;
  128.  
  129. procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
  130. var I:integer;
  131. begin
  132.   try
  133.     for I:=gcBigUndo downto 0 do begin
  134.       // fUndoImgs[I].Picture.Assign(nil);
  135.       // fUndoImgs[I].Free;
  136.       fUndoImgs[I].FreeOnRelease;
  137.     end;
  138.   except
  139.     ShowMessageFmt('Image exception at %d.',[I]);
  140.   end;
  141.   fInitBkgImg.Free;
  142.   fTempImg0.Free;
  143. end;
  144.  
  145. procedure TForm1.FormShow(Sender: TObject);
  146. var I:integer;
  147. begin
  148.   fInitBkgImg.Picture.Assign(BackgroundImage1.Picture);
  149.   for I:=0 to gcBigUndo do
  150.     fUndoImgs[I].Picture.Assign(fInitBkgImg.Picture);
  151. end;
  152.  
  153. procedure TForm1.FormCreate(Sender: TObject);
  154. var I,J:integer;
  155. begin
  156.   Randomize;
  157.   for I:=0 to gcBigX do
  158.     for J:=0 to gcBigY do
  159.       gPicked[I,J]:=false;
  160.   fInitBkgImg:=TImage.Create(nil);
  161.   fTempImg0:=TImage.Create(nil);
  162.   for I:=0 to gcBigUndo do
  163.     fUndoImgs[I]:=TImage.Create(nil);
  164. end;
  165.  
  166. 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
Bazza

Lazarus 1.6.4 r54278 FPC 3.0.2 x86_64-win64-win32/win64
Windows 10.