Combobox mit Bitmaps

[uligerhardt]

Nochmal ein lauffähiges Beispiel:

Delphi-Quellcode:

unit MyCombo;

interface

uses
  Windows,
  Messages,
  Classes,
  StdCtrls;

type
  TRehCheckComboBox = class(TComboBox)
  private
    FListInstance: Pointer;
    FDefListProc: Pointer;
    procedure ListWndProc(var Message: TMessage);
    // List box simulation:
    function ItemAtPos(Pos: TPoint; Existing: Boolean): Integer;
    function ItemRect(Index: Integer): TRect;
  protected
    procedure CreateWnd; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;

implementation

uses
  SysUtils;

constructor TRehCheckComboBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FListInstance := MakeObjectInstance(ListWndProc);
end;

destructor TRehCheckComboBox.Destroy;
begin
  FreeObjectInstance(FListInstance);
  inherited;
end;

procedure TRehCheckComboBox.CreateWnd;
var
  cbi: TComboBoxInfo;
  pListHandle: ^HWND;
begin
  inherited CreateWnd;
  FillChar(cbi, SizeOf(cbi), 0);
  cbi.cbSize := SizeOf(cbi);
  pListHandle := @ListHandle;
  if GetComboBoxInfo(Handle, cbi) then
  begin
    pListHandle^ := cbi.hwndList;
    FDefListProc := Pointer(GetWindowLong(ListHandle, GWL_WNDPROC));
    SetWindowLong(ListHandle, GWL_WNDPROC, Longint(FListInstance));
  end
  else
  begin
    //OutputDebugString(PChar(SysErrorMessage(GetLastError)));
    pListHandle^ := 0;
  end;
end;

procedure TRehCheckComboBox.ListWndProc(var Message: TMessage);
const
  cCheckWidth = 20;
var
  X, Y, Index: Integer;
begin
  case Message.Msg of
    WM_LBUTTONDOWN:
      begin
        X := TWMMouse(Message).XPos;
        Y := TWMMouse(Message).YPos;
        Index := ItemAtPos(Point(X, Y), True);
        if Index <> -1 then
        begin
          if X - ItemRect(Index).Left < cCheckWidth then
          begin
            Beep; //ToggleClickCheck(Index);
            Exit;
          end;
        end;
      end;
  end;

  Message.Result := CallWindowProc(FDefListProc, ListHandle, Message.Msg,
    Message.WParam, Message.LParam);
end;

function TRehCheckComboBox.ItemAtPos(Pos: TPoint; Existing: Boolean): Integer;
var
  Count: Integer;
  ItemRect, ClientRect: TRect;
begin
  Windows.GetClientRect(ListHandle, ClientRect);
  if PtInRect(ClientRect, Pos) then
  begin
    Result := SendMessage(ListHandle, LB_GETTOPINDEX, 0, 0);
    Count := Items.Count;
    while Result < Count do
    begin
      SendMessage(ListHandle, LB_GETITEMRECT, Result, Longint(@ItemRect));
      if PtInRect(ItemRect, Pos) then Exit;
      Inc(Result);
    end;
    if not Existing then Exit;
  end;
  Result := -1;
end;

function TRehCheckComboBox.ItemRect(Index: Integer): TRect;
var
  Count: Integer;
begin
  Count := Items.Count;
  if (Index = 0) or (Index < Count) then
    SendMessage(ListHandle, LB_GETITEMRECT, Index, Longint(@Result))
  else if Index = Count then
  begin
    SendMessage(ListHandle, LB_GETITEMRECT, Index - 1, Longint(@Result));
    OffsetRect(Result, 0, Result.Bottom - Result.Top);
  end
  else
    FillChar(Result, SizeOf(Result), 0);
end;

end.

Delphi-Quellcode:

unit MainF;

interface

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

type
  TComboBox = class(TRehCheckComboBox);

  TForm1 = class(TForm)
    ComboBox1: TComboBox;
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

end.

Dabei hat ComboBox1 den Style csDropDownList. Wenn du das Programm laufen lässt, die Combo aufklappst und in die linken 20 Pixel klickst, machst's Piep und die Combo bleibt offen. Das ist doch halbwegs das, was der OP möchte.