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

没人写啊.自己用Ado的原生类开发吧,可以分页

自己写吧，从TCustomListView继承。

//参考如下代码～～
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无语……

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

//封装成如下元件请参考～～
//其他功能请自己补充～～(*//
标题:显示换行的ListBox
说明:如显示聊天记录
日期:2005-02-05
设计:Zswang
支持:[email protected]
//*)//*******Begin 修改日志*******//
//2005-02-05 Zswang No.1 新建
//------------------------------------------------------------------------------
//2003-02-07 Zswang No.1 完善加入自动换行的属性
//*******End 修改日志*******//unit HistoryBox;interfaceuses
  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;implementationprocedure 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]); //<<<<<<这条语句是我做调试用的，用的时候请删掉

调试易

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

解决方案 »