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