You've already forked lazarus-ccr
jvcllaz: Add TJvProfiler.
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6859 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
@ -1,3 +1,4 @@
|
|||||||
tjvstrholder.bmp
|
tjvstrholder.bmp
|
||||||
tjvmultistringholder.bmp
|
tjvmultistringholder.bmp
|
||||||
tjvspellchecker.bmp
|
tjvspellchecker.bmp
|
||||||
|
tjvprofiler.bmp
|
||||||
BIN
components/jvcllaz/design/JvCmp/images/tjvprofiler.bmp
Normal file
BIN
components/jvcllaz/design/JvCmp/images/tjvprofiler.bmp
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 1.6 KiB |
@ -17,12 +17,12 @@ uses
|
|||||||
Classes, PropEdits, ComponentEditors,
|
Classes, PropEdits, ComponentEditors,
|
||||||
JvDsgnConsts,
|
JvDsgnConsts,
|
||||||
JvStringHolder, JvSpellChecker,
|
JvStringHolder, JvSpellChecker,
|
||||||
JvStrHolderEditor;
|
JvStrHolderEditor, JvProfilerForm;
|
||||||
|
|
||||||
procedure Register;
|
procedure Register;
|
||||||
begin
|
begin
|
||||||
RegisterComponents(RsPaletteJvcl, [
|
RegisterComponents(RsPaletteJvcl, [
|
||||||
TJvStrHolder, TJvMultiStringHolder,
|
TJvStrHolder, TJvMultiStringHolder, TJvProfiler,
|
||||||
TJvSpellChecker
|
TJvSpellChecker
|
||||||
]);
|
]);
|
||||||
RegisterComponentEditor(TJvStrHolder, TJvStrHolderEditor);
|
RegisterComponentEditor(TJvStrHolder, TJvStrHolderEditor);
|
||||||
|
|||||||
189
components/jvcllaz/examples/JvProfiler32/Profiler32MainFormU.lfm
Normal file
189
components/jvcllaz/examples/JvProfiler32/Profiler32MainFormU.lfm
Normal file
@ -0,0 +1,189 @@
|
|||||||
|
object Profiler32MainForm: TProfiler32MainForm
|
||||||
|
Left = 343
|
||||||
|
Height = 357
|
||||||
|
Top = 157
|
||||||
|
Width = 466
|
||||||
|
Caption = 'Profiler 32 test program'
|
||||||
|
ClientHeight = 357
|
||||||
|
ClientWidth = 466
|
||||||
|
Color = clBtnFace
|
||||||
|
Constraints.MinHeight = 200
|
||||||
|
Constraints.MinWidth = 380
|
||||||
|
DefaultMonitor = dmDesktop
|
||||||
|
Font.Color = clWindowText
|
||||||
|
KeyPreview = True
|
||||||
|
OnClose = FormClose
|
||||||
|
OnCreate = FormCreate
|
||||||
|
OnKeyDown = FormKeyDown
|
||||||
|
Position = poScreenCenter
|
||||||
|
LCLVersion = '2.1.0.0'
|
||||||
|
Scaled = False
|
||||||
|
object ListBox1: TListBox
|
||||||
|
Left = 6
|
||||||
|
Height = 303
|
||||||
|
Top = 38
|
||||||
|
Width = 454
|
||||||
|
Align = alClient
|
||||||
|
BorderSpacing.Left = 6
|
||||||
|
BorderSpacing.Right = 6
|
||||||
|
BorderStyle = bsNone
|
||||||
|
Items.Strings = (
|
||||||
|
'ASSOC'
|
||||||
|
'AT'
|
||||||
|
'ATTRIB'
|
||||||
|
'BREAK'
|
||||||
|
'CACLS'
|
||||||
|
'CALL'
|
||||||
|
'CD'
|
||||||
|
'CHCP'
|
||||||
|
'CHDIR'
|
||||||
|
'CHKDSK'
|
||||||
|
'CLS'
|
||||||
|
'CMD'
|
||||||
|
'COLOR'
|
||||||
|
'COMP'
|
||||||
|
'COMPACT'
|
||||||
|
'CONVERT'
|
||||||
|
'COPY'
|
||||||
|
'DATE'
|
||||||
|
'DEL'
|
||||||
|
'DIR'
|
||||||
|
'DISKCOMP'
|
||||||
|
'DISKCOPY'
|
||||||
|
'DOSKEY'
|
||||||
|
'ECHO'
|
||||||
|
'ENDLOCAL'
|
||||||
|
'ERASE'
|
||||||
|
'EXIT'
|
||||||
|
'FC'
|
||||||
|
'FIND'
|
||||||
|
'FINDSTR'
|
||||||
|
'FOR'
|
||||||
|
'FORMAT'
|
||||||
|
'FTYPE'
|
||||||
|
'GOTO'
|
||||||
|
'GRAFTABL'
|
||||||
|
'HELP'
|
||||||
|
'IF'
|
||||||
|
'KEYB'
|
||||||
|
'LABEL'
|
||||||
|
'MD'
|
||||||
|
'MKDIR'
|
||||||
|
'MODE'
|
||||||
|
'MORE'
|
||||||
|
'MOVE'
|
||||||
|
'PATH'
|
||||||
|
'PAUSE'
|
||||||
|
'POPD'
|
||||||
|
'PRINT'
|
||||||
|
'PROMPT'
|
||||||
|
'PUSHD'
|
||||||
|
'RD'
|
||||||
|
'RECOVER'
|
||||||
|
'REM'
|
||||||
|
'REN'
|
||||||
|
'RENAME'
|
||||||
|
'REPLACE'
|
||||||
|
'RESTORE'
|
||||||
|
'RMDIR'
|
||||||
|
'SET'
|
||||||
|
'SETLOCAL'
|
||||||
|
'SHIFT'
|
||||||
|
'SORT'
|
||||||
|
'START'
|
||||||
|
'SUBST'
|
||||||
|
'TIME'
|
||||||
|
'TITLE'
|
||||||
|
'TREE'
|
||||||
|
'TYPE'
|
||||||
|
'VER'
|
||||||
|
'VERIFY'
|
||||||
|
'VOL'
|
||||||
|
'XCOPY'
|
||||||
|
)
|
||||||
|
ItemHeight = 15
|
||||||
|
TabOrder = 0
|
||||||
|
end
|
||||||
|
object Panel1: TPanel
|
||||||
|
Left = 0
|
||||||
|
Height = 38
|
||||||
|
Top = 0
|
||||||
|
Width = 466
|
||||||
|
Align = alTop
|
||||||
|
AutoSize = True
|
||||||
|
BevelOuter = bvNone
|
||||||
|
ClientHeight = 38
|
||||||
|
ClientWidth = 466
|
||||||
|
TabOrder = 1
|
||||||
|
object Label1: TLabel
|
||||||
|
AnchorSideLeft.Control = Panel1
|
||||||
|
AnchorSideTop.Control = Panel1
|
||||||
|
AnchorSideTop.Side = asrCenter
|
||||||
|
Left = 6
|
||||||
|
Height = 15
|
||||||
|
Top = 12
|
||||||
|
Width = 72
|
||||||
|
BorderSpacing.Around = 6
|
||||||
|
Caption = 'Create report:'
|
||||||
|
ParentColor = False
|
||||||
|
end
|
||||||
|
object UseIdBtn: TButton
|
||||||
|
AnchorSideLeft.Control = Label1
|
||||||
|
AnchorSideLeft.Side = asrBottom
|
||||||
|
AnchorSideTop.Control = Panel1
|
||||||
|
AnchorSideTop.Side = asrCenter
|
||||||
|
Left = 108
|
||||||
|
Height = 25
|
||||||
|
Top = 7
|
||||||
|
Width = 75
|
||||||
|
BorderSpacing.Left = 24
|
||||||
|
BorderSpacing.Around = 6
|
||||||
|
Caption = 'Use &ID'
|
||||||
|
OnClick = UseIdBtnClick
|
||||||
|
TabOrder = 0
|
||||||
|
end
|
||||||
|
object UseNameBtn: TButton
|
||||||
|
AnchorSideLeft.Control = UseIdBtn
|
||||||
|
AnchorSideLeft.Side = asrBottom
|
||||||
|
AnchorSideTop.Control = Panel1
|
||||||
|
AnchorSideTop.Side = asrCenter
|
||||||
|
Left = 197
|
||||||
|
Height = 25
|
||||||
|
Top = 7
|
||||||
|
Width = 75
|
||||||
|
BorderSpacing.Left = 8
|
||||||
|
BorderSpacing.Around = 6
|
||||||
|
Caption = 'Use &name'
|
||||||
|
OnClick = UseNameBtnClick
|
||||||
|
TabOrder = 1
|
||||||
|
end
|
||||||
|
object ResultBtn: TButton
|
||||||
|
AnchorSideTop.Control = Panel1
|
||||||
|
AnchorSideTop.Side = asrCenter
|
||||||
|
AnchorSideRight.Control = Panel1
|
||||||
|
AnchorSideRight.Side = asrBottom
|
||||||
|
Left = 385
|
||||||
|
Height = 25
|
||||||
|
Top = 7
|
||||||
|
Width = 75
|
||||||
|
Anchors = [akTop, akRight]
|
||||||
|
BorderSpacing.Left = 80
|
||||||
|
BorderSpacing.Around = 6
|
||||||
|
Caption = '&Result'
|
||||||
|
OnClick = ResultBtnClick
|
||||||
|
TabOrder = 2
|
||||||
|
end
|
||||||
|
end
|
||||||
|
object Progress: TProgressBar
|
||||||
|
Left = 0
|
||||||
|
Height = 16
|
||||||
|
Top = 341
|
||||||
|
Width = 466
|
||||||
|
Align = alBottom
|
||||||
|
TabOrder = 2
|
||||||
|
end
|
||||||
|
object P: TJvProfiler
|
||||||
|
left = 376
|
||||||
|
top = 56
|
||||||
|
end
|
||||||
|
end
|
||||||
171
components/jvcllaz/examples/JvProfiler32/Profiler32MainFormU.pas
Normal file
171
components/jvcllaz/examples/JvProfiler32/Profiler32MainFormU.pas
Normal file
@ -0,0 +1,171 @@
|
|||||||
|
{-----------------------------------------------------------------------------
|
||||||
|
The contents of this file are subject to the Mozilla Public License
|
||||||
|
Version 1.1 (the "License"); you may not use this file except in compliance
|
||||||
|
with the License. You may obtain a copy of the License at
|
||||||
|
http://www.mozilla.org/MPL/MPL-1.1.html
|
||||||
|
|
||||||
|
Software distributed under the License is distributed on an "AS IS" basis,
|
||||||
|
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
|
||||||
|
the specific language governing rights and limitations under the License.
|
||||||
|
|
||||||
|
The Original Code is: JvLookOut.PAS, released on 2002-05-26.
|
||||||
|
|
||||||
|
The Initial Developer of the Original Code is Peter Th�rnqvist [peter3 att users dott sourceforge dott net]
|
||||||
|
Portions created by Peter Th�rnqvist are Copyright (C) 2002 Peter Th�rnqvist.
|
||||||
|
All Rights Reserved.
|
||||||
|
|
||||||
|
Contributor(s):
|
||||||
|
|
||||||
|
Last Modified: 2002-05-26
|
||||||
|
|
||||||
|
You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
|
||||||
|
located at http://jvcl.delphi-jedi.org
|
||||||
|
|
||||||
|
Known Issues:
|
||||||
|
-----------------------------------------------------------------------------}
|
||||||
|
|
||||||
|
unit Profiler32MainFormU;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
//Windows, Messages,
|
||||||
|
SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
||||||
|
StdCtrls, ExtCtrls, ComCtrls, //JvComponent,
|
||||||
|
JvProfilerForm;
|
||||||
|
|
||||||
|
type
|
||||||
|
TProfiler32MainForm = class(TForm)
|
||||||
|
ListBox1: TListBox;
|
||||||
|
Panel1: TPanel;
|
||||||
|
UseIdBtn: TButton;
|
||||||
|
UseNameBtn: TButton;
|
||||||
|
ResultBtn: TButton;
|
||||||
|
Label1: TLabel;
|
||||||
|
Progress: TProgressBar;
|
||||||
|
P: TJvProfiler;
|
||||||
|
procedure FormCreate(Sender: TObject);
|
||||||
|
procedure ResultBtnClick(Sender: TObject);
|
||||||
|
procedure UseNameBtnClick(Sender: TObject);
|
||||||
|
procedure UseIdBtnClick(Sender: TObject);
|
||||||
|
procedure FormClose(Sender: TObject; var AAction: TCloseAction);
|
||||||
|
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
||||||
|
private
|
||||||
|
FTerminated:boolean;
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
Profiler32MainForm: TProfiler32MainForm;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{$R *.lfm}
|
||||||
|
|
||||||
|
const
|
||||||
|
DefCaption = 'JvProfiler 32 Test program';
|
||||||
|
|
||||||
|
procedure TProfiler32MainForm.FormCreate(Sender: TObject);
|
||||||
|
begin
|
||||||
|
P.Names := ListBox1.Items;
|
||||||
|
P.Sorted := true;
|
||||||
|
P.Enabled := true;
|
||||||
|
FTerminated := false;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TProfiler32MainForm.ResultBtnClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
P.ShowReport;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TProfiler32MainForm.UseNameBtnClick(Sender: TObject);
|
||||||
|
var i,j,k:integer;
|
||||||
|
begin
|
||||||
|
Randomize;
|
||||||
|
{ just randomize to get some results }
|
||||||
|
Screen.Cursor := crHourGlass;
|
||||||
|
UseIdBtn.Enabled := false;
|
||||||
|
UseNameBtn.Enabled := false;
|
||||||
|
ResultBtn.Enabled := false;
|
||||||
|
P.Start;
|
||||||
|
try
|
||||||
|
k := Random(133);
|
||||||
|
Progress.Max := k;
|
||||||
|
for j := 0 to k do
|
||||||
|
begin
|
||||||
|
Progress.Position := j;
|
||||||
|
Caption := Format('%s - to do: %d',[DefCaption,k - j]);
|
||||||
|
i := Random(ListBox1.Items.Count);
|
||||||
|
{ use integer ID (Names[i] ID = i) }
|
||||||
|
P.EnterID(i);
|
||||||
|
Sleep(random(333)); // wp: replaces next line
|
||||||
|
// SleepEx(random(333),false);
|
||||||
|
P.ExitID(i);
|
||||||
|
Application.ProcessMessages;
|
||||||
|
if FTerminated then
|
||||||
|
Break;
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
Screen.Cursor := crDefault;
|
||||||
|
UseIdBtn.Enabled := true;
|
||||||
|
UseNameBtn.Enabled := true;
|
||||||
|
ResultBtn.Enabled := true;
|
||||||
|
end;
|
||||||
|
P.Stop;
|
||||||
|
Beep;
|
||||||
|
Progress.Position := 0;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TProfiler32MainForm.UseIdBtnClick(Sender: TObject);
|
||||||
|
var i,j,k:integer;
|
||||||
|
begin
|
||||||
|
Randomize;
|
||||||
|
P.Start;
|
||||||
|
{ make distributed randomize to get some results }
|
||||||
|
Screen.Cursor := crHourGlass;
|
||||||
|
UseIdBtn.Enabled := false;
|
||||||
|
UseNameBtn.Enabled := false;
|
||||||
|
ResultBtn.Enabled := false;
|
||||||
|
try
|
||||||
|
k := Random(100);
|
||||||
|
Progress.Max := k;
|
||||||
|
for j := 0 to k do
|
||||||
|
begin
|
||||||
|
Progress.Position := j;
|
||||||
|
Caption := Format('%s - to do: %d',[DefCaption,k - j]);
|
||||||
|
i := Random(ListBox1.Items.Count);
|
||||||
|
{ use string ID instead }
|
||||||
|
P.EnterName(P.Names[i]);
|
||||||
|
Sleep(10 * j); // wp: replaces next line
|
||||||
|
//SleepEx(10 * j,false);
|
||||||
|
P.ExitName(P.Names[i]);
|
||||||
|
Application.ProcessMessages;
|
||||||
|
if FTerminated then
|
||||||
|
Break;
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
Screen.Cursor := crDefault;
|
||||||
|
UseIdBtn.Enabled := true;
|
||||||
|
UseNameBtn.Enabled := true;
|
||||||
|
ResultBtn.Enabled := true;
|
||||||
|
end;
|
||||||
|
P.Stop;
|
||||||
|
Beep;
|
||||||
|
Progress.Position := 0;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TProfiler32MainForm.FormClose(Sender: TObject; var AAction: TCloseAction);
|
||||||
|
begin
|
||||||
|
Fterminated := true;
|
||||||
|
P.Enabled := false;
|
||||||
|
P.Stop;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TProfiler32MainForm.FormKeyDown(Sender: TObject; var Key: Word;
|
||||||
|
Shift: TShiftState);
|
||||||
|
begin
|
||||||
|
if Key = 27 then FTerminated := true;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
81
components/jvcllaz/examples/JvProfiler32/ProfilerDemo.lpi
Normal file
81
components/jvcllaz/examples/JvProfiler32/ProfilerDemo.lpi
Normal file
@ -0,0 +1,81 @@
|
|||||||
|
<?xml version="1.0" encoding="UTF-8"?>
|
||||||
|
<CONFIG>
|
||||||
|
<ProjectOptions>
|
||||||
|
<Version Value="12"/>
|
||||||
|
<PathDelim Value="\"/>
|
||||||
|
<General>
|
||||||
|
<SessionStorage Value="InProjectDir"/>
|
||||||
|
<Title Value="ProfilerDemo"/>
|
||||||
|
<Scaled Value="True"/>
|
||||||
|
<ResourceType Value="res"/>
|
||||||
|
<UseXPManifest Value="True"/>
|
||||||
|
<XPManifest>
|
||||||
|
<DpiAware Value="True"/>
|
||||||
|
</XPManifest>
|
||||||
|
<Icon Value="0"/>
|
||||||
|
</General>
|
||||||
|
<BuildModes>
|
||||||
|
<Item Name="Default" Default="True"/>
|
||||||
|
</BuildModes>
|
||||||
|
<PublishOptions>
|
||||||
|
<Version Value="2"/>
|
||||||
|
<UseFileFilters Value="True"/>
|
||||||
|
</PublishOptions>
|
||||||
|
<RunParams>
|
||||||
|
<FormatVersion Value="2"/>
|
||||||
|
<Modes Count="0"/>
|
||||||
|
</RunParams>
|
||||||
|
<RequiredPackages Count="2">
|
||||||
|
<Item1>
|
||||||
|
<PackageName Value="JvCmpR"/>
|
||||||
|
</Item1>
|
||||||
|
<Item2>
|
||||||
|
<PackageName Value="LCL"/>
|
||||||
|
</Item2>
|
||||||
|
</RequiredPackages>
|
||||||
|
<Units>
|
||||||
|
<Unit>
|
||||||
|
<Filename Value="ProfilerDemo.lpr"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
</Unit>
|
||||||
|
<Unit>
|
||||||
|
<Filename Value="Profiler32MainFormU.pas"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<ComponentName Value="Profiler32MainForm"/>
|
||||||
|
<HasResources Value="True"/>
|
||||||
|
<ResourceBaseClass Value="Form"/>
|
||||||
|
</Unit>
|
||||||
|
</Units>
|
||||||
|
</ProjectOptions>
|
||||||
|
<CompilerOptions>
|
||||||
|
<Version Value="11"/>
|
||||||
|
<PathDelim Value="\"/>
|
||||||
|
<Target>
|
||||||
|
<Filename Value="ProfilerDemo"/>
|
||||||
|
</Target>
|
||||||
|
<SearchPaths>
|
||||||
|
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||||
|
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||||
|
</SearchPaths>
|
||||||
|
<Linking>
|
||||||
|
<Options>
|
||||||
|
<Win32>
|
||||||
|
<GraphicApplication Value="True"/>
|
||||||
|
</Win32>
|
||||||
|
</Options>
|
||||||
|
</Linking>
|
||||||
|
</CompilerOptions>
|
||||||
|
<Debugging>
|
||||||
|
<Exceptions Count="3">
|
||||||
|
<Item1>
|
||||||
|
<Name Value="EAbort"/>
|
||||||
|
</Item1>
|
||||||
|
<Item2>
|
||||||
|
<Name Value="ECodetoolError"/>
|
||||||
|
</Item2>
|
||||||
|
<Item3>
|
||||||
|
<Name Value="EFOpenError"/>
|
||||||
|
</Item3>
|
||||||
|
</Exceptions>
|
||||||
|
</Debugging>
|
||||||
|
</CONFIG>
|
||||||
15
components/jvcllaz/examples/JvProfiler32/ProfilerDemo.lpr
Normal file
15
components/jvcllaz/examples/JvProfiler32/ProfilerDemo.lpr
Normal file
@ -0,0 +1,15 @@
|
|||||||
|
program ProfilerDemo;
|
||||||
|
|
||||||
|
uses
|
||||||
|
Interfaces,
|
||||||
|
Forms,
|
||||||
|
Profiler32MainFormU in 'Profiler32MainFormU.pas' {Profiler32MainForm};
|
||||||
|
|
||||||
|
{$R *.res}
|
||||||
|
|
||||||
|
begin
|
||||||
|
Application.Scaled:=True;
|
||||||
|
Application.Initialize;
|
||||||
|
Application.CreateForm(TProfiler32MainForm, Profiler32MainForm);
|
||||||
|
Application.Run;
|
||||||
|
end.
|
||||||
@ -18,7 +18,7 @@
|
|||||||
- StringHolder (easier access to TStrings at designtime)."/>
|
- StringHolder (easier access to TStrings at designtime)."/>
|
||||||
<License Value="The JVCL is released in accordance with the MPL 1.1 license. To get your own copy or read it, go to http://www.mozilla.org/MPL/MPL-1.1.html. "/>
|
<License Value="The JVCL is released in accordance with the MPL 1.1 license. To get your own copy or read it, go to http://www.mozilla.org/MPL/MPL-1.1.html. "/>
|
||||||
<Version Major="1" Release="4"/>
|
<Version Major="1" Release="4"/>
|
||||||
<Files Count="4">
|
<Files Count="5">
|
||||||
<Item1>
|
<Item1>
|
||||||
<Filename Value="..\run\JvCmp\JvSpellChecker.pas"/>
|
<Filename Value="..\run\JvCmp\JvSpellChecker.pas"/>
|
||||||
<UnitName Value="JvSpellChecker"/>
|
<UnitName Value="JvSpellChecker"/>
|
||||||
@ -35,6 +35,10 @@
|
|||||||
<Filename Value="..\run\JvCmp\jvstringholder.pas"/>
|
<Filename Value="..\run\JvCmp\jvstringholder.pas"/>
|
||||||
<UnitName Value="JvStringHolder"/>
|
<UnitName Value="JvStringHolder"/>
|
||||||
</Item4>
|
</Item4>
|
||||||
|
<Item5>
|
||||||
|
<Filename Value="..\run\JvCmp\jvprofilerform.pas"/>
|
||||||
|
<UnitName Value="JvProfilerForm"/>
|
||||||
|
</Item5>
|
||||||
</Files>
|
</Files>
|
||||||
<RequiredPkgs Count="2">
|
<RequiredPkgs Count="2">
|
||||||
<Item1>
|
<Item1>
|
||||||
|
|||||||
Binary file not shown.
143
components/jvcllaz/run/JvCmp/jvprofilerform.lfm
Normal file
143
components/jvcllaz/run/JvCmp/jvprofilerform.lfm
Normal file
@ -0,0 +1,143 @@
|
|||||||
|
object ProfReport: TProfReport
|
||||||
|
Left = 470
|
||||||
|
Height = 305
|
||||||
|
Top = 178
|
||||||
|
Width = 550
|
||||||
|
ActiveControl = lvReport
|
||||||
|
BorderIcons = [biSystemMenu]
|
||||||
|
Caption = 'Profiler Report'
|
||||||
|
ClientHeight = 305
|
||||||
|
ClientWidth = 550
|
||||||
|
Color = clBtnFace
|
||||||
|
Font.Color = clBlack
|
||||||
|
Icon.Data = {
|
||||||
|
FE0200000000010001002020040000000000E802000016000000280000002000
|
||||||
|
0000400000000100040000000000000200000000000000000000000000000000
|
||||||
|
0000000000000000800000800000008080008000000080008000808000008080
|
||||||
|
8000C0C0C0000000FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFF
|
||||||
|
FF00000007777777777777777777777777000000777777777777777777777777
|
||||||
|
77700030000000000000000000000007777703BBBBBBBBBBBBBBBBBBBBBBBB80
|
||||||
|
77773BBBBBBBBBBBBBBBBBBBBBBBBBB807773BBBBBBBBBBBBBBBBBBBBBBBBBBB
|
||||||
|
07773BBBBBBBBBBBB8008BBBBBBBBBBB07703BBBBBBBBBBBB0000BBBBBBBBBB8
|
||||||
|
077003BBBBBBBBBBB0000BBBBBBBBBB0770003BBBBBBBBBBB8008BBBBBBBBB80
|
||||||
|
7700003BBBBBBBBBBBBBBBBBBBBBBB077000003BBBBBBBBBBB0BBBBBBBBBB807
|
||||||
|
70000003BBBBBBBBB808BBBBBBBBB07700000003BBBBBBBBB303BBBBBBBB8077
|
||||||
|
000000003BBBBBBBB000BBBBBBBB0770000000003BBBBBBB80008BBBBBB80770
|
||||||
|
0000000003BBBBBB30003BBBBBB077000000000003BBBBBB00000BBBBB807700
|
||||||
|
00000000003BBBBB00000BBBBB07700000000000003BBBBB00000BBBB8077000
|
||||||
|
000000000003BBBB00000BBBB0770000000000000003BBBB00000BBB80770000
|
||||||
|
0000000000003BBB80008BBB077000000000000000003BBBBBBBBBB807700000
|
||||||
|
00000000000003BBBBBBBBB07700000000000000000003BBBBBBBB8077000000
|
||||||
|
000000000000003BBBBBBB0770000000000000000000003BBBBBB80770000000
|
||||||
|
0000000000000003BBBBB077000000000000000000000003BBBB807000000000
|
||||||
|
00000000000000003BB800000000000000000000000000000333000000000000
|
||||||
|
0000F8000003F0000001C0000000800000000000000000000000000000010000
|
||||||
|
00018000000380000003C0000007C0000007E000000FE000000FF000001FF000
|
||||||
|
001FF800003FF800003FFC00007FFC00007FFE0000FFFE0000FFFF0001FFFF00
|
||||||
|
01FFFF8003FFFF8003FFFFC007FFFFC007FFFFE00FFFFFE01FFFFFF07FFFFFF8
|
||||||
|
FFFF
|
||||||
|
}
|
||||||
|
OnShow = FormShow
|
||||||
|
Position = poScreenCenter
|
||||||
|
ShowHint = True
|
||||||
|
LCLVersion = '2.1.0.0'
|
||||||
|
object Panel1: TPanel
|
||||||
|
Left = 0
|
||||||
|
Height = 37
|
||||||
|
Top = 268
|
||||||
|
Width = 550
|
||||||
|
Align = alBottom
|
||||||
|
AutoSize = True
|
||||||
|
BevelOuter = bvNone
|
||||||
|
ClientHeight = 37
|
||||||
|
ClientWidth = 550
|
||||||
|
TabOrder = 0
|
||||||
|
object SaveBtn: TButton
|
||||||
|
AnchorSideLeft.Control = Panel1
|
||||||
|
AnchorSideTop.Control = Panel1
|
||||||
|
AnchorSideTop.Side = asrCenter
|
||||||
|
Left = 6
|
||||||
|
Height = 25
|
||||||
|
Hint = 'Save report to a file (compatible with Excel)'
|
||||||
|
Top = 6
|
||||||
|
Width = 75
|
||||||
|
BorderSpacing.Around = 6
|
||||||
|
Caption = '&Save...'
|
||||||
|
OnClick = SaveBtnClick
|
||||||
|
TabOrder = 0
|
||||||
|
end
|
||||||
|
object TrimBtn: TButton
|
||||||
|
AnchorSideLeft.Control = SaveBtn
|
||||||
|
AnchorSideLeft.Side = asrBottom
|
||||||
|
AnchorSideTop.Control = Panel1
|
||||||
|
AnchorSideTop.Side = asrCenter
|
||||||
|
Left = 87
|
||||||
|
Height = 25
|
||||||
|
Hint = 'Remove unused calls from the list'
|
||||||
|
Top = 6
|
||||||
|
Width = 75
|
||||||
|
BorderSpacing.Around = 6
|
||||||
|
Caption = '&Trim'
|
||||||
|
OnClick = TrimBtnClick
|
||||||
|
TabOrder = 1
|
||||||
|
end
|
||||||
|
object OKBtn: TButton
|
||||||
|
AnchorSideTop.Control = Panel1
|
||||||
|
AnchorSideTop.Side = asrCenter
|
||||||
|
AnchorSideRight.Control = Panel1
|
||||||
|
AnchorSideRight.Side = asrBottom
|
||||||
|
Left = 469
|
||||||
|
Height = 25
|
||||||
|
Hint = 'Close report window'
|
||||||
|
Top = 6
|
||||||
|
Width = 75
|
||||||
|
Anchors = [akTop, akRight]
|
||||||
|
BorderSpacing.Around = 6
|
||||||
|
Cancel = True
|
||||||
|
Caption = '&Close'
|
||||||
|
Default = True
|
||||||
|
ModalResult = 1
|
||||||
|
OnClick = OKBtnClick
|
||||||
|
TabOrder = 2
|
||||||
|
end
|
||||||
|
end
|
||||||
|
object lvReport: TListView
|
||||||
|
Left = 0
|
||||||
|
Height = 268
|
||||||
|
Hint = 'Click the top column to sort the items'
|
||||||
|
Top = 0
|
||||||
|
Width = 550
|
||||||
|
Align = alClient
|
||||||
|
BorderStyle = bsNone
|
||||||
|
Columns = <
|
||||||
|
item
|
||||||
|
Caption = 'Function / Procedure '
|
||||||
|
Width = 160
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Alignment = taRightJustify
|
||||||
|
Caption = 'Total time (ms)'
|
||||||
|
Width = 100
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Alignment = taRightJustify
|
||||||
|
Caption = 'Calls'
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Alignment = taRightJustify
|
||||||
|
Caption = 'Average time (ms)'
|
||||||
|
Width = 120
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Alignment = taRightJustify
|
||||||
|
Caption = 'Percent (%)'
|
||||||
|
Width = 90
|
||||||
|
end>
|
||||||
|
GridLines = True
|
||||||
|
MultiSelect = True
|
||||||
|
RowSelect = True
|
||||||
|
TabOrder = 1
|
||||||
|
ViewStyle = vsReport
|
||||||
|
OnColumnClick = lvReportColumnClick
|
||||||
|
end
|
||||||
|
end
|
||||||
525
components/jvcllaz/run/JvCmp/jvprofilerform.pas
Normal file
525
components/jvcllaz/run/JvCmp/jvprofilerform.pas
Normal file
@ -0,0 +1,525 @@
|
|||||||
|
{-----------------------------------------------------------------------------
|
||||||
|
The contents of this file are subject to the Mozilla Public License
|
||||||
|
Version 1.1 (the "License"); you may not use this file except in compliance
|
||||||
|
with the License. You may obtain a copy of the License at
|
||||||
|
http://www.mozilla.org/MPL/MPL-1.1.html
|
||||||
|
|
||||||
|
Software distributed under the License is distributed on an "AS IS" basis,
|
||||||
|
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
|
||||||
|
the specific language governing rights and limitations under the License.
|
||||||
|
|
||||||
|
The Original Code is: JvProfilerForm.PAS, released on 2002-05-26.
|
||||||
|
|
||||||
|
The Initial Developer of the Original Code is Certified Software Corp. [certsoft att quest-net dott com]
|
||||||
|
Portions created by Peter Th�rnqvist are Copyright (C) 1996 Certified Software Corp.
|
||||||
|
All Rights Reserved.
|
||||||
|
|
||||||
|
Contributor(s): Peter Th�rnqvist [peter3 at sourceforge dot net]
|
||||||
|
|
||||||
|
You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
|
||||||
|
located at http://jvcl.delphi-jedi.org
|
||||||
|
|
||||||
|
Known Issues:
|
||||||
|
Use QueryPerformanceCounter / Frequency instead of GetTickCount (the high resolution timer)
|
||||||
|
-----------------------------------------------------------------------------}
|
||||||
|
// $Id$
|
||||||
|
|
||||||
|
unit JvProfilerForm;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, Dialogs, ComCtrls, StdCtrls, Controls, ExtCtrls, Forms;
|
||||||
|
|
||||||
|
const
|
||||||
|
MaxProfEntries = 1024; { maximum number of "blocks" to profile }
|
||||||
|
MaxStackSize = 1024; { maximum nesting of blocks at any one time }
|
||||||
|
|
||||||
|
var
|
||||||
|
OddClick: Boolean = True;
|
||||||
|
|
||||||
|
type
|
||||||
|
TJvProfileInfo = array [0..MaxProfEntries - 1] of record
|
||||||
|
InOutTime: Longint;
|
||||||
|
TimeSpent: Longint;
|
||||||
|
Calls: Longint;
|
||||||
|
StringID: string;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TProcStack = array [1..MaxStackSize] of record
|
||||||
|
CallerID: Integer;
|
||||||
|
EntryTime: Longint;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TProfReport = class(TForm)
|
||||||
|
Panel1: TPanel;
|
||||||
|
SaveBtn: TButton;
|
||||||
|
lvReport: TListView;
|
||||||
|
OKBtn: TButton;
|
||||||
|
TrimBtn: TButton;
|
||||||
|
procedure FormShow(Sender: TObject);
|
||||||
|
procedure lvReportColumnClick(Sender: TObject; Column: TListColumn);
|
||||||
|
procedure SaveBtnClick(Sender: TObject);
|
||||||
|
procedure OKBtnClick(Sender: TObject);
|
||||||
|
procedure TrimBtnClick(Sender: TObject);
|
||||||
|
public
|
||||||
|
StartTime: Integer;
|
||||||
|
EndTime: Integer;
|
||||||
|
LastProc: Integer;
|
||||||
|
ProfileInfo: TJvProfileInfo;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TJvProfiler = class(TComponent)
|
||||||
|
private
|
||||||
|
FProfileInfo: TJvProfileInfo;
|
||||||
|
FNames: TStringList;
|
||||||
|
FStack: TProcStack;
|
||||||
|
FStartTime: Longint;
|
||||||
|
FEndTime: Longint;
|
||||||
|
FLastProc: Integer;
|
||||||
|
FStackSize: Integer;
|
||||||
|
FEnabled: Boolean;
|
||||||
|
FStarted: Boolean;
|
||||||
|
FSorted: Boolean;
|
||||||
|
FOnStart: TNotifyEvent;
|
||||||
|
FOnStop: TNotifyEvent;
|
||||||
|
function GetNames: TStrings;
|
||||||
|
procedure SetNames(Value: TStrings);
|
||||||
|
procedure SetEnabled(Value: Boolean);
|
||||||
|
procedure SetSorted(Value: Boolean);
|
||||||
|
protected
|
||||||
|
procedure DoStart; virtual;
|
||||||
|
procedure DoStop; virtual;
|
||||||
|
procedure Initialize; virtual;
|
||||||
|
public
|
||||||
|
constructor Create(AOwner: TComponent); override;
|
||||||
|
destructor Destroy; override;
|
||||||
|
procedure Start;
|
||||||
|
procedure EnterID(ID: Integer);
|
||||||
|
procedure EnterName(const AName: string);
|
||||||
|
procedure ExitName(const AName: string);
|
||||||
|
procedure ExitID(ID: Integer);
|
||||||
|
procedure Stop;
|
||||||
|
procedure ShowReport;
|
||||||
|
published
|
||||||
|
property Enabled: Boolean read FEnabled write SetEnabled default False;
|
||||||
|
property Names: TStrings read GetNames write SetNames;
|
||||||
|
property Sorted: Boolean read FSorted write SetSorted default False;
|
||||||
|
property OnStart: TNotifyEvent read FOnStart write FOnStart;
|
||||||
|
property OnStop: TNotifyEvent read FOnStop write FOnStop;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
{$IFDEF LINUX}
|
||||||
|
baseunix, unix, linux, users,
|
||||||
|
{$ELSE}
|
||||||
|
Windows,
|
||||||
|
{$ENDIF}
|
||||||
|
SysUtils, LazUTF8,
|
||||||
|
JvConsts, JvTypes, JvResources;
|
||||||
|
|
||||||
|
{$R *.lfm}
|
||||||
|
|
||||||
|
const
|
||||||
|
EmptyLine = '0.00';
|
||||||
|
DefHeader2 =
|
||||||
|
'Profiler 32 - (C) 1996 Certified Software Corp, portions Copyright (C) 1997 by Peter Th�rnqvist; all rights reserved.';
|
||||||
|
|
||||||
|
type
|
||||||
|
PProfType = ^TProfType;
|
||||||
|
TProfType = record
|
||||||
|
InOutTime: Integer;
|
||||||
|
TimeSpent: Integer;
|
||||||
|
Calls: Integer;
|
||||||
|
StringID: string;
|
||||||
|
end;
|
||||||
|
|
||||||
|
PStackType = ^TStackType;
|
||||||
|
TStackType = record
|
||||||
|
CallerID: Integer;
|
||||||
|
EntryTime: Integer;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function GetUserName: String;
|
||||||
|
// http://forum.lazarus.freepascal.org/index.php/topic,23171.msg138057.html#msg138057
|
||||||
|
{$IFDEF WINDOWS}
|
||||||
|
const
|
||||||
|
MaxLen = 256;
|
||||||
|
var
|
||||||
|
Len: DWORD;
|
||||||
|
WS: WideString;
|
||||||
|
Res: windows.BOOL;
|
||||||
|
{$ENDIF}
|
||||||
|
begin
|
||||||
|
Result := '';
|
||||||
|
{$IFDEF UNIX}
|
||||||
|
{$IF (DEFINED(LINUX)) OR (DEFINED(FREEBSD))}
|
||||||
|
Result := SysToUtf8(users.GetUserName(fpgetuid)); //GetUsername in unit Users, fpgetuid in unit BaseUnix
|
||||||
|
{$ELSE Linux/BSD}
|
||||||
|
Result := GetEnvironmentVariableUtf8('USER');
|
||||||
|
{$ENDIF UNIX}
|
||||||
|
{$ELSE}
|
||||||
|
{$IFDEF WINDOWS}
|
||||||
|
Len := MaxLen;
|
||||||
|
{$IFnDEF WINCE}
|
||||||
|
if Win32MajorVersion <= 4 then begin
|
||||||
|
SetLength(Result,MaxLen);
|
||||||
|
Res := Windows.GetUserName(@Result[1], Len);
|
||||||
|
//writeln('GetUserNameA = ',Res);
|
||||||
|
if Res then begin
|
||||||
|
SetLength(Result,Len-1);
|
||||||
|
Result := WinCPToUtf8(Result);
|
||||||
|
end else
|
||||||
|
SetLength(Result,0);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
{$ENDIF NOT WINCE}
|
||||||
|
begin
|
||||||
|
SetLength(WS, MaxLen-1);
|
||||||
|
Res := Windows.GetUserNameW(@WS[1], Len);
|
||||||
|
//writeln('GetUserNameW = ',Res);
|
||||||
|
if Res then begin
|
||||||
|
SetLength(WS, Len - 1);
|
||||||
|
Result := Utf16ToUtf8(WS);
|
||||||
|
end else
|
||||||
|
SetLength(Result,0);
|
||||||
|
end;
|
||||||
|
{$ENDIF WINDOWS}
|
||||||
|
{$ENDIF UNIX}
|
||||||
|
end;
|
||||||
|
|
||||||
|
function GetComputerName : string;
|
||||||
|
{$IFDEF WINDOWS}
|
||||||
|
var
|
||||||
|
len : cardinal;
|
||||||
|
begin
|
||||||
|
len := MAX_COMPUTERNAME_LENGTH + 1;
|
||||||
|
SetLength(result, len);
|
||||||
|
if Windows.GetComputerName(PChar(result), len) then begin
|
||||||
|
SetLength(Result, len);
|
||||||
|
Result := WinCPToUTF8(Result);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
RaiseLastWin32Error;
|
||||||
|
end;
|
||||||
|
{$ELSE}
|
||||||
|
begin
|
||||||
|
Result := GetHostName;
|
||||||
|
end;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
|
||||||
|
//=== { TJvProfiler } ========================================================
|
||||||
|
|
||||||
|
constructor TJvProfiler.Create(AOwner: TComponent);
|
||||||
|
begin
|
||||||
|
inherited Create(AOwner);
|
||||||
|
FNames := TStringList.Create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TJvProfiler.Destroy;
|
||||||
|
begin
|
||||||
|
Stop;
|
||||||
|
FNames.Free;
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvProfiler.Initialize;
|
||||||
|
var
|
||||||
|
I: Integer;
|
||||||
|
begin
|
||||||
|
FEnabled := False;
|
||||||
|
FStarted := False;
|
||||||
|
FStartTime := 0;
|
||||||
|
FEndTime := 0;
|
||||||
|
FStackSize := 0;
|
||||||
|
FLastProc := -1;
|
||||||
|
{ build ID list }
|
||||||
|
for I := 0 to FNames.Count - 1 do
|
||||||
|
begin
|
||||||
|
if Length(Trim(FNames[I])) < 1 then
|
||||||
|
Continue; { skip empty ID's }
|
||||||
|
if FLastProc > MaxProfEntries then
|
||||||
|
raise EJVCLException.CreateResFmt(@RsEMaxNumberOfIDsExceededd, [MaxProfEntries - 1]);
|
||||||
|
Inc(FLastProc);
|
||||||
|
with FProfileInfo[FLastProc] do
|
||||||
|
begin
|
||||||
|
TimeSpent := 0;
|
||||||
|
Calls := 0;
|
||||||
|
StringID := FNames[I];
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvProfiler.EnterID(ID: Integer);
|
||||||
|
var
|
||||||
|
Snap: Integer;
|
||||||
|
begin
|
||||||
|
if FEnabled then
|
||||||
|
begin
|
||||||
|
Snap := GetTickCount;
|
||||||
|
if FStackSize > MaxStackSize then
|
||||||
|
raise EJVCLException.CreateResFmt(@RsEMaxStackSizeExceededd, [MaxStackSize]);
|
||||||
|
Inc(FStackSize);
|
||||||
|
|
||||||
|
with FStack[FStackSize] do
|
||||||
|
begin
|
||||||
|
EntryTime := Snap;
|
||||||
|
CallerID := ID
|
||||||
|
end;
|
||||||
|
|
||||||
|
with FProfileInfo[ID] do
|
||||||
|
begin
|
||||||
|
Inc(Calls);
|
||||||
|
InOutTime := Snap;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvProfiler.EnterName(const AName: string);
|
||||||
|
begin
|
||||||
|
EnterID(FNames.IndexOf(AName));
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvProfiler.ExitName(const AName: string);
|
||||||
|
begin
|
||||||
|
ExitID(FNames.IndexOf(AName));
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvProfiler.ExitID(ID: Integer);
|
||||||
|
var
|
||||||
|
Snap, Elapsed: Integer;
|
||||||
|
begin
|
||||||
|
if Enabled then
|
||||||
|
begin
|
||||||
|
Snap := GetTickCount;
|
||||||
|
with FProfileInfo[ID] do
|
||||||
|
begin
|
||||||
|
Elapsed := Snap - InOutTime;
|
||||||
|
TimeSpent := TimeSpent + Elapsed;
|
||||||
|
end;
|
||||||
|
if FStackSize > 0 then
|
||||||
|
Dec(FStackSize);
|
||||||
|
if FStackSize > 0 then
|
||||||
|
with FProfileInfo[FStack[FStackSize].CallerID] do
|
||||||
|
TimeSpent := TimeSpent - Elapsed;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvProfiler.DoStart;
|
||||||
|
begin
|
||||||
|
if Assigned(FOnStart) then
|
||||||
|
FOnStart(Self);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvProfiler.DoStop;
|
||||||
|
begin
|
||||||
|
if Assigned(FOnStop) then
|
||||||
|
FOnStop(Self);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvProfiler.Start;
|
||||||
|
begin
|
||||||
|
if FEnabled and not FStarted then
|
||||||
|
begin
|
||||||
|
// Initialize;
|
||||||
|
DoStart;
|
||||||
|
FStartTime := GetTickCount;
|
||||||
|
FStarted := True;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvProfiler.Stop;
|
||||||
|
begin
|
||||||
|
if FEnabled and FStarted then
|
||||||
|
begin
|
||||||
|
FEndTime := GetTickCount;
|
||||||
|
DoStop;
|
||||||
|
FStarted := False;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJvProfiler.GetNames: TStrings;
|
||||||
|
begin
|
||||||
|
Result := FNames;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvProfiler.SetNames(Value: TStrings);
|
||||||
|
begin
|
||||||
|
FNames.Assign(Value);
|
||||||
|
Initialize;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvProfiler.SetEnabled(Value: Boolean);
|
||||||
|
begin
|
||||||
|
if FEnabled <> Value then
|
||||||
|
FEnabled := Value;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvProfiler.SetSorted(Value: Boolean);
|
||||||
|
begin
|
||||||
|
if FSorted <> Value then
|
||||||
|
begin
|
||||||
|
FSorted := Value;
|
||||||
|
FNames.Sorted := FSorted;
|
||||||
|
Initialize;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvProfiler.ShowReport;
|
||||||
|
begin
|
||||||
|
if FEnabled then
|
||||||
|
begin
|
||||||
|
if FStarted then
|
||||||
|
Stop;
|
||||||
|
with TProfReport.Create(nil) do
|
||||||
|
begin
|
||||||
|
EndTime := FEndTime;
|
||||||
|
StartTime := FStartTime;
|
||||||
|
LastProc := FLastProc;
|
||||||
|
ProfileInfo := FProfileInfo;
|
||||||
|
ShowModal;
|
||||||
|
Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
//=== { TProfReport } ========================================================
|
||||||
|
|
||||||
|
procedure TProfReport.FormShow(Sender: TObject);
|
||||||
|
const
|
||||||
|
NumberFormat = '%4.2f';
|
||||||
|
var
|
||||||
|
ThisProc: Integer;
|
||||||
|
TotalSum: Integer;
|
||||||
|
LItem: TListItem;
|
||||||
|
begin
|
||||||
|
OddClick := True;
|
||||||
|
TotalSum := (EndTime - StartTime);
|
||||||
|
if TotalSum = 0 then
|
||||||
|
Exit;
|
||||||
|
lvReport.Items.BeginUpdate;
|
||||||
|
lvReport.Items.Clear;
|
||||||
|
for ThisProc := 0 to LastProc do
|
||||||
|
with ProfileInfo[ThisProc] do
|
||||||
|
begin
|
||||||
|
LItem := lvReport.Items.Add;
|
||||||
|
LItem.Caption := StringID; { function ID }
|
||||||
|
if Calls <> 0 then
|
||||||
|
begin
|
||||||
|
LItem.SubItems.Add(Format(NumberFormat, [TimeSpent * 1.0])); { Total time spent here }
|
||||||
|
LItem.SubItems.Add(IntToStr(Calls)); { Total number of calls }
|
||||||
|
LItem.SubItems.Add(Format(NumberFormat, [TimeSpent / Calls])); { average time }
|
||||||
|
LItem.SubItems.Add(Format(NumberFormat, [TimeSpent / TotalSum * 100.0])); { percentage }
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
LItem.SubItems.Add(EmptyLine);
|
||||||
|
LItem.SubItems.Add('0');
|
||||||
|
LItem.SubItems.Add(EmptyLine);
|
||||||
|
LItem.SubItems.Add(EmptyLine);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
Caption := Format(RsTotalElapsedTimedms, [RsDefCaption, TotalSum]);
|
||||||
|
lvReport.Items.EndUpdate;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function IsFloat(S: string): Boolean;
|
||||||
|
var
|
||||||
|
x: Double;
|
||||||
|
begin
|
||||||
|
Result := TryStrToFloat(S, x);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function DefSort(lParam1, lParam2: TListItem; lParamSort: Integer): Integer; stdcall;
|
||||||
|
var
|
||||||
|
l1, l2: Extended;
|
||||||
|
begin
|
||||||
|
if lParamSort = 0 then
|
||||||
|
Result := AnsiCompareText(lParam1.Caption, lParam2.Caption)
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
if not IsFloat(lParam1.SubItems[lParamSort - 1]) then
|
||||||
|
l1 := -1.0
|
||||||
|
else
|
||||||
|
l1 := StrToFloat(lParam1.SubItems[lParamSort - 1]);
|
||||||
|
if not IsFloat(lParam2.SubItems[lParamSort - 1]) then
|
||||||
|
l2 := -1.0
|
||||||
|
else
|
||||||
|
l2 := StrToFloat(lParam2.SubItems[lParamSort - 1]);
|
||||||
|
Result := Round((l1 * 1000) - (l2 * 1000));
|
||||||
|
end;
|
||||||
|
if OddClick then
|
||||||
|
Result := -Result;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TProfReport.lvReportColumnClick(Sender: TObject; Column: TListColumn);
|
||||||
|
begin
|
||||||
|
// lvReport.Items.BeginUpdate;
|
||||||
|
lvReport.CustomSort(TLVCompare(@DefSort), Column.Index);
|
||||||
|
OddClick := not OddClick;
|
||||||
|
// lvReport.Items.EndUpdate;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TProfReport.SaveBtnClick(Sender: TObject);
|
||||||
|
var
|
||||||
|
OutList: TStringList;
|
||||||
|
S: string;
|
||||||
|
I, J: Integer;
|
||||||
|
begin
|
||||||
|
with TSaveDialog.Create(nil) do
|
||||||
|
begin
|
||||||
|
Filter := RsTextFormatsasctxtinfdocAllFiles;
|
||||||
|
if Execute then
|
||||||
|
begin
|
||||||
|
OutList := TStringList.Create;
|
||||||
|
OutList.Add(Format(RsDefHeader, [DateToStr(Now), GetUserName,
|
||||||
|
GetComputerName]));
|
||||||
|
OutList.Add(DefHeader2);
|
||||||
|
S := '';
|
||||||
|
for I := 0 to lvReport.Columns.Count - 1 do
|
||||||
|
S := S + lvReport.Columns[I].Caption + Tab;
|
||||||
|
OutList.Add(S);
|
||||||
|
S := '';
|
||||||
|
with lvReport do
|
||||||
|
for I := 0 to Items.Count - 1 do
|
||||||
|
begin
|
||||||
|
with Items[I] do
|
||||||
|
begin
|
||||||
|
S := S + Caption + Tab;
|
||||||
|
for J := 0 to SubItems.Count - 1 do
|
||||||
|
S := S + SubItems[J] + Tab;
|
||||||
|
OutList.Add(S);
|
||||||
|
end;
|
||||||
|
S := '';
|
||||||
|
end;
|
||||||
|
OutList.SaveToFile(Filename);
|
||||||
|
OutList.Free;
|
||||||
|
end;
|
||||||
|
Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TProfReport.OKBtnClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
Close;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TProfReport.TrimBtnClick(Sender: TObject);
|
||||||
|
var
|
||||||
|
I: Integer;
|
||||||
|
begin
|
||||||
|
lvReport.Items.BeginUpdate;
|
||||||
|
for I := lvReport.Items.Count - 1 downto 0 do
|
||||||
|
{ no calls = not used }
|
||||||
|
if lvReport.Items[I].SubItems[1] = '0' then
|
||||||
|
lvReport.Items.Delete(I);
|
||||||
|
lvReport.Items.EndUpdate;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
Reference in New Issue
Block a user