peresource.pas

East make Tray Icon in delphi

unit PeResource;

{$I JCL.INC}

interface

uses
  Windows, Messages, Classes, SysUtils, Graphics, ComCtrls,
  {$IFDEF DELPHI5_UP}
  Contnrs,
  {$ENDIF}
  JclBase, JclFileUtils, JclPeImage, JclStrings;

type
  PAccelTableEntry = ^TAccelTableEntry;
  ACCELTABLEENTRY = packed record
    fFlags: Word;
    wAnsi: Word;
    wId: Word;
    padding: Word;
  end;  
  {$EXTERNALSYM ACCELTABLEENTRY}
  TAccelTableEntry = ACCELTABLEENTRY;

  PCursorDir = ^TCursorDir;
  CURSORDIR = packed record
    Width: Word;
    Height: Word;
  end;
  {$EXTERNALSYM CURSORDIR}
  TCursorDir = CURSORDIR;

  PCursorShape = ^TCursorShape;
  _CURSORSHAPE = packed record
    xHotSpot: Integer;
    yHotSpot: Integer;
    cx: Integer;
    cy: Integer;
    cbWidth: Integer;
    Planes: Byte;
    BitsPixel: Byte;
  end;
  {$EXTERNALSYM _CURSORSHAPE}
  TCursorShape = _CURSORSHAPE;
  CURSORSHAPE = _CURSORSHAPE;
  {$EXTERNALSYM CURSORSHAPE}

  PLocalHeader = ^TLocalHeader;
  _LOCALHEADER = packed record
    xHotSpot: Word;
    yHotSpot: Word;
  end;
  {$EXTERNALSYM _LOCALHEADER}
  TLocalHeader = _LOCALHEADER;
  LOCALHEADER = _LOCALHEADER;
  {$EXTERNALSYM LOCALHEADER}

  PNewHeader = ^TNewHeader;
  _NEWHEADER = packed record
    Reserved: Word;
    ResType: Word;
    ResCount: Word;
  end;
  {$EXTERNALSYM _NEWHEADER}
  TNewHeader = _NEWHEADER;
  NEWHEADER = _NEWHEADER;
  {$EXTERNALSYM NEWHEADER}

  PIconResdir = ^TIconResdir;
  ICONRESDIR = packed record
    Width: Byte;
    Height: Byte;
    ColorCount: Byte;
    Reserved: Byte;
  end;
  {$EXTERNALSYM ICONRESDIR}
  TIconResdir = ICONRESDIR;

  TResInfo = packed record
    case Integer of
      0: (Icon: TIconResdir);
      1: (Cursor: TCursorDir);
  end;
  {$NODEFINE TResInfo}

  PResDir = ^TResDir;
  _RESDIR = packed record
    ResInfo: TResInfo;
    Planes: Word;
    BitCount: Word;
    BytesInRes: DWORD;
    IconCursorId: Word;
  end;
  {$EXTERNALSYM _RESDIR}
  TResDir = _RESDIR;
  RESDIR = _RESDIR;
  {$EXTERNALSYM RESDIR}

  PDlgTemplate = ^TDlgTemplate;
  DLGTEMPLATE = packed record
    style: DWORD;
    dwExtendedStyle: DWORD;
    cdit: Word;
    x: ShortInt; // short
    y: ShortInt;
    cx: ShortInt;
    cy: ShortInt;
  end;
  {$EXTERNALSYM DLGTEMPLATE}
  TDlgTemplate = DLGTEMPLATE;

  PDlgItemTemplate = ^TDlgItemTemplate;
  DLGITEMTEMPLATE = packed record
    style: DWORD;
    dwExtendedStyle: DWORD;
    x: ShortInt;
    y: ShortInt;
    cx: ShortInt;
    cy: ShortInt;
    id: Word;
  end;
  {$EXTERNALSYM DLGITEMTEMPLATE}
  TDlgItemTemplate = DLGITEMTEMPLATE;

  PMenuHeader = ^TMenuHeader;
  MENUHEADER = packed record
    wVersion: Word;
    cbHeaderSize: Word;
  end;
  {$EXTERNALSYM MENUHEADER}
  TMenuHeader = MENUHEADER;

  PMenuHelpID = ^TMenuHelpID;
  MENUHELPID = packed record
    helpID: DWORD;
  end;
  {$EXTERNALSYM MENUHELPID}
  TMenuHelpID = MENUHELPID;

  PNormalMenuItem = ^TNormalMenuItem;
  NORMALMENUITEM = packed record
    resInfo: WORD;
    menuText: Pointer; // szOrOrd
  end;
  {$EXTERNALSYM NORMALMENUITEM}
  TNormalMenuItem = NORMALMENUITEM;

  PPopupMenuItem = ^TPopupMenuItem;
  POPUPMENUITEM = packed record
    type_: DWORD;
    state: DWORD;
    id: DWORD;
    resInfo: Word;
    menuText: Pointer; // szOrOrd
  end;
  {$EXTERNALSYM POPUPMENUITEM}
  TPopupMenuItem = POPUPMENUITEM;

  PMenuExTemplateHeader = ^TMenuExTemplateHeader;
  MENUEX_TEMPLATE_HEADER = packed record
    wVersion: Word;
    wOffset: Word;
    dwHelpId: DWORD;
  end;
  {$EXTERNALSYM MENUEX_TEMPLATE_HEADER}
  TMenuExTemplateHeader = MENUEX_TEMPLATE_HEADER;

  PMenuExTemplateItem = ^TMenuExTemplateItem;
  MENUEX_TEMPLATE_ITEM = packed record
    dwType: DWORD;
    dwState: DWORD;
    uId: UINT;
    bResInfo: Word;
    szText: array[0..0] of WideChar;
    dwHelpId: DWORD;
  end;
  {$EXTERNALSYM MENUEX_TEMPLATE_ITEM}
  TMenuExTemplateItem = MENUEX_TEMPLATE_ITEM;

  PMessageResourceBlock = ^TMessageResourceBlock;
  _MESSAGE_RESOURCE_BLOCK = packed record
    LowId: ULONG;
    HighId: ULONG;
    OffsetToEntries: ULONG;
  end;
  {$EXTERNALSYM _MESSAGE_RESOURCE_BLOCK}
  TMessageResourceBlock = _MESSAGE_RESOURCE_BLOCK;
  MESSAGE_RESOURCE_BLOCK = _MESSAGE_RESOURCE_BLOCK;
  {$EXTERNALSYM MESSAGE_RESOURCE_BLOCK}

  PMessageResourceData = ^TMessageResourceData;
  _MESSAGE_RESOURCE_DATA = packed record
    NumberOfBlocks: ULONG;
    // Blocks: array[0..0] of TMessageResourceBlock;
  end;
  {$EXTERNALSYM _MESSAGE_RESOURCE_DATA}
  TMessageResourceData = _MESSAGE_RESOURCE_DATA;
  MESSAGE_RESOURCE_DATA = _MESSAGE_RESOURCE_DATA;
  {$EXTERNALSYM MESSAGE_RESOURCE_DATA}

  PMessageResourceEntry = ^TMessageResourceEntry;
  _MESSAGE_RESOURCE_ENTRY = packed record
    Length: Word;
    Flags: Word;
    // Text: array[0..0] of Char;
  end;
  {$EXTERNALSYM _MESSAGE_RESOURCE_ENTRY}
  TMessageResourceEntry = _MESSAGE_RESOURCE_ENTRY;
  MESSAGE_RESOURCE_ENTRY = _MESSAGE_RESOURCE_ENTRY;
  {$EXTERNALSYM MESSAGE_RESOURCE_ENTRY}

