TGraphic

TGraphic
2010年06月10日
　　问题：忘掉代码 之 TGraphic ( 积分：0, 回复：22, 阅读：444 )
　　分类：编程手记 ( 版主：DNChen, cAkk ) 
　　来自：小雨哥, 时间：2007-10-13 14:46:00, ID：3842211 [显示：小字体 | 大字体] 
　　这是一个抽象类。顾名思义，抽象类是用来抽象一般事物，它本身应该是泛意的，而基于它
　　产生的真正的对象，才是 Graphic 的。Delphi 原代码中直接定义为抽象类的类并不多，比
　　如 ： TStream 也是一个抽象类，仔细通读这些类的定义方法，可以给自己带来很多收获。
　　现在，让我们一起走进 TGraphic ，我首先请大家要做的事情是忘掉代码，只需要用欣赏的
　　心情走入图形的世界。
　　怎样来定义一个抽象类？哇塞，这样的问题不要来问我，那是高智商问题，容易导致脑部抽
　　筋。TGraphic 就是一个抽象类，它是怎么定义的？任何事物的抽象，都是有其真实的参照
　　物来的，TGraphic 的参照物就是世界上的所有图形图像。那么图形图象这么多，那些是它
　　们共有的可以被抽象的？很容易回答这个问题，无非就是宽度、长度，除了这二个东西外，
　　我们都不能真正地抽象图形，这一点可以从 TGraphic 类中的 Equals 方法中领悟到。
　　Equals 方法是这样判断二个图像是否相等的：首先，它检查这二个图像是否具有相同的类
　　形，假如类型相同，那么就仔细比较他们的每一个部分，直到得到的比对结果完全一样，这
　　个函数才会回答这二个图像是否真的相等。
　　看看，也就是说，实际上并没有一个更简单的办法可以抽象图形，如果有的话，这个函数大
　　概就不会这么写了，当然，写这个函数的程序员并没有自大，他觉得在他目前的AI状态下，
　　这个函数大概也就到此为止了，但他并不排除 High AI 的人士存在，所以他在这个函数的
　　尾部定义了一个关键词：virtual ，目的无非是让高智商的人士有用武之地。
　　[请待下文，本篇没分，因为我也快穷得叮当响了] 
　　来自：小雨哥, 时间：2007-10-13 15:33:30, ID：3842222
　　感谢这位定义 Equals 为虚方法的程序员给高智商人士带来人文关怀的同时，我们或许会
　　思考，一个图形，难道真的只有长和宽吗？不是还有 RGB 颜色和透明与否等等内容吗？
　　还有，同一个图形，从不同角度不是还可以看到不同的变形吗？
　　是的，我完全同意这样的思考，只是这些思考中的部分内容，实际上在 TGraphic 中有更好
　　的思考。
　　前面我们讲到，TGraphic 只关心长和宽，也就是说，它只关心图形的维度。那么，也就意
　　味着这个类中的大多数代码将与维度有关。然而，即便是这么简单的维度问题，在具体的类
　　型未知的情况下，我们也无法深入，怎么办呢？最好的办法是交给具体类型的实现者去向我
　　们提供长和宽，甚至，我们在 TGraphic 看到的 GetHeight 和 GetWidth 直接就是纯虚方
　　法。纯虚方法是一个用来定义规则的占位符，实现者必须依照这个规则向 TGraphic 提供具
　　体的实现。
　　既然我们知道了图形的维度，那么图形的最终目的是用来显示给人看的，我们并没有在这个
　　类里看到每个图形都有的 RGB 要素，那么如何显示呢？这个问题很简单，TGraphic 也不知
　　道每个具体的图形应该如何显示，怎么办呢？老方法：留给实现者去做。于是就有了一个
　　Draw 的纯虚方法，这个方法的意思是：请按你的图形情况在合适的位置画出图形。
　　哇塞，什么都不用做啊，全推给了后面实现者去完成，这样的活我喜欢，最好还能工资照拿
　　就更妙了。说笑归说笑，事实上抽象类就是只定规则不干活的。这犹如真实世界里的企业管
　　理，好的规则不仅清晰容易明白，而且可以包容并且最大限度地发挥人才优势。
　　到这里，一个 TGraphic 的抽象实际上已经完成，但是，我们是写程序的，程序的要素是数
　　据和行为，我们还需要真正的图像数据，这些数据怎么来？呵呵，没错，TGraphic 又定义
　　了二个不干活的规则： LoadFromStream 和 SaveToStream 。说到这里，这个类是怎么来的
　　大概已经说得很清楚了，接下来我们来看看这个程序员百密一疏的地方。
　　[请待下文] 
　　来自：小雨哥, 时间：2007-10-13 15:51:34, ID：3842235
　　其实，在定义规则的时候，并不仅是定义一个方法，更多的时候我们会为这个方法应该带上
　　怎么样的参数费心思。GetHeight 和 GetWidth 这样的方法很明确，他们将返回一个具体的
　　维度数据，不需要带任何参数，就象是发布命令一样就可以了。而 Draw 方法就不怎么好处
　　理了，通常的观点是：你提供一个画布，并规定画到画布的什么位置，我来完成绘画。于是
　　Draw 的方法可以定义成：Draw(DC:HDC,R:TRect)或者Draw(X,Y,DC:HDC)或者Draw(C:TCanvas;R:TRect)
　　等等。这时候我们看到，要么是一个Delphi专用的TCanvas，要么是一个Windows通用的HDC。
　　TCanvas 是 Delphi 用来包装 Windows 系统中的 DC 的一个对象，所以，这二个东西本质
　　上是一个东西。考虑到 Delphi 中更通用的是 TCanvas ，所以 TGraphic 中就选择了 TCanvas。
　　但是，我们既然在说抽象，一个 Draw 方法就把我们的抽象带回到了具体的操作系统依赖
　　上，这似乎是出人意料的简单。为什么我们不能更抽象一些呢？为什么我们的 Draw 方法
　　不是这个样子呢： Draw( Dest:TGraphic; DR:TRect ) ？ 
　　来自：iseek, 时间：2007-10-13 16:43:15, ID：3842257
　　写得太好了,这才叫深入浅出.没有真正的理解是写不出来的... 
　　来自：wk_knife, 时间：2007-10-13 17:09:29, ID：3842262
　　不知道你想说啥哦？ 
　　来自：zqw0117, 时间：2007-10-13 17:21:34, ID：3842268
　　说明楼上功力还不够。哈哈。支持小雨哥。TGraphic是VCL里面一个非常有意思的类，之所以各种Image图片格式都可以让VCL支持，就在TGraphic的设计上的灵活哦！ 
　　来自：leaber, 时间：2007-10-13 17:27:54, ID：3842270
　　哈哈,小雨哥,顶一下!! 
　　来自：kinneng, 时间：2007-10-13 18:03:35, ID：3842278
　　我看不明白上面写什么？ TGraphic 是一个待扩充的框架，没有装修的毛胚房，没那么神吧 
　　来自：gotiger, 时间：2007-10-13 20:46:27, ID：3842310
　　深入浅出 
　　来自：piao40993470, 时间：2007-10-13 21:07:39, ID：3842319
　　突然想起某人说过的一句话“抽象程度越高的使用越复杂，越低的越易使用”
　　来自：ztf86781163, 时间：2007-10-14 12:40:05, ID：3842420
　　Draw( Dest:TGraphic; DR:TRect ) ?
　　我另外想到一个办法,首先转换一下观念,这里的TGraphic是一个主动者,所以它要表现自己(Draw)就需要一个画布一样的东西,假如能表现这个TGraphic不是个画布,而是其他的呢,所以这时候我们可以选择是TGraphic成为一个被调用者,即主动者变调用者,定义一个接口 IDrawInterFace ,它接受的参数为TGraphic,则Draw可以这样写
　　Draw(Drawer : IDrawInterFace) ;
　　begin
　　Drawer.draw(self) ; //draw 是 IDrawInterFace 接口必须实现的方法
　　end;
　　这样可以将把自己的画的任务交给专门实现了 IDrawInterFace的类了~~ 
　　来自：h_backup, 时间：2007-10-17 17:13:49, ID：3843423
　　搞java的整天就研究这类问题,搞delphi的研究这类问题的相对少得多,建议对类库设计感兴趣的朋友多看看java相关的东东,会有所收获的 
　　来自：yeskert1, 时间：2007-10-18 14:20:58, ID：3843729
　　to 小雨哥:
　　好厉害的小雨哥，高手啊！
　　但是，borland的程序员那样定义自然有他的好处，就是这个类不仅仅可以画在自己知道的那个东西上，还可以画在别处。难以两全！我想他当时应该也是矛盾良久的吧。
　　有时候为了理论上的完美，要做很多枯燥、冗余、费解的工作，绕了很多很多，实现了理论上的完美；另一方面，朴素、使用、简洁！两者结合不仅仅需要智慧，而且需要经验和眼光。
　　正如“所有飞着的终究要着地”一样，所有的变化和灵活都是基于某些确定不变的东西，所有的抽象都是为了更好的表述现实。
　　抽象，一种手段罢了！ 
　　来自：小雨哥, 时间：2007-12-26 0:53:11, ID：3862817
　　yeskert1 说的极是。从应用角度说， TGraphic 已经定义得很完美了。
　　ztf86781163 则从另一个角度提出了规则的转换法则，也是相当有见地的。
　　实际上，如果 TGraphic 没有用 TCanvas 作为一个基本成员的话，VCL 架构就未必好看。
　　反正这样对应用已经够用了，这应该是设计者一个理性的择中。甚至，由于这样的设计，我
　　们现在已经可以直接把呈现从 TGraphic 中剥离出来，比如，我们可以直接创建一个 VCL
　　形式的 DirectX 呈现，几乎花不了几行代码。 
　　来自：小雨哥, 时间：2007-12-26 1:10:01, ID：3862822
　　为了把帖子玩个够，索性我再继续上面已经扯远的关于呈现的话题吧。
　　下面我将定义一个继承自 TCanvas 的特殊的画布对象，这个对象可以呈现所有继承自 TGraphic
　　的对象，像 TBitmap 、TTJPEGImage 、TPngObject 等等，都可以通过它来呈现。而这个
　　TCanvas 类的特殊点是：它不再是一个 Windows GDI 对象，而是一个 DirectX 对象，让
　　我们一起来见识见识在 Delphi 的 VCL 架构下，封装一个绘图引擎需要几行代码。
　　首先声明这个类：
　　type
　　TDirectCanvas = class(TCanvas)
　　private
　　DDS : IDirectDrawSurface7;
　　protected
　　procedure Changed; override;
　　procedure CreateHandle; override;
　　public
　　constructor Create(pDD: IDirectDraw7; pddsd: TDDSurfaceDesc2);
　　destructor Destroy; override;
　　property Surface: IDirectDrawSurface7 read DDS;
　　end;
　　如果以上代码也算是代码的话，这大概只能算 6 行代码，甚至更少。
　　再来看看实现：
　　procedure TDirectCanvas.Changed;
　　begin
　　if Handle  0 then DDS.ReleaseDC(Handle);
　　Handle := 0;
　　inherited Changed;
　　end;
　　constructor TDirectCanvas.Create(pDD: IDirectDraw7; pddsd: TDDSurfaceDesc2);
　　begin
　　if pDD  nil then
　　begin
　　if pDD.CreateSurface(pddsd, DDS, nil)  DD_OK then
　　raise EInvalidOperation.Create('CreateSurface Faile');
　　end
　　else raise EInvalidOperation.Create('Invalid IDirectDraw7');
　　inherited Create;
　　end;
　　procedure TDirectCanvas.CreateHandle;
　　var
　　DC:HDC;
　　begin
　　inherited CreateHandle;
　　Handle := 0;
　　if DDS.GetDC(DC) = S_OK then Handle := DC;
　　end;
　　destructor TDirectCanvas.Destroy;
　　begin
　　DDS := nil;
　　inherited Destroy;
　　end;
　　全部实现代码大概约 12 行，即便加上刚才用来声明类的代码也算的话，也没有超过 20 行。
　　至此，一个绘图引擎在 VCL 支撑下就算完成了。呵呵，非常简单啊。
　　来自：小雨哥, 时间：2007-12-26 1:54:40, ID：3862825
　　使用上面的绘图引擎与使用普通的 VCL TCanvas 没有什么区别，因此，可以使用我们已经
　　非常熟悉的 Canvas 上全部的绘图方法，下面的演示将把一个 TBitmap 图片绘制到窗体上。
　　首先把主要的初始化代码贴出来，演示中，我创建了二块 TDirectCanvas 画布，分别称为
　　PrimaCanvas 和 BackCanvas ，顾名思义就是前台画布和后台画布。所有的绘图工作都在
　　后台画布上操作，绘制完成后再由前台画布显示出来。这个初始化代码如下：
　　procedure TForm1.Initialize;
　　var
　　DDX      : IDirectDraw7;
　　Clipper  : IDirectDrawClipper;
　　ddsd     : TDDSurfaceDesc2;
　　begin
　　DirectDrawCreateEx(nil, DDX, IID_IDirectDraw7, nil);
　　DDX.SetCooperativeLevel(Handle, DDSCL_NORMAL);
　　DDX.CreateClipper(0, Clipper, nil);
　　Clipper.SetHWnd(0, Handle);
　　FillChar(ddsd, sizeof(ddsd),0);
　　ddsd.dwSize         := sizeof(ddsd);
　　ddsd.dwFlags        := DDSD_CAPS;
　　ddsd.ddsCaps.dwCaps := DDSCAPS_PRIMARYSURFACE;
　　PrimaCanvas := TDirectCanvas.Create(DDX,ddsd);
　　PrimaCanvas.Surface.SetClipper(Clipper);
　　ddsd.dwFlags        := DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT;
　　ddsd.ddsCaps.dwCaps := DDSCAPS_SYSTEMMEMORY;
　　ddsd.dwWidth        := Bmp.Width;
　　ddsd.dwHeight       := Bmp.Height;
　　BackCanvas := TDirectCanvas.Create(DDX,ddsd);
　　BackCanvas.Draw(0,0,Bmp);
　　Clipper := nil;
　　DDX := nil;
　　end;
　　在创建后台画布的时候，我把它的宽和高与将要显示的 Bitmap 设计得一样，无非是偷懒而
　　已，实际可以根据需要进行处理。也因为这个原因，我为了在这个函数调用时可以使用位图，
　　所以，这个位图要先于这个函数创建好，我把它放在了窗体的创建过程中完成：
　　procedure TForm1.FormCreate(Sender: TObject);
　　begin
　　strBmp := '1280X720.bmp';
　　Bmp:=TBitmap.Create;
　　if FileExists(strBmp) then
　　Bmp.LoadFromFile(strBmp)
　　else
　　begin
　　Bmp.Width :=Width;
　　Bmp.Height:=Height;
　　end;
　　Width := Bmp.Width;
　　Height:= Bmp.Height;
　　Initialize;
　　end;
　　好了，接下来只要在窗体重绘事件里把后台画布上的内容画到前台画布就可以了：
　　procedure TForm1.FormPaint(Sender: TObject);
　　var
　　pt:TPoint;
　　R :TRect;
　　begin
　　if PrimaCanvas  nil then
　　begin
　　pt := ClientOrigin;
　　SetRect(R,pt.x,pt.y,pt.x + Width,pt.y + Height);
　　PrimaCanvas.Surface.Blt(@R, BackCanvas.Surface,nil,DDBLT_WAIT,nil);
　　end;
　　end;
　　因为窗口是可以随意缩放的，为让效果看起来好一点，在窗口尺寸变化的时候，最好做个画
　　面刷新动作如下：
　　procedure TForm1.FormResize(Sender: TObject);
　　begin
　　Invalidate;
　　end;
　　所有的画图程序，如果直接画在 Windows 管理的地方，都要注意小心不要让 Windows 来刷
　　新背景，所以我截断了背景刷新的消息，禁止 Windows 刷新背景：
　　// 函数声明：procedure WMEraseBkgnd(var Msg: TWmEraseBkgnd); message WM_ERASEBKGND;
　　procedure TForm1.WMEraseBkgnd(var Msg: TWmEraseBkgnd);
　　begin
　　Msg.Result:=1;
　　end;
　　最后，当程序结束的时候，也要像普通程序那样，把内存清干净：
　　procedure TForm1.FormDestroy(Sender: TObject);
　　begin
　　Bmp.Free;
　　PrimaCanvas.Free;
　　BackCanvas.Free;
　　end; 
　　来自：小雨哥, 时间：2007-12-26 2:01:28, ID：3862826
　　因为上面的代码涉及到了 DirectX 的内容，所以一定不要忘了添加 DirectDraw.pas 单元
　　的引用。
　　上面的代码会显示你提供的位图，假如我们要写几个文字，也相当简单：
　　procedure TForm1.TextOut(x,y:integer;Text: WideString);
　　begin
　　BackCanvas.Font.Name:='隶书';
　　BackCanvas.Font.Size:=46;
　　BackCanvas.Font.Style:=[fsBold];
　　BackCanvas.Font.Color:=clRed;
　　SetBkMode(BackCanvas.Handle,TRANSPARENT);
　　BackCanvas.TextOut(x,y,Text);
　　end;
　　把这个函数嵌到合适的位置即可：
　　procedure TForm1.FormPaint(Sender: TObject);
　　var
　　pt:TPoint;
　　R :TRect;
　　begin
　　if PrimaCanvas  nil then
　　begin
　　pt := ClientOrigin;
　　SetRect(R,pt.x,pt.y,pt.x + Width,pt.y + Height);
　　TextOut(0,0,'写点文字看看');        // Msg - Optional text describing in one or two words what the graphic
　　class is currently working on.  Ex:  "Loading" "Storing"
　　"Reducing colors".  The Msg string can also be empty.
　　Msg strings should be resourced for translation,  should not
　　contain trailing periods, and should be used only for
　　display purposes.  (do not: if Msg = 'Loading' then...)
　　简单的提示信息表示图形当前的工作状态。
　　}
　　TProgressStage = (psStarting, psRunning, psEnding); // 处理状态：开始，运行，结束
　　TProgressEvent = procedure (Sender: TObject; Stage: TProgressStage;
　　PercentDone: Byte; RedrawNow: Boolean; const R: TRect; const Msg: string) of object;
　　{ The TGraphic class is a abstract base class for dealing with graphic images
　　such as metafile, bitmaps, icons, and other image formats.
　　TGraphic 类是图像图像的抽象基类，比如 metafile, bitmaps, icons 等等。
　　LoadFromFile - Read the graphic from the file system.  The old contents of
　　the graphic are lost.  If the file is not of the right format, an
　　exception will be generated.
　　LoadFromFile - 从文件系统读取新图形，其旧内容将丢失。
　　如果文件不是一个合法的图形格式，将产生意外。
　　SaveToFile - Writes the graphic to disk in the file provided.
　　将图形写到磁盘
　　LoadFromStream - Like LoadFromFile except source is a stream (e.g.
　　TBlobStream).
　　与 LoadFromFile 类似，只是源文件是一个流
　　SaveToStream - stream analogue of SaveToFile.
　　与 SaveToFile 类似
　　LoadFromClipboardFormat - Replaces the current image with the data
　　provided.  If the TGraphic does not support that format it will generate
　　an exception.
　　用提供的数据替换当前的图像。如果 TGraphic 不支持这个格式将产生意外。
　　SaveToClipboardFormats - Converts the image to a clipboard format.  If the
　　image does not support being translated into a clipboard format it
　　will generate an exception.
　　将图像转换为粘贴板格式。如果图像不能被转换为粘贴板格式将产生意外。
　　Height - The native, unstretched, height of the graphic.
　　原始的，没有扩展的图形高度
　　Palette - Color palette of image.  Zero if graphic doesn't need/use palettes.
　　图像的颜色面板。如果图形不需要则为 0
　　Transparent - Image does not completely cover its rectangular area
　　图像不能完全覆盖它的矩形区域
　　Width - The native, unstretched, width of the graphic.
　　原始的，没有扩展的图形宽度
　　OnChange - Called whenever the graphic changes
　　当图形改变时调用。
　　PaletteModified - Indicates in OnChange whether color palette has changed.
　　Stays true until whoever's responsible for realizing this new palette
　　(ex: TImage) sets it to False.
　　当颜色面板改变了则触发 OnChange.
　　直到不再改变新面板才会 False.(比如 TImage)
　　OnProgress - Generic progress indicator event. Propagates out to TPicture
　　and TImage OnProgress events.
　　过程处理事件。 传播到 TPicture 和 TImage
　　}
　　TGraphic = class(TInterfacedPersistent, IStreamPersist)
　　private
　　FOnChange: TNotifyEvent; // 改变
　　FOnProgress: TProgressEvent; // 处理
　　FModified: Boolean; // 修改
　　FTransparent: Boolean; // 透明
　　FPaletteModified: Boolean; // 面板修改
　　procedure SetModified(Value: Boolean); // 设置修改
　　protected
　　procedure Changed(Sender: TObject); virtual; // 改变
　　procedure DefineProperties(Filer: TFiler); override; // 定义属性
　　procedure Draw(ACanvas: TCanvas; const Rect: TRect); virtual; abstract; // VA 画
　　function Equals(Graphic: TGraphic): Boolean; virtual; // 图形是否相等
　　function GetEmpty: Boolean; virtual; abstract; // VA 是否空
　　function GetHeight: Integer; virtual; abstract; // VA 得到高度
　　function GetPalette: HPALETTE; virtual; // 得到面板
　　function GetTransparent: Boolean; virtual; // 得到是否透明
　　function GetWidth: Integer; virtual; abstract; // VA 得到宽度
　　procedure Progress(Sender: TObject; Stage: TProgressStage; // 处理进度
　　PercentDone: Byte;  RedrawNow: Boolean; const R: TRect; const Msg: string); dynamic;
　　procedure ReadData(Stream: TStream); virtual; // 读数据
　　procedure SetHeight(Value: Integer); virtual; abstract; // VA 设置高度
　　procedure SetPalette(Value: HPALETTE); virtual; // 设置面板
　　procedure SetTransparent(Value: Boolean); virtual; // 设置透明
　　procedure SetWidth(Value: Integer); virtual; abstract; // VA 设置宽度
　　procedure WriteData(Stream: TStream); virtual; // 写数据
　　public
　　constructor Create; virtual; // 创建
　　procedure LoadFromFile(const Filename: string); virtual; // 从文件装载
　　procedure SaveToFile(const Filename: string); virtual; // 保存到文件
　　procedure LoadFromStream(Stream: TStream); virtual; abstract; // VA 从流装载
　　procedure SaveToStream(Stream: TStream); virtual; abstract; // VA 保存到流
　　procedure LoadFromClipboardFormat(AFormat: Word; AData: THandle;
　　APalette: HPALETTE); virtual; abstract; // 从粘贴板装载
　　procedure SaveToClipboardFormat(var AFormat: Word; var AData: THandle;
　　var APalette: HPALETTE); virtual; abstract; // 保存到粘贴板
　　property Empty: Boolean read GetEmpty; // 是否空
　　property Height: Integer read GetHeight write SetHeight; // 高
　　property Modified: Boolean read FModified write SetModified; // 修改
　　property Palette: HPALETTE read GetPalette write SetPalette; // 调色板
　　property PaletteModified: Boolean read FPaletteModified write FPaletteModified; // 调色板被修改
　　property Transparent: Boolean read GetTransparent write SetTransparent; // 透明
　　property Width: Integer read GetWidth write SetWidth; // 宽
　　property OnChange: TNotifyEvent read FOnChange write FOnChange; // 改变通知
　　property OnProgress: TProgressEvent read FOnProgress write FOnProgress; // 进度事件
　　end;
　　{ TGraphic }
　　constructor TGraphic.Create;
　　begin                 // This stub is required for C++ compatibility.
　　inherited Create;   // C++ doesn't support abstract virtual constructors.
　　// 这一块需要 C++ 兼容
　　// C++ 不支持纯虚构造函数
　　end;
　　// 图形改变
　　procedure TGraphic.Changed(Sender: TObject);
　　begin
　　FModified := True;
　　if Assigned(FOnChange) then FOnChange(Self);
　　end;
　　// 定义数据属性
　　procedure TGraphic.DefineProperties(Filer: TFiler);
　　function DoWrite: Boolean;
　　begin
　　if Filer.Ancestor  nil then
　　Result := not (Filer.Ancestor is TGraphic) or
　　not Equals(TGraphic(Filer.Ancestor))
　　else
　　Result := not Empty;
　　end;
　　begin
　　Filer.DefineBinaryProperty('Data', ReadData, WriteData, DoWrite);
　　end;
　　// 图形是否相等
　　function TGraphic.Equals(Graphic: TGraphic): Boolean;
　　var
　　MyImage, GraphicsImage: TMemoryStream;
　　begin
　　Result := (Graphic  nil) and (ClassType = Graphic.ClassType); // 首先判断类型
　　if Empty or Graphic.Empty then
　　begin
　　Result := Empty and Graphic.Empty;
　　Exit;
　　end;
　　if Result then
　　begin
　　MyImage := TMemoryStream.Create;
　　try
　　WriteData(MyImage); // 保存数据
　　GraphicsImage := TMemoryStream.Create;
　　try
　　Graphic.WriteData(GraphicsImage);
　　Result := (MyImage.Size = GraphicsImage.Size) and  // 大小判断
　　CompareMem(MyImage.Memory, GraphicsImage.Memory, MyImage.Size); // 内存比较
　　finally
　　GraphicsImage.Free;
　　end;
　　finally
　　MyImage.Free;
　　end;
　　end;
　　end;
　　function TGraphic.GetPalette: HPALETTE;
　　begin
　　Result := 0;
　　end;
　　function TGraphic.GetTransparent: Boolean;
　　begin
　　Result := FTransparent;
　　end;
　　procedure TGraphic.LoadFromFile(const Filename: string);
　　var
　　Stream: TStream;
　　begin
　　Stream := TFileStream.Create(Filename, fmOpenRead or fmShareDenyWrite);
　　try
　　LoadFromStream(Stream);
　　finally
　　Stream.Free;
　　end;
　　end;
　　// 进度处理
　　procedure TGraphic.Progress(Sender: TObject; Stage: TProgressStage;
　　PercentDone: Byte; RedrawNow: Boolean; const R: TRect; const Msg: string);
　　begin
　　if Assigned(FOnProgress) then
　　FOnProgress(Sender, Stage, PercentDone, RedrawNow, R, Msg);
　　end;
　　procedure TGraphic.ReadData(Stream: TStream);
　　begin
　　LoadFromStream(Stream);
　　end;
　　procedure TGraphic.SaveToFile(const Filename: string);
　　var
　　Stream: TStream;
　　begin
　　Stream := TFileStream.Create(Filename, fmCreate);
　　try
　　SaveToStream(Stream);
　　finally
　　Stream.Free;
　　end;
　　end;
　　procedure TGraphic.SetPalette(Value: HPalette);
　　begin
　　end;
　　procedure TGraphic.SetModified(Value: Boolean);
　　begin
　　if Value then
　　Changed(Self)
　　else
　　FModified := False;
　　end;
　　procedure TGraphic.SetTransparent(Value: Boolean);
　　begin
　　if Value  FTransparent then
　　begin
　　FTransparent := Value;
　　Changed(Self);
　　end;
　　end;
　　procedure TGraphic.WriteData(Stream: TStream);
　　begin
　　SaveToStream(Stream);
　　end;
　　来自：Corn3, 时间：2008-1-14 9:23:29, ID：3867164
　　真正的好帖。
　　期待小雨哥的其他大作 
　　来自：smlabc, 时间：2009-1-22 13:23:25, ID：3940953
　　Draw( Dest:TGraphic; DR:TRect )?
　　在一个图象上画一个图象?为什么不是在一个对象上画呢?
　　Draw(Dest:TObject; DR:TRect )?