V
virtualmfc
Unregistered / Unconfirmed
GUEST, unregistred user!
以下我用Delphi实现Observer模式,却在实际运行中会出现Access Violation。
请大家帮帮忙,看看哪里有错,代码较长,请大家有点耐心看。
unit Subscribe;
interface
uses
SysUtils, Windows, Messages, Classes, Graphics, Controls,
Forms, Dialogs;
type
IObserver = interface;
TNonRefCountedObject = class (TInterfacedObject, IInterface)
public
function _AddRef: Integer;
stdcall;
function _Release: Integer;
stdcall;
end;
TObservable = class (TNonRefCountedObject)
private
changed: Boolean;
obs: TInterfaceList;
public
constructor Create;
destructor Destroy;
override;
procedure addObserver(o: IObserver);
procedure clearChanged;
function countObservers: Integer;
procedure deleteObserver(const o: IObserver);
procedure deleteObservers;
function hasChanged: Boolean;
procedure notifyObservers;
overload;
procedure notifyObservers(arg: TObject);
overload;
procedure setChanged;
end;
TNameObserver = class (TNonRefCountedObject, IObserver)
public
constructor Create;
destructor Destroy;
override;
procedure update(obs: TObservable;
arg:TObject );
stdcall;
end;
TPriceObserver = class (TNonRefCountedObject, IObserver)
public
constructor Create;
destructor Destroy;
override;
procedure update(obs: TObservable;
arg:TObject );
stdcall;
end;
TProduct = class (TObservable)
private
FName: string;
FPrice:do
uble;
function GetName: string;
function GetPrice:do
uble;
procedure SetName(const Value: string);
procedure SetPrice(Value:do
uble);
public
property Name: string read GetName write SetName;
property Price:do
uble read GetPrice write SetPrice;
end;
IObserver = interface (IInterface)
['{73AA5958-E523-48EC-8AD4-5E9DAEDF7AC7}']
procedure update(obs: TObservable;
arg:TObject );
stdcall;
end;
implementation
{
***************************** TNonRefCountedObject *****************************
}
function TNonRefCountedObject._AddRef: Integer;
begin
{ TODO -cMM : Interface wizard: Implement interface method }
Result := -1;
end;
function TNonRefCountedObject._Release: Integer;
begin
{ TODO -cMM : Interface wizard: Implement interface method }
Result := -1;
end;
{
********************************* TObservable **********************************
}
constructor TObservable.Create;
begin
inherited Create;
obs := TInterfaceList.Create;
{obs := TList.Create;}
end;
destructor TObservable.Destroy;
begin
obs.Free;
inherited Destroy;
end;
procedure TObservable.addObserver(o: IObserver);
begin
{
Adds an observer to the set of observers for this object,
provided that it is not the same as some observer already in
the set.
@param o an observer to be added.
}
if obs.IndexOf(o) = -1 then
obs.Add(o);
end;
procedure TObservable.clearChanged;
begin
changed := false;
end;
function TObservable.countObservers: Integer;
begin
Result := obs.Count;
end;
procedure TObservable.deleteObserver(const o: IObserver);
begin
{
Deletes an observer from the set of observers of this object.
@param o the observer to be deleted.
}
obs.Remove(o);
end;
procedure TObservable.deleteObservers;
begin
{
Clears the observer list so that this object no longer has any observers.
}
obs.Clear;
end;
function TObservable.hasChanged: Boolean;
begin
Result := changed;
end;
procedure TObservable.notifyObservers;
begin
{
if this object has changed, as indicated by the
hasChanged method, then
notify all of its observers
and then
call the clearChanged method to indicate
that this object has no longer changed.
}
notifyObservers(nil);
end;
procedure TObservable.notifyObservers(arg: TObject);
var
I: Integer;
begin
{
if this object has changed, as indicated by the
hasChanged method, then
notify all of its observers
and then
call the clearChanged method to indicate
that this object has no longer changed.
}
if hasChanged then
begin
for I:=0 to obs.Count - 1do
begin
(IObserver(obs.Items)).update(self, arg);
end;
clearChanged;
end;
end;
procedure TObservable.setChanged;
begin
changed := true;
end;
{
******************************** TNameObserver *********************************
}
constructor TNameObserver.Create;
begin
inherited Create;
end;
destructor TNameObserver.Destroy;
begin
ShowMessage('TNameObserver has destroyed');
inherited Destroy;
end;
procedure TNameObserver.update(obs: TObservable;
arg:TObject );
var
product: TProduct;
begin
{ TODO -cMM : Interface wizard: Implement interface method }
product := TProduct(obs);
ShowMessage('Name Observer: Name changed to' + product.GetName());
end;
{
******************************** TPriceObserver ********************************
}
constructor TPriceObserver.Create;
begin
inherited Create;
end;
destructor TPriceObserver.Destroy;
begin
ShowMessage('TPriceObserver has destroyed');
inherited Destroy;
end;
procedure TPriceObserver.update(obs: TObservable;
arg:TObject );
var
product: TProduct;
begin
{ TODO -cMM : Interface wizard: Implement interface method }
product := TProduct(obs);
ShowMessage('Price Observer: Price changed to' + FloatToStr(product.GetPrice()));
end;
{
*********************************** TProduct ***********************************
}
function TProduct.GetName: string;
begin
Result := FName;
end;
function TProduct.GetPrice:do
uble;
begin
Result := FPrice;
end;
procedure TProduct.SetName(const Value: string);
begin
FName := Value;
setChanged();
notifyObservers();
end;
procedure TProduct.SetPrice(Value:do
uble);
begin
FPrice := Value;
setChanged();
notifyObservers();
end;
end.
====================================================================
unit main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Subscribe;
type
TMainForm = class(TForm)
btnObserver: TButton;
procedure btnObserverClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
MainForm: TMainForm;
implementation
{$R *.dfm}
procedure TMainForm.btnObserverClick(Sender: TObject);
var
product: TProduct;
//step 1
nameobs: TNameObserver;
priceobs: TPriceObserver;
{
//step 2
nameobs, priceobs: IObserver;
}
begin
product := TProduct.Create;
nameobs := TNameObserver.Create;
priceobs := TPriceObserver.Create;
try
product.addObserver(nameobs);
product.addObserver(priceobs);
product.Name := 'ToothBrush';
product.Price := 9.22;
finally
//step 1
nameobs.Free;
priceobs.Free;
product.Free;
end;
end;
end.
请大家帮帮忙,看看哪里有错,代码较长,请大家有点耐心看。
unit Subscribe;
interface
uses
SysUtils, Windows, Messages, Classes, Graphics, Controls,
Forms, Dialogs;
type
IObserver = interface;
TNonRefCountedObject = class (TInterfacedObject, IInterface)
public
function _AddRef: Integer;
stdcall;
function _Release: Integer;
stdcall;
end;
TObservable = class (TNonRefCountedObject)
private
changed: Boolean;
obs: TInterfaceList;
public
constructor Create;
destructor Destroy;
override;
procedure addObserver(o: IObserver);
procedure clearChanged;
function countObservers: Integer;
procedure deleteObserver(const o: IObserver);
procedure deleteObservers;
function hasChanged: Boolean;
procedure notifyObservers;
overload;
procedure notifyObservers(arg: TObject);
overload;
procedure setChanged;
end;
TNameObserver = class (TNonRefCountedObject, IObserver)
public
constructor Create;
destructor Destroy;
override;
procedure update(obs: TObservable;
arg:TObject );
stdcall;
end;
TPriceObserver = class (TNonRefCountedObject, IObserver)
public
constructor Create;
destructor Destroy;
override;
procedure update(obs: TObservable;
arg:TObject );
stdcall;
end;
TProduct = class (TObservable)
private
FName: string;
FPrice:do
uble;
function GetName: string;
function GetPrice:do
uble;
procedure SetName(const Value: string);
procedure SetPrice(Value:do
uble);
public
property Name: string read GetName write SetName;
property Price:do
uble read GetPrice write SetPrice;
end;
IObserver = interface (IInterface)
['{73AA5958-E523-48EC-8AD4-5E9DAEDF7AC7}']
procedure update(obs: TObservable;
arg:TObject );
stdcall;
end;
implementation
{
***************************** TNonRefCountedObject *****************************
}
function TNonRefCountedObject._AddRef: Integer;
begin
{ TODO -cMM : Interface wizard: Implement interface method }
Result := -1;
end;
function TNonRefCountedObject._Release: Integer;
begin
{ TODO -cMM : Interface wizard: Implement interface method }
Result := -1;
end;
{
********************************* TObservable **********************************
}
constructor TObservable.Create;
begin
inherited Create;
obs := TInterfaceList.Create;
{obs := TList.Create;}
end;
destructor TObservable.Destroy;
begin
obs.Free;
inherited Destroy;
end;
procedure TObservable.addObserver(o: IObserver);
begin
{
Adds an observer to the set of observers for this object,
provided that it is not the same as some observer already in
the set.
@param o an observer to be added.
}
if obs.IndexOf(o) = -1 then
obs.Add(o);
end;
procedure TObservable.clearChanged;
begin
changed := false;
end;
function TObservable.countObservers: Integer;
begin
Result := obs.Count;
end;
procedure TObservable.deleteObserver(const o: IObserver);
begin
{
Deletes an observer from the set of observers of this object.
@param o the observer to be deleted.
}
obs.Remove(o);
end;
procedure TObservable.deleteObservers;
begin
{
Clears the observer list so that this object no longer has any observers.
}
obs.Clear;
end;
function TObservable.hasChanged: Boolean;
begin
Result := changed;
end;
procedure TObservable.notifyObservers;
begin
{
if this object has changed, as indicated by the
hasChanged method, then
notify all of its observers
and then
call the clearChanged method to indicate
that this object has no longer changed.
}
notifyObservers(nil);
end;
procedure TObservable.notifyObservers(arg: TObject);
var
I: Integer;
begin
{
if this object has changed, as indicated by the
hasChanged method, then
notify all of its observers
and then
call the clearChanged method to indicate
that this object has no longer changed.
}
if hasChanged then
begin
for I:=0 to obs.Count - 1do
begin
(IObserver(obs.Items)).update(self, arg);
end;
clearChanged;
end;
end;
procedure TObservable.setChanged;
begin
changed := true;
end;
{
******************************** TNameObserver *********************************
}
constructor TNameObserver.Create;
begin
inherited Create;
end;
destructor TNameObserver.Destroy;
begin
ShowMessage('TNameObserver has destroyed');
inherited Destroy;
end;
procedure TNameObserver.update(obs: TObservable;
arg:TObject );
var
product: TProduct;
begin
{ TODO -cMM : Interface wizard: Implement interface method }
product := TProduct(obs);
ShowMessage('Name Observer: Name changed to' + product.GetName());
end;
{
******************************** TPriceObserver ********************************
}
constructor TPriceObserver.Create;
begin
inherited Create;
end;
destructor TPriceObserver.Destroy;
begin
ShowMessage('TPriceObserver has destroyed');
inherited Destroy;
end;
procedure TPriceObserver.update(obs: TObservable;
arg:TObject );
var
product: TProduct;
begin
{ TODO -cMM : Interface wizard: Implement interface method }
product := TProduct(obs);
ShowMessage('Price Observer: Price changed to' + FloatToStr(product.GetPrice()));
end;
{
*********************************** TProduct ***********************************
}
function TProduct.GetName: string;
begin
Result := FName;
end;
function TProduct.GetPrice:do
uble;
begin
Result := FPrice;
end;
procedure TProduct.SetName(const Value: string);
begin
FName := Value;
setChanged();
notifyObservers();
end;
procedure TProduct.SetPrice(Value:do
uble);
begin
FPrice := Value;
setChanged();
notifyObservers();
end;
end.
====================================================================
unit main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Subscribe;
type
TMainForm = class(TForm)
btnObserver: TButton;
procedure btnObserverClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
MainForm: TMainForm;
implementation
{$R *.dfm}
procedure TMainForm.btnObserverClick(Sender: TObject);
var
product: TProduct;
//step 1
nameobs: TNameObserver;
priceobs: TPriceObserver;
{
//step 2
nameobs, priceobs: IObserver;
}
begin
product := TProduct.Create;
nameobs := TNameObserver.Create;
priceobs := TPriceObserver.Create;
try
product.addObserver(nameobs);
product.addObserver(priceobs);
product.Name := 'ToothBrush';
product.Price := 9.22;
finally
//step 1
nameobs.Free;
priceobs.Free;
product.Free;
end;
end;
end.