?? rxresexp.pas
字號:
else Result := IntToStr(ResType);
end;
end;
function ResTypeName(ResType: PChar): string;
begin
if HiWord(Longint(ResType)) = 0 then
Result := ResourceTypeName(LoWord(Longint(ResType)))
else Result := StrPas(ResType);
end;
function FindNode(TreeView: TCustomTreeView; Node: TTreeNode;
const ResName, ResType: string): TTreeNode;
function SearchNodes(Node: TTreeNode): TTreeNode;
var
ChildNode: TTreeNode;
Entry: TResourceEntry;
begin
Result := nil;
if Node = nil then Exit;
Entry := TResourceEntry(Node.Data);
if ((Entry <> nil) and (Entry.GetName = ResName) and
(Entry.GetTypeName = ResType)) or ((Entry = nil) and (ResName = '') and
(Node.Text = ResType)) then
Result := Node
else
begin
ChildNode := Node.GetFirstChild;
while ChildNode <> nil do begin
Result := SearchNodes(ChildNode);
if Result <> nil then Break
else ChildNode := Node.GetNextChild(ChildNode);
end;
end;
end;
begin
if Node = nil then Node := TTreeView(TreeView).Items.GetFirstNode;
Result := SearchNodes(Node);
end;
const
ResImages: array[TResourceType] of Integer = (2, 4, 4, 5, 3, 3, 2, 8, 4, 2);
AllMenuFlags = [mfInvalid, mfEnabled, mfVisible, mfChecked, mfBreak,
mfBarBreak, mfRadioItem];
const
MOVEABLE = $0010;
PURE = $0020;
PRELOAD = $0040;
DISCARDABLE = $1000;
const
rc3_StockIcon = 0;
rc3_Icon = 1;
rc3_Cursor = 2;
type
PCursorOrIcon = ^TCursorOrIcon;
TCursorOrIcon = packed record
Reserved: Word;
wType: Word;
Count: Word;
end;
PIconDirectory = ^TIconDirectory;
TIconDirectory = packed record
case Integer of
rc3_Cursor:
(cWidth: Word;
cHeight: Word);
rc3_Icon:
(Width: Byte;
Height: Byte;
Colors: Byte;
Reserved: Byte;
Planes: Word;
BitCount: Word;
BytesInRes: Longint;
NameOrdinal: Word);
end;
PCursorHeader = ^TCursorHeader;
TCursorHeader = packed record
xHotspot: Word;
yHotspot: Word;
end;
PDirectory = ^TDirectory;
TDirectory = array[0..64] of TIconDirectory;
PIconRec = ^TIconRec;
TIconRec = packed record
Width: Byte;
Height: Byte;
Colors: Word;
Reserved1: Word; { xHotspot }
Reserved2: Word; { yHotspot }
DIBSize: Longint;
DIBOffset: Longint;
end;
PIconList = ^TIconList;
TIconList = array[0..64] of TIconRec;
procedure InvalidIcon; near;
begin
raise EInvalidGraphic.Create(ResStr(SInvalidIcon));
end;
{ TIconData }
type
TIconData = class
private
FHeader: TCursorOrIcon;
FList: Pointer;
FNames: PWordArray;
FData: TList;
procedure Clear;
public
constructor Create;
destructor Destroy; override;
function GetCount: Integer;
procedure LoadFromStream(Stream: TStream);
procedure SaveToStream(Stream: TStream);
function BuildResourceGroup(var Size: Integer): Pointer;
function BuildResourceItem(Index: Integer; var Size: Integer): Pointer;
procedure LoadResourceGroup(Data: Pointer; Size: Integer);
procedure LoadResourceItem(Index: Integer; Data: Pointer; Size: Integer);
procedure SetNameOrdinal(Index: Integer; Name: Word);
end;
constructor TIconData.Create;
begin
inherited Create;
FData := TList.Create;
end;
destructor TIconData.Destroy;
begin
Clear;
FData.Free;
inherited Destroy;
end;
procedure TIconData.Clear;
begin
if FNames <> nil then FreeMem(FNames);
FNames := nil;
if FList <> nil then FreeMem(FList);
FList := nil;
while FData.Count > 0 do begin
if Pointer(FData[0]) <> nil then FreeMem(Pointer(FData[0]));
FData.Delete(0);
end;
FillChar(FHeader, SizeOf(FHeader), 0);
end;
function TIconData.GetCount: Integer;
begin
Result := FData.Count;
end;
function TIconData.BuildResourceGroup(var Size: Integer): Pointer;
var
P: PDirectory;
List: PIconList;
I: Integer;
BI: PBitmapInfoHeader;
begin
Size := SizeOf(FHeader) + SizeOf(TIconDirectory) * FHeader.Count;
Result := AllocMem(Size);
try
Move(FHeader, Result^, SizeOf(FHeader));
P := PDirectory(PChar(Result) + SizeOf(FHeader));
List := PIconList(FList);
for I := 0 to FHeader.Count - 1 do begin
BI := PBitmapInfoHeader(Pointer(FData[I]));
with P^[I] do begin
if FHeader.wType = rc3_Cursor then begin
cWidth := List^[I].Width;
cHeight := List^[I].Height * 2;
end
else begin
Width := List^[I].Width;
Height := List^[I].Height;
Colors := List^[I].Colors;
Reserved := 0;
end;
Planes := BI^.biPlanes;
BitCount := BI^.biBitCount;
BytesInRes := List^[I].DIBSize;
if FHeader.wType = rc3_Cursor then
Inc(BytesInRes, SizeOf(TCursorHeader));
NameOrdinal := 0;
if FNames <> nil then NameOrdinal := FNames^[I];
end;
end;
except
FreeMem(Result);
raise;
end;
end;
function TIconData.BuildResourceItem(Index: Integer;
var Size: Integer): Pointer;
var
Icon: PIconRec;
P: Pointer;
begin
Icon := @(PIconList(FList)^[Index]);
Size := Icon^.DIBSize;
if FHeader.wType = rc3_Cursor then Inc(Size, SizeOf(TCursorHeader));
Result := AllocMem(Size);
try
P := Result;
if FHeader.wType = rc3_Cursor then begin
with PCursorHeader(Result)^ do begin
xHotspot := Icon^.Reserved1;
yHotspot := Icon^.Reserved2;
end;
Inc(PChar(P), SizeOf(TCursorHeader));
end;
Move(Pointer(FData[Index])^, P^, Icon^.DIBSize);
except
FreeMem(Result);
raise;
end;
end;
procedure TIconData.SetNameOrdinal(Index: Integer; Name: Word);
begin
if (FNames <> nil) and (Index >= 0) and (Index < FData.Count) then
FNames^[Index] := Name;
end;
procedure TIconData.LoadResourceGroup(Data: Pointer; Size: Integer);
var
P: PDirectory;
List: PIconList;
I: Integer;
begin
FHeader.Count := (Size - SizeOf(FHeader)) div SizeOf(TIconDirectory);
Move(Data^, FHeader, SizeOf(FHeader));
if FList <> nil then FreeMem(FList);
FList := AllocMem(SizeOf(TIconRec) * FHeader.Count);
while FData.Count > 0 do begin
if Pointer(FData[0]) <> nil then FreeMem(Pointer(FData[0]));
FData.Delete(0);
end;
P := PDirectory(PChar(Data) + SizeOf(FHeader));
List := PIconList(FList);
if FNames <> nil then FreeMem(FNames);
FNames := AllocMem(FHeader.Count * SizeOf(Word));
for I := 0 to FHeader.Count - 1 do begin
with List^[I] do begin
if FHeader.wType = rc3_Cursor then begin
Width := P^[I].cWidth;
Height := P^[I].cHeight div 2;
end
else begin
Width := P^[I].Width;
Height := P^[I].Height;
Colors := P^[I].Colors;
end;
DIBSize := P^[I].BytesInRes;
if FHeader.wType = rc3_Cursor then Dec(DIBSize, SizeOf(TCursorHeader));
Reserved1 := 0;
Reserved2 := 0;
end;
FData.Add(nil);
SetNameOrdinal(I, P^[I].NameOrdinal);
end;
end;
procedure TIconData.LoadResourceItem(Index: Integer; Data: Pointer;
Size: Integer);
var
P: Pointer;
Rec: PIconRec;
BI: PBitmapInfoHeader;
begin
if (Index < 0) or (Index >= FData.Count) then Exit;
Rec := @(PIconList(FList)^[Index]);
P := Data;
if FHeader.wType = rc3_Cursor then begin
with Rec^ do begin
Reserved1 := PCursorHeader(Data).xHotspot;
Reserved2 := PCursorHeader(Data).yHotspot;
end;
Inc(PChar(P), SizeOf(TCursorHeader));
Dec(Size, SizeOf(TCursorHeader));
end;
FData[Index] := AllocMem(Size);
Move(P^, Pointer(FData[Index])^, Min(Rec^.DIBSize, Size));
BI := PBitmapInfoHeader(Pointer(FData[Index]));
case BI^.biBitCount of
1, 4, 8: Rec^.Colors := (1 shl BI^.biBitCount) * BI^.biPlanes;
else Rec^.Colors := BI^.biBitCount * BI^.biPlanes;
end;
end;
procedure TIconData.SaveToStream(Stream: TStream);
var
I, J: Integer;
Data: Pointer;
begin
FHeader.Count := FData.Count;
Stream.WriteBuffer(FHeader, SizeOf(FHeader));
for I := 0 to FHeader.Count - 1 do begin
PIconList(FList)^[I].DIBOffset := SizeOf(FHeader) + (SizeOf(TIconRec) *
FHeader.Count);
for J := 0 to I - 1 do
Inc(PIconList(FList)^[I].DIBOffset, PIconList(FList)^[I - 1].DIBSize);
end;
Stream.WriteBuffer(FList^, SizeOf(TIconRec) * FHeader.Count);
for I := 0 to FHeader.Count - 1 do begin
Data := FData[I];
Stream.WriteBuffer(Data^, PIconList(FList)^[I].DIBSize);
end;
end;
procedure TIconData.LoadFromStream(Stream: TStream);
var
I: Integer;
Data: Pointer;
begin
Clear;
Stream.ReadBuffer(FHeader, SizeOf(FHeader));
if (not (FHeader.wType in [rc3_Icon, rc3_Cursor])) or
(FHeader.Count < 1) then InvalidIcon;
FList := AllocMem(SizeOf(TIconRec) * FHeader.Count);
try
Stream.ReadBuffer(FList^, SizeOf(TIconRec) * FHeader.Count);
for I := 0 to FHeader.Count - 1 do begin
Stream.Seek(PIconList(FList)^[I].DIBOffset, 0);
Data := AllocMem(PIconList(FList)^[I].DIBSize);
try
FData.Add(TObject(Data));
except
FreeMem(Data);
raise;
end;
Stream.ReadBuffer(Data^, PIconList(FList)^[I].DIBSize);
end;
FNames := AllocMem(FData.Count * SizeOf(Word));
FillChar(FNames^, FData.Count * SizeOf(Word), 0);
except
Clear;
raise;
end;
end;
{ TAddInNotifier }
procedure EnableMenuItem(Expert: TRxProjectResExpert;
AEnable: Boolean);
begin
with Expert.ProjectResourcesItem do
if (Expert.FResFileName <> '') and AEnable then
SetFlags(AllMenuFlags, GetFlags + [mfEnabled])
else
SetFlags(AllMenuFlags, GetFlags - [mfEnabled]);
end;
constructor TAddInNotifier.Create(AProjectResources: TRxProjectResExpert);
begin
inherited Create;
FProjectResources := AProjectResources;
end;
procedure TAddInNotifier.FileNotification(NotifyCode: TFileNotification;
const FileName: string; var Cancel: Boolean);
begin
if FProjectResources = nil then Exit;
case NotifyCode of
fnProjectOpened:
begin
FProjectResources.OpenProject(FileName);
EnableMenuItem(FProjectResources, True);
end;
{$IFNDEF RX_D4}
fnProjectDesktopLoad:
FProjectResources.LoadDesktop(FileName);
fnProjectDesktopSave:
FProjectResources.SaveDesktop(FileName);
{$ENDIF}
end;
end;
{$IFDEF RX_D3}
procedure TAddInNotifier.EventNotification(NotifyCode: TEventNotification;
var Cancel: Boolean);
begin
{ Nothing to do here but needs to be overridden anyway }
end;
{$ENDIF}
{ TProjectNotifier }
constructor TProjectNotifier.Create(AProjectResources: TRxProjectResExpert);
begin
inherited Create;
FProjectResources := AProjectResources;
end;
procedure TProjectNotifier.Notify(NotifyCode: TNotifyCode);
begin
if FProjectResources = nil then Exit;
case NotifyCode of
ncModuleDeleted:
begin
if RxResourceEditor <> nil then RxResourceEditor.Close;
EnableMenuItem(FProjectResources, False);
FProjectResources.CloseProject;
end;
ncModuleRenamed, ncProjResModified:
begin
FProjectResources.UpdateProjectResInfo;
EnableMenuItem(FProjectResources, True);
end;
end;
end;
procedure TProjectNotifier.ComponentRenamed(const AComponent: TComponent;
const OldName, NewName: string);
begin
{ Nothing to do here but needs to be overridden anyway }
end;
{ TResourceEntry }
constructor TResourceEntry.Create(AEntry: TIResourceEntry);
var
P: PChar;
begin
inherited Create;
FChildren := TList.Create;
FHandle := AEntry.GetEntryHandle;
P := AEntry.GetResourceType;
if HiWord(Longint(P)) = 0 then begin
FResType := CheckResType(LoWord(Longint(P)));
FTypeId := LoWord(Longint(P));
end;
FType := ResTypeName(P);
P := AEntry.GetResourceName;
if HiWord(Longint(P)) = 0 then
FNameId := LoWord(Longint(P));
FName := StrText(P);
FSize := AEntry.GetDataSize;
end;
destructor TResourceEntry.Destroy;
begin
FChildren.Free;
inherited Destroy;
end;
function TResourceEntry.GetResourceName: PChar;
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -