lcl: fix loading of icons and cursor from the resources:

- fix signature check for TCursorImage in case of ReadData call
  - split loading of icons and cursor from the resource because of different structures used for them
  - load TCursorImage from RT_CURSOR instead of RT_ICON

git-svn-id: trunk@30006 -

lcl/graphics.pp

@@ -33,7 +33,7 @@ interface
 {$endif}
 
 uses
-  SysUtils, Math, Types, Classes, FPCAdds, LCLversion,
+  SysUtils, Math, Types, Classes, Contnrs, FPCAdds, LCLversion,
   FileUtil,
   FPImage, FPCanvas,
   FPWriteBMP,              // bmp support
@@ -1607,8 +1607,9 @@ type
     function GetRawImagePtr: PRawImage; override;
     function GetRawImageDescriptionPtr: PRawImageDescription; override;
     function GetTransparent: Boolean; override;
-    class function GetTypeID: Word; virtual;
     class function GetSharedImageClass: TSharedRasterImageClass; override;
+    class function GetStreamSignature: Cardinal; virtual;
+    class function GetTypeID: Word; virtual;
     procedure HandleNeeded; override;
     function InternalReleaseBitmapHandle: HBITMAP; override;
     function InternalReleaseMaskHandle: HBITMAP; override;
@@ -1639,7 +1640,7 @@ type
     function LazarusResourceTypeValid(const ResourceType: string): boolean; override;
     procedure LoadFromResourceName(Instance: THandle; const ResName: String); override;
     procedure LoadFromResourceID(Instance: THandle; ResID: PtrInt); override;
-    procedure LoadFromResourceHandle(Instance: THandle; ResHandle: TFPResourceHandle);
+    procedure LoadFromResourceHandle(Instance: THandle; ResHandle: TFPResourceHandle); virtual;
     function BitmapHandleAllocated: boolean; override;
     function MaskHandleAllocated: boolean; override;
     function PaletteAllocated: boolean; override;
@@ -1657,9 +1658,11 @@ type
     function GetIconHandle: HICON;
     procedure SetIconHandle(const AValue: HICON);
   protected
+    class function GetStreamSignature: Cardinal; override;
     class function GetTypeID: Word; override;
     procedure HandleNeeded; override;
   public
+    procedure LoadFromResourceHandle(Instance: THandle; ResHandle: TFPResourceHandle); override;
     function ReleaseHandle: HICON;
     function GetResourceType: TResourceType; override;
     property Handle: HICON read GetIconHandle write SetIconHandle;
@@ -1736,11 +1739,13 @@ type
   protected
     procedure HandleNeeded; override;
     class function GetDefaultSize: TSize; override;
+    class function GetStreamSignature: Cardinal; override;
     class function GetSharedImageClass: TSharedRasterImageClass; override;
     class function GetTypeID: Word; override;
   public
     class function GetFileExtensions: string; override;
     function GetResourceType: TResourceType; override;
+    procedure LoadFromResourceHandle(Instance: THandle; ResHandle: TFPResourceHandle); override;
     function LazarusResourceTypeValid(const ResourceType: string): boolean; override;
     function ReleaseHandle: HCURSOR;
     property HotSpot: TPoint read GetHotSpot;
@@ -2622,9 +2627,9 @@ end;
 {$I png.inc}
 {$I pnm.inc}
 {$I jpegimage.inc}
-{$I cursorimage.inc}
 {$I icon.inc}
 {$I icnsicon.inc}
+{$I cursorimage.inc}
 {$I fpimagebitmap.inc}
 {$I bitmap.inc}
 {$I tiffimage.inc}

lcl/include/cursorimage.inc

@@ -17,7 +17,20 @@
  *                                                                           *
  *****************************************************************************
 }
+const
+  CursorSignature: array [0..3] of char = #0#0#2#0;
 
+function TestStreamIsCursor(const AStream: TStream): boolean;
+var
+  Signature: array[0..3] of char;
+  ReadSize: Integer;
+  OldPosition: TStreamSeekType;
+begin
+  OldPosition:=AStream.Position;
+  ReadSize:=AStream.Read(Signature, SizeOf(Signature));
+  Result:=(ReadSize=SizeOf(Signature)) and CompareMem(@Signature,@CursorSignature,4);
+  AStream.Position:=OldPosition;
+end;
 
 { TSharedCursorImage }
 
