lcl: implement .icns (osx icon resource) graphic reader

git-svn-id: trunk@15612 -

.gitattributes

@@ -2811,6 +2811,7 @@ lcl/graphtype.pp svneol=native#text/pascal
 lcl/graphutil.pp svneol=native#text/pascal
 lcl/grids.pas svneol=native#text/pascal
 lcl/helpintfs.pas svneol=native#text/plain
+lcl/icnstypes.pas svneol=native#text/pascal
 lcl/imagelistcache.pas svneol=native#text/pascal
 lcl/images/README.txt svneol=native#text/plain
 lcl/images/btncalccancel.xpm -text svneol=native#image/x-xpixmap
@@ -2963,6 +2964,7 @@ lcl/include/graphiccontrol.inc svneol=native#text/pascal
 lcl/include/graphicsobject.inc svneol=native#text/pascal
 lcl/include/headercontrol.inc svneol=native#text/pascal
 lcl/include/hintwindow.inc svneol=native#text/pascal
+lcl/include/icnsicon.inc svneol=native#text/pascal
 lcl/include/icon.inc svneol=native#text/pascal
 lcl/include/idletimer.inc svneol=native#text/pascal
 lcl/include/imglist.inc svneol=native#text/pascal

lcl/graphics.pp

@@ -42,7 +42,7 @@ uses
   IntfGraphics,
   AvgLvlTree,
   LCLStrConsts, LCLType, LCLProc, LMessages, LCLIntf, LResources, LCLResCache,
-  GraphType, GraphMath, InterfaceBase, WSReferences;
+  GraphType, IcnsTypes, GraphMath, InterfaceBase, WSReferences;
 
 
 type
@@ -1489,6 +1489,8 @@ type
     property Current: Integer read FCurrent write SetCurrent;
     property Count: Integer read GetCount;
   end;
+
+  { TIcon }
   
   TIcon = class(TCustomIcon)
   private
@@ -1500,6 +1502,45 @@ type
     function ReleaseHandle: HICON;
     property Handle: HICON read GetIconHandle write SetIconHandle;
   end;
+  
+  TIcnsRec = record
+    IconType: TicnsIconType;
+    RawImage: TRawImage;
+  end;
+  PIcnsRec = ^TIcnsRec;
+
+  { TIcnsList }
+
+  TIcnsList = class(TList)
+  private
+    function GetItem(Index: Integer): PIcnsRec;
+    procedure SetItem(Index: Integer; const AValue: PIcnsRec);
+  protected
+    procedure Notify(Ptr: Pointer; Action: TListNotification); override;
+  public
+    function Add(AIconType: TicnsIconType; ARawImage: TRawImage): Integer; reintroduce;
+    property Items[Index: Integer]: PIcnsRec read GetItem write SetItem; default;
+  end;
+
+  { TIcnsIcon }
+
+  TIcnsIcon = class(TCustomIcon)
+  private
+    FImageList: TIcnsList;
+    FMaskList: TIcnsList;
+    procedure IcnsAdd(AIconType: TicnsIconType; ARawImage: TRawImage);
+    procedure IcnsProcess;
+  protected
+    procedure ReadData(Stream: TStream); override;
+    procedure ReadStream(AStream: TMemoryStream; ASize: Longint); override;
+    procedure WriteStream(AStream: TMemoryStream); override;
+  public
+    constructor Create; override;
+    destructor Destroy; override;
+
+    class function GetFileExtensions: string; override;
+    function LazarusResourceTypeValid(const ResourceType: string): boolean; override;
+  end;
 
   { TSharedCursorImage }
 
@@ -2173,6 +2214,7 @@ end;
 {$I jpegimage.inc}
 {$I cursorimage.inc}
 {$I icon.inc}
+{$I icnsicon.inc}
 {$I fpimagebitmap.inc}
 {$I bitmap.inc}
 

lcl/icnstypes.pas

