開発環境は、Delphi6 Personal,Windows2000です。
TComboBoxから継承して、マウスでドラッグするとマウスに合わせて移動するコンボボックスTMyCmbBoxを作っています。
Web上の情報を頼りに以下のようにしてみました。
〜（略）
type
TMyCmbBox = class(TComboBox)
private
FBoolStartMove: Boolean; //移動開始フラグ
FXbefore: integer; //移動前のクライアント座標
FYBefore: integer; //移動前のクライアント座標
protected
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
end;
〜（略）〜
procedure TMyCmbBox.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
//マウスキャプチャを解除
ReleaseCapture;
//移動開始
FBoolStartMove := true;
//移動前のクライアント座標を記録
FXbefore := X;
FYbefore := Y;
inherited;
end;
procedure TMyCmbBox.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
if FBoolStartMove = true then
begin
//(X - FXbefore) : X方向の移動量
Self.Left := Self.Left + (X - FXbefore);
Self.Top := Self.Top + (Y - FYbefore);
end;
inherited;
end;
procedure TMyCmbBox.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
//移動フラグ解除
FBoolStartMove := false;
inherited;
end;
テストしてみると、ドロップボタンの部分をドラッグすると期待通りの動きを見せてもらえます。
ところが、StyleプロパティをcsDropDownListに変更すると、
コンボボックスをクリックしたあとに一度アイテムリストがドロップダウンされてしまいます。
これをクリックしたあとにアイテムリストを表示させないようにするにはどうすればいいのでしょうか？
またはドラッグで移動するコンボボックスを作るには別の方向からアプローチするべきでしょうか？
解決策、アドバイスよろしくお願いします。
なんか、リストが選択できなくて、動きが変な気がします。（自分だけ？）
たとえば、mbRight で移動させるとか・・。
あるいは、Panel に入れて、そのパネルを移動する仕組みにするとか・・・。
これ追加したらどうなる？
一瞬リストがでるかも・・・。
-------------
procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
-------------
procedure TMyCmbBox.CNCommand(var Message: TWMCommand);
begin
case Message.NotifyCode of
CBN_DROPDOWN: begin
if FBoolStartMove then begin
PostMessage(Handle, WM_CANCELMODE, 0, 0);
Exit;
end;
end;
end;
inherited;
end;
お返事ありがとうございます。
>わからんちんさん
>なんか、リストが選択できなくて、動きが変な気がします。
説明足らずでしたすいません。
一度アイテムリストが表示されて、すぐにそれがクローズされ、
クローズした後にドラッグで移動できるという挙動です。
クローズする前にマウスがコンボボックスの外に出てしまうと動きがおかしくなります。
>mbRight で移動させる
右クリックのときは違う機能を持たせたいので、できれば左クリックで移動させたいです。
具体的には左クリックのときは普通に移動させて、
右クリックのときはグリッドに合わせて移動させるという物です。
グリッドに合わせて移動させるという物はすでに実現できています。
>Panel に入れて、そのパネルを移動する仕組みにする
自分の実力不足でこの方法を実現させる事ができませんが、
仮にパネルの上にコンボボックスを乗せたとしても、
コンボボックスをクリックしたときに今と同じようにアイテムリストが表示されてしまうと思います。
パネルの上にコンボボックスを乗せて、台座のパネルをドラッグで動かすというのならできそうです。
>ん？さん
提示されたコードを追加してテストしてみましたが、
同じように一度アイテムリストが表示されて、その後自動でクローズされる、という動きでした。
例えば「アイテムリストをドロップダウンさせる」というメソッドがあれば、
それを改造すれば解決できそうなんですが、見つけることができませんでした。
http://homepage2.nifty.com/Mr_XRAY/index.htm
のサンプルプログラム集
>参考URLさん
参考URLを提示してくれてありがとうございます。
教えてくれたサイトのサンプルプログラム集の中から関係ありそうな
コントロールのドラッグ1
コントロールのドラッグ2
コントロールのドラッグ3
をそれぞれ、提示されているサンプルコードをコンポーネントの設計に組み込む場合と、
テストするために必要なイベント（OnMouse〜系、OnDrag〜系）をTComboBoxに継承させたTMyCmbBox1を作って、
それをフォームに貼り付けて提示されているサンプルコードを適用させた場合の2通り行いましたが、
いずれの場合もアイテムリストが表示されてしまいました。
サンプルプログラム集のほかの項目は試してません。（今から読みます）
もしサンプルプログラム集の他の項目のことを言っていたのなら教えてください。
type
TMyCmbBox = class(TComboBox)
private
FBoolStartMove: Boolean; //移動開始フラグ
FXbefore: integer; //移動前のクライアント座標
FYBefore: integer; //移動前のクライアント座標
private
procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
protected
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
end;
procedure TMyCmbBox.WMLButtonDown(var Message: TWMLButtonDown);
begin
if (Style = csDropDownList) and
(Message.XPos < (Width - GetSystemMetrics(SM_CXHSCROLL))) then begin
//マウスキャプチャを解除
ReleaseCapture;
//移動開始
FBoolStartMove := true;
//移動前のクライアント座標を記録
FXbefore := Message.XPos;
FYbefore := Message.YPos;
end
else begin
inherited;
end;
end;
procedure TMyCmbBox.WMLButtonUp(var Message: TWMLButtonUp);
begin
//移動フラグ解除
FBoolStartMove := false;
inherited;
end;
procedure TMyCmbBox.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
if FBoolStartMove = true then
begin
//(X - FXbefore) : X方向の移動量
Self.Left := Self.Left + (X - FXbefore);
Self.Top := Self.Top + (Y - FYbefore);
end;
inherited;
end;
↑は、Style = csDropDownList 限定っぽいな
↓は、一応、全スタイル対応・・・
type
TMyCmbBox = class(TComboBox)
private
FBoolStartMove: Boolean; //移動開始フラグ
FXbefore: integer; //移動前のクライアント座標
FYBefore: integer; //移動前のクライアント座標
private
procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
procedure StartMove(X, Y: Integer);
protected
procedure ComboWndProc(var Message: TMessage; ComboWnd: HWnd;
ComboProc: Pointer); override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
end;
procedure TMyCmbBox.WMLButtonDown(var Message: TWMLButtonDown);
begin
if (Message.XPos < (Width - GetSystemMetrics(SM_CXHSCROLL))) then begin
StartMove(Message.XPos, Message.YPos);
end
else begin
inherited;
end;
end;
procedure TMyCmbBox.WMLButtonUp(var Message: TWMLButtonUp);
begin
//移動フラグ解除
FBoolStartMove := false;
inherited;
end;
procedure TMyCmbBox.CMMouseLeave(var Message: TMessage);
begin
FBoolStartMove := false;
end;
procedure TMyCmbBox.StartMove(X, Y: Integer);
begin
//マウスキャプチャを解除
ReleaseCapture;
//移動開始
FBoolStartMove := true;
//移動前のクライアント座標を記録
FXbefore := X;
FYbefore := Y;
end;
procedure TMyCmbBox.ComboWndProc(var Message: TMessage; ComboWnd: HWnd; ComboProc: Pointer);
begin
try
case Message.Msg of
WM_LBUTTONDOWN: begin
StartMove(TWMLButtonDown(Message).XPos, TWMLButtonDown(Message).YPos);
end;
WM_MOUSEMOVE:begin
MouseMove(KeysToShiftState(TWMMouseMove(Message).Keys),
TWMMouseMove(Message).XPos,
TWMMouseMove(Message).YPos);
end;
WM_LBUTTONUP: begin
FBoolStartMove := false;
end;
end;
inherited;
except
Application.HandleException(Self);
end;
end;
procedure TMyCmbBox.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if (Style <> csDropDownList) and
(X < (Width - GetSystemMetrics(SM_CXHSCROLL))) then begin
StartMove(X, Y);
end;
inherited;
end;
procedure TMyCmbBox.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
if FBoolStartMove = true then
begin
//(X - FXbefore) : X方向の移動量
Self.Left := Self.Left + (X - FXbefore);
Self.Top := Self.Top + (Y - FYbefore);
end;
inherited;
end;
>ん？さん
自分のレベルに合わせて全コードを示してくれてとても助かります。
提示されたコードを試してみたところ要求以上の完璧な動きを見せてくれました。
おかげさまで解決いたしました。ありがとうございます。
メッセージをキャッチしてそれにあわせた処理を行うという手法でしょうか
（生半可な知識なので間違っているかもしれません）
勉強になります。
今後メッセージについて勉強しようと思います。
お世話になりました。