www.pudn.com > HgzVip1.2_code.rar > unitResourceGraphics.pas

(*======================================================================* 
 | unitResourceGraphics unit for PEResourceExplorer                     | 
 |                                                                      | 
 | Encapsulates graphics in resources (icon, cursor, bitmap)            | 
 |                                                                      | 
 | The contents of this file are subject to the Mozilla Public License  | 
 | Version 1.1 (the "License"); you may not use this file except in     | 
 | compliance with the License. You may obtain a copy of the License    | 
 | at http://www.mozilla.org/MPL/                                       | 
 |                                                                      | 
 | Software distributed under the License is distributed on an "AS IS"  | 
 | basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See  | 
 | the License for the specific language governing rights and           | 
 | limitations under the License.                                       | 
 |                                                                      | 
 | Copyright © Colin Wilson 2002  All Rights Reserved 
 |                                                                      | 
 | Version  Date        By    Description                               | 
 | -------  ----------  ----  ------------------------------------------| 
 | 1.0      05/01/2001  CPWW  Original                                  | 
 | 1.1      11/02/2002  CPWW  Continued development                     | 
 *======================================================================*) 
 
unit unitResourceGraphics; 
 
interface 
 
uses Windows, Classes, SysUtils, unitResourceDetails, graphics, unitExIcon;//, gifimage; 
 
type 
 
//------------------------------------------------------------------------ 
// Base class 
 
  TGraphicsResourceDetails = class (TResourceDetails) 
  protected 
    function GetHeight: Integer; virtual; abstract; 
    function GetPixelFormat: TPixelFormat; virtual; abstract; 
    function GetWidth: Integer; virtual; abstract; 
  public 
    procedure GetImage (picture : TPicture); virtual; abstract; 
    procedure SetImage (image : TPicture); virtual; 
 
    property Width : Integer read GetWidth; 
    property Height : Integer read GetHeight; 
    property PixelFormat : TPixelFormat read GetPixelFormat; 
  end; 
 
  TGraphicsResourceDetailsClass = class of TGraphicsResourceDetails; 
 
//------------------------------------------------------------------------ 
// Bitmap resource details class 
 
 { TBitmapResourceDetails = class (TGraphicsResourceDetails) 
  protected 
    function GetHeight: Integer; override; 
    function GetPixelFormat: TPixelFormat; override; 
    function GetWidth: Integer; override; 
    procedure InitNew; override; 
    procedure InternalGetImage (s : TStream; picture : TPicture); 
    procedure InternalSetImage (s : TStream; image : TPicture); 
 
  public 
    class function GetBaseType : string; override; 
    procedure GetImage (picture : TPicture); override; 
    procedure SetImage (image : TPicture); override; 
  end;     } 
 
//------------------------------------------------------------------------ 
// DIB resource details class 
// 
// Same as RT_BITMAP resources, but they have a TBitmapFileHeader at the start 
// of the resource, before the TBitmapInfoHeader.  See 
// \program files\Microsoft Office\office\1033\outlibr.dll 
 
 { TDIBResourceDetails = class (TBitmapResourceDetails) 
  protected 
    class function SupportsData (Size : Integer; data : Pointer) : Boolean; override; 
    procedure InitNew; override; 
  public 
    class function GetBaseType : string; override; 
    procedure GetImage (picture : TPicture); override; 
    procedure SetImage (image : TPicture); override; 
  end;  } 
 
  TIconCursorResourceDetails = class; 
 
//------------------------------------------------------------------------ 
// Icon / Cursor group resource details class 
 
  TIconCursorGroupResourceDetails = class (TResourceDetails) 
  private 
    fDeleting : Boolean; 
    function GetResourceCount: Integer; 
    function GetResourceDetails(idx: Integer): TIconCursorResourceDetails; 
  protected 
    procedure InitNew; override; 
  public 
    procedure GetImage (picture : TPicture); 
    property ResourceCount : Integer read GetResourceCount; 
    property ResourceDetails [idx : Integer] : TIconCursorResourceDetails read GetResourceDetails; 
    function Contains (details : TIconCursorResourceDetails) : Boolean; 
    procedure RemoveFromGroup (details : TIconCursorResourceDetails); 
    procedure AddToGroup (details : TIconCursorResourceDetails); 
    procedure LoadImage (const FileName : string); 
    procedure BeforeDelete; override; 
  end; 
 
