rxresexp.pas

rx library V2.7.7a component use in delphi7 to delphi 2006

  Entry := ResFile.FindEntry(ResType, NewName);
  try
    if Entry <> nil then
      raise Exception.Create(Format(sCannotRename, [NewName]));
  finally
    Entry.Free;
  end;
end;

function TRxProjectResExpert.UniqueName(ResFile: TIResourceFile;
  ResType: PChar; var Index: Integer): string;
var
  N: Integer;
  Entry: TIResourceEntry;

  procedure CheckItemName;
  begin
    if (ResType = RT_ICON) or (ResType = RT_CURSOR) then begin
      Result := IntToStr(N);
      Entry := ResFile.FindEntry(ResType, PChar(N));
    end
    else begin
      Result := Format(ResTypeName(ResType) + '_%d', [N]);
      Entry := ResFile.FindEntry(ResType, PChar(Result));
    end;
  end;

begin
  N := 1;
  Index := 0;
  CheckItemName;
  while Entry <> nil do begin
    Entry.Free;
    Inc(N);
    CheckItemName;
  end;
  if (ResType = RT_ICON) or (ResType = RT_CURSOR) then Index := N;
end;

function TRxProjectResExpert.DeleteEntry(ResFile: TIResourceFile;
  Entry: TResourceEntry): Boolean;
var
  I: Integer;
  P: Pointer;
  Child: TResourceEntry;
  ResourceFile: TIResourceFile;
begin
  Result := False;
  if ResFile = nil then ResourceFile := GetResFile
  else ResourceFile := ResFile;
  try
    if (ResourceFile <> nil) and (Entry <> nil) then begin
      BeginUpdate;
      try
        P := Entry.FHandle;
        Result := ResourceFile.DeleteEntry(P);
        if Result then
        try
          { delete children }
          for I := 0 to Entry.FChildren.Count - 1 do begin
            Child := TResourceEntry(Entry.FChildren[I]);
            if Child <> nil then
              ResourceFile.DeleteEntry(Child.FHandle);
          end;
        finally
          MarkModified;
        end;
      finally
        EndUpdate;
      end;
    end;
  finally
    if ResFile = nil then ResourceFile.Free;
  end;
end;

procedure TRxProjectResExpert.CreateEntry(ResFile: TIResourceFile;
  ResType, ResName: PChar; ADataSize: Integer; AData: Pointer;
  SetToEntry: Boolean);
var
  I: Integer;
  S: string;
  ResourceFile: TIResourceFile;
  Entry: TIResourceEntry;
begin
  BeginUpdate;
  try
    if ResFile = nil then ResourceFile := GetResFile
    else ResourceFile := ResFile;
    try
      if ResName = nil then begin
        S := UniqueName(ResourceFile, ResType, I);
        if I > 0 then ResName := PChar(I)
        else ResName := PChar(S);
      end;
      if not IsValidIdent(StrText(ResName)) then
        raise Exception.Create(Format(sInvalidName, [StrText(ResName)]));
      CheckRename(ResourceFile, ResType, ResName);
{$IFNDEF RX_D3}
      if ResourceFile.GetEntryCount > 0 then begin
        for I := 0 to ResourceFile.GetEntryCount - 1 do
          ResourceFile.GetEntry(I).Free;
      end;
{$ENDIF}
      Entry := ResourceFile.CreateEntry(ResType, ResName,
        MOVEABLE or DISCARDABLE, LANG_NEUTRAL, 0, 0, 0);
      if (Entry = nil) then
        raise Exception.Create(Format(sCannotRename, [StrText(ResName)]));
      with Entry do
      try
        if SetToEntry then begin
          FSelection.ResName := StrText(GetResourceName);
          FSelection.ResType := ResTypeName(GetResourceType);
        end;
        SetDataSize(PadUp(ADataSize));
        FillChar(GetData^, GetDataSize, 0);
        if GetDataSize < ADataSize then ADataSize := GetDataSize;
        Move(AData^, GetData^, ADataSize);
      finally
        Free;
      end;
      MarkModified;
    finally
      if ResFile = nil then ResourceFile.Free;
    end;
  finally
    EndUpdate;
  end;
end;

procedure TRxProjectResExpert.NewCursorIconRes(ResFile: TIResourceFile;
  ResName: PChar; IsIcon: Boolean; Stream: TStream);
var
  ResType: PChar;
  Data: TIconData;
  ResData: Pointer;
  I, ResSize, NameOrd: Integer;
  ResourceFile: TIResourceFile;
  GroupName: string;
