Autor Beitrag
martin300
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starhalf ontopic star
Beiträge: 186
Erhaltene Danke: 2



BeitragVerfasst: Fr 16.05.08 12:06 
Hallo,

der folgende Code ist eine Implementierung vom Observer Pattern. Diese Version funktioniert auch.

ausblenden volle Höhe Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
unit uObserver;

//========================================================================
// Copyright (c) 1998, Ader Gonzalez
// Observer Design Pattern
//========================================================================

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Dialogs, Controls, comctrls;

type
  TObservable = class;

    // Observer abstract class interface
  TObserver = class
    procedure Update(ChangedSubject: TObservable); virtual; abstract;
  end;

    // Subject abstract class interface
  TObservable = class
    procedure Add(Observer: TObserver); virtual; abstract;
    procedure Remove(Observer: TObserver); virtual; abstract;
    procedure Notify; virtual; abstract;
  end;


//------------------------------------------------------------------------
// concrete observable classes: TMySubject
// Observable/Subject data object/Problem Domain Object
//------------------------------------------------------------------------
  TMySubject = class(TObservable)
  private
    FObservers: TList;
    Fx: integer;
    Fy: integer;
  public
    constructor Create;
    destructor Destroy; override;
      //TObservable
    procedure Add(Observer: TObserver); override;
    procedure Remove(Observer: TObserver); override;
    procedure Notify; override;
      //MyData interface
    function getX: integer;
    function getY: integer;
    procedure setX(value: integer);
    procedure setY(value: integer);
  end;

//------------------------------------------------------------------------
// Concrete Observer classes: TMyBars and TMyTrackBars
//------------------------------------------------------------------------
  TMyBars = class(TObserver)
  private
    FBarX: TProgressBar;
    FBarY: TProgressBar;
  public
    constructor CreateBars(aParent: TWinControl);
    destructor Destroy; override;
    procedure Update(ChangedSubject: TObservable); override;
  end;

  TMyProgressBar = class(TProgressBar)
  public
    constructor Create(aOwner: TComponent); override;
  end;

    // TMyTrackBars
  TMyTrackBars = class(TObserver)
  private
    FBarX: TTrackBar;
    FBarY: TTrackBar;
    FSubject: TMySubject;
    procedure TrackBarChange(Sender: TObject);
  public
    constructor CreateBars(aParent: TWinControl; aSubject: TMySubject);
    destructor Destroy; override;
    procedure Update(ChangedSubject: TObservable); override;
  end;

implementation

//========================================================================
// TMySubject Observable object
//========================================================================
constructor TMySubject.Create;
begin
  inherited Create;
  FObservers := TList.Create;
end;

destructor TMySubject.Destroy;
begin
  FObservers.Free;
  inherited Destroy;
end;

procedure TMySubject.Add(Observer: TObserver);
begin
  FObservers.Add(Observer); 
end;

procedure TMySubject.Remove(Observer: TObserver);
begin
  FObservers.Remove(Observer);
end;

procedure TMySubject.Notify;
var
  i: integer;
begin
  for i := 0 to pred(FObservers.Count) do
    TObserver(FObservers.Items[i]).Update(Self);;
end;

function TMySubject.getX: integer;
begin
  result := Fx;
end;

function TMySubject.getY: integer;
begin
  result := Fy;
end;

procedure TMySubject.setX(value: integer);
begin
  if value <> Fx then begin
    Fx := value;
    Notify;           // state change notification
  end;
end;

procedure TMySubject.setY(value: integer);
begin
  if value <> Fy then begin
    Fy := value;
    Notify;
  end;
end;


//========================================================================
//  Concrete Observers: TMyBars and TMyTrackBars
//========================================================================
constructor TMybars.CreateBars(aParent: TWinControl);
begin
  inherited Create;
  FBarX := TMyProgressBar.Create(nil);
  FBarY := TMyProgressBar.Create(nil);
  FBarX.Parent := aParent;
  FBarY.Parent := aParent;
end;

destructor TMybars.Destroy;
begin
  FBarX.Free;
  FBarY.Free;
  inherited Destroy;
