rxresexp.pas

rxlib2.75控件包

begin
  if FNameId > 0 then Result := MakeIntResource(FNameId)
  else Result := PChar(FName);
end;

function TResourceEntry.GetResourceType: PChar;
begin
  if FTypeId > 0 then Result := MakeIntResource(FTypeId)
  else Result := PChar(FType);
end;

function TResourceEntry.GetName: string;
begin
  Result := FName;
end;

function TResourceEntry.GetTypeName: string;
begin
  Result := FType;
end;

function TResourceEntry.EnableEdit: Boolean;
begin
  Result := FResType in [rtpGroupCursor, rtpBitmap, rtpGroupIcon, rtpRCData,
    rtpAniCursor, rtpCustom];
end;

function TResourceEntry.EnableRenameDelete: Boolean;
begin
  Result := FResType in [rtpCustom, rtpGroupCursor, rtpBitmap, rtpGroupIcon,
    rtpRCData, rtpAniCursor, rtpPredefined];
  if (FResType = rtpGroupIcon) then
    Result := CompareText(GetName, 'MAINICON') <> 0;
end;

function TResourceEntry.GetCursorOrIcon(ResFile: TIResourceFile;
  IsIcon: Boolean): HIcon;
var
  Entry, ChildEntry: TIResourceEntry;
  I: Integer;
begin
  Result := 0;
  if not (FResType in [rtpGroupIcon, rtpGroupCursor]) then Exit;
  Entry := ResFile.FindEntry(GetResourceType, GetResourceName);
  try
    I := LookupIconIdFromDirectory(Entry.GetData, IsIcon);
    if I > 0 then begin
      if IsIcon then
        ChildEntry := ResFile.FindEntry(RT_ICON, PChar(I))
      else
        ChildEntry := ResFile.FindEntry(RT_CURSOR, PChar(I));
      if ChildEntry <> nil then
      try
        with ChildEntry do
          Result := CreateIconFromResourceEx(GetData, GetDataSize,
            IsIcon, $30000, 0, 0, $80);
      finally
        ChildEntry.Free;
      end;
    end;
  finally
    Entry.Free;
  end;
end;

procedure TResourceEntry.GetIconData(ResFile: TIResourceFile; Stream: TStream);
var
  Data: TIconData;
  Entry: TIResourceEntry;
  I: Integer;
  P: PChar;
begin
  if not (FResType in [rtpGroupIcon, rtpGroupCursor]) then Exit;
  Data := TIconData.Create;
  try
    Entry := ResFile.FindEntry(GetResourceType, GetResourceName);
    try
      Data.LoadResourceGroup(Entry.GetData, Entry.GetDataSize);
    finally
      Entry.Free;
    end;
    for I := 0 to Data.FHeader.Count - 1 do begin
      P := MakeIntResource(Data.FNames^[I]);
      if FResType = rtpGroupIcon then
        Entry := ResFile.FindEntry(RT_ICON, P)
      else {rtpGroupCursor}
        Entry := ResFile.FindEntry(RT_CURSOR, P);
      try
        Data.LoadResourceItem(I, Entry.GetData, Entry.GetDataSize);
      finally
        Entry.Free;
      end;
    end;
    Data.SaveToStream(Stream);
  finally
    Data.Free;
  end;
end;

function TResourceEntry.GetBitmap(ResFile: TIResourceFile): TBitmap;

  function GetDInColors(BitCount: Word): Integer;
  begin
    case BitCount of
      1, 4, 8: Result := 1 shl BitCount;
      else Result := 0;
    end;
  end;

var
  Header: PBitmapFileHeader;
  BI: PBitmapInfoHeader;
  BC: PBitmapCoreHeader;
  Entry: TIResourceEntry;
  Mem: TMemoryStream;
  ClrUsed: Integer;
begin
  Result := nil;
  if FResType <> rtpBitmap then Exit;
  Mem := TMemoryStream.Create;
  try
    Entry := ResFile.FindEntry(GetResourceType, GetResourceName);
    try
      Mem.SetSize(Entry.GetDataSize + SizeOf(TBitmapFileHeader));
      Move(Entry.GetData^, Pointer(PChar(Mem.Memory) +
        SizeOf(TBitmapFileHeader))^, Mem.Size);
      Header := PBitmapFileHeader(Mem.Memory);
      BI := PBitmapInfoHeader(PChar(Mem.Memory) + SizeOf(TBitmapFileHeader));
      { fill header }
      with Header^ do begin
        if BI^.biSize = SizeOf(TBitmapInfoHeader) then begin
          ClrUsed := BI^.biClrUsed;
          if ClrUsed = 0 then ClrUsed := GetDInColors(BI^.biBitCount);
          bfOffBits :=  ClrUsed * SizeOf(TRGBQuad) +
            SizeOf(TBitmapInfoHeader) + SizeOf(TBitmapFileHeader);
        end
        else begin
          BC := PBitmapCoreHeader(PChar(Mem.Memory) +
            SizeOf(TBitmapFileHeader));
          ClrUsed := GetDInColors(BC^.bcBitCount);
          bfOffBits :=  ClrUsed * SizeOf(TRGBTriple) +
            SizeOf(TBitmapCoreHeader) + SizeOf(TBitmapFileHeader);
        end;
        bfSize := bfOffBits + BI^.biSizeImage;
        bfType := $4D42; { BM }
      end;
    finally
      Entry.Free;
    end;
    Result := TBitmap.Create;
    try
      Result.LoadFromStream(Mem);
    except
      Result.Free;
      raise;
    end;
  finally
    Mem.Free;
  end;
