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.
// www.
|
