Marco Web Center

[an error occurred while processing this directive]

Home: Code Repository: Delphi 2009 Handbook

Project: InliningTest.dproj

Project Structure

InliningTest.dpr
program InliningTest;

uses
  Forms,
  InliningForm in 'InliningForm.pas' {Form3},
  timetest_clock in 'timetest_clock.pas';

{$R *.res}

begin
  Application.Initialize;
  Application.CreateForm(TForm3, Form3);
  Application.Run;
end.
InliningForm.pas
unit InliningForm;

interface

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

type
  /// form principale
  TForm3 = class(TForm)
    bntLenght: TButton;
    btnLengthInline: TButton;
    btnMaxInline: TButton;
    Memo1: TMemo;
    btnMax: TButton;
    /// calcola il massimo
    procedure btnMaxClick(Sender: TObject);
    procedure btnMaxInlineClick(Sender: TObject);
    procedure btnLengthInlineClick(Sender: TObject);
    procedure bntLenghtClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  /// ecco la form
  Form3: TForm3;

implementation

{$R *.dfm}

uses
  timetest_clock, Math;

const
  LoopCount = 100000000;
var
  ssample : string;

{$INLINE ON}

// was:
function LengthStdcall (const s: AnsiString): Longint;
// shoudl be:
// function LengthStdcall (const s: string): Longint;
begin
  Result := Integer(S);
  if Result <> 0 then
    Result := PInteger(Result-4)^;
end;

procedure TForm3.bntLenghtClick(Sender: TObject);
var
  ttt: TTimeTest;
  I, J: Integer;
begin
  ssample:= 'sample string';
  J := 0;
  ttt := TTimeTest.Create;
  try
    for I := 0 to LoopCount do
      Inc (J, LengthStdcall (ssample));
    memo1.Lines.Add ('Length ' + ttt.Elapsed + '[' + IntToStr (J) + ']');
  finally
    FreeAndNil (ttt);
  end;
end;

procedure TForm3.btnLengthInlineClick(Sender: TObject);
var
  ttt: TTimeTest;
  I, J: Integer;
begin
  ssample:= 'sample string';
  J := 0;
  ttt := TTimeTest.Create;
  try
    for I := 0 to LoopCount do
      Inc (J, Length (ssample));
    memo1.Lines.Add ('Inline ' + ttt.Elapsed + '[' + IntToStr (J) + ']');
  finally
    FreeAndNil (ttt);
  end;
end;

procedure TForm3.btnMaxInlineClick(Sender: TObject);
var
  ttt: TTimeTest;
  I, J: Integer;
begin
  J := 0;
  ttt := TTimeTest.Create;
  try
    for I := 0 to LoopCount do
      J := Max (I, J);
    memo1.Lines.Add ('Max ' + ttt.Elapsed + '[' + IntToStr (J) + ']');
  finally
    FreeAndNil (ttt);
  end;
end;

{$INLINE OFF}
procedure TForm3.btnMaxClick(Sender: TObject);
var
  ttt: TTimeTest;
  I, J: Integer;
begin
  J := 0;
  ttt := TTimeTest.Create;
  try
    for I := 0 to LoopCount do
      J := Max (I, J);
    memo1.Lines.Add ('Off ' + ttt.Elapsed + '[' + IntToStr (J) + ']');
  finally
    FreeAndNil (ttt);
  end;
end;

end.
InliningForm.pas.dfm
object Form3: TForm3
  Left = 0
  Top = 0
  Caption = 'InliningTest'
  ClientHeight = 294
  ClientWidth = 467
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object bntLenght: TButton
    Left = 48
    Top = 40
    Width = 75
    Height = 25
    Caption = 'Lenght'
    TabOrder = 0
    OnClick = bntLenghtClick
  end
  object btnLengthInline: TButton
    Left = 48
    Top = 80
    Width = 75
    Height = 25
    Caption = 'LengthInline'
    TabOrder = 1
    OnClick = btnLengthInlineClick
  end
  object btnMaxInline: TButton
    Left = 48
    Top = 120
    Width = 75
    Height = 25
    Caption = 'MaxInline'
    TabOrder = 2
    OnClick = btnMaxInlineClick
  end
  object Memo1: TMemo
    Left = 152
    Top = 40
    Width = 265
    Height = 201
    TabOrder = 3
  end
  object btnMax: TButton
    Left = 48
    Top = 160
    Width = 75
    Height = 25
    Caption = 'Max'
    TabOrder = 4
    OnClick = btnMaxClick
  end
end
timetest_clock.pas
unit timetest_clock;

interface

uses
  Classes, SysUtils, Windows;

type
  TTimeTest = class
  private
    init: TDateTime;
  public
    constructor Create;
    function Elapsed: string;
    destructor Destroy; override;
  end;

implementation

uses
  DateUtils;

{ TTimeTest }

constructor TTimeTest.Create;
begin
  inherited;
  init := Now;
  // Screen.Cursor := crHourGlass;
end;

destructor TTimeTest.Destroy;
begin
  // Screen.Cursor := crDefault;
  inherited;
end;

function TTimeTest.Elapsed: string;
begin
  Result := FormatFloat ('###,###,###', MilliSecondsBetween (Now, init));
end;

end.
HTML file generated by PasToWeb, a tool by Marco Cantù
Copyright 2008 Marco Cantù