Tabbox和Listbox中的彩色線條

Question

我使用的是1999年由Fredric Rylander編寫的Tabbed Listbox組件，從那以後它一直在爲我服務。 :)似乎無法找到他了。

我現在有一個應用程序需要列表框中的選項卡式數據和交替的彩色線。

如果需要，我可以在此處包含組件。

我試圖從這裏 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; 

這裏是上面的代碼的輸出：