命令历史记录单元的意外行为

Question

我在Delphi中编写了这样的模块，用于存储绘画应用程序中图片的最新更改。

    unit HistoryQueue;

    interface

    uses
      Graphics;

   type
myHistory = class
  constructor Create(Size:Integer);
  public
    procedure Push(Bmp:TBitmap);
    function Pop():TBitmap;
    procedure Clean();
    procedure Offset();
    function isEmpty():boolean;
    function isFull():boolean;
    function getLast():TBitmap;
  protected
    historyQueueArray: array of TBitmap;
    historyIndex, hSize:Integer;
  end;

implementation

procedure myHistory.Push(Bmp:TBitmap);
var tbmp:TBitmap;
begin
  if(not isFull) then begin
      Inc(historyIndex);
      historyQueueArray[historyIndex]:=TBitmap.Create;
      historyQueueArray[historyIndex].Assign(bmp);
  end else begin
      Offset();
      historyQueueArray[historyIndex]:=TBitmap.Create;
      historyQueueArray[historyIndex].Assign(bmp);
  end;

end;

procedure myHistory.Clean;
var i:Integer;
begin
{  for i:=0 to hSize do begin
    historyQueueArray[i].Free;
    historyQueueArray[i].Destroy;
  end;        }

end;

constructor myHistory.Create(Size:Integer);
begin
  hSize:=Size;
  SetLength(historyQueueArray, hSize);
  historyIndex:=-1;
end;

function myHistory.isEmpty: boolean;
begin
  Result:=(historyIndex = -1);
end;

function myHistory.isFull: boolean;
begin
  Result:=(historyIndex = hSize);
end;

procedure myHistory.Offset; {to handle overflow}
var i:integer;
begin
  //historyQueueArray[0]:=nil;
  for i:=0 to hSize-1 do begin
    historyQueueArray[i]:=TBitmap.Create;
    historyQueueArray[i].Assign(historyQueueArray[i+1]);
  end;
end;

function myHistory.Pop: TBitmap;
var
  popBmp:TBitmap;
begin
  popBmp:= TBitmap.Create;
  popBmp.Assign(historyQueueArray[historyIndex]);
  Dec(historyIndex);
  Result:=popBmp;
end;

function myHistory.getLast: TBitmap; {this function I use when I need refresh the cnvas when I draw ellipse or rect, to get rid of traces and safe previous changes of the picture}
var
  tBmp:TBitmap;
begin
  tBmp:= TBitmap.Create;
  tBmp.Assign(historyQueueArray[historyIndex]);
  Result:=tBmp;
end;

end.

这是我如何使用它的方式。

procedure TMainForm.FormCreate(Sender: TObject);
var
  cleanBmp:TBitmap;
begin
    {...}

    doneRedo:=false;

    redomode:=false; undomode:=false;
//init arrays
    picHistory:=myHistory.Create(10);   //FOR UNDO
    tempHistory:=myHistory.Create(10); //FOR REDO

    cleanbmp:=TBitmap.Create;
    cleanbmp.Assign(imgMain.Picture.Bitmap);
    picHistory.Push(cleanbmp);
    cleanbmp.Free;

    {...}

end;

 procedure TMainForm.btnUndoClick(Sender: TObject);
var redBmp:TBitmap;
begin

  undoMode:=true;
  //if there were some changes
  if(not picHistory.isEmpty) then begin
    redBmp:=TBitmap.Create;
    redBmp.Assign(picHistory.getLast);
    //clean canvas
    imgMain.Picture.Bitmap:=nil; 
    //get what was there before
    imgMain.Canvas.Draw(0,0, picHistory.Pop);
    //and in case if we will not make any changes after UNDO(clicked one or more times)
    //and call REDO then
    tempHistory.Push(redBmp);//we save what were on canvas before UNDOand push it to redo history
    redBmp.Free;
  end;

end;


procedure TMainForm.btnRedoClick(Sender: TObject);
var undBmp:TBitmap;
begin
  redoMode:=true;
  if(not tempHistory.isEmpty) then begin

    doneRedo:=True;

    undBmp:=TBitmap.Create;

    undBmp.Assign(tempHistory.getLast);
    imgMain.Picture.Bitmap:=nil;
    MainForm.imgMain.Canvas.Draw(0,0, tempHistory.Pop);

    //same history (like with UNDO implementation) here but reverse
    picHistory.Push(undBmp);
    undBmp.Free;
  end;
end;


{...}

procedure TMainForm.imgMainMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var bmp:TBitmap;
begin
//if mouse were down and then it's up this means we drew something
//and must save changes into history to be able to make UNDO
  {...}
    bmp:=TBitmap.Create;
    try
      bmp.Assign(imgMain.Picture.Bitmap);
      picHistory.Push(bmp);
      //if there are some changes added after redo then we clean redo history
     if (doneRedo) then begin
        tempHistory.Clean;
        doneRedo:=false;
     end;
    finally
      bmp.Free;
      //sor of refresh
      imgMain.Canvas.Draw(0,0, picHistory.getLast);
    end;
  {...}

但问题是它并不按照我预期的方式工作。例如：

如果我按一次撤销按钮-什么也不会发生。如果按两次-它会立即执行。

如果我画了一个椭圆形，然后点击一次撤销，再开始画新的图形-最后一次画的椭圆形就会消失！

