Rxresexp.pas
上传用户:hylc_2004
上传日期:2014-01-23
资源大小:46800k
文件大小:66k
源码类别:

Delphi控件源码

开发平台:

Delphi

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