1 files changed, 218 insertions, 0 deletions
diff --git a/extras/tiopf/demos/Demo_TtiBaseObject/frm_main.pas b/extras/tiopf/demos/Demo_TtiBaseObject/frm_main.pas
new file mode 100644
index 00000000..e4aec833
--- /dev/null
+++ b/extras/tiopf/demos/Demo_TtiBaseObject/frm_main.pas
@@ -0,0 +1,218 @@
+unit frm_main;
+
+{$mode objfpc}{$H+}
+
+// You need to enable these in tiOPF's tiDefines.inc as well.
+{.$Define object_tracking}
+{$Define reference_counting}
+
+
+interface
+
+uses
+  SysUtils, Classes, gfxbase, fpgfx, gui_edit, 
+  gfx_widget, gui_form, gui_label, gui_button,
+  gui_listbox, gui_memo, gui_combobox, gui_grid, 
+  gui_dialogs, gui_checkbox, gui_tree, gui_trackbar, 
+  gui_progressbar, gui_radiobutton, gui_tab, gui_menu,
+  gui_bevel, gui_popupcalendar, gui_gauge;
+
+type
+
+  TMainForm = class(TfpgForm)
+  private
+    procedure   PerformanceTestNoReferenceCounting(Sender: TObject);
+    procedure   PerformanceTestReferenceCounting(Sender: TObject);
+    procedure   btnTestValidClick(Sender: TObject);
+    procedure   Log(const AMessage: string);
+  public
+    {@VFD_HEAD_BEGIN: MainForm}
+    btnNoRefCount: TfpgButton;
+    btnRefCount: TfpgButton;
+    btnTestValid: TfpgButton;
+    memName1: TfpgMemo;
+    lblName1: TfpgLabel;
+    lblName2: TfpgLabel;
+    memLog: TfpgMemo;
+    {@VFD_HEAD_END: MainForm}
+    constructor Create(AOwner: TComponent); override;
+    procedure   AfterCreate; override;
+  end;
+
+{@VFD_NEWFORM_DECL}
+
+implementation
+
+uses
+  tiUtils,
+  tiBaseObject;
+  
+const
+  CTestRunTime = 5; // Seconds
+  CTestCount = 1000000; // 1 million
+
+{@VFD_NEWFORM_IMPL}
+
+procedure TMainForm.PerformanceTestNoReferenceCounting(Sender: TObject);
+var
+  LO: TtiBaseObject;
+  LStart: Cardinal;
+  LCount: Cardinal;
+begin
+  LCount := 0;
+  LStart := tiGetTickCount;
+  while LCount < CTestCount do
+  begin
+    LO := TtiBaseObject.Create;
+    LO.Free;
+    Inc(LCount);
+  end;
+  Log(Format('%s iterations in %d ms (no reference counting)',
+      [tiIntToCommaStr(LCount), tiGetTickCount - LStart]));
+end;
+
+procedure TMainForm.PerformanceTestReferenceCounting(Sender: TObject);
+{$ifdef reference_counting}
+var
+//  LO: IInterface;
+  LO: TtiBaseObject;  // We are testing object creation only. Hence a class and not interface reference.
+  LStart: Cardinal;
+  LCount: Cardinal;
+begin
+  LCount := 0;
+  LStart := tiGetTickCount;
+  while LCount < CTestCount do
+  begin
+    LO := TtiBaseObject.CreateWithRefCounting;
+    LO.Free;    // we are testing object creation. This remove the garbage collector.
+    Inc(LCount);
+  end;
+  Log(Format('%s iterations in %d ms (reference counting)',
+      [tiIntToCommaStr(LCount), tiGetTickCount - LStart]));
+{$else}
+begin
+  Assert(False, 'reference_counting not enabled');
+{$endif}
+end;
+
+procedure TMainForm.btnTestValidClick(Sender: TObject);
+var
+  LO: TtiBaseObject;
+begin
+  LO := TtiBaseObject.Create;
+  Assert(LO.TestValid);
+  LO.Free;
+  Assert(not LO.TestValid);
+end;
+
+procedure TMainForm.Log(const AMessage: string);
+begin
+  memLog.Lines.Add(AMessage);
+  memLog.Invalidate;
+end;
+
+constructor TMainForm.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  memLog.Lines.Clear;
+  {$ifdef object_tracking}
+    Log('object_tracking is ON');
+  {$else}
+    btnTestValid.Enabled := False;
+    Log('object_tracking is OFF');
+  {$endif}
+  {$ifdef reference_counting}
+    Log('reference_counting is ON');
+  {$else}
+    Log('reference_counting is OFF');
+    btnRefCount.Enabled := False;
+  {$endif}
+  Log('---');
+end;
+
+procedure TMainForm.AfterCreate;
+begin
+  {@VFD_BODY_BEGIN: MainForm}
+  Name := 'MainForm';
+  SetPosition(307, 319, 357, 290);
+  WindowTitle := 'TtiBaseObject Performance Demo';
+  WindowPosition := wpScreenCenter;
+
+  btnNoRefCount := TfpgButton.Create(self);
+  with btnNoRefCount do
+  begin
+    Name := 'btnNoRefCount';
+    SetPosition(16, 28, 155, 23);
+    Text := 'No reference counting';
+    FontDesc := '#Label1';
+    ImageName := '';
+    OnClick := @PerformanceTestNoReferenceCounting;
+  end;
+
+  btnRefCount := TfpgButton.Create(self);
+  with btnRefCount do
+  begin
+    Name := 'btnRefCount';
+    SetPosition(16, 56, 155, 23);
+    Text := 'Reference counting';
+    FontDesc := '#Label1';
+    ImageName := '';
+    OnClick := @PerformanceTestReferenceCounting;
+  end;
+
+  btnTestValid := TfpgButton.Create(self);
+  with btnTestValid do
+  begin
+    Name := 'btnTestValid';
+    SetPosition(16, 112, 155, 23);
+    Text := 'TtiBaseObject.TestValid';
+    FontDesc := '#Label1';
+    ImageName := '';
+    OnClick := @btnTestValidClick;
+  end;
+
+  memName1 := TfpgMemo.Create(self);
+  with memName1 do
+  begin
+    Name := 'memName1';
+    SetPosition(176, 28, 176, 125);
+    Lines.Add('Toggle the conditional defines');
+    Lines.Add('REFERENCE_COUNTING ');
+    Lines.Add('and OBJECT_TRACKING on ');
+    Lines.Add('and off to examine behaviour.');
+    FontDesc := '#Edit1';
+    Enabled := False;
+  end;
+
+  lblName1 := TfpgLabel.Create(self);
+  with lblName1 do
+  begin
+    Name := 'lblName1';
+    SetPosition(8, 8, 160, 15);
+    Text := 'Performance';
+    FontDesc := '#Label2';
+  end;
+
+  lblName2 := TfpgLabel.Create(self);
+  with lblName2 do
+  begin
+    Name := 'lblName2';
+    SetPosition(8, 92, 160, 15);
+    Text := 'TtiBaseObject.TestValid';
+    FontDesc := '#Label2';
+  end;
+
+  memLog := TfpgMemo.Create(self);
+  with memLog do
+  begin
+    Name := 'memLog';
+    SetPosition(8, 164, 344, 121);
+    Lines.Add('');
+    FontDesc := '#Edit1';
+  end;
+
+  {@VFD_BODY_END: MainForm}
+end;
+
+
+end.