@@ -0,0 +1,252 @@
+{  $Id$  }
+{
+ /***************************************************************************
+                              IcnsTypes.pas
+                              ---------------
+
+ ***************************************************************************/
+
+ *****************************************************************************
+ *                                                                           *
+ *  This file is part of the Lazarus Component Library (LCL)                 *
+ *                                                                           *
+ *  See the file COPYING.modifiedLGPL, included in this distribution,        *
+ *  for details about the copyright.                                         *
+ *                                                                           *
+ *  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.                     *
+ *                                                                           *
+ *****************************************************************************
+
+  Author: Paul Ishenin
+
+  Abstract:
+    Types, consts and functions we need to read MAC osx icon resource files - icns
+  Most defines present here were taken from univint package of fpc
+}
+unit IcnsTypes;
+
+{$mode objfpc}{$H+}
+
+interface
+
+type
+  FourCharCode = array[0..3] of char;
+
+type
+  TIconFamilyElement = record
+    elementType: FourCharCode; {  'ICN#', 'icl8', etc... }
+    elementSize: LongInt;      { Size of this element }
+  end;
+
+  TIconFamilyResource = record
+    resourceType: FourCharCode; {  Always 'icns' }
+    resourceSize: LongInt;      {  Total size of this resource }
+  end;
+
+const
+  kIconFamilyType = 'icns';
+
+  kIconServices512PixelDataARGB: FourCharCode = 'ic09';
+  kIconServices256PixelDataARGB: FourCharCode = 'ic08';
+  kThumbnail32BitData          : FourCharCode = 'it32';
+  kThumbnail8BitMask           : FourCharCode = 't8mk';
+  kHuge1BitMask                : FourCharCode = 'ich#';
+  kHuge4BitData                : FourCharCode = 'ich4';
+  kHuge8BitData                : FourCharCode= 'ich8';
+  kHuge32BitData               : FourCharCode= 'ih32';
+  kHuge8BitMask                : FourCharCode= 'h8mk';
+  {	 The following icon types can be used as a resource type 	}
+  {	 or as an icon element type inside a 'icns' icon family 	}
+  kLarge1BitMask               : FourCharCode= 'ICN#';
+  kLarge4BitData               : FourCharCode= 'icl4';
+  kLarge8BitData               : FourCharCode= 'icl8';
+  kLarge32BitData              : FourCharCode= 'il32';
+  kLarge8BitMask               : FourCharCode= 'l8mk';
+  kSmall1BitMask               : FourCharCode= 'ics#';
+  kSmall4BitData               : FourCharCode= 'ics4';
+  kSmall8BitData               : FourCharCode= 'ics8';
+  kSmall32BitData              : FourCharCode= 'is32';
+  kSmall8BitMask               : FourCharCode= 's8mk';
+  kMini1BitMask                : FourCharCode= 'icm#';
+  kMini4BitData                : FourCharCode= 'icm4';
+  kMini8BitData                : FourCharCode= 'icm8';
+
+type
+  // from lower to higher
+  TicnsIconType =
+  (
+    iitNone,
+    // data icons
+    iitMini4BitData,
+    iitMini8BitData,
+    iitSmall4BitData,
+    iitSmall8BitData,
+    iitSmall32BitData,
+    iitLarge4BitData,
+    iitLarge8BitData,
+    iitLarge32BitData,
+    iitHuge4BitData,
+    iitHuge8BitData,
+    iitHuge32BitData,
+    iitThumbnail32BitData,
+    // mask icons
+    iitMini1BitMask,
+    iitSmall1BitMask,
+    iitSmall8BitMask,
+    iitLarge1BitMask,
+    iitLarge8BitMask,
+    iitHuge1BitMask,
+    iitHuge8BitMask,
+    iitThumbnail8BitMask,
+    // alpha icons
+    iit256PixelDataARGB,
+    iit512PixelDataARGB
+  );
+  
+  TicnsIconTypes = set of TicnsIconType;
+  
+  TicnsIconInfo = record
+    Width: Integer;
+    Height: Integer;
+    Depth: Integer;
+  end;
+
+const
+  icnsDataTypes =
+    [
+      iitMini4BitData, iitMini8BitData, iitSmall4BitData, iitSmall8BitData,
+      iitSmall32BitData, iitLarge4BitData, iitLarge8BitData, iitLarge32BitData,
+      iitHuge4BitData, iitHuge8BitData, iitHuge32BitData, iitThumbnail32BitData
+    ];
+  icnsMaskTypes =
+    [
+      iitMini1BitMask, iitSmall1BitMask, iitSmall8BitMask, iitLarge1BitMask,
+      iitLarge8BitMask, iitHuge1BitMask, iitHuge8BitMask, iitThumbnail8BitMask
+    ];
+  icnsRGB =
+    [
+      iitSmall32BitData, iitLarge32BitData, iitHuge32BitData, iitThumbnail32BitData
+    ];
+  icnsWithAlpha =
+    [
+      iit256PixelDataARGB, iit512PixelDataARGB
+    ];
+
+  icnsIconTypeInfo: array[TicnsIconType] of TicnsIconInfo =
+  (
+ { iitNone               } (Width: 000; Height: 000; Depth: 00),
+ { iitMini4BitData       } (Width: 016; Height: 012; Depth: 04),
+ { iitMini8BitData       } (Width: 016; Height: 012; Depth: 08),
+ { iitSmall4BitData      } (Width: 016; Height: 016; Depth: 04),
+ { iitSmall8BitData      } (Width: 016; Height: 016; Depth: 08),
+ { iitSmall32BitData     } (Width: 016; Height: 016; Depth: 32),
+ { iitLarge4BitData      } (Width: 032; Height: 032; Depth: 04),
+ { iitLarge8BitData      } (Width: 032; Height: 032; Depth: 08),
+ { iitLarge32BitData     } (Width: 032; Height: 032; Depth: 32),
+ { iitHuge4BitData       } (Width: 048; Height: 048; Depth: 04),
+ { iitHuge8BitData       } (Width: 048; Height: 048; Depth: 08),
+ { iitHuge32BitData      } (Width: 048; Height: 048; Depth: 32),
+ { iitThumbnail32BitData } (Width: 128; Height: 128; Depth: 32),
+ { iitMini1BitMask       } (Width: 016; Height: 012; Depth: 01),
+ { iitSmall1BitMask      } (Width: 016; Height: 016; Depth: 01),
+ { iitSmall8BitMask      } (Width: 016; Height: 016; Depth: 08),
+ { iitLarge1BitMask      } (Width: 032; Height: 032; Depth: 01),
+ { iitLarge8BitMask      } (Width: 032; Height: 032; Depth: 08),
+ { iitHuge1BitMask       } (Width: 048; Height: 048; Depth: 01),
+ { iitHuge8BitMask       } (Width: 048; Height: 048; Depth: 08),
+ { iitThumbnail8BitMask  } (Width: 128; Height: 128; Depth: 08),
+ { iit256PixelDataARGB   } (Width: 256; Height: 256; Depth: 32),
+ { iit512PixelDataARGB   } (Width: 512; Height: 512; Depth: 32)
+  );
+  
+  icnsMaskToImageMap: array[iitMini1BitMask..iitThumbnail8BitMask] of TicnsIconTypes =
+  (
+ { iitMini1BitMask       } [iitMini4BitData, iitMini8BitData],
+ { iitSmall1BitMask      } [iitSmall4BitData, iitSmall8BitData, iitSmall32BitData],
+ { iitSmall8BitMask      } [iitSmall4BitData, iitSmall8BitData, iitSmall32BitData],
+ { iitLarge1BitMask      } [iitLarge4BitData, iitLarge8BitData, iitLarge32BitData],
+ { iitLarge8BitMask      } [iitLarge4BitData, iitLarge8BitData, iitLarge32BitData],
+ { iitHuge1BitMask       } [iitHuge4BitData, iitHuge8BitData, iitHuge32BitData],
+ { iitHuge8BitMask       } [iitHuge4BitData, iitHuge8BitData, iitHuge32BitData],
+ { iitThumbnail8BitMask  } [iitThumbnail32BitData]
+  );
+
+function GetIcnsIconType(StrIconType: FourCharCode): TicnsIconType;
+
+implementation
+
+function GetIcnsIconType(StrIconType: FourCharCode): TicnsIconType;
+begin
+  Result := iitNone;
+
+  if StrIconType = kMini4BitData then
+    exit(iitMini4BitData);
+    
+  if StrIconType = kMini8BitData then
+    exit(iitMini8BitData);
+
+  if StrIconType = kSmall4BitData then
+    exit(iitSmall4BitData);
+
+  if StrIconType = kSmall8BitData then
+    exit(iitSmall8BitData);
+
+  if StrIconType = kSmall32BitData then
+    exit(iitSmall32BitData);
+
+  if StrIconType = kLarge4BitData then
+    exit(iitLarge4BitData);
+
+  if StrIconType = kLarge8BitData then
+    exit(iitLarge8BitData);
+
+  if StrIconType = kLarge32BitData then
+    exit(iitLarge32BitData);
+
+  if StrIconType = kHuge4BitData then
+    exit(iitHuge4BitData);
+
+  if StrIconType = kHuge8BitData then
+    exit(iitHuge8BitData);
+
+  if StrIconType = kHuge32BitData then
+    exit(iitHuge32BitData);
+    
+  if StrIconType = kThumbnail32BitData then
+    exit(iitThumbnail32BitData);
+
+  if StrIconType = kMini1BitMask then
+    exit(iitMini1BitMask);
+
+  if StrIconType = kSmall1BitMask then
+    exit(iitSmall1BitMask);
+
+  if StrIconType = kSmall8BitMask then
+    exit(iitSmall8BitMask);
+
+  if StrIconType = kLarge1BitMask then
+    exit(iitLarge1BitMask);
+
+  if StrIconType = kLarge8BitMask then
+    exit(iitLarge8BitMask);
+
+  if StrIconType = kHuge1BitMask then
+    exit(iitHuge1BitMask);
+
+  if StrIconType = kHuge8BitMask then
+    exit(iitHuge8BitMask);
+
+  if StrIconType = kThumbnail8BitMask then
+    exit(iitThumbnail8BitMask);
+
+  if StrIconType = kIconServices256PixelDataARGB then
+    exit(iit256PixelDataARGB);
+
+  if StrIconType = kIconServices512PixelDataARGB then
+    exit(iit512PixelDataARGB);
+end;
+
+end.
+

