Marco Web Center

[an error occurred while processing this directive]

Home: Code Repository: Delphi 2009 Handbook

Project: SmartPointers.dproj

Project Structure

SmartPointers.dpr
program SmartPointers;

uses
  Forms,
  SmartPointers_MainForm in 'SmartPointers_MainForm.pas' {FormSmartPointers},
  SmartPointerClass in 'SmartPointerClass.pas';

{$R *.res}

begin
  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TFormSmartPointers, FormSmartPointers);
  Application.Run;
end.
SmartPointers_MainForm.pas
unit SmartPointers_MainForm;

interface

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

type
  TFormSmartPointers = class(TForm)
    btnLeak: TButton;
    btnSmart: TButton;
    btnSmartShort: TButton;
    btnImplicitCreate: TButton;
    Memo1: TMemo;
    Button1: TButton;
    procedure btnLeakClick(Sender: TObject);
    procedure btnSmartClick(Sender: TObject);
    procedure btnSmartShortClick(Sender: TObject);
    procedure btnImplicitCreateClick(Sender: TObject);
    procedure Log (const strMsg: string);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FormSmartPointers: TFormSmartPointers;

implementation

uses
  SmartPointerClass;

{$R *.dfm}

procedure TFormSmartPointers.btnImplicitCreateClick(Sender: TObject);
var
  smartP: TSmartPointer<TStringList>;
begin
//  smartP.Create;
  smartP.Value.Add('foo');
  Log ('Count: ' + IntToStr (smartP.Value.Count));
end;

procedure TFormSmartPointers.btnLeakClick(Sender: TObject);
var
  sl: TStringList;
begin
  // memory leak
  sl := TStringList.Create;
  sl.Add('foo');
  Log ('Count: ' + IntToStr (sl.Count));
end;

procedure TFormSmartPointers.btnSmartClick(Sender: TObject);
var
  sl: TStringList;
  smartP: TSmartPointer<TStringList>;
begin
  sl := TStringList.Create;
  smartP := sl;
  sl.Add('foo');
  Log ('Count: ' + IntToStr (sl.Count));
end;

procedure TFormSmartPointers.btnSmartShortClick(Sender: TObject);
var
  smartP: TSmartPointer<TStringList>;
begin
  smartP := TStringList.Create;
  smartP.Value.Add('foo');
  TStringList(smartP).Add('foo2');
  Log ('Count: ' + IntToStr (TStringList(smartP).Count));
end;

procedure TFormSmartPointers.Button1Click(Sender: TObject);
var
  sl: TStringList;
begin
  sl := TSmartPointer<TStringList>.
    Create(TStringList.Create).Value;
  sl.Add('foo');
  sl.Add('foo2');
  Log ('Count: ' + IntToStr (sl.Count));
end;

procedure TFormSmartPointers.Log(const strMsg: string);
begin
  Memo1.Lines.Add (strMsg);
end;

initialization
  ReportMemoryLeaksOnShutdown := True;

end.
SmartPointers_MainForm.pas.dfm
object FormSmartPointers: TFormSmartPointers
  Left = 0
  Top = 0
  Caption = 'SmartPointers'
  ClientHeight = 361
  ClientWidth = 525
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object btnLeak: TButton
    Left = 72
    Top = 30
    Width = 113
    Height = 25
    Caption = 'btnLeak'
    TabOrder = 0
    OnClick = btnLeakClick
  end
  object btnSmart: TButton
    Left = 72
    Top = 72
    Width = 113
    Height = 25
    Caption = 'btnSmart'
    TabOrder = 1
    OnClick = btnSmartClick
  end
  object btnSmartShort: TButton
    Left = 72
    Top = 112
    Width = 113
    Height = 25
    Caption = 'btnSmartShort'
    TabOrder = 2
    OnClick = btnSmartShortClick
  end
  object btnImplicitCreate: TButton
    Left = 72
    Top = 192
    Width = 113
    Height = 25
    Caption = 'btnImplicitCreate'
    TabOrder = 3
    OnClick = btnImplicitCreateClick
  end
  object Memo1: TMemo
    Left = 232
    Top = 32
    Width = 249
    Height = 289
    TabOrder = 4
  end
  object Button1: TButton
    Left = 72
    Top = 152
    Width = 113
    Height = 25
    Caption = 'tbnPlainCode'
    TabOrder = 5
    OnClick = Button1Click
  end
end
SmartPointerClass.pas
unit SmartPointerClass;

interface

uses
  Generics.Defaults;

type
  TSmartPointer<T: class, constructor> = record
  strict private
    FValue: T;
    FFreeTheValue: IInterface;
    function GetValue: T;
  private
    type
      TFreeTheValue = class (TInterfacedObject)
      private
        fObjectToFree: TObject;
      public
        constructor Create(anObjectToFree: TObject);
        destructor Destroy; override;
      end;
  public
    constructor Create(AValue: T); overload;
    procedure Create; overload;
    class operator Implicit(AValue: T): TSmartPointer<T>;
    class operator Implicit(smart: TSmartPointer <T>): T;
    property Value: T read GetValue;
  end;

implementation

{ TSmartPointer<T> }

constructor TSmartPointer<T>.Create(AValue: T);
begin
  FValue := AValue;
  FFreeTheValue := TFreeTheValue.Create(FValue);
end;

procedure TSmartPointer<T>.Create;
begin
  Create (T.Create);
end;

function TSmartPointer<T>.GetValue: T;
begin
  if not Assigned(FFreeTheValue) then
    Create;
  Result := FValue;
end;

class operator TSmartPointer<T>.Implicit(smart: TSmartPointer<T>): T;
begin
  Result := Smart.Value;
end;

class operator TSmartPointer<T>.Implicit(AValue: T): TSmartPointer<T>;
begin
  Result := TSmartPointer<T>.Create(AValue);
end;

{ TSmartPointer<T>.TFreeTheValue }

constructor TSmartPointer<T>.TFreeTheValue.Create(anObjectToFree: TObject);
begin
  fObjectToFree := anObjectToFree;
end;

destructor TSmartPointer<T>.TFreeTheValue.Destroy;
begin
  fObjectToFree.Free;
  inherited;
end;


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