Delphi中如何编写图像解析组件

　2006-02-04 13:39:24　来源：WEB开发网　　　

核心提示： Delphi中如何编写图像解析组件Delphi作为一个强大的RAD开发工具，在应用软件的开发方面一直有着它的独特优势，Delphi中如何编写图像解析组件，这种优势同样体现在图像相关软件的开发上，如果你要在桌面上放置一张图像，} procedure TRASGraphic.SaveToStream(Stream: TS

Delphi中如何编写图像解析组件

Delphi作为一个强大的RAD开发工具，在应用软件的开发方面一直有着它的独特优势。这种优势同样体现在图像相关软件的开发上。如果你要在桌面上放置一张图像，只需要简单的在桌面上放置一个Image控件，然后就可以通过其Image属性任意的加载BMP、WMF、EMF等格式的图像。如果还想增加对JPEG的支持，只需要添加一个JPEG单元即可。甚至在Image中加载一张JPEG后，Delphi会自动添加一个JPEG单元。一切做起来就是这么的简单。基本格式都已经封装在了VCL中，那么Delphi对类似JPEG这样图像格式的支持是如何实现的呢？

其实从TPicture中很容易看出其中的实现过程，它可以理解为所有图像对象的容器。

如JPEG.pas中有如下两句代码:

TPicture.RegisterFileFormat('jpeg', sJPEGImageFile, TJPEGImage);
TPicture.RegisterFileFormat('jpg', sJPEGImageFile, TJPEGImage);

(sJPEGImageFile = 'JPEG Image File'，见JConsts.pas)

什么意思呢？可以理解为将TJPEGImage注册为jpeg、jpg两种后缀图像文件的类。

其实质就是将后缀，图像描述，具体图像解析类等信息保存到了FileFormats。

具体见如下代码：

var FileFormats: TFileFormatsList = nil;

class PRocedure TPicture.RegisterFileFormat(const AExtension,
ADescription: string; AGraphicClass: TGraphicClass);
begin
GetFileFormats.Add(AExtension, ADescription, 0, AGraphicClass);
end;

function GetFileFormats: TFileFormatsList;
begin
if FileFormats = nil then FileFormats := TFileFormatsList.Create;
Result := FileFormats;
end;

而TPicture默认支持四种图像格式是因为TFileFormatsList的构造函数中已进行了添加。

constructor TFileFormatsList.Create;
begin
inherited Create;
Add('wmf', SVMetafiles, 0, TMetafile);
Add('emf', SVEnhMetafiles, 0, TMetafile);
Add('ico', SVIcons, 0, TIcon);
Add('bmp', SVBitmaps, 0, TBitmap);
end;

也正是通过FileFormats中保存的信息，控件OpenPictureDialog中自动生成了所支持文件类型的列表。

那么该如何编写这些图像解析类呢？

TGraphic是TBitmap、TIcon、TMetafile对象的基类。同样这里的图像解析类也应该从TGraphic派生，利用很多VCL中已经封装了的代码，可以省去很多工作。

实现基本功能一般只需要重载三个成员：

TXXXImage = class(TGraphic)
protected
procedure Draw(ACanvas: TCanvas; const Rect: TRect); override;//绘制图像到画布
public
procedure LoadFromStream(Stream: TStream); override; //从流中获取图像数据
procedure SaveToStream(Stream: TStream); override; //将图像数据写入流中
end;

因为TGraphic.LoadFromFile/TGraphic.SaveToFile中已经实现了由文件名读取数据到流的/将流中的数据写入到对应文件的功能，无特殊需要这里可以不用重载。而成员Draw自然就是用于实现将图像绘制到画布，由于TCanvas对GDI的完善封装，这里不需要考虑如何将图像利用GDI绘制到窗体的这个过程。剩下的就只是编写图像解析部分的代码啦。

下面就以RAS格式为例做进一步的探讨。

这里没有用TGraphic作为基类，而是用了TBitmap，这样进一步把Draw的实现过程都省了，只需要在LoadFromStream中实现转化为位图的过程就可以了。

type

TRASGraphic = class(TBitmap)
public
procedure LoadFromStream(Stream: TStream); override;
procedure SaveToStream(Stream: TStream); override;
end;

//定义描述RAS文件头的记录类型
TRASHeader = packed record
Magic,　　　　　　　 //标记
Width,　　　　　　　 //宽
Height,　　　　　　 //高
Depth,　　　　　　　 //色深
Length,　　　　　　 //图像数据长度，可能会等于0
RasType,　　　　　　 //格式类型
MapType,　　　　　　 //调色板类型
MapLength: Cardinal; //调色板数据长度
end;

//定义一个用来描述RAS文件头的记录类型是非常必要的

const

//定义代表RAS所有类型的常量
RT_OLD = 0;
RT_STANDARD = 1;
RT_BYTE_ENCODED = 2;
RT_FORMAT_RGB = 3;
RT_FORMAT_TIFF = 4;
RT_FORMAT_IFF = 5;
RT_EXPERIMENTAL = $FFFF;

//定义代表调色板类型的常量
RMT_NONE = 0;//无调色板数据
RMT_EQUAL_RGB = 1;
RMT_RAW = 2;

{如果RAS的格式为RT_OLD，数据长度可能为0}

function SwapLong(const Value: Cardinal): Cardinal;
asm
BSWAP EAX//调用字节交换指令
end;

//抛出异常，参数为具体的异常信息
procedure RasError(const ErrorString: String);
begin
raise EInvalidGraphic.Create(ErrorString);
end;

{下面是实现部分的代码。}

procedure TRASGraphic.LoadFromStream(Stream: TStream);
var
Header: TRASHeader;
Row8: PByte;
Row24: PRGBTriple;
Row32: PRGBQuad;
PMap: PByte;
Y: Integer;
I: Integer;
MapReaded: Boolean;
Pal: TMaxLogPalette;
R,G,B:array[0..255] of Byte;
ColorByte: Byte;
begin
with Stream do
begin
ReadBuffer(Header, SizeOf(Header)); //将文件头数据读取到记录Header中
with Header do
begin
　 Width := SwapLong(Width);
　 Height := SwapLong(Height);
　 Depth := SwapLong(Depth);
　 Length := SwapLong(Length);
　 RASType := SwapLong(RASType);
　 MapType := SwapLong(MapType);
　 MapLength := SwapLong(MapLength);
end;
//由于读取数据的顺序问题，这里需要调用上面的SwapLong改变顺序。
if (Header.Magic = $956AA659) and
(Header.Width<>0) and (Header.Height<>0) and
(Header.Depth in [1,8,24,32]) and (Header.RasType in [RT_OLD,RT_STANDARD,RT_BYTE_ENCODED,RT_FORMAT_RGB]) then
begin
　 Width := Header.Width;
　 Height := Header.Height;
　 MapReaded := False;

　 case Header.Depth of
　　 1:PixelFormat := pf1Bit;
　　 8:
　　 begin
　　　 PixelFormat := pf8Bit;

　 case Header.MapType of
　　　　 RMT_NONE:
　　　　 begin
　　　　　 Pal.palVersion:=$300;
　　　　　 Pal.palNumEntries:=256;
　　　　　 for I := 0 to 255 do
　　　　　 begin
　　　　　　 Pal.palPalEntry[I].peRed:=I;
　　　　　　 Pal.palPalEntry[I].peGreen:=I;
　　　　　　 Pal.palPalEntry[I].peBlue:=I;
　　　　　　 Pal.palPalEntry[I].peFlags:=0;
　　　　　 end;
　　　　　 Palette := CreatePalette(PLogPalette(@Pal)^);
　　　　　 //当图像色深为8位，而又不存在调色板信息时，创建一个8位的灰度调色板
　　　　 end;
　　　　 RMT_EQUAL_RGB:
　　　　 begin
　　　　　 if (Header.MapLength = 3*256) then
　　　　　 begin
　　　　　　 Pal.palVersion:=$300;
　　　　　　 Pal.palNumEntries:=256;
　　　　　　 ReadBuffer(R,256);
　　　　　　 ReadBuffer(G,256);
　　　　　　 ReadBuffer(B,256);
　　　　　　 for I := 0 to 255 do
　　　　　　 begin
　　　　　　　 Pal.palPalEntry[I].peRed:=R[I];
　　　　　　　 Pal.palPalEntry[I].peGreen:=G[I];
　　　　　　　 Pal.palPalEntry[I].peBlue:=B[I];
　　　　　　　 Pal.palPalEntry[I].peFlags:=0;
　　　　　　 end;
　　　　　　 Palette := CreatePalette(PLogPalette(@Pal)^);
　　　　　　 //读取文件中的调色板信息
　　　　　　 //相关调色板操作的API请查询MSDN
　　　　　 end
　　　　　 else
　　　　　　 RasError('调色板长度错误！');
　　　　　 MapReaded := True;
　　　　 end;
　　　　 RMT_RAW:
　　　　 begin
　　　　　 RasError('不支持的文件格式！');
　　　　 end;
　　　 end;
　　 end;
　　 24:PixelFormat := pf24Bit;
　　 32:
　　 begin
　　　 PixelFormat := pf32Bit;
　　　 //
　　 end;
　 end;

　 if (not MapReaded) and (Header.MapLength>0) then
　 begin
　　 Position := Position + Header.MapLength;
　 end;
　 //如果调色板长度不为0，而又未正确读取相关信息时，跳过这一段数据

　 case Header.Depth of
　　 8:
　　 begin
　　　 if Header.RasType = RT_BYTE_ENCODED then
　　　 begin
　　　　 //ENCODE
　　　　 //关于RLE压缩的编码解码请自行查阅资料
　　　　 RasError('不支持压缩格式！');
　　　 end
　　　 else
　　　 begin
　　　　 for Y := 0 to Height-1 do
　　　　 begin
　　　　　 Row8:=ScanLine[Y];
　　　　　 ReadBuffer(Row8^,Width);
　　　　　 if (Width mod 2)=1 then
　　　　　 begin
　　　　　　　 Position := Position + 1;
　　　　　 end;
　　　　 end;
　　　 end;
　　 end;{end of 8Bit}
　　 24:
　　 begin
　　　 case Header.RasType of
　　　　 RT_OLD,
　　　　 RT_STANDARD:
　　　　 begin
　　　　　 for Y := 0 to Height-1 do
　　　　　 begin
　　　　　　 Row24:=ScanLine[Y];
　　　　　　 ReadBuffer(Row24^,Width*3);
　　　　　　 if (Width mod 2)=1 then
　　　　　　 begin
　　　　　　　　 Position := Position + 1;
　　　　　　 end;
　　　　　 end;
　　　　 end;
　　　　 RT_BYTE_ENCODED:
　　　　 begin
　　　　　 //ENCODE
　　　　　 //关于RLE压缩的编码解码请自行查阅资料
　　　　　 RasError('不支持压缩格式！');
　　　　 end;
　　　　 RT_FORMAT_RGB:
　　　　 begin
　　　　　 for Y := 0 to Height-1 do
　　　　　 begin
　　　　　　 Row24:=ScanLine[Y];
　　　　　　 ReadBuffer(Row24^,Width*3);
　　　　　　 for I := 0 to Width-1 do
　　　　　　 begin
　　　　　　　 ColorByte := Row24^.rgbtRed;
　　　　　　　 Row24^.rgbtRed := Row24^.rgbtBlue;
　　　　　　　 Row24^.rgbtBlue := ColorByte;
　　　　　　　 Inc(Row24);
　　　　　　 end;
　　　　　　 //当为RT_FORMAT_RGB格式时，按RGB获取数据，这里需要交换R和B的值
　　　　　　 if (Width mod 2)=1 then
　　　　　　 begin
　　　　　　　　 Position := Position + 1;
　　　　　　 end;
　　　　　 end;
　　　　 end;{end of RT_FORMAT_RGB}
　　　　 else
　　　　　 RasError('不支持的文件格式！');
　　　 end;
　　 end;{end of 24Bit}
　　 32:
　　 begin
　　　 case Header.RasType of
　　　　 RT_OLD,
　　　　 RT_STANDARD:
　　　　 begin
　　　　　 for Y := 0 to Height-1 do
　　　　　 begin
　　　　　　 Row32:=ScanLine[Y];
　　　　　　 ReadBuffer(Row32^,Width*4);
　　　　　　 for I := 0 to Width-1 do
　　　　　　 begin
　　　　　　　 ColorByte := Row32^.rgbReserved;
　　　　　　　 Row32^.rgbReserved := Row32^.rgbBlue;
　　　　　　　 Row32^.rgbBlue := Row32^.rgbGreen;
　　　　　　　 Row32^.rgbGreen := Row32^.rgbRed;
　　　　　　　 Row32^.rgbRed := ColorByte;
　　　　　　　 Inc(Row32);
　　　　　　 end;
　　　　　　 //32位色时，需要调整读取后数据的顺序
　　　　　 end;
　　　　 end;
　　　　 RT_BYTE_ENCODED:
　　　　 begin
　　　　　 //ENCODE
　　　　　 //关于RLE压缩的编码解码请自行查阅资料
　　　　　 RasError('不支持压缩格式！');
　　　　 end;
　　　　 RT_FORMAT_RGB:
　　　　 begin
　　　　　 For Y := 0 to Height-1 do
　　　　　 begin
　　　　　　 Row32:=ScanLine[Y];
　　　　　　 ReadBuffer(Row32^,Width*4);
　　　　　　 for I := 0 to Width-1 do
　　　　　　 begin
　　　　　　　 ColorByte := Row32^.rgbBlue;
　　　　　　　 Row32^.rgbBlue := Row32^.rgbReserved;
　　　　　　　 Row32^.rgbReserved := ColorByte;
　　　　　　　 ColorByte := Row32^.rgbGreen;
　　　　　　　 Row32^.rgbGreen := Row32^.rgbRed;
　　　　　　　 Row32^.rgbRed := ColorByte;
　　　　　　　 Inc(Row32);
　　　　　　 end;
　　　　　　 //这里将顺序调整和R和B值的交换的代码进行了合并
　　　　　 end;
　　　　 end;{end of RT_FORMAT_RGB}
　　　　 else
　　　　　 RasError('不支持的文件格式！');
　　　 end;{end of 32Bit}

end;
　　 else
　　 begin
　　　 FreeImage;
　　　 RasError('不支持的文件格式！');
　　 end;
　 end;
end
else
　 RasError('不支持的文件格式！');

end;{end with}
end;

{上面的代码中多次出现如下代码：
if (Width mod 2)=1 then
begin
Position := Position + 1;
end;
这是因为每行的数据都要按字对齐，既每行的数据都要用偶数的字节记录。当每个像素的颜色信息用1字节(8位)或3字节(24位)记录且每行像素数为奇数时，要补齐一个字节。所以这里跳过一个字节。
后面代码中的
if (Width mod 2) = 1 then
begin
FillByte:=0;
Stream.Write(FillByte,1);
end;
也是基于同一道理。}

procedure TRASGraphic.SaveToStream(Stream: TStream);
var
Header: TRASHeader;
Row8: PByte;
Row24: PRGBTriple;
Row32: PRGBQuad;
FillByte: Byte;
Y: Integer;
I: Integer;
Pal: TMaxLogPalette;
R,G,B:array[0..255] of Byte;
begin
Header.Magic := $956AA659;
Header.Width := SwapLong(Width);
Header.Height := SwapLong(Height);
Header.RasType := SwapLong(RT_STANDARD);
if (PixelFormat = pf1bit) or (PixelFormat = pf4bit) then
PixelFormat:=pf8bit
else if (PixelFormat <> pf8bit) and (PixelFormat <> pf24bit) and (PixelFormat <> pf32bit) then
PixelFormat:=pf24bit;
case PixelFormat of
pf8bit:
begin
　 Header.Length := SwapLong(Height*(Width+(Width mod 2)));
　 Header.Depth := SwapLong(8);
　 Header.MapType := SwapLong(RMT_EQUAL_RGB);
　 Header.MapLength := SwapLong(3*256);
　 Stream.WriteBuffer(Header,SizeOf(Header));
　 GetPaletteEntries(Palette, 0, 256, Pal.palPalEntry);
　 for I := 0 to 255 do
　 begin
　　 R[I]:=Pal.palPalEntry[I].peRed;
　　 G[I]:=Pal.palPalEntry[I].peGreen;
　　 B[I]:=Pal.palPalEntry[I].peBlue;
　 end;
　 //相关调色板操作的API请查询MSDN
　 Stream.WriteBuffer(R,256);
　 Stream.WriteBuffer(G,256);
　 Stream.WriteBuffer(B,256);
　 for Y := 0 to Height-1 do
　 begin
　　 Row8 := ScanLine[Y];
　　 Stream.WriteBuffer(Row8^,Width);
　　 if (Width mod 2) = 1 then
　　 begin
　　　 FillByte:=0;
　　　 Stream.Write(FillByte,1);
　　 end;
　 end;
end;
pf32bit:
begin
　 Header.Length := SwapLong(Height*Width*4);
　 Header.Depth := SwapLong(32);
　 Header.MapType := SwapLong(RMT_NONE);
　 Header.MapLength := 0;
　 Stream.WriteBuffer(Header,SizeOf(Header));
　 for Y := 0 to Height-1 do
　 begin
　　 Row32 := ScanLine[Y];
　　 for I := 0 to Width-1 do
　　 begin
　　　 Stream.WriteBuffer(Row32.rgbReserved,1);
　　　 Stream.WriteBuffer(Row32^,3);
　　　 Inc(Row32);
　　 end;
　 end;
end;
else
begin
　 Header.Length := SwapLong(Height*Width*3);
　 Header.Depth := SwapLong(24);
　 Header.MapType := SwapLong(RMT_NONE);
　 Header.MapLength := 0;
　 Stream.WriteBuffer(Header,SizeOf(Header));
　 for Y := 0 to Height-1 do
　 begin
　　 Row24 := ScanLine[Y];
　　 Stream.WriteBuffer(Row24^,Width*3);
　　 if (Width mod 2) = 1 then
　　 begin
　　　 FillByte:=0;
　　　 Stream.Write(FillByte,1);
　　 end;　　
　 end;
end;
end;
//SaveToStream基本上就是LoadFromStream的逆过程。