?? rxresexp.pas
字號:
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
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -