rxresexp.pas

rxlib2.75控件包

          TypeList := TStringList.Create;
          try
            TypeList.Sorted := True;
            TypeList.Duplicates := dupIgnore;
            RootNode := ResTree.Items.Add(nil, ExtractFileName(FResFileName));
            RootNode.ImageIndex := 9; { Delphi Project }
            RootNode.SelectedIndex := RootNode.ImageIndex;
            for I := 0 to FResourceList.Count - 1 do begin
              Entry := TResourceEntry(FResourceList.Objects[I]);
              if (Entry = nil) or (Entry.FParent <> nil) then
                Continue; { ignore cursors and icons, use groups }
              Cnt := TypeList.IndexOf(Entry.GetTypeName);
              if Cnt < 0 then begin
                TypeNode := ResTree.Items.AddChildObject(RootNode,
                  Entry.GetTypeName, nil);
                TypeNode.ImageIndex := 0; { Collapsed Folder }
                TypeNode.SelectedIndex := TypeNode.ImageIndex;
                TypeList.AddObject(Entry.GetTypeName, TypeNode);
              end
              else
                TypeNode := TTreeNode(TypeList.Objects[Cnt]);
              Entry.FEntryNode := ResTree.Items.AddChildObject(TypeNode,
                Entry.GetName, Entry);
              Entry.FEntryNode.ImageIndex := ResImages[Entry.FResType];
              Entry.FEntryNode.SelectedIndex := Entry.FEntryNode.ImageIndex;
            end;
            RootNode.Expanded := True;
          finally
            TypeList.Free;
          end;
        finally
          ResTree.Items.EndUpdate;
        end;
      end;
    end;
  finally
    ResourceFile.Free;
  end;
end;

procedure TRxProjectResExpert.ClearProjectResInfo;
var
  I: Integer;
begin
  FResFileName := '';
  if RxResourceEditor <> nil then begin
    RxResourceEditor.ResTree.Items.Clear;
    RxResourceEditor.StatusBar.Panels[0].Text := '';
  end;
  for I := 0 to FResourceList.Count - 1 do
    TResourceEntry(FResourceList.Objects[I]).Free;
  FResourceList.Clear;
end;

procedure TRxProjectResExpert.UpdateProjectResInfo;
var
  TreeState: TStringList;
  Node, ChildNode: TTreeNode;
  I: Integer;
begin
  if FLockCount > 0 then Exit;
  if RxResourceEditor <> nil then
    RxResourceEditor.ResTree.Items.BeginUpdate;
  try
    TreeState := TStringList.Create;
    try
      if RxResourceEditor <> nil then begin
        if FSelection.ResType = '' then begin
          { save selection }
          Node := RxResourceEditor.ResTree.Selected;
          if Node <> nil then begin
            if (Node.Data <> nil) then begin
              FSelection.ResName := TResourceEntry(Node.Data).GetName;
              FSelection.ResType := TResourceEntry(Node.Data).GetTypeName;
            end
            else begin
              FSelection.ResName := '';
              FSelection.ResType := Node.Text;
            end;
          end;
        end;
        { save tree state }
        Node := RxResourceEditor.ResTree.Items.GetFirstNode;
        if Node <> nil then ChildNode := Node.GetFirstChild
        else ChildNode := nil;
        while ChildNode <> nil do begin
          TreeState.AddObject(ChildNode.Text, TObject(ChildNode.Expanded));
          ChildNode := Node.GetNextChild(ChildNode);
        end;
      end;
      Inc(FLockCount);
      try
        ClearProjectResInfo;
        try
          LoadProjectResInfo;
        except
          ClearProjectResInfo;
        end;
      finally
        Dec(FLockCount);
      end;
      if (RxResourceEditor <> nil) then begin
        { restore tree state }
        Node := RxResourceEditor.ResTree.Items.GetFirstNode;
        if Node <> nil then begin
          ChildNode := Node.GetFirstChild;
          while ChildNode <> nil do begin
            I := TreeState.IndexOf(ChildNode.Text);
            if I >= 0 then
              ChildNode.Expanded := Boolean(TreeState.Objects[I]);
            ChildNode := Node.GetNextChild(ChildNode);
          end;
        end;
        if (FSelection.ResName <> '') or (FSelection.ResType <> '') then
        begin { restore selection }
          with FSelection do
            Node := FindNode(RxResourceEditor.ResTree, nil, ResName, ResType);
          if Node <> nil then begin
            if Node.Parent <> nil then Node.Parent.Expanded := True;
            Node.Selected := True;
          end;
        end;
      end;
    finally
      TreeState.Free;
      with FSelection do begin
        ResName := '';
        ResType := '';
      end;
    end;
  finally
    if RxResourceEditor <> nil then
      RxResourceEditor.ResTree.Items.EndUpdate;
  end;
