Why does TCanvas.Rectangle() with pmXOR pen only work "sometimes"?
I developed the following AnimateRects() method to draw an animation rectangle on the Windows desktop. I use it for animating display of a modal form, making it appear to have "grown" from a grid cell.
I call the method once with the bExpand parameter = True right before the form shows. Then when the user closes the form I call it again but with bExpand = False, to show the form "collapsing" into the grid cell.
The problem is with the bExpand = False case... In the first iteration of the loop, the first call to Rectangle(r) draws the rectangle as expected, but it's as if the second call to Rectangle(r) was never called--the first rectangle never gets XORed. So after the sequence of "collapsing" rectangles has been drawn I end up with the first rectangle remaining as an artifact on the screen.
Any ideas what I'm doing wrong?
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; //Ass开发者_运维问答ign 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;
The problem, most likely, is you're starting to draw the rectangles while the modal form is still visible. At one point the form vanishes from the screen with a rectangle on it and when you draw the same rectangle to erase the previous one, it is now on the screen. Note that calling 'Free', 'Hide' etc. on a form will not hide it immediately.
(edit: this requires some explanation: the form will be hidden before the next line of the code runs, but there's no guarantee as to when the uncovered window(s) will update their invalidated regions).
The solution would be to Sleep
a while after the modal form is closed and before AnimateRects
is called, or perhaps call Application.ProcessMessages
. The latter probably wouldn't be of much help if the modal form is not fully on a window of your own application. And the former probably wouldn't be of much help if the modal form is over an application that's continuously doing its own drawing at the same time. Like the task manager f.i...
edit: Although I might be frowned upon for this, this problem is exactly why LockWindowUpdate
exists. When you think about it, you'll see that what you're doing is not different what the shell does when it shows a drag outline of a window when you're moving it (when "show window contents while dragging" is disabled).
精彩评论