上一篇 | 下一篇

一个简单的显示和存放JPEG图形的控件

发布: 2008-6-26 17:18 | 作者: admin | 来源: | 查看: 0次

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

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 = '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.delphibbs.com)

字号: | 推荐给好友

评分:0

我来说两句