Delphi知识中心
www.delphi.ee
提供Delphi技术知识
与Delphi程序员共同进步


在线服务QQ:99923144 随时恭候您的光临
首页 基础知识 WIN系统 组件使用 组件开发 数据库 ACTIVEX 多媒体技术 网络技术 关于
文章类别:组件开发    你尚未登陆,会员功能无法使用,请从 网站首页 登陆。
  简单的显示和存放JPEG图形的控件  
 
一个简单的显示和存放JPEG图形的控件

很久以前写的,今天正好看到有人需要,就贴出来了。

unit JPGDBImage;

interface

uses Classes, DBCtrls, Controls, Graphics, JPEG, DB;

type
TJPGDBImage = class(TDBImage)
public
constructor Create(AOwner: TComponent); override;
end;

implementation

type
TGraphicHeader = record
Count: Word; { Fixed at 1 }
HType: Word; { Fixed at $0100 }
Size: Longint; { Size not including header }
end;

TDBPicture = class(TPicture)
public
procedure Assign(Source: TPersistent); override;
end;

{$HINTS OFF}
THackDBImage = class(TCustomControl)
private
FDataLink: TFieldDataLink;
FPicture: TPicture;
end;
{$HINTS ON}

procedure TDBPicture.Assign(Source: TPersistent);
var
BlobStream: TStream;
BMPTag: array [0..1] of Char;
AJPG: TJPEGImage;
Size, SavePos: Integer;
Header: TGraphicHeader;
begin
if (Source is TField) and (TField(Source).IsBlob) and not TField(Source).IsNull then
begin
BlobStream := TField(Source).DataSet.CreateBlobStream(TField(Source), bmRead);
try
Size := BlobStream.Size;
if Size >= SizeOf(TGraphicHeader) then
begin
BlobStream.Read(Header, SizeOf(Header));
if (Header.Count <> 1) or (Header.HType <> $0100) or
(Header.Size <> Size - SizeOf(Header)) then
BlobStream.Position := 0;
end;
SavePos := BlobStream.Position;
BlobStream.Read(BMPTag, 2);
BlobStream.Position := SavePos;
if (BMPTag[0] = 'B') and (BMPTag[1] = 'M') then
LoadFromStream(BlobStream)
else
begin
AJPG := TJPEGImage.Create;
try
AJPG.LoadFromStream(BlobStream);
inherited Assign(AJPG);
finally
AJPG.Free;
end;
end;
finally
BlobStream.Free;
end;
end
else
inherited;
end;

constructor TJPGDBImage.Create(AOwner: TComponent);
var
ADBPicture: TDBPicture;
begin
inherited;

ADBPicture := TDBPicture.Create;
ADBPicture.OnChange := THackDBImage(Self).FPicture.OnChange;
THackDBImage(Self).FPicture.Free;
THackDBImage(Self).FPicture := ADBPicture;
end;

end.

 

在线服务QQ:99923144 Delphi程序员QQ群(139442)
Delphi知识中心 www.delphi.ee 最专业的Delphi技术资料网站