@@ -48,6 +61,73 @@ begin
   Result := RT_GROUP_CURSOR;
 end;
 
+procedure TCursorImage.LoadFromResourceHandle(Instance: THandle; ResHandle: TFPResourceHandle);
+var
+  GlobalHandle: TFPResourceHGlobal;
+  Dir: PNewHeader;
+  DirEntry: PGrpCursorDirEntry;
+  IconEntry: TIconDirEntry;
+  LocalHeader: TLocalHeader;
+  i, offset: integer;
+  Stream: TMemoryStream;
+  CursorStream: TResourceStream;
+  ResourceStreams: TObjectList;
+begin
+  // build a usual cur stream using several RT_CURSOR resources
+  GlobalHandle := LoadResource(Instance, ResHandle);
+  if GlobalHandle = 0 then
+    Exit;
+  Dir := LockResource(GlobalHandle);
+  if Dir = nil then
+    Exit;
+
+  Stream := TMemoryStream.Create;
+  try
+    // write cursor header
+    Stream.Write(Dir^, SizeOf(TIconHeader));
+    // write cursor entries headers
+    ResourceStreams := TObjectList.Create(True);
+    try
+      offset := Stream.Position + SizeOf(IconEntry) * LEtoN(Dir^.idCount);
+      DirEntry := PGrpCursorDirEntry(PChar(Dir) + SizeOf(Dir^));
+      for i := 0 to LEtoN(Dir^.idCount) - 1 do
+      begin
+        CursorStream := TResourceStream.CreateFromID(Instance, LEtoN(DirEntry^.nID), RT_CURSOR);
+        ResourceStreams.Add(CursorStream);
+
+        // hot spots are stored in the local header of cursor
+        CursorStream.Read(LocalHeader, SizeOf(LocalHeader));
+
+        IconEntry.bWidth := DirEntry^.wWidth;
+        IconEntry.bHeight := DirEntry^.wHeight div 2; // in cursor resource the height is doubled
+        IconEntry.bColorCount := 0;
+        IconEntry.bReserved := 0;
+        IconEntry.wXHotSpot := LocalHeader.xHotSpot;
+        IconEntry.wYHotSpot := LocalHeader.yHotSpot;
+        IconEntry.dwImageOffset := NtoLE(offset);
+        IconEntry.dwBytesInRes := DirEntry^.dwBytesInRes - SizeOf(LocalHeader);
+        inc(offset, LEtoN(IconEntry.dwBytesInRes));
+        Stream.Write(IconEntry, SizeOf(IconEntry));
+        Inc(DirEntry);
+      end;
+      // write cursors data
+      for i := 0 to ResourceStreams.Count - 1 do
+      begin
+        CursorStream := TResourceStream(ResourceStreams[i]);
+        Stream.CopyFrom(CursorStream, CursorStream.Size - CursorStream.Position);
+      end;
+    finally
+      ResourceStreams.Free;
+    end;
+    Stream.Position := 0;
+    ReadData(Stream);
+  finally
+    Stream.Free;
+    UnLockResource(GlobalHandle);
+    FreeResource(GlobalHandle);
+  end;
+end;
+
 class function TCursorImage.GetSharedImageClass: TSharedRasterImageClass;
 begin
   Result := TSharedCursorImage;
@@ -118,4 +198,9 @@ begin
   Result := Size(GetSystemMetrics(SM_CXCURSOR), GetSystemMetrics(SM_CYCURSOR));
 end;
 
+class function TCursorImage.GetStreamSignature: Cardinal;
+begin
+  Result := Cardinal(CursorSignature);
+end;
+
 

lcl/include/icon.inc

@@ -20,7 +20,6 @@
 
 const
   IconSignature: array [0..3] of char = #0#0#1#0;
-  CursorSignature: array [0..3] of char = #0#0#2#0;
 
 type
   TIconHeader = {packed} record // packed it not needed
