你能帮助将这个非常小的C ++组件翻译成Delphi吗?

时间:2010-12-04 23:14:05

标签: delphi components delphi-7 c++builder

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

2 个答案:

答案 0 :(得分:4)

午夜过后我很累 - 抱歉我的愚蠢。它正在进行以下修改:

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

(添加两个覆盖并取出虚拟内容)

要理清的最后一件事是,如果在没有键盘按键的情况下选择了禁用项目,则不要让组合框关闭!

答案 1 :(得分:0)

@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;