lcl/include/icnsicon.inc

@@ -0,0 +1,246 @@
+{%MainUnit ../graphics.pp}
+
+{******************************************************************************
+                               TicnsIcon
+ ******************************************************************************
+
+ *****************************************************************************
+ *                                                                           *
+ *  This file is part of the Lazarus Component Library (LCL)                 *
+ *                                                                           *
+ *  See the file COPYING.modifiedLGPL, included in this distribution,        *
+ *  for details about the copyright.                                         *
+ *                                                                           *
+ *  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.                     *
+ *                                                                           *
+ *****************************************************************************
+}
+
+{ TIcnsList }
+
+function TIcnsList.GetItem(Index: Integer): PIcnsRec;
+begin
+  Result := inherited Get(Index);
+end;
+
+procedure TIcnsList.SetItem(Index: Integer; const AValue: PIcnsRec);
+begin
+  inherited Put(Index, AValue);
+end;
+
+procedure TIcnsList.Notify(Ptr: Pointer; Action: TListNotification);
+begin
+  if Action = lnDeleted then
+    Dispose(PIcnsRec(Ptr));
+  inherited Notify(Ptr, Action);
+end;
+
+function TIcnsList.Add(AIconType: TicnsIconType; ARawImage: TRawImage): Integer;
+var
+  Rec: PIcnsRec;
+begin
+  New(Rec);
+  Rec^.IconType := AIconType;
+  Rec^.RawImage := ARawImage;
+  Result := inherited Add(Rec);
+end;
+
+{ TIcnsIcon }
+
+procedure TIcnsIcon.IcnsAdd(AIconType: TicnsIconType; ARawImage: TRawImage);
+
+  function GetMaskList: TIcnsList;
+  begin
+    if FMaskList = nil then
+      FMaskList := TIcnsList.Create;
+    Result := FMaskList;
+  end;
+
+  function GetImageList: TIcnsList;
+  begin
+    if FImageList = nil then
+      FImageList := TIcnsList.Create;
+    Result := FImageList;
+  end;
+
+begin
+  if AIconType in icnsMaskTypes
+  then GetMaskList.Add(AIconType, ARawImage)
+  else GetImageList.Add(AIconType, ARawImage);
+end;
+
+procedure TIcnsIcon.IcnsProcess;
+
+  procedure MergeMask(var AImage, AMask: TRawImage);
+  var
+    LazIntfImage, LazIntfMask: TLazIntfImage;
+    Col, Row: Integer;
+    Color: TFpColor;
+  begin
+    if AMask.Description.Depth = 1 then
+    begin
+      // merge mask
+      AImage.Description.MaskBitOrder := AMask.Description.MaskBitOrder;
+      AImage.Description.MaskLineEnd := AMask.Description.MaskLineEnd;
+      AImage.Description.MaskBitsPerPixel := AMask.Description.MaskBitsPerPixel;
+      AImage.Description.MaskShift := AMask.Description.MaskShift;
+      AImage.MaskSize := AMask.MaskSize;
+      AImage.Mask := ReallocMem(AImage.Mask, AMask.MaskSize);
+      Move(AMask.Mask^, AImage.Mask^, AMask.MaskSize);
+    end
+    else
+    begin
+      LazIntfImage := TLazIntfImage.Create(AImage, False);
+      LazIntfMask := TLazIntfImage.Create(AMask, False);
+      for Row := 0 to LazIntfImage.Height - 1 do
+        for Col := 0 to LazIntfImage.Width - 1 do
+        begin
+          Color := LazIntfImage.Colors[Col,Row];
+          Color.alpha := LazIntfMask.Colors[Col,Row].alpha;
+          LazIntfImage.Colors[Col,Row] := Color;
+        end;
+      LazIntfMask.Free;
+      LazIntfImage.Free;
+    end;
+  end;
+
+var
+  i, AIndex: integer;
+  IconType: TicnsIconType;
+  ImagesForMask: TicnsIconTypes;
+  IconImage: TIconImage;
+begin
+  // merge separate image and masc rawdata together
+
+  if FMaskList <> nil then
+  begin
+    for i := 0 to FMaskList.Count - 1 do
+    begin
+      ImagesForMask := icnsMaskToImageMap[FMaskList[i]^.IconType];
+      for AIndex := 0 to FImageList.Count - 1 do
+        if FImageList[AIndex]^.IconType in ImagesForMask then
+          MergeMask(FImageList[AIndex]^.RawImage, FMaskList[i]^.RawImage);
+      // dispose RawImage since no more needed
+      FMaskList[i]^.RawImage.FreeData;
+    end;
+    FreeAndNil(FMaskList);
+  end;
+
+  IconType := iitNone;
+  for i := 0 to FImageList.Count - 1 do
+  begin
+    // todo: we have no jpeg 2000 reader to decompress their data => skip for now
+    if FImageList[i]^.IconType in icnsWithAlpha then
+      Continue;
+
+    // Add image
+    with TSharedIcon(FSharedImage) do
+    begin
+      IconImage := GetImagesClass.Create(FImageList[i]^.RawImage);
+      Add(IconImage);
+    end;
+    if FImageList[i]^.IconType > IconType then
+    begin
+      IconType := FImageList[i]^.IconType;
+      FCurrent := TSharedIcon(FSharedImage).Count - 1;
+    end;
+  end;
+  FreeAndNil(FImageList);
+end;
+
+constructor TIcnsIcon.Create;
+begin
+  inherited Create;
+  FImageList := nil;
+  FMaskList := nil;
+end;
+
+destructor TIcnsIcon.Destroy;
+begin
+  inherited Destroy;
+  FImageList.Free;
+  FMaskList.Free;
+end;
+
+procedure TIcnsIcon.ReadData(Stream: TStream);
+var
+  Resource: TIconFamilyResource;
+  Position: Int64;
+begin
+  Position := Stream.Position;
+  Stream.Read(Resource, SizeOf(Resource));
+  if Resource.resourceType = kIconFamilyType then
+  begin
+    Stream.Position := Position;
+    LoadFromStream(Stream, BEtoN(Resource.resourceSize))
+  end else
+  begin
+    Stream.Position := Position;
+    LoadFromStream(Stream);
+  end;
+end;
+
+procedure TIcnsIcon.ReadStream(AStream: TMemoryStream; ASize: Longint);
+var
+  Resource: TIconFamilyResource;
+
+  IntfImage: TLazIntfImage;
+  ImgReader: TLazReaderIcnsPart;
+  LazReader: ILazImageReader;
+  RawImage: TRawImage;
+begin
+  AStream.Read(Resource, SizeOf(Resource));
+
+  if (Resource.resourceType <> kIconFamilyType) then
+    raise EInvalidGraphic.Create('Stream is not an ICNS type');
+
+  IntfImage := nil;
+  ImgReader := nil;
+
+  Resource.resourceSize := BEtoN(Resource.resourceSize);
+
+  if ASize > Resource.resourceSize then
+    ASize := Resource.resourceSize;
+
+  while AStream.Position < ASize do
+  begin
+    if IntfImage = nil
+    then IntfImage := TLazIntfImage.Create(0,0)
+    else IntfImage.SetSize(0,0);
+
+    if ImgReader = nil
+    then ImgReader := TLazReaderIcnsPart.Create;
+
+    if Supports(ImgReader, ILazImageReader, LazReader)
+    then LazReader.UpdateDescription := True
+    else IntfImage.DataDescription := QueryDescription([riqfRGB, riqfAlpha, riqfMask]); // fallback to default
+
+    ImgReader.ImageRead(AStream, IntfImage);
+    IntfImage.GetRawImage(RawImage, True);
+
+    IcnsAdd(ImgReader.IconType, RawImage);
+  end;
+
+  LazReader := nil;
+  IntfImage.Free;
+  ImgReader.Free;
+
+  IcnsProcess;
+end;
+
+procedure TIcnsIcon.WriteStream(AStream: TMemoryStream);
+begin
+  //
+end;
+
+class function TIcnsIcon.GetFileExtensions: string;
+begin
+  Result := 'icns';
+end;
+
+function TIcnsIcon.LazarusResourceTypeValid(const ResourceType: string): boolean;
+begin
+  Result := (UpperCase(ResourceType) = 'ICNS');
+end;

