4

フォームキャンバスとフォームのコントロール上に何かを描画するにはどうすればよいですか？

私は次のことを試みます：

procedure TForm1.FormPaint(Sender: TObject);
var x,y: Integer;
begin
  x := Mouse.CursorPos.X - 10;
  y := Mouse.CursorPos.Y - 10;
  x := ScreentoClient(point(x,y)).X - 10;
  y := ScreenToClient(point(x,y)).Y - 10;
  Canvas.Brush.Color := clRed;
  Canvas.FillRect(rect(x, y, x + 10, y + 10));
  Invalidate;
end;

長方形は他のコントロールが描画される前に描画されるため、コントロールの後ろに隠れます（これはDelphi Docsによると予想される動作です）。

私の質問は、どうすればコントロールを描画できるかということです。

4

5 に答える 5

10

ペイントハンドラーで「無効化」しないでください。無効にすると、WM_PAINTが送信されます。これにより、もちろん、ペイントの処理がすべて開始されます。マウスを動かさなくても、投稿したコードサンプルにより、「OnPaint」イベントが何度も実行されます。描画はカーソルの位置に依存するため、これには「OnMouseMove」イベントを使用します。ただし、他のウィンドウコントロールのマウスメッセージもインターセプトする必要があります。以下のサンプルでは、​​この理由から「ApplicationEvents」コンポーネントを使用しています。アプリケーションに複数のフォームがある場合は、描画しているフォームを区別するメカニズムをデバイス化する必要があります。

また、ドキュメントで、VCLInvalidateがウィンドウ全体を無効にすることも参照してください。あなたはそれをする必要はありません、あなたは小さな長方形を描いています、そしてあなたはあなたが描いている場所を正確に知っています。描画する場所と描画した場所を無効にするだけです。

コントロールへの描画に関しては、実際には描画部分は簡単ですが、提供されているキャンバスではそれを行うことはできません。フォームにはWS_CLIPCHILDRENスタイルがあり、子ウィンドウのサーフェスは更新領域から除外されるため、GetDCExまたはを使用する必要がありGetWindowDCます。コメントで「user205376」が言及しているように、実際には複数のコントロールに1つの長方形を描画できるため、描画したものを消去するのは少し注意が必要です。しかし、コードでわかるように、APIにもこれへのショートカットがあります。

従うことができるようにコードに少しコメントしようとしましたが、エラー処理をスキップしました。実際のペイントは「OnPaint」イベントハンドラーにある可能性がありますが、「TWinControl」から派生しないコントロールはハンドラーの後にペイントされています。つまり、WM_PAINTハンドラーにあります。

type
  TForm1 = class(TForm)
    [..]
    ApplicationEvents1: TApplicationEvents;
    procedure FormCreate(Sender: TObject);
    procedure ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean);
  private
    FMousePt, FOldPt: TPoint;
    procedure WM_PAINT(var Msg: TWmPaint); message WM_PAINT;
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  // no rectangle drawn at form creation
  FOldPt := Point(-1, -1);
end;

procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
  var Handled: Boolean);
var
  R: TRect;
  Pt: TPoint;
begin
  if Msg.message = WM_MOUSEMOVE then begin

    // assume no drawing (will test later against the point).
    // also, below RedrawWindow will cause an immediate WM_PAINT, this will
    // provide a hint to the paint handler to not to draw anything yet.
    FMousePt := Point(-1, -1);


    // first, if there's already a previous rectangle, invalidate it to clear
    if (FOldPt.X > 0) and (FOldPt.Y > 0) then begin
      R := Rect(FOldPt.X - 10, FOldPt.Y - 10, FOldPt.X, FOldPt.Y);
      InvalidateRect(Handle, @R, True);

      // invalidate childs
      // the pointer could be on one window yet parts of the rectangle could be
      // on a child or/and a parent, better let Windows handle it all
      RedrawWindow(Handle, @R, 0,
                     RDW_INVALIDATE or RDW_UPDATENOW or RDW_ALLCHILDREN);
    end;


    // is the message window our form?
    if Msg.hwnd = Handle then
      // then save the bottom-right coordinates
      FMousePt := SmallPointToPoint(TSmallPoint(Msg.lParam))
    else begin
      // is the message window one of our child windows?
      if GetAncestor(Msg.hwnd, GA_ROOT) = Handle then begin
        // then convert to form's client coordinates
        Pt := SmallPointToPoint(TSmallPoint(Msg.lParam));
        windows.ClientToScreen(Msg.hwnd, Pt);
        FMousePt := ScreenToClient(Pt);
      end;
    end;

    // will we draw?  (test against the point)
    if PtInRect(ClientRect, FMousePt) then begin
      R := Rect(FMousePt.X - 10, FMousePt.Y - 10, FMousePt.X, FMousePt.Y);
      InvalidateRect(Handle, @R, False);
    end;
  end;
