rxresexp.pas

rxlib2.75控件包

    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;