マウスの中央のボタンのイベントを取得するには？ (ID：15789)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

ちょっとおもしろそうだったので、途中まで作ってみました。
いちおう、これで正しく動いている気がします。
当方D5なので、D5での動作確認しかしていません。

つっこみがあれば、どうぞつっこんでください。

---------------------------------
TMyPaint	=class(TPaintBox)
private
  AllocHandle	:THandle;
public
  constructor Create(aOwner: TComponent); override;
  destructor Destroy; override;
private
  procedure WMMouseWheel(var Message: TWMMouseWheel); message WM_MOUSEWHEEL;
  procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
  procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
  procedure CMMousewheel(var Message: TCMMouseWheel); message CM_MOUSEWHEEL;
protected
  procedure WndMethod(var Message:TMessage);
end;

constructor TMyPaint.Create(aOwner: TComponent);
var
  wndLong	:LongInt;
begin
  inherited Create(aOwner);
  {メッセージ受信ウインドウの作成}
  AllocHandle := AllocateHWnd(WndMethod);
  {子ウインドウ化：これがないとフォームが非アクティブになる}
  wndLong := GetWindowLong(AllocHandle, GWL_STYLE);
  wndLong := wndLong AND not WS_POPUP or WS_CHILD;
  SetWindowLong(AllocHandle, GWL_STYLE, wndLong);
end;

destructor TMyPaint.Destroy;
begin
  {メッセージ受信ウインドウの破棄}
  DeallocateHwnd(AllocHandle);
  inherited Destroy;
end;

procedure TMyPaint.WMMouseWheel(var Message: TWMMouseWheel);
begin
  TCMMouseWheel(Message).ShiftState := KeysToShiftState(Message.Keys);
  Perform(CM_MOUSEWHEEL, TMessage(Message).wParam, TMessage(Message).lParam);
end;

procedure TMyPaint.CMMouseEnter(var Message: TMessage);
begin
  SetFocus(AllocHandle);
end;

procedure TMyPaint.CMMouseLeave(var Message: TMessage);
begin
  if Screen.ActiveControl <> nil then begin
    SetFocus(Screen.ActiveControl.Handle);
  end;
end;

procedure TMyPaint.CMMousewheel(var Message: TCMMouseWheel);
begin
  with Message do
  begin
    Result := 0;
    if DoMouseWheel(ShiftState, WheelDelta, SmallPointToPoint(Pos)) then
      Message.Result := 1
    else if Parent <> nil then
      with TMessage(Message) do
        Result := Parent.Perform(CM_MOUSEWHEEL, WParam, LParam);
  end;
end;

procedure TMyPaint.WndMethod(var Message:TMessage);
var
  form	:TCustomForm;
begin
  if (WM_MOUSEFIRST <= Message.Msg) and (Message.Msg <= WM_MOUSELAST) then begin
    {マウスメッセージはすべて自分で処理するのでいいのでしょうか？}
    Message.Result := Perform(Message.Msg, Message.wParam, Message.lParam);
  end
  else begin
    if (Message.Msg = WM_ACTIVATEAPP) then begin
      form := GetParentForm(Self);
      if form <> nil then begin
	Windows.SetParent(AllocHandle, form.Handle);
      end;
    end;
    Message.Result := CallWindowProc(@DefWindowProc, AllocHandle, Message.Msg,
			Message.wParam, Message.lParam);
  end;
end;

←解決時は質問者本人がここをチェックしてください。

戻る