end;

procedure TMyBars.Update(ChangedSubject: TObservable);
begin
  FBarX.Position := (ChangedSubject as TMySubject).getX;
  FBarY.Position := (ChangedSubject as TMySubject).getY;
end;

//------------------------------------------------------------------------
// TMyTrackBars
//------------------------------------------------------------------------
constructor TMyTrackBars.CreateBars(aParent: TWinControl; aSubject: TMySubject);

  procedure InitTrackBar(aBar: TTrackBar);
  begin
    with aBar do begin
      Min := 0;
      Max := 100;
      Align := alTop;
      Parent := aParent;
      OnChange := TrackBarChange;
    end;
  end;

begin
  inherited Create;
  FBarX := TTrackBar.Create(nil);
  FBarY := TTrackBar.Create(nil);
  InitTrackBar(FBarX);
  InitTrackBar(FBarY);
  FSubject := aSubject;
end;

destructor TMyTrackBars.Destroy;
begin
  FBarX.Free;
  FBarY.Free;
  inherited Destroy;
end;

procedure TMyTrackBars.Update(ChangedSubject: TObservable);
begin
  FBarX.Position := (ChangedSubject as TMySubject).getX;
  FBarY.Position := (ChangedSubject as TMySubject).getY;
end;

procedure TMyTrackBars.TrackBarChange(Sender: TObject);
begin
  if Sender = FBarX then FSubject.setX(FBarX.Position)
  else FSubject.setY(FBarY.Position);
end;

//------------------------------------------------------------------------
// TMyProgressBar
//------------------------------------------------------------------------
constructor TMyProgressBar.Create(aOwner: TComponent);
begin
  inherited Create(aOwner);
  Min := 0;
  Max := 100;
  Step := 1;
  Align := alTop;
end;

end.


Zur Vollständigkeit ist der ganze Code angegeben. Ich möchte die beiden abstrakten
Klassen TObserver und TObservable als Interface implementieren.

Dazu habe ich den Code geändert (Interface eingefügt)

ausblenden volle Höhe Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
unit uObserver1;

//========================================================================
// Copyright (c) 1998, Ader Gonzalez
// Observer Design Pattern
//========================================================================

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Dialogs, Controls, comctrls, STDCtrls, Contnrs, ShellAPI;

type
  TObservable = interface;

    // Observer abstract class interface
  TObserver = interface(IInterface)
    procedure Update(ChangedSubject: TObservable); //virtual; abstract;
  end;

    // Subject abstract class interface
  TObservable = interface(IInterface)
    procedure Add(Observer: TObserver); //virtual; abstract;
    procedure Remove(Observer: TObserver); //virtual; abstract;
    procedure Notify; //virtual; abstract;
  end;


//------------------------------------------------------------------------
// concrete observable classes: TMySubject
// Observable/Subject data object/Problem Domain Object
//------------------------------------------------------------------------
  TMySubject = class(TInterfacedObject, TObservable)
  private
    FObservers: TList;
    Fx: integer;
    Fy: integer;
  public
    constructor Create;
    destructor Destroy; override;
      //TObservable
    procedure Add(Observer: TObserver); //override;
    procedure Remove(Observer: TObserver); //override;
    procedure Notify;// override;
      //MyData interface
    function getX: integer;
    function getY: integer;
    procedure setX(value: integer);
    procedure setY(value: integer);
  end;

//------------------------------------------------------------------------
// Concrete Observer classes: TMyBars and TMyTrackBars
//------------------------------------------------------------------------
  TMyBars = class(TInterfacedObject, TObserver)
  private
    FBarX: TProgressBar;
    FBarY: TProgressBar;
  public
    constructor CreateBars(aParent: TWinControl);
    destructor Destroy; //override;
    procedure Update(ChangedSubject: TObservable); //override;
  end;

  TMyProgressBar = class(TProgressBar)
  public
    constructor Create(aOwner: TComponent); override;
  end;

    // TMyTrackBars
  TMyTrackBars = class(TInterfacedObject, TObserver)
  private
    FBarX: TTrackBar;
    FBarY: TTrackBar;
    FSubject: TMySubject;
    procedure TrackBarChange(Sender: TObject);
  public
    constructor CreateBars(aParent: TWinControl; aSubject: TMySubject);
    destructor Destroy; override;
    procedure Update(ChangedSubject: TObservable); //override;
  end;