lcl/intfgraphics.pas

@@ -32,7 +32,7 @@ interface
 
 uses
   Classes, SysUtils, fpImage, FPReadBMP, BMPComn, FPCAdds, AvgLvlTree, LCLType,
-  LCLProc, GraphType, LCLIntf, FPReadPNG;
+  LCLProc, GraphType, LCLIntf, FPReadPNG, IcnsTypes;
 
 type
   { TLazIntfImage }
@@ -515,6 +515,39 @@ type
     property UpdateDescription: Boolean read GetUpdateDescription write SetUpdateDescription;
   end;
 
+  { TLazReaderIcnsPart }
+
+  TLazReaderIcnsPart = class(TFPCustomImageReader, ILazImageReader)
+  private
+    FUpdateDescription: Boolean;
+    FPalette: TFPPalette;
+    FImage: TLazIntfImage;
+    FData: PByte;
+    FCalcSize: Integer;
+    FDataSize: Integer;
+    FIconType: TicnsIconType;
+    FIconInfo: TicnsIconInfo;
+  protected
+    function  InternalCheck(Str:TStream): boolean; override;
+    procedure InternalRead(Stream: TStream; Img: TFPCustomImage); override;
+    function QueryInterface(const iid: TGuid; out obj): LongInt; stdcall;
+    function _AddRef: LongInt; stdcall;
+    function _Release: LongInt; stdcall;
+    function GetUpdateDescription: Boolean;
+    procedure SetUpdateDescription(AValue: Boolean);
+    procedure SetupRead(AWidth, AHeight, ADepth: Integer; IsMask: Boolean);
+    function Create256ColorPalette: TFPPalette;
+    procedure DoReadRaw;
+    procedure DoReadRLE;
+    procedure DoReadJpeg2000;
+    procedure DoReadMask;
+  public
+    constructor Create; override;
+    destructor Destroy; override;
+    property UpdateDescription: Boolean read GetUpdateDescription write SetUpdateDescription;
+    property IconType: TicnsIconType read FIconType;
+    property DataSize: Integer read FDataSize;
+  end;
 
 // extra Rawimage utility functions
 
