How to write image parsing component in Delphi
As a powerful RAD development tool, Delphi has always had its unique advantages in application software development. This advantage is also reflected in the development of image-related software. If you want to place an image on the desktop, you only need to simply place an Image control on the desktop, and then you can arbitrarily load images in BMP, WMF, EMF and other formats through its Image property. If you also want to add support for JPEG, you only need to add a JPEG unit. Even after loading a JPEG in Image, Delphi will automatically add a JPEG unit. Everything is so simple to do. The basic formats have been encapsulated in VCL, so how does Delphi implement support for image formats like JPEG?
In fact, it is easy to see the implementation process from TPicture, which can be understood as a container for all image objects.
For example, there are the following two lines of code in JPEG.pas:
TPicture.RegisterFileFormat('jpeg', sJPEGImageFile, TJPEGImage);
TPicture.RegisterFileFormat('jpg', sJPEGImageFile, TJPEGImage);
(sJPEGImageFile = 'JPEG Image File', see JConsts.pas)
What does it mean? It can be understood as a class that registers TJPEGImage as an image file with two suffixes: jpeg and jpg.
The essence is to save the suffix, image description, specific image analysis class and other information to FileFormats.
See the following code for details:
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 supports four image formats by default because they have been added in the constructor of 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;
It is through the information saved in FileFormats that the control OpenPictureDialog automatically generates a list of supported file types.
So how to write these image parsing classes?
TGraphic is the base class of TBitmap, TIcon, and TMetafile objects. Similarly, the image parsing class here should also be derived from TGraphic. It can save a lot of work by using a lot of code that has been encapsulated in VCL.
To implement basic functions, you generally only need to overload three members:
TXXXImage = class(TGraphic)
protected
procedure Draw(ACanvas: TCanvas; const Rect: TRect); override;//Draw the image to the canvas
public
procedure LoadFromStream(Stream: TStream); override; //Get image data from the stream
procedure SaveToStream(Stream: TStream); override; //Write image data into the stream
end;
Because TGraphic.LoadFromFile/TGraphic.SaveToFile has already implemented the function of reading data from the file name to the stream/writing the data in the stream to the corresponding file, there is no need to overload it without special needs. The member Draw is naturally used to draw images to the canvas. Due to TCanvas' perfect encapsulation of GDI, there is no need to consider the process of how to draw images to the form using GDI. All that's left is to write the code for the image parsing part.
Let's take the RAS format as an example for further discussion.
TGraphic is not used as the base class here, but TBitmap is used. This further saves the implementation process of Draw and only needs to implement the process of converting to bitmap in LoadFromStream.
type
TRASGraphic = class(TBitmap)
public
procedure LoadFromStream(Stream: TStream); override;
procedure SaveToStream(Stream: TStream); override;
end;
//Define the record type describing the RAS file header
TRASHeader = packed record
Magic, //mark
Width, //width
Height, //high
Depth, //color depth
Length, //image data length, may be equal to 0
RasType, //Format type
MapType, //Palette type
MapLength: Cardinal; //Palette data length
end;
//It is very necessary to define a record type used to describe the RAS file header
const
//Define constants representing all types of 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;
//Define constants representing palette types
RMT_NONE = 0; //No palette data
RMT_EQUAL_RGB = 1;
RMT_RAW = 2;
{If the format of RAS is RT_OLD, the data length may be 0}
function SwapLong(const Value: Cardinal): Cardinal;
asm
BSWAP EAX//Call byte exchange instruction
end;
//Throw an exception, the parameter is the specific exception information
procedure RasError(const ErrorString: String);
begin
raise EInvalidGraphic.Create(ErrorString);
end;
{The following is the code for the implementation part. }
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)); //Read the file header data into the record 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;
//Due to the order of reading data, you need to call the above SwapLong to change the order.
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)^);
//When the image color depth is 8 bits and no palette information exists, create an 8-bit grayscale palette
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)^);
//Read the palette information in the file
//For API related palette operations, please check MSDN
end
else
RasError('Palette length is wrong!');
MapReaded := True;
end;
RMT_RAW:
begin
RasError('Unsupported file format!');
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;
//If the palette length is not 0 and the relevant information is not read correctly, skip this piece of data
case Header.Depth of
8:
begin
if Header.RasType = RT_BYTE_ENCODED then
begin
//ENCODE
//Please check the information yourself about the encoding and decoding of RLE compression.
RasError('Compression format not supported!');
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}
twenty four:
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
//Please check the information yourself about the encoding and decoding of RLE compression.
RasError('Compression format not supported!');
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;
//When it is in RT_FORMAT_RGB format, get the data by RGB, here you need to exchange the values of R and B
if (Width mod 2)=1 then
begin
Position := Position + 1;
end;
end;
end;{end of RT_FORMAT_RGB}
else
RasError('Unsupported file format!');
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;
//When using 32-bit color, you need to adjust the order of the data after reading.
end;
end;
RT_BYTE_ENCODED:
begin
//ENCODE
//Please check the information yourself about the encoding and decoding of RLE compression.
RasError('Compression format not supported!');
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;
//The codes for order adjustment and exchange of R and B values are merged here.
end;
end;{end of RT_FORMAT_RGB}
else
RasError('Unsupported file format!');
end;{end of 32Bit}
end;
else
begin
FreeImage;
RasError('Unsupported file format!');
end;
end;
end
else
RasError('Unsupported file format!');
end;{end with}
end;
{The following code appears multiple times in the above code:
if (Width mod 2)=1 then
begin
Position := Position + 1;
end;
This is because the data in each row must be word-aligned, that is, the data in each row must be recorded with an even number of bytes. When the color information of each pixel is recorded in 1 byte (8 bits) or 3 bytes (24 bits) and the number of pixels in each row is an odd number, one byte must be padded. So one byte is skipped here.
in the code behind
if (Width mod 2) = 1 then
begin
FillByte:=0;
Stream.Write(FillByte,1);
end;
It is also based on the same principle. }
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;
//For API related palette operations, please check 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 is basically the reverse process of LoadFromStream.
end;
initialization
TPicture.RegisterFileFormat('RAS', 'Sun RAS', TRASGraphic);
finalization
TPicture.UnregisterGraphicClass(TRASGraphic);
With these few lines of code, a complete image parsing component is completed.