//------------------------------------------------------------------------ 
// Icon group resource details class 
 
  TIconGroupResourceDetails = class (TIconCursorGroupResourceDetails) 
  public 
    class function GetBaseType : string; override; 
  end; 
 
//------------------------------------------------------------------------ 
// Cursor group resource details class 
 
  {TCursorGroupResourceDetails = class (TIconCursorGroupResourceDetails) 
  public 
    class function GetBaseType : string; override; 
  end;  } 
 
//------------------------------------------------------------------------ 
// Icon / Cursor resource details class 
 
  TIconCursorResourceDetails = class (TGraphicsResourceDetails) 
  protected 
    function GetHeight: Integer; override; 
    function GetPixelFormat: TPixelFormat; override; 
    function GetWidth: Integer; override; 
  protected 
    procedure InitNew; override; 
  public 
    procedure BeforeDelete; override; 
    procedure GetImage (picture : TPicture); override; 
    procedure SetImage (image : TPicture); override; 
    property Width : Integer read GetWidth; 
    property Height : Integer read GetHeight; 
    property PixelFormat : TPixelFormat read GetPixelFormat; 
  end;     
 
//------------------------------------------------------------------------ 
// Icon resource details class 
 
  TIconResourceDetails = class (TIconCursorResourceDetails) 
  public 
    class function GetBaseType : string; override; 
  end; 
 
//------------------------------------------------------------------------ 
// Cursor resource details class 
 
  {TCursorResourceDetails = class (TIconCursorResourceDetails) 
  protected 
  public 
    class function GetBaseType : string; override; 
  end; } 
 
const 
  DefaultIconCursorWidth : Integer = 32; 
  DefaultIconCursorHeight : Integer = 32; 
  DefaultIconCursorPixelFormat : TPixelFormat = pf4Bit; 
  DefaultCursorHotspot : DWord = $00100010; 
 
  DefaultBitmapWidth : Integer = 128; 
  DefaultBitmapHeight : Integer = 96; 
  DefaultBitmapPixelFormat : TPixelFormat = pf24Bit; 
 
implementation 
 
type 
 
TResourceDirectory = packed record 
  details : packed record case boolean of 
    False : (cursorWidth, cursorHeight : word); 
    True : (iconWidth, iconHeight, iconColorCount, iconReserved : BYTE) 
  end; 
  wPlanes, wBitCount : word; 
  lBytesInRes : DWORD; 
  wNameOrdinal : word 
end; 
PResourceDirectory = ^TResourceDirectory; 
 
resourcestring 
  rstCursors = 'Cursors'; 
  rstIcons = 'Icons'; 
 
 
{ TIconGroupResourceDetails } 
 
(*----------------------------------------------------------------------* 
 | TIconGroupResourceDetails.GetBaseType                                | 
 *----------------------------------------------------------------------*) 
class function TIconGroupResourceDetails.GetBaseType: string; 
begin 
  result := IntToStr (Integer (RT_GROUP_ICON)); 
end; 
 
{ TCursorGroupResourceDetails } 
 
(*----------------------------------------------------------------------* 
 | TCursorGroupResourceDetails.GetBaseType                              | 
 *----------------------------------------------------------------------*) 
{class function TCursorGroupResourceDetails.GetBaseType: string; 
begin 
  result := IntToStr (Integer (RT_GROUP_CURSOR)); 
end;  } 
 
{ TIconResourceDetails } 
 
(*----------------------------------------------------------------------* 
 | TIconResourceDetails.GetBaseType                                     | 
 *----------------------------------------------------------------------*) 
class function TIconResourceDetails.GetBaseType: string; 
begin 
  result := IntToStr (Integer (RT_ICON)); 
end; 
 
{ TCursorResourceDetails } 
 
