summaryrefslogtreecommitdiff
path: root/img
diff options
context:
space:
mode:
Diffstat (limited to 'img')
-rw-r--r--img/bmpreader.pas634
-rw-r--r--img/fpimg.pas25
2 files changed, 328 insertions, 331 deletions
diff --git a/img/bmpreader.pas b/img/bmpreader.pas
index c2693792..8476f01f 100644
--- a/img/bmpreader.pas
+++ b/img/bmpreader.pas
@@ -1,317 +1,317 @@
-{
- fpGUI - Free Pascal GUI Library
-
- Image reader for BMP files
-
- Copyright (C) 2000 - 2006 See the file AUTHORS.txt, included in this
- distribution, for details of the copyright.
-
- See the file COPYING.modifiedLGPL, included in this distribution,
- for details about redistributing fpGUI.
-
- 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 }
-
- 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; { case }
- end; { if }
-
- HeaderFinished;
- end; { if }
-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; { while }
-end;
-
-end.
+{
+ fpGUI - Free Pascal GUI Library
+
+ Image reader for BMP files
+
+ Copyright (C) 2000 - 2006 See the file AUTHORS.txt, included in this
+ distribution, for details of the copyright.
+
+ See the file COPYING.modifiedLGPL, included in this distribution,
+ for details about redistributing fpGUI.
+
+ 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 }
+
+ 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 := PixelFormatRGB24;
+ end;
+ else
+ raise EImgUnsupportedPixelFormat.Create;
+ end; { case }
+ end; { if }
+
+ HeaderFinished;
+ end; { if }
+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; { while }
+end;
+
+end.
diff --git a/img/fpimg.pas b/img/fpimg.pas
index 9c782a04..39728b89 100644
--- a/img/fpimg.pas
+++ b/img/fpimg.pas
@@ -25,25 +25,22 @@ unit fpImg;
interface
uses
- Classes
- ,GFXBase
- ,ImageIO
- ;
+ Classes, gfxbase, ImageIO, fpgfx;
-function CreateImageFromFile(AScreen: TGfxScreen; AReader: TImageReaderClass;
- const AFilename: String): TGfxImage;
+function CreateImageFromFile(AScreen: TFScreen; AReader: TImageReaderClass;
+ const AFilename: String): TFBitmap;
-function CreateImageFromStream(AScreen: TGfxScreen; AReader: TImageReaderClass;
- AStream: TStream): TGfxImage;
+function CreateImageFromStream(AScreen: TFScreen; AReader: TImageReaderClass;
+ AStream: TStream): TFBitmap;
implementation
-function CreateImageFromFile(AScreen: TGfxScreen; AReader: TImageReaderClass;
- const AFilename: String): TGfxImage;
+function CreateImageFromFile(AScreen: TFScreen; AReader: TImageReaderClass;
+ const AFilename: String): TFBitmap;
var
Stream: TFileStream;
begin
@@ -56,8 +53,8 @@ begin
end;
-function CreateImageFromStream(AScreen: TGfxScreen; AReader: TImageReaderClass;
- AStream: TStream): TGfxImage;
+function CreateImageFromStream(AScreen: TFScreen; AReader: TImageReaderClass;
+ AStream: TStream): TFBitmap;
var
Reader: TImageReader;
Data: Pointer;
@@ -67,10 +64,10 @@ begin
Reader := AReader.Create;
try
Reader.ProcessHeaderData(AStream);
- Result := AScreen.Display.CreateImage(Reader.Width, Reader.Height, Reader.PixelFormat);
+ Result := TFBitmap.Create(Reader.Width, Reader.Height, Reader.PixelFormat);
if Reader.PaletteSize > 0 then
begin
- Palette := AScreen.CreatePalette(Reader.PaletteSize, Reader.Palette);
+ Palette := TGfxPalette.create(Reader.PaletteSize, Reader.Palette);
try
Result.Palette := Palette;
finally
generated by cgit v1.2.3-70-g09d2 (git 2.47.0) at 2024-10-16 15:27:11 +0000