@@ -54,32 +53,38 @@ type
   PIconDirEntry = ^TIconDirEntry;
 
   // executables and libraries has the next structures for icons and cursors
+  PGrpIconDirEntry = ^TGrpIconDirEntry;
   TGrpIconDirEntry = packed record
     bWidth: Byte;           // Width, in pixels, of the image
     bHeight: Byte;          // Height, in pixels, of the image
     bColorCount: Byte;      // Number of colors in image (0 if >=8bpp)
     bReserved: Byte;        // Reserved
-    case Byte of
-      1: (
-        // icon
     wPlanes: Word;          // color planes
     wBpp: Word;             // bits per pixel
-        // common
     dwBytesInRes: Dword;    // how many bytes in this resource?
     nID: Word;              // the ID
-      );
-      2:(
-        // cursor
-        wXHotSpot: Word;
-        wYHotSpot: Word;
-      );
   end;
 
-  TGrpIconDir = packed record
+  PGrpCursorDirEntry = ^TGrpCursorDirEntry;
+  TGrpCursorDirEntry = packed record
+    wWidth: Word;           // Width, in pixels, of the image
+    wHeight: Word;          // Height, in pixels, of the image
+    wPlanes: Word;          // color planes
+    wBitCount: Word;        // bits per pixel
+    dwBytesInRes: Dword;    // how many bytes in this resource?
+    nID: Word;              // the ID
+  end;
+
+  TLocalHeader = packed record
+    xHotSpot: Word;
+    yHotSpot: Word;
+  end;
+
+  PNewHeader = ^TNewHeader;
+  TNewHeader = packed record
     idReserved: Word; // Reserved (must be 0)
     idType: Word;     // Resource type (1 for icons)
     idCount: Word;    //  How many images?
-    idEntries: array[0..0] of TGrpIconDirEntry; // The entries for each image
   end;
 
 function TestStreamIsIcon(const AStream: TStream): boolean;
@@ -94,18 +99,6 @@ begin
   AStream.Position:=OldPosition;
 end;
 
-function TestStreamIsCursor(const AStream: TStream): boolean;
-var
-  Signature: array[0..3] of char;
-  ReadSize: Integer;
-  OldPosition: TStreamSeekType;
-begin
-  OldPosition:=AStream.Position;
-  ReadSize:=AStream.Read(Signature, SizeOf(Signature));
-  Result:=(ReadSize=SizeOf(Signature)) and CompareMem(@Signature,@CursorSignature,4);
-  AStream.Position:=OldPosition;
-end;
-
 ////////////////////////////////////////////////////////////////////////////////
 
 { TSharedIcon }
@@ -621,6 +614,11 @@ begin
   Result := True;
 end;
 
+class function TCustomIcon.GetStreamSignature: Cardinal;
+begin
+  Result := 0;
+end;
+
 class function TCustomIcon.GetTypeID: Word;
 begin
   Result := 0;
@@ -702,57 +700,7 @@ begin
 end;
 
 procedure TCustomIcon.LoadFromResourceHandle(Instance: THandle; ResHandle: TFPResourceHandle);
-var
-  GlobalHandle: TFPResourceHGlobal;
-  Dir: ^TGrpIconDir;
-  DirEntry: ^TGrpIconDirEntry;
-  IconEntry: TIconDirEntry;
-  i, offset: integer;
-  Stream: TMemoryStream;
-  IconStream: TResourceStream;
 begin