(*----------------------------------------------------------------------* 
 | TCursorResourceDetails.GetBaseType                                   | 
 *----------------------------------------------------------------------*) 
{class function TCursorResourceDetails.GetBaseType: string; 
begin 
  result := IntToStr (Integer (RT_CURSOR)); 
end; } 
 
{ TGraphicsResourceDetails } 
 
 
{ TIconCursorResourceDetails } 
 
(*----------------------------------------------------------------------* 
 | TIconCursorResourceDetails.GetHeight                                 | 
 *----------------------------------------------------------------------*) 
function TIconCursorResourceDetails.GetHeight: Integer; 
var 
  infoHeader : PBitmapInfoHeader; 
begin 
 // if self is TCursorResourceDetails then        // Not very 'OOP'.  Sorry 
 //   infoHeader := PBitmapInfoHeader (PChar (data.Memory) + sizeof (DWORD)) 
 // else 
    infoHeader := PBitmapInfoHeader (PChar (data.Memory)); 
 
  result := infoHeader.biHeight div 2 
end; 
 
(*----------------------------------------------------------------------* 
 | TIconCursorResourceDetails.GetImage                                  | 
 *----------------------------------------------------------------------*) 
procedure TIconCursorResourceDetails.GetImage(picture: TPicture); 
var 
  iconCursor : TExIconCursor; 
  strm : TMemoryStream; 
  hdr : TIconHeader; 
  dirEntry : TIconDirEntry; 
  infoHeader : PBitmapInfoHeader; 
begin 
  if data.Size = 0 then Exit; 
 
 
  strm := Nil; 
{  if self is TCursorResourceDetails then 
  begin 
    hdr.wType := 2; 
    infoHeader := PBitmapInfoHeader (PChar (data.Memory) + sizeof (DWORD)); 
    iconCursor := TExCursor.Create 
  end 
  else } 
  begin 
    hdr.wType := 1; 
    infoHeader := PBitmapInfoHeader (PChar (data.Memory)); 
    iconCursor := TExIcon.Create 
  end; 
 
  try 
    strm := TMemoryStream.Create; 
    hdr.wReserved := 0; 
    hdr.wCount := 1; 
 
    strm.Write (hdr, sizeof (hdr)); 
 
    dirEntry.bWidth := infoHeader^.biWidth; 
    dirEntry.bHeight := infoHeader^.biHeight div 2; 
    dirEntry.bColorCount := GetBitmapInfoNumColors (infoHeader^); 
    dirEntry.bReserved := 0; 
 
    dirEntry.wPlanes := infoHeader^.biPlanes; 
    dirEntry.wBitCount := infoHeader^.biBitCount; 
 
    dirEntry.dwBytesInRes := data.Size; 
    dirEntry.dwImageOffset := sizeof (hdr) + sizeof (dirEntry); 
 
    strm.Write (dirEntry, sizeof (dirEntry)); 
    strm.CopyFrom (data, 0); 
    strm.Seek (0, soFromBeginning); 
 
    iconcursor.LoadFromStream (strm); 
    picture.Graphic := iconcursor 
  finally 
    strm.Free; 
    iconcursor.Free 
  end 
end; 
 
(*----------------------------------------------------------------------* 
 | TIconCursorResourceDetails.SetImage                                  | 
 *----------------------------------------------------------------------*) 
procedure TIconCursorResourceDetails.SetImage(image: TPicture); 
var 
  icon : TExIconCursor; 
begin 
  icon := TExIconCursor (image.graphic); 
  data.Clear; 
  data.CopyFrom (icon.Images [icon.CurrentImage].MemoryImage, 0); 
end; 
 
 
(*----------------------------------------------------------------------* 
 | TIconCursorResourceDetails.GetPixelFormat                            | 
 *----------------------------------------------------------------------*) 
function TIconCursorResourceDetails.GetPixelFormat: TPixelFormat; 
var 
  infoHeader : PBitmapInfoHeader; 
