Ignore:
Timestamp:
Apr 17, 2019, 12:58:41 AM (5 years ago)
Author:
chronos
Message:
  • Modified: Propagate project build mode options to used packages.
  • Added: Check memory leaks using heaptrc.
  • Modified: Update BGRABitmap package.
Location:
GraphicTest
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • GraphicTest

    • Property svn:ignore

      •  

        old new  
        88GraphicTest.lps
        99GraphicTest.dbg
         10heaptrclog.trc

  • GraphicTest/Packages/bgrabitmap/bgrareadbmp.pas

    r494 r521  
    2424   - direct access to pixels with TBGRABitmap
    2525   - vertical shrink option with MinifyHeight,WantedHeight,OutputHeight (useful for thumbnails)
     26  01/2017 by circular:
     27   - support for OS/2 1.x format
     28   - support for headerless files
    2629}
    2730
    … …  
    3740type
    3841  TBMPTransparencyOption = (toAuto, toTransparent, toOpaque);
     42  TBitMapInfoHeader = BMPcomn.TBitMapInfoHeader;
     43  TBitMapFileHeader = BMPcomn.TBitMapFileHeader;
     44  TOS2BitmapHeader = packed record
     45    bcSize: DWORD;
     46    bcWidth: Word;
     47    bcHeight: Word;
     48    bcPlanes: Word;
     49    bcBitCount: Word;
     50  end;
     51  TMinimumBitmapHeader = packed record
     52    Size:longint;
     53    Width:longint;
     54    Height:longint;
     55    Planes:word;
     56    BitCount:word;
     57  end;
     58  TBitmapSubFormat = (bsfWithFileHeader, bsfHeaderless, bsfHeaderlessWithMask);
     59  TReadScanlineProc = procedure(Row : Integer; Stream : TStream) of object;
     60  TWriteScanlineProc = procedure(Row : Integer; Img : TFPCustomImage) of object;
     61  TProgressProc = procedure(Percent: integer; var ShouldContinue: boolean) of object;
     62
    3963
    4064  { TBGRAReaderBMP }
    4165
    42   TBGRAReaderBMP = class (TFPCustomImageReader)
     66  TBGRAReaderBMP = class (TBGRAImageReader)
    4367    Private
    4468      DeltaX, DeltaY : integer; // Used for the never-used delta option in RLE
    4569      TopDown : boolean;        // If set, bitmap is stored top down instead of bottom up
    46       continue : boolean;       // needed for onprogress event
    47       Rect : TRect;
    4870      Procedure FreeBufs;       // Free (and nil) buffers.
    4971    protected
    5072      ReadSize : Integer;       // Size (in bytes) of 1 scanline.
    51       BFI : TBitMapInfoHeader;  // The header as read from the stream.
     73      BFH: TBitMapFileHeader;    // The file header
     74      BFI: TBitMapInfoHeader;  // The header as read from the stream.
     75      FPaletteEntrySize: integer;  // 4 for Windows, 3 for OS/2 1.x
    5276      FPalette : PFPcolor;      // Buffer with Palette entries. (useless now)
    5377      FBGRAPalette : PBGRAPixel;
    … …  
    6286      FBufferStream: TStream;
    6387      FHasAlphaValues: boolean;
     88      FMaskData: PByte;
     89      FMaskDataSize: integer;
    6490      // SetupRead will allocate the needed buffers, and read the colormap if needed.
    6591      procedure SetupRead(nPalette, nRowBits: Integer; Stream : TStream); virtual;
    … …  
    74100      procedure WriteScanLine(Row : Integer; Img : TFPCustomImage); virtual;
    75101      procedure WriteScanLineBGRA(Row : Integer; Img : TFPCustomImage); virtual;
     102      procedure ReadMaskLine({%H-}Row : Integer; Stream : TStream); virtual;
     103      procedure SkipMaskLine({%H-}Row : Integer; Stream : TStream); virtual;
     104      procedure WriteMaskLine(Row : Integer; Img : TFPCustomImage); virtual;
    76105      // required by TFPCustomImageReader
    77106      procedure InternalRead  (Stream:TStream; Img:TFPCustomImage); override;
    … …  
    81110      function GetNextBufferByte: byte;
    82111      procedure MakeOpaque(Img: TFPCustomImage);
     112      procedure LoadMask(Stream:TStream; Img:TFPCustomImage; var ShouldContinue: boolean);
     113      procedure MainProgressProc(Percent: integer; var ShouldContinue: boolean);
     114      procedure ImageVerticalLoop(Stream:TStream; Img:TFPCustomImage;
     115        ReadProc, SkipProc: TReadScanlineProc; WriteProc: TWriteScanlineProc;
     116        ProgressProc: TProgressProc; var ShouldContinue: boolean);
    83117    public
    84118      MinifyHeight,WantedHeight: integer;
     119      Hotspot: TPoint;
     120      Subformat: TBitmapSubFormat;
    85121      constructor Create; override;
    86122      destructor Destroy; override;
    … …  
    88124      property OutputHeight: integer read FOutputHeight;
    89125      property TransparencyOption: TBMPTransparencyOption read FTransparencyOption write FTransparencyOption;
    90   end;
     126      function GetQuickInfo(AStream: TStream): TQuickImageInfo; override;
     127      function GetBitmapDraft(AStream: TStream; {%H-}AMaxWidth, AMaxHeight: integer; out AOriginalWidth,AOriginalHeight: integer): TBGRACustomBitmap; override;
     128  end;
     129
     130function MakeBitmapFileHeader(AData: TStream): TBitMapFileHeader;
    91131
    92132implementation
    93133
    94 type
    95   TWriteScanlineProc = procedure (Row : Integer; Img : TFPCustomImage) of object;
    96 
     134uses math;
     135
     136function MakeBitmapFileHeader(AData: TStream): TBitMapFileHeader;
     137var header: PBitMapInfoHeader;
     138  headerSize: integer;
     139  extraSize: integer;
     140  os2header: TOS2BitmapHeader;
     141begin
     142  AData.Position := 0;
     143  headerSize := LEtoN(AData.ReadDWord);
     144  if headerSize = sizeof(TOS2BitmapHeader) then //OS2 1.x
     145  begin
     146    AData.ReadBuffer({%H-}os2header,sizeof(os2header));
     147    if LEtoN(os2header.bcBitCount) in [1,2,4,8] then
     148    begin
     149      extraSize := 3*(1 shl LEtoN(os2header.bcBitCount));
     150    end else
     151      extraSize := 0;
     152    result.bfType:= Word('BM');
     153    result.bfSize := NtoLE(Integer(sizeof(TBitMapFileHeader) + AData.Size));
     154    result.bfReserved:= 0;
     155    result.bfOffset := NtoLE(Integer(sizeof(TBitMapFileHeader) + headerSize + extraSize));
     156  end else
     157  begin
     158    if (headerSize < 16) or (headerSize > AData.Size) or (headerSize > 1024) then
     159      raise exception.Create('Invalid header size');
     160    getmem(header, headerSize);
     161    try
     162      fillchar(header^, headerSize,0);
     163      header^.Size := NtoLE(headerSize);
     164      AData.ReadBuffer((PByte(header)+4)^, headerSize-4);
     165      if LEtoN(header^.Compression) = BI_BITFIELDS then
     166        extraSize := 4*3
     167      else if LEtoN(header^.BitCount) in [1,2,4,8] then
     168      begin
     169        if header^.ClrUsed > 0 then
     170          extraSize := 4*header^.ClrUsed
     171        else
     172          extraSize := 4*(1 shl header^.BitCount);
     173      end else
     174        extraSize := 0;
     175      result.bfType:= Word('BM');
     176      result.bfSize := NtoLE(Integer(sizeof(TBitMapFileHeader) + AData.Size));
     177      result.bfReserved:= 0;
     178      result.bfOffset := NtoLE(Integer(sizeof(TBitMapFileHeader) + headerSize + extraSize));
     179    finally
     180      freemem(header);
     181    end;
     182  end;
     183end;
    97184
    98185function RGBAToFPColor(Const RGBA: TColorRGBA) : TFPcolor;
    99 
    100186begin
    101187  with Result, RGBA do
    … …  
    125211  inherited create;
    126212  FTransparencyOption := toTransparent;
     213  Subformat:= bsfWithFileHeader;
    127214end;
    128215
    … …  
    134221end;
    135222
     223function TBGRAReaderBMP.GetQuickInfo(AStream: TStream): TQuickImageInfo;
     224var headerSize: dword;
     225  os2header: TOS2BitmapHeader;
     226  minHeader: TMinimumBitmapHeader;
     227  totalDepth: integer;
     228  headerPos: int64;
     229begin
     230  fillchar({%H-}result, sizeof(result), 0);
     231  headerPos := AStream.Position;
     232  if AStream.Read({%H-}headerSize, sizeof(headerSize)) <> sizeof(headerSize) then exit;
     233  headerSize := LEtoN(headerSize);
     234
     235  //check presence of file header
     236  if (headerSize and $ffff) = BMmagic then
     237  begin
     238    headerPos += sizeof(TBitMapFileHeader);
     239    AStream.Position := headerPos;
     240    if AStream.Read(headerSize, sizeof(headerSize)) <> sizeof(headerSize) then exit;
     241    headerSize := LEtoN(headerSize);
     242  end;
     243
     244  AStream.Position := headerPos;
     245
     246  if headerSize = sizeof(TOS2BitmapHeader) then //OS2 1.x
     247  begin
     248    if AStream.Read({%H-}os2header, sizeof(os2header)) <> sizeof(os2header) then exit;
     249    result.width := LEtoN(os2header.bcWidth);
     250    result.height := LEtoN(os2header.bcHeight);
     251    result.colorDepth := LEtoN(os2header.bcBitCount);
     252    result.alphaDepth := 0;
     253  end
     254  else
     255  if headerSize >= sizeof(minHeader) then
     256  begin
     257    if AStream.Read({%H-}minHeader, sizeof(minHeader)) <> sizeof(minHeader) then exit;
     258    result.width := LEtoN(minHeader.Width);
     259    result.height := LEtoN(minHeader.Height);
     260    totalDepth := LEtoN(minHeader.BitCount);
     261    if totalDepth > 24 then
     262    begin
     263      result.colorDepth:= 24;
     264      result.alphaDepth:= 8;
     265    end else
     266    begin
     267      result.colorDepth := totalDepth;
     268      result.alphaDepth:= 0;
     269    end;
     270  end else
     271  begin
     272    result.width := 0;
     273    result.height:= 0;
     274    result.colorDepth:= 0;
     275    result.alphaDepth:= 0;
     276  end;
     277end;
     278
     279function TBGRAReaderBMP.GetBitmapDraft(AStream: TStream; AMaxWidth,
     280  AMaxHeight: integer; out AOriginalWidth, AOriginalHeight: integer): TBGRACustomBitmap;
     281var
     282  bmpFormat: TBGRAReaderBMP;
     283  prevStreamPos: Int64;
     284begin
     285  bmpFormat:= TBGRAReaderBMP.Create;
     286  bmpFormat.Subformat:= Subformat;
     287  bmpFormat.MinifyHeight := AMaxHeight*2;
     288  result := BGRABitmapFactory.Create;
     289  prevStreamPos := AStream.Position;
     290  try
     291    result.LoadFromStream(AStream, bmpFormat);
     292    AOriginalWidth:= result.Width;
     293    AOriginalHeight:= bmpFormat.OriginalHeight;
     294  finally
     295    bmpFormat.Free;
     296    AStream.Position := prevStreamPos;
     297  end;
     298end;
     299
    136300procedure TBGRAReaderBMP.FreeBufs;
    137 
    138301begin
    139302  If (LineBuf<>Nil) then
    … …  
    233396var
    234397  ColInfo: ARRAY OF TColorRGBA;
    235   i: Integer;
     398  ColInfo3: packed array of TColorRGB;
     399  i,colorPresent: Integer;
    236400
    237401begin
    … …  
    262426    SetLength(ColInfo, nPalette);
    263427    if BFI.ClrUsed>0 then
    264       Stream.Read(ColInfo[0],BFI.ClrUsed*SizeOf(TColorRGBA))
    265     else // Seems to me that this is dangerous.
    266       Stream.Read(ColInfo[0],nPalette*SizeOf(TColorRGBA));
     428      colorPresent:= min(BFI.ClrUsed,nPalette)
     429    else
     430      colorPresent:= nPalette;
     431    if FPaletteEntrySize = 3 then
     432    begin
     433      setlength(ColInfo3, nPalette);
     434      Stream.Read(ColInfo3[0],colorPresent*SizeOf(TColorRGB));
     435      for i := 0 to colorPresent-1 do
     436        ColInfo[i].RGB := ColInfo3[i];
     437    end
     438    else
     439    begin
     440      Stream.Read(ColInfo[0],colorPresent*SizeOf(TColorRGBA));
     441    end;
    267442    for i := 0 to High(ColInfo) do
    268443    begin
    … …  
    282457
    283458Var
    284   PrevSourceRow,SourceRow, i, pallen, SourceRowDelta, SourceLastRow : Integer;
     459  i, pallen : Integer;
    285460  BadCompression : boolean;
    286461  WriteScanlineProc: TWriteScanlineProc;
    287   SourceRowAdd: integer;
    288   SourceRowAcc,SourceRowMod: integer;
    289   SourceRowAccAdd: integer;
    290   OutputLastRow, OutputRow, OutputRowDelta: integer;
    291 
    292   prevPercent, percent, percentAdd : byte;
    293   percentMod : longword;
    294   percentAcc, percentAccAdd : longword;
    295 
    296 begin
    297   Rect.Left:=0; Rect.Top:=0; Rect.Right:=0; Rect.Bottom:=0;
    298   continue:=true;
    299   Progress(psStarting,0,false,Rect,'',continue);
    300   if not continue then exit;
    301   Stream.Read(BFI,SizeOf(BFI));
    302   {$IFDEF ENDIAN_BIG}
    303   SwapBMPInfoHeader(BFI);
    304   {$ENDIF}
     462  headerSize: longword;
     463  os2header: TOS2BitmapHeader;
     464  shouldContinue: boolean;
     465
     466begin
     467  shouldContinue:=true;
     468  Progress(psStarting,0,false,EmptyRect,'',shouldContinue);
     469  if not shouldContinue then exit;
     470
     471  headerSize := LEtoN(Stream.ReadDWord);
     472  fillchar({%H-}BFI,SizeOf(BFI),0);
     473  if headerSize = sizeof(TOS2BitmapHeader) then
     474  begin
     475    fillchar({%H-}os2header,SizeOf(os2header),0);
     476    Stream.Read(os2header.bcWidth,min(SizeOf(os2header),headerSize)-sizeof(DWord));
     477    BFI.Size := 16;
     478    BFI.Width := LEtoN(os2header.bcWidth);
     479    BFI.Height := LEtoN(os2header.bcHeight);
     480    BFI.Planes := LEtoN(os2header.bcPlanes);
     481    BFI.BitCount := LEtoN(os2header.bcBitCount);
     482    FPaletteEntrySize:= 3;
     483  end else
     484  begin
     485    Stream.Read(BFI.Width,min(SizeOf(BFI),headerSize)-sizeof(DWord));
     486    {$IFDEF ENDIAN_BIG}
     487    SwapBMPInfoHeader(BFI);
     488    {$ENDIF}
     489    BFI.Size := headerSize;
     490    FPaletteEntrySize:= 4;
     491  end;
    305492  { This will move past any junk after the BFI header }
    306493  Stream.Position:=Stream.Position-SizeOf(BFI)+BFI.Size;
    … …  
    339526      32:
    340527        SetupRead(0,Width*8*4,Stream);
    341     end;
    342   end;
     528    else raise exception.Create('Invalid bit depth ('+inttostr(BFI.BitCount)+')');
     529    end;
     530  end;
     531  if Subformat = bsfHeaderlessWithMask then BFI.Height := BFI.Height div 2;
    343532  Try
    344533    { Note: it would be better to Fill the image palette in setupread instead of creating FPalette.
    … …  
    350539    if pallen>0 then
    351540    begin
     541      if FPalette = nil then raise exception.Create('Internal error: palette object not initialized');
    352542      Img.Palette.Count:=pallen;
    353543      for i:=0 to pallen-1 do
    354544        Img.Palette.Color[i]:=FPalette[i];
    355545    end;
    356     if MinifyHeight < BFI.Height then FOutputHeight:= MinifyHeight else
    357     if WantedHeight <> 0 then FOutputHeight:= WantedHeight else
    358       FOutputHeight:= 0;
    359 
    360     percent:=0;
    361     percentAdd := 100 div BFI.Height;
    362     percentAcc:=BFI.Height div 2;
    363     percentAccAdd := 100 mod BFI.Height;
    364     percentMod:=BFI.Height;
    365 
    366     DeltaX:=-1; DeltaY:=-1;
    367     if TopDown then
    368     begin
    369       SourceRowDelta := 1;
    370       SourceRow := 0;
    371       SourceLastRow := BFI.Height-1;
    372     end else
    373     begin
    374       SourceRowDelta := -1;
    375       SourceRow := BFI.Height-1;
    376       SourceLastRow := 0;
    377     end;
    378     OutputRowDelta:= SourceRowDelta;
    379     if (OutputHeight <= 0) or (OutputHeight = BFI.Height) then
    380     begin
    381       SourceRowAdd := SourceRowDelta;
    382       SourceRowAcc := 0;
    383       SourceRowAccAdd := 0;
    384       SourceRowMod := 1;
    385       OutputRow := SourceRow;
    386       OutputLastRow := SourceLastRow;
    387       Img.SetSize(BFI.Width,BFI.Height);
    388     end else
    389     begin
    390       SourceRowAdd := (BFI.Height div OutputHeight)*SourceRowDelta;
    391       SourceRowAcc := OutputHeight div 2;
    392       SourceRowAccAdd := BFI.Height mod OutputHeight;
    393       SourceRowMod := OutputHeight;
    394       If TopDown then
    395       begin
    396         OutputRow := 0;
    397         OutputLastRow := OutputHeight-1;
    398       end
    399       else
    400       begin
    401         OutputRow := OutputHeight-1;
    402         OutputLastRow := 0;
    403       end;
    404       Img.SetSize(BFI.Width,OutputHeight);
    405     end;
     546    if (MinifyHeight > 0) and (MinifyHeight < BFI.Height) then FOutputHeight:= MinifyHeight else
     547    if WantedHeight > 0 then FOutputHeight:= WantedHeight else
     548      FOutputHeight:= BFI.Height;
     549
     550    if (BFI.Compression=BI_RLE8) or(BFI.Compression=BI_RLE4) then InitReadBuffer(Stream,2048);
     551    FHasAlphaValues:= false;
     552
     553    Img.SetSize(BFI.Width,FOutputHeight);
     554
    406555    if Img is TBGRACustomBitmap then
    407556      WriteScanlineProc := @WriteScanLineBGRA else
    408557        WriteScanlineProc := @WriteScanLine;
    409     PrevSourceRow := SourceRow-SourceRowDelta;
    410     if (BFI.Compression=BI_RLE8) or(BFI.Compression=BI_RLE4) then InitReadBuffer(Stream,2048);
    411     FHasAlphaValues:= false;
    412     while SourceRow <> SourceLastRow+SourceRowDelta do
    413     begin
    414       while PrevSourceRow <> SourceRow do
    415       begin
    416         inc(PrevSourceRow, SourceRowDelta);
    417         if PrevSourceRow = SourceRow then
    418           ReadScanLine(PrevSourceRow,Stream)
    419         else
    420           SkipScanLine(PrevSourceRow,Stream);
    421       end;
    422       WriteScanLineProc(OutputRow,Img);
    423       if OutputRow = OutputLastRow then break;
    424       if not continue then exit;
    425 
    426       inc(OutputRow,OutputRowDelta);
    427       inc(SourceRow,SourceRowAdd);
    428       inc(SourceRowAcc,SourceRowAccAdd);
    429       if SourceRowAcc >= SourceRowMod then
    430       begin
    431        dec(SourceRowAcc,SourceRowMod);
    432        Inc(SourceRow,SourceRowDelta);
    433       end;
    434 
    435       prevPercent := percent;
    436       inc(percent,percentAdd);
    437       inc(percentAcc,percentAccAdd);
    438       if percentAcc>=percentMod then inc(percent);
    439       if percent<>prevPercent then Progress(psRunning,percent,false,Rect,'',continue);
    440     end;
    441     if not FHasAlphaValues and (TransparencyOption = toAuto) and (BFI.BitCount = 32) then
    442       MakeOpaque(Img);
    443     Progress(psEnding,100,false,Rect,'',continue);
     558
     559    ImageVerticalLoop(Stream, Img, @ReadScanLine, @SkipScanLine, WriteScanlineProc,
     560                      @MainProgressProc, shouldContinue);
     561
     562    if shouldContinue then
     563    begin
     564      if not FHasAlphaValues and (TransparencyOption = toAuto) and (BFI.BitCount = 32) then
     565        MakeOpaque(Img);
     566      if (BFI.Compression=BI_RLE8) or(BFI.Compression=BI_RLE4) then CloseReadBuffer;
     567
     568      if Subformat = bsfHeaderlessWithMask then LoadMask(Stream,Img, shouldContinue);
     569
     570      Progress(psEnding,100,false,EmptyRect,'',shouldContinue);
     571    end;
     572
    444573  finally
    445     if (BFI.Compression=BI_RLE8) or(BFI.Compression=BI_RLE4) then CloseReadBuffer;
    446574    FreeBufs;
    447575  end;
    … …  
    729857        for Column:=0 to img.Width-1 do
    730858        begin
    731           PDest^:= BGRA((PSrc)^,(PSrc+1)^,(PSrc+2)^,(PSrc+3)^);
     859          PDest^:= BGRA((PSrc+2)^,(PSrc+1)^,(PSrc)^,(PSrc+3)^);
    732860          if PDest^.alpha <> 0 then FHasAlphaValues:= true;
    733861          inc(PDest);
    … …  
    750878end;
    751879
     880procedure TBGRAReaderBMP.ReadMaskLine(Row: Integer; Stream: TStream);
     881begin
     882  FillChar(FMaskData^, FMaskDataSize, 0);
     883  Stream.Read(FMaskData^, FMaskDataSize);
     884end;
     885
     886procedure TBGRAReaderBMP.SkipMaskLine(Row: Integer; Stream: TStream);
     887begin
     888  Stream.Position := Stream.Position+FMaskDataSize;
     889end;
     890
     891procedure TBGRAReaderBMP.WriteMaskLine(Row: Integer; Img: TFPCustomImage);
     892var x, maskPos: integer;
     893  bit: byte;
     894  bmp: TBGRACustomBitmap;
     895  pimg: PBGRAPixel;
     896begin
     897  if Img is TBGRACustomBitmap then
     898    bmp := TBGRACustomBitmap(Img)
     899  else
     900    exit;
     901
     902  maskPos := 0;
     903  bit := $80;
     904  pimg := bmp.ScanLine[Row];
     905  for x := 0 to bmp.Width-1 do
     906  begin
     907    if (FMaskData[maskPos] and bit) <> 0 then //if AND mask is non zero, value is kept
     908    begin
     909      if pimg^.alpha = 255 then
     910      begin
     911        pimg^.alpha := 0;
     912        if dword(pimg^) <> 0 then
     913        begin
     914         bmp.NeedXorMask;
     915         bmp.XorMask.SetPixel(x,Row,pimg^);
     916        end;
     917      end;
     918    end;
     919    inc(pimg);
     920    bit := bit shr 1;
     921    if bit = 0 then
     922    begin
     923      bit := $80;
     924      inc(maskPos);
     925    end;
     926  end;
     927end;
     928
    752929function  TBGRAReaderBMP.InternalCheck (Stream:TStream) : boolean;
    753 
    754 var
    755   {%H-}BFH:TBitMapFileHeader;
    756 begin
    757   stream.Read({%H-}BFH,SizeOf(BFH));
    758   {$IFDEF ENDIAN_BIG}
    759   SwapBMPFileHeader(BFH);
    760   {$ENDIF}
    761   With BFH do
    762     Result:=(bfType=BMmagic); // Just check magic number
     930begin
     931  fillchar(BFH, sizeof(BFH), 0);
     932  if Subformat in [bsfHeaderless,bsfHeaderlessWithMask] then
     933  begin
     934   result := true;
     935   Hotspot := Point(0,0);
     936  end else
     937  begin
     938    if stream.Read(BFH,SizeOf(BFH)) <> sizeof(BFH) then
     939    begin
     940      result := false;
     941      exit;
     942    end;
     943    Hotspot := Point(LEtoN(PWord(@BFH.bfReserved)^),LEtoN((PWord(@BFH.bfReserved)+1)^));
     944    {$IFDEF ENDIAN_BIG}
     945    SwapBMPFileHeader(BFH);
     946    {$ENDIF}
     947    With BFH do
     948      Result:=(bfType=BMmagic); // Just check magic number
     949  end;
    763950end;
    764951
    … …  
    8141001end;
    8151002
     1003procedure TBGRAReaderBMP.LoadMask(Stream: TStream; Img: TFPCustomImage; var ShouldContinue: boolean);
     1004begin
     1005  if Img is TBGRACustomBitmap then TBGRACustomBitmap(Img).DiscardXorMask;
     1006  FMaskDataSize := ((Img.Width+31) div 32)*4; //padded to dword
     1007  getmem(FMaskData, FMaskDataSize);
     1008  try
     1009    ImageVerticalLoop(Stream,Img, @ReadMaskLine, @SkipMaskLine, @WriteMaskLine, nil, ShouldContinue);
     1010  finally
     1011    freemem(FMaskData);
     1012    FMaskData := nil;
     1013    FMaskDataSize := 0;
     1014  end;
     1015end;
     1016
     1017procedure TBGRAReaderBMP.MainProgressProc(Percent: integer;
     1018  var ShouldContinue: boolean);
     1019begin
     1020  Progress(psRunning,Percent,false,EmptyRect,'',ShouldContinue);
     1021end;
     1022
     1023procedure TBGRAReaderBMP.ImageVerticalLoop(Stream: TStream;
     1024  Img: TFPCustomImage; ReadProc, SkipProc: TReadScanlineProc;
     1025  WriteProc: TWriteScanlineProc; ProgressProc: TProgressProc;
     1026  var ShouldContinue: boolean);
     1027var
     1028  prevPercent, percent, percentAdd : byte;
     1029  percentMod : longword;
     1030  percentAcc, percentAccAdd : longword;
     1031  PrevSourceRow,SourceRow, SourceRowDelta, SourceLastRow: integer;
     1032  SourceRowAdd: integer;
     1033  SourceRowAcc,SourceRowMod: integer;
     1034  SourceRowAccAdd: integer;
     1035  OutputLastRow, OutputRow, OutputRowDelta: integer;
     1036begin
     1037  if OutputHeight <= 0 then exit;
     1038
     1039  percent:=0;
     1040  percentAdd := 100 div BFI.Height;
     1041  percentAcc:=BFI.Height div 2;
     1042  percentAccAdd := 100 mod BFI.Height;
     1043  percentMod:=BFI.Height;
     1044
     1045  DeltaX:=-1; DeltaY:=-1;
     1046  if TopDown then
     1047  begin
     1048    SourceRowDelta := 1;
     1049    SourceRow := 0;
     1050    SourceLastRow := BFI.Height-1;
     1051  end else
     1052  begin
     1053    SourceRowDelta := -1;
     1054    SourceRow := BFI.Height-1;
     1055    SourceLastRow := 0;
     1056  end;
     1057  OutputRowDelta:= SourceRowDelta;
     1058
     1059  SourceRowAdd := (BFI.Height div OutputHeight)*SourceRowDelta;
     1060  SourceRowAcc := OutputHeight div 2;
     1061  SourceRowAccAdd := BFI.Height mod OutputHeight;
     1062  SourceRowMod := OutputHeight;
     1063  If TopDown then
     1064  begin
     1065    OutputRow := 0;
     1066    OutputLastRow := OutputHeight-1;
     1067  end
     1068  else
     1069  begin
     1070    OutputRow := OutputHeight-1;
     1071    OutputLastRow := 0;
     1072  end;
     1073
     1074  PrevSourceRow := SourceRow-SourceRowDelta;
     1075
     1076  while ShouldContinue and (SourceRow <> SourceLastRow+SourceRowDelta) do
     1077  begin
     1078    while PrevSourceRow <> SourceRow do
     1079    begin
     1080      inc(PrevSourceRow, SourceRowDelta);
     1081      if PrevSourceRow = SourceRow then
     1082        ReadProc(PrevSourceRow,Stream)
     1083      else
     1084        SkipProc(PrevSourceRow,Stream);
     1085    end;
     1086    WriteProc(OutputRow,Img);
     1087    if OutputRow = OutputLastRow then break;
     1088
     1089    inc(OutputRow,OutputRowDelta);
     1090    inc(SourceRow,SourceRowAdd);
     1091    inc(SourceRowAcc,SourceRowAccAdd);
     1092    if SourceRowAcc >= SourceRowMod then
     1093    begin
     1094     dec(SourceRowAcc,SourceRowMod);
     1095     Inc(SourceRow,SourceRowDelta);
     1096    end;
     1097
     1098    prevPercent := percent;
     1099    inc(percent,percentAdd);
     1100    inc(percentAcc,percentAccAdd);
     1101    if percentAcc>=percentMod then inc(percent);
     1102    if (percent<>prevPercent) and Assigned(ProgressProc) then ProgressProc(percent, ShouldContinue);
     1103  end;
     1104end;
    8161105
    8171106initialization
Note: See TracChangeset for help on using the changeset viewer.