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.