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

我使用的是Tabred Listbox组件，该组件由Fredric Rylander于1999年编写，自那时以来一直为我服务。 :)似乎找不到他了。

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

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

我尝试从这里涂上颜色
http://delphi.about.com/cs/adptips2002/a/bltip0602_4.htm

但后来它吞噬了Tabs，但我确实得到了交替的彩色线条。

有人可以告诉我如何将两者结合。

谢谢

这是组件

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 [email protected].

  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__

  [email protected] : www.rylander.nu : [email protected]

  "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.

最佳答案

这是一个使用标准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;

这是上面代码的输出：