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.q3060.com |