begin
  Data := TIconData.Create;
  try
    Data.LoadFromStream(Stream);
    if IsIcon then Data.FHeader.wType := rc3_Icon
    else Data.FHeader.wType := rc3_Cursor;
    if Data.GetCount > 0 then begin
      BeginUpdate;
      try
        if ResFile = nil then ResourceFile := GetResFile
        else ResourceFile := ResFile;
        try
          if IsIcon then ResType := RT_ICON
          else ResType := RT_CURSOR;
          for I := 0 to Data.GetCount - 1 do begin
            ResData := Data.BuildResourceItem(I, ResSize);
            try
              UniqueName(ResourceFile, ResType, NameOrd);
              CreateEntry(ResourceFile, ResType, PChar(NameOrd), ResSize,
                ResData, False);
              Data.SetNameOrdinal(I, NameOrd);
            finally
              FreeMem(ResData);
            end;
          end;
          if IsIcon then ResType := RT_GROUP_ICON
          else ResType := RT_GROUP_CURSOR;
          if ResName = nil then begin
            GroupName := UniqueName(ResourceFile, ResType, NameOrd);
            ResName := PChar(GroupName);
          end;
          ResData := Data.BuildResourceGroup(ResSize);
          try
            CreateEntry(ResourceFile, ResType, ResName, ResSize,
              ResData, True);
          finally
            FreeMem(ResData);
          end;
        finally
          if ResFile = nil then ResourceFile.Free;
        end;
      finally
        EndUpdate;
      end;
    end;
  finally
    Data.Free;
  end;
end;

procedure TRxProjectResExpert.EditCursorIconRes(Entry: TResourceEntry;
  IsIcon: Boolean; Stream: TStream);
var
  ResFile: TIResourceFile;
  CI: TCursorOrIcon;
begin
  BeginUpdate;
  try
    ResFile := GetResFile;
    try
      if not Entry.EnableRenameDelete { 'MAINICON' } then begin
        Stream.ReadBuffer(CI, SizeOf(CI));
        Stream.Seek(-SizeOf(CI), soFromCurrent);
        if (CI.Count < 1) or not (CI.wType in [rc3_Icon, rc3_Cursor]) then
          InvalidIcon;
      end;
      DeleteEntry(ResFile, Entry);
      NewCursorIconRes(ResFile, Entry.GetResourceName, IsIcon, Stream);
    finally
      ResFile.Free;
    end;
  finally
    EndUpdate;
  end;
end;

procedure TRxProjectResExpert.NewBitmapRes(ResFile: TIResourceFile;
  ResName: PChar; Bitmap: TBitmap);
var
  Mem: TMemoryStream;
begin
  Mem := TMemoryStream.Create;
  try
    Bitmap.SaveToStream(Mem);
    Mem.Position := 0;
    CreateEntry(ResFile, RT_BITMAP, ResName, Mem.Size - SizeOf(TBitmapFileHeader),
      Pointer(PChar(Mem.Memory) + SizeOf(TBitmapFileHeader)), True);
  finally
    Mem.Free;
  end;
end;

procedure TRxProjectResExpert.EditBitmapRes(Entry: TResourceEntry;
  Bitmap: TBitmap);
var
  ResFile: TIResourceFile;
begin
  BeginUpdate;
  try
    ResFile := GetResFile;
    try
      DeleteEntry(ResFile, Entry);
      NewBitmapRes(ResFile, Entry.GetResourceName, Bitmap);
    finally
      ResFile.Free;
    end;
  finally
    EndUpdate;
  end;
end;

procedure TRxProjectResExpert.NewBinaryRes(ResFile: TIResourceFile;
  ResName, ResType: PChar; Stream: TMemoryStream);
begin
  Stream.Position := 0;
  CreateEntry(ResFile, ResType, ResName, Stream.Size, Stream.Memory, True);
end;

procedure TRxProjectResExpert.EditBinaryRes(Entry: TResourceEntry;
  Stream: TMemoryStream);
var
  ResFile: TIResourceFile;
begin
  BeginUpdate;
  try
    ResFile := GetResFile;
    try
      DeleteEntry(ResFile, Entry);
      NewBinaryRes(ResFile, Entry.GetResourceName, Entry.GetResourceType,
        Stream);
    finally
      ResFile.Free;
    end;
  finally
    EndUpdate;
  end;
end;

{ TRxResourceEditor }

{$ifdef use_toolsapi}
function GetBaseRegistryKey: string;
var
  OTAServices: IOTAServices50;
begin
  if Supports(BorlandIDEServices, IOTAServices50, OTAServices) then
    Result := OTAServices.GetBaseRegistryKey
  else
    Result := 'GetBaseRegistryKeyFailed';
end;
{$else}
function GetBaseRegistryKey: string;
begin
  if Assigned(ToolServices) then
    Result := ToolServices.GetBaseRegistryKey
  else
    Result := 'GetBaseRegistryKeyFailed';
end;
{$endif}

procedure TRxResourceEditor.FormCreate(Sender: TObject);
{$IFDEF RX_D4}
var
  I: Integer;
{$ENDIF}
begin
  TreeImages.ResourceLoad(rtBitmap, 'RXRESEXPIMG', clFuchsia);
{$IFDEF RX_D3}
  ResTree.RightClickSelect := True;
{$ENDIF}
{$IFDEF RX_D4}
  PopupMenu.Images := TreeImages;
  for I := 0 to PopupMenu.Items.Count - 1 do
    if PopupMenu.Items[I].Tag > 0 then
      PopupMenu.Items[I].ImageIndex := PopupMenu.Items[I].Tag;
  for I := 0 to NewItem.Count - 1 do
    if NewItem.Items[I].Tag > 0 then
      NewItem.Items[I].ImageIndex := NewItem.Items[I].Tag;
{$ENDIF RX_D4}
  with Placement do begin
    IniFileName := GetBaseRegistryKey;
    IniSection := sExpertID;
  end;