begin 
 { if self is TCursorResourceDetails then 
    infoHeader := PBitmapInfoHeader (PChar (data.Memory) + sizeof (DWORD)) 
  else  } 
    infoHeader := PBitmapInfoHeader (PChar (data.Memory)); 
 
  result := GetBitmapInfoPixelFormat (infoHeader^); 
end; 
 
(*----------------------------------------------------------------------* 
 | TIconCursorResourceDetails.GetWidth                                  | 
 *----------------------------------------------------------------------*) 
function TIconCursorResourceDetails.GetWidth: Integer; 
var 
  infoHeader : PBitmapInfoHeader; 
begin 
{  if self is TCursorResourceDetails then 
    infoHeader := PBitmapInfoHeader (PChar (data.Memory) + sizeof (DWORD)) 
  else } 
    infoHeader := PBitmapInfoHeader (PChar (data.Memory)); 
 
  result := infoHeader.biWidth 
end; 
 
{ TIconCursorGroupResourceDetails } 
 
(*----------------------------------------------------------------------* 
 | TIconCursorGroupResourceDetails.BeforeDelete 
 |                                                                      | 
 *----------------------------------------------------------------------*) 
procedure TIconCursorGroupResourceDetails.AddToGroup( 
  details: TIconCursorResourceDetails); 
var 
  attributes : PResourceDirectory; 
  infoHeader : PBitmapInfoHeader; 
  cc : Integer; 
begin 
  data.Size := Data.Size + sizeof (TResourceDirectory); 
  attributes := PResourceDirectory (PChar (Data.Memory) + sizeof (TIconHeader)); 
 
  Inc (Attributes, PIconHeader (data.Memory)^.wCount); 
 
  attributes^.wNameOrdinal :=  StrToInt (details.ResourceName); 
  attributes^.lBytesInRes := details.Data.Size; 
 
  if details is TIconResourceDetails then 
  begin 
    infoHeader := PBitmapInfoHeader (PChar (details.data.Memory)); 
    attributes^.details.iconWidth := infoHeader^.biWidth; 
    attributes^.details.iconHeight := infoHeader^.biHeight div 2; 
    cc := GetBitmapInfoNumColors (infoHeader^); 
    if cc < 256 then 
      attributes^.details.iconColorCount := cc 
    else 
      attributes^.details.iconColorCount := 0; 
    attributes^.details.iconReserved := 0 
  end 
  else 
  begin 
    infoHeader := PBitmapInfoHeader (PChar (details.data.Memory) + sizeof (DWORD)); 
    attributes^.details.cursorWidth := infoHeader^.biWidth; 
    attributes^.details.cursorHeight := infoHeader^.biHeight div 2 
  end; 
 
  attributes^.wPlanes := infoHeader^.biPlanes; 
  attributes^.wBitCount := infoHeader^.biBitCount; 
 
  Inc (PIconHeader (data.Memory)^.wCount); 
end; 
 
procedure TIconCursorGroupResourceDetails.BeforeDelete; 
begin 
  fDeleting := True; 
  try 
    while ResourceCount > 0 do 
      Parent.DeleteResource (Parent.IndexOfResource (ResourceDetails [0])); 
  finally 
    fDeleting := False 
  end 
end; 
 
(*----------------------------------------------------------------------* 
 | TIconCursorGroupResourceDetails.Contains                             | 
 *----------------------------------------------------------------------*) 
function TIconCursorGroupResourceDetails.Contains( 
  details: TIconCursorResourceDetails): Boolean; 
var 
  i, id : Integer; 
  attributes : PResourceDirectory; 
begin 
  Result := False; 
  if ResourceNameToInt (details.ResourceType) = ResourceNameToInt (ResourceType) - DIFFERENCE then 
  begin 
    attributes := PResourceDirectory (PChar (Data.Memory) + sizeof (TIconHeader)); 
    id := ResourceNameToInt (details.ResourceName); 
 
    for i := 0 to PIconHeader (Data.Memory)^.wCount - 1 do 
      if attributes^.wNameOrdinal = id then 
      begin 
        Result := True; 
        break 
      end 
      else 
        Inc (attributes) 
  end 
end; 
 
