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

Question

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

\n\n

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

\n\n

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

\n\n

我尝试从这里对线条进行着色\n http://delphi.about.com/cs/adptips2002/a/bltip0602_4.htm

\n\n

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

\n\n

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

\n\n

谢谢

\n\n

这是组件

\n\n

unit myListBoxTabbed;\n{\n  Copyright \xc2\xa9 1999 Fredric Rylander\n\n  You can easily add a header control to this list box: drop a header\n  control onto the form (it\'s default align property is set to alTop, if\n  it\'s not--set it); then set the myTabbedListBox\'s aligned property\n  to alClient; now, add the following two events and their code.\n\n  1) HeaderControl\'s OnSectionResize event:\n  var\n    i, last: integer;\n  begin\n    last := 0;\n    for i:=0 to HeaderControl1.Sections.Count-1 do begin\n      last := last + HeaderControl1.Sections[i].Width;\n      myTabbedListBox1.TabStops[i] := last;\n    end;\n  end;\n\n  2) Main form\'s OnCreate event:\n  var\n    i, last: integer;\n  begin\n    last := 0;\n    for i:=0 to HeaderControl1.Sections.Count-1 do begin\n      last := last + HeaderControl1.Sections[i].Width;\n      myTabbedListBox1.TabStops[i] := last;\n    end;\n    for i:=HeaderControl1.Sections.Count to MaxNumSections do\n      myTabbedListBox1.TabStops[i] := 2000;\n  end;\n\n  To get tab characters into the list box items either use the\n  string list property editor in the Delphi GUI and press\n  Ctrl + Tab or add tab characters (#9) in strings as so:\n\n  myTabbedListBox1.Items.Add( Edit1.Text + #9 + Edit2.Text );\n\n  I hope you find this tutorial helpful! :^)\n\n  (!) This is not a retail product, it\'s a tutorial and don\'t claim to\n  meet a potential user\'s demands.\n\n  If you find anything that seems odd (or incorrect even) don\'t hesitate to\n  write me a line. You can communicate with me at fredric@rylander.nu.\n\n  The source is available for you to use, abuse, modify and/or improve.\n\n  Happy trails!\n\n  / Fredric\n\n\n  ___________________________________F_r_e_d_r_i_c__R_y_l_a_n_d_e_r__\n\n  fredric@rylander.nu : www.rylander.nu : 6429296@pager.mirabilis.com\n\n  "power to the source sharing community"\n}\n\ninterface\n\nuses\n  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,\n  StdCtrls;\n\ntype\n  TTabsArray = array[0..9] of integer;\n\ntype\n  TmyTabbedListBox = class( TListBox )\n  private\n    { Private declarations }\n    fTabStops: TTabsArray;\n    function GetTabStops( iIndex: integer ): integer;\n    procedure SetTabStops( iIndex, iValue: integer);\n    function GetTabsString: string;\n    procedure SetTabsString( const sValue: string );\n  protected\n    { Protected declarations }\n    procedure UpdateTabStops;\n  public\n    { Public declarations }\n    procedure CreateParams( var cParams: TCreateParams ); override;\n    procedure CreateWnd; override;\n    property TabStops[ iIndex: integer ]: integer\n      read GetTabStops write SetTabStops;\n  published\n    { Published declarations }\n    property TabsString: string\n      read GetTabsString write SetTabsString;\n  end;\n\nprocedure Register;\n\nresourcestring\n  STR_ALPHA_UPPERLOWER = \'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz\';\n  CHAR_SEMICOLON = \';\';\n\nimplementation\n\nprocedure Register;\nbegin\n  RegisterComponents(\'Additional\', [TmyTabbedListBox]);\nend;\n\n{ myTabbedListBox }\n\nprocedure TmyTabbedListBox.CreateParams(var cParams: TCreateParams);\nbegin\n  inherited CreateParams( cParams );\n  // add the window style LBS_USETABSTOPS to accept tabs\n  cParams.Style := cParams.Style or LBS_USETABSTOPS;\nend;\n\nprocedure TmyTabbedListBox.CreateWnd;\nvar\n  i: integer;\nbegin\n  inherited CreateWnd;\n  // set all the tabs into the box\n  for i := Low( fTabStops ) to High( fTabStops ) do\n    fTabStops[i] := i * 100;\n  // show the real tab positions\n  UpdateTabStops;\nend;\n\nfunction TmyTabbedListBox.GetTabsString: string;\nvar\n  sBuffer: string;\n  i: integer;\nbegin\n  // init var\n  sBuffer := SysUtils.EmptyStr;\n  // set all tabstops to the string (separated by \';\'-char)\n  for i := Low( fTabStops ) to High( fTabStops ) do\n    sBuffer := sBuffer + IntToStr( fTabStops[i] ) + CHAR_SEMICOLON;\n  // and here we have the results\n  Result := sBuffer;\nend;\n\nfunction TmyTabbedListBox.GetTabStops( iIndex: integer ): integer;\nbegin\n  // nothing funny here\n  Result := fTabStops[iIndex];\nend;\n\nprocedure TmyTabbedListBox.SetTabsString( const sValue: string );\nvar\n  sBuffer: string;\n  i, len: integer;\nbegin\n  // copy value into buffer\n  sBuffer := sValue;\n  // set the tabstops as specified\n  for i := Low( fTabStops ) to High( fTabStops ) do begin\n    len := Pos( sBuffer, CHAR_SEMICOLON );\n    fTabStops[i] := StrToIntDef( Copy( sBuffer, 1, len ), 0 );\n    Delete( sBuffer, 1, len );\n  end;\n  // show/redraw the results\n  UpdateTabStops;\n  Invalidate;\nend;\n\nprocedure TmyTabbedListBox.SetTabStops( iIndex, iValue: integer );\nbegin\n  // do we really need to update?\n  if fTabStops[iIndex] <> iValue then begin\n    // oki, let\'s then\n    fTabStops[iIndex] := iValue;\n    // show/redraw the results\n    UpdateTabStops;\n    Invalidate;\n  end;\nend;\n\nprocedure TmyTabbedListBox.UpdateTabStops;\nvar\n  i, iHUnits: integer;\n  arrConvertedTabs: TTabsArray;\nbegin\n  // convert dialog box units to pixels.\n  // dialog box unit = average character width/height div 4/8\n\n  // determine the horizontal dialog box units used by the\n  // list box (which depend on its current font)\n  Canvas.Font := Font;\n  iHUnits := Canvas.TextWidth( STR_ALPHA_UPPERLOWER ) div 52;\n\n  // convert the array of tab values\n  for i := Low( arrConvertedTabs ) to High( arrConvertedTabs ) do\n    arrConvertedTabs[i] := ( fTabStops[i] * 4 ) div iHUnits;\n\n  // activate the tabs stops in the list box,\n  // sending a Windows list box message\n  SendMessage( Handle, LB_SETTABSTOPS,\n    1 + High( arrConvertedTabs ) - Low( arrConvertedTabs ),\n    LongInt( @arrConvertedTabs ) );\nend;\n\nend.\n

\n

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;

这是上面代码的输出：