implementation

//========================================================================
// TMySubject Observable object
//========================================================================
constructor TMySubject.Create;
begin
  inherited Create;
  FObservers := TObjectList.Create;
end;

destructor TMySubject.Destroy;
begin
  FObservers.Free;
  inherited Destroy;
end;

procedure TMySubject.Add(Observer: TObserver);
begin
  FObservers.Add(Observer);
end;

procedure TMySubject.Remove(Observer: TObserver);
begin
  FObservers.Remove(Observer);
end;

procedure TMySubject.Notify;
var
  i: integer;
begin
  for i := 0 to pred(FObservers.Count) do
    TObserver(FObservers.Items[i]).Update(Self);;
end;

function TMySubject.getX: integer;
begin
  result := Fx;
end;

function TMySubject.getY: integer;
begin
  result := Fy;
end;

procedure TMySubject.setX(value: integer);
begin
  if value <> Fx then begin
    Fx := value;
    Notify;           // state change notification
  end;
end;

procedure TMySubject.setY(value: integer);
begin
  if value <> Fy then begin
    Fy := value;
    Notify;
  end;
end;


//========================================================================
//  Concrete Observers: TMyBars and TMyTrackBars
//========================================================================
constructor TMybars.CreateBars(aParent: TWinControl);
begin
  inherited Create;
  FBarX := TMyProgressBar.Create(nil);
  FBarY := TMyProgressBar.Create(nil);
  FBarX.Parent := aParent;
  FBarY.Parent := aParent;
end;

destructor TMybars.Destroy;
begin
  FBarX.Free;
  FBarY.Free;
  inherited Destroy;
end;

procedure TMyBars.Update(ChangedSubject: TObservable);
begin
  FBarX.Position := (ChangedSubject as TMySubject).getX;
  FBarY.Position := (ChangedSubject as TMySubject).getY;
end;

//------------------------------------------------------------------------
// TMyTrackBars
//------------------------------------------------------------------------
constructor TMyTrackBars.CreateBars(aParent: TWinControl; aSubject: TMySubject);

  procedure InitTrackBar(aBar: TTrackBar);
  begin
    with aBar do begin
      Min := 0;
      Max := 100;
      Align := alTop;
      Parent := aParent;
      OnChange := TrackBarChange;
    end;
  end;

begin
  inherited Create;
  FBarX := TTrackBar.Create(nil);
  FBarY := TTrackBar.Create(nil);
  InitTrackBar(FBarX);
  InitTrackBar(FBarY);
  FSubject := aSubject;
end;

destructor TMyTrackBars.Destroy;
begin
  FBarX.Free;
  FBarY.Free;
  inherited Destroy;
end;

procedure TMyTrackBars.Update(ChangedSubject: TObservable);
begin
  FBarX.Position := (ChangedSubject as TMySubject).getX;
  FBarY.Position := (ChangedSubject as TMySubject).getY;
end;

procedure TMyTrackBars.TrackBarChange(Sender: TObject);
begin
  if Sender = FBarX then FSubject.setX(FBarX.Position)
  else FSubject.setY(FBarY.Position);
end;

//------------------------------------------------------------------------
// TMyProgressBar
//------------------------------------------------------------------------
constructor TMyProgressBar.Create(aOwner: TComponent);
begin
  inherited Create(aOwner);
  Min := 0;
  Max := 100;
  Step := 1;
  Align := alTop;
end;

end.


Nun erscheint in der Prozedur
ausblenden Delphi-Quelltext
1:
2:
3:
4:
procedure TMySubject.Add(Observer: TObserver);
begin
  FObservers.Add(Observer);
end;

eine Fehlermeldung Inkompatible Typen: 'Pointer' und 'TObserver' bei FObservers.Add;
Meine Frage daher, was passt bei der Definiton vom Interface nicht...