(*----------------------------------------------------------------------* 
 | TIconCursorGroupResourceDetails.GetImage                             | 
 *----------------------------------------------------------------------*) 
procedure TIconCursorGroupResourceDetails.GetImage(picture: TPicture); 
var 
  i, hdrOffset, imgOffset : Integer; 
  iconCursor : TExIconCursor; 
  strm : TMemoryStream; 
  hdr : TIconHeader; 
  dirEntry : TIconDirEntry; 
  pdirEntry : PIconDirEntry; 
  infoHeader : PBitmapInfoHeader; 
begin 
  if data.Size = 0 then Exit; 
 
  strm := Nil; 
 { if self is TCursorGroupResourceDetails then 
  begin 
    hdr.wType := 2; 
    hdrOffset := SizeOf (DWORD); 
    iconCursor := TExCursor.Create 
  end 
  else } 
  begin 
    hdr.wType := 1; 
    hdrOffset := 0; 
    iconCursor := TExIcon.Create 
  end; 
 
  try 
    strm := TMemoryStream.Create; 
    hdr.wReserved := 0; 
    hdr.wCount := ResourceCount; 
 
    strm.Write (hdr, sizeof (hdr)); 
 
    for i := 0 to ResourceCount - 1 do 
    begin 
      infoHeader := PBitmapInfoHeader (PChar (ResourceDetails [i].Data.Memory) + hdrOffset); 
      dirEntry.bWidth := infoHeader^.biWidth; 
      dirEntry.bHeight := infoHeader^.biHeight div 2; 
      dirEntry.wPlanes := infoHeader^.biPlanes; 
      dirEntry.bColorCount := GetBitmapInfoNumColors (infoHeader^); 
      dirEntry.bReserved := 0; 
      dirEntry.wBitCount := infoHeader^.biBitCount; 
      dirEntry.dwBytesInRes := resourceDetails [i].data.Size; 
      dirEntry.dwImageOffset := 0; 
 
      strm.Write (dirEntry, sizeof (dirEntry)); 
    end; 
 
    for i := 0 to ResourceCount - 1 do 
    begin 
      imgOffset := strm.Position; 
      pDirEntry := PIconDirEntry (PChar (strm.Memory) + SizeOf (TIconHeader) + i * SizeOf (TIconDirEntry)); 
      pDirEntry^.dwImageOffset := imgOffset; 
 
      strm.CopyFrom (ResourceDetails [i].Data, 0); 
    end; 
 
    if ResourceCount > 0 then 
    begin 
      strm.Seek (0, soFromBeginning); 
      iconcursor.LoadFromStream (strm); 
      picture.Graphic := iconcursor 
    end 
    else 
      picture.Graphic := Nil 
  finally 
    strm.Free; 
    iconcursor.Free 
  end 
end; 
 
(*----------------------------------------------------------------------* 
 | TIconCursorGroupResourceDetails.GetResourceCount                     | 
 *----------------------------------------------------------------------*) 
function TIconCursorGroupResourceDetails.GetResourceCount: Integer; 
begin 
  result := PIconHeader (Data.Memory)^.wCount 
end; 
 
(*----------------------------------------------------------------------* 
 | TIconCursorGroupResourceDetails.GetResourceDetails                   | 
 *----------------------------------------------------------------------*) 
function TIconCursorGroupResourceDetails.GetResourceDetails( 
  idx: Integer): TIconCursorResourceDetails; 
var 
  i : Integer; 
  res : TResourceDetails; 
  attributes : PResourceDirectory; 
  iconCursorResourceType : string; 
begin 
  result := Nil; 
  attributes := PResourceDirectory (PChar (Data.Memory) + sizeof (TIconHeader)); 
  Inc (attributes, idx); 
 
  // DIFFERENCE (from Windows.pas) is 11.  It's the difference between a 'group 
  // resource' and the resource itself.  They called it 'DIFFERENCE' to be annoying. 
 
  iconCursorResourceType := IntToStr (ResourceNameToInt (ResourceType) - DIFFERENCE); 
  for i := 0 to Parent.ResourceCount - 1 do 
  begin 
    res := Parent.ResourceDetails [i]; 
    if (res is TIconCursorResourceDetails) and (iconCursorResourceType = res.ResourceType) and (attributes.wNameOrdinal = ResourceNameToInt (res.ResourceName)) then 
    begin 
      result := TIconCursorResourceDetails (res); 
      break 
    end 
  end 
