delphi - 列表框中的选项卡和彩色线条

Question

我正在使用 Fredric Rylander 于 1999 年编写的选项卡式列表框组件，从那时起它就一直为我服务。 :) 似乎再也找不到他了。

我现在有一个应用程序，需要选项卡式数据和列表框中交替的彩色线。

如果需要，我可以在此处包含该组件以供细读。

我尝试从这里给线条着色 http://delphi.about.com/cs/adptips2002/a/bltip0602_4.htm

但随后它吃掉了选项卡，但我确实得到了交替的彩色线。

有人可以告诉我如何将两者结合起来吗？

谢谢

这是组件

unit myListBoxTabbed;
{
  Copyright © 1999 Fredric Rylander

  You can easily add a header control to this list box: drop a header
  control onto the form (it's default align property is set to alTop, if
  it's not--set it); then set the myTabbedListBox's aligned property
  to alClient; now, add the following two events and their code.

  1) HeaderControl's OnSectionResize event:
  var
    i, last: integer;
  begin
    last := 0;
    for i:=0 to HeaderControl1.Sections.Count-1 do begin
      last := last + HeaderControl1.Sections[i].Width;
      myTabbedListBox1.TabStops[i] := last;
    end;
  end;

  2) Main form's OnCreate event:
  var
    i, last: integer;
  begin
    last := 0;
    for i:=0 to HeaderControl1.Sections.Count-1 do begin
      last := last + HeaderControl1.Sections[i].Width;
      myTabbedListBox1.TabStops[i] := last;
    end;
    for i:=HeaderControl1.Sections.Count to MaxNumSections do
      myTabbedListBox1.TabStops[i] := 2000;
  end;

  To get tab characters into the list box items either use the
  string list property editor in the Delphi GUI and press
  Ctrl + Tab or add tab characters (#9) in strings as so:

  myTabbedListBox1.Items.Add( Edit1.Text + #9 + Edit2.Text );

  I hope you find this tutorial helpful! :^)

  (!) This is not a retail product, it's a tutorial and don't claim to
  meet a potential user's demands.

  If you find anything that seems odd (or incorrect even) don't hesitate to
  write me a line. You can communicate with me at fredric@rylander.nu.

  The source is available for you to use, abuse, modify and/or improve.

  Happy trails!

  / Fredric


  ___________________________________F_r_e_d_r_i_c__R_y_l_a_n_d_e_r__

  fredric@rylander.nu : www.rylander.nu : 6429296@pager.mirabilis.com

  "power to the source sharing community"
}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TTabsArray = array[0..9] of integer;

type
  TmyTabbedListBox = class( TListBox )
  private
    { Private declarations }
    fTabStops: TTabsArray;
    function GetTabStops( iIndex: integer ): integer;
    procedure SetTabStops( iIndex, iValue: integer);
    function GetTabsString: string;
    procedure SetTabsString( const sValue: string );
  protected
    { Protected declarations }
    procedure UpdateTabStops;
  public
    { Public declarations }
    procedure CreateParams( var cParams: TCreateParams ); override;
    procedure CreateWnd; override;
    property TabStops[ iIndex: integer ]: integer
      read GetTabStops write SetTabStops;
  published
    { Published declarations }
    property TabsString: string
      read GetTabsString write SetTabsString;
  end;

procedure Register;

resourcestring
  STR_ALPHA_UPPERLOWER = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz';
  CHAR_SEMICOLON = ';';

implementation

procedure Register;
begin
  RegisterComponents('Additional', [TmyTabbedListBox]);
end;

{ myTabbedListBox }

procedure TmyTabbedListBox.CreateParams(var cParams: TCreateParams);
begin
  inherited CreateParams( cParams );
  // add the window style LBS_USETABSTOPS to accept tabs
  cParams.Style := cParams.Style or LBS_USETABSTOPS;
end;

procedure TmyTabbedListBox.CreateWnd;
var
  i: integer;
begin
  inherited CreateWnd;
  // set all the tabs into the box
  for i := Low( fTabStops ) to High( fTabStops ) do
    fTabStops[i] := i * 100;
  // show the real tab positions
  UpdateTabStops;
end;

