一个简单的显示和存放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.