以下是绘制椭圆形的方法，如果有助于找出问题：

    procedure TMainForm.ellipseDraw(X, Y: Integer);
    begin
      imgMain.Canvas.Pen.Color:=useColor;
      imgMain.Canvas.Brush.Color:=scndColor;

      imgMain.Canvas.Pen.Width:=size;

      if(mouseIsDown) then  begin
        imgMain.Canvas.Draw(0,0, picHistory.getLast); //there gonna be no bizzare traces from figures
        imgMain.Canvas.Ellipse(dX, dY, X,Y);
      end;
    end;

- DanilGholtsman

---

请在您的帖子中避免使用粗俗语言。 - J...

@J...哦，对不起。我不是母语为英语的人，我机械地写下这些话，没有考虑到它对母语为英语的人听起来会有什么感觉。 - DanilGholtsman

易懂。将来你会明白的。我们在这里尽量保持专业的语气。 - J...

这段代码漏洞百出。 - David Heffernan

@DavidHeffernan 嗯，你猜得对。但我该怎么修复它？ - DanilGholtsman

@DavidHeffernan 这是我遇到的撤销/重做问题的原因吗？ - DanilGholtsman

Answer 1

答案

当我点击一次撤销按钮时，什么也不会发生。点两次时，它会立即执行所需的操作。

这确实是您代码的行为：

• 在 imgMainMouseUp 中，您将当前图片添加到撤消列表中，
• 在 btnUndoClick 中，您检索最后一个位图从撤消列表中，它与当前看到的图像相同。

对于这个具体问题的解决方案是将先前的位图添加到撤消列表中，而不是当前的位图。

附加奖励

针对David的评论，关于泄漏问题，您的实现存在内存泄漏，因为：

• Pop和getLast例程返回新创建的局部位图。这使得其销毁的责任落在例程的调用者身上。您的 MainForm 代码并没有销毁这些位图，因此它们就成了内存泄漏。解决方法是简单地返回数组中的项，而不是创建新位图。
• 在Offset例程中，您再次创建新位图并泄漏所有以前的位图。只需将Queue[I]分配给Queue[I + 1]。
• 在Push方法中，您忘记释放最后一项。
• 该类没有析构函数，这会使得销毁所有位图的责任落在对象的使用者身上，并需要调用Clean方法，但实际上它没有这样做。解决方案是向您的对象添加一个析构函数，它调用Clean。

除了这些泄漏之外，您的代码还存在其他问题。下面是一些修复和提示：

• 由于动态数组从零开始，因此您的isFull例程在应该返回True时并不返回。应这样实现：Result := historyIndex = hSize - 1;
• 您的数组不是队列（FIFO），而是堆栈（LIFO）。
• 您的Pop例程没有检查空列表。

总之，您的历史记录类可以更好地呈现为：

uses
  SysUtils, Graphics;

type
  TBitmapHistory = class(TObject)
  private
    FIndex: Integer;
    FStack: array of TBitmap;
    procedure Offset;
  public
    procedure Clear;
    function Count: Integer;
    constructor Create(ACount: Integer);
    destructor Destroy; override;
    function Empty: Boolean;
    function Full: Boolean;
    function Last: TBitmap;
    function Pop: TBitmap;
    procedure Push(ABitmap: TBitmap);
  end;

implementation

{ TBitmapHistory }

procedure TBitmapHistory.Clear;
var
  I: Integer;
begin
  for I := 0 to Count - 1 do
    FreeAndNil(FStack[I]);
  FIndex := -1;
end;

function TBitmapHistory.Count: Integer;
begin
  Result := Length(FStack);
end;

constructor TBitmapHistory.Create(ACount: Integer);
begin
  inherited Create;
  SetLength(FStack, ACount);
  FIndex := -1;
end;

destructor TBitmapHistory.Destroy;
begin
  Clear;
  inherited Destroy;
end;

function TBitmapHistory.Empty: Boolean;
begin
  Result := FIndex = -1;
end;

function TBitmapHistory.Full: Boolean;
begin
  Result := FIndex = Count - 1;
end;

function TBitmapHistory.Last: TBitmap;
begin
  if Empty then
    Result := nil
  else
    Result := FStack[FIndex];
end;

procedure TBitmapHistory.Offset;
begin
  FStack[0].Free;
  Move(FStack[1], FStack[0], (Count - 1) * SizeOf(TBitmap));
end;

function TBitmapHistory.Pop: TBitmap;
begin
  if not Empty then
  begin
    Result := Last;
    Dec(FIndex);
  end;
end;

procedure TBitmapHistory.Push(ABitmap: TBitmap);
begin
  if Full then
    Offset
  else
    Inc(FIndex);
  FStack[Findex].Free;
  FStack[FIndex] := TBitmap.Create;
  FStack[Findex].Assign(ABitmap);
end;

备注：

• 还有一种专门的类TObjectStack在Contnrs单元中可供使用，您可以覆盖/利用它。
• 您的MainForm代码也存在问题，但我很礼貌地将其留给您自己解决。

- NGLN

---

你的 MainForm 代码没有销毁那些位图，因此它们会造成内存泄漏。 - DanilGholtsman

对象的生命周期不受 Delphi 语言控制，因为它没有垃圾回收器。因此，生命不受任何范围的限制。对象会一直存在，直到被以下方式销毁：（1）应用程序终止，（2）当对象是 TComponent 并且具有所有者时，由 VCL 销毁，（3）您自己的框架，（4）手动销毁。 - NGLN