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/bgrathumbnail.pas

    r494 r521  
    99  Classes, SysUtils, BGRABitmap, BGRABitmapTypes, FPimage;
    1010
    11 function GetBitmapThumbnail(ABitmap: TBGRABitmap; AWidth,AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap= nil; AVerticalShrink : single = 1): TBGRABitmap;
     11function GetBitmapThumbnail(ABitmap: TBGRACustomBitmap; AWidth,AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap= nil; AVerticalShrink: single = 1; AHorizShrink: single = 1): TBGRABitmap; overload;
     12function GetBitmapThumbnail(ABitmap: TBGRACustomBitmap; AFormat: TBGRAImageFormat; AWidth,AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap= nil; AVerticalShrink: single = 1; AHorizShrink: single = 1): TBGRABitmap; overload;
    1213function GetFileThumbnail(AFilenameUTF8: string; AWidth,AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap= nil): TBGRABitmap;
    1314function GetStreamThumbnail(AStream: TStream; AWidth,AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; ASuggestedExtensionUTF8: string = ''; ADest: TBGRABitmap= nil): TBGRABitmap; overload;
    … …  
    2223function GetPaintDotNetThumbnail(AStream: TStream; AWidth, AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap= nil): TBGRABitmap;
    2324function GetBmpThumbnail(AStream: TStream; AWidth, AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap= nil): TBGRABitmap;
    24 {$IFDEF BGRABITMAP_USE_LCL}
    2525function GetIcoThumbnail(AStream: TStream; AWidth, AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap= nil): TBGRABitmap;
    26 {$ENDIF}
     26function GetCurThumbnail(AStream: TStream; AWidth, AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap= nil): TBGRABitmap;
    2727
    2828function GetPcxThumbnail(AStream: TStream; AWidth, AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap= nil): TBGRABitmap;
    … …  
    3434function GetBmpMioMapThumbnail(AStream: TStream; AWidth, AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap= nil): TBGRABitmap;
    3535
    36 procedure DrawThumbnailCheckers(bmp: TBGRABitmap; ARect: TRect);
     36procedure DrawThumbnailCheckers(bmp: TBGRABitmap; ARect: TRect; AIconCheckers: boolean = false);
     37
     38var
     39  ImageCheckersColor1,ImageCheckersColor2  : TBGRAPixel;
     40  IconCheckersColor1,IconCheckersColor2  : TBGRAPixel;
    3741
    3842implementation
    3943
    40 uses Types, base64, BGRAUTF8, {$IFDEF BGRABITMAP_USE_LCL}Graphics, GraphType,{$ENDIF}
     44uses Types, base64, BGRAUTF8,
    4145     DOM, XMLRead, BGRAReadJPEG, BGRAReadPng, BGRAReadGif, BGRAReadBMP,
    4246     BGRAReadPSD, BGRAReadIco, UnzipperExt, BGRAReadLzp;
    4347
    44 procedure DrawThumbnailCheckers(bmp: TBGRABitmap; ARect: TRect);
    45 begin
    46   bmp.DrawCheckers(ARect, BGRA(255,255,255), BGRA(220,220,220));
    47 end;
    48 
    49 function GetBitmapThumbnail(ABitmap: TBGRABitmap; AWidth, AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap; AVerticalShrink: single
    50   ): TBGRABitmap;
     48procedure DrawThumbnailCheckers(bmp: TBGRABitmap; ARect: TRect; AIconCheckers: boolean);
     49begin
     50  if AIconCheckers then
     51    bmp.DrawCheckers(ARect, IconCheckersColor1, IconCheckersColor2)
     52  else
     53    bmp.DrawCheckers(ARect, ImageCheckersColor1, ImageCheckersColor2);
     54end;
     55
     56function InternalGetBitmapThumbnail(ABitmap: TBGRACustomBitmap; AWidth, AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean;
     57  ADest: TBGRABitmap; AVerticalShrink: single = 1; AHorizShrink: single = 1; AShowHotSpot: boolean = false; ADarkCheckers: boolean = false): TBGRABitmap;
    5158var
    5259  factorX, factorY, factor: single;
    5360  xIcon,yIcon,wIcon,hIcon: Integer;
     61  hotspot: TPoint;
    5462begin
    5563  result := nil;
    … …  
    6472      end else
    6573        result := TBGRABitmap.Create(AWidth,AHeight,ABackColor);
    66       factorX := result.Width/ABitmap.Width;
     74      factorX := result.Width/(ABitmap.Width*AHorizShrink);
    6775      factorY := result.Height/(ABitmap.Height*AVerticalShrink);
    6876      if factorX < factorY then factor := factorX else factor := factorY;
    69       wIcon := round(ABitmap.Width*factor);
     77      wIcon := round(ABitmap.Width*AHorizShrink*factor);
     78      if wIcon = 0 then wIcon := 1;
    7079      hIcon := round(ABitmap.Height*AVerticalShrink*factor);
     80      if hIcon = 0 then hIcon := 1;
    7181      xIcon:= (result.Width-wIcon) div 2;
    7282      yIcon:= (result.Height-hIcon) div 2;
    73       if ACheckers then DrawThumbnailCheckers(result,Rect(xIcon,yIcon,xIcon+wIcon,yIcon+hIcon));
     83      if ACheckers then DrawThumbnailCheckers(result,Rect(xIcon,yIcon,xIcon+wIcon,yIcon+hIcon),ADarkCheckers);
     84      if AShowHotSpot and (wIcon > 0) and (hIcon > 0) then
     85      begin
     86        hotspot := Point(xIcon+ABitmap.HotSpot.X*wIcon div ABitmap.Width,yIcon+ABitmap.HotSpot.Y*hIcon div ABitmap.Height);
     87        result.HorizLine(xIcon,hotspot.y-1,xIcon+wIcon-1,CSSLime,dmDrawWithTransparency);
     88        result.HorizLine(xIcon,hotspot.y,xIcon+wIcon-1,CSSLime,dmDrawWithTransparency);
     89        result.HorizLine(xIcon,hotspot.y+1,xIcon+wIcon-1,CSSLime,dmDrawWithTransparency);
     90        result.VertLine(hotspot.x-1,yIcon,yIcon+hIcon-1,CSSLime,dmDrawWithTransparency);
     91        result.VertLine(hotspot.x,yIcon,yIcon+hIcon-1,CSSLime,dmDrawWithTransparency);
     92        result.VertLine(hotspot.x+1,yIcon,yIcon+hIcon-1,CSSLime,dmDrawWithTransparency);
     93      end;
    7494      if (ABackColor.alpha <> 0) or ACheckers then
    7595        result.StretchPutImage(Rect(xIcon,yIcon,xIcon+wIcon,yIcon+hIcon),ABitmap,dmDrawWithTransparency) else
    7696        result.StretchPutImage(Rect(xIcon,yIcon,xIcon+wIcon,yIcon+hIcon),ABitmap,dmSet);
     97      if AShowHotSpot and (wIcon > 0) and (hIcon > 0) then
     98      begin
     99        result.HorizLine(xIcon,yIcon+ABitmap.HotSpot.Y*hIcon div ABitmap.Height,xIcon+wIcon-1,BGRA(255,0,255,96),dmDrawWithTransparency);
     100        result.VertLine(xIcon+ABitmap.HotSpot.X*wIcon div ABitmap.Width,yIcon,yIcon+hIcon-1,BGRA(255,0,255,96),dmDrawWithTransparency);
     101      end;
    77102    end;
    78103  except
    79104  end;
     105end;
     106
     107function GetBitmapThumbnail(ABitmap: TBGRACustomBitmap; AWidth, AHeight: integer;
     108  ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap = nil;
     109  AVerticalShrink: single = 1; AHorizShrink: single = 1): TBGRABitmap;
     110begin
     111  result := InternalGetBitmapThumbnail(ABitmap,AWidth,AHeight,ABackColor,ACheckers,ADest,AVerticalShrink,AHorizShrink,
     112                                       false,false);
     113end;
     114
     115function GetBitmapThumbnail(ABitmap: TBGRACustomBitmap; AFormat: TBGRAImageFormat; AWidth, AHeight: integer;
     116  ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap = nil; AVerticalShrink: single = 1; AHorizShrink: single = 1): TBGRABitmap;
     117begin
     118  result := InternalGetBitmapThumbnail(ABitmap,AWidth,AHeight,ABackColor,ACheckers,ADest,AVerticalShrink,AHorizShrink,
     119                                       AFormat = ifCur, AFormat in[ifCur,ifIco]);
     120
    80121end;
    81122
    … …  
    83124var stream: TFileStreamUTF8;
    84125begin
     126  result := nil;
    85127  try
    86128    stream := TFileStreamUTF8.Create(AFilenameUTF8,fmOpenRead or fmShareDenyWrite);
    87129  except
    88     result := nil;
    89130    exit;
    90131  end;
    … …  
    99140  ABackColor: TBGRAPixel; ACheckers: boolean; ASuggestedExtensionUTF8: string;
    100141  ADest: TBGRABitmap): TBGRABitmap;
    101 begin
    102   case DetectFileFormat(AStream,ASuggestedExtensionUTF8) of
     142var
     143  ff: TBGRAImageFormat;
     144  reader: TFPCustomImageReader;
     145begin
     146  ff := DetectFileFormat(AStream,ASuggestedExtensionUTF8);
     147  case ff of
    103148    ifJpeg: result := GetJpegThumbnail(AStream, AWidth,AHeight, ABackColor, ACheckers, ADest);
    104     ifPng: result := GetPngThumbnail(AStream, AWidth,AHeight, ABackColor, ACheckers, ADest);
    105     ifGif: result := GetGifThumbnail(AStream, AWidth,AHeight, ABackColor, ACheckers, ADest);
    106     ifBmp: result := GetBmpThumbnail(AStream, AWidth,AHeight, ABackColor, ACheckers, ADest);
    107     {$IFDEF BGRABITMAP_USE_LCL}
    108149    ifIco: result := GetIcoThumbnail(AStream, AWidth,AHeight, ABackColor, ACheckers, ADest);
    109     {$ENDIF}
    110     ifPcx: result := GetPcxThumbnail(AStream, AWidth,AHeight, ABackColor, ACheckers, ADest);
     150    ifCur: result := GetCurThumbnail(AStream, AWidth,AHeight, ABackColor, ACheckers, ADest);
    111151    ifPaintDotNet: result := GetPaintDotNetThumbnail(AStream, AWidth,AHeight, ABackColor, ACheckers, ADest);
    112152    ifLazPaint: result := GetLazPaintThumbnail(AStream, AWidth,AHeight, ABackColor, ACheckers, ADest);
    … …  
    114154    ifPhoxo: result := GetPhoxoThumbnail(AStream, AWidth,AHeight, ABackColor, ACheckers, ADest);
    115155    ifPsd: result := GetPsdThumbnail(AStream, AWidth,AHeight, ABackColor, ACheckers, ADest);
    116     ifTarga: result := GetTargaThumbnail(AStream, AWidth,AHeight, ABackColor, ACheckers, ADest);
    117     ifTiff: result := GetTiffThumbnail(AStream, AWidth,AHeight, ABackColor, ACheckers, ADest);
    118     ifXwd: result := GetXwdThumbnail(AStream, AWidth,AHeight, ABackColor, ACheckers, ADest);
    119     ifXPixMap: result := GetXPixMapThumbnail(AStream, AWidth,AHeight, ABackColor, ACheckers, ADest);
    120     ifBmpMioMap: result := GetBmpMioMapThumbnail(AStream, AWidth,AHeight, ABackColor, ACheckers, ADest);
    121156    else
    122       result := nil;
     157    begin
     158      if (ff = ifUnknown) or (DefaultBGRAImageReader[ff] = nil) then
     159        result := nil
     160      else
     161      begin
     162        result := nil;
     163        reader := nil;
     164        try
     165          reader := CreateBGRAImageReader(ff);
     166          result := GetStreamThumbnail(AStream, reader, AWidth, AHeight, ABackColor, ACheckers, ADest);
     167        finally
     168          reader.Free;
     169        end;
     170      end;
     171    end;
    123172  end;
    124173end;
    … …  
    127176  AWidth, AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean;
    128177  ADest: TBGRABitmap): TBGRABitmap;
    129 var bmp: TBGRABitmap;
    130 begin
     178var
     179  bmp: TBGRACustomBitmap;
     180  AOriginalWidth, AOriginalHeight: integer;
     181begin
     182  if AReader is TBGRAImageReader then
     183  begin
     184    bmp := nil;
     185    try
     186      bmp := TBGRAImageReader(AReader).GetBitmapDraft(AStream, AWidth,AHeight, AOriginalWidth,AOriginalHeight);
     187      if Assigned(bmp) and (bmp.Height <> 0) and (bmp.Width <> 0) then
     188        result := GetBitmapThumbnail(bmp, AWidth, AHeight, ABackColor, ACheckers, ADest,
     189                    AOriginalHeight/bmp.Height, AOriginalWidth/bmp.Width);
     190    except
     191      result := nil;
     192    end;
     193    bmp.free;
     194    exit;
     195  end;
     196
    131197  bmp := TBGRABitmap.Create;
    132198  try
    … …  
    143209  end;
    144210end;
    145 
    146 
    147211
    148212function GetOpenRasterThumbnail(AStream: TStream; AWidth, AHeight: integer;
    … …  
    234298end;
    235299
    236 function GetPngThumbnail(AStream: TStream; AWidth, AHeight: integer
    237   ; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap= nil): TBGRABitmap;
    238 var
    239   png: TBGRAReaderPNG;
    240   bmp: TBGRABitmap;
    241 begin
    242   png:= TBGRAReaderPNG.Create;
    243   bmp := TBGRABitmap.Create;
    244   try
    245     png.MinifyHeight := AHeight;
    246     bmp.LoadFromStream(AStream, png);
    247   except
    248     FreeAndNil(bmp);
    249   end;
    250   if bmp = nil then
    251     result := nil
    252   else
    253   begin
    254     result := GetBitmapThumbnail(bmp, AWidth, AHeight, ABackColor, ACheckers, ADest, png.OriginalHeight/bmp.Height);
    255     bmp.Free;
    256   end;
    257   png.Free;
     300function GetPngThumbnail(AStream: TStream; AWidth, AHeight: integer;
     301    ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap= nil): TBGRABitmap;
     302var
     303  pngFormat: TBGRAReaderPNG;
     304begin
     305  pngFormat:= TBGRAReaderPNG.Create;
     306  result:= GetStreamThumbnail(AStream, pngFormat, AWidth,AHeight, ABackColor, ACheckers, ADest);
     307  pngFormat.Free;
    258308end;
    259309
    … …  
    303353        if Assigned(pngNode) then
    304354        begin
    305           png64 := TStringStream.Create(pngNode.NodeValue);
     355          png64 := TStringStream.Create(string(pngNode.NodeValue));
    306356          try
    307357            png64.Position := 0;
    … …  
    327377var
    328378  bmpFormat: TBGRAReaderBMP;
    329   bmp: TBGRABitmap;
    330379begin
    331380  bmpFormat:= TBGRAReaderBMP.Create;
    332   bmpFormat.MinifyHeight := AHeight*2;
    333   bmp := TBGRABitmap.Create;
    334   try
    335     bmp.LoadFromStream(AStream, bmpFormat);
    336   except
    337     FreeAndNil(bmp);
    338   end;
    339   if bmp = nil then
    340     result := nil
    341   else
    342   begin
    343     if bmp.Height <= 0 then
    344       result := nil
    345     else
    346       result := GetBitmapThumbnail(bmp, AWidth, AHeight, ABackColor, ACheckers, ADest, bmpFormat.OriginalHeight/bmp.Height);
    347     bmp.Free;
    348   end;
     381  result:= GetStreamThumbnail(AStream, bmpFormat, AWidth,AHeight, ABackColor, ACheckers, ADest);
    349382  bmpFormat.Free;
    350383end;
    351384
    352 {$IFDEF BGRABITMAP_USE_LCL}
    353385function GetIcoThumbnail(AStream: TStream; AWidth, AHeight: integer;
    354386  ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap): TBGRABitmap;
    355 var ico: TIcon; i,bestIdx: integer;
    356     height,width: word; format:TPixelFormat;
    357     bestHeight,bestWidth: integer; maxFormat: TPixelFormat;
    358     icoBmp: TBGRABitmap;
     387var
     388  reader: TBGRAReaderIco;
     389  icoBmp: TBGRABitmap;
    359390begin
    360391  result := nil;
    361   ico := TIcon.Create;
    362   try
    363     ico.LoadFromStream(AStream);
    364   except
    365     ico.free;
    366     exit;
    367   end;
    368   bestIdx := -1;
    369   bestHeight := 0;
    370   bestWidth := 0;
    371   maxFormat := pfDevice;
    372   try
    373     for i := 0 to ico.Count-1 do
    374     begin
    375       ico.GetDescription(i,format,height,width);
    376       if (bestIdx = -1) or (abs(height-AHeight)+abs(width-AWidth) < abs(bestHeight-AHeight)+abs(bestWidth-AWidth)) or
    377       ((height = bestHeight) or (width = bestWidth) and (format > maxFormat)) then
    378       begin
    379         bestIdx := i;
    380         bestHeight := height;
    381         bestWidth := width;
    382         maxFormat := format;
    383       end;
    384     end;
    385     if (bestIdx = -1) or (bestWidth = 0) or (bestHeight = 0) then result := nil else
    386     begin
    387       ico.Current := bestIdx;
    388       icoBmp := TBGRABitmap.Create(bestWidth,bestHeight);
    389       icoBmp.Assign(ico);
    390       result := GetBitmapThumbnail(icoBmp, AWidth, AHeight, ABackColor, ACheckers, ADest);
    391       icoBmp.Free;
    392     end;
    393   except
    394   end;
    395   ico.Free;
    396 end;
    397 {$ENDIF}
     392  reader := TBGRAReaderIco.Create;
     393  reader.WantedWidth:= AWidth;
     394  reader.WantedHeight:= AHeight;
     395  icoBmp := TBGRABitmap.Create;
     396  try
     397    icoBmp.LoadFromStream(AStream, reader);
     398    result := GetBitmapThumbnail(icoBmp, ifIco, AWidth, AHeight, ABackColor, ACheckers, ADest);
     399  except
     400  end;
     401  icoBmp.Free;
     402  reader.Free;
     403end;
     404
     405function GetCurThumbnail(AStream: TStream; AWidth, AHeight: integer;
     406  ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap): TBGRABitmap;
     407var
     408  reader: TBGRAReaderCur;
     409  icoBmp: TBGRABitmap;
     410begin
     411  result := nil;
     412  reader := TBGRAReaderCur.Create;
     413  reader.WantedWidth:= AWidth;
     414  reader.WantedHeight:= AHeight;
     415  icoBmp := TBGRABitmap.Create;
     416  try
     417    icoBmp.LoadFromStream(AStream, reader);
     418    result := GetBitmapThumbnail(icoBmp, ifCur, AWidth, AHeight, ABackColor, ACheckers, ADest);
     419  except
     420  end;
     421  icoBmp.Free;
     422  reader.Free;
     423end;
    398424
    399425function GetPcxThumbnail(AStream: TStream; AWidth, AHeight: integer;
    … …  
    467493end;
    468494
     495initialization
     496
     497  IconCheckersColor1 := BGRA(140,180,180);
     498  IconCheckersColor2 := BGRA(80,140,140);
     499
     500  ImageCheckersColor1 := BGRA(255,255,255);
     501  ImageCheckersColor2 := BGRA(220,220,220);
     502
    469503end.
Note: See TracChangeset for help on using the changeset viewer.