delphi - リストボックスのタブと色付きの線

Question

私は、1999 年に Fredric Rylander によって書かれた Tabbed Listbox コンポーネントを使用しており、それ以来、うまく機能しています。:) もう彼を見つけることができないようです。

リストボックスにタブ付きデータと交互に色分けされた線の両方を必要とするアプリケーションができました。

必要に応じて、熟読のためにここにコンポーネントを含めることができます。

ここから線を着色してみました http://delphi.about.com/cs/adptips2002/a/bltip0602_4.htm

しかし、それはタブを食べますが、色付きの線が交互に表示されます。

誰かが2つを組み込む方法を教えてください。

ありがとう

コンポーネントはこちら

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.