开发者

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).

0

上一篇:

下一篇:

精彩评论

暂无评论...
验证码 换一张
取 消

最新问答

问答排行榜