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

2005-02-02 10:18:46 256 阅读 AI 写同款 · GEO 优化AI 选题数据监测一键分发 ›

python分析qq聊天记录一、任务目标本实验主要是根据导出的qq群聊天记录，做一个简单的数据提取和可视化操作，比较简单而且贴合现实生活。二、环境以及所需的安装包环境： win10+python3 安装包： import re import datetime import matplotlib.pyplot as plt import ... 阅读详情

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

...全文

QQ聊天记录统计可视化分析 QQ聊天记录统计可视化分析阅读详情

newdreamer

Delphi 5,944 成员 262,941 内容

+ 关注 + 加入社区

切换为时间正序

newdreamer 2005-02-07

打赏
举报

这段代码实现不了呀。

王集鹄 2005-02-07

打赏
举报

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

王集鹄 2005-02-07

打赏
举报

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

(*//
标题:显示换行的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;
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.

kuki84 2005-02-07

打赏
举报

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

newdreamer 2005-02-07

打赏
举报

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

newdreamer 2005-02-07

打赏
举报

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

王集鹄 2005-02-07

打赏
举报

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

无语……

王集鹄 2005-02-05

打赏
举报

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

newdreamer 2005-02-04

打赏
举报

顶

sixgj 2005-02-02

打赏
举报

好象没有……

DieGhost 2005-02-02

打赏
举报

没人写啊.

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

Kshape 2005-02-02

打赏
举报

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

yinxu 2005-02-02

打赏
举报

就是跟TListBox差不多

jb99334 2005-02-02

打赏
举报

没见到过,自己写吧

adong2838 2005-02-02

打赏
举报

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

纯冰糖 2005-02-02

打赏
举报

Study...

haen_zhou 2005-02-02

打赏
举报

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

BambooCaep 2005-02-02

打赏
举报

自己写吧，从TCustomListView继承。

cdsgajxlp 2005-02-02

打赏
举报

没有见过

Kshape 2005-02-02

打赏
举报

没用过
自己写了

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

相关推荐