@@ -5208,6 +5241,327 @@ begin
   Result := -1;
 end;
 
+{ TLazReaderIcnsPart }
+
+function TLazReaderIcnsPart.InternalCheck(Str: TStream): boolean;
+begin
+  // todo: write check code
+  Result := True;
+end;
+
+procedure TLazReaderIcnsPart.InternalRead(Stream: TStream; Img: TFPCustomImage);
+var
+  Desc: TRawImageDescription;
+  Element: TIconFamilyElement;
+  IsMask: Boolean;
+begin
+  FImage := TheImage as TLazIntfImage;
+
+  Stream.Read(Element, SizeOf(Element));
+  Element.elementSize := BEtoN(Element.elementSize);
+  FIconType := GetIcnsIconType(Element.elementType);
+  FIconInfo := icnsIconTypeInfo[FIconType];
+  IsMask := FIconType in icnsMaskTypes;
+
+  if UpdateDescription
+  then begin
+    if IsMask then
+    begin
+      if FIconInfo.Depth = 1 then
+        DefaultReaderDescription(FIconInfo.Width, FIconInfo.Height, FIconInfo.Depth, Desc)
+      else
+        DefaultReaderDescription(FIconInfo.Width, FIconInfo.Height, 32, Desc);
+    end
+    else
+      DefaultReaderDescription(FIconInfo.Width, FIconInfo.Height, FIconInfo.Depth, Desc);
+    if (Desc.BitsPerPixel = 32) then
+      Desc.MaskBitsPerPixel := 0;
+    FImage.DataDescription := Desc;
+  end
+  else Desc := FImage.DataDescription;
+
+  SetupRead(FIconInfo.Width, FIconInfo.Height, FIconInfo.Depth, IsMask);
+
+  FDataSize := Element.elementSize - SizeOf(Element);
+
+  GetMem(FData, FDataSize);
+  try
+    Stream.Read(FData^, FDataSize);
+    if FIconType in icnsWithAlpha then
+      DoReadJpeg2000
+    else
+    if IsMask then
+      DoReadMask
+    else
+    if FIconType in icnsRGB then
+      DoReadRLE
+    else
+      DoReadRaw;
+  finally
+    FreeMem(FData);
+    FData := nil;
+  end;
+end;
+
+function TLazReaderIcnsPart.QueryInterface(const iid: TGuid; out obj): LongInt; stdcall;
+begin
+  if GetInterface(iid, obj)
+  then Result := S_OK
+  else Result := E_NOINTERFACE;
+end;
+
+function TLazReaderIcnsPart._AddRef: LongInt; stdcall;
+begin
+  Result := -1;
+end;
+
+function TLazReaderIcnsPart._Release: LongInt; stdcall;
+begin
+  Result := -1;
+end;
+
+function TLazReaderIcnsPart.GetUpdateDescription: Boolean;
+begin
+  Result := FUpdateDescription;
+end;
+
+procedure TLazReaderIcnsPart.SetUpdateDescription(AValue: Boolean);
+begin
+  FUpdateDescription := AValue;
+end;
+
+procedure TLazReaderIcnsPart.SetupRead(AWidth, AHeight, ADepth: Integer; IsMask: Boolean);
+begin
+  if FData <> nil then
+    FreeMem(FData);
+  FreeAndNil(FPalette);
+  if not IsMask then
+    case ADepth of
+      4: FPalette := CreateVGAPalette;
+      8: FPalette := Create256ColorPalette;
+    end;
+
+  FCalcSize := ((AWidth * AHeight * ADepth) shr 3);
+  TheImage.SetSize(AWidth, AHeight);
+end;
+
+procedure TLazReaderIcnsPart.DoReadRaw;
+var
+  Row, Column: Integer;
+  shift: byte;
+  b: PByte;
+begin
+  // only 4 and 8 are stored as raw image format
+  case FIconInfo.Depth of
+    4 :
+      begin
+        b := FData;
+        shift := 4;
+        for Row := 0 to FIconInfo.Height - 1 do
+          for Column := 0 to FIconInfo.Width - 1 do
+          begin
+            FImage.colors[Column, Row] := FPalette[(b^ shr shift) mod 16];
+            if shift = 0 then
+            begin
+              shift := 4;
+              inc(b);
+            end
+            else
+              shift := 0;
+          end;
+      end;
+    8 :
+      begin
+        b := FData;
+        for Row := 0 to FIconInfo.Height - 1 do
+          for Column := 0 to FIconInfo.Width - 1 do
+          begin
+            FImage.colors[Column, Row] := FPalette[b^];
+            inc(b);
+          end;
+      end;
+  end;
+end;
+
+procedure TLazReaderIcnsPart.DoReadRLE;
+var
+  ADecompData: PDWord;
+  ARGBAData: PRGBAQuad;
+  Component, Shift: Byte;
+  PixelCount, j, l: Integer;
+  RepeatValue: DWord;
+  SourcePtr: PByte;
+  DestPtr: PDWord;
+begin
+  // only 24 bit RGB is RLE encoded the same way as TIFF or TGA RLE
+  // data is encoded channel by channel:
+  // high bit = 0 => length = low 0..6 bits + 1; read length times next value
+  // high bit = 1 => length = value - 125      ; read one value and repeat length times
+
+  ADecompData := AllocMem(FCalcSize);
+  DestPtr := ADecompData;
+
+  if FIconType = iitThumbnail32BitData
+  then SourcePtr := @FData[4]
+  else SourcePtr := FData;
+
+  PixelCount := FIconInfo.Height * FIconInfo.Width;
+
+  for Component := 0 to 2 do
+  begin
+    DestPtr := ADecompData;
+    Shift := (2 - Component) * 8;
+    while DestPtr - ADecompData < PixelCount do
+    begin
+      l := SourcePtr^;
+      inc(SourcePtr);
+      if (l and $80) = 0 then // high bit = 0
+      begin
+        for j := 0 to l do
+        begin
+          DestPtr^ := DestPtr^ or (DWord(SourcePtr^) shl Shift);
+          inc(SourcePtr);
+          inc(DestPtr);
+        end;
+      end
+      else
+      begin                   // high bit = 1
+        l := l - 126;
+        RepeatValue := DWord(SourcePtr^) shl Shift;
+        inc(SourcePtr);
+        for j := 0 to l do
+        begin
+          DestPtr^ := DestPtr^ or RepeatValue;
+          inc(DestPtr);
+        end;
+      end;
+    end;
+  end;
+
+  ARGBAData := PRGBAQuad(ADecompData);
+  for l := 0 to FIconInfo.Height - 1 do
+    for j := 0 to FIconInfo.Width - 1 do
+    begin
+      FImage.Colors[j, l] :=
+        FPColor(ARGBAData^.Red shl 8 or ARGBAData^.Red,
+                ARGBAData^.Green shl 8 or ARGBAData^.Green,
+                ARGBAData^.Blue shl 8 or ARGBAData^.Blue,
+                alphaOpaque);
+      inc(ARGBAData);
+    end;
+  FreeMem(ADecompData);
+end;
+
+procedure TLazReaderIcnsPart.DoReadJpeg2000;
+begin
+  // TODO: according to some research in the web we need to read jpeg 2000 data
+end;
+
+procedure TLazReaderIcnsPart.DoReadMask;
+var
+  Row, Column: Integer;
+  shift: byte;
+  b: PByte;
+begin
+  case FIconInfo.Depth of
+    1:
+      begin
+        // actually here is stored 2 1-bit images, but we will get only first
+        shift := 7;
+        b := FData;
+        for Row := 0 to FIconInfo.Height - 1 do
+        begin
+          for Column := 0 to FIconInfo.Width - 1 do
+          begin
+            FImage.colors[Column, Row] := FPColor(0, 0, 0);
+            FImage.Masked[Column, Row] := (b^ shr shift) mod 2 = 0;
+            if shift = 0 then
+            begin
+              shift := 7;
+              inc(b);
+            end
+            else
+              dec(shift);
+          end;
+        end;
+      end;
+    8:
+      begin
+        b := FData;
+        for Row := 0 to FIconInfo.Height - 1 do
+          for Column := 0 to FIconInfo.Width - 1 do
+          begin
+            FImage.colors[Column, Row] := FPColor(0, 0, 0, (b^ shl 8) or b^);
+            inc(b);
+          end;
+      end;
+  end;
+end;
+
+function TLazReaderIcnsPart.Create256ColorPalette: TFPPalette;
+const
+  CHANNELVAL: array[0..15] of Word = (
+    $FFFF, $CCCC, $9999, $6666, $3333, $0000,
+    $EEEE, $DDDD, $BBBB, $AAAA, $8888,
+    $7777, $5555, $4444, $2222, $1111
+  );
+
+var
+  rIdx, gIdx, bIdx: byte;
+  PalIdx: Byte;
+begin
+  Result := TFPPalette.Create(256);
+  PalIdx := 0;
+  for rIdx := 0 to 5 do
+  begin
+    for gIdx := 0 to 5 do
+    begin
+      for bIdx := 0 to 5 do
+      begin
+        Result[PalIdx] := FPColor(CHANNELVAL[rIdx], CHANNELVAL[gIdx], CHANNELVAL[bIdx]);
+        Inc(PalIdx);
+      end;
+    end;
+  end;
+  for rIdx := 6 to 15 do
+  begin
+    Result[PalIdx] := FPColor(CHANNELVAL[rIdx], 0, 0);
+    Inc(PalIdx);
+  end;
+  for gIdx := 6 to 15 do
+  begin
+    Result[PalIdx] := FPColor(0, CHANNELVAL[gIdx], 0);
+    Inc(PalIdx);
+  end;
+  for bIdx := 6 to 15 do
+  begin
+    Result[PalIdx] := FPColor(0, 0, CHANNELVAL[bIdx]);
+    Inc(PalIdx);
+  end;
+  for rIdx := 6 to 15 do
+  begin
+    Result[PalIdx] := FPColor(CHANNELVAL[rIdx], CHANNELVAL[rIdx], CHANNELVAL[rIdx]);
+    Inc(PalIdx);
+  end;
+  Result[PalIdx] := FPColor(0, 0, 0);
+end;
+
+constructor TLazReaderIcnsPart.Create;
+begin
+  inherited Create;
+  FData := nil;
+  FPalette := nil;
+  FCalcSize := 0;
+  FIconType := iitNone;
+end;
+
+destructor TLazReaderIcnsPart.Destroy;
+begin
+  FPalette.Free;
+  FreeMem(FData);
+  inherited Destroy;
+end;
+
 //------------------------------------------------------------------------------
 procedure InternalInit;
 var