delphi - 你能帮忙把这个非常小的 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;

(添加两个覆盖并删除虚拟)

最后要解决的问题是，如果在没有键盘按键的情况下选择了禁用的项目，则不要让组合框关闭!