end;

procedure TRxResourceEditor.FormDestroy(Sender: TObject);
begin
  RxResourceEditor := nil;
end;

procedure TRxResourceEditor.ResTreeExpanded(Sender: TObject;
  Node: TTreeNode);
begin
  if Node.ImageIndex = 0 then begin
    Node.ImageIndex := 1;
    Node.SelectedIndex := Node.ImageIndex;
  end;
end;

procedure TRxResourceEditor.ResTreeCollapsed(Sender: TObject;
  Node: TTreeNode);
begin
  if Node.ImageIndex = 1 then begin
    Node.ImageIndex := 0;
    Node.SelectedIndex := Node.ImageIndex;
  end;
end;

procedure TRxResourceEditor.ResTreeEditing(Sender: TObject;
  Node: TTreeNode; var AllowEdit: Boolean);
var
  Entry: TResourceEntry;
begin
  if (Node.Data = nil) then AllowEdit := False
  else begin
    Entry := TResourceEntry(Node.Data);
    AllowEdit := Entry.EnableRenameDelete;
  end;
end;

procedure TRxResourceEditor.ResTreeEdited(Sender: TObject; Node: TTreeNode;
  var S: string);
var
  Entry: TResourceEntry;
  RF: TIResourceFile;
begin
  if (Node.Data <> nil) then begin
    Entry := TResourceEntry(Node.Data);
    Inc(FExpert.FLockCount);
    try
      RF := FExpert.GetResFile;
      try
        S := AnsiUpperCase(S);
        FExpert.CheckRename(RF, Entry.GetResourceType, ResIdent(S));
        if Entry.Rename(RF, S) then begin
          Node.Text := Entry.GetName;
          FExpert.MarkModified;
        end
        else Beep;
      finally
        RF.Free;
      end;
    finally
      Dec(FExpert.FLockCount);
      S := Node.Text;
    end;
  end;
end;

procedure TRxResourceEditor.PopupMenuPopup(Sender: TObject);
var
  Node: TTreeNode;
  Entry: TResourceEntry;
begin
  Node := ResTree.Selected;
  if (Node <> nil) and (Node.Data <> nil) then begin
    Entry := TResourceEntry(Node.Data);
    EditItem.Enabled := Entry.EnableEdit;
    RenameItem.Enabled := Entry.EnableRenameDelete;
    DeleteItem.Enabled := RenameItem.Enabled;
    PreviewItem.Enabled := Entry.FResType in [rtpBitmap, rtpGroupIcon,
      rtpGroupCursor];
    SaveItem.Enabled := Entry.FResType in [rtpGroupCursor, rtpGroupIcon,
      rtpBitmap, rtpAniCursor, rtpRCData, rtpCustom];
    ResTree.Selected := Node;
  end
  else begin
    EditItem.Enabled := False;
    RenameItem.Enabled := False;
    DeleteItem.Enabled := False;
    PreviewItem.Enabled := False;
    SaveItem.Enabled := False;
  end;
end;

procedure TRxResourceEditor.RenameItemClick(Sender: TObject);
var
  Node: TTreeNode;
begin
  Node := ResTree.Selected;
  if Node <> nil then Node.EditText;
end;

procedure TRxResourceEditor.EditItemClick(Sender: TObject);
var
  Node: TTreeNode;
  ResFile: TIResourceFile;
  Entry: TResourceEntry;
  Graphic: TGraphic;
  Stream: TStream;
begin
  Node := ResTree.Selected;
  if Node <> nil then begin
    Entry := TResourceEntry(Node.Data);
    if (Entry <> nil) and Entry.EnableEdit then begin
      case Entry.FResType of
        rtpGroupCursor,
        rtpGroupIcon:
          begin
            if Entry.FResType = rtpGroupCursor then
              OpenDlg.Filter := sCursorFilesFilter
            else
              OpenDlg.Filter := sIconFilesFilter + '|' + sCursorFilesFilter;
            OpenDlg.FileName := '';
            if OpenDlg.Execute then begin
              Stream := TFileStream.Create(OpenDlg.FileName, fmOpenRead +
                fmShareDenyNone);
              try
                FExpert.EditCursorIconRes(Entry, Entry.FResType =
                  rtpGroupIcon, Stream);
              finally
                Stream.Free;
              end;
            end;
          end;
        rtpBitmap:
          begin
            ResFile := FExpert.GetResFile;
            try
              Graphic := Entry.GetGraphic(ResFile);
            finally
              ResFile.Free;
            end;
            try
              if EditGraphic(Graphic, nil, Entry.GetName) then begin