diff options
author | sekelsenmat <sekelsenmat@ae50a9b5-8222-0410-bf8d-8a13f76226bf> | 2007-05-27 09:29:23 +0000 |
---|---|---|
committer | sekelsenmat <sekelsenmat@ae50a9b5-8222-0410-bf8d-8a13f76226bf> | 2007-05-27 09:29:23 +0000 |
commit | 41fd902e393efc9a057defc73fee1a1aef17d98f (patch) | |
tree | 501c79507895c11f0d58bf9587f160c98d4ea977 | |
parent | 2d5991c4c67b9ead40df34cfdb73434231956116 (diff) | |
download | fpGUI-41fd902e393efc9a057defc73fee1a1aef17d98f.tar.xz |
partial fix for fpimg
-rw-r--r-- | examples/gfx/imgtest/imgtest.lpi | 7 | ||||
-rw-r--r-- | examples/img/masktest/masktest.pas | 39 | ||||
-rw-r--r-- | img/bmpreader.pas | 634 | ||||
-rw-r--r-- | img/fpimg.pas | 25 |
4 files changed, 349 insertions, 356 deletions
diff --git a/examples/gfx/imgtest/imgtest.lpi b/examples/gfx/imgtest/imgtest.lpi index c507609d..57b067c6 100644 --- a/examples/gfx/imgtest/imgtest.lpi +++ b/examples/gfx/imgtest/imgtest.lpi @@ -1,7 +1,7 @@ <?xml version="1.0"?> <CONFIG> <ProjectOptions> - <PathDelim Value="/"/> + <PathDelim Value="\"/> <Version Value="5"/> <General> <Flags> @@ -9,7 +9,7 @@ </Flags> <SessionStorage Value="InProjectDir"/> <MainUnit Value="0"/> - <IconPath Value="./"/> + <IconPath Value=".\"/> <TargetFileExt Value=""/> </General> <PublishOptions> @@ -20,7 +20,7 @@ <RunParams> <local> <FormatVersion Value="1"/> - <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/> + <LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/> </local> </RunParams> <RequiredPackages Count="1"> @@ -39,6 +39,7 @@ </ProjectOptions> <CompilerOptions> <Version Value="5"/> + <PathDelim Value="\"/> <CodeGeneration> <Generate Value="Faster"/> </CodeGeneration> diff --git a/examples/img/masktest/masktest.pas b/examples/img/masktest/masktest.pas index 79b619ef..b469dbd5 100644 --- a/examples/img/masktest/masktest.pas +++ b/examples/img/masktest/masktest.pas @@ -24,44 +24,41 @@ type TMainWindow = class procedure Paint(Sender: TObject; const ARect: TRect); private - Display: TDefDisplay; - Window: TGfxWindow; - Image2, Image4, Image8, Image24, Mask: TGfxImage; + Window: TFWindow; + Image2, Image4, Image8, Image24, Mask: TFBitmap; Image2Canvas, Image4Canvas, Image8Canvas, - Image24Canvas, MaskCanvas: TGfxCanvas; + Image24Canvas, MaskCanvas: TFCanvas; public - constructor Create(ADisplay: TDefDisplay); + constructor Create; destructor Destroy; override; end; -constructor TMainWindow.Create(ADisplay: TDefDisplay); +constructor TMainWindow.Create; begin inherited Create; - Display := ADisplay; // Load and prepare the images - Image2 := CreateImageFromFile(Display.DefaultScreen, TBMPReader, 'image2.bmp'); - Image2Canvas := - Display.DefaultScreen.CreateBitmap(Image2.Width, Image2.Height); + Image2 := CreateImageFromFile(GFScreen, TBMPReader, 'image2.bmp'); + Image2Canvas := TFBitmap.Create(Image2.Width, Image2.Height); Image2Canvas.DrawImage(Image2, Point(0, 0)); - Image4 := CreateImageFromFile(Display.DefaultScreen, TBMPReader, 'image4.bmp'); + Image4 := CreateImageFromFile(GFScreen, TBMPReader, 'image4.bmp'); Image4Canvas := - Display.DefaultScreen.CreateBitmap(Image4.Width, Image4.Height); + GFScreen.CreateBitmap(Image4.Width, Image4.Height); Image4Canvas.DrawImage(Image4, Point(0, 0)); - Image8 := CreateImageFromFile(Display.DefaultScreen, TBMPReader, 'image8.bmp'); + Image8 := CreateImageFromFile(GFScreen, TBMPReader, 'image8.bmp'); Image8Canvas := Display.DefaultScreen.CreateBitmap(Image8.Width, Image8.Height); Image8Canvas.DrawImage(Image8, Point(0, 0)); - Image24 := CreateImageFromFile(Display.DefaultScreen, TBMPReader, 'image24.bmp'); + Image24 := CreateImageFromFile(GFScreen, TBMPReader, 'image24.bmp'); Image24Canvas := Display.DefaultScreen.CreateBitmap(Image24.Width, Image24.Height); Image24Canvas.DrawImage(Image24, Point(0, 0)); // Load and prepare the image mask - Mask := CreateImageFromFile(Display.DefaultScreen, TBMPReader, 'mask.bmp'); + Mask := CreateImageFromFile(GFScreen, TBMPReader, 'mask.bmp'); MaskCanvas := Display.DefaultScreen.CreateMonoBitmap(Mask.Width, Mask.Height); MaskCanvas.DrawImage(Mask, Point(0, 0)); @@ -124,14 +121,12 @@ begin end; var - Display: TDefDisplay; MainWindow: TMainWindow; begin - WriteLn('Version: ' + {$I %date%} + ' ' + {$I %time%}); - Display := TDefDisplay.Create; - MainWindow := TMainWindow.Create(Display); - Display.Run; - MainWindow.Free; - Display.Free; + GFApplication.Initialize; + MainWindow := TMainWindow.Create; + GFApplication.AddWindow(MainWindow); + MainWindow.Show; + GFApplication.Run; end. 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 |