function TmyTabbedListBox.GetTabsString: string;
var
  sBuffer: string;
  i: integer;
begin
  // init var
  sBuffer := SysUtils.EmptyStr;
  // set all tabstops to the string (separated by ';'-char)
  for i := Low( fTabStops ) to High( fTabStops ) do
    sBuffer := sBuffer + IntToStr( fTabStops[i] ) + CHAR_SEMICOLON;
  // and here we have the results
  Result := sBuffer;
end;

function TmyTabbedListBox.GetTabStops( iIndex: integer ): integer;
begin
  // nothing funny here
  Result := fTabStops[iIndex];
end;

procedure TmyTabbedListBox.SetTabsString( const sValue: string );
var
  sBuffer: string;
  i, len: integer;
begin
  // copy value into buffer
  sBuffer := sValue;
  // set the tabstops as specified
  for i := Low( fTabStops ) to High( fTabStops ) do begin
    len := Pos( sBuffer, CHAR_SEMICOLON );
    fTabStops[i] := StrToIntDef( Copy( sBuffer, 1, len ), 0 );
    Delete( sBuffer, 1, len );
  end;
  // show/redraw the results
  UpdateTabStops;
  Invalidate;
end;

procedure TmyTabbedListBox.SetTabStops( iIndex, iValue: integer );
begin
  // do we really need to update?
  if fTabStops[iIndex] <> iValue then begin
    // oki, let's then
    fTabStops[iIndex] := iValue;
    // show/redraw the results
    UpdateTabStops;
    Invalidate;
  end;
end;

procedure TmyTabbedListBox.UpdateTabStops;
var
  i, iHUnits: integer;
  arrConvertedTabs: TTabsArray;
begin
  // convert dialog box units to pixels.
  // dialog box unit = average character width/height div 4/8

  // determine the horizontal dialog box units used by the
  // list box (which depend on its current font)
  Canvas.Font := Font;
  iHUnits := Canvas.TextWidth( STR_ALPHA_UPPERLOWER ) div 52;

  // convert the array of tab values
  for i := Low( arrConvertedTabs ) to High( arrConvertedTabs ) do
    arrConvertedTabs[i] := ( fTabStops[i] * 4 ) div iHUnits;

  // activate the tabs stops in the list box,
  // sending a Windows list box message
  SendMessage( Handle, LB_SETTABSTOPS,
    1 + High( arrConvertedTabs ) - Low( arrConvertedTabs ),
    LongInt( @arrConvertedTabs ) );
end;

end.

Answer 1

这是一个使用标准 TListBox 及其 OnDrawItem 事件的示例，基于您提供的链接中的代码并在 Delphi 2007 中进行了测试。请注意，您需要设置将ListBox.Style 更改为lbOwnerDrawFixed。您也许可以使用它作为修改组件的基础(或者完全放弃它)。

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
  LB: TListBox;
  NewColor: TColor;
  NewBrush: TBrush;
  R: TRect;
  Fmt: Cardinal;
  ItemText: string;
begin
  NewBrush := TBrush.Create;
  LB := (Control as TListBox);
  if (odSelected in State) then
  begin
    NewColor := LB.Canvas.Brush.Color;
  end
  else
  begin
    if not Odd(Index) then
      NewColor := clSilver
    else
      NewColor := clYellow;
  end;
  NewBrush.Style := bsSolid;
  NewBrush.Color := NewColor;
  // This is the ListBox.Canvas brush itself, not to be
  // confused with the NewBrush we've created above
  LB.Canvas.Brush.Style := bsClear;
  R := Rect;
  ItemText := LB.Items[Index];
  Fmt := DT_EXPANDTABS or DT_CALCRECT or DT_NOCLIP;
  DrawText(LB.Canvas.Handle, PChar(ItemText), Length(ItemText),
       R, Fmt);

  // Note we need to FillRect on the original Rect and not
  // the one we're using in the call to DrawText
  Windows.FillRect(LB.Canvas.Handle, Rect, NewBrush.Handle) ;
  DrawText(LB.Canvas.Handle, PChar(ItemText), Length(ItemText),
       R, DT_EXPANDTABS);
  NewBrush.Free;
end;

这是上述代码的输出: