Style = csDropDownListのComboBoxをクリックしたときに、アイテムリストを表示させないようにするには？ (ID:19762)

名前

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

本文

↑は、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;

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

戻る