Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Can you help translating this very small C++ component to Delphi?

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.
like image 539
Steve Avatar asked Oct 13 '22 20:10

Steve


1 Answers

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!

like image 66
Steve Avatar answered Oct 30 '22 01:10

Steve