2

次のAnimateRects（）メソッドを開発して、Windowsデスクトップにアニメーションの長方形を描画しました。モーダルフォームの表示をアニメーション化するために使用し、グリッドセルから「成長」したように見せます。

フォームが表示される直前に、bExpandパラメーター=Trueを指定してメソッドを1回呼び出します。次に、ユーザーがフォームを閉じると、もう一度呼び出しますが、bExpand = Falseを使用して、フォームがグリッドセルに「折りたたまれている」ことを示します。

問題はbExpand=Falseの場合です...ループの最初の反復では、 Rectangle（r）の最初の呼び出しで期待どおりに長方形が描画されますが、Rectangle（r）の2番目の呼び出しが呼び出されなかったかのようになります- -最初の長方形がXORされることはありません。したがって、「折りたたむ」長方形のシーケンスが描画された後、最初の長方形が画面上のアーティファクトとして残ることになります。

私が間違っていることについて何か考えはありますか？

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;
4

1 に答える 1

1

問題は、おそらく、モーダル フォームがまだ表示されている間に四角形を描き始めていることです。ある時点でフォームが画面から消え、その上に四角形が表示され、同じ四角形を描画して前の四角形を消去すると、画面上に表示されます。フォームで「Free」、「Hide」などを呼び出しても、すぐには非表示にならないことに注意してください。

(編集:これにはいくつかの説明が必要です: コードの次の行が実行される前にフォームは非表示になりますが、カバーされていないウィンドウがいつ無効化された領域を更新するかについての保証はありません)。

解決策は、モーダル フォームが閉じられてからが呼び出されるまでSleep の間AnimateRects、またはおそらく callApplication.ProcessMessagesです。モーダル フォームが独自のアプリケーションのウィンドウに完全に表示されていない場合、後者はおそらくあまり役​​に立ちません。また、モーダル フォームが、独自の描画を同時に継続的に実行しているアプリケーション上にある場合、前者はおそらくあまり役​​に立ちません。タスクマネージャーのように..

編集：私はこれに眉をひそめているかもしれませんが、この問題がまさにLockWindowUpdate存在する理由です. 考えてみると、ウィンドウを移動しているときにウィンドウのドラッグ アウトラインを表示するときのシェルの動作と同じであることがわかります ([ドラッグ中にウィンドウの内容を表示する] が無効になっている場合)。 .

于 2011-01-26T20:00:01.993 に答える