From 41fd902e393efc9a057defc73fee1a1aef17d98f Mon Sep 17 00:00:00 2001 From: sekelsenmat Date: Sun, 27 May 2007 09:29:23 +0000 Subject: partial fix for fpimg --- examples/gfx/imgtest/imgtest.lpi | 7 +- examples/img/masktest/masktest.pas | 39 +-- img/bmpreader.pas | 634 ++++++++++++++++++------------------- 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 @@ - + @@ -9,7 +9,7 @@ - + @@ -20,7 +20,7 @@ - + @@ -39,6 +39,7 @@ + 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 -- cgit v1.2.3-70-g09d2