Browse Source

+ More modular reading of BMP for easier overriding in descendents

michael 21 years ago
parent
commit
213ac636c8
2 changed files with 171 additions and 131 deletions
  1. 20 11
      fcl/image/bmpcomn.pp
  2. 151 120
      fcl/image/fpreadbmp.pp

+ 20 - 11
fcl/image/bmpcomn.pp

@@ -34,7 +34,8 @@ type
 {10+04 : Offset of image data : size if the file hieder + the info header}
       bfOffset:longint;
    end;
-
+   PBitMapFileHeader = ^TBitMapFileHeader;
+   
    TBitMapInfoHeader = packed record
 {14+04 : Size of the bitmap info header : sould be 40=$28}
       Size:longint;
@@ -59,15 +60,20 @@ type
 {50+04 : Number of imprtant colors used : usefull for displaying on VGA256}
       ClrImportant:longint;
    end;
-  
-    TColorRGB=packed record
-      B,G,R:Byte;
-    end;
-    TColorRGBA=packed record
-      case Boolean of
-        False:(B,G,R,A:Byte);
-        True:(RGB:TColorRGB);
-      end;
+   PBitMapInfoHeader = ^TBitMapInfoHeader;
+   
+   TColorRGB=packed record
+     B,G,R:Byte;
+   end;
+   PColorRGB = ^TColorRGB;
+   
+   TColorRGBA=packed record
+   case Boolean of
+      False:(B,G,R,A:Byte);
+      True:(RGB:TColorRGB);
+   end;
+   PColorRGBA = ^TColorRGBA; 
+    
 {54+?? : Color map : Lenght of color map is 4 bytes + the rest until the beginning of image data fixed in BFH.bfOffset}
     TColorMap=TColorRGBA;
 
@@ -76,7 +82,10 @@ implementation
 end.
 {
 $Log$
-Revision 1.3  2004-02-15 20:59:06  michael
+Revision 1.4  2004-02-20 22:42:44  michael
++ More modular reading of BMP for easier overriding in descendents
+
+Revision 1.3  2004/02/15 20:59:06  michael
 + Patch from Colin Western
 
 Revision 1.2  2003/09/09 11:22:30  mazen

+ 151 - 120
fcl/image/fpreadbmp.pp

@@ -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