end; 
 
(*----------------------------------------------------------------------* 
 | TIconCursorGroupResourceDetails.InitNew                              | 
 *----------------------------------------------------------------------*) 
procedure TIconCursorGroupResourceDetails.InitNew; 
var 
  imageResource : TIconCursorResourceDetails; 
  iconHeader : TIconHeader; 
  dir : TResourceDirectory; 
  nm : string; 
 
begin 
  iconHeader.wCount := 1; 
  iconHeader.wReserved := 0; 
 
 { if Self is TCursorGroupResourceDetails then 
  begin 
    iconHeader.wType := 2; 
    nm := Parent.GetUniqueResourceName (TCursorResourceDetails.GetBaseType); 
    imageResource := TCursorResourceDetails.CreateNew (Parent, ResourceLanguage, nm) 
  end 
  else  } 
  begin 
    iconHeader.wType := 1; 
    nm := Parent.GetUniqueResourceName (TIconResourceDetails.GetBaseType); 
    imageResource := TIconResourceDetails.CreateNew (Parent, ResourceLanguage, nm) 
  end; 
 
  data.Write (iconHeader, SizeOf (iconHeader)); 
 
  if Self is TIconGroupResourceDetails then 
  begin 
    dir.details.iconWidth := DefaultIconCursorWidth; 
    dir.details.iconHeight := DefaultIconCursorHeight; 
    dir.details.iconColorCount := GetPixelFormatNumColors (DefaultIconCursorPixelFormat); 
    dir.details.iconReserved := 0 
  end 
  else 
  begin 
    dir.details.cursorWidth := DefaultIconCursorWidth; 
    dir.details.cursorHeight := DefaultIconCursorHeight 
  end; 
 
  dir.wPlanes := 1; 
  dir.wBitCount := GetPixelFormatBitCount (DefaultIconCursorPixelFormat); 
  dir.lBytesInRes := imageResource.Data.Size; 
  dir.wNameOrdinal := ResourceNametoInt (imageResource.ResourceName); 
 
  data.Write (dir, SizeOf (dir)); 
end; 
 
(*----------------------------------------------------------------------* 
 | TIconCursorResourceDetails.BeforeDelete                              | 
 |                                                                      | 
 | If we're deleting an icon/curor resource, remove its reference from  | 
 | the icon/cursor group resource.                                      | 
 *----------------------------------------------------------------------*) 
procedure TIconCursorResourceDetails.BeforeDelete; 
var 
  i : Integer; 
  details : TResourceDetails; 
  resGroup : TIconCursorGroupResourceDetails; 
begin 
  for i := 0 to Parent.ResourceCount - 1 do 
  begin 
    details := Parent.ResourceDetails [i]; 
    if (details.ResourceType = IntToStr (ResourceNameToInt (ResourceType) + DIFFERENCE)) then 
    begin 
      resGroup := details as TIconCursorGroupResourceDetails; 
      if resGroup.Contains (Self) then 
      begin 
        resGroup.RemoveFromGroup (Self); 
        break 
      end 
    end 
  end 
end; 
 
procedure TIconCursorGroupResourceDetails.LoadImage( 
  const FileName: string); 
var 
  img : TExIconCursor; 
  hdr : TIconHeader; 
  i : Integer; 
  dirEntry : TResourceDirectory; 
  res : TIconCursorResourceDetails; 
  resTp : string; 
