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(分钟/贴)
//---------------------------------------------------------------