(*//

标题:显示换行的ListBox

说明:如显示聊天记录

日期:2005-02-05

设计:Zswang

支持:wjhu111@21cn.com

//*)

//*******Begin 修改日志*******//

//2005-02-05 Zswang No.1 新建

//------------------------------------------------------------------------------

//2003-02-07 Zswang No.1 完善 加入自动换行的属性

//*******End 修改日志*******//

unit HistoryBox;

interface

uses

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

type

 THistoryBox = class(TCustomListBox)

 private

   FWordWrap: Boolean;

   procedure SetWordWrap(const Value: Boolean);

   { Private declarations }

 protected

   { Protected declarations }

   procedure DrawItem(Index: Integer; Rect: TRect;

     State: TOwnerDrawState); override;

   procedure MeasureItem(Index: Integer; var Height: Integer); override;

   procedure Resize; override;

 public

   { Public declarations }

   constructor Create(AOwner: TComponent); override;

 published

   { Published declarations }

   property WordWrap: Boolean read FWordWrap write SetWordWrap default True;   //2003-02-07 Zswang No.1

   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 OnDrawItem;

   property OnEndDock;

   property OnEndDrag;

   property OnEnter;

   property OnExit;

   property OnKeyDown;

   property OnKeyPress;

   property OnKeyUp;

   property OnMeasureItem;

   property OnMouseDown;

   property OnMouseMove;

   property OnMouseUp;

   property OnStartDock;

   property OnStartDrag;

 end;

procedure Register;

implementation

procedure Register;

begin

 RegisterComponents('Zswang', [THistoryBox]);

end;

{ THistoryBox }

const

 cWordWraps: array[Boolean] of Word = (0, DT_WORDBREAK);

constructor THistoryBox.Create(AOwner: TComponent);

begin

 inherited;

 FWordWrap := True;

 Style := lbOwnerDrawVariable;

end;

procedure THistoryBox.DrawItem(Index: Integer; Rect: TRect;

 State: TOwnerDrawState);

var

 vRect: TRect;

 S: string;

begin

 inherited;

 S := Items[Index];

 Canvas.FillRect(Rect);

 vRect := Rect;

 if Odd(Index) then

   Canvas.Font.Color := clRed

 else Canvas.Font.Color := clBlue;

 DrawText(Canvas.Handle, PChar(S), Length(S), vRect,

   DT_LEFT or cWordWraps[FWordWrap]);

end;

procedure THistoryBox.MeasureItem(Index: Integer; var Height: Integer);

var

 vRect: TRect;

 S: string;

begin

 inherited;

 S := Items[Index];

 vRect := ClientRect;

 DrawText(Canvas.Handle, PChar(S), Length(S), vRect,

   DT_LEFT or cWordWraps[FWordWrap] or DT_CALCRECT);

 Height := vRect.Bottom - vRect.Top;

end;

procedure THistoryBox.Resize;

var

 I: Integer;

begin

 inherited;

 if not FWordWrap then Exit;

 Items.BeginUpdate;

 for I := 0 to Items.Count - 1 do Items := Items;

 Items.EndUpdate;

end;

procedure THistoryBox.SetWordWrap(const Value: Boolean);

begin

 if FWordWrap = Value then Exit;

 FWordWrap := Value;

 Resize;

end;

end.