begin 
  BeforeDelete;         // Make source there are no existing image resources 
 
 // if Self is TIconGroupResourceDetails then 
 // begin 
    hdr.wType := 1; 
    img := TExIcon.Create; 
    resTp := TIconResourceDetails.GetBaseType; 
 // end; 
 { else 
  begin 
    hdr.wType := 2; 
    img := TExCursor.Create; 
    resTp := TCursorResourceDetails.GetBaseType; 
  end;} 
 
  img.LoadFromFile (FileName); 
 
  hdr.wReserved := 0; 
  hdr.wCount := img.ImageCount; 
 
  data.Clear; 
 
  data.Write (hdr, SizeOf (hdr)); 
 
  for i := 0 to img.ImageCount - 1 do 
  begin 
    if hdr.wType = 1 then 
    begin 
      dirEntry.details.iconWidth := img.Images [i].FWidth; 
      dirEntry.details.iconHeight := img.Images [i].FHeight; 
      dirEntry.details.iconColorCount := GetPixelFormatNumColors (img.Images [i].FPixelFormat); 
      dirEntry.details.iconReserved := 0 
    end 
    else 
    begin 
      dirEntry.details.cursorWidth := img.Images [i].FWidth; 
      dirEntry.details.cursorHeight := img.Images [i].FHeight; 
    end; 
 
    dirEntry.wPlanes := 1; 
    dirEntry.wBitCount := GetPixelFormatBitCount (img.Images [i].FPixelFormat); 
 
    dirEntry.lBytesInRes := img.Images [i].FMemoryImage.Size; 
 
  //  if hdr.wType = 1 then 
      res := TIconResourceDetails.Create (Parent, ResourceLanguage, Parent.GetUniqueResourceName (resTp), resTp, img.Images [i].FMemoryImage.Size, img.Images [i].FMemoryImage.Memory); 
  //  else 
   //   res := TCursorResourceDetails.Create (Parent, ResourceLanguage, Parent.GetUniqueResourceName (resTp), resTp, img.Images [i].FMemoryImage.Size, img.Images [i].FMemoryImage.Memory); 
    Parent.AddResource (res); 
    dirEntry.wNameOrdinal := ResourceNameToInt (res.ResourceName); 
 
    data.Write (dirEntry, SizeOf (dirEntry)); 
  end 
end; 
 
(*----------------------------------------------------------------------* 
 | TIconCursorGroupResourceDetails.RemoveFromGroup                      | 
 *----------------------------------------------------------------------*) 
procedure TIconCursorGroupResourceDetails.RemoveFromGroup( 
  details: TIconCursorResourceDetails); 
var 
  i, id, count : Integer; 
  attributes, ap : PResourceDirectory; 
begin 
  if ResourceNametoInt (details.ResourceType) = ResourceNameToInt (ResourceType) - DIFFERENCE then 
  begin 
    attributes := PResourceDirectory (PChar (Data.Memory) + sizeof (TIconHeader)); 
    id := ResourceNametoInt (details.ResourceName); 
 
    Count := PIconHeader (Data.Memory)^.wCount; 
 
    for i := 0 to Count - 1 do 
      if attributes^.wNameOrdinal = id then 
      begin 
        if i < Count - 1 then 
        begin 
          ap := Attributes; 
          Inc (ap); 
          Move (ap^, Attributes^, SizeOf (TResourceDirectory) * (Count - i - 1)); 
        end; 
 
        Data.Size := data.Size - SizeOf (TResourceDirectory); 
        PIconHeader (Data.Memory)^.wCount := Count - 1; 
        if (Count = 1) and not fDeleting then 
          Parent.DeleteResource (Parent.IndexOfResource (Self)); 
        break 
      end 
      else 
        Inc (attributes) 
  end 
end; 
 
(*----------------------------------------------------------------------* 
 | TIconCursorResourceDetails.InitNew                                   | 
 *----------------------------------------------------------------------*) 
procedure TIconCursorResourceDetails.InitNew; 
var 
  hdr : TBitmapInfoHeader; 
  cImageSize : DWORD; 
  pal : HPALETTE; 
  entries : PPALETTEENTRY; 
  w : DWORD; 
  p : PChar; 
 