(*

Value Meaning
0x0080 Button
0x0081 Edit
0x0082 Static
0x0083 List box
0x0084 Scroll bar
0x0085 Combo box}

  PDlgTemplateEx = ^TDlgTemplateEx;
  DLGTEMPLATEEX = packed record
    dlgVer: WORD;
    signature: WORD;
    helpID: DWORD;
    exStyle: DWORD;
    style: DWORD;
    cDlgItems: WORD;
    x: short;
    y: short;
    cx: short;
    cy: short;
    sz_Or_Ord menu;         // name or ordinal of a menu resource
    sz_Or_Ord windowClass;  // name or ordinal of a window class
    WCHAR  title[titleLen]; // title string of the dialog box
    short  pointsize;       // if DS_SETFONT or DS_SHELLFONT is set
    short  weight;          // if DS_SETFONT or DS_SHELLFONT is set
    short  bItalic;         // if DS_SETFONT or DS_SHELLFONT is set
    WCHAR  font[fontLen];   // if DS_SETFONT or DS_SHELLFONT is set
} DLGTEMPLATEEX;


 typedef struct {
    DWORD  helpID;
    DWORD  exStyle;
    DWORD  style;
    short  x;
    short  y;
    short  cx;
    short  cy;
    WORD   id;
    sz_Or_Ord windowClass; // name or ordinal of a window class
    sz_Or_Ord title;       // title string or ordinal of a resource
    WORD   extraCount;     // bytes of following creation data
} DLGITEMTEMPLATEEX;

