CSDN人气统计器

王集鹄 2002-07-07 10:04:34
//TopicUnit.pas

(*//
标题:CSDN人气统计
说明:统计抽样帖子中分数、回复、时间差的情况
设计:Zswang
支持:wjhu111@21cn.com
日期:2002-07-06
//*)

unit TopicUnit;

interface

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

type
TFormTopic = class(TForm)
MemoData: TMemo;
ButtonCalc: TButton;
MemoReport: TMemo;
EditTitle: TEdit;
procedure FormCreate(Sender: TObject);
procedure ButtonCalcClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
FormTopic: TFormTopic;

implementation

{$R *.dfm}

{$IFDEF VER140}
uses StrUtils, DateUtils;
{$ELSE}
function ReverseString(const AText: string): string;
var
I: Integer;
begin
Result := '';
for I := Length(AText) downto 1 do
Result := Result + AText[I];
end;

function SpanOfNowAndThen(const ANow, AThen: TDateTime): TDateTime;
begin
if ANow < AThen then
Result := AThen - ANow
else
Result := ANow - AThen;
end;

function MinuteSpan(const ANow, AThen: TDateTime): Double;
begin
Result := 24 * 60 * SpanOfNowAndThen(ANow, AThen);
end;

function StrToDateTimeDef(const S: string; const Default: TDateTime): TDateTime;
begin
try
Result := StrToDateTime(S);
except
Result := Default;
end;
end;
{$ENDIF}

function Calc(mStrings: TStrings; var nMark, nRevert, nTimeSpan: Real): Boolean;
const
cYear = '2002';
var
I, J: Integer;
S: string;
vMaxTime: TDateTime;
vMinTime: TDateTime;
vMark, vRevert: Integer;
vDateTime: TDateTime;
begin
Result := False;
if not Assigned(mStrings) then Exit;
///////Begin 清除相同的数据
for I := mStrings.Count - 1 downto 0 do
if mStrings.IndexOf(mStrings[I]) <> I then
mStrings.Delete(I);
///////End 清除相同的数据
///////Begin 初始化变量
nMark := 0;
nRevert := 0;
nTimeSpan := 0;
vMaxTime := 0;
vMinTime := 0;
///////End 初始化变量
for I := 0 to mStrings.Count - 1 do begin
S := ReverseString(Trim(mStrings[I]));
///////Begin 处理时间部分
Delete(S, 1, 5);
Delete(S, 3, 1);
vDateTime := StrToDateTimeDef(cYear + '-' +
ReverseString(Copy(S, 1, 11)), 0);
if vMaxTime = 0 then
vMaxTime := vDateTime
else if vDateTime > vMaxTime then
vMaxTime := vDateTime;
if vMinTime = 0 then
vMinTime := vDateTime
else if vDateTime < vMinTime then
vMinTime := vDateTime;
Delete(S, 1, 12);
///////End 处理时间部分
///////Begin 处理回复部分
J := Pos(' ', S) - 1;
vRevert := StrToIntDef(ReverseString(Copy(S, 1, J)), 0);
Delete(S, 1, J + 1);
///////End 处理回复部分
///////Begin 处理分数部分
J := Pos(' ', S) - 1;
vMark := StrToIntDef(ReverseString(Copy(S, 1, J)), 0);
///////End 处理分数部分
nMark := nMark + vMark;
nRevert := nRevert + vRevert;
end;
nTimeSpan := Int(MinuteSpan(vMaxTime, vMinTime) + 0.5); //计算时间差
Result := True;
end;

procedure TFormTopic.FormCreate(Sender: TObject);
begin
Font.Name := '宋体';
Font.Size := 9;
Caption := '人气统计';
ButtonCalc.Caption := '统计(&C)';
MemoData.WordWrap := False;
MemoReport.WordWrap := False;
MemoData.Clear;
EditTitle.Clear;
MemoReport.Clear;
end;

procedure TFormTopic.ButtonCalcClick(Sender: TObject);
var
vMark, vRevert, vTimeSpan: Real;
vCount: Integer;
begin
vCount := MemoData.Lines.Count;
if vCount <= 0 then Exit;
Calc(MemoData.Lines, vMark, vRevert, vTimeSpan);
vCount := MemoData.Lines.Count;
MemoReport.Lines.Add(EditTitle.Text);
MemoReport.Lines.Add('[抽样数据]');
MemoReport.Lines.Add(MemoData.Lines[0]);
MemoReport.Lines.Add(Format('... 共%d贴 ...', [vCount]));
MemoReport.Lines.Add(MemoData.Lines[MemoData.Lines.Count - 1]);
MemoReport.Lines.Add('');
MemoReport.Lines.Add('[统计结果]');
MemoReport.Lines.Add(Format(
'合计分数: %7.2f (分); 合计回复: %7.2f (次); 合计时差: %7.2f (分钟)',
[vMark, vRevert, vTimeSpan]));
MemoReport.Lines.Add(Format(
'平均分数: %7.2f(分/贴); 平均回复: %7.2f(次/贴); 平均时差: %7.2f(分钟/贴)',
[vMark / vCount, vRevert / vCount, vTimeSpan / vCount]));
MemoReport.Lines.Add(
'//---------------------------------------------------------------');
end;

end.

//TopicUnit.dfm
object FormTopic: TFormTopic
Left = 192
Top = 107
Width = 503
Height = 321
Caption = 'FormTopic'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object MemoData: TMemo
Left = 8
Top = 24
Width = 481
Height = 128
Anchors = [akLeft, akTop, akRight]
Lines.Strings = (
'MemoData')
TabOrder = 0
WordWrap = False
end
object ButtonCalc: TButton
Left = 8
Top = 264
Width = 75
Height = 25
Anchors = [akLeft, akBottom]
Caption = 'ButtonCalc'
TabOrder = 1
OnClick = ButtonCalcClick
end
object MemoReport: TMemo
Left = 8
Top = 160
Width = 481
Height = 97
Anchors = [akLeft, akTop, akRight, akBottom]
Lines.Strings = (
'MemoReport')
TabOrder = 2
end
object EditTitle: TEdit
Left = 8
Top = 0
Width = 481
Height = 21
Anchors = [akLeft, akTop, akRight]
TabOrder = 3
Text = 'EditTitle'
end
end


//---------------------------------------------------------------
Delphi (未结技术区)
[抽样数据]
? 如何屏蔽提示信息? (mscrack ) 20 6 07-07 10: 00 管理
... 共30贴 ...
? 窗口分辨率问题?急,急,急. (xxyzjf ) 20 7 07-07 08: 51 管理

[统计结果]
合计分数: 2110.00 (分); 合计回复: 311.00 (次); 合计时差: 69.00 (分钟)
平均分数: 70.33(分/贴); 平均回复: 10.37(次/贴); 平均时差: 2.30(分钟/贴)
//---------------------------------------------------------------
Visual C++ (未结技术区)
[抽样数据]
? 我如何用按钮控件来打开一个新的对话窗口?(极品菜鸟)回答就给分 (ilovenet ) 40 3 07-07 10: 03 管理
... 共30贴 ...
? 高手救命——300分!懂“控制脚本”的高高手们快快请进!(提思路给例程都可以) (Yhw0704 ) 100 34 07-07 08: 55 管理

[统计结果]
合计分数: 2165.00 (分); 合计回复: 509.00 (次); 合计时差: 68.00 (分钟)
平均分数: 72.17(分/贴); 平均回复: 16.97(次/贴); 平均时差: 2.27(分钟/贴)
//---------------------------------------------------------------
...全文
54 12 打赏 收藏 转发到动态 举报
写回复
用AI写文章
12 条回复
切换为时间正序
请发表友善的回复…
发表回复
zhptj 2002-07-08
  • 打赏
  • 举报
回复
有意思
捧场
Billy_Chen28 2002-07-08
  • 打赏
  • 举报
回复
关注
日总是我哥 2002-07-08
  • 打赏
  • 举报
回复
mark~~
日总是我哥 2002-07-08
  • 打赏
  • 举报
回复
mark~~
王集鹄 2002-07-08
  • 打赏
  • 举报
回复
procedure TFormTopic.ButtonCalcClick(Sender: TObject);
var
vMark, vRevert, vTimeSpan: Real;
vCount: Integer;
I: Integer;
vStringList: TStringList;
begin
vCount := MemoData.Lines.Count;
if vCount <= 0 then Exit;
vStringList := TStringList.Create;
try
///////Begin 处理全拷贝的情况
vStringList.Assign(MemoData.Lines);
for I := vCount - 1 downto 0 do
if (Pos('版主:', Trim(vStringList[I])) = 1) and (I > 0) then begin
EditTitle.Text := Trim(vStringList[I - 1]);
vStringList.Delete(I);
end else if (Pos( '?', Trim(vStringList[I])) = 1) or
(Pos( '√', Trim(vStringList[I])) = 1) then
else vStringList.Delete(I);
///////End 处理全拷贝的情况
Calc(vStringList, vMark, vRevert, vTimeSpan);
vCount := vStringList.Count;
MemoReport.Lines.Add(EditTitle.Text);
MemoReport.Lines.Add('[抽样数据]');
MemoReport.Lines.Add(vStringList[0]);
MemoReport.Lines.Add(Format('... 共%d贴 ...', [vCount]));
MemoReport.Lines.Add(vStringList[vStringList.Count - 1]);
MemoReport.Lines.Add('');
MemoReport.Lines.Add('[统计结果]');
MemoReport.Lines.Add(Format(
'合计分数: %7.2f (分); 合计回复: %7.2f (次); 合计时差: %7.2f (分钟)',
[vMark, vRevert, vTimeSpan]));
MemoReport.Lines.Add(Format(
'平均分数: %7.2f(分/贴); 平均回复: %7.2f(次/贴); 平均时差: %7.2f(分钟/贴)',
[vMark / vCount, vRevert / vCount, vTimeSpan / vCount]));
MemoReport.Lines.Add(
'//---------------------------------------------------------------');
finally
vStringList.Free;
end;
end;


Visual C++ (已解决问题)
[抽样数据]
√ 在线等待,高分求助:应用程序初始化(0xc0000142)失败 (zhlc9 ) 100 18 07-08 08: 39 管理
... 共30贴 ...
√ win98下用直接端口操作,怎么控制不了打印机了? -----在此先谢谢大侠了----- (MSVCer ) 100 9 07-07 13: 40 管理

[统计结果]
合计分数: 2124.00 (分); 合计回复: 239.00 (次); 合计时差: 1139.00 (分钟)
平均分数: 70.80(分/贴); 平均回复: 7.97(次/贴); 平均时差: 37.97(分钟/贴)
//---------------------------------------------------------------
Delphi (已解决问题)
[抽样数据]
√ 请大家帮忙,来者有分!!!!!! (hotxu ) 200 44 07-08 08: 44 管理
... 共30贴 ...
√ 我正在作的窗体突然就不能打开了(一分钟之前我还在用呢), (xjl ) 80 30 07-07 16: 46 管理

[统计结果]
合计分数: 2373.00 (分); 合计回复: 357.00 (次); 合计时差: 958.00 (分钟)
平均分数: 79.10(分/贴); 平均回复: 11.90(次/贴); 平均时差: 31.93(分钟/贴)
//---------------------------------------------------------------Visual C++ (未结技术区)
[抽样数据]
? 郁闷!只有你们才能理解! (mscsdn ) 10 6 07-08 09: 01 管理
... 共30贴 ...
? 高分~,谁知道access中数据输入时用的表格是什么控件,我怎么才能调用这个控件? (luckbird ) 100 1 07-08 08: 48 管理

[统计结果]
合计分数: 2223.00 (分); 合计回复: 208.00 (次); 合计时差: 13.00 (分钟)
平均分数: 74.10(分/贴); 平均回复: 6.93(次/贴); 平均时差: 0.43(分钟/贴)
//---------------------------------------------------------------
Delphi (未结技术区)
[抽样数据]
? Label问题 (toplor ) 20 14 07-08 09: 02 管理
... 共30贴 ...
? rain xp (nb20022 ) 50 5 07-08 08: 44 管理

[统计结果]
合计分数: 2539.00 (分); 合计回复: 376.00 (次); 合计时差: 18.00 (分钟)
平均分数: 84.63(分/贴); 平均回复: 12.53(次/贴); 平均时差: 0.60(分钟/贴)
//---------------------------------------------------------------

yangyugw 2002-07-08
  • 打赏
  • 举报
回复
开来用DELPHI的问题最多了
kakiyawen 2002-07-08
  • 打赏
  • 举报
回复
厉害
王集鹄 2002-07-08
  • 打赏
  • 举报
回复
Delphi (未结技术区)
[抽样数据]
? 能给个stringrid的例子吗?一步步的那种,我有程序可不会把控件和程序对应 (littlekf ) 20 1 07-08 13: 45 管理
... 共30贴 ...
? 我的程序在运行的时候会调用一个批处理文件,我怎么监视这个程序退出. (zsy_good ) 50 1 07-08 13: 33 管理

[统计结果]
合计分数: 2250.00 (分); 合计回复: 446.00 (次); 合计时差: 12.00 (分钟)
平均分数: 75.00(分/贴); 平均回复: 14.87(次/贴); 平均时差: 0.40(分钟/贴)
//---------------------------------------------------------------
Visual C++ (未结技术区)
[抽样数据]
? 怎么样快速(效率要求很高)把一个文件的内容放到一个字符串中???? (Sale_Boss ) 50 0 07-08 13: 48 管理
... 共30贴 ...
? 各位专家好!关于软键盘的窗口实现问题! (szptfjq ) 100 1 07-08 13: 35 管理

[统计结果]
合计分数: 2100.00 (分); 合计回复: 53.00 (次); 合计时差: 13.00 (分钟)
平均分数: 70.00(分/贴); 平均回复: 1.77(次/贴); 平均时差: 0.43(分钟/贴)
//---------------------------------------------------------------
Visual Basic (未结技术区)
[抽样数据]
? 一个ado的疑问,请大家解释 (miu ) 60 2 07-08 13: 49 管理
... 共30贴 ...
? 哪能搞到中文的vb帮助? (usb ) 10 5 07-08 13: 27 管理

[统计结果]
合计分数: 1850.00 (分); 合计回复: 285.00 (次); 合计时差: 22.00 (分钟)
平均分数: 61.67(分/贴); 平均回复: 9.50(次/贴); 平均时差: 0.73(分钟/贴)
//---------------------------------------------------------------
C++ Builder (未结技术区)
[抽样数据]
? 请问socket通信能单独作为一个线程吗? (francohe ) 100 2 07-08 13: 49 管理
... 共30贴 ...
? 我写了一个程序,要求是用户点击我的这个程序时,程序就能自动运行到电脑的启动中,以后每次电脑启动的时候就自动运行这个程序了,那应该 (citywolf ) 60 5 07-08 12: 56 管理

[统计结果]
合计分数: 1910.00 (分); 合计回复: 172.00 (次); 合计时差: 53.00 (分钟)
平均分数: 63.67(分/贴); 平均回复: 5.73(次/贴); 平均时差: 1.77(分钟/贴)
//---------------------------------------------------------------


嘻嘻嘻 看来Delphi的回复次数比较高 嘻嘻嘻嘻
ihihonline 2002-07-07
  • 打赏
  • 举报
回复
嘻嘻嘻,收到,嘻嘻嘻
johnsonrao 2002-07-07
  • 打赏
  • 举报
回复
收到!
xyxx 2002-07-07
  • 打赏
  • 举报
回复
GAO!
netlib 2002-07-07
  • 打赏
  • 举报
回复
呵呵,谢谢!!!

5,379

社区成员

发帖
与我相关
我的任务
社区描述
Delphi 开发及应用
社区管理员
  • VCL组件开发及应用社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