OnChange o.ä. für Speicheraufforderung

[DeddyH]

Da im Threadtitel FreePascal steht, vermute ich, es geht um Lazarus. Den folgenden Code habe ich gerade eben unter Lazarus 1.1 ausprobiert (komplette Unit):

Delphi-Quellcode:

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls;

type

  { TTestClass }

  TTestClass = class
  private
    FName: string;
    FFirstname: string;
    FOnChanged: TNotifyEvent;
    FOnSaved: TNotifyEvent;
    procedure Change;
    procedure SetName(AValue: string);
    procedure SetFirstname(AValue: string);
  public
    procedure Save;
    property Name: string read FName write SetName;
    property Firstname: string read FFirstname write SetFirstname;
    property OnChanged: TNotifyEvent read FOnChanged write FOnChanged;
    property OnSaved: TNotifyEvent read FOnSaved write FOnSaved;
  end;

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { private declarations }
    FTest: TTestClass;
    procedure DoOnTestChanged(Sender: TObject);
    procedure DoOnTestSaved(Sender: TObject);
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
  FTest := TTestClass.Create;
  FTest.OnChanged := @DoOnTestChanged;
  FTest.OnSaved := @DoOnTestSaved;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  FTest.Name := 'Hanswurst';
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  FTest.Firstname := 'Pumuckl';
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  FTest.Save;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FTest.Free;
end;

procedure TForm1.DoOnTestChanged(Sender: TObject);
begin
  Caption := Name + '*';
end;

procedure TForm1.DoOnTestSaved(Sender: TObject);
begin
  Caption := Name;
end;

{$R *.lfm}

{ TTestClass }

procedure TTestClass.Change;
begin
  if Assigned(FOnChanged) then
    FOnChanged(self);
end;

procedure TTestClass.SetName(AValue: string);
begin
  if FName=AValue then Exit;
  FName:=AValue;
  Change;
end;

procedure TTestClass.SetFirstname(AValue: string);
begin
  if FFirstname=AValue then Exit;
  FFirstname:=AValue;
  Change;
end;

procedure TTestClass.Save;
begin
  if Assigned(FOnSaved) then
    FOnSaved(self);
end;

end.

So sollte das vermutlich in etwa aussehen, bei mir hat das wie erwartet funktioniert. Die "Exits" hat Lazarus BTW selbst eingefügt, ich habe es dabei belassen, falls jemand meckern möchte *g*.