new TraceForm for monitoring renders
This commit is contained in:
zueuk
parent
f3662ecc7e
commit
3f5e7e6a72
133
2.10/Source/Tracer.dfm
Normal file
133
2.10/Source/Tracer.dfm
Normal file
@ -0,0 +1,133 @@
|
||||
object TraceForm: TTraceForm
|
||||
Left = 36
|
||||
Top = 159
|
||||
Width = 411
|
||||
Height = 527
|
||||
Caption = 'Trace'
|
||||
Color = clBtnFace
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clWindowText
|
||||
Font.Height = -11
|
||||
Font.Name = 'MS Sans Serif'
|
||||
Font.Style = []
|
||||
Icon.Data = {
|
||||
0000010001001010000000000800680500001600000028000000100000002000
|
||||
0000010008000000000000010000000000000000000000010000000100000000
|
||||
0000000080000080000000808000800000008000800080800000C0C0C000C0DC
|
||||
C000F0CAA60004040400080808000C0C0C0011111100161616001C1C1C002222
|
||||
220029292900555555004D4D4D004242420039393900807CFF005050FF009300
|
||||
D600FFECCC00C6D6EF00D6E7E70090A9AD000000330000006600000099000000
|
||||
CC00003300000033330000336600003399000033CC000033FF00006600000066
|
||||
330000666600006699000066CC000066FF000099000000993300009966000099
|
||||
99000099CC000099FF0000CC000000CC330000CC660000CC990000CCCC0000CC
|
||||
FF0000FF660000FF990000FFCC00330000003300330033006600330099003300
|
||||
CC003300FF00333300003333330033336600333399003333CC003333FF003366
|
||||
00003366330033666600336699003366CC003366FF0033990000339933003399
|
||||
6600339999003399CC003399FF0033CC000033CC330033CC660033CC990033CC
|
||||
CC0033CCFF0033FF330033FF660033FF990033FFCC0033FFFF00660000006600
|
||||
330066006600660099006600CC006600FF006633000066333300663366006633
|
||||
99006633CC006633FF00666600006666330066666600666699006666CC006699
|
||||
00006699330066996600669999006699CC006699FF0066CC000066CC330066CC
|
||||
990066CCCC0066CCFF0066FF000066FF330066FF990066FFCC00CC00FF00FF00
|
||||
CC009999000099339900990099009900CC009900000099333300990066009933
|
||||
CC009900FF00996600009966330099336600996699009966CC009933FF009999
|
||||
330099996600999999009999CC009999FF0099CC000099CC330066CC660099CC
|
||||
990099CCCC0099CCFF0099FF000099FF330099CC660099FF990099FFCC0099FF
|
||||
FF00CC00000099003300CC006600CC009900CC00CC0099330000CC333300CC33
|
||||
6600CC339900CC33CC00CC33FF00CC660000CC66330099666600CC669900CC66
|
||||
CC009966FF00CC990000CC993300CC996600CC999900CC99CC00CC99FF00CCCC
|
||||
0000CCCC3300CCCC6600CCCC9900CCCCCC00CCCCFF00CCFF0000CCFF330099FF
|
||||
6600CCFF9900CCFFCC00CCFFFF00CC003300FF006600FF009900CC330000FF33
|
||||
3300FF336600FF339900FF33CC00FF33FF00FF660000FF663300CC666600FF66
|
||||
9900FF66CC00CC66FF00FF990000FF993300FF996600FF999900FF99CC00FF99
|
||||
FF00FFCC0000FFCC3300FFCC6600FFCC9900FFCCCC00FFCCFF00FFFF3300CCFF
|
||||
6600FFFF9900FFFFCC006666FF0066FF660066FFFF00FF666600FF66FF00FFFF
|
||||
66002100A5005F5F5F00777777008686860096969600CBCBCB00B2B2B200D7D7
|
||||
D700DDDDDD00E3E3E300EAEAEA00F1F1F100F8F8F800F0FBFF00A4A0A0008080
|
||||
80000000FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF000000
|
||||
000000000000000000000000000000000000000000000000000000000000AC12
|
||||
1212121212121212121212F70000AC000000000000000000000000120000AC00
|
||||
0000000000000000000000120000AC00FA00FAFA00FA0000000000120000AC00
|
||||
0000000000000000000000120000AC00FAFA00FAFAFA00FA000000120000AC00
|
||||
0000000000000000000000120000AC00FA00FAFA00FAFA00000000120000AC00
|
||||
0000000000000000000000120000AC000000000000000000000000120000ACAC
|
||||
ACACACACACACACACACACACAC0000ACFF090909090909090909FFADFF0000ACAC
|
||||
ACACACACACACACACACACACACAC0000000000000000000000000000000000FFFF
|
||||
0000000100000001000000010000000100000001000000010000000100000001
|
||||
0000000100000001000000010000000100000001000000010000FFFF0000}
|
||||
OldCreateOrder = False
|
||||
OnClose = FormClose
|
||||
OnCreate = FormCreate
|
||||
DesignSize = (
|
||||
403
|
||||
499)
|
||||
PixelsPerInch = 96
|
||||
TextHeight = 13
|
||||
object PageControl1: TPageControl
|
||||
Left = 0
|
||||
Top = 0
|
||||
Width = 403
|
||||
Height = 499
|
||||
ActivePage = TabMain
|
||||
Align = alClient
|
||||
Images = MainForm.Buttons
|
||||
TabOrder = 0
|
||||
object TabMain: TTabSheet
|
||||
Caption = 'Main'
|
||||
ImageIndex = 47
|
||||
object MainTrace: TMemo
|
||||
Left = 0
|
||||
Top = 0
|
||||
Width = 395
|
||||
Height = 470
|
||||
Align = alClient
|
||||
Color = clBlack
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clLime
|
||||
Font.Height = -11
|
||||
Font.Name = 'Courier New'
|
||||
Font.Style = []
|
||||
ParentFont = False
|
||||
ReadOnly = True
|
||||
ScrollBars = ssVertical
|
||||
TabOrder = 0
|
||||
end
|
||||
end
|
||||
object TabFullscreen: TTabSheet
|
||||
Caption = 'Fullscreen'
|
||||
ImageIndex = 52
|
||||
object FullscreenTrace: TMemo
|
||||
Left = 0
|
||||
Top = 0
|
||||
Width = 395
|
||||
Height = 468
|
||||
Align = alClient
|
||||
Color = clBlack
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clLime
|
||||
Font.Height = -11
|
||||
Font.Name = 'Courier New'
|
||||
Font.Style = []
|
||||
ParentFont = False
|
||||
ReadOnly = True
|
||||
ScrollBars = ssVertical
|
||||
TabOrder = 0
|
||||
end
|
||||
end
|
||||
end
|
||||
object cbTraceLevel: TComboBox
|
||||
Left = 280
|
||||
Top = 0
|
||||
Width = 121
|
||||
Height = 21
|
||||
Style = csDropDownList
|
||||
Anchors = [akTop, akRight]
|
||||
ItemHeight = 13
|
||||
TabOrder = 1
|
||||
OnSelect = cbTraceLevelSelect
|
||||
Items.Strings = (
|
||||
'No trace'
|
||||
'Minimal trace'
|
||||
'Full trace')
|
||||
end
|
||||
end
|
||||
123
2.10/Source/Tracer.pas
Normal file
123
2.10/Source/Tracer.pas
Normal file
@ -0,0 +1,123 @@
|
||||
{
|
||||
Apophysis Copyright (C) 2001-2004 Mark Townsend
|
||||
Apophysis Copyright (C) 2005-2006 Ronald Hordijk, Piotr Borys, Peter Sdobnov
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation; either version 2 of the License, or
|
||||
(at your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
GNU General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program; if not, write to the Free Software
|
||||
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
||||
}
|
||||
unit Tracer;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
|
||||
Dialogs, StdCtrls, ComCtrls;
|
||||
|
||||
type
|
||||
TTraceForm = class(TForm)
|
||||
PageControl1: TPageControl;
|
||||
TabMain: TTabSheet;
|
||||
TabFullscreen: TTabSheet;
|
||||
FullscreenTrace: TMemo;
|
||||
cbTraceLevel: TComboBox;
|
||||
MainTrace: TMemo;
|
||||
procedure cbTraceLevelSelect(Sender: TObject);
|
||||
procedure FormClose(Sender: TObject; var Action: TCloseAction);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
private
|
||||
{ Private declarations }
|
||||
public
|
||||
{ Public declarations }
|
||||
end;
|
||||
|
||||
var
|
||||
TraceForm: TTraceForm;
|
||||
|
||||
var
|
||||
TraceLevel: integer;
|
||||
|
||||
const
|
||||
MsgComplete = '< Received WM_THREAD_COMPLETE from RenderThread #';
|
||||
MsgTerminated = '< Received WM_THREAD_TERMINATE from RenderThread #';
|
||||
MsgNotAssigned = 'Ignoring message: RenderThread does not exist';
|
||||
MsgAnotherRunning = 'Ignoring message: another RenderThread is running';
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.dfm}
|
||||
|
||||
uses
|
||||
Registry,
|
||||
Global, Main;
|
||||
|
||||
procedure TTraceForm.cbTraceLevelSelect(Sender: TObject);
|
||||
begin
|
||||
TraceLevel := cbTraceLevel.ItemIndex;
|
||||
end;
|
||||
|
||||
procedure TTraceForm.FormCreate(Sender: TObject);
|
||||
var
|
||||
Registry: TRegistry;
|
||||
begin
|
||||
{ Read position from registry }
|
||||
Registry := TRegistry.Create;
|
||||
try
|
||||
Registry.RootKey := HKEY_CURRENT_USER;
|
||||
if Registry.OpenKey('Software\' + APP_NAME + '\Forms\Trace', False) then
|
||||
begin
|
||||
if Registry.ValueExists('Top') then
|
||||
self.Top := Registry.ReadInteger('Top');
|
||||
if Registry.ValueExists('Left') then
|
||||
self.Left := Registry.ReadInteger('Left');
|
||||
if Registry.ValueExists('Width') then
|
||||
self.Width := Registry.ReadInteger('Width');
|
||||
if Registry.ValueExists('Height') then
|
||||
self.Height := Registry.ReadInteger('Height');
|
||||
|
||||
if Registry.ValueExists('TraceLevel') then
|
||||
TraceLevel := Registry.ReadInteger('TraceLevel');
|
||||
end;
|
||||
Registry.CloseKey;
|
||||
finally
|
||||
Registry.Free;
|
||||
end;
|
||||
|
||||
cbTraceLevel.ItemIndex := TraceLevel;
|
||||
end;
|
||||
|
||||
procedure TTraceForm.FormClose(Sender: TObject; var Action: TCloseAction);
|
||||
var
|
||||
Registry: TRegistry;
|
||||
begin
|
||||
{ Write position to registry }
|
||||
Registry := TRegistry.Create;
|
||||
try
|
||||
Registry.RootKey := HKEY_CURRENT_USER;
|
||||
if Registry.OpenKey('\Software\' + APP_NAME + '\Forms\Trace', True) then
|
||||
begin
|
||||
if self.WindowState <> wsMaximized then begin
|
||||
Registry.WriteInteger('Top', self.Top);
|
||||
Registry.WriteInteger('Left', self.Left);
|
||||
Registry.WriteInteger('Width', self.Width);
|
||||
Registry.WriteInteger('Height', self.Height);
|
||||
|
||||
Registry.WriteInteger('TraceLevel', TraceLevel);
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
Registry.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
Loading…
Reference in New Issue
Block a user