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

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;

这是上面代码的输出：