(100分求)有没有可以自动换行的ListBox控件?(100分)

  • 主题发起人 主题发起人 snowsky
  • 开始时间 开始时间
S

snowsky

Unregistered / Unconfirmed
GUEST, unregistred user!
如题,我在做一个程序,菜单放在一个文本文件内,每一行一个,根据行号来决定相应
指向的文件名,需要使用LISTBOX控件,只是这个控件不支持自动换行,不知道大家知不
知道哪有可以自动换行的LISTBOX控件,多谢各位高手!
 
ListBox1.Items.LoadFromFile('c:/a0.txt');
 
我当然知道这样使用了,只是装入的文本文件假如一行超过LISTBOX的宽度剩下的就会不
显示的,有没有办法让它折行呢?要是能定义它的背景色更好了。
 
哦,是这个意思。那你可以自己读文件,读入一定长度字符串后就放进去。
ListBox有Color属性,直接改就行了。
 
呵呵,那我读剩下的字符串该怎么处理呢?不知道你用过没有用过TopGrid控件,我想找
一个像它那样自动换行的LISTBOX
 
Win98 + D6

unit WrapListBox;

interface

uses
Windows, Messages, SysUtils, Classes,
Graphics, Controls, StdCtrls;

type
TWrapListBox = class(TCustomListBox)
private
procedure CMFontChanged(var Msg: TMessage); message CM_FONTCHANGED;
protected
procedure DrawItem(Index: Integer; Rect: TRect;
State: TOwnerDrawState); override;
procedure MeasureItem(Index: Integer; var Height: Integer); override;
public
constructor Create(AOwner: TComponent); override;
published
property AutoComplete;
property Align;
property Anchors;
property BevelEdges;
property BevelInner;
property BevelKind default bkNone;
property BevelOuter;
property BiDiMode;
property BorderStyle;
property Color;
property Columns;
property Constraints;
property Ctl3D;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property ExtendedSelect;
property Font;
property ImeMode;
property ImeName;
property IntegralHeight;
property ItemHeight;
property Items;
property MultiSelect;
property ParentBiDiMode;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ScrollWidth;
property ShowHint;
property Sorted;
property TabOrder;
property TabStop;
property TabWidth;
property Visible;

property OnClick;
property OnContextPopup;
property OnData;
property OnDataFind;
property OnDataObject;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDock;
property OnStartDrag;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Samples', [TWrapListBox]);
end;

{ TWrapListBox }

procedure TWrapListBox.CMFontChanged(var Msg: TMessage);
begin
Invalidate;
end;

constructor TWrapListBox.Create(AOwner: TComponent);
begin
inherited;
Style := lbOwnerDrawVariable;
end;

procedure TWrapListBox.DrawItem(Index: Integer; Rect: TRect;
State: TOwnerDrawState);
var
Flags: Longint;
Data: String;
begin
Canvas.FillRect(Rect);
if Index < Count then begin
Canvas.Font := Font;
if odSelected in State then
Canvas.Font.Color := clHighlightText;
Flags := DrawTextBiDiModeFlags(
DT_WORDBREAK or DT_VCENTER or DT_NOPREFIX or DT_EDITCONTROL);
if not UseRightToLeftAlignment then
Inc(Rect.Left, 2)
else
Dec(Rect.Right, 2);

Data := Items[Index];
DrawText(Canvas.Handle, PChar(Data), Length(Data), Rect, Flags);
end;
end;

procedure TWrapListBox.MeasureItem(Index: Integer; var Height: Integer);
var
Rt: TRect;
Data: String;
begin
if Index < Count then begin
Canvas.Font := Font;
Data := Items[Index];
Rt := Rect(0, 0, ClientWidth, 600);
DrawText(Canvas.Handle, PChar(Data), Length(Data), Rt,
DT_WORDBREAK or DT_VCENTER or DT_NOPREFIX or DT_CALCRECT or DT_EDITCONTROL);
Height := Rt.Bottom - Rt.Top;
end;
end;

end.
 
稍候,我试一下。
 
这样也可以解决你的问题:
Delphi 的 TListBox元件自动实现了垂直的滚动条,当ListBox不能显示全部的
菜单(Item)时,这个垂直的滚动条就会出现。然而,当菜单的宽度比ListBox宽
时水平的滚动条却不会出现。以下的程序就是处理这个问题的。

在你的Form的OnCreate事件中添加以下代码:
procedure TForm1.FormCreate(Sender: TObject);
var
i, MaxWidth: integer;
begin
MaxWidth := 0;
for i := 0 to ListBox1.Items.Count - 1 do
if MaxWidth < ListBox1.Canvas.TextWidth(ListBox1.Items.Strings) then
MaxWidth := ListBox1.Canvas.TextWidth(ListBox1.Items.Strings);

SendMessage(ListBox1.Handle, LB_SETHORIZONTALEXTENT, MaxWidth+2, 0);
end;

以上的代码首先得到ListBox中最长Item的长度,然后用LB_SETHORIZONTALEXTENT消息设置ListBox的水平滚动的宽度,宽度加2是为了给右面留2个点的边。
 
多谢您!已经搞定,我再为它加上选中后定义颜色,就更完美了。
 
多谢了
自己解决了,其实好简单啊,惭愧
下面是个样子
procedure TForm1.Button1Click(Sender: TObject);
begin
listBox1.Items.Add(edit1.Text );
end;

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
var
i:integer;
begin

//ListBox1.Canvas.Brush.Color := Index * $A0F0F0;
ListBox1.Canvas.FillRect(Rect);
//上面的代码是填充Item的背景,下面画出每个Item的文字,可以为每个Item设置不同的字体及着色
ListBox1.Canvas.Font.Color := clRed;
//用Canvas的TextOut画出文字:
ListBox1.Canvas.TextOut(Rect.Left, Rect.Top, ListBox1.Items[Index]);

listBox1.Canvas.Font.Color :=clBlack;
for i:=0 to memo1.Lines.Count -1 do begin
listbox1.Canvas.TextOut(rect.Left ,rect.Top+16*(i+1) ,memo1.Lines );
end;
end;



procedure TForm1.ListBox1MeasureItem(Control: TWinControl; Index: Integer;
var Height: Integer);
begin
//Height := Index Mod 3 * 2 + ListBox1.ItemHeight;
height:=16*(memo1.Lines.Count+1);
end;
 
后退
顶部