end;

procedure TForm1.WM_PAINT(var Msg: TWmPaint);
var
  DC: HDC;
  Rgn: HRGN;
begin
  inherited;

  if (FMousePt.X > 0) and (FMousePt.Y > 0) then begin
    // save where we draw, we'll need to erase before we draw an other one
    FOldPt := FMousePt;

    // get a dc that could draw on child windows
    DC := GetDCEx(Handle, 0, DCX_PARENTCLIP);

    // don't draw on borders & caption
    Rgn := CreateRectRgn(ClientRect.Left, ClientRect.Top,
                          ClientRect.Right, ClientRect.Bottom);
    SelectClipRgn(DC, Rgn);
    DeleteObject(Rgn);

    // draw a red rectangle
    SelectObject(DC, GetStockObject(DC_BRUSH));
    SetDCBrushColor(DC, ColorToRGB(clRed));
    FillRect(DC, Rect(FMousePt.X - 10, FMousePt.Y - 10, FMousePt.X, FMousePt.Y), 0);

    ReleaseDC(Handle, DC);
  end;
end;
于 2010-12-19T06:05:10.897 に答える
1

アプリケーションのメインウィンドウは、他のコントロールサーフェス上に描画できません。コントロールは定期的に自分自身をペイントおよび消去します（コントロールの「ペイントサイクル」に基づく）

アプリケーションは、アプリケーションがそれを実行できるようにするコントロールのみを利用できます。多くの一般的なコントロールは、コントロールのカスタム描画手法を通じて、コントロールの外観をカスタマイズするためのアプリケーションに柔軟性を提供します。

于 2010-12-18T17:26:03.593 に答える
1

できません。

コントロールは、親ウィンドウの上に描画されます。親ウィンドウに描画したものはすべて、そのウィンドウのコントロールの後ろに表示されます。なぜそのような描画を行う必要があるのか​​は明らかではありません。ただし、フォーム内に透明なコントロールを作成して前面に設定してから、キャンバスに描画することもできます。そうすれば、図面はフォームと他のコントロールの上に表示されますが、透明なコントロールの背後にあるため、ユーザーはフォーム上の他のコントロールを操作できません。

于 2010-12-18T17:26:32.140 に答える
1

これはできません。ウィンドウ化されたコントロール（ウィンドウなど）を作成し、このウィンドウを「上」に描画するコントロールの上に配置する必要があります。次に、次のいずれかを行うことができます

  1. コントロール付きのフォームのビットマップをコピーし、このビットマップをこの新しいコントロールの背景画像として使用するか、

  2. この新しいウィンドウを不規則な形状にして、不規則な形状の領域の外側が透明になるようにします。

于 2010-12-18T17:39:40.017 に答える
-1

ここで、フォームのコンポーネントの周りにハンドルを描画する必要があることを行いました。

まず、次のようなメッセージを作成します。

Const
PM_AfterPaint = WM_App + 1;

メッセージを処理するためのプロシージャを記述します。

Procedure AfterPaint(var msg: tmsg); Message PM_AfterPaint;

Procedure AfterPaint(var msg: tmsg);
begin
  {place the drawing code here}
  ValidateRect(Handle, ClientRect);
end;

Validaterectは、フォームを再描画する必要がないことをWindowsに通知します。ペイントすると、フォームの一部が「無効」になります。ValidateRectは、Windowsに対してすべてが「検証」であると言います。

また、最後のステップで、ペイント手順をオーバーライドする必要があります。

Procedure Paint; Override;

Procedure TForm1.paint;
Begin
  Inherited;
  PostMessage(Handle, PM_AfterPaint, 0, 0);
End;

したがって、フォームを再ペイントする必要があるたびに（WM_Paint）、祖先のペイントが呼び出され、メッセージキューにAfterPaintメッセージが追加されます。メッセージが処理されると、AfterPaintが呼び出され、ペイントを実行して、すべてが正常であることをWindowsに通知し、ペイントの別の呼び出しを防ぎます。

この助けを願っています。

于 2015-12-10T22:07:37.200 に答える