I'm translating the following C++ component to Delphi:
http://borland.newsgroups.archived.at/public.delphi.vcl.components.using.win32/200708/0708225318.html
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.
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!
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With