Можете ли вы помочь перевести этот очень маленький компонент C ++ на Delphi?

Question

Я перевожу следующий компонент C ++ в Delphi:

http://borland.newsgroups.archived.at/public.delphi.vcl.components.using.win32/200708/0708225318.html

Но это не работает ... Я прилагаю переведенный код, может кто-нибудь из профессионалов возьметвзгляд?

Спасибо!

Вот код:

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.

Answer 1

Уже после полуночи я устал - извините за мою глупость. Работает со следующими модификациями:

procedure WndProc(var Message: TMessage); override;
procedure ListWndProc(var Message: TMessage);
procedure DrawItem(Index: Integer; Rect: TRect;
  State: TOwnerDrawState); override;

(добавить два переопределения и убрать виртуальный)

Последнее, что нужно перебрать, - это не позволить комбобоксу закрыться, если отключен элемент без клавиш клавиатуры!

Answer 2

@ Ответ Стива работает отлично, но с помощью простого добавления вы можете создать фактический разделитель строк между двумя элементами.

procedure WndProc(var Message: TMessage); override;
procedure ListWndProc(var Message: TMessage);
procedure DrawItem(Index: Integer; Rect: TRect;
  State: TOwnerDrawState); override;

Изменить последнюю часть DrawItem на:

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;

Мне очень помогает, когда я вижу, как можно использовать класс. Поэтому для других я добавил пример того, как его использовать:

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;