Homepage von Thomas Schwobe
Home Software Quelltext Impressum Datenschutzerklärung

Quelltext:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Contnrs;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FormPaint(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

  TUndo = class
  private
    FBitmaps: TObjectList;
    FIndex: Integer;

  public
    constructor Create;
    destructor Destroy; override;

    procedure Assign(Bitmap: TBitmap; Flag: Boolean = True);

    function CanUndo: Boolean;
    function CanRedo: Boolean;

    procedure Undo(Bitmap: TBitmap);
    procedure Redo(Bitmap: TBitmap);

    procedure Clear;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

constructor TUndo.Create;
begin
  inherited Create;

  FBitmaps:=TObjectList.Create(True);
  FIndex:=0;
end;

destructor TUndo.Destroy;
begin
  FBitmaps.Free;

  inherited Destroy;
end;

procedure TUndo.Assign(Bitmap: TBitmap; Flag: Boolean = True);
var bmp: TBitmap;

begin
  while FIndex<FBitmaps.Count do
    FBitmaps.Delete(FBitmaps.Count-1);

  bmp:=TBitmap.Create;
  bmp.Assign(Bitmap);

  FIndex:=FBitmaps.Add(bmp);

  if Flag then
    inc(FIndex);
end;

function TUndo.CanUndo: Boolean;
begin
  result:=FIndex>0;
end;

function TUndo.CanRedo: Boolean;
begin
  result:=FIndex<FBitmaps.Count-1;
end;

procedure TUndo.Undo(Bitmap: TBitmap);
begin
  if FIndex>FBitmaps.Count-1 then
    Assign(Bitmap, False);

  if FIndex>0 then
  begin
    dec(FIndex);
    Bitmap.Assign(TBitmap(FBitmaps[FIndex]));
  end;
end;

procedure TUndo.Redo(Bitmap: TBitmap);
begin
  if FIndex<FBitmaps.Count-1 then
  begin
    inc(FIndex);
    Bitmap.Assign(TBitmap(FBitmaps[FIndex]));
  end;
end;

procedure TUndo.Clear;
begin
  FBitmaps.Clear;
  FIndex:=0;
end;

var undo: TUndo;
    bmp: TBitmap;

procedure TForm1.FormCreate(Sender: TObject);
begin
  undo:=TUndo.Create;

  bmp:=TBitmap.Create;
  bmp.Width:=120;
  bmp.Height:=90;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  undo.Free;
  bmp.Free;
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  Canvas.Draw(0, 0, bmp);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  undo.Undo(bmp);
  Invalidate;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  undo.Redo(bmp);
  Invalidate;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  undo.Assign(bmp);

  bmp.Canvas.TextRect(Rect(0, 0, 120, 90), 0, 0, inttostr(Tag));
  Tag:=Tag+1;

  Invalidate;
end;

end.


object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 333
  ClientWidth = 480
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  OnPaint = FormPaint
  TextHeight = 13
  object Button1: TButton
    Left = 232
    Top = 8
    Width = 75
    Height = 25
    Caption = 'Undo'
    TabOrder = 0
    OnClick = Button1Click
  end
  object Button2: TButton
    Left = 313
    Top = 8
    Width = 75
    Height = 25
    Caption = 'Redo'
    TabOrder = 1
    OnClick = Button2Click
  end
  object Button3: TButton
    Left = 394
    Top = 8
    Width = 75
    Height = 25
    Caption = 'Edit'
    TabOrder = 2
    OnClick = Button3Click
  end
end

© 2025 by Thomas Schwobe