end;

procedure TRxProjectResExpert.OpenProject(const FileName: string);
begin
  CloseProject;
  ProjectModule := ToolServices.GetModuleInterface(FileName);
  if ProjectModule <> nil then begin
    ProjectNotifier := TProjectNotifier.Create(Self);
    ProjectModule.AddNotifier(ProjectNotifier);
    try
      LoadProjectResInfo;
      FProjectName := FileName;
    except
      ClearProjectResInfo;
    end;
  end;
end;

procedure TRxProjectResExpert.CloseProject;
begin
  if ProjectModule <> nil then begin
    ClearProjectResInfo;
    ProjectModule.RemoveNotifier(ProjectNotifier);
    ProjectNotifier.Free;
    ProjectModule.Free;
    ProjectNotifier := nil;
    ProjectModule := nil;
    FProjectName := '';
  end;
end;

{$IFNDEF RX_D4}

procedure TRxProjectResExpert.LoadDesktop(const FileName: string);
var
  Desktop: TIniFile;
begin
  Desktop := TIniFile.Create(FileName);
  try
    if DeskTop.ReadBool(sExpertName, sVisible, False) then
      ProjectResourcesClick(nil)
    else if RxResourceEditor <> nil then RxResourceEditor.Close;
  finally
    Desktop.Free;
  end;
end;

procedure TRxProjectResExpert.SaveDesktop(const FileName: string);
var
  Desktop: TIniFile;
  Visible: Boolean;
begin
  Desktop := TIniFile.Create(FileName);
  try
    Visible := (RxResourceEditor <> nil) and RxResourceEditor.Visible;
    DeskTop.WriteBool(sExpertName, sVisible, Visible);
  finally
    Desktop.Free;
  end;
end;

{$ENDIF}

procedure TRxProjectResExpert.ProjectResourcesClick(Sender: TIMenuItemIntf);
var
  Reopen: Boolean;
  ProjectName: string;
  ResourceFile: TIResourceFile;
begin
  ResourceFile := GetResFile;
  try
    if Assigned(ResourceFile) then begin
      Reopen := RxResourceEditor = nil;
      CreateForm(TRxResourceEditor, RxResourceEditor);
      RxResourceEditor.FExpert := Self;
      ProjectName := ToolServices.GetProjectName;
      if Reopen or (FProjectName <> ProjectName) then begin
        if ProjectName <> '' then OpenProject(ProjectName);
      end;
      RxResourceEditor.Show;
    end;
  finally
    ResourceFile.Free;
  end;
end;

procedure TRxProjectResExpert.MarkModified;
var
  EditorInterface: TIEditorInterface;
begin
  if ProjectModule <> nil then begin
    EditorInterface := ProjectModule.GetEditorInterface;
    try
      EditorInterface.MarkModified;
    finally
      EditorInterface.Free;
    end;
  end;
end;

procedure TRxProjectResExpert.CheckRename(ResFile: TIResourceFile;
  ResType, NewName: PChar);
var
  Entry: TIResourceEntry;
begin
  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