-  // build a usual ico/cur stream using several RT_ICON resources
-  GlobalHandle := LoadResource(Instance, ResHandle);
-  if GlobalHandle = 0 then
-    Exit;
-  Dir := LockResource(GlobalHandle);
-  if Dir = nil then
-    Exit;
-
-  Stream := TMemoryStream.Create;
-  try
-    // write icon header
-    Stream.Write(Dir^, SizeOf(TIconHeader));
-    // write icon entries headers
-    offset := Stream.Position + SizeOf(IconEntry) * LEtoN(Dir^.idCount);
-    DirEntry := @Dir^.idEntries[0];
-    for i := 0 to LEtoN(Dir^.idCount) - 1 do
-    begin
-      Move(DirEntry^, IconEntry, SizeOf(DirEntry^));
-      IconEntry.dwImageOffset := NtoLE(offset);
-      inc(offset, LEtoN(IconEntry.dwBytesInRes));
-      Stream.Write(IconEntry, SizeOf(IconEntry));
-      Inc(DirEntry);
-    end;
-    // write icons data
-    DirEntry := @Dir^.idEntries[0];
-    for i := 0 to LEtoN(Dir^.idCount) - 1 do
-    begin
-      IconStream := TResourceStream.CreateFromID(Instance, LEtoN(DirEntry^.nID), RT_ICON);
-      try
-        Stream.CopyFrom(IconStream, IconStream.Size);
-      finally
-        IconStream.Free;
-      end;
-      Inc(DirEntry);
-    end;
-    Stream.Position := 0;
-    ReadData(Stream);
-  finally
-    Stream.Free;
-    UnLockResource(GlobalHandle);
-    FreeResource(GlobalHandle);
-  end;
 end;
 
 function TCustomIcon.MaskHandleAllocated: boolean;
@@ -841,7 +789,7 @@ begin
   Position := Stream.Position;
   Stream.Read(Signature, SizeOf(Signature));
   Stream.Position := Position;
-  if Cardinal(Signature) = Cardinal(IconSignature)
+  if Cardinal(Signature) = GetStreamSignature
   then begin
     // Assume Icon - stream without explicit size
     LoadFromStream(Stream);
@@ -1402,6 +1350,11 @@ begin
   SetHandle(AValue);
 end;
 
+class function TIcon.GetStreamSignature: Cardinal;
+begin
+  Result := Cardinal(IconSignature);
+end;
+
 procedure TIcon.HandleNeeded;
 var
   IconInfo: TIconInfo;
@@ -1414,4 +1367,58 @@ begin
   FSharedImage.FHandle := WidgetSet.CreateIconIndirect(@IconInfo);
 end;
 
+procedure TIcon.LoadFromResourceHandle(Instance: THandle; ResHandle: TFPResourceHandle);
+var
+  GlobalHandle: TFPResourceHGlobal;
+  Dir: PNewHeader;
+  DirEntry: PGrpIconDirEntry;
+  IconEntry: TIconDirEntry;
+  i, offset: integer;
+  Stream: TMemoryStream;
+  IconStream: TResourceStream;
+begin
+  // build a usual ico stream using several RT_ICON resources
+  GlobalHandle := LoadResource(Instance, ResHandle);
+  if GlobalHandle = 0 then
+    Exit;
+  Dir := LockResource(GlobalHandle);
+  if Dir = nil then
+    Exit;
+
+  Stream := TMemoryStream.Create;
+  try
+    // write icon header
+    Stream.Write(Dir^, SizeOf(TIconHeader));
+    // write icon entries headers
+    offset := Stream.Position + SizeOf(IconEntry) * LEtoN(Dir^.idCount);
+    DirEntry := PGrpIconDirEntry(PChar(Dir) + SizeOf(Dir^));
+    for i := 0 to LEtoN(Dir^.idCount) - 1 do
+    begin
+      Move(DirEntry^, IconEntry, SizeOf(DirEntry^));
+      IconEntry.dwImageOffset := NtoLE(offset);
+      inc(offset, LEtoN(IconEntry.dwBytesInRes));
+      Stream.Write(IconEntry, SizeOf(IconEntry));
+      Inc(DirEntry);
+    end;
+    // write icons data
+    DirEntry := PGrpIconDirEntry(PChar(Dir) + SizeOf(Dir^));
+    for i := 0 to LEtoN(Dir^.idCount) - 1 do
+    begin
+      IconStream := TResourceStream.CreateFromID(Instance, LEtoN(DirEntry^.nID), RT_ICON);
+      try
+        Stream.CopyFrom(IconStream, IconStream.Size);
+      finally
+        IconStream.Free;
+      end;
+      Inc(DirEntry);
+    end;
+    Stream.Position := 0;
+    ReadData(Stream);
+  finally
+    Stream.Free;
+    UnLockResource(GlobalHandle);
+    FreeResource(GlobalHandle);
+  end;
+end;
+