Reputation: 2520
I'm translating the following C++ component to Delphi:
But it's not working... I'm attaching the translated code, could one of the pros take a look?
Thanks!
Here is the code:
unit ComboBoxPlus;
interface
uses
SysUtils, Classes, Controls, StdCtrls, Messages, Types, Windows, Graphics;
type
TComboBoxPlus = class(TComboBox)
private
FClickedItem: Integer;
FListHandle: HWND;
ListWndProcPtr: Longint;
OldListWndProc: Pointer;
function GetIsEnabled(Index: Integer): Boolean;
procedure SetIsEnabled(Index: Integer; Value: Boolean);
protected
procedure WndProc(var Message: TMessage);
procedure ListWndProc(var Message: TMessage); virtual;
procedure DrawItem(Index: Integer; Rect: TRect;
State: TOwnerDrawState);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Enabled[Index: Integer]: Boolean read GetIsEnabled write SetIsEnabled;
published
{ Published declarations }
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Win32', [TComboBoxPlus]);
end;
constructor TComboBoxPlus.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Style := csOwnerDrawFixed;
Height := 21;
ItemHeight := 17;
ListWndProcPtr := Longint(Classes.MakeObjectInstance(ListWndProc));
end;
destructor TComboBoxPlus.Destroy;
begin
if FListHandle <> 0 then
SetWindowLong(FListHandle, GWL_WNDPROC, Longint(OldListWndProc));
FreeObjectInstance(Pointer(ListWndProcPtr));
inherited Destroy;
end;
function TComboBoxPlus.GetIsEnabled(Index: Integer): Boolean;
begin
if Boolean(Items.Objects[Index]) then Result := false
else Result := true;
end;
procedure TComboBoxPlus.SetIsEnabled(Index: Integer; Value: Boolean);
begin
if Value then
Items.Objects[Index] := TObject(false)
else
Items.Objects[Index] := TObject(true);
end;
procedure TComboBoxPlus.DrawItem(Index: Integer; Rect: TRect;
State: TOwnerDrawState);
begin
if odSelected in State then
begin
if not Boolean(Items.Objects[Index]) then
begin
Canvas.Brush.Color := clHighlight;
Canvas.Font.Color := clHighlightText;
Canvas.FillRect(Rect);
end else
begin
Canvas.Brush.Color := Color;
Canvas.Font.Color := clGrayText;
Canvas.FillRect(Rect);
Canvas.DrawFocusRect(Rect);
end;
end else
begin
if not Boolean(Items.Objects[Index]) then
begin
Canvas.Brush.Color := Color;
Canvas.Font.Color := Font.Color;
end else
begin
Canvas.Brush.Color := Color;
Canvas.Font.Color := clGrayText;
end;
Canvas.FillRect(Rect);
end;
Canvas.TextOut(Rect.Left + 3, Rect.Top + (((Rect.Bottom - Rect.Top) div 2) -
(Canvas.TextHeight('Wg') div 2)), Items.Strings[Index]);
end;
procedure TComboBoxPlus.WndProc(var Message: TMessage);
begin
if (Message.Msg = WM_CTLCOLORLISTBOX) then
begin
if FListHandle = 0 then
begin
FListHandle := HWnd(Message.LParam);
inherited WndProc(Message);
OldListWndProc := Pointer(SetWindowLong(FListHandle, GWL_WNDPROC, ListWndProcPtr));
exit;
end;
end;
inherited WndProc(Message);
end;
procedure TComboBoxPlus.ListWndProc(var Message: TMessage);
var
R: TRect;
X, Y: Integer;
begin
if (Message.Msg = WM_LBUTTONDOWN) or (Message.Msg = WM_LBUTTONUP) then
begin
X := Message.LParamLo;
Y := Message.LParamHi;
Windows.GetClientRect(FListHandle, R);
if PtInRect(R, Point(X, Y)) then
begin
FClickedItem := SendMessage(FListHandle, LB_GETTOPINDEX, 0, 0) + (Y div ItemHeight);
if (not Enabled[FClickedItem]) then
begin
Message.Result := 0;
exit;
end;
end;
end else if (Message.Msg = WM_LBUTTONDBLCLK) then
begin
Message.Result := 0;
exit;
end;
Message.Result := CallWindowProc(OldListWndProc, FListHandle, Message.Msg,
Message.WParam, Message.LParam);
end;
end.
Upvotes: 5
Views: 1488
Reputation: 1
@Steve's answer works fine, but with a simple adding you can create an actual line seperator between two items.
procedure WndProc(var Message: TMessage); override;
procedure ListWndProc(var Message: TMessage);
procedure DrawItem(Index: Integer; Rect: TRect;
State: TOwnerDrawState); override;
Change the last part of DrawItem to:
if( not Boolean(Items.Objects[Index]) ) then
Canvas.TextOut(Rect.Left + 3, Rect.Top + (((Rect.Bottom - Rect.Top) div 2) -
(Canvas.TextHeight('Wg') div 2)), Items.Strings[Index])
else
begin
Canvas.Pen.Color := clSilver;
Canvas.Pen.Width := 1;
Canvas.Pen.Style := psSolid;
Canvas.MoveTo(Rect.Left + 3, Rect.Top + ((Rect.Bottom - Rect.Top) div 2));
Canvas.LineTo(Rect.Right - 3, Rect.Top + ((Rect.Bottom - Rect.Top) div 2));
end;
It helps me alot when I can see how the class can be used. So for others I added an example on how to use it:
uses
Forms, o_comboboxplus;
var
fComboPlus: TComboBoxPlus;
begin
fComboPlus := TComboBoxPlus.Create(Form1);
with(fComboPlus) do
begin
Parent := Form1;
Left := 10;
Top := 10;
Items.Add('Test1');
Items.Add('Test2');
Items.Add('Test3');
Items.Add('Test4');
Enabled[2] := false; //'Test3' will become a line seperator
end;
end;
Upvotes: 0
Reputation: 2520
It's after midnight I'm tired - sorry about my stupidity. It's working with the following modifications:
procedure WndProc(var Message: TMessage); override;
procedure ListWndProc(var Message: TMessage);
procedure DrawItem(Index: Integer; Rect: TRect;
State: TOwnerDrawState); override;
(add two overrides and take out the virtual)
The last thing to sort out is not to let the combobox close up if the disabled item is selected without keyboard keys!
Upvotes: 4