diff options
Diffstat (limited to 'img/bmpreader.pas')
| -rw-r--r-- | img/bmpreader.pas | 308 |
1 files changed, 308 insertions, 0 deletions
diff --git a/img/bmpreader.pas b/img/bmpreader.pas new file mode 100644 index 00000000..71d7ee73 --- /dev/null +++ b/img/bmpreader.pas @@ -0,0 +1,308 @@ +{ + fpImg - Free Pascal Imaging Library + Copyright (C) 2000 by + Areca Systems GmbH / Sebastian Guenther, sg@freepascal.org + + Image reader for BMP files + + See the file COPYING, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. +} + + +unit BMPReader; + +{$IFDEF Debug} +{$ASSERTIONS On} +{$ENDIF} + +interface + +uses Classes, GFXBase, ImageIO; + +type + DWORD = LongWord; + LONG = LongInt; + + TBitmapFileHeader = packed record + bfType: WORD; + bfSize: DWORD; + bfReserved1: WORD; + bfReserved2: WORD; + bfOffBits: DWORD; + end; + + TBitmapInfoHeader = packed record + biSize: DWORD; + biWidth: LONG; + biHeight: LONG; + biPlanes: WORD; + biBitCount: WORD; + biCompression: DWORD; + biSizeImage: DWORD; + biXPelsPerMeter: LONG; + biYPelsPerMeter: LONG; + biClrUsed: DWORD; + biClrImportant: DWORD; + end; + + PRGBQuad = ^TRGBQuad; + TRGBQuad = packed record + rgbBlue, rgbGreen, rgbRed, rgbReserved: BYTE; + end; + + + TBMPReader = class(TImageReader) + protected + FFileHeader: TBitmapFileHeader; + FInfoHeader: TBitmapInfoHeader; + FBMPPalette: PRGBQuad; + FFileStride: LongWord; + + HeaderBytesRead, PalBytesRead: Integer; + ScanlinesLeft: Integer; + ThisSegmentHeight: Integer; + ScanlinesLeftInSegment: Integer; + ScanlineBytesDone: LongWord; + CurScanline: Pointer; + + procedure DoProcessHeaderData(AStream: TStream); override; + function DoGetImageSegmentStartY(ASegmentHeight: Integer): Integer; + override; + procedure InitImageReading; override; + procedure InitSegmentReading; + procedure DoProcessImageData(AStream: TStream); override; + public + destructor Destroy; override; + property FileHeader: TBitmapFileHeader read FFileHeader; + property InfoHeader: TBitmapInfoHeader read FInfoHeader; + property BMPPalette: PRGBQuad read FBMPPalette; + property FileStride: LongWord read FFileStride; + end; + + +implementation + + +destructor TBMPReader.Destroy; +begin + if Assigned(Palette) then + FreeMem(FPalette); + if Assigned(BMPPalette) then + FreeMem(FBMPPalette); + inherited Destroy; +end; + +procedure TBMPReader.DoProcessHeaderData(AStream: TStream); +var + DataOffset: LongWord; + HaveRead, BytesToSkip, i: Integer; + IsFirstRead: Boolean; + SkipBuffer: array[0..1023] of Byte; +begin + if HeaderBytesRead < SizeOf(FileHeader) then + begin + HaveRead := AStream.Read(PChar(@FileHeader)[HeaderBytesRead], + SizeOf(FileHeader) - HeaderBytesRead); + if HaveRead = 0 then + raise EImgOutOfData.Create; + Inc(HeaderBytesRead, HaveRead); + IsFirstRead := False; + end else + IsFirstRead := True; + + if HeaderBytesRead < SizeOf(FileHeader) + SizeOf(InfoHeader) then + begin + HaveRead := AStream.Read( + PChar(@InfoHeader)[HeaderBytesRead - SizeOf(FileHeader)], + SizeOf(FileHeader) + SizeOf(InfoHeader) - HeaderBytesRead); + if HaveRead = 0 then + if IsFirstRead then + raise EImgOutOfData.Create + else + exit; + IsFirstRead := False; + Inc(HeaderBytesRead, HaveRead); + end; + + if HeaderBytesRead = SizeOf(FileHeader) + SizeOf(InfoHeader) then + begin + case InfoHeader.biBitCount of + 1: FPaletteSize := 2; + 4: FPaletteSize := 16; + 8: FPaletteSize := 256; + end; + if PaletteSize > 0 then + begin + GetMem(FBMPPalette, PaletteSize * SizeOf(TRGBQuad)); + GetMem(FPalette, PaletteSize * SizeOf(TGfxColor)); + end; + end; + + if HeaderBytesRead >= SizeOf(FileHeader) + SizeOf(InfoHeader) then + begin + DataOffset := FileHeader.bfOffBits; + if HeaderBytesRead < DataOffset then + begin + BytesToSkip := DataOffset - HeaderBytesRead; + if BytesToSkip > SizeOf(SkipBuffer) then + BytesToSkip := SizeOf(SkipBuffer); + HaveRead := AStream.Read(SkipBuffer, BytesToSkip); + if HaveRead = 0 then + if IsFirstRead then + raise EImgOutOfData.Create + else + exit; + IsFirstRead := False; + Inc(HeaderBytesRead, HaveRead); + if PalBytesRead < PaletteSize * SizeOf(TGfxPixel) then + begin + Move(SkipBuffer, PByte(FBMPPalette)[PalBytesRead], HaveRead); + Inc(PalBytesRead, HaveRead); + end; + end; + + if HeaderBytesRead = DataOffset then + begin + FWidth := InfoHeader.biWidth; + FHeight := InfoHeader.biHeight; + + if PaletteSize > 0 then + for i := 0 to PaletteSize - 1 do + begin + Palette[i].Red := BMPPalette[i].rgbRed * 257; + Palette[i].Green := BMPPalette[i].rgbGreen * 257; + Palette[i].Blue := BMPPalette[i].rgbBlue * 257; + Palette[i].Alpha := 0; + end; + + case InfoHeader.biBitCount of + 1: + begin + FFileStride := ((Width + 31) shr 3) and not 3; + FPixelFormat.FormatType := ftMono; + end; + 4: + begin + FFileStride := ((Width + 7) shr 1) and not 3; + FPixelFormat.FormatType := ftPal4; + end; + 8: + begin + FFileStride := (Width + 3) and not 3; + FPixelFormat.FormatType := ftPal8; + end; + 24: + begin + FFileStride := (Width * 3 + 3) and not 3; + FPixelFormat := PixelFormatBGR24; + end; + else + raise EImgUnsupportedPixelFormat.Create; + end; + end; + + HeaderFinished; + end; +end; + +function TBMPReader.DoGetImageSegmentStartY(ASegmentHeight: Integer): Integer; +begin + Result := ScanlinesLeft - ASegmentHeight; + if Result < 0 then + Result := 0; +end; + +procedure TBMPReader.InitImageReading; +begin + ScanlinesLeft := Height; + InitSegmentReading; +end; + +procedure TBMPReader.InitSegmentReading; +begin + ThisSegmentHeight := ScanlinesLeft; + if ThisSegmentHeight > SegmentHeight then + ThisSegmentHeight := SegmentHeight; + ScanlinesLeftInSegment := ThisSegmentHeight; + ScanlineBytesDone := 0; + CurScanline := SegmentData + (ThisSegmentHeight - 1) * SegmentStride; +end; + +procedure TBMPReader.DoProcessImageData(AStream: TStream); + + procedure ScanlineDone; + begin + Dec(ScanlinesLeftInSegment); + Dec(ScanlinesLeft); + + if ScanlinesLeftInSegment = 0 then + begin + SegmentFinished(ScanlinesLeft, ThisSegmentHeight); + if ScanlinesLeft = 0 then + ImageFinished + else + InitSegmentReading; + end else + Dec(CurScanline, SegmentStride); + end; + +var + ReadMayFail: Boolean; + ToRead, HaveRead: Integer; +begin + if ScanlineBytesDone > 0 then + begin + ToRead := SegmentStride; + if ToRead > FileStride then + ToRead := FileStride; + Dec(ToRead, ScanlineBytesDone); + HaveRead := AStream.Read(PChar(CurScanline)[ScanlineBytesDone], ToRead); + if HaveRead = 0 then + raise EImgOutOfData.Create; + if HaveRead = ToRead then + begin + ScanlineBytesDone := 0; + ScanlineDone + end else + begin + Inc(ScanlineBytesDone, HaveRead); + exit; + end; + ReadMayFail := True; + end else + ReadMayFail := False; + + while ScanlinesLeft > 0 do + begin + ToRead := SegmentStride; + if ToRead > FileStride then + ToRead := FileStride; + + HaveRead := AStream.Read(CurScanline^, ToRead); + + if HaveRead = 0 then + if ReadMayFail then + exit + else + raise EImgOutOfData.Create; + + if HaveRead < ToRead then + begin + ScanlineBytesDone := HaveRead; + break; + end; + + // Handle the ordinary case: a full scanline has been read + if ToRead < FileStride then + AStream.Position := AStream.Position + FileStride - ToRead; + ReadMayFail := True; + ScanlineDone; + end; +end; + +end. |