struct FONTDIRENTRY {
    WORD dfVersion;
    DWORD dfSize;
    char dfCopyright[60];
    WORD dfType;
    WORD dfPoints;
    WORD dfVertRes;
    WORD dfHorizRes;
    WORD dfAscent;
    WORD dfInternalLeading;
    WORD dfExternalLeading;
    BYTE dfItalic;
    BYTE dfUnderline;
    BYTE dfStrikeOut;
    WORD dfWeight;
    BYTE dfCharSet;
    WORD dfPixWidth;
    WORD dfPixHeight;
    BYTE dfPitchAndFamily;
    WORD dfAvgWidth;
    WORD dfMaxWidth;
    BYTE dfFirstChar;
    BYTE dfLastChar;
    BYTE dfDefaultChar;
    BYTE dfBreakChar;
    WORD dfWidthBytes;
    DWORD dfDevice;
    DWORD dfFace;
    DWORD dfReserved;
    char szDeviceName[];
    char szFaceName[];
};

struct FONTGROUPHDR {
    WORD NumberOfFonts;
    DIRENTRY  DE [1];
};

*)

type
  TPeResKind = (rkAccelerator, rkAvi, rkBitmap, rkCursor, rkData, rkDialog,
    rkHTML, rkIcon, rkMenu, rkMessageTable, rkString, rkVersion, rkUnknown);

  TPeResImage = class;

  TPeResItem = class;

  TPeResItem = class(TPersistent)
  private
    FKind: TPeResKind;
    FList: TObjectList;
    FResImage: TPeResImage;
    FResourceItem: TJclPeResourceItem;
    FStream: TJclPeResourceRawStream;
    function GetItems(Index: Integer): TPeResItem;
    function GetItemCount: Integer;
    function GetStream: TJclPeResourceRawStream;
  protected
    procedure CreateList; virtual;
  public
    constructor Create(AResImage: TPeResImage; AResourceItem: TJclPeResourceItem); virtual;
    destructor Destroy; override;
    function IsList: Boolean; virtual;
    function Offset: Integer;
    function RawData: Pointer;
    function ResName: string; virtual;
    function ResType: TJclPeResourceKind;
    procedure SaveToStream(Stream: TStream); virtual;
    function Size: Integer;
    property ItemCount: Integer read GetItemCount;
    property Items[Index: Integer]: TPeResItem read GetItems; default;
    property Kind: TPeResKind read FKind;
    property ResourceItem: TJclPeResourceItem read FResourceItem;
    property Stream: TJclPeResourceRawStream read GetStream;
  end;

  TJclReResItemClass = class of TPeResItem;

  TPeResUnknown = class(TPeResItem)
  public
    function FileExt: string; dynamic;
    function IsList: Boolean; override;
    function ResName: string; override;
  end;

  TPeGraphicProperties = record
    Width, Height, BitsPerPixel: Integer;
  end;

  TPeResUnkGraphic = class(TPeResUnknown)
  public
    function GraphicProperties: TPeGraphicProperties; virtual; abstract;
  end;

  TPeResUnkStrings = class(TPeResUnknown)
  protected
    procedure AssignTo(Dest: TPersistent); override;
  public
    function FileExt: string; override;
    procedure FillStrings(Strings: TStrings; StripCrLf: Boolean = False); virtual; abstract;
  end;

  TPeResAccelerator = class(TPeResUnkStrings)
  public
    procedure FillStrings(Strings: TStrings; StripCrLf: Boolean = False); override;
  end;

  TPeResAvi = class(TPeResUnknown)
  protected
    procedure AssignTo(Dest: TPersistent); override;
  public
    function FileExt: string; override;
  end;

  TPeResBitmap = class(TPeResUnkGraphic)
  protected
    procedure AssignTo(Dest: TPersistent); override;
  public
    function GraphicProperties: TPeGraphicProperties; override;
    function FileExt: string; override;
    procedure SaveToStream(Stream: TStream); override;
  end;

  TPeResCursorItem = class(TPeResUnkGraphic)
  private
    FResInfo: PResDir;
  protected
    procedure AssignTo(Dest: TPersistent); override;
  public
    function FileExt: string; override;
    function GraphicProperties: TPeGraphicProperties; override;
    function ResName: string; override;
    procedure SaveToStream(Stream: TStream); override;
  end;

  TPeResCursor = class(TPeResUnknown)
  private
    function GetItems(Index: Integer): TPeResCursorItem;
  protected
    procedure CreateList; override;
  public
    function IsList: Boolean; override;
    property Items[Index: Integer]: TPeResCursorItem read GetItems; default;
  end;

  TPeResDialog = class(TPeResUnknown)
  public
    function CanShowDialog: Boolean;
    function ShowDialog(ParentWnd: HWND): Integer;
  end;

  TPeResDataKind = (dkUnknown, dkDFM, dkPackageDescription, dkPackageInfo);

  TPeResRCData = class(TPeResUnknown)
  private
    FDataKind: TPeResDataKind;
  protected
    procedure AssignTo(Dest: TPersistent); override;
    procedure CheckFormat;
    procedure DFMToStrings(Strings: TStrings);
    procedure PackageInfoToStrings(Strings: TStrings);
  public
    constructor Create(AResImage: TPeResImage; AResourceItem: TJclPeResourceItem); override;
    function FileExt: string; override;
    property DataKind: TPeResDataKind read FDataKind;
  end;

  TPeResHTML = class(TPeResUnknown)
  public
    function FileExt: string; override;
    function ResPath: string;
  end;

  TPeResIconItem = class(TPeResCursorItem)
  public
    function FileExt: string; override;
    function GraphicProperties: TPeGraphicProperties; override;
  end;

  TPeResIcon = class(TPeResCursor)
  private
    function GetItems(Index: Integer): TPeResIconItem;
  public
    property Items[Index: Integer]: TPeResIconItem read GetItems; default;
  end;

  TPeResMenu = class(TPeResUnknown)
  end;

  TPeMessageTable = class(TPeResUnkStrings)
  public
    procedure FillStrings(Strings: TStrings; StripCrLf: Boolean = False); override;
  end;

  TPeResString = class(TPeResUnkStrings)
  public
    procedure FillStrings(Strings: TStrings; StripCrLf: Boolean = False); override;
  end;

  TPeResVersion = class(TPeResUnkStrings)
  public
    procedure FillStrings(Strings: TStrings; StripCrLf: Boolean = False); override;
  end;

  TPeResImage = class(TObjectList)
  private
    FCursorEntry: TJclPeResourceList;
    FIconEntry: TJclPeResourceList;
    FImageAttached: Boolean;
    FLibHandle: THandle;
    FPeImage: TJclPeImage;
    function GetFileName: TFileName;
    procedure SetFileName(const Value: TFileName);
    procedure SetPeImage(const Value: TJclPeImage);
    function GetItems(Index: Integer): TPeResItem;
    function GetLibHandle: THandle;
  protected
    procedure CreateList;
    procedure UnloadLib;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Clear; override;
    property ImageAttached: Boolean read FImageAttached;
    property Items[Index: Integer]: TPeResItem read GetItems; default;
    property LibHandle: THandle read GetLibHandle;
    property FileName: TFileName read GetFileName write SetFileName;
    property PeImage: TJclPeImage read FPeImage write SetPeImage;
  end;

  function LangNameFromName(const Name: string; ShortName: Boolean = False): string;

implementation

uses
  Consts, JclLocales, JclSysUtils, JclWin32;

resourcestring
  RsPeResAccelerator = 'Accel table';
  RsPeResAVI = 'AVI';
  RsPeResBitmap = 'Bitmap';
  RsPeResCursor = 'Cursor';
  RsPeResData = 'RCData';
  RsPeResDialog = 'Dialog';
  RsPeResHTML = 'HTML';
  RsPeResIcon = 'Icon';
  RsPeResMenu = 'Menu';