示例:使用虚代理实现
说明:
Graphic类为图形对象定义一个接口。
Image类实现了Graphic接口用来显示图像文件。Image重定义Handlemouse操作,使得用户可以交互的调整图像的尺寸。
ImageProxy和Image具有相同的接口,其构造函数保存了存储图像的文件名的本地拷贝,并初始化FExtent和Fimage。如果可能的话,GetExtent的实现部分返回缓存的图像尺寸;否则从文件中装载图像。Draw用来装载图像,HandelMouse则向实际图像转发这个事件。Save操作将缓存的图像尺寸和文件名保存在一个流中。Load得到这个信息并初始化相应的成员函数。
代码:
unit uDocument;
interface
uses
Windows,Classes,Graphics,Contnrs;
type
TMouseEventType = (mtUp,mtDown,mtMove);
TMouseEvent = record
MType: TMouseEventType;
MPos: TPoint;
end;
TTextDocument = class;
TGraphic = class
private
FParent: TTextDocument;
public
procedure Draw(const at: TPoint); virtual; abstract;
function GetExtent(): TPoint; virtual; abstract;
procedure Load(AStream: TStream); virtual; abstract;
procedure Save(AStream: TStream); virtual; abstract;
procedure HandleMouse(AEvent: TMouseEvent); virtual; abstract;
//---
property Parent: TTextDocument read FParent write FParent;
end;
TImage1 = class(TGraphic)
private
FFileName: string;
FBitmap: TBitmap;
public
constructor Create(const AImageFile: string);
destructor Destroy; override;
//---
procedure Draw(const at: TPoint); override;
function GetExtent(): TPoint; override;
procedure Load(AStream: TStream); override;
procedure Save(AStream: TStream); override;
procedure HandleMouse(AEvent: TMouseEvent); override;
end;
TImageProxy = class(TGraphic)
private
FImage: TImage1;
FExtent: TPoint;
FFileName: string;
protected
function GetImage: TImage1;
public
constructor Create(const AImageFile: string);
destructor Destroy; override;
//---
procedure Draw(const at: TPoint); override;
function GetExtent(): TPoint; override;
procedure Load(AStream: TStream); override;
procedure Save(AStream: TStream); override;
procedure HandleMouse(AEvent: TMouseEvent); override;
end;
TTextDocument = class
private
FCanvas: TCanvas;
FGraphics: TObjectList;
public
constructor Create(const ACanvas: TCanvas);
destructor Destroy; override;
//---
procedure Insert(aGraphic: TGraphic);
procedure Draw;
//---
property Canvas: TCanvas read FCanvas;
end;
implementation
constructor TImage1.Create(const AImageFile: string);
begin
inherited Create;
//---
FFileName := AImageFile;
//---
FBitmap := TBitmap.Create;
FBitmap.LoadFromFile(FFileName);
end;
destructor TImage1.Destroy;
begin
if assigned(FBitmap) then
FBitmap.Free;
//---
inherited;
end;
procedure TImage1.Draw(const at: TPoint);
begin
self.Parent.Canvas.Draw(at.X,at.Y,FBitmap);
end;
procedure TImage1.HandleMouse(AEvent: TMouseEvent);
begin
end;
function TImage1.GetExtent(): TPoint;
begin
with Result do
begin
X := FBitmap.Width;
Y := FBitmap.Height;
end;
end;
procedure TImage1.Load(AStream: TStream);
begin
FBitmap.LoadFromStream(AStream);
end;
procedure TImage1.Save(AStream: TStream);
begin
FBitmap.SaveToStream(AStream);
end;
function TImageProxy.GetImage: TImage1;
begin
if FImage = nil then
begin
FImage := TImage1.Create(FFileName);
FImage.Parent := self.Parent;
end;
result := FImage;
end;
constructor TImageProxy.Create(const AImageFile: string);
begin
inherited Create;
//---
FFileName := AImageFile;
FExtent := Point(0,0);
FImage := nil;
end;
destructor TImageProxy.Destroy;
begin
if Assigned(FImage) then
FImage.Free;
//---
inherited
end;
procedure TImageProxy.Draw(const at: TPoint);
begin
self.GetImage.Draw(at);
end;
procedure TImageProxy.HandleMouse(AEvent: TMouseEvent);
begin
self.GetImage.HandleMouse(AEvent);
end;
function TImageProxy.GetExtent(): TPoint;
begin
if (FExtent.x = 0) and (FExtent.y = 0) then
FExtent := self.GetImage.GetExtent;
Result := FExtent;
end;
procedure TImageProxy.Load(AStream: TStream);
var
AFileNameLen: integer;
begin
AStream.Read(FExtent.X,SizeOf(FExtent.X));
AStream.Read(FExtent.Y,SizeOf(FExtent.Y));
//---
AStream.Read(AFileNameLen,SizeOf(AFileNameLen));
SetLength(FFileName,AFileNameLen);
AStream.Read(FFileName[1],AFileNameLen);
end;
procedure TImageProxy.Save(AStream: TStream);
var
AFileNameLen: integer;
begin
AStream.Write(FExtent.X,SizeOf(FExtent.X));
AStream.Write(FExtent.Y,SizeOf(FExtent.Y));
//---
AFileNameLen := Length(FFileName);
AStream.Write(AFileNameLen,SizeOf(AFileNameLen));
AStream.Write(FFileName[1],AFileNameLen);
end;
constructor TTextDocument.Create(const ACanvas: TCanvas);
begin
FGraphics := TObjectList.Create;
FCanvas := ACanvas;
end;
destructor TTextDocument.Destroy;
begin
FGraphics.Free;
//---
inherited;
end;
procedure TTextDocument.Draw;
var
at: TPoint;
i: integer;
begin
at := Point(0,0);
//---
with FGraphics do
begin
for i := 0 to Count - 1 do
begin
with TGraphic(Items[i]) do
begin
Draw(at);
//---
at.Y := at.Y + GetExtent.Y;
end;
end;
end;
end;
procedure TTextDocument.Insert(aGraphic: TGraphic);
begin
aGraphic.Parent := self;
FGraphics.Add(aGraphic);
end;
end.
procedure TForm1.Button1Click(Sender: TObject);
var
ADocument: TTextDocument;
begin
ADocument := TTextDocument.Create(self.Canvas);
try
ADocument.Insert(TImageProxy.Create('D:/temp/test.bmp'));
ADocument.Insert(TImageProxy.Create('D:/temp/test1.bmp'));
ADocument.Draw;
finally
ADocument.Free;
end;
end;