你能帮忙把这个非常小的 C++ 组件翻译成 Delphi 吗？

Posted 2023-02-23

【中文标题】你能帮忙把这个非常小的 C++ 组件翻译成 Delphi 吗？

【英文标题】：Can you help translating this very small C++ component to Delphi?

【发布时间】：2011-05-20 08:57:44

【问题描述】：

我正在将以下 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.

【问题讨论】：

到目前为止你有什么，它怎么不工作？

代码编译运行无错误。我认为 DrawItem 和 SetIsEnabled/GetIsEnabled 有效，但是 WndProcs 存在问题，因为项目没有被禁用并且消息的内部部分没有被调用......

【参考方案1】：

午夜过后我累了 - 对不起我的愚蠢。它正在进行以下修改：

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

（添加两个覆盖并取出虚拟）

最后要整理的是，如果在没有键盘键的情况下选择了禁用的项目，不要让组合框关闭！

【讨论】：

如果您要添加/澄清您的原始问题，那么这应该是对其进行编辑...而不是作为答案;)

是的，但我回答了我自己的问题 :-)

编译器没有警告过你丢失的覆盖吗？应该有。

自己整理出来的工作做得很好。如果没有覆盖，代码也可以编译，但是由于 WndProc 是由较低的类调用的，所以你自己的 WndProc 没有被调用。

【参考方案2】：

@Steve's 答案工作正常，但通过简单的添加，您可以在两个项目之间创建一个实际的行分隔符。

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;