|
@@ -19,13 +19,20 @@ unit FPReadBMP;
|
|
|
|
|
|
interface
|
|
|
|
|
|
-uses FPImage, classes, sysutils;
|
|
|
+uses FPImage, classes, sysutils, BMPcomn;
|
|
|
|
|
|
type
|
|
|
TFPReaderBMP = class (TFPCustomImageReader)
|
|
|
- private
|
|
|
- BytesPerPixel:Integer;
|
|
|
+ Private
|
|
|
+ Procedure FreeBufs;
|
|
|
protected
|
|
|
+ ReadSize:Integer;
|
|
|
+ BFI:TBitMapInfoHeader;
|
|
|
+ FPalette : PFPcolor;
|
|
|
+ LineBuf : PByte; // Byte , TColorRGB or TColorRGBA
|
|
|
+ procedure ReadScanLine(Row : Integer; Stream : TStream);
|
|
|
+ procedure WriteScanLine(Row : Integer; Img : TFPCustomImage);
|
|
|
+ procedure SetupRead(nPalette, nRowBits: Integer; Stream : TStream); virtual;
|
|
|
procedure InternalRead (Stream:TStream; Img:TFPCustomImage); override;
|
|
|
function InternalCheck (Stream:TStream) : boolean; override;
|
|
|
public
|
|
@@ -35,138 +42,159 @@ type
|
|
|
|
|
|
implementation
|
|
|
|
|
|
-uses BMPcomn;
|
|
|
|
|
|
-constructor TFPReaderBMP.create;
|
|
|
+function MakeFpColor(RGBA: TColorRGBA):TFPcolor;
|
|
|
+
|
|
|
+begin
|
|
|
+ with Result, RGBA do
|
|
|
+ begin
|
|
|
+ Red :=(R shl 8) or R;
|
|
|
+ Green :=(G shl 8) or G;
|
|
|
+ Blue :=(B shl 8) or B;
|
|
|
+ alpha :=AlphaOpaque;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+Constructor TFPReaderBMP.create;
|
|
|
+
|
|
|
begin
|
|
|
inherited create;
|
|
|
end;
|
|
|
|
|
|
-destructor TFPReaderBMP.Destroy;
|
|
|
+Destructor TFPReaderBMP.Destroy;
|
|
|
+
|
|
|
begin
|
|
|
+ FreeBufs;
|
|
|
inherited destroy;
|
|
|
end;
|
|
|
|
|
|
-procedure TFPReaderBMP.InternalRead(Stream:TStream; Img:TFPCustomImage);
|
|
|
- var
|
|
|
- BFI:TBitMapInfoHeader;
|
|
|
- Row,Column,nBpLine,ReadSize:Integer;
|
|
|
- aColor:TFPcolor;
|
|
|
- palette: ARRAY OF TFPcolor;
|
|
|
- aLine:ARRAY OF TColorRGB;
|
|
|
- bLine:ARRAY OF TColorRGBA;
|
|
|
- mLine: array of Byte;
|
|
|
- function MakeFpColor(RGBA: TColorRGBA):TFPcolor;
|
|
|
+Procedure TFPReaderBMP.FreeBufs;
|
|
|
+
|
|
|
+begin
|
|
|
+ If (LineBuf<>Nil) then
|
|
|
+ begin
|
|
|
+ FreeMem(LineBuf);
|
|
|
+ LineBuf:=Nil;
|
|
|
+ end;
|
|
|
+ If (FPalette<>Nil) then
|
|
|
begin
|
|
|
- with Result, RGBA do begin
|
|
|
- Red := (R shl 8) or R;
|
|
|
- Green := (G shl 8) or G;
|
|
|
- Blue := (B shl 8) or B;
|
|
|
- alpha := AlphaOpaque;
|
|
|
- end;
|
|
|
+ FreeMem(FPalette);
|
|
|
+ FPalette:=Nil;
|
|
|
end;
|
|
|
- procedure SetupRead(nPalette, nRowBits: Integer);
|
|
|
- var
|
|
|
- ColInfo: ARRAY OF TColorRGBA;
|
|
|
- i: Integer;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TFPReaderBMP.SetupRead(nPalette, nRowBits: Integer; Stream : TStream);
|
|
|
+
|
|
|
+var
|
|
|
+ ColInfo: ARRAY OF TColorRGBA;
|
|
|
+ i: Integer;
|
|
|
+
|
|
|
+begin
|
|
|
+ if nPalette>0 then
|
|
|
+ begin
|
|
|
+ GetMem(FPalette, nPalette*SizeOf(TFPColor));
|
|
|
+ SetLength(ColInfo, nPalette);
|
|
|
+ if BFI.ClrUsed>0 then
|
|
|
+ Stream.Read(ColInfo[0],BFI.ClrUsed*SizeOf(TColorRGBA))
|
|
|
+ else // Seems to me that this is dangerous.
|
|
|
+ Stream.Read(ColInfo[0],nPalette*SizeOf(TColorRGBA));
|
|
|
+ for i := 0 to High(ColInfo) do
|
|
|
+ FPalette[i] := MakeFpColor(ColInfo[i]);
|
|
|
+ end
|
|
|
+ else if BFI.ClrUsed>0 then { Skip palette }
|
|
|
+ Stream.Position := Stream.Position + BFI.ClrUsed*SizeOf(TColorRGBA);
|
|
|
+ ReadSize:=((nRowBits + 31) div 32) shl 2;
|
|
|
+ GetMem(LineBuf,ReadSize);
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TFPReaderBMP.InternalRead(Stream:TStream; Img:TFPCustomImage);
|
|
|
+
|
|
|
+Var
|
|
|
+ Row : Integer;
|
|
|
+
|
|
|
+begin
|
|
|
+ Stream.Read(BFI,SizeOf(BFI));
|
|
|
+ { This will move past any junk after the BFI header }
|
|
|
+ Stream.Position:=Stream.Position-SizeOf(BFI)+BFI.Size;
|
|
|
+ with BFI do
|
|
|
begin
|
|
|
- if nPalette > 0 then begin
|
|
|
- SetLength(palette, nPalette);
|
|
|
- SetLength(ColInfo, nPalette);
|
|
|
- if BFI.ClrUsed > 0 then
|
|
|
- Stream.Read(ColInfo[0], BFI.ClrUsed*SizeOf(TColorRGBA))
|
|
|
- else if nPalette > 0 then
|
|
|
- Stream.Read(ColInfo[0], nPalette*SizeOf(TColorRGBA));
|
|
|
- end else
|
|
|
- if BFI.ClrUsed > 0 then { Skip palette }
|
|
|
- Stream.Position := Stream.Position + BFI.ClrUsed*SizeOf(TColorRGBA);
|
|
|
- for i := 0 to High(ColInfo) do
|
|
|
- palette[i] := MakeFpColor(ColInfo[i]);
|
|
|
- ReadSize := ((nRowBits + 31) div 32) shl 2;
|
|
|
+ Img.Width:=Width;
|
|
|
+ Img.Height:=Height;
|
|
|
end;
|
|
|
- begin
|
|
|
- Stream.Read(BFI,SizeOf(BFI));
|
|
|
- { This will move past any junk after the BFI header }
|
|
|
- Stream.Position := Stream.Position - SizeOf(BFI) + BFI.Size;
|
|
|
- with BFI do
|
|
|
- begin
|
|
|
- Img.Width:=Width;
|
|
|
- Img.Height:=Height;
|
|
|
- end;
|
|
|
- if BFI.BitCount = 1 then begin
|
|
|
- { Monochrome }
|
|
|
- SetupRead(2, Img.Width);
|
|
|
- SetLength(mLine, ReadSize);
|
|
|
- for Row:=Img.Height-1 downto 0 do begin
|
|
|
- Stream.Read(mLine[0],ReadSize);
|
|
|
- for Column:=0 to Img.Width-1 do
|
|
|
- if ((mLine[Column div 8] shr (7-(Column and 7)) ) and 1) <> 0 then
|
|
|
- img.colors[Column,Row] := Palette[1]
|
|
|
- else
|
|
|
- img.colors[Column,Row] := Palette[0];
|
|
|
- end;
|
|
|
- end else if BFI.BitCount = 4 then begin
|
|
|
- SetupRead(16, Img.Width*4);
|
|
|
- SetLength(mLine, ReadSize);
|
|
|
- for Row:=img.Height-1 downto 0 do begin
|
|
|
- Stream.Read(mLine[0],ReadSize);
|
|
|
- for Column:=0 to img.Width-1 do
|
|
|
- img.colors[Column,Row] := Palette[(mLine[Column div 2] shr (((Column+1) and 1)*4)) and $0f];
|
|
|
- end;
|
|
|
- end else if BFI.BitCount = 8 then begin
|
|
|
- SetupRead(256, Img.Width*8);
|
|
|
- SetLength(mLine, ReadSize);
|
|
|
- for Row:=img.Height-1 downto 0 do begin
|
|
|
- Stream.Read(mLine[0],ReadSize);
|
|
|
- for Column:=0 to img.Width-1 do
|
|
|
- img.colors[Column,Row] := Palette[mLine[Column]];
|
|
|
- end;
|
|
|
- end else if BFI.BitCount = 16 then begin
|
|
|
- raise Exception.Create('16 bpp bitmaps not supported');
|
|
|
-{Treating the 24bit BMP files}
|
|
|
- end else if BFI.BitCount=24 then
|
|
|
- begin
|
|
|
- SetupRead(0, Img.Width*8*3);
|
|
|
- SetLength(aLine,ReadSize);//3 extra byte for BMP 4Bytes alignement.
|
|
|
- for Row:=img.Height-1 downto 0 do
|
|
|
- begin
|
|
|
- Stream.Read(aLine[0],ReadSize);
|
|
|
- for Column:=0 to img.Width-1 do
|
|
|
- with aLine[Column],aColor do
|
|
|
- begin
|
|
|
-{Use only the high byte to convert the color}
|
|
|
- Red := (R shl 8) + R;
|
|
|
- Green := (G shl 8) + G;
|
|
|
- Blue := (B shl 8) + B;
|
|
|
- alpha := AlphaOpaque;
|
|
|
- img.colors[Column,Row]:=aColor;
|
|
|
- end;
|
|
|
- end;
|
|
|
- end
|
|
|
- else if BFI.BitCount=32 then
|
|
|
- begin
|
|
|
- SetupRead(0, Img.Width*8*4);
|
|
|
- SetLength(bLine,ReadSize);
|
|
|
- for Row:=img.Height-1 downto 0 do
|
|
|
- begin
|
|
|
- Stream.Read(bLine[0],ReadSize);
|
|
|
- for Column:=0 to img.Width-1 do
|
|
|
- img.colors[Column,Row]:=MakeFpColor(bLine[Column])
|
|
|
- end;
|
|
|
- end;
|
|
|
+ Case BFI.BitCount of
|
|
|
+ 1 : { Monochrome }
|
|
|
+ SetupRead(2,Img.Width,Stream);
|
|
|
+ 4 :
|
|
|
+ SetupRead(16,Img.Width*4,Stream);
|
|
|
+ 8 :
|
|
|
+ SetupRead(256,Img.Width*8,Stream);
|
|
|
+ 16 :
|
|
|
+ Raise Exception.Create('16 bpp bitmaps not supported');
|
|
|
+ 24:
|
|
|
+ SetupRead(0,Img.Width*8*3,Stream);
|
|
|
+ 32:
|
|
|
+ SetupRead(0,Img.Width*8*4,Stream);
|
|
|
end;
|
|
|
+ for Row:=Img.Height-1 downto 0 do
|
|
|
+ begin
|
|
|
+ ReadScanLine(Row,Stream);
|
|
|
+ WriteScanLine(Row,Img);
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TFPReaderBMP.ReadScanLine(Row : Integer; Stream : TStream);
|
|
|
+
|
|
|
+begin
|
|
|
+ // Add here support for compressed lines. The 'readsize' is the same
|
|
|
+ Stream.Read(LineBuf[0],ReadSize);
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TFPReaderBMP.WriteScanLine(Row : Integer; Img : TFPCustomImage);
|
|
|
+
|
|
|
+Var
|
|
|
+ Column : Integer;
|
|
|
+ AColor : TFPColor;
|
|
|
+
|
|
|
+begin
|
|
|
+ Case BFI.BitCount of
|
|
|
+ 1 :
|
|
|
+ for Column:=0 to Img.Width-1 do
|
|
|
+ if ((LineBuf[Column div 8] shr (7-(Column and 7)) ) and 1) <> 0 then
|
|
|
+ img.colors[Column,Row]:=FPalette[1]
|
|
|
+ else
|
|
|
+ img.colors[Column,Row]:=FPalette[0];
|
|
|
+ 4 :
|
|
|
+ for Column:=0 to img.Width-1 do
|
|
|
+ img.colors[Column,Row]:=FPalette[(LineBuf[Column div 2] shr (((Column+1) and 1)*4)) and $0f];
|
|
|
+ 8 :
|
|
|
+ for Column:=0 to img.Width-1 do
|
|
|
+ img.colors[Column,Row]:=FPalette[LineBuf[Column]];
|
|
|
+ 16 :
|
|
|
+ Raise Exception.Create('16 bpp bitmaps not supported');
|
|
|
+ 24 :
|
|
|
+ for Column:=0 to img.Width-1 do
|
|
|
+ with PColorRGB(LineBuf)[Column],aColor do
|
|
|
+ begin {Use only the high byte to convert the color}
|
|
|
+ Red := (R shl 8) + R;
|
|
|
+ Green := (G shl 8) + G;
|
|
|
+ Blue := (B shl 8) + B;
|
|
|
+ alpha := AlphaOpaque;
|
|
|
+ img.colors[Column,Row]:=aColor;
|
|
|
+ end;
|
|
|
+ 32 :
|
|
|
+ for Column:=0 to img.Width-1 do
|
|
|
+ img.colors[Column,Row]:=MakeFpColor(PColorRGBA(LineBuf)[Column]);
|
|
|
+ end;
|
|
|
+end;
|
|
|
|
|
|
function TFPReaderBMP.InternalCheck (Stream:TStream) : boolean;
|
|
|
- var
|
|
|
- BFH:TBitMapFileHeader;
|
|
|
- begin
|
|
|
- stream.Read(BFH,SizeOf(BFH));
|
|
|
- with BFH do
|
|
|
- if bfType<>BMmagic
|
|
|
- then
|
|
|
- InternalCheck:=False
|
|
|
- else { Do not check size to allow multiple bitmaps per stream }
|
|
|
- InternalCheck:=True;
|
|
|
+
|
|
|
+var
|
|
|
+ BFH:TBitMapFileHeader;
|
|
|
+begin
|
|
|
+ stream.Read(BFH,SizeOf(BFH));
|
|
|
+ With BFH do
|
|
|
+ Result:=(bfType=BMmagic); // Just check magic number
|
|
|
end;
|
|
|
|
|
|
initialization
|
|
@@ -174,7 +202,10 @@ initialization
|
|
|
end.
|
|
|
{
|
|
|
$Log$
|
|
|
-Revision 1.6 2004-02-15 20:59:06 michael
|
|
|
+Revision 1.7 2004-02-20 22:42:44 michael
|
|
|
++ More modular reading of BMP for easier overriding in descendents
|
|
|
+
|
|
|
+Revision 1.6 2004/02/15 20:59:06 michael
|
|
|
+ Patch from Colin Western
|
|
|
|
|
|
Revision 1.5 2003/09/30 14:17:05 luk
|