有没有能做出类似qq聊天记录形式的控件呢？着急

[newdreamer]

可以选择，可以自动折行的。谢谢，我急需。

[Kshape]

没用过
自己写了

[cdsgajxlp]

没有见过

[BambooCaep]

自己写吧，从TCustomListView继承。

[haen_zhou]

我同我的同事正在写这部分的代码哈

[纯冰糖]

Study...

[adong2838]

幫你UP....................

[jb99334]

没见到过,自己写吧

[yinxu]

就是跟TListBox差不多

[Kshape]

qq聊天记录形式
------------------------
还没有仔细研究过这个东西呢

[DieGhost]

没人写啊.

自己用Ado的原生类开发吧,可以分页

[sixgj]

好象没有……

[newdreamer]

顶

[王集鹄]

//参考如下代码～～
function SubStrCount( //统计子串出现的次数
mStr: string; //字符串
mSub: string //子串
): Integer; //返回子字符串出现的次数
begin
Result := (Length(mStr) -
Length(StringReplace(mStr, mSub, '', [rfReplaceAll]))) div Length(mSub);
end; { SubStrCount }

procedure TForm1.FormCreate(Sender: TObject);
begin
ListBox1.Style := lbOwnerDrawVariable;
FCharHeight := ListBox1.Canvas.TextHeight('|');
Font.Name := '宋体';
Font.Size := 9;

ListBox1.Items.Add(
'(2005-01-11 11:13:13) 拉灯(410465996)'#13#10 +
'投我一票吧！'#13#10
);
ListBox1.Items.Add(
'(2005-01-11 11:14:56) 拉灯(410465996)'#13#10 +
'那我只好去CSDN灌点水了'#13#10
);
ListBox1.Items.Add(
'(2005-02-04 11:12:44) CoolSlob(7975379)'#13#10 +
'明天可以回家了'#13#10
);
ListBox1.Items.Add(
'(2005-01-11 11:14:25) 布石(356213398)'#13#10 +
'昨天没有上网吗？'#13#10 +
'看你进天的表现，:)'#13#10
);
ListBox1.Items.Add(
'(2005-01-13 17:39:03) Ehomsoft(18270172)'#13#10 +
'在某个月黑风高的晚上。。。'#13#10 +
'我用我的独门武器，刷票机，找了台肉机，把第一页作弊的全刷黑了'#13#10
);
end;

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
var
I: Integer;
begin
with TListBox(Control) do
begin
Canvas.FillRect(Rect);
with TStringList.Create do try
Text := Items[Index];
Canvas.Font.Color := clRed;
Canvas.TextOut(Rect.Left, Rect.Top + FCharHeight * 0, Strings[0]);
Canvas.Font.Color := clBlue;
for I := 1 to Pred(Count) do
Canvas.TextOut(Rect.Left, Rect.Top + FCharHeight * I, Strings[I]);
finally
Free;
end;
end;
end;

procedure TForm1.ListBox1MeasureItem(Control: TWinControl; Index: Integer;
var Height: Integer);
begin
Height := (SubStrCount(TrimRight(TListBox(Control).Items[Index]), #13#10) + 1) *
FCharHeight + 1;
end;

[王集鹄]

效果图：
http://www.soulan.com/kingron/UploadFile/2005-2/200525141457122.gif

无语……

[newdreamer]

FCharHeight 这个是怎么取值的。我直接写了10，不行呀。

[newdreamer]

你这个是自己加了换行控制了，当然是可以了。我现在要的是能自动换行的。

[kuki84]

帮up,弄出来了共享学习一下。

[王集鹄]

//封装成如下元件请参考～～
//其他功能请自己补充～～

(*//
标题:显示换行的ListBox
说明:如显示聊天记录
日期:2005-02-05
设计:Zswang
支持:[e-mail]
//*)

//*******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;
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;
TForm(Parent).Caption := Format('%.6f', [Now]);
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[I] := Items[I];
Items.EndUpdate;
end;

procedure THistoryBox.SetWordWrap(const Value: Boolean);
begin
if FWordWrap = Value then Exit;
FWordWrap := Value;
Resize;
end;

end.

[王集鹄]

TForm(Parent).Caption := Format('%.6f', [Now]); //<<<<<<这条语句是我做调试用的，用的时候请删掉

[newdreamer]

这段代码实现不了呀。