home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kolekce / d6 / RX275D6.ZIP / Units / Rxresexp.pas < prev    next >
Pascal/Delphi Source File  |  2001-06-24  |  67KB  |  2,366 lines

  1. {*******************************************************}
  2. {                                                       }
  3. {         Delphi VCL Extensions (RX)                    }
  4. {                                                       }
  5. {         Copyright (c) 1997, 1998 Master-Bank          }
  6. {                                                       }
  7. {*******************************************************}
  8.  
  9. unit RxResExp;
  10.  
  11. interface
  12.  
  13. {$I RX.INC}
  14.  
  15. {$IFNDEF RX_D3}
  16.   ERROR! This unit is intended for Delphi 3.0 or higher only!
  17.   { Resource expert doesn't work properly in Delphi 2.0 and in
  18.     C++Builder 1.0 and I don't know why. }
  19. {$ENDIF}
  20.  
  21. uses
  22.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  23.   IniFiles, ComCtrls, EditIntf, ExptIntf, ToolIntf, Menus, StdCtrls, Placemnt;
  24.  
  25. type
  26.   TRxProjectResExpert = class;
  27.   TResourceType = (rtpCustom, rtpCursor, rtpGroupCursor, rtpBitmap,
  28.     rtpIcon, rtpGroupIcon, rtpRCData, rtpVersion, rtpAniCursor,
  29.     rtpPredefined);
  30.  
  31.   TResSelection = record
  32.     ResName: string;
  33.     ResType: string;
  34.   end;
  35.  
  36.   TAddInNotifier = class(TIAddInNotifier)
  37.   private
  38.     FProjectResources: TRxProjectResExpert;
  39.   public
  40.     constructor Create(AProjectResources: TRxProjectResExpert);
  41.     procedure FileNotification(NotifyCode: TFileNotification;
  42.       const FileName: string; var Cancel: Boolean); override;
  43. {$IFDEF RX_D3}
  44.     procedure EventNotification(NotifyCode: TEventNotification;
  45.       var Cancel: Boolean); override;
  46. {$ENDIF}
  47.   end;
  48.  
  49.   TProjectNotifier = class(TIModuleNotifier)
  50.   private
  51.     FProjectResources: TRxProjectResExpert;
  52.   public
  53.     constructor Create(AProjectResources: TRxProjectResExpert);
  54.     procedure Notify(NotifyCode: TNotifyCode); override;
  55.     procedure ComponentRenamed(const AComponent: TComponent;
  56.       const OldName, NewName: string); override;
  57.   end;
  58.  
  59.   TResourceEntry = class(TObject)
  60.   private
  61.     FHandle: Pointer;
  62.     FName: string;
  63.     FType: string;
  64.     FNameId: Word;
  65.     FTypeId: Word;
  66.     FSize: Integer;
  67.     FEntryNode: TTreeNode;
  68.     FResType: TResourceType;
  69.     FChildren: TList;
  70.     FParent: TResourceEntry;
  71.     function GetBitmap(ResFile: TIResourceFile): TBitmap;
  72.     function GetCursorOrIcon(ResFile: TIResourceFile; IsIcon: Boolean): HIcon;
  73.   public
  74.     constructor Create(AEntry: TIResourceEntry);
  75.     destructor Destroy; override;
  76.     function Rename(ResFile: TIResourceFile; const NewName: string): Boolean;
  77.     function GetGraphic(ResFile: TIResourceFile): TGraphic;
  78.     procedure GetData(ResFile: TIResourceFile; Stream: TStream);
  79.     procedure GetIconData(ResFile: TIResourceFile; Stream: TStream);
  80.     function GetName: string;
  81.     function GetTypeName: string;
  82.     function GetResourceName: PChar;
  83.     function GetResourceType: PChar;
  84.     function EnableEdit: Boolean;
  85.     function EnableRenameDelete: Boolean;
  86.   end;
  87.  
  88.   TRxProjectResExpert = class(TIExpert)
  89.   private
  90.     ProjectResourcesItem: TIMenuItemIntf;
  91.     AddInNotifier: TAddInNotifier;
  92.     ProjectNotifier: TProjectNotifier;
  93.     ProjectModule: TIModuleInterface;
  94.     FResourceList: TStringList;
  95.     FSelection: TResSelection;
  96.     FResFileName: string;
  97.     FProjectName: string;
  98.     FLockCount: Integer;
  99.     procedure FindChildren(ResFile: TIResourceFile; Entry: TResourceEntry);
  100.     procedure LoadProjectResInfo;
  101.     procedure ClearProjectResInfo;
  102.     procedure UpdateProjectResInfo;
  103.     procedure OpenProject(const FileName: string);
  104.     procedure CloseProject;
  105. {$IFNDEF RX_D4}
  106.     procedure LoadDesktop(const FileName: string);
  107.     procedure SaveDesktop(const FileName: string);
  108. {$ENDIF}
  109.     procedure ProjectResourcesClick(Sender: TIMenuItemIntf);
  110.   public
  111.     constructor Create;
  112.     destructor Destroy; override;
  113.     function GetName: string; override;
  114.     function GetAuthor: string; override;
  115.     function GetComment: string; override;
  116.     function GetPage: string; override;
  117.     function GetGlyph: HICON; override;
  118.     function GetMenuText: string; override;
  119.     function GetState: TExpertState; override;
  120.     function GetStyle: TExpertStyle; override;
  121.     function GetIDString: string; override;
  122.     procedure Execute; override;
  123.     procedure BeginUpdate;
  124.     procedure EndUpdate;
  125.     procedure MarkModified;
  126.     function GetResFile: TIResourceFile;
  127.     function UniqueName(ResFile: TIResourceFile; ResType: PChar;
  128.       var Index: Integer): string;
  129.     procedure CheckRename(ResFile: TIResourceFile; ResType, NewName: PChar);
  130.     function DeleteEntry(ResFile: TIResourceFile; Entry: TResourceEntry): Boolean;
  131.     procedure CreateEntry(ResFile: TIResourceFile; ResType, ResName: PChar;
  132.       ADataSize: Integer; AData: Pointer; SetToEntry: Boolean);
  133.     procedure NewBinaryRes(ResFile: TIResourceFile; ResName, ResType: PChar;
  134.       Stream: TMemoryStream);
  135.     procedure EditBinaryRes(Entry: TResourceEntry; Stream: TMemoryStream);
  136.     procedure NewBitmapRes(ResFile: TIResourceFile; ResName: PChar;
  137.       Bitmap: TBitmap);
  138.     procedure EditBitmapRes(Entry: TResourceEntry; Bitmap: TBitmap);
  139.     procedure NewCursorIconRes(ResFile: TIResourceFile; ResName: PChar;
  140.       IsIcon: Boolean; Stream: TStream);
  141.     procedure EditCursorIconRes(Entry: TResourceEntry; IsIcon: Boolean;
  142.       Stream: TStream);
  143.   end;
  144.  
  145.   TRxResourceEditor = class(TForm)
  146.     StatusBar: TStatusBar;
  147.     ResTree: TTreeView;
  148.     PopupMenu: TPopupMenu;
  149.     NewItem: TMenuItem;
  150.     EditItem: TMenuItem;
  151.     RenameItem: TMenuItem;
  152.     DeleteItem: TMenuItem;
  153.     TreeImages: TImageList;
  154.     N1: TMenuItem;
  155.     NewBitmapItem: TMenuItem;
  156.     NewIconItem: TMenuItem;
  157.     NewCursorItem: TMenuItem;
  158.     NewUserDataItem: TMenuItem;
  159.     OpenDlg: TOpenDialog;
  160.     SaveDlg: TSaveDialog;
  161.     Placement: TFormStorage;
  162.     PreviewItem: TMenuItem;
  163.     SaveItem: TMenuItem;
  164.     procedure FormCreate(Sender: TObject);
  165.     procedure ResTreeExpanded(Sender: TObject; Node: TTreeNode);
  166.     procedure ResTreeCollapsed(Sender: TObject; Node: TTreeNode);
  167.     procedure ResTreeEditing(Sender: TObject; Node: TTreeNode;
  168.       var AllowEdit: Boolean);
  169.     procedure ResTreeEdited(Sender: TObject; Node: TTreeNode;
  170.       var S: string);
  171.     procedure PopupMenuPopup(Sender: TObject);
  172.     procedure RenameItemClick(Sender: TObject);
  173.     procedure EditItemClick(Sender: TObject);
  174.     procedure DeleteItemClick(Sender: TObject);
  175.     procedure NewBitmapItemClick(Sender: TObject);
  176.     procedure NewIconItemClick(Sender: TObject);
  177.     procedure NewCursorItemClick(Sender: TObject);
  178.     procedure NewUserDataItemClick(Sender: TObject);
  179.     procedure ResTreeKeyPress(Sender: TObject; var Key: Char);
  180.     procedure ResTreeDblClick(Sender: TObject);
  181.     procedure ResTreeChange(Sender: TObject; Node: TTreeNode);
  182.     procedure FormDestroy(Sender: TObject);
  183.     procedure PreviewItemClick(Sender: TObject);
  184.     procedure StatusBarDrawPanel(StatusBar: TStatusBar;
  185.       Panel: TStatusPanel; const Rect: TRect);
  186.     procedure SaveItemClick(Sender: TObject);
  187.   private
  188.     { Private declarations }
  189.     FExpert: TRxProjectResExpert;
  190.     function GetResourceTypeName: string;
  191.     procedure CheckResourceType(Sender: TObject; var TypeName: string;
  192.       var Apply: Boolean);
  193.   public
  194.     { Public declarations }
  195.   end;
  196.  
  197. var
  198.   RxResourceEditor: TRxResourceEditor = nil;
  199.  
  200. procedure RegisterResourceExpert;
  201.  
  202. implementation
  203.  
  204. uses Consts, VCLUtils, rxStrUtils, MaxMin, PictEdit
  205.   {$IFDEF RX_D4}, ImgList {$ENDIF};
  206.  
  207. {$R *.DFM}
  208. {$R *.R32}
  209. {$D-}
  210.  
  211. {$I RXRESEXP.INC}
  212.  
  213. const
  214.   sExpertID = 'RX.ProjectResourceExpert';
  215.   sVisible = 'Visible';
  216.  
  217. { Library registration }
  218.  
  219. procedure RegisterResourceExpert;
  220. begin
  221.   RegisterLibraryExpert(TRxProjectResExpert.Create);
  222. end;
  223.  
  224. { TInputBox }
  225.  
  226. type
  227.   TApplyEvent = procedure(Sender: TObject; var Value: string;
  228.     var Apply: Boolean) of object;
  229.  
  230.   TInputBox = class(TForm)
  231.   private
  232.     FPrompt: TLabel;
  233.     FEdit: TComboBox;
  234.     FValue: string;
  235.     FOnApply: TApplyEvent;
  236.     function GetPrompt: string;
  237.     procedure SetPrompt(const Value: string);
  238.     function GetStrings: TStrings;
  239.     procedure SetStrings(Value: TStrings);
  240.     procedure OkButtonClick(Sender: TObject);
  241.   public
  242.     function Execute: Boolean;
  243.     constructor Create(AOwner: TComponent); override;
  244.     property Caption;
  245.     property Value: string read FValue write FValue;
  246.     property Prompt: string read GetPrompt write SetPrompt;
  247.     property Strings: TStrings read GetStrings write SetStrings;
  248.     property OnApply: TApplyEvent read FOnApply write FOnApply;
  249.   end;
  250.  
  251. constructor TInputBox.Create(AOwner: TComponent);
  252. var
  253.   DialogUnits: TPoint;
  254.   ButtonTop, ButtonWidth, ButtonHeight: Integer;
  255. begin
  256. {$IFDEF CBUILDER}
  257.   inherited CreateNew(AOwner, 0);
  258. {$ELSE}
  259.   inherited CreateNew(AOwner);
  260. {$ENDIF}
  261.   Canvas.Font := Self.Font;
  262.   DialogUnits := GetAveCharSize(Canvas);
  263.   BorderStyle := bsDialog;
  264.   ClientWidth := MulDiv(180, DialogUnits.X, 4);
  265.   ClientHeight := MulDiv(63, DialogUnits.Y, 8);
  266.   Position := poScreenCenter;
  267.   FPrompt := TLabel.Create(Self);
  268.   with FPrompt do begin
  269.     Parent := Self;
  270.     AutoSize := True;
  271.     Left := MulDiv(8, DialogUnits.X, 4);
  272.     Top := MulDiv(8, DialogUnits.Y, 8);
  273.   end;
  274.   FEdit := TComboBox.Create(Self);
  275.   with FEdit do begin
  276.     Parent := Self;
  277.     Left := FPrompt.Left;
  278.     Top := MulDiv(19, DialogUnits.Y, 8);
  279.     Width := MulDiv(164, DialogUnits.X, 4);
  280.     MaxLength := 255;
  281.     Style := csDropDown;
  282.   end;
  283.   FPrompt.FocusControl := FEdit;
  284.   ButtonTop := MulDiv(41, DialogUnits.Y, 8);
  285.   ButtonWidth := MulDiv(50, DialogUnits.X, 4);
  286.   ButtonHeight := MulDiv(14, DialogUnits.Y, 8);
  287.   with TButton.Create(Self) do begin
  288.     Parent := Self;
  289.     Caption := SMsgDlgOK;
  290.     ModalResult := mrNone;
  291.     OnClick := OkButtonClick;
  292.     Default := True;
  293.     SetBounds(MulDiv(38, DialogUnits.X, 4), ButtonTop, ButtonWidth,
  294.       ButtonHeight);
  295.   end;
  296.   with TButton.Create(Self) do begin
  297.     Parent := Self;
  298.     Caption := SMsgDlgCancel;
  299.     ModalResult := mrCancel;
  300.     Cancel := True;
  301.     SetBounds(MulDiv(92, DialogUnits.X, 4), ButtonTop, ButtonWidth,
  302.       ButtonHeight);
  303.   end;
  304. end;
  305.  
  306. procedure TInputBox.OkButtonClick(Sender: TObject);
  307. var
  308.   Apply: Boolean;
  309.   Value: string;
  310. begin
  311.   Apply := True;
  312.   if Assigned(FOnApply) then begin
  313.     Value := FEdit.Text;
  314.     FOnApply(Self, Value, Apply);
  315.     if FEdit.Text <> Value then FEdit.Text := Value;
  316.   end;
  317.   if Apply then ModalResult := mrOk;
  318. end;
  319.  
  320. function TInputBox.Execute: Boolean;
  321. begin
  322.   with FEdit do begin
  323.     Text := FValue;
  324.     SelectAll;
  325.   end;
  326.   Result := ShowModal = mrOk;
  327.   if Result then FValue := FEdit.Text;
  328. end;
  329.  
  330. function TInputBox.GetPrompt: string;
  331. begin
  332.   Result := FPrompt.Caption;
  333. end;
  334.  
  335. procedure TInputBox.SetPrompt(const Value: string);
  336. begin
  337.   FPrompt.Caption := Value;
  338. end;
  339.  
  340. function TInputBox.GetStrings: TStrings;
  341. begin
  342.   Result := FEdit.Items;
  343. end;
  344.  
  345. procedure TInputBox.SetStrings(Value: TStrings);
  346. begin
  347.   if Value = nil then FEdit.Items.Clear
  348.   else FEdit.Items.Assign(Value);
  349. end;
  350.  
  351. { Utility routines }
  352.  
  353. {$IFNDEF RX_D3}
  354. const
  355.   RT_ANICURSOR = MakeIntResource(21);
  356.   RT_ANIICON = MakeIntResource(22);
  357. {$ENDIF}
  358. const
  359.   FIRST_CUSTOM_RESTYPE = 25;
  360.  
  361. function IsValidIdent(const Ident: string): Boolean;
  362. const
  363.   Numeric = ['0'..'9'];
  364.   AlphaNumeric = Numeric + ['A'..'Z', 'a'..'z', '_', '.'];
  365. var
  366.   I: Integer;
  367. begin
  368.   Result := False;
  369.   if (Length(Ident) = 0) then Exit;
  370.   for I := 1 to Length(Ident) do
  371.     if not (Ident[I] in AlphaNumeric) then Exit;
  372.   Result := True;
  373. end;
  374.  
  375. function IsValidResType(const Ident: string): Boolean;
  376. var
  377.   Val: Longint;
  378. begin
  379.   Result := IsValidIdent(Ident);
  380.   if Result then begin
  381.     Val := StrToIntDef(Ident, FIRST_CUSTOM_RESTYPE);
  382.     Result := (Val >= FIRST_CUSTOM_RESTYPE) and (Val <= High(Word));
  383.   end;
  384. end;
  385.  
  386. procedure CreateForm(InstanceClass: TComponentClass; var Reference);
  387. begin
  388.   if TComponent(Reference) = nil then begin
  389.     TComponent(Reference) := TComponent(InstanceClass.NewInstance);
  390.     try
  391.       TComponent(Reference).Create(Application);
  392.     except
  393.       TComponent(Reference).Free;
  394.       TComponent(Reference) := nil;
  395.       raise;
  396.     end;
  397.   end;
  398. end;
  399.  
  400. function PadUp(Value: Longint): Longint;
  401. begin
  402.   Result := Value + (Value mod 4);
  403. end;
  404.  
  405. function StrText(P: PChar): string;
  406. begin
  407.   if HiWord(Longint(P)) = 0 then
  408.     Result := IntToStr(LoWord(Longint(P)))
  409.   else Result := StrPas(P);
  410. end;
  411.  
  412. function ResIdent(const Name: string): PChar;
  413. var
  414.   Id: Word;
  415.   Code: Integer;
  416. begin
  417.   Val(Name, Id, Code);
  418.   if Code = 0 then Result := MakeIntResource(Id)
  419.   else Result := PChar(AnsiUpperCase(Name));
  420. end;
  421.  
  422. function CheckResType(ResType: Integer): TResourceType;
  423. begin
  424.   case ResType of
  425.     Integer(RT_CURSOR): Result := rtpCursor;
  426.     Integer(RT_BITMAP): Result := rtpBitmap;
  427.     Integer(RT_ICON): Result := rtpIcon;
  428.     Integer(RT_RCDATA): Result := rtpRCData;
  429.     Integer(RT_GROUP_CURSOR): Result := rtpGroupCursor;
  430.     Integer(RT_GROUP_ICON): Result := rtpGroupIcon;
  431.     Integer(RT_VERSION): Result := rtpVersion;
  432.     Integer(RT_ANICURSOR): Result := rtpAniCursor;
  433.     else Result := rtpCustom; { user-defined resource type }
  434.   end;
  435.   if (Result = rtpCustom) and (ResType > 0) and
  436.     (ResType < FIRST_CUSTOM_RESTYPE) then
  437.     Result := rtpPredefined;
  438. end;
  439.  
  440. function ResourceTypeName(ResType: Integer): string;
  441. begin
  442.   case ResType of
  443.     Integer(RT_CURSOR): Result := 'CURSOR';
  444.     Integer(RT_BITMAP): Result := 'BITMAP';
  445.     Integer(RT_ICON): Result := 'ICON';
  446.     Integer(RT_MENU): Result := 'MENU';
  447.     Integer(RT_DIALOG): Result := 'DIALOG';
  448.     Integer(RT_STRING): Result := 'STRINGS';
  449.     Integer(RT_FONTDIR): Result := 'FONTDIR';
  450.     Integer(RT_FONT): Result := 'FONT';
  451.     Integer(RT_ACCELERATOR): Result := 'ACCELERATOR';
  452.     Integer(RT_RCDATA): Result := 'RCDATA';
  453.     Integer(RT_MESSAGETABLE): Result := 'MESSAGE TABLE';
  454.     Integer(RT_GROUP_CURSOR): Result := 'CURSOR';
  455.     Integer(RT_GROUP_ICON): Result := 'ICON';
  456.     Integer(RT_VERSION): Result := 'VERSIONINFO';
  457.     Integer(RT_DLGINCLUDE): Result := 'DLGINCLUDE';
  458.     Integer(RT_PLUGPLAY): Result := 'PLUG-AND-PLAY';
  459.     Integer(RT_VXD): Result := 'VXD';
  460.     Integer(RT_ANICURSOR): Result := 'ANICURSOR';
  461.     Integer(RT_ANIICON): Result := 'ANIICON';
  462.     else Result := IntToStr(ResType);
  463.   end;
  464. end;
  465.  
  466. function ResTypeName(ResType: PChar): string;
  467. begin
  468.   if HiWord(Longint(ResType)) = 0 then
  469.     Result := ResourceTypeName(LoWord(Longint(ResType)))
  470.   else Result := StrPas(ResType);
  471. end;
  472.  
  473. function FindNode(TreeView: TCustomTreeView; Node: TTreeNode;
  474.   const ResName, ResType: string): TTreeNode;
  475.  
  476.   function SearchNodes(Node: TTreeNode): TTreeNode;
  477.   var
  478.     ChildNode: TTreeNode;
  479.     Entry: TResourceEntry;
  480.   begin
  481.     Result := nil;
  482.     if Node = nil then Exit;
  483.     Entry := TResourceEntry(Node.Data);
  484.     if ((Entry <> nil) and (Entry.GetName = ResName) and
  485.       (Entry.GetTypeName = ResType)) or ((Entry = nil) and (ResName = '') and
  486.       (Node.Text = ResType)) then
  487.       Result := Node
  488.     else
  489.     begin
  490.       ChildNode := Node.GetFirstChild;
  491.       while ChildNode <> nil do begin
  492.         Result := SearchNodes(ChildNode);
  493.         if Result <> nil then Break
  494.         else ChildNode := Node.GetNextChild(ChildNode);
  495.       end;
  496.     end;
  497.   end;
  498.  
  499. begin
  500.   if Node = nil then Node := TTreeView(TreeView).Items.GetFirstNode;
  501.   Result := SearchNodes(Node);
  502. end;
  503.  
  504. const
  505.   ResImages: array[TResourceType] of Integer = (2, 4, 4, 5, 3, 3, 2, 8, 4, 2);
  506.   AllMenuFlags = [mfInvalid, mfEnabled, mfVisible, mfChecked, mfBreak,
  507.     mfBarBreak, mfRadioItem];
  508.  
  509. const
  510.   MOVEABLE    = $0010;
  511.   PURE        = $0020;
  512.   PRELOAD     = $0040;
  513.   DISCARDABLE = $1000;
  514.  
  515. const
  516.   rc3_StockIcon = 0;
  517.   rc3_Icon = 1;
  518.   rc3_Cursor = 2;
  519.  
  520. type
  521.   PCursorOrIcon = ^TCursorOrIcon;
  522.   TCursorOrIcon = packed record
  523.     Reserved: Word;
  524.     wType: Word;
  525.     Count: Word;
  526.   end;
  527.  
  528.   PIconDirectory = ^TIconDirectory;
  529.   TIconDirectory = packed record
  530.     case Integer of
  531.       rc3_Cursor:
  532.         (cWidth: Word;
  533.         cHeight: Word);
  534.       rc3_Icon:
  535.         (Width: Byte;
  536.         Height: Byte;
  537.         Colors: Byte;
  538.         Reserved: Byte;
  539.         Planes: Word;
  540.         BitCount: Word;
  541.         BytesInRes: Longint;
  542.         NameOrdinal: Word);
  543.   end;
  544.  
  545.   PCursorHeader = ^TCursorHeader;
  546.   TCursorHeader = packed record
  547.     xHotspot: Word;
  548.     yHotspot: Word;
  549.   end;
  550.  
  551.   PDirectory = ^TDirectory;
  552.   TDirectory = array[0..64] of TIconDirectory;
  553.  
  554.   PIconRec = ^TIconRec;
  555.   TIconRec = packed record
  556.     Width: Byte;
  557.     Height: Byte;
  558.     Colors: Word;
  559.     Reserved1: Word; { xHotspot }
  560.     Reserved2: Word; { yHotspot }
  561.     DIBSize: Longint;
  562.     DIBOffset: Longint;
  563.   end;
  564.  
  565.   PIconList = ^TIconList;
  566.   TIconList = array[0..64] of TIconRec;
  567.  
  568. procedure InvalidIcon; near;
  569. begin
  570.   raise EInvalidGraphic.Create(ResStr(SInvalidIcon));
  571. end;
  572.  
  573. { TIconData }
  574.  
  575. type
  576.   TIconData = class
  577.   private
  578.     FHeader: TCursorOrIcon;
  579.     FList: Pointer;
  580.     FNames: PWordArray;
  581.     FData: TList;
  582.     procedure Clear;
  583.   public
  584.     constructor Create;
  585.     destructor Destroy; override;
  586.     function GetCount: Integer;
  587.     procedure LoadFromStream(Stream: TStream);
  588.     procedure SaveToStream(Stream: TStream);
  589.     function BuildResourceGroup(var Size: Integer): Pointer;
  590.     function BuildResourceItem(Index: Integer; var Size: Integer): Pointer;
  591.     procedure LoadResourceGroup(Data: Pointer; Size: Integer);
  592.     procedure LoadResourceItem(Index: Integer; Data: Pointer; Size: Integer);
  593.     procedure SetNameOrdinal(Index: Integer; Name: Word);
  594.   end;
  595.  
  596. constructor TIconData.Create;
  597. begin
  598.   inherited Create;
  599.   FData := TList.Create;
  600. end;
  601.  
  602. destructor TIconData.Destroy;
  603. begin
  604.   Clear;
  605.   FData.Free;
  606.   inherited Destroy;
  607. end;
  608.  
  609. procedure TIconData.Clear;
  610. begin
  611.   if FNames <> nil then FreeMem(FNames);
  612.   FNames := nil;
  613.   if FList <> nil then FreeMem(FList);
  614.   FList := nil;
  615.   while FData.Count > 0 do begin
  616.     if Pointer(FData[0]) <> nil then FreeMem(Pointer(FData[0]));
  617.     FData.Delete(0);
  618.   end;
  619.   FillChar(FHeader, SizeOf(FHeader), 0);
  620. end;
  621.  
  622. function TIconData.GetCount: Integer;
  623. begin
  624.   Result := FData.Count;
  625. end;
  626.  
  627. function TIconData.BuildResourceGroup(var Size: Integer): Pointer;
  628. var
  629.   P: PDirectory;
  630.   List: PIconList;
  631.   I: Integer;
  632.   BI: PBitmapInfoHeader;
  633. begin
  634.   Size := SizeOf(FHeader) + SizeOf(TIconDirectory) * FHeader.Count;
  635.   Result := AllocMem(Size);
  636.   try
  637.     Move(FHeader, Result^, SizeOf(FHeader));
  638.     P := PDirectory(PChar(Result) + SizeOf(FHeader));
  639.     List := PIconList(FList);
  640.     for I := 0 to FHeader.Count - 1 do begin
  641.       BI := PBitmapInfoHeader(Pointer(FData[I]));
  642.       with P^[I] do begin
  643.         if FHeader.wType = rc3_Cursor then begin
  644.           cWidth := List^[I].Width;
  645.           cHeight := List^[I].Height * 2;
  646.         end
  647.         else begin
  648.           Width := List^[I].Width;
  649.           Height := List^[I].Height;
  650.           Colors := List^[I].Colors;
  651.           Reserved := 0;
  652.         end;
  653.         Planes := BI^.biPlanes;
  654.         BitCount := BI^.biBitCount;
  655.         BytesInRes := List^[I].DIBSize;
  656.         if FHeader.wType = rc3_Cursor then
  657.           Inc(BytesInRes, SizeOf(TCursorHeader));
  658.         NameOrdinal := 0;
  659.         if FNames <> nil then NameOrdinal := FNames^[I];
  660.       end;
  661.     end;
  662.   except
  663.     FreeMem(Result);
  664.     raise;
  665.   end;
  666. end;
  667.  
  668. function TIconData.BuildResourceItem(Index: Integer;
  669.   var Size: Integer): Pointer;
  670. var
  671.   Icon: PIconRec;
  672.   P: Pointer;
  673. begin
  674.   Icon := @(PIconList(FList)^[Index]);
  675.   Size := Icon^.DIBSize;
  676.   if FHeader.wType = rc3_Cursor then Inc(Size, SizeOf(TCursorHeader));
  677.   Result := AllocMem(Size);
  678.   try
  679.     P := Result;
  680.     if FHeader.wType = rc3_Cursor then begin
  681.       with PCursorHeader(Result)^ do begin
  682.         xHotspot := Icon^.Reserved1;
  683.         yHotspot := Icon^.Reserved2;
  684.       end;
  685.       Inc(PChar(P), SizeOf(TCursorHeader));
  686.     end;
  687.     Move(Pointer(FData[Index])^, P^, Icon^.DIBSize);
  688.   except
  689.     FreeMem(Result);
  690.     raise;
  691.   end;
  692. end;
  693.  
  694. procedure TIconData.SetNameOrdinal(Index: Integer; Name: Word);
  695. begin
  696.   if (FNames <> nil) and (Index >= 0) and (Index < FData.Count) then
  697.     FNames^[Index] := Name;
  698. end;
  699.  
  700. procedure TIconData.LoadResourceGroup(Data: Pointer; Size: Integer);
  701. var
  702.   P: PDirectory;
  703.   List: PIconList;
  704.   I: Integer;
  705. begin
  706.   FHeader.Count := (Size - SizeOf(FHeader)) div SizeOf(TIconDirectory);
  707.   Move(Data^, FHeader, SizeOf(FHeader));
  708.   if FList <> nil then FreeMem(FList);
  709.   FList := AllocMem(SizeOf(TIconRec) * FHeader.Count);
  710.   while FData.Count > 0 do begin
  711.     if Pointer(FData[0]) <> nil then FreeMem(Pointer(FData[0]));
  712.     FData.Delete(0);
  713.   end;
  714.   P := PDirectory(PChar(Data) + SizeOf(FHeader));
  715.   List := PIconList(FList);
  716.   if FNames <> nil then FreeMem(FNames);
  717.   FNames := AllocMem(FHeader.Count * SizeOf(Word));
  718.   for I := 0 to FHeader.Count - 1 do begin
  719.     with List^[I] do begin
  720.       if FHeader.wType = rc3_Cursor then begin
  721.         Width := P^[I].cWidth;
  722.         Height := P^[I].cHeight div 2;
  723.       end
  724.       else begin
  725.         Width := P^[I].Width;
  726.         Height := P^[I].Height;
  727.         Colors := P^[I].Colors;
  728.       end;
  729.       DIBSize := P^[I].BytesInRes;
  730.       if FHeader.wType = rc3_Cursor then Dec(DIBSize, SizeOf(TCursorHeader));
  731.       Reserved1 := 0;
  732.       Reserved2 := 0;
  733.     end;
  734.     FData.Add(nil);
  735.     SetNameOrdinal(I, P^[I].NameOrdinal);
  736.   end;
  737. end;
  738.  
  739. procedure TIconData.LoadResourceItem(Index: Integer; Data: Pointer;
  740.   Size: Integer);
  741. var
  742.   P: Pointer;
  743.   Rec: PIconRec;
  744.   BI: PBitmapInfoHeader;
  745. begin
  746.   if (Index < 0) or (Index >= FData.Count) then Exit;
  747.   Rec := @(PIconList(FList)^[Index]);
  748.   P := Data;
  749.   if FHeader.wType = rc3_Cursor then begin
  750.     with Rec^ do begin
  751.       Reserved1 := PCursorHeader(Data).xHotspot;
  752.       Reserved2 := PCursorHeader(Data).yHotspot;
  753.     end;
  754.     Inc(PChar(P), SizeOf(TCursorHeader));
  755.     Dec(Size, SizeOf(TCursorHeader));
  756.   end;
  757.   FData[Index] := AllocMem(Size);
  758.   Move(P^, Pointer(FData[Index])^, Min(Rec^.DIBSize, Size));
  759.   BI := PBitmapInfoHeader(Pointer(FData[Index]));
  760.   case BI^.biBitCount of
  761.     1, 4, 8: Rec^.Colors := (1 shl BI^.biBitCount) * BI^.biPlanes;
  762.     else Rec^.Colors := BI^.biBitCount * BI^.biPlanes;
  763.   end;
  764. end;
  765.  
  766. procedure TIconData.SaveToStream(Stream: TStream);
  767. var
  768.   I, J: Integer;
  769.   Data: Pointer;
  770. begin
  771.   FHeader.Count := FData.Count;
  772.   Stream.WriteBuffer(FHeader, SizeOf(FHeader));
  773.   for I := 0 to FHeader.Count - 1 do begin
  774.     PIconList(FList)^[I].DIBOffset := SizeOf(FHeader) + (SizeOf(TIconRec) *
  775.       FHeader.Count);
  776.     for J := 0 to I - 1 do
  777.       Inc(PIconList(FList)^[I].DIBOffset, PIconList(FList)^[I - 1].DIBSize);
  778.   end;
  779.   Stream.WriteBuffer(FList^, SizeOf(TIconRec) * FHeader.Count);
  780.   for I := 0 to FHeader.Count - 1 do begin
  781.     Data := FData[I];
  782.     Stream.WriteBuffer(Data^, PIconList(FList)^[I].DIBSize);
  783.   end;
  784. end;
  785.  
  786. procedure TIconData.LoadFromStream(Stream: TStream);
  787. var
  788.   I: Integer;
  789.   Data: Pointer;
  790. begin
  791.   Clear;
  792.   Stream.ReadBuffer(FHeader, SizeOf(FHeader));
  793.   if (not (FHeader.wType in [rc3_Icon, rc3_Cursor])) or
  794.     (FHeader.Count < 1) then InvalidIcon;
  795.   FList := AllocMem(SizeOf(TIconRec) * FHeader.Count);
  796.   try
  797.     Stream.ReadBuffer(FList^, SizeOf(TIconRec) * FHeader.Count);
  798.     for I := 0 to FHeader.Count - 1 do begin
  799.       Stream.Seek(PIconList(FList)^[I].DIBOffset, 0);
  800.       Data := AllocMem(PIconList(FList)^[I].DIBSize);
  801.       try
  802.         FData.Add(TObject(Data));
  803.       except
  804.         FreeMem(Data);
  805.         raise;
  806.       end;
  807.       Stream.ReadBuffer(Data^, PIconList(FList)^[I].DIBSize);
  808.     end;
  809.     FNames := AllocMem(FData.Count * SizeOf(Word));
  810.     FillChar(FNames^, FData.Count * SizeOf(Word), 0);
  811.   except
  812.     Clear;
  813.     raise;
  814.   end;
  815. end;
  816.  
  817. { TAddInNotifier }
  818.  
  819. procedure EnableMenuItem(Expert: TRxProjectResExpert;
  820.   AEnable: Boolean);
  821. begin
  822.   with Expert.ProjectResourcesItem do
  823.     if (Expert.FResFileName <> '') and AEnable then
  824.       SetFlags(AllMenuFlags, GetFlags + [mfEnabled])
  825.     else
  826.       SetFlags(AllMenuFlags, GetFlags - [mfEnabled]);
  827. end;
  828.  
  829. constructor TAddInNotifier.Create(AProjectResources: TRxProjectResExpert);
  830. begin
  831.   inherited Create;
  832.   FProjectResources := AProjectResources;
  833. end;
  834.  
  835. procedure TAddInNotifier.FileNotification(NotifyCode: TFileNotification;
  836.   const FileName: string; var Cancel: Boolean);
  837. begin
  838.   if FProjectResources = nil then Exit;
  839.   case NotifyCode of
  840.     fnProjectOpened:
  841.       begin
  842.         FProjectResources.OpenProject(FileName);
  843.         EnableMenuItem(FProjectResources, True);
  844.       end;
  845. {$IFNDEF RX_D4}
  846.     fnProjectDesktopLoad:
  847.       FProjectResources.LoadDesktop(FileName);
  848.     fnProjectDesktopSave:
  849.       FProjectResources.SaveDesktop(FileName);
  850. {$ENDIF}
  851.   end;  
  852. end;
  853.  
  854. {$IFDEF RX_D3}
  855. procedure TAddInNotifier.EventNotification(NotifyCode: TEventNotification;
  856.   var Cancel: Boolean);
  857. begin
  858.   { Nothing to do here but needs to be overridden anyway }
  859. end;
  860. {$ENDIF}
  861.  
  862. { TProjectNotifier }
  863.  
  864. constructor TProjectNotifier.Create(AProjectResources: TRxProjectResExpert);
  865. begin
  866.   inherited Create;
  867.   FProjectResources := AProjectResources;
  868. end;
  869.  
  870. procedure TProjectNotifier.Notify(NotifyCode: TNotifyCode);
  871. begin
  872.   if FProjectResources = nil then Exit;
  873.   case NotifyCode of
  874.     ncModuleDeleted:
  875.       begin
  876.         if RxResourceEditor <> nil then RxResourceEditor.Close;
  877.         EnableMenuItem(FProjectResources, False);
  878.         FProjectResources.CloseProject;
  879.       end;
  880.     ncModuleRenamed, ncProjResModified:
  881.       begin
  882.         FProjectResources.UpdateProjectResInfo;
  883.         EnableMenuItem(FProjectResources, True);
  884.       end;
  885.   end;
  886. end;
  887.  
  888. procedure TProjectNotifier.ComponentRenamed(const AComponent: TComponent;
  889.   const OldName, NewName: string);
  890. begin
  891.   { Nothing to do here but needs to be overridden anyway }
  892. end;
  893.  
  894. { TResourceEntry }
  895.  
  896. constructor TResourceEntry.Create(AEntry: TIResourceEntry);
  897. var
  898.   P: PChar;
  899. begin
  900.   inherited Create;
  901.   FChildren := TList.Create;
  902.   FHandle := AEntry.GetEntryHandle;
  903.   P := AEntry.GetResourceType;
  904.   if HiWord(Longint(P)) = 0 then begin
  905.     FResType := CheckResType(LoWord(Longint(P)));
  906.     FTypeId := LoWord(Longint(P));
  907.   end;
  908.   FType := ResTypeName(P);
  909.   P := AEntry.GetResourceName;
  910.   if HiWord(Longint(P)) = 0 then
  911.     FNameId := LoWord(Longint(P));
  912.   FName := StrText(P);
  913.   FSize := AEntry.GetDataSize;
  914. end;
  915.  
  916. destructor TResourceEntry.Destroy;
  917. begin
  918.   FChildren.Free;
  919.   inherited Destroy;
  920. end;
  921.  
  922. function TResourceEntry.GetResourceName: PChar;
  923. begin
  924.   if FNameId > 0 then Result := MakeIntResource(FNameId)
  925.   else Result := PChar(FName);
  926. end;
  927.  
  928. function TResourceEntry.GetResourceType: PChar;
  929. begin
  930.   if FTypeId > 0 then Result := MakeIntResource(FTypeId)
  931.   else Result := PChar(FType);
  932. end;
  933.  
  934. function TResourceEntry.GetName: string;
  935. begin
  936.   Result := FName;
  937. end;
  938.  
  939. function TResourceEntry.GetTypeName: string;
  940. begin
  941.   Result := FType;
  942. end;
  943.  
  944. function TResourceEntry.EnableEdit: Boolean;
  945. begin
  946.   Result := FResType in [rtpGroupCursor, rtpBitmap, rtpGroupIcon, rtpRCData,
  947.     rtpAniCursor, rtpCustom];
  948. end;
  949.  
  950. function TResourceEntry.EnableRenameDelete: Boolean;
  951. begin
  952.   Result := FResType in [rtpCustom, rtpGroupCursor, rtpBitmap, rtpGroupIcon,
  953.     rtpRCData, rtpAniCursor, rtpPredefined];
  954.   if (FResType = rtpGroupIcon) then
  955.     Result := CompareText(GetName, 'MAINICON') <> 0;
  956. end;
  957.  
  958. function TResourceEntry.GetCursorOrIcon(ResFile: TIResourceFile;
  959.   IsIcon: Boolean): HIcon;
  960. var
  961.   Entry, ChildEntry: TIResourceEntry;
  962.   I: Integer;
  963. begin
  964.   Result := 0;
  965.   if not (FResType in [rtpGroupIcon, rtpGroupCursor]) then Exit;
  966.   Entry := ResFile.FindEntry(GetResourceType, GetResourceName);
  967.   try
  968.     I := LookupIconIdFromDirectory(Entry.GetData, IsIcon);
  969.     if I > 0 then begin
  970.       if IsIcon then
  971.         ChildEntry := ResFile.FindEntry(RT_ICON, PChar(I))
  972.       else
  973.         ChildEntry := ResFile.FindEntry(RT_CURSOR, PChar(I));
  974.       if ChildEntry <> nil then
  975.       try
  976.         with ChildEntry do
  977.           Result := CreateIconFromResourceEx(GetData, GetDataSize,
  978.             IsIcon, $30000, 0, 0, $80);
  979.       finally
  980.         ChildEntry.Free;
  981.       end;
  982.     end;
  983.   finally
  984.     Entry.Free;
  985.   end;
  986. end;
  987.  
  988. procedure TResourceEntry.GetIconData(ResFile: TIResourceFile; Stream: TStream);
  989. var
  990.   Data: TIconData;
  991.   Entry: TIResourceEntry;
  992.   I: Integer;
  993.   P: PChar;
  994. begin
  995.   if not (FResType in [rtpGroupIcon, rtpGroupCursor]) then Exit;
  996.   Data := TIconData.Create;
  997.   try
  998.     Entry := ResFile.FindEntry(GetResourceType, GetResourceName);
  999.     try
  1000.       Data.LoadResourceGroup(Entry.GetData, Entry.GetDataSize);
  1001.     finally
  1002.       Entry.Free;
  1003.     end;
  1004.     for I := 0 to Data.FHeader.Count - 1 do begin
  1005.       P := MakeIntResource(Data.FNames^[I]);
  1006.       if FResType = rtpGroupIcon then
  1007.         Entry := ResFile.FindEntry(RT_ICON, P)
  1008.       else {rtpGroupCursor}
  1009.         Entry := ResFile.FindEntry(RT_CURSOR, P);
  1010.       try
  1011.         Data.LoadResourceItem(I, Entry.GetData, Entry.GetDataSize);
  1012.       finally
  1013.         Entry.Free;
  1014.       end;
  1015.     end;
  1016.     Data.SaveToStream(Stream);
  1017.   finally
  1018.     Data.Free;
  1019.   end;
  1020. end;
  1021.  
  1022. function TResourceEntry.GetBitmap(ResFile: TIResourceFile): TBitmap;
  1023.  
  1024.   function GetDInColors(BitCount: Word): Integer;
  1025.   begin
  1026.     case BitCount of
  1027.       1, 4, 8: Result := 1 shl BitCount;
  1028.       else Result := 0;
  1029.     end;
  1030.   end;
  1031.  
  1032. var
  1033.   Header: PBitmapFileHeader;
  1034.   BI: PBitmapInfoHeader;
  1035.   BC: PBitmapCoreHeader;
  1036.   Entry: TIResourceEntry;
  1037.   Mem: TMemoryStream;
  1038.   ClrUsed: Integer;
  1039. begin
  1040.   Result := nil;
  1041.   if FResType <> rtpBitmap then Exit;
  1042.   Mem := TMemoryStream.Create;
  1043.   try
  1044.     Entry := ResFile.FindEntry(GetResourceType, GetResourceName);
  1045.     try
  1046.       Mem.SetSize(Entry.GetDataSize + SizeOf(TBitmapFileHeader));
  1047.       Move(Entry.GetData^, Pointer(PChar(Mem.Memory) +
  1048.         SizeOf(TBitmapFileHeader))^, Mem.Size);
  1049.       Header := PBitmapFileHeader(Mem.Memory);
  1050.       BI := PBitmapInfoHeader(PChar(Mem.Memory) + SizeOf(TBitmapFileHeader));
  1051.       { fill header }
  1052.       with Header^ do begin
  1053.         if BI^.biSize = SizeOf(TBitmapInfoHeader) then begin
  1054.           ClrUsed := BI^.biClrUsed;
  1055.           if ClrUsed = 0 then ClrUsed := GetDInColors(BI^.biBitCount);
  1056.           bfOffBits :=  ClrUsed * SizeOf(TRGBQuad) +
  1057.             SizeOf(TBitmapInfoHeader) + SizeOf(TBitmapFileHeader);
  1058.         end
  1059.         else begin
  1060.           BC := PBitmapCoreHeader(PChar(Mem.Memory) +
  1061.             SizeOf(TBitmapFileHeader));
  1062.           ClrUsed := GetDInColors(BC^.bcBitCount);
  1063.           bfOffBits :=  ClrUsed * SizeOf(TRGBTriple) +
  1064.             SizeOf(TBitmapCoreHeader) + SizeOf(TBitmapFileHeader);
  1065.         end;
  1066.         bfSize := bfOffBits + BI^.biSizeImage;
  1067.         bfType := $4D42; { BM }
  1068.       end;
  1069.     finally
  1070.       Entry.Free;
  1071.     end;
  1072.     Result := TBitmap.Create;
  1073.     try
  1074.       Result.LoadFromStream(Mem);
  1075.     except
  1076.       Result.Free;
  1077.       raise;
  1078.     end;
  1079.   finally
  1080.     Mem.Free;
  1081.   end;
  1082. end;
  1083.  
  1084. procedure TResourceEntry.GetData(ResFile: TIResourceFile; Stream: TStream);
  1085. var
  1086.   Entry: TIResourceEntry;
  1087. begin
  1088.   Entry := ResFile.FindEntry(GetResourceType, GetResourceName);
  1089.   try
  1090.     Stream.WriteBuffer(Entry.GetData^, Entry.GetDataSize);
  1091.   finally
  1092.     Entry.Free;
  1093.   end;
  1094. end;
  1095.  
  1096. function TResourceEntry.GetGraphic(ResFile: TIResourceFile): TGraphic;
  1097. begin
  1098.   Result := nil;
  1099.   case FResType of
  1100.     rtpBitmap: Result := GetBitmap(ResFile);
  1101.     rtpGroupIcon:
  1102.       begin
  1103.         Result := TIcon.Create;
  1104.         try
  1105.           TIcon(Result).Handle := GetCursorOrIcon(ResFile, True);
  1106.         except
  1107.           Result.Free;
  1108.           raise;
  1109.         end;
  1110.       end;
  1111.   end;
  1112. end;
  1113.  
  1114. function TResourceEntry.Rename(ResFile: TIResourceFile;
  1115.   const NewName: string): Boolean;
  1116. var
  1117.   P: PChar;
  1118.   AName: string;
  1119.   Id: Word;
  1120.   Code: Integer;
  1121.   Entry: TIResourceEntry;
  1122. begin
  1123.   Result := False;
  1124.   Entry := ResFile.FindEntry(GetResourceType, GetResourceName);
  1125.   try
  1126.     Val(NewName, Id, Code);
  1127.     if Code = 0 then P := MakeIntResource(Id)
  1128.     else begin
  1129.       if not IsValidIdent(NewName) then
  1130.         raise Exception.Create(Format(sInvalidName, [NewName]));
  1131.       AName := AnsiUpperCase(NewName);
  1132.       P := PChar(AName);
  1133.     end;
  1134.     Result := Entry.Change(Entry.GetResourceType, P);
  1135.     if Result then begin
  1136.       P := Entry.GetResourceName;
  1137.       if HiWord(Longint(P)) = 0 then FNameId := LoWord(Longint(P));
  1138.       FName := StrText(P);
  1139.     end;
  1140.   finally
  1141.     Entry.Free;
  1142.   end;
  1143. end;
  1144.  
  1145. { TRxProjectResExpert }
  1146.  
  1147. constructor TRxProjectResExpert.Create;
  1148. var
  1149.   MainMenu: TIMainMenuIntf;
  1150.   ProjSrcMenu: TIMenuItemIntf;
  1151.   ViewMenu: TIMenuItemIntf;
  1152.   MenuItems: TIMenuItemIntf;
  1153. begin
  1154.   inherited Create;
  1155.   FResourceList := TStringList.Create;
  1156.   if Assigned(ToolServices) then begin
  1157.     MainMenu := ToolServices.GetMainMenu;
  1158.     if MainMenu <> nil then
  1159.     try
  1160.       MenuItems := MainMenu.GetMenuItems;
  1161.       if MenuItems <> nil then
  1162.       try
  1163.         ProjSrcMenu := MainMenu.FindMenuItem('ViewPrjSourceItem');
  1164.         if ProjSrcMenu <> nil then
  1165.         try
  1166.           ViewMenu := ProjSrcMenu.GetParent;
  1167.           if ViewMenu <> nil then
  1168.           try
  1169.             ProjectResourcesItem := ViewMenu.InsertItem(
  1170.               ProjSrcMenu.GetIndex, GetMenuText, 'ViewPrjResourceItem',
  1171.               '', 0, 0, 0, [mfVisible], ProjectResourcesClick);
  1172.           finally
  1173.             ViewMenu.Free;
  1174.           end;
  1175.         finally
  1176.           ProjSrcMenu.Free;
  1177.         end;
  1178.       finally
  1179.         MenuItems.Free;
  1180.       end;
  1181.     finally
  1182.       MainMenu.Free;
  1183.     end;
  1184.     AddInNotifier := TAddInNotifier.Create(Self);
  1185. {$IFDEF RX_D4}
  1186.     ToolServices.AddNotifierEx(AddInNotifier);
  1187. {$ELSE}
  1188.     ToolServices.AddNotifier(AddInNotifier);
  1189. {$ENDIF}
  1190.   end;
  1191. end;
  1192.  
  1193. destructor TRxProjectResExpert.Destroy;
  1194. begin
  1195.   if RxResourceEditor <> nil then RxResourceEditor.Free;
  1196.   ToolServices.RemoveNotifier(AddInNotifier);
  1197.   CloseProject;
  1198.   ProjectResourcesItem.Free;
  1199.   AddInNotifier.Free;
  1200.   FResourceList.Free;
  1201.   inherited Destroy;
  1202. end;
  1203.  
  1204. function TRxProjectResExpert.GetName: string;
  1205. begin
  1206.   Result := sExpertName;
  1207. end;
  1208.  
  1209. function TRxProjectResExpert.GetAuthor: string;
  1210. begin
  1211.   Result := '';
  1212. end;
  1213.  
  1214. function TRxProjectResExpert.GetComment: string;
  1215. begin
  1216.   Result := '';
  1217. end;
  1218.  
  1219. function TRxProjectResExpert.GetPage: string;
  1220. begin
  1221.   Result := '';
  1222. end;
  1223.  
  1224. function TRxProjectResExpert.GetGlyph: HICON;
  1225. begin
  1226.   Result := 0;
  1227. end;
  1228.  
  1229. function TRxProjectResExpert.GetMenuText: string;
  1230. begin
  1231.   Result := sMenuItemCaption;
  1232. end;
  1233.  
  1234. function TRxProjectResExpert.GetState: TExpertState;
  1235. begin
  1236.   Result := [esEnabled];
  1237. end;
  1238.  
  1239. function TRxProjectResExpert.GetStyle: TExpertStyle;
  1240. begin
  1241.   Result := esAddIn;
  1242. end;
  1243.  
  1244. function TRxProjectResExpert.GetIDString: string;
  1245. begin
  1246.   Result := sExpertID;
  1247. end;
  1248.  
  1249. procedure TRxProjectResExpert.Execute;
  1250. begin
  1251. end;
  1252.  
  1253. procedure TRxProjectResExpert.BeginUpdate;
  1254. begin
  1255.   Inc(FLockCount);
  1256. end;
  1257.  
  1258. procedure TRxProjectResExpert.EndUpdate;
  1259. begin
  1260.   Dec(FLockCount);
  1261.   if FLockCount = 0 then UpdateProjectResInfo;
  1262. end;
  1263.  
  1264. function TRxProjectResExpert.GetResFile: TIResourceFile;
  1265. begin
  1266.   if ProjectModule.IsProjectModule then
  1267.     Result := ProjectModule.GetProjectResource
  1268.   else Result := nil;
  1269. end;
  1270.  
  1271. procedure TRxProjectResExpert.FindChildren(ResFile: TIResourceFile;
  1272.   Entry: TResourceEntry);
  1273. var
  1274.   I, Idx: Integer;
  1275.   Header: PCursorOrIcon;
  1276.   Directory: PDirectory;
  1277.   Data: Pointer;
  1278.   Child: TResourceEntry;
  1279.   ResEntry: TIResourceEntry;
  1280. begin
  1281.   if Entry = nil then Exit;
  1282.   if Entry.FResType in [rtpGroupCursor, rtpGroupIcon] then begin
  1283.     ResEntry := ResFile.GetEntryFromHandle(Entry.FHandle);
  1284.     if ResEntry <> nil then
  1285.     try
  1286.       Data := ResEntry.GetData;
  1287.       if Data <> nil then begin
  1288.         Header := PCursorOrIcon(Data);
  1289.         Directory := PDirectory(PChar(Data) + SizeOf(TCursorOrIcon));
  1290.         for I := 0 to Header^.Count - 1 do begin
  1291.           for Idx := 0 to FResourceList.Count - 1 do begin
  1292.             Child := TResourceEntry(FResourceList.Objects[Idx]);
  1293.             if (Child <> nil) and (Child.FParent = nil) and
  1294.               (((Entry.FResType = rtpGroupIcon) and (Child.FResType = rtpIcon)) or
  1295.               ((Entry.FResType = rtpGroupCursor) and (Child.FResType = rtpCursor)))
  1296.               and (Child.GetName = IntToStr(Directory^[I].NameOrdinal)) then
  1297.             begin
  1298.               Entry.FChildren.Add(Child);
  1299.               Inc(Entry.FSize, Child.FSize);
  1300.               Child.FParent := Entry;
  1301.             end;
  1302.           end;
  1303.         end;
  1304.       end;
  1305.     finally
  1306.       ResEntry.Free;
  1307.     end;
  1308.   end;
  1309. end;
  1310.  
  1311. procedure TRxProjectResExpert.LoadProjectResInfo; //!!!!!
  1312. var
  1313.   I, Cnt: Integer;
  1314.   RootNode, TypeNode: TTreeNode;
  1315.   Entry: TResourceEntry;
  1316.   ResEntry: TIResourceEntry;
  1317.   TypeList: TStringList;
  1318.   ResourceFile: TIResourceFile;
  1319. {$IFDEF RX_V110}
  1320.   EditInt: TIEditorInterface;
  1321.   IsNewProject: Boolean;
  1322. {$ENDIF}
  1323. begin
  1324.   Cnt := -1;
  1325.   try
  1326.     ResourceFile := GetResFile;
  1327.   except
  1328.     ResourceFile := nil;
  1329.   end;
  1330.   try
  1331.     if ResourceFile <> nil then
  1332.       with ResourceFile do begin
  1333.         FResFileName := FileName;
  1334. {$IFDEF RX_V110}
  1335.         EditInt := ProjectModule.GetEditorInterface;
  1336.         try
  1337.           IsNewProject := not FileExists(EditInt.FileName);
  1338.         finally
  1339.           EditInt.Free;
  1340.         end;
  1341.         if IsNewProject or FileExists(FResFileName) then begin
  1342.           try
  1343.             Cnt := GetEntryCount;
  1344.             if not FileExists(FResFileName) and (Cnt = 0) then begin
  1345.               Cnt := -1;
  1346.               FResFileName := '';
  1347.             end;
  1348.           except
  1349.             Cnt := -1;
  1350.             FResFileName := '';
  1351.           end;
  1352.           { Access violation error is occured when specified }
  1353.           { resource file doesn't exist }
  1354.         end
  1355.         else begin
  1356.           Cnt := -1;
  1357.           FResFileName := '';
  1358.         end;
  1359. {$ELSE}
  1360.         Cnt := GetEntryCount;
  1361. {$ENDIF}
  1362.         for I := 0 to Cnt - 1 do begin
  1363.           ResEntry := GetEntry(I);
  1364.           if ResEntry <> nil then begin
  1365.             try
  1366.               Entry := TResourceEntry.Create(ResEntry);
  1367.             finally
  1368.               ResEntry.Free;
  1369.             end;
  1370.             FResourceList.AddObject(Entry.GetName, Entry);
  1371.           end;
  1372.         end;
  1373.         for I := 0 to FResourceList.Count - 1 do begin
  1374.           Entry := TResourceEntry(FResourceList.Objects[I]);
  1375.           FindChildren(ResourceFile, Entry);
  1376.         end;
  1377.       end;
  1378.     if (RxResourceEditor <> nil) and (ResourceFile <> nil) and (Cnt >= 0) then
  1379.     begin
  1380.       with RxResourceEditor do begin
  1381.         StatusBar.Panels[0].Text := FResFileName;
  1382.         ResTree.Items.BeginUpdate;
  1383.         try
  1384.           TypeList := TStringList.Create;
  1385.           try
  1386.             TypeList.Sorted := True;
  1387.             TypeList.Duplicates := dupIgnore;
  1388.             RootNode := ResTree.Items.Add(nil, ExtractFileName(FResFileName));
  1389.             RootNode.ImageIndex := 9; { Delphi Project }
  1390.             RootNode.SelectedIndex := RootNode.ImageIndex;
  1391.             for I := 0 to FResourceList.Count - 1 do begin
  1392.               Entry := TResourceEntry(FResourceList.Objects[I]);
  1393.               if (Entry = nil) or (Entry.FParent <> nil) then
  1394.                 Continue; { ignore cursors and icons, use groups }
  1395.               Cnt := TypeList.IndexOf(Entry.GetTypeName);
  1396.               if Cnt < 0 then begin
  1397.                 TypeNode := ResTree.Items.AddChildObject(RootNode,
  1398.                   Entry.GetTypeName, nil);
  1399.                 TypeNode.ImageIndex := 0; { Collapsed Folder }
  1400.                 TypeNode.SelectedIndex := TypeNode.ImageIndex;
  1401.                 TypeList.AddObject(Entry.GetTypeName, TypeNode);
  1402.               end
  1403.               else
  1404.                 TypeNode := TTreeNode(TypeList.Objects[Cnt]);
  1405.               Entry.FEntryNode := ResTree.Items.AddChildObject(TypeNode,
  1406.                 Entry.GetName, Entry);
  1407.               Entry.FEntryNode.ImageIndex := ResImages[Entry.FResType];
  1408.               Entry.FEntryNode.SelectedIndex := Entry.FEntryNode.ImageIndex;
  1409.             end;
  1410.             RootNode.Expanded := True;
  1411.           finally
  1412.             TypeList.Free;
  1413.           end;
  1414.         finally
  1415.           ResTree.Items.EndUpdate;
  1416.         end;
  1417.       end;
  1418.     end;
  1419.   finally
  1420.     ResourceFile.Free;
  1421.   end;
  1422. end;
  1423.  
  1424. procedure TRxProjectResExpert.ClearProjectResInfo;
  1425. var
  1426.   I: Integer;
  1427. begin
  1428.   FResFileName := '';
  1429.   if RxResourceEditor <> nil then begin
  1430.     RxResourceEditor.ResTree.Items.Clear;
  1431.     RxResourceEditor.StatusBar.Panels[0].Text := '';
  1432.   end;
  1433.   for I := 0 to FResourceList.Count - 1 do
  1434.     TResourceEntry(FResourceList.Objects[I]).Free;
  1435.   FResourceList.Clear;
  1436. end;
  1437.  
  1438. procedure TRxProjectResExpert.UpdateProjectResInfo;
  1439. var
  1440.   TreeState: TStringList;
  1441.   Node, ChildNode: TTreeNode;
  1442.   I: Integer;
  1443. begin
  1444.   if FLockCount > 0 then Exit;
  1445.   if RxResourceEditor <> nil then
  1446.     RxResourceEditor.ResTree.Items.BeginUpdate;
  1447.   try
  1448.     TreeState := TStringList.Create;
  1449.     try
  1450.       if RxResourceEditor <> nil then begin
  1451.         if FSelection.ResType = '' then begin
  1452.           { save selection }
  1453.           Node := RxResourceEditor.ResTree.Selected;
  1454.           if Node <> nil then begin
  1455.             if (Node.Data <> nil) then begin
  1456.               FSelection.ResName := TResourceEntry(Node.Data).GetName;
  1457.               FSelection.ResType := TResourceEntry(Node.Data).GetTypeName;
  1458.             end
  1459.             else begin
  1460.               FSelection.ResName := '';
  1461.               FSelection.ResType := Node.Text;
  1462.             end;
  1463.           end;
  1464.         end;
  1465.         { save tree state }
  1466.         Node := RxResourceEditor.ResTree.Items.GetFirstNode;
  1467.         if Node <> nil then ChildNode := Node.GetFirstChild
  1468.         else ChildNode := nil;
  1469.         while ChildNode <> nil do begin
  1470.           TreeState.AddObject(ChildNode.Text, TObject(ChildNode.Expanded));
  1471.           ChildNode := Node.GetNextChild(ChildNode);
  1472.         end;
  1473.       end;
  1474.       Inc(FLockCount);
  1475.       try
  1476.         ClearProjectResInfo;
  1477.         try
  1478.           LoadProjectResInfo;
  1479.         except
  1480.           ClearProjectResInfo;
  1481.         end;
  1482.       finally
  1483.         Dec(FLockCount);
  1484.       end;
  1485.       if (RxResourceEditor <> nil) then begin
  1486.         { restore tree state }
  1487.         Node := RxResourceEditor.ResTree.Items.GetFirstNode;
  1488.         if Node <> nil then begin
  1489.           ChildNode := Node.GetFirstChild;
  1490.           while ChildNode <> nil do begin
  1491.             I := TreeState.IndexOf(ChildNode.Text);
  1492.             if I >= 0 then
  1493.               ChildNode.Expanded := Boolean(TreeState.Objects[I]);
  1494.             ChildNode := Node.GetNextChild(ChildNode);
  1495.           end;
  1496.         end;
  1497.         if (FSelection.ResName <> '') or (FSelection.ResType <> '') then
  1498.         begin { restore selection }
  1499.           with FSelection do
  1500.             Node := FindNode(RxResourceEditor.ResTree, nil, ResName, ResType);
  1501.           if Node <> nil then begin
  1502.             if Node.Parent <> nil then Node.Parent.Expanded := True;
  1503.             Node.Selected := True;
  1504.           end;
  1505.         end;
  1506.       end;
  1507.     finally
  1508.       TreeState.Free;
  1509.       with FSelection do begin
  1510.         ResName := '';
  1511.         ResType := '';
  1512.       end;
  1513.     end;
  1514.   finally
  1515.     if RxResourceEditor <> nil then
  1516.       RxResourceEditor.ResTree.Items.EndUpdate;
  1517.   end;
  1518. end;
  1519.  
  1520. procedure TRxProjectResExpert.OpenProject(const FileName: string);
  1521. begin
  1522.   CloseProject;
  1523.   ProjectModule := ToolServices.GetModuleInterface(FileName);
  1524.   if ProjectModule <> nil then begin
  1525.     ProjectNotifier := TProjectNotifier.Create(Self);
  1526.     ProjectModule.AddNotifier(ProjectNotifier);
  1527.     try
  1528.       LoadProjectResInfo;
  1529.       FProjectName := FileName;
  1530.     except
  1531.       ClearProjectResInfo;
  1532.     end;
  1533.   end;
  1534. end;
  1535.  
  1536. procedure TRxProjectResExpert.CloseProject;
  1537. begin
  1538.   if ProjectModule <> nil then begin
  1539.     ClearProjectResInfo;
  1540.     ProjectModule.RemoveNotifier(ProjectNotifier);
  1541.     ProjectNotifier.Free;
  1542.     ProjectModule.Free;
  1543.     ProjectNotifier := nil;
  1544.     ProjectModule := nil;
  1545.     FProjectName := '';
  1546.   end;
  1547. end;
  1548.  
  1549. {$IFNDEF RX_D4}
  1550.  
  1551. procedure TRxProjectResExpert.LoadDesktop(const FileName: string);
  1552. var
  1553.   Desktop: TIniFile;
  1554. begin
  1555.   Desktop := TIniFile.Create(FileName);
  1556.   try
  1557.     if DeskTop.ReadBool(sExpertName, sVisible, False) then
  1558.       ProjectResourcesClick(nil)
  1559.     else if RxResourceEditor <> nil then RxResourceEditor.Close;
  1560.   finally
  1561.     Desktop.Free;
  1562.   end;
  1563. end;
  1564.  
  1565. procedure TRxProjectResExpert.SaveDesktop(const FileName: string);
  1566. var
  1567.   Desktop: TIniFile;
  1568.   Visible: Boolean;
  1569. begin
  1570.   Desktop := TIniFile.Create(FileName);
  1571.   try
  1572.     Visible := (RxResourceEditor <> nil) and RxResourceEditor.Visible;
  1573.     DeskTop.WriteBool(sExpertName, sVisible, Visible);
  1574.   finally
  1575.     Desktop.Free;
  1576.   end;
  1577. end;
  1578.  
  1579. {$ENDIF}
  1580.  
  1581. procedure TRxProjectResExpert.ProjectResourcesClick(Sender: TIMenuItemIntf);
  1582. var
  1583.   Reopen: Boolean;
  1584.   ProjectName: string;
  1585.   ResourceFile: TIResourceFile;
  1586. begin
  1587.   ResourceFile := GetResFile;
  1588.   try
  1589.     if Assigned(ResourceFile) then begin
  1590.       Reopen := RxResourceEditor = nil;
  1591.       CreateForm(TRxResourceEditor, RxResourceEditor);
  1592.       RxResourceEditor.FExpert := Self;
  1593.       ProjectName := ToolServices.GetProjectName;
  1594.       if Reopen or (FProjectName <> ProjectName) then begin
  1595.         if ProjectName <> '' then OpenProject(ProjectName);
  1596.       end;
  1597.       RxResourceEditor.Show;
  1598.     end;
  1599.   finally
  1600.     ResourceFile.Free;
  1601.   end;
  1602. end;
  1603.  
  1604. procedure TRxProjectResExpert.MarkModified;
  1605. var
  1606.   EditorInterface: TIEditorInterface;
  1607. begin
  1608.   if ProjectModule <> nil then begin
  1609.     EditorInterface := ProjectModule.GetEditorInterface;
  1610.     try
  1611.       EditorInterface.MarkModified;
  1612.     finally
  1613.       EditorInterface.Free;
  1614.     end;
  1615.   end;
  1616. end;
  1617.  
  1618. procedure TRxProjectResExpert.CheckRename(ResFile: TIResourceFile;
  1619.   ResType, NewName: PChar);
  1620. var
  1621.   Entry: TIResourceEntry;
  1622. begin
  1623.   Entry := ResFile.FindEntry(ResType, NewName);
  1624.   try
  1625.     if Entry <> nil then
  1626.       raise Exception.Create(Format(sCannotRename, [NewName]));
  1627.   finally
  1628.     Entry.Free;
  1629.   end;
  1630. end;
  1631.  
  1632. function TRxProjectResExpert.UniqueName(ResFile: TIResourceFile;
  1633.   ResType: PChar; var Index: Integer): string;
  1634. var
  1635.   N: Integer;
  1636.   Entry: TIResourceEntry;
  1637.  
  1638.   procedure CheckItemName;
  1639.   begin
  1640.     if (ResType = RT_ICON) or (ResType = RT_CURSOR) then begin
  1641.       Result := IntToStr(N);
  1642.       Entry := ResFile.FindEntry(ResType, PChar(N));
  1643.     end
  1644.     else begin
  1645.       Result := Format(ResTypeName(ResType) + '_%d', [N]);
  1646.       Entry := ResFile.FindEntry(ResType, PChar(Result));
  1647.     end;
  1648.   end;
  1649.  
  1650. begin
  1651.   N := 1;
  1652.   Index := 0;
  1653.   CheckItemName;
  1654.   while Entry <> nil do begin
  1655.     Entry.Free;
  1656.     Inc(N);
  1657.     CheckItemName;
  1658.   end;
  1659.   if (ResType = RT_ICON) or (ResType = RT_CURSOR) then Index := N;
  1660. end;
  1661.  
  1662. function TRxProjectResExpert.DeleteEntry(ResFile: TIResourceFile;
  1663.   Entry: TResourceEntry): Boolean;
  1664. var
  1665.   I: Integer;
  1666.   P: Pointer;
  1667.   Child: TResourceEntry;
  1668.   ResourceFile: TIResourceFile;
  1669. begin
  1670.   Result := False;
  1671.   if ResFile = nil then ResourceFile := GetResFile
  1672.   else ResourceFile := ResFile;
  1673.   try
  1674.     if (ResourceFile <> nil) and (Entry <> nil) then begin
  1675.       BeginUpdate;
  1676.       try
  1677.         P := Entry.FHandle;
  1678.         Result := ResourceFile.DeleteEntry(P);
  1679.         if Result then
  1680.         try
  1681.           { delete children }
  1682.           for I := 0 to Entry.FChildren.Count - 1 do begin
  1683.             Child := TResourceEntry(Entry.FChildren[I]);
  1684.             if Child <> nil then
  1685.               ResourceFile.DeleteEntry(Child.FHandle);
  1686.           end;
  1687.         finally
  1688.           MarkModified;
  1689.         end;
  1690.       finally
  1691.         EndUpdate;
  1692.       end;
  1693.     end;
  1694.   finally
  1695.     if ResFile = nil then ResourceFile.Free;
  1696.   end;
  1697. end;
  1698.  
  1699. procedure TRxProjectResExpert.CreateEntry(ResFile: TIResourceFile;
  1700.   ResType, ResName: PChar; ADataSize: Integer; AData: Pointer;
  1701.   SetToEntry: Boolean);
  1702. var
  1703.   I: Integer;
  1704.   S: string;
  1705.   ResourceFile: TIResourceFile;
  1706.   Entry: TIResourceEntry;
  1707. begin
  1708.   BeginUpdate;
  1709.   try
  1710.     if ResFile = nil then ResourceFile := GetResFile
  1711.     else ResourceFile := ResFile;
  1712.     try
  1713.       if ResName = nil then begin
  1714.         S := UniqueName(ResourceFile, ResType, I);
  1715.         if I > 0 then ResName := PChar(I)
  1716.         else ResName := PChar(S);
  1717.       end;
  1718.       if not IsValidIdent(StrText(ResName)) then
  1719.         raise Exception.Create(Format(sInvalidName, [StrText(ResName)]));
  1720.       CheckRename(ResourceFile, ResType, ResName);
  1721. {$IFNDEF RX_D3}
  1722.       if ResourceFile.GetEntryCount > 0 then begin
  1723.         for I := 0 to ResourceFile.GetEntryCount - 1 do
  1724.           ResourceFile.GetEntry(I).Free;
  1725.       end;
  1726. {$ENDIF}
  1727.       Entry := ResourceFile.CreateEntry(ResType, ResName,
  1728.         MOVEABLE or DISCARDABLE, LANG_NEUTRAL, 0, 0, 0);
  1729.       if (Entry = nil) then
  1730.         raise Exception.Create(Format(sCannotRename, [StrText(ResName)]));
  1731.       with Entry do
  1732.       try
  1733.         if SetToEntry then begin
  1734.           FSelection.ResName := StrText(GetResourceName);
  1735.           FSelection.ResType := ResTypeName(GetResourceType);
  1736.         end;
  1737.         SetDataSize(PadUp(ADataSize));
  1738.         FillChar(GetData^, GetDataSize, 0);
  1739.         if GetDataSize < ADataSize then ADataSize := GetDataSize;
  1740.         Move(AData^, GetData^, ADataSize);
  1741.       finally
  1742.         Free;
  1743.       end;
  1744.       MarkModified;
  1745.     finally
  1746.       if ResFile = nil then ResourceFile.Free;
  1747.     end;
  1748.   finally
  1749.     EndUpdate;
  1750.   end;
  1751. end;
  1752.  
  1753. procedure TRxProjectResExpert.NewCursorIconRes(ResFile: TIResourceFile;
  1754.   ResName: PChar; IsIcon: Boolean; Stream: TStream);
  1755. var
  1756.   ResType: PChar;
  1757.   Data: TIconData;
  1758.   ResData: Pointer;
  1759.   I, ResSize, NameOrd: Integer;
  1760.   ResourceFile: TIResourceFile;
  1761.   GroupName: string;
  1762. begin
  1763.   Data := TIconData.Create;
  1764.   try
  1765.     Data.LoadFromStream(Stream);
  1766.     if IsIcon then Data.FHeader.wType := rc3_Icon
  1767.     else Data.FHeader.wType := rc3_Cursor;
  1768.     if Data.GetCount > 0 then begin
  1769.       BeginUpdate;
  1770.       try
  1771.         if ResFile = nil then ResourceFile := GetResFile
  1772.         else ResourceFile := ResFile;
  1773.         try
  1774.           if IsIcon then ResType := RT_ICON
  1775.           else ResType := RT_CURSOR;
  1776.           for I := 0 to Data.GetCount - 1 do begin
  1777.             ResData := Data.BuildResourceItem(I, ResSize);
  1778.             try
  1779.               UniqueName(ResourceFile, ResType, NameOrd);
  1780.               CreateEntry(ResourceFile, ResType, PChar(NameOrd), ResSize,
  1781.                 ResData, False);
  1782.               Data.SetNameOrdinal(I, NameOrd);
  1783.             finally
  1784.               FreeMem(ResData);
  1785.             end;
  1786.           end;
  1787.           if IsIcon then ResType := RT_GROUP_ICON
  1788.           else ResType := RT_GROUP_CURSOR;
  1789.           if ResName = nil then begin
  1790.             GroupName := UniqueName(ResourceFile, ResType, NameOrd);
  1791.             ResName := PChar(GroupName);
  1792.           end;
  1793.           ResData := Data.BuildResourceGroup(ResSize);
  1794.           try
  1795.             CreateEntry(ResourceFile, ResType, ResName, ResSize,
  1796.               ResData, True);
  1797.           finally
  1798.             FreeMem(ResData);
  1799.           end;
  1800.         finally
  1801.           if ResFile = nil then ResourceFile.Free;
  1802.         end;
  1803.       finally
  1804.         EndUpdate;
  1805.       end;
  1806.     end;
  1807.   finally
  1808.     Data.Free;
  1809.   end;
  1810. end;
  1811.  
  1812. procedure TRxProjectResExpert.EditCursorIconRes(Entry: TResourceEntry;
  1813.   IsIcon: Boolean; Stream: TStream);
  1814. var
  1815.   ResFile: TIResourceFile;
  1816.   CI: TCursorOrIcon;
  1817. begin
  1818.   BeginUpdate;
  1819.   try
  1820.     ResFile := GetResFile;
  1821.     try
  1822.       if not Entry.EnableRenameDelete { 'MAINICON' } then begin
  1823.         Stream.ReadBuffer(CI, SizeOf(CI));
  1824.         Stream.Seek(-SizeOf(CI), soFromCurrent);
  1825.         if (CI.Count < 1) or not (CI.wType in [rc3_Icon, rc3_Cursor]) then
  1826.           InvalidIcon;
  1827.       end;
  1828.       DeleteEntry(ResFile, Entry);
  1829.       NewCursorIconRes(ResFile, Entry.GetResourceName, IsIcon, Stream);
  1830.     finally
  1831.       ResFile.Free;
  1832.     end;
  1833.   finally
  1834.     EndUpdate;
  1835.   end;
  1836. end;
  1837.  
  1838. procedure TRxProjectResExpert.NewBitmapRes(ResFile: TIResourceFile;
  1839.   ResName: PChar; Bitmap: TBitmap);
  1840. var
  1841.   Mem: TMemoryStream;
  1842. begin
  1843.   Mem := TMemoryStream.Create;
  1844.   try
  1845.     Bitmap.SaveToStream(Mem);
  1846.     Mem.Position := 0;
  1847.     CreateEntry(ResFile, RT_BITMAP, ResName, Mem.Size - SizeOf(TBitmapFileHeader),
  1848.       Pointer(PChar(Mem.Memory) + SizeOf(TBitmapFileHeader)), True);
  1849.   finally
  1850.     Mem.Free;
  1851.   end;
  1852. end;
  1853.  
  1854. procedure TRxProjectResExpert.EditBitmapRes(Entry: TResourceEntry;
  1855.   Bitmap: TBitmap);
  1856. var
  1857.   ResFile: TIResourceFile;
  1858. begin
  1859.   BeginUpdate;
  1860.   try
  1861.     ResFile := GetResFile;
  1862.     try
  1863.       DeleteEntry(ResFile, Entry);
  1864.       NewBitmapRes(ResFile, Entry.GetResourceName, Bitmap);
  1865.     finally
  1866.       ResFile.Free;
  1867.     end;
  1868.   finally
  1869.     EndUpdate;
  1870.   end;
  1871. end;
  1872.  
  1873. procedure TRxProjectResExpert.NewBinaryRes(ResFile: TIResourceFile;
  1874.   ResName, ResType: PChar; Stream: TMemoryStream);
  1875. begin
  1876.   Stream.Position := 0;
  1877.   CreateEntry(ResFile, ResType, ResName, Stream.Size, Stream.Memory, True);
  1878. end;
  1879.  
  1880. procedure TRxProjectResExpert.EditBinaryRes(Entry: TResourceEntry;
  1881.   Stream: TMemoryStream);
  1882. var
  1883.   ResFile: TIResourceFile;
  1884. begin
  1885.   BeginUpdate;
  1886.   try
  1887.     ResFile := GetResFile;
  1888.     try
  1889.       DeleteEntry(ResFile, Entry);
  1890.       NewBinaryRes(ResFile, Entry.GetResourceName, Entry.GetResourceType,
  1891.         Stream);
  1892.     finally
  1893.       ResFile.Free;
  1894.     end;
  1895.   finally
  1896.     EndUpdate;
  1897.   end;
  1898. end;
  1899.  
  1900. { TRxResourceEditor }
  1901.  
  1902. procedure TRxResourceEditor.FormCreate(Sender: TObject);
  1903. {$IFDEF RX_D4}
  1904. var
  1905.   I: Integer;
  1906. {$ENDIF}
  1907. begin
  1908.   TreeImages.ResourceLoad(rtBitmap, 'RXRESEXPIMG', clFuchsia);
  1909. {$IFDEF RX_D3}
  1910.   ResTree.RightClickSelect := True;
  1911. {$ENDIF}
  1912. {$IFDEF RX_D4}
  1913.   PopupMenu.Images := TreeImages;
  1914.   for I := 0 to PopupMenu.Items.Count - 1 do
  1915.     if PopupMenu.Items[I].Tag > 0 then
  1916.       PopupMenu.Items[I].ImageIndex := PopupMenu.Items[I].Tag;
  1917.   for I := 0 to NewItem.Count - 1 do
  1918.     if NewItem.Items[I].Tag > 0 then
  1919.       NewItem.Items[I].ImageIndex := NewItem.Items[I].Tag;
  1920. {$ENDIF RX_D4}
  1921.   with Placement do begin
  1922.     IniFileName := ToolServices.GetBaseRegistryKey;
  1923.     IniSection := sExpertID;
  1924.   end;
  1925. end;
  1926.  
  1927. procedure TRxResourceEditor.FormDestroy(Sender: TObject);
  1928. begin
  1929.   RxResourceEditor := nil;
  1930. end;
  1931.  
  1932. procedure TRxResourceEditor.ResTreeExpanded(Sender: TObject;
  1933.   Node: TTreeNode);
  1934. begin
  1935.   if Node.ImageIndex = 0 then begin
  1936.     Node.ImageIndex := 1;
  1937.     Node.SelectedIndex := Node.ImageIndex;
  1938.   end;
  1939. end;
  1940.  
  1941. procedure TRxResourceEditor.ResTreeCollapsed(Sender: TObject;
  1942.   Node: TTreeNode);
  1943. begin
  1944.   if Node.ImageIndex = 1 then begin
  1945.     Node.ImageIndex := 0;
  1946.     Node.SelectedIndex := Node.ImageIndex;
  1947.   end;
  1948. end;
  1949.  
  1950. procedure TRxResourceEditor.ResTreeEditing(Sender: TObject;
  1951.   Node: TTreeNode; var AllowEdit: Boolean);
  1952. var
  1953.   Entry: TResourceEntry;
  1954. begin
  1955.   if (Node.Data = nil) then AllowEdit := False
  1956.   else begin
  1957.     Entry := TResourceEntry(Node.Data);
  1958.     AllowEdit := Entry.EnableRenameDelete;
  1959.   end;
  1960. end;
  1961.  
  1962. procedure TRxResourceEditor.ResTreeEdited(Sender: TObject; Node: TTreeNode;
  1963.   var S: string);
  1964. var
  1965.   Entry: TResourceEntry;
  1966.   RF: TIResourceFile;
  1967. begin
  1968.   if (Node.Data <> nil) then begin
  1969.     Entry := TResourceEntry(Node.Data);
  1970.     Inc(FExpert.FLockCount);
  1971.     try
  1972.       RF := FExpert.GetResFile;
  1973.       try
  1974.         S := AnsiUpperCase(S);
  1975.         FExpert.CheckRename(RF, Entry.GetResourceType, ResIdent(S));
  1976.         if Entry.Rename(RF, S) then begin
  1977.           Node.Text := Entry.GetName;
  1978.           FExpert.MarkModified;
  1979.         end
  1980.         else Beep;
  1981.       finally
  1982.         RF.Free;
  1983.       end;
  1984.     finally
  1985.       Dec(FExpert.FLockCount);
  1986.       S := Node.Text;
  1987.     end;
  1988.   end;
  1989. end;
  1990.  
  1991. procedure TRxResourceEditor.PopupMenuPopup(Sender: TObject);
  1992. var
  1993.   Node: TTreeNode;
  1994.   Entry: TResourceEntry;
  1995. begin
  1996.   Node := ResTree.Selected;
  1997.   if (Node <> nil) and (Node.Data <> nil) then begin
  1998.     Entry := TResourceEntry(Node.Data);
  1999.     EditItem.Enabled := Entry.EnableEdit;
  2000.     RenameItem.Enabled := Entry.EnableRenameDelete;
  2001.     DeleteItem.Enabled := RenameItem.Enabled;
  2002.     PreviewItem.Enabled := Entry.FResType in [rtpBitmap, rtpGroupIcon,
  2003.       rtpGroupCursor];
  2004.     SaveItem.Enabled := Entry.FResType in [rtpGroupCursor, rtpGroupIcon,
  2005.       rtpBitmap, rtpAniCursor, rtpRCData, rtpCustom];
  2006.     ResTree.Selected := Node;
  2007.   end
  2008.   else begin
  2009.     EditItem.Enabled := False;
  2010.     RenameItem.Enabled := False;
  2011.     DeleteItem.Enabled := False;
  2012.     PreviewItem.Enabled := False;
  2013.     SaveItem.Enabled := False;
  2014.   end;
  2015. end;
  2016.  
  2017. procedure TRxResourceEditor.RenameItemClick(Sender: TObject);
  2018. var
  2019.   Node: TTreeNode;
  2020. begin
  2021.   Node := ResTree.Selected;
  2022.   if Node <> nil then Node.EditText;
  2023. end;
  2024.  
  2025. procedure TRxResourceEditor.EditItemClick(Sender: TObject);
  2026. var
  2027.   Node: TTreeNode;
  2028.   ResFile: TIResourceFile;
  2029.   Entry: TResourceEntry;
  2030.   Graphic: TGraphic;
  2031.   Stream: TStream;
  2032. begin
  2033.   Node := ResTree.Selected;
  2034.   if Node <> nil then begin
  2035.     Entry := TResourceEntry(Node.Data);
  2036.     if (Entry <> nil) and Entry.EnableEdit then begin
  2037.       case Entry.FResType of
  2038.         rtpGroupCursor,
  2039.         rtpGroupIcon:
  2040.           begin
  2041.             if Entry.FResType = rtpGroupCursor then
  2042.               OpenDlg.Filter := sCursorFilesFilter
  2043.             else
  2044.               OpenDlg.Filter := sIconFilesFilter + '|' + sCursorFilesFilter;
  2045.             OpenDlg.FileName := '';
  2046.             if OpenDlg.Execute then begin
  2047.               Stream := TFileStream.Create(OpenDlg.FileName, fmOpenRead +
  2048.                 fmShareDenyNone);
  2049.               try
  2050.                 FExpert.EditCursorIconRes(Entry, Entry.FResType =
  2051.                   rtpGroupIcon, Stream);
  2052.               finally
  2053.                 Stream.Free;
  2054.               end;
  2055.             end;
  2056.           end;
  2057.         rtpBitmap:
  2058.           begin
  2059.             ResFile := FExpert.GetResFile;
  2060.             try
  2061.               Graphic := Entry.GetGraphic(ResFile);
  2062.             finally
  2063.               ResFile.Free;
  2064.             end;
  2065.             try
  2066.               if EditGraphic(Graphic, nil, Entry.GetName) then begin
  2067.                 if not Graphic.Empty then
  2068.                   FExpert.EditBitmapRes(Entry, TBitmap(Graphic))
  2069.                 else if Entry.EnableRenameDelete then
  2070.                   FExpert.DeleteEntry(nil, Entry);
  2071.               end;
  2072.             finally
  2073.               Graphic.Free;
  2074.             end;
  2075.           end;
  2076.         rtpAniCursor,
  2077.         rtpRCData,
  2078.         rtpCustom:
  2079.           begin
  2080.             if Entry.FResType = rtpAniCursor then
  2081.               OpenDlg.Filter := sAniCursorFilesFilter
  2082.             else
  2083.               OpenDlg.Filter := sAllFilesFilter;
  2084.             OpenDlg.FileName := '';
  2085.             if OpenDlg.Execute then begin
  2086.               Stream := TMemoryStream.Create;
  2087.               try
  2088.                 TMemoryStream(Stream).LoadFromFile(OpenDlg.FileName);
  2089.                 FExpert.EditBinaryRes(Entry, TMemoryStream(Stream));
  2090.               finally
  2091.                 Stream.Free;
  2092.               end;
  2093.             end;
  2094.           end;
  2095.         else Exit;
  2096.       end;
  2097.     end;
  2098.   end;
  2099. end;
  2100.  
  2101. procedure TRxResourceEditor.DeleteItemClick(Sender: TObject);
  2102. var
  2103.   Node: TTreeNode;
  2104.   Entry: TResourceEntry;
  2105. begin
  2106.   Node := ResTree.Selected;
  2107.   if Node <> nil then begin
  2108.     Entry := TResourceEntry(Node.Data);
  2109.     if (Entry <> nil) and Entry.EnableRenameDelete then
  2110.       FExpert.DeleteEntry(nil, Entry);
  2111.   end;
  2112. end;
  2113.  
  2114. procedure TRxResourceEditor.NewBitmapItemClick(Sender: TObject);
  2115. var
  2116.   Bitmap: TBitmap;
  2117. begin
  2118.   Bitmap := TBitmap.Create;
  2119.   try
  2120.     if EditGraphic(Bitmap, TBitmap, sNewBitmap) then begin
  2121.       if not Bitmap.Empty then
  2122.         FExpert.NewBitmapRes(nil, nil, Bitmap);
  2123.     end;
  2124.   finally
  2125.     Bitmap.Free;
  2126.   end;
  2127. end;
  2128.  
  2129. procedure TRxResourceEditor.NewIconItemClick(Sender: TObject);
  2130. var
  2131.   Stream: TStream;
  2132. begin
  2133.   OpenDlg.Filter := sIconFilesFilter + '|' + sCursorFilesFilter;
  2134.   OpenDlg.FileName := '';
  2135.   if OpenDlg.Execute then begin
  2136.     Stream := TFileStream.Create(OpenDlg.FileName, fmOpenRead +
  2137.       fmShareDenyNone);
  2138.     try
  2139.       FExpert.NewCursorIconRes(nil, nil, True, Stream);
  2140.     finally
  2141.       Stream.Free;
  2142.     end;
  2143.   end;
  2144. end;
  2145.  
  2146. procedure TRxResourceEditor.NewCursorItemClick(Sender: TObject);
  2147. var
  2148.   Stream: TStream;
  2149. begin
  2150.   OpenDlg.Filter := sCursorFilesFilter + '|' + sAniCursorFilesFilter;
  2151.   OpenDlg.FileName := '';
  2152.   if OpenDlg.Execute then begin
  2153.     if AnsiCompareText(ExtractFileExt(OpenDlg.FileName), '.ani') = 0 then begin
  2154.       Stream := TMemoryStream.Create;
  2155.       try
  2156.         TMemoryStream(Stream).LoadFromFile(OpenDlg.FileName);
  2157.         FExpert.NewBinaryRes(nil, nil, RT_ANICURSOR, TMemoryStream(Stream));
  2158.       finally
  2159.         Stream.Free;
  2160.       end;
  2161.     end
  2162.     else begin
  2163.       Stream := TFileStream.Create(OpenDlg.FileName, fmOpenRead +
  2164.         fmShareDenyNone);
  2165.       try
  2166.         FExpert.NewCursorIconRes(nil, nil, False, Stream);
  2167.       finally
  2168.         Stream.Free;
  2169.       end;
  2170.     end;
  2171.   end;
  2172. end;
  2173.  
  2174. procedure TRxResourceEditor.CheckResourceType(Sender: TObject;
  2175.   var TypeName: string; var Apply: Boolean);
  2176. begin
  2177.   TypeName := AnsiUpperCase(TypeName);
  2178.   Apply := IsValidResType(TypeName) or (TypeName = ResTypeName(RT_RCDATA));
  2179.   if not Apply then
  2180.     raise Exception.Create(Format(sInvalidType, [TypeName]));
  2181. end;
  2182.  
  2183. function TRxResourceEditor.GetResourceTypeName: string;
  2184. var
  2185.   I: Integer;
  2186.   Entry: TResourceEntry;
  2187. begin
  2188.   Result := ResTypeName(RT_RCDATA);
  2189.   with TInputBox.Create(Application) do
  2190.   try
  2191.     Value := Result;
  2192.     Caption := SNewResource;
  2193.     Prompt := sResType;
  2194.     OnApply := CheckResourceType;
  2195.     with FExpert do
  2196.       for I := 0 to FResourceList.Count - 1 do begin
  2197.         Entry := TResourceEntry(FResourceList.Objects[I]);
  2198.         if (Entry <> nil) and (Entry.FResType in [rtpCustom, rtpRCData]) then
  2199.           if Strings.IndexOf(ResTypeName(Entry.GetResourceType)) < 0 then
  2200.             Strings.Add(ResTypeName(Entry.GetResourceType));
  2201.       end;
  2202.     if Execute then Result := Value
  2203.     else Result := '';
  2204.   finally
  2205.     Free;
  2206.   end;
  2207. end;
  2208.  
  2209. procedure TRxResourceEditor.NewUserDataItemClick(Sender: TObject);
  2210. var
  2211.   Mem: TMemoryStream;
  2212.   TypeName: string;
  2213.   Code: Integer;
  2214.   Id: Word;
  2215.   P: PChar;
  2216. begin
  2217.   TypeName := AnsiUpperCase(GetResourceTypeName);
  2218.   if TypeName = '' then Exit;
  2219.   Val(TypeName, Id, Code);
  2220.   if TypeName = ResTypeName(RT_RCDATA) then P := RT_RCDATA
  2221.   else if Code = 0 then P := MakeIntResource(Id)
  2222.   else P := PChar(TypeName);
  2223.   OpenDlg.Filter := sAllFilesFilter;
  2224.   OpenDlg.FileName := '';
  2225.   if OpenDlg.Execute then begin
  2226.     Mem := TMemoryStream.Create;
  2227.     try
  2228.       Mem.LoadFromFile(OpenDlg.FileName);
  2229.       FExpert.NewBinaryRes(nil, nil, P, Mem);
  2230.     finally
  2231.       Mem.Free;
  2232.     end;
  2233.   end;
  2234. end;
  2235.  
  2236. procedure TRxResourceEditor.PreviewItemClick(Sender: TObject);
  2237. begin
  2238.   { not implemented yet, item is invisible }
  2239. end;
  2240.  
  2241. procedure TRxResourceEditor.SaveItemClick(Sender: TObject);
  2242. var
  2243.   Node: TTreeNode;
  2244.   ResFile: TIResourceFile;
  2245.   Entry: TResourceEntry;
  2246.   Graphic: TGraphic;
  2247.   Stream: TStream;
  2248. begin
  2249.   { save resource }
  2250.   Node := ResTree.Selected;
  2251.   if Node <> nil then begin
  2252.     Entry := TResourceEntry(Node.Data);
  2253.     if (Entry <> nil) then begin
  2254.       with SaveDlg do begin
  2255.         case Entry.FResType of
  2256.           rtpGroupCursor:
  2257.             begin
  2258.               Filter := sCursorFilesFilter + '|' + sAllFilesFilter;
  2259.               DefaultExt := 'cur';
  2260.             end;
  2261.           rtpGroupIcon:
  2262.             begin
  2263.               Filter := sIconFilesFilter + '|' + sAllFilesFilter;
  2264.               DefaultExt := GraphicExtension(TIcon);
  2265.             end;
  2266.           rtpBitmap:
  2267.             begin
  2268.               Filter := GraphicFilter(TBitmap) + '|' + sAllFilesFilter;
  2269.               DefaultExt := GraphicExtension(TBitmap);
  2270.             end;
  2271.           rtpAniCursor:
  2272.             begin
  2273.               Filter := sAniCursorFilesFilter + '|' + sAllFilesFilter;
  2274.               DefaultExt := 'ani';
  2275.             end;
  2276.           else
  2277.             begin
  2278.               Filter := sAllFilesFilter;
  2279.               DefaultExt := '';
  2280.             end;
  2281.         end;
  2282.         FileName := '';
  2283.       end;
  2284.       if SaveDlg.Execute then begin
  2285.         ResFile := FExpert.GetResFile;
  2286.         try
  2287.           case Entry.FResType of
  2288.             rtpBitmap:
  2289.               begin
  2290.                 Graphic := Entry.GetGraphic(ResFile);
  2291.                 try
  2292.                   Graphic.SaveToFile(SaveDlg.FileName);
  2293.                 finally
  2294.                   Graphic.Free;
  2295.                 end;
  2296.               end;
  2297.             rtpGroupCursor, rtpGroupIcon,
  2298.             rtpAniCursor, rtpRCData, rtpCustom:
  2299.               begin
  2300.                 Stream := TFileStream.Create(SaveDlg.FileName, fmCreate);
  2301.                 try
  2302.                   if Entry.FResType in [rtpGroupCursor, rtpGroupIcon] then
  2303.                     Entry.GetIconData(ResFile, Stream)
  2304.                   else Entry.GetData(ResFile, Stream);
  2305.                 finally
  2306.                   Stream.Free;
  2307.                 end;
  2308.               end;
  2309.             else Exit;
  2310.           end;
  2311.         finally
  2312.           ResFile.Free;
  2313.         end;
  2314.       end;
  2315.     end;
  2316.   end;
  2317. end;
  2318.  
  2319. procedure TRxResourceEditor.ResTreeKeyPress(Sender: TObject;
  2320.   var Key: Char);
  2321. begin
  2322.   if (Key = Char(VK_RETURN)) then begin
  2323.     EditItemClick(Sender);
  2324.     Key := #0;
  2325.   end;
  2326. end;
  2327.  
  2328. procedure TRxResourceEditor.ResTreeDblClick(Sender: TObject);
  2329. begin
  2330.   EditItemClick(Sender);
  2331. end;
  2332.  
  2333. procedure TRxResourceEditor.ResTreeChange(Sender: TObject;
  2334.   Node: TTreeNode);
  2335. var
  2336.   Entry: TResourceEntry;
  2337.   S: string;
  2338. begin
  2339.   S := '';
  2340.   if Node <> nil then begin
  2341.     Entry := TResourceEntry(Node.Data);
  2342.     if Entry <> nil then begin
  2343.       if Entry.FResType in [rtpGroupCursor, rtpGroupIcon] then
  2344.         S := Format('%d image(s)  ', [Entry.FChildren.Count]);
  2345.       S := S + Format('%d byte(s)', [Entry.FSize]);
  2346.     end;
  2347.   end;
  2348.   if S = '' then S := FExpert.FResFileName;
  2349.   StatusBar.Panels[0].Text := S;
  2350. end;
  2351.  
  2352. procedure TRxResourceEditor.StatusBarDrawPanel(StatusBar: TStatusBar;
  2353.   Panel: TStatusPanel; const Rect: TRect);
  2354. var
  2355.   Offset: Integer;
  2356. begin
  2357.   with StatusBar do begin
  2358.     Offset := Max(0, (HeightOf(Rect) - Canvas.TextHeight('Wg')) div 2);
  2359.     WriteText(Canvas, Rect, Offset, Offset, MinimizeText(Panels[0].Text,
  2360.       Canvas, WidthOf(Rect) - Height), taLeftJustify, False);
  2361.   end;
  2362. end;
  2363.  
  2364. initialization
  2365.   RxResourceEditor := nil;
  2366. end.