rxresexp.pas

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

function TRxProjectResExpert.GetMenuText: string;
begin
  Result := sMenuItemCaption;
end;
{$endif}

{$ifdef use_toolsapi}
function TRxProjectResExpert.GetState: TWizardState;
begin
  Result := [wsEnabled];
end;
{$else}
function TRxProjectResExpert.GetState: TExpertState;
begin
  Result := [esEnabled];
end;

function TRxProjectResExpert.GetStyle: TExpertStyle;
begin
  Result := esAddIn;
end;
{$endif}

function TRxProjectResExpert.GetIDString: string;
begin
  Result := sExpertID;
end;

procedure TRxProjectResExpert.Execute;
begin
end;

procedure TRxProjectResExpert.BeginUpdate;
begin
  Inc(FLockCount);
end;

procedure TRxProjectResExpert.EndUpdate;
begin
  Dec(FLockCount);
  if FLockCount = 0 then UpdateProjectResInfo;
end;

{$ifdef use_toolsapi}
function GetProjectResource(Project: IOTAProject): IOTAProjectResource;
var
  i: Integer;
  Editor: IOTAEditor;
begin
  Result := nil;
  for i:= 0 to (Project.GetModuleFileCount - 1) do
  begin
    Editor := Project.GetModuleFileEditor(i);
    if Supports(Editor, IOTAProjectResource, Result) then
      Break;
  end;
end;
{$else}
function TRxProjectResExpert.GetResFile: TIResourceFile;
begin
  Result := nil;
  try
    if Assigned(ProjectModule) and ProjectModule.IsProjectModule then
      Result := ProjectModule.GetProjectResource;
  except
    Result := nil;
  end;
end;
{$endif}

procedure TRxProjectResExpert.FindChildren(ResFile: TIResourceFile;
  Entry: TResourceEntry);
var
  I, Idx: Integer;
  Header: PCursorOrIcon;
  Directory: PDirectory;
  Data: Pointer;
  Child: TResourceEntry;
  ResEntry: TIResourceEntry;
begin
  if Entry = nil then Exit;
  if Entry.FResType in [rtpGroupCursor, rtpGroupIcon] then begin
    ResEntry := ResFile.GetEntryFromHandle(Entry.FHandle);
    if ResEntry <> nil then
    try
      Data := ResEntry.GetData;
      if Data <> nil then begin
        Header := PCursorOrIcon(Data);
        Directory := PDirectory(PChar(Data) + SizeOf(TCursorOrIcon));
        for I := 0 to Header^.Count - 1 do begin
          for Idx := 0 to FResourceList.Count - 1 do begin
            Child := TResourceEntry(FResourceList.Objects[Idx]);
            if (Child <> nil) and (Child.FParent = nil) and
              (((Entry.FResType = rtpGroupIcon) and (Child.FResType = rtpIcon)) or
              ((Entry.FResType = rtpGroupCursor) and (Child.FResType = rtpCursor)))
              and (Child.GetName = IntToStr(Directory^[I].NameOrdinal)) then
            begin
              Entry.FChildren.Add(Child);
              Inc(Entry.FSize, Child.FSize);
              Child.FParent := Entry;
            end;
          end;
        end;
      end;
    finally
      ResEntry.Free;
    end;
  end;
end;

procedure TRxProjectResExpert.LoadProjectResInfo; //!!!!!
var
  I, Cnt: Integer;
  RootNode, TypeNode: TTreeNode;
  Entry: TResourceEntry;
  ResEntry: TIResourceEntry;
  TypeList: TStringList;
  ResourceFile: TIResourceFile;
{$IFDEF RX_V110}
  EditInt: TIEditorInterface;
  IsNewProject: Boolean;
{$ENDIF}
begin
  Cnt := -1;
  try
  ResourceFile := GetResFile;
  except
    ResourceFile := nil;
  end;
  try
    if ResourceFile <> nil then
      with ResourceFile do begin
        FResFileName := FileName;
{$IFDEF RX_V110}
        EditInt := ProjectModule.GetEditorInterface;
        try
          IsNewProject := not FileExists(EditInt.FileName);
        finally
          EditInt.Free;
        end;
        if IsNewProject or FileExists(FResFileName) then begin
          try
            Cnt := GetEntryCount;
            if not FileExists(FResFileName) and (Cnt = 0) then begin
              Cnt := -1;
              FResFileName := '';
            end;
          except
            Cnt := -1;
            FResFileName := '';
          end;
          { Access violation error is occured when specified }
          { resource file doesn't exist }
        end
        else begin
          Cnt := -1;
          FResFileName := '';
        end;
{$ELSE}
        Cnt := GetEntryCount;
{$ENDIF}
        for I := 0 to Cnt - 1 do begin
          ResEntry := GetEntry(I);
          if ResEntry <> nil then begin
            try
              Entry := TResourceEntry.Create(ResEntry);
            finally
              ResEntry.Free;
            end;
            FResourceList.AddObject(Entry.GetName, Entry);
          end;
        end;
        for I := 0 to FResourceList.Count - 1 do begin
          Entry := TResourceEntry(FResourceList.Objects[I]);
          FindChildren(ResourceFile, Entry);
        end;
      end;
    if (RxResourceEditor <> nil) and (ResourceFile <> nil) and (Cnt >= 0) then
    begin
      with RxResourceEditor do begin
        StatusBar.Panels[0].Text := FResFileName;
        ResTree.Items.BeginUpdate;
        try
          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;

{$ifdef use_toolsapi}
procedure TRxProjectResExpert.OpenProject(const FileName: string);
var
  Project: IOTAProject;
begin
  Project := GetActiveProject;
//  Project.
  { TODO -otwm : implement }
end;
{$else}
procedure TRxProjectResExpert.OpenProject(const FileName: string);
begin
  CloseProject;
  if not Assigned(ToolServices) then
    exit;
  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;
{$endif}
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}

{$ifdef use_toolsapi}
procedure TRxProjectResExpert.ProjectResourcesClick(Sender: TObject);
var
  Reopen: Boolean;
  ProjectName: string;
  ResourceFile: TIResourceFile;
  ActiveProject: IOTAProject;
begin
  ResourceFile := GetResFile;
  try
    if Assigned(ResourceFile) then begin
      Reopen := RxResourceEditor = nil;
      CreateForm(TRxResourceEditor, RxResourceEditor);
      RxResourceEditor.FExpert := Self;
      ActiveProject := GetActiveProject;
      if Assigned(ActiveProject) then
      begin
        ProjectName := ActiveProject.Filename;
        if Reopen or (FProjectName <> ProjectName) then begin
          if ProjectName <> '' then OpenProject(ProjectName);
        end;
      end;
      RxResourceEditor.Show;
    end;
  finally
    ResourceFile.Free;
  end;
end;
{$else}
procedure TRxProjectResExpert.ProjectResourcesClick(Sender: TIMenuItemIntf);
var
  Reopen: Boolean;
  ProjectName: string;
  ResourceFile: TIResourceFile;
begin
  if not Assigned(ToolServices) then
    Exit;
  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;
{$ENDIF}

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