Methode "Free" selbst implementieren (Assembler-Problem?)

[MaBuSE]

Folgendes "einfaches" Beispiel sollte Dein Problem lösen:

Unit1.pas

Delphi-Quellcode:

unit Unit1;

interface

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

type
  TMyObject = class;

  TMyObject = class(TForm)
    Timer1: TTimer;
    procedure Timer1Timer(Sender: TObject);
  private
    { Private-Deklarationen }
    MyRefCount: Integer;
  public
    { Public-Deklarationen }
    constructor Create(AOwner: TComponent); override;
    function GetMyObject: TMyObject;
    procedure FreeMyObject;
  end;

var
  MyObject: TMyObject;

implementation

{$R *.dfm}

{ TMyObject}

// Hier wird nur MyRefCount hochgezählt (auf 1 gesetzt)
constructor TMyObject.Create(AOwner: TComponent);
begin
  inherited;
  Inc(MyRefCount);
end;

// hiermit werden die Objekte freigegeben
procedure TMyObject.FreeMyObject;
begin
  if Self <> nil then
  begin
    Dec(MyRefCount);
    if MyRefCount < 1 then Self.Free;
  end;
end;

// hiermit wird eine Objektreferenz geholt
function TMyObject.GetMyObject: TMyObject;
begin
  if Self <> nil then
  begin
    Inc(MyRefCount);
    Result := Self;
  end
  else
  begin
    Result := nil;
  end;
end;

// Der Timer ist nur auf dem Form, damit man sieht wie viele Refs es gibt
procedure TMyObject.Timer1Timer(Sender: TObject);
begin
  Caption := IntToStr(MyRefCount);
end;

end.

Hier werden 3 wichtige Dinge implementiert:

• Create wird überladen der der Referenzzähler auf 1 gesetzt
• Mit GetMyObject wird das akive Object übergeben und der Referenzzähler um 1 erhöht
• Mit FreeMyObject wird die aktive Referenz freigegeben und der Referenzzähler um 1 erniedrigt

Anwendung siehe Unit2:

Delphi-Quellcode:

unit Unit2;

interface

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

type
  TForm2 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form2: TForm2;

implementation

uses Unit1;

{$R *.dfm}

var a, b : TMyObject;

procedure TForm2.Button1Click(Sender: TObject);
begin
  MyObject := TMyObject.Create(self);
  MyObject.Show;
end;

procedure TForm2.Button2Click(Sender: TObject);
begin
  a := MyObject.GetMyObject;
end;

procedure TForm2.Button3Click(Sender: TObject);
begin
  b := MyObject.GetMyObject;
end;

procedure TForm2.Button4Click(Sender: TObject);
begin
  a.FreeMyObject;
  a := nil;
end;

procedure TForm2.Button5Click(Sender: TObject);
begin
  b.FreeMyObject;
  b := nil;
end;

procedure TForm2.Button6Click(Sender: TObject);
begin
  MyObject.FreeMyObject;
  MyObject := nil
end;

procedure TForm2.Button7Click(Sender: TObject);
begin
  Close;
end;

end.

Die Unit 2 ist ein leeres TForm mit 7 TButtons

• Button1 = MyObject erzeugen und anzeigen
• Buttin2 = MyObject wird A zugewiesen
• Buttin3 = MyObject wird B zugewiesen
• Buttin4 = A wird freigegeben
• Buttin5 = B wird freigegeben
• Buttin6 = MyObject wird freigegeben
• Button7 = Programmende

Egal in welcher Reihenfolge freigegeben wird, verschwindet das Fenster TMyObject erst, wenn die letzte Referenz freigegeben wurde.

Das Ganze wird in die Project1.dpr eingebunden:

Delphi-Quellcode:

program Project1;

uses
  Forms,
  Unit1 in 'Unit1.pas' {MyObject},
  Unit2 in 'Unit2.pas' {Form2};

{$R *.res}

begin
  Application.Initialize;
  Application.CreateForm(TForm2, Form2);
  Application.Run;
end.

Viel Spaß

[edit]
wichtig: Es muß natürlich erst der Button1 gedrückt werden, damit TMyObject.Create aufgerufen wird.
[/edit]