我开发了以下AnimateRects（）方法在Windows桌面上绘制动画矩形。我用它来动画显示模态形式，使其看起来像是从网格单元中“生长”出来的。
我在表单显示之前立即使用bExpand参数= True调用该方法。然后，当用户关闭表单时，我再次使用bExpand = False对其进行调用，以将表单“崩溃”显示到网格单元格中。
问题出在bExpand = False的情况下...在循环的第一次迭代中，对Rectangle（r）的第一次调用按预期绘制了矩形，但是好像从未对Rectangle（r）的第二次调用- -第一个矩形永远不会被异或。因此，在绘制了“塌陷”矩形的序列后，我最终将第一个矩形保留为屏幕上的假象。
有什么想法我做错了吗？
const
MSECS_PER_DAY = 24.0 * 60.0 * 60.0 * 1000;
procedure DelayMSecs(msecs: Word);
var
Later: TDateTime;
begin
Later := Now + (msecs / MSECS_PER_DAY);
while Now < Later do begin
Application.ProcessMessages;
sleep(0); //give up remainder of our time slice
end;
end;
procedure T_fmExplore.AnimateRects(ASourceRect, ADestRect: TRect; bExpand:
boolean; bAdjustSourceForFrame: boolean = True);
const
MINSTEPS = 10;
MAXSTEPS = 30;
MAXDELAY = 180; //150 - 200 is about right
MINDELAY = 1;
var
iSteps: integer;
DeltaHt: Integer; //Rect size chg for each redraw of animation window
DeltaWidth: Integer;
DeltaTop : integer; //Origin change for each redraw
DeltaLeft : integer;
NewWidth, NewHt: Integer;
iTemp: Integer;
iDelay: integer;
r : Trect;
ScreenCanvas: TCanvas;
begin
r := ASourceRect;
with r do begin
NewWidth := ADestRect.Right - ADestRect.Left; //Target rect's Width
NewHt := ADestRect.Bottom - ADestRect.Top; //Target rect's Height
//Temporarily, Deltas hold the total chg in Width & Height
DeltaWidth := NewWidth - (Right - Left); //NewWidth - old width
DeltaHt := NewHt - (Bottom - Top);
//With a static number of iSteps, animation was too jerky for large windows.
//So we adjust the number of iSteps & Delay relative to the window area.
iSteps := Max( DeltaWidth * DeltaHt div 6500, MINSTEPS ); //eg. 10 iSteps for 250x250 deltas (62500 pixels)
iSteps := Min( iSteps, MAXSTEPS );
//Now convert Deltas to the delta in window rect size
DeltaWidth := DeltaWidth div iSteps;
DeltaHt := DeltaHt div iSteps;
DeltaTop := (ADestRect.Top - ASourceRect.Top) div iSteps;
DeltaLeft := (ADestRect.Left - ASourceRect.Left) div iSteps;
iDelay := Max( MAXDELAY div iSteps, MINDELAY );
ScreenCanvas := TCanvas.Create;
try
ScreenCanvas.Handle := GetDC( 0 ); //Desktop
try
with ScreenCanvas do begin
Pen.Color := clWhite;
Pen.Mode := pmXOR;
Pen.Style := psSolid;
Pen.Width := GetSystemMetrics(SM_CXFRAME);
Brush.Style := bsClear;
if bAdjustSourceForFrame then
InflateRect(ASourceRect, -Pen.Width, -Pen.Width);
repeat
iTemp := (Bottom - Top) + DeltaHt; //Height
if (bExpand and (iTemp > NewHt)) or (not bExpand and (iTemp < NewHt)) then begin
Top := ADestRect.Top;
Bottom := Top + NewHt;
end else begin
Top := Top + DeltaTop; //Assign Top first...Bottom is calc'd from it
Bottom := Top + iTemp;
end;
iTemp := (Right - Left) + DeltaWidth; //Width
if (bExpand and (iTemp > NewWidth)) or (not bExpand and (iTemp < NewWidth)) then begin
Left := Left + DeltaLeft;
Right := Left + NewWidth;
end else begin
Left := Left + DeltaLeft; //Assign Left first...Right is calc'd from it
Right := Left + iTemp;
end;
ScreenCanvas.Rectangle(r);
SysStuff.DelayMSecs( iDelay );
ScreenCanvas.Rectangle(r); //pmXOR pen ...erase ourself
until (Right - Left = NewWidth) and (Bottom - Top = NewHt);
end;
finally
ReleaseDC( 0, ScreenCanvas.Handle );
ScreenCanvas.Handle := 0;
end;
finally
ScreenCanvas.Free;
end;
end;
end;
最佳答案
问题很可能是您在模态形式仍然可见时开始绘制矩形。在某一点上，窗体从屏幕上消失了，上面有一个矩形，当您绘制相同的矩形以擦除前一个矩形时，该窗体现在位于屏幕上。请注意，在表单上调用“免费”，“隐藏”等不会立即将其隐藏。
（编辑：这需要一些解释：表单将在代码的下一行运行之前被隐藏，但是无法保证未发现的窗口何时更新其无效区域）。
解决方案是在关闭模态形式之后，在调用Sleep之前或者也许调用AnimateRects一段时间。如果模式形式不完全在您自己的应用程序窗口中，则后者可能不会有太大帮助。如果模态形式位于同时不断绘制自己的图形的应用程序上，那么前者可能不会有太大帮助。像任务管理器一样
编辑：尽管对此我可能不满意，但是这个问题正是Application.ProcessMessages存在的原因。当您考虑它时，您会发现您所做的与外壳在移动时显示窗口的拖动轮廓时所做的操作没有什么不同（当“拖动时显示窗口内容”被禁用时） 。