begin 
//  if Self is TCursorResourceDetails then 
  //  Data.Write (DefaultCursorHotspot, SizeOf (DefaultCursorHotspot)); 
 
  hdr.biSize := SizeOf (hdr); 
  hdr.biWidth := DefaultIconCursorWidth; 
  hdr.biHeight := DefaultIconCursorHeight * 2; 
  hdr.biPlanes := 1; 
  hdr.biBitCount := GetPixelFormatBitCount (DefaultIconCursorPixelFormat); 
 
  if DefaultIconCursorPixelFormat = pf16Bit then 
    hdr.biCompression := BI_BITFIELDS 
  else 
    hdr.biCompression := BI_RGB; 
 
  hdr.biSizeImage := 0; // See note in unitExIcon 
 
  hdr.biXPelsPerMeter := 0; 
  hdr.biYPelsPerMeter := 0; 
 
  hdr.biClrUsed := GetPixelFormatNumColors (DefaultIconCursorPixelFormat); 
  hdr.biClrImportant := hdr.biClrUsed; 
 
  Data.Write (hdr, SizeOf (hdr)); 
 
  pal := 0; 
  case DefaultIconCursorPixelFormat of 
    pf1Bit : pal := SystemPalette2; 
    pf4Bit : pal := SystemPalette16; 
    pf8Bit : pal := SystemPalette256 
  end; 
 
  entries := Nil; 
  try 
    if pal > 0 then 
    begin 
      GetMem (entries, hdr.biClrUsed * sizeof (PALETTEENTRY)); 
      GetPaletteEntries (pal, 0, hdr.biClrUsed, entries^); 
 
      data.Write (entries^, hdr.biClrUsed * SizeOf (PALETTEENTRY)) 
    end 
    else 
      if hdr.biCompression = BI_BITFIELDS then 
      begin { 5,6,5 bitfield } 
        w := $0f800;  // 1111 1000 0000 0000  5 bit R mask 
        data.Write (w, SizeOf (w)); 
        w := $07e0;   // 0000 0111 1110 0000  6 bit G mask 
        data.Write (w, SizeOf (w)); 
        w := $001f;   // 0000 0000 0001 1111  5 bit B mask 
        data.Write (w, SizeOf (w)) 
      end 
 
  finally 
    ReallocMem (entries, 0) 
  end; 
 
  // Write dummy image 
  cImageSize := BytesPerScanLine (hdr.biWidth, hdr.biBitCount, 32) * DefaultIconCursorHeight; 
  p := AllocMem (cImageSize); 
  try 
    data.Write (p^, cImageSize); 
  finally 
    ReallocMem (p, 0) 
  end; 
 
  // Write dummy mask 
  cImageSize := DefaultIconCursorHeight * DefaultIconCursorWidth div 8; 
 
  GetMem (p, cImageSize); 
  FillChar (p^, cImageSize, $ff); 
 
  try 
    data.Write (p^, cImageSize); 
  finally 
    ReallocMem (p, 0) 
  end; 
end; 
 
 
{ TGraphicsResourceDetails } 
 
procedure TGraphicsResourceDetails.SetImage(image: TPicture); 
begin 
  data.Clear; 
  image.Graphic.SaveToStream (data); 
end; 
 
initialization 
  TPicture.RegisterFileFormat ('ICO', rstIcons, TExIcon); 
  TPicture.RegisterFileFormat ('CUR', rstCursors, TExCursor); 
  TPicture.UnregisterGraphicClass (TIcon); 
 
 
  RegisterResourceDetails (TIconGroupResourceDetails); 
 // RegisterResourceDetails (TCursorGroupResourceDetails); 
  RegisterResourceDetails (TIconResourceDetails); 
//  RegisterResourceDetails (TCursorResourceDetails); 
finalization 
  TPicture.UnregisterGraphicClass (TExIcon); 
  TPicture.UnregisterGraphicClass (TExCursor); 
  TPicture.RegisterFileFormat ('ICO', 'Icon', TIcon); 
 // UnregisterResourceDetails (TCursorResourceDetails); 
  UnregisterResourceDetails (TIconResourceDetails); 
  //UnregisterResourceDetails (TCursorGroupResourceDetails); 
  UnregisterResourceDetails (TIconGroupResourceDetails); 
end.