end;

procedure TResourceEntry.GetData(ResFile: TIResourceFile; Stream: TStream);
var
  Entry: TIResourceEntry;
begin
  Entry := ResFile.FindEntry(GetResourceType, GetResourceName);
  try
    Stream.WriteBuffer(Entry.GetData^, Entry.GetDataSize);
  finally
    Entry.Free;
  end;
end;

function TResourceEntry.GetGraphic(ResFile: TIResourceFile): TGraphic;
begin
  Result := nil;
  case FResType of
    rtpBitmap: Result := GetBitmap(ResFile);
    rtpGroupIcon:
      begin
        Result := TIcon.Create;
        try
          TIcon(Result).Handle := GetCursorOrIcon(ResFile, True);
        except
          Result.Free;
          raise;
        end;
      end;
  end;
end;

function TResourceEntry.Rename(ResFile: TIResourceFile;
  const NewName: string): Boolean;
var
  P: PChar;
  AName: string;
  Id: Word;
  Code: Integer;
  Entry: TIResourceEntry;
begin
  Result := False;
  Entry := ResFile.FindEntry(GetResourceType, GetResourceName);
  try
    Val(NewName, Id, Code);
    if Code = 0 then P := MakeIntResource(Id)
    else begin
      if not IsValidIdent(NewName) then
        raise Exception.Create(Format(sInvalidName, [NewName]));
      AName := AnsiUpperCase(NewName);
      P := PChar(AName);
    end;
    Result := Entry.Change(Entry.GetResourceType, P);
    if Result then begin
      P := Entry.GetResourceName;
      if HiWord(Longint(P)) = 0 then FNameId := LoWord(Longint(P));
      FName := StrText(P);
    end;
  finally
    Entry.Free;
  end;
end;

{ TRxProjectResExpert }

constructor TRxProjectResExpert.Create;
var
  MainMenu: TIMainMenuIntf;
  ProjSrcMenu: TIMenuItemIntf;
  ViewMenu: TIMenuItemIntf;
  MenuItems: TIMenuItemIntf;
begin
  inherited Create;
  FResourceList := TStringList.Create;
  if Assigned(ToolServices) then begin
    MainMenu := ToolServices.GetMainMenu;
    if MainMenu <> nil then
    try
      MenuItems := MainMenu.GetMenuItems;
      if MenuItems <> nil then
      try
        ProjSrcMenu := MainMenu.FindMenuItem('ViewPrjSourceItem');
        if ProjSrcMenu <> nil then
        try
          ViewMenu := ProjSrcMenu.GetParent;
          if ViewMenu <> nil then
          try
            ProjectResourcesItem := ViewMenu.InsertItem(
              ProjSrcMenu.GetIndex, GetMenuText, 'ViewPrjResourceItem',
              '', 0, 0, 0, [mfVisible], ProjectResourcesClick);
          finally
            ViewMenu.Free;
          end;
        finally
          ProjSrcMenu.Free;
        end;
      finally
        MenuItems.Free;
      end;
    finally
      MainMenu.Free;
    end;
    AddInNotifier := TAddInNotifier.Create(Self);
{$IFDEF RX_D4}
    ToolServices.AddNotifierEx(AddInNotifier);
{$ELSE}
    ToolServices.AddNotifier(AddInNotifier);
{$ENDIF}
  end;
end;

destructor TRxProjectResExpert.Destroy;
begin
  if RxResourceEditor <> nil then RxResourceEditor.Free;
  ToolServices.RemoveNotifier(AddInNotifier);
  CloseProject;
  ProjectResourcesItem.Free;
  AddInNotifier.Free;
  FResourceList.Free;
  inherited Destroy;
end;

function TRxProjectResExpert.GetName: string;
begin
  Result := sExpertName;
end;

function TRxProjectResExpert.GetAuthor: string;
begin
  Result := '';
end;

function TRxProjectResExpert.GetComment: string;
begin
  Result := '';
end;

function TRxProjectResExpert.GetPage: string;
begin
  Result := '';
end;

function TRxProjectResExpert.GetGlyph: HICON;
begin
  Result := 0;
end;

function TRxProjectResExpert.GetMenuText: string;
begin
  Result := sMenuItemCaption;
end;

function TRxProjectResExpert.GetState: TExpertState;
begin
  Result := [esEnabled];
end;

function TRxProjectResExpert.GetStyle: TExpertStyle;
begin
  Result := esAddIn;
end;

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;

function TRxProjectResExpert.GetResFile: TIResourceFile;
begin
  if ProjectModule.IsProjectModule then
    Result := ProjectModule.GetProjectResource
  else Result := nil;
end;

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