7

TImage私はそれを部分的にTPanelカバーし、それらが同じ親を共有している状況を持っています:

------------------
|  Image1        |
|  ------------  |
|  |  Panel1  |  |
|  ------------  |
|                |
------------------

Panel1 はマウス ダウン/移動/アップ イベントを受信して​​処理しています (Image1 も同様です) が、状況によっては、Panel1 ではなく Image1 がクリックされたことをシミュレートするかのように、マウス ダウン メッセージを Image1 に「リダイレクト」したいと考えています。

これが私がしたことです：

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if (ssLeft in Shift) then
    Beep;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; 
  X, Y: Integer);
begin
  //...
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  ShowMessage('boo!');
end;

procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  P: TPoint;
begin
  if FRedirectToImage then begin
    ReleaseCapture; // do I need to send a WM_LBUTTONUP as well to the panel?        
    GetCursorPos(P);
    P := ScreenToClient(P);
    Image1.Perform(WM_LBUTTONDOWN, MK_LBUTTON, Longint(PointToSmallPoint(P)));
    Exit;
  end;

  // Normal handling
  if (ssLeft in Shift) then begin
    // ...
  end;
end;

期待どおりに機能しますが、正しい方法かどうかはわかりません。
私の質問は、私はそれを正しくやっていますか？それを行うより良い方法または推奨される方法はありますか？

更新 (1) :WM_NCHITTEST提案どおりの処理は有効な答えであり、私もそれについて考えました。に設定Panel1.EnabledしてもFalse、マウス メッセージは基になる Image1 コントロールにルーティングされます。

しかし (!)xパネル上の場所をクリックしても、メッセージを Image1 にルーティングする必要があるという状況を考えてみてください。

------------------
|  Image1        |
|          --------------
|          |  Panel1  x |
|          --------------
|                |
------------------

私の方法は機能しますがWM_NCHITTEST、説明されているシナリオには適用できません。私の方法が有効かどうか、まだ答えが得られませんでした。（または、上記のシナリオで別の質問をする必要がありますか？）

4

3 に答える 3

7

wm_NCHitTestパネルに送信されたメッセージを処理し、 を返しhtTransparentます。OS はマウス メッセージを次のコントロールに送信しますが、プログラムでそれ以上の処理を行う必要はありません。(OS の観点からは、「次のコントロール ダウン」は、パネルと画像の両方の親コントロールです。VCL は、すべてのTGraphicControl子孫の場合と同様に、マウス メッセージを画像コントロールに戻すようにルーティングします。実際のウィンドウ コントロールです。)

このようなもの：

procedure TParentForm.PanelWindowProc(var Msg: TMessage);
begin
  FPrevPanelWindowProc(Msg);
  if (Msg.Message = wm_NCHitTest) and FRedirectToImage then
    Msg.Result := htTransparent;
end;

そのメソッドをパネルの WindowProc メソッドに割り当てます。プロパティの以前の値をフォームのフィールドに保存します。

var
  FPrevPanelWindowProc: TWndMethod;

FPrevPanelWindowProc := Panel.WindowProc;
Panel.WindowProc := Self.PanelWindowProc;
于 2012-12-13T22:14:19.277 に答える
6

マウスイベントのリダイレクト元のコントロールが、それらのイベントのリダイレクト先のコントロール内のクライアント領域全体にない場合(質問の更新で示したように)、WM_NCHITTESTメッセージはに送信される可能性があります別のコントロール。次に、IMHOを使用してすべてのマウスメッセージをリダイレクトする唯一の方法が残っています。

@David が彼のコメントで述べたように、このメッセージのリダイレクトはOnMessage、TApplication. またはTApplicationEventsオブジェクトを使用します。

次の例では、リダイレクトされるメッセージの範囲を定義し、そのリダイレクトのソース コントロールとターゲット コントロールのリストを指定できます。リダイレクトにはオブジェクトのOnMessageイベントが使用されますが、この場合ターゲットは子孫であるため、着信メッセージの受信者を変更できるだけでなく、このメッセージを食べて、ターゲット コントロールでメッセージを実行する必要があります。方法は自分で。TApplicationTGraphicControlPerform

すべてのマウス メッセージを から にリダイレクトする方法を示すコードを次に示しPanel1ますImage1。from here必要に応じて、テスト プロジェクト全体を取得できます。

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TMsgRange = record
    MsgFrom: UINT;
    MsgTo: UINT;
  end;
  TRedirect = record
    Source: HWND;
    Target: TControl;
  end;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Panel1: TPanel;
    Image1: TImage;
    procedure FormCreate(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Panel1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    FRedirectList: array of TRedirect;
    FRedirectEnabled: Boolean;
    FRedirectMsgRange: TMsgRange;
    procedure ApplicationMessage(var AMessage: TMsg; var Handled: Boolean);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.ApplicationMessage(var AMessage: TMsg; var Handled: Boolean);
var
  I: Integer;
begin
  if FRedirectEnabled and (AMessage.message >= FRedirectMsgRange.MsgFrom) and
    (AMessage.message <= FRedirectMsgRange.MsgTo) then
  begin
    for I := 0 to High(FRedirectList) do
      if (AMessage.hwnd = FRedirectList[I].Source) and
        Assigned(FRedirectList[I].Target) then
      begin
        Handled := True;
        FRedirectList[I].Target.Perform(AMessage.message,
          AMessage.wParam, AMessage.lParam);
        Break;
      end;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FRedirectEnabled := True;
  FRedirectMsgRange.MsgFrom := WM_MOUSEFIRST;
  FRedirectMsgRange.MsgTo := WM_MOUSELAST;
  SetLength(FRedirectList, 1);
  FRedirectList[0].Source := Panel1.Handle;
  FRedirectList[0].Target := Image1;
  Application.OnMessage := ApplicationMessage;
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Memo1.Lines.Add('Image1MouseDown')
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Memo1.Lines.Add('Image1MouseUp')
end;

procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Memo1.Lines.Add('Panel1MouseDown')
end;

procedure TForm1.Panel1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Memo1.Lines.Add('Panel1MouseUp')
end;

end.
于 2012-12-14T00:15:11.407 に答える
5

パネル クラスを派生させて、パネルの下のコントロールにマウス メッセージを受信させたい領域WM_NCHITTESTに返すメッセージを処理できます。HTTRANSPARENT例えば：

procedure TMyPanel.WMNCHitTest(var Message: TWMNCHitTest);
var
  Pt: TPoint;
begin
  Pt := ScreenToClient(SmallPointToPoint(Message.Pos));
  if (Pt.X < 80) and (Pt.Y < 60) then // devise your logic here...
    Message.Result := HTTRANSPARENT
  else
    inherited;
end;

明らかにこれは単なるテストです。コンポーネントにフィールドを公開して、そのコントロールが存在する場所などを解決することができます.

于 2012-12-13T22:05:03.050 に答える