rxresexp.pas

rxlib2.75控件包

    Bitmap.SaveToStream(Mem);
    Mem.Position := 0;
    CreateEntry(ResFile, RT_BITMAP, ResName, Mem.Size - SizeOf(TBitmapFileHeader),
      Pointer(PChar(Mem.Memory) + SizeOf(TBitmapFileHeader)), True);
  finally
    Mem.Free;
  end;
end;

procedure TRxProjectResExpert.EditBitmapRes(Entry: TResourceEntry;
  Bitmap: TBitmap);
var
  ResFile: TIResourceFile;
begin
  BeginUpdate;
  try
    ResFile := GetResFile;
    try
      DeleteEntry(ResFile, Entry);
      NewBitmapRes(ResFile, Entry.GetResourceName, Bitmap);
    finally
      ResFile.Free;
    end;
  finally
    EndUpdate;
  end;
end;

procedure TRxProjectResExpert.NewBinaryRes(ResFile: TIResourceFile;
  ResName, ResType: PChar; Stream: TMemoryStream);
begin
  Stream.Position := 0;
  CreateEntry(ResFile, ResType, ResName, Stream.Size, Stream.Memory, True);
end;

procedure TRxProjectResExpert.EditBinaryRes(Entry: TResourceEntry;
  Stream: TMemoryStream);
var
  ResFile: TIResourceFile;
begin
  BeginUpdate;
  try
    ResFile := GetResFile;
    try
      DeleteEntry(ResFile, Entry);
      NewBinaryRes(ResFile, Entry.GetResourceName, Entry.GetResourceType,
        Stream);
    finally
      ResFile.Free;
    end;
  finally
    EndUpdate;
  end;
end;

{ TRxResourceEditor }

procedure TRxResourceEditor.FormCreate(Sender: TObject);
{$IFDEF RX_D4}
var
  I: Integer;
{$ENDIF}
begin
  TreeImages.ResourceLoad(rtBitmap, 'RXRESEXPIMG', clFuchsia);
{$IFDEF RX_D3}
  ResTree.RightClickSelect := True;
{$ENDIF}
{$IFDEF RX_D4}
  PopupMenu.Images := TreeImages;
  for I := 0 to PopupMenu.Items.Count - 1 do
    if PopupMenu.Items[I].Tag > 0 then
      PopupMenu.Items[I].ImageIndex := PopupMenu.Items[I].Tag;
  for I := 0 to NewItem.Count - 1 do
    if NewItem.Items[I].Tag > 0 then
      NewItem.Items[I].ImageIndex := NewItem.Items[I].Tag;
{$ENDIF RX_D4}
  with Placement do begin
    IniFileName := ToolServices.GetBaseRegistryKey;
    IniSection := sExpertID;
  end;
end;

procedure TRxResourceEditor.FormDestroy(Sender: TObject);
begin
  RxResourceEditor := nil;
end;

procedure TRxResourceEditor.ResTreeExpanded(Sender: TObject;
  Node: TTreeNode);
begin
  if Node.ImageIndex = 0 then begin
    Node.ImageIndex := 1;
    Node.SelectedIndex := Node.ImageIndex;
  end;
end;

procedure TRxResourceEditor.ResTreeCollapsed(Sender: TObject;
  Node: TTreeNode);
begin
  if Node.ImageIndex = 1 then begin
    Node.ImageIndex := 0;
    Node.SelectedIndex := Node.ImageIndex;
  end;
end;

procedure TRxResourceEditor.ResTreeEditing(Sender: TObject;
  Node: TTreeNode; var AllowEdit: Boolean);
var
  Entry: TResourceEntry;
begin
  if (Node.Data = nil) then AllowEdit := False
  else begin
    Entry := TResourceEntry(Node.Data);
    AllowEdit := Entry.EnableRenameDelete;
  end;
end;

procedure TRxResourceEditor.ResTreeEdited(Sender: TObject; Node: TTreeNode;
  var S: string);
var
  Entry: TResourceEntry;
  RF: TIResourceFile;
begin
  if (Node.Data <> nil) then begin
    Entry := TResourceEntry(Node.Data);
    Inc(FExpert.FLockCount);
    try
      RF := FExpert.GetResFile;
      try
        S := AnsiUpperCase(S);
        FExpert.CheckRename(RF, Entry.GetResourceType, ResIdent(S));
        if Entry.Rename(RF, S) then begin
          Node.Text := Entry.GetName;
          FExpert.MarkModified;
        end
        else Beep;
      finally
        RF.Free;
      end;
    finally
      Dec(FExpert.FLockCount);
      S := Node.Text;
    end;
  end;
end;

procedure TRxResourceEditor.PopupMenuPopup(Sender: TObject);
var
  Node: TTreeNode;
  Entry: TResourceEntry;
begin
  Node := ResTree.Selected;
  if (Node <> nil) and (Node.Data <> nil) then begin
    Entry := TResourceEntry(Node.Data);
    EditItem.Enabled := Entry.EnableEdit;
    RenameItem.Enabled := Entry.EnableRenameDelete;
    DeleteItem.Enabled := RenameItem.Enabled;
    PreviewItem.Enabled := Entry.FResType in [rtpBitmap, rtpGroupIcon,
      rtpGroupCursor];
    SaveItem.Enabled := Entry.FResType in [rtpGroupCursor, rtpGroupIcon,
      rtpBitmap, rtpAniCursor, rtpRCData, rtpCustom];
    ResTree.Selected := Node;
  end
  else begin
    EditItem.Enabled := False;
    RenameItem.Enabled := False;
    DeleteItem.Enabled := False;
    PreviewItem.Enabled := False;
    SaveItem.Enabled := False;
  end;
end;

procedure TRxResourceEditor.RenameItemClick(Sender: TObject);
var
  Node: TTreeNode;
begin
  Node := ResTree.Selected;
  if Node <> nil then Node.EditText;
end;

procedure TRxResourceEditor.EditItemClick(Sender: TObject);
var
  Node: TTreeNode;
  ResFile: TIResourceFile;
  Entry: TResourceEntry;
  Graphic: TGraphic;
  Stream: TStream;
begin
  Node := ResTree.Selected;
  if Node <> nil then begin
    Entry := TResourceEntry(Node.Data);
    if (Entry <> nil) and Entry.EnableEdit then begin
      case Entry.FResType of
        rtpGroupCursor,
        rtpGroupIcon:
          begin
            if Entry.FResType = rtpGroupCursor then
              OpenDlg.Filter := sCursorFilesFilter
            else
              OpenDlg.Filter := sIconFilesFilter + '|' + sCursorFilesFilter;
            OpenDlg.FileName := '';
            if OpenDlg.Execute then begin
              Stream := TFileStream.Create(OpenDlg.FileName, fmOpenRead +
                fmShareDenyNone);
              try
                FExpert.EditCursorIconRes(Entry, Entry.FResType =
                  rtpGroupIcon, Stream);
              finally
                Stream.Free;
              end;
            end;
          end;
        rtpBitmap:
          begin
            ResFile := FExpert.GetResFile;
            try
              Graphic := Entry.GetGraphic(ResFile);
            finally
              ResFile.Free;
            end;
            try
              if EditGraphic(Graphic, nil, Entry.GetName) then begin
                if not Graphic.Empty then
                  FExpert.EditBitmapRes(Entry, TBitmap(Graphic))
                else if Entry.EnableRenameDelete then
                  FExpert.DeleteEntry(nil, Entry);
              end;
            finally
              Graphic.Free;
            end;
          end;
        rtpAniCursor,
        rtpRCData,
        rtpCustom:
          begin
            if Entry.FResType = rtpAniCursor then
              OpenDlg.Filter := sAniCursorFilesFilter
            else
              OpenDlg.Filter := sAllFilesFilter;
            OpenDlg.FileName := '';
            if OpenDlg.Execute then begin
              Stream := TMemoryStream.Create;
              try
                TMemoryStream(Stream).LoadFromFile(OpenDlg.FileName);
                FExpert.EditBinaryRes(Entry, TMemoryStream(Stream));
              finally
                Stream.Free;
              end;
            end;
          end;
        else Exit;
      end;
    end;
  end;
end;

procedure TRxResourceEditor.DeleteItemClick(Sender: TObject);
var
  Node: TTreeNode;
  Entry: TResourceEntry;
begin
  Node := ResTree.Selected;
  if Node <> nil then begin
    Entry := TResourceEntry(Node.Data);
    if (Entry <> nil) and Entry.EnableRenameDelete then
      FExpert.DeleteEntry(nil, Entry);
  end;
end;

procedure TRxResourceEditor.NewBitmapItemClick(Sender: TObject);
var
  Bitmap: TBitmap;
begin
  Bitmap := TBitmap.Create;
  try
    if EditGraphic(Bitmap, TBitmap, sNewBitmap) then begin
      if not Bitmap.Empty then
        FExpert.NewBitmapRes(nil, nil, Bitmap);
    end;
  finally
    Bitmap.Free;
  end;
end;

procedure TRxResourceEditor.NewIconItemClick(Sender: TObject);
var
  Stream: TStream;
begin
  OpenDlg.Filter := sIconFilesFilter + '|' + sCursorFilesFilter;
  OpenDlg.FileName := '';
  if OpenDlg.Execute then begin
    Stream := TFileStream.Create(OpenDlg.FileName, fmOpenRead +
      fmShareDenyNone);
    try
      FExpert.NewCursorIconRes(nil, nil, True, Stream);
    finally
      Stream.Free;
    end;
  end;
end;

procedure TRxResourceEditor.NewCursorItemClick(Sender: TObject);
var
  Stream: TStream;
begin
  OpenDlg.Filter := sCursorFilesFilter + '|' + sAniCursorFilesFilter;
  OpenDlg.FileName := '';
  if OpenDlg.Execute then begin
    if AnsiCompareText(ExtractFileExt(OpenDlg.FileName), '.ani') = 0 then begin
      Stream := TMemoryStream.Create;
      try
        TMemoryStream(Stream).LoadFromFile(OpenDlg.FileName);
        FExpert.NewBinaryRes(nil, nil, RT_ANICURSOR, TMemoryStream(Stream));
      finally
        Stream.Free;
      end;
    end
    else begin
      Stream := TFileStream.Create(OpenDlg.FileName, fmOpenRead +
        fmShareDenyNone);
      try
        FExpert.NewCursorIconRes(nil, nil, False, Stream);
      finally
        Stream.Free;
      end;
    end;
  end;
end;

procedure TRxResourceEditor.CheckResourceType(Sender: TObject;
  var TypeName: string; var Apply: Boolean);
begin
  TypeName := AnsiUpperCase(TypeName);
  Apply := IsValidResType(TypeName) or (TypeName = ResTypeName(RT_RCDATA));
  if not Apply then
    raise Exception.Create(Format(sInvalidType, [TypeName]));
end;

function TRxResourceEditor.GetResourceTypeName: string;
var
  I: Integer;
  Entry: TResourceEntry;
begin
  Result := ResTypeName(RT_RCDATA);
  with TInputBox.Create(Application) do
  try
    Value := Result;
    Caption := SNewResource;
    Prompt := sResType;
    OnApply := CheckResourceType;
    with FExpert do
      for I := 0 to FResourceList.Count - 1 do begin
        Entry := TResourceEntry(FResourceList.Objects[I]);
        if (Entry <> nil) and (Entry.FResType in [rtpCustom, rtpRCData]) then
          if Strings.IndexOf(ResTypeName(Entry.GetResourceType)) < 0 then
            Strings.Add(ResTypeName(Entry.GetResourceType));
      end;
    if Execute then Result := Value
    else Result := '';
  finally
    Free;
  end;
end;

procedure TRxResourceEditor.NewUserDataItemClick(Sender: TObject);
var
  Mem: TMemoryStream;
  TypeName: string;
  Code: Integer;
  Id: Word;
  P: PChar;
begin
  TypeName := AnsiUpperCase(GetResourceTypeName);
  if TypeName = '' then Exit;
  Val(TypeName, Id, Code);
  if TypeName = ResTypeName(RT_RCDATA) then P := RT_RCDATA
  else if Code = 0 then P := MakeIntResource(Id)
  else P := PChar(TypeName);
  OpenDlg.Filter := sAllFilesFilter;
  OpenDlg.FileName := '';
  if OpenDlg.Execute then begin
    Mem := TMemoryStream.Create;
    try
      Mem.LoadFromFile(OpenDlg.FileName);
      FExpert.NewBinaryRes(nil, nil, P, Mem);
    finally
      Mem.Free;
    end;
  end;
end;

procedure TRxResourceEditor.PreviewItemClick(Sender: TObject);
begin
  { not implemented yet, item is invisible }
end;

procedure TRxResourceEditor.SaveItemClick(Sender: TObject);
var
  Node: TTreeNode;
  ResFile: TIResourceFile;
  Entry: TResourceEntry;
  Graphic: TGraphic;
  Stream: TStream;
begin
  { save resource }
  Node := ResTree.Selected;
  if Node <> nil then begin
    Entry := TResourceEntry(Node.Data);
    if (Entry <> nil) then begin
      with SaveDlg do begin
        case Entry.FResType of
          rtpGroupCursor:
            begin
              Filter := sCursorFilesFilter + '|' + sAllFilesFilter;
              DefaultExt := 'cur';
            end;
          rtpGroupIcon:
            begin
              Filter := sIconFilesFilter + '|' + sAllFilesFilter;
              DefaultExt := GraphicExtension(TIcon);
            end;
          rtpBitmap:
            begin
              Filter := GraphicFilter(TBitmap) + '|' + sAllFilesFilter;
              DefaultExt := GraphicExtension(TBitmap);
            end;
          rtpAniCursor:
            begin
              Filter := sAniCursorFilesFilter + '|' + sAllFilesFilter;
              DefaultExt := 'ani';
            end;
          else
            begin
              Filter := sAllFilesFilter;
              DefaultExt := '';
            end;
        end;
        FileName := '';
      end;
      if SaveDlg.Execute then begin
        ResFile := FExpert.GetResFile;
        try
          case Entry.FResType of
            rtpBitmap:
              begin
                Graphic := Entry.GetGraphic(ResFile);
                try
                  Graphic.SaveToFile(SaveDlg.FileName);
                finally
                  Graphic.Free;
                end;
              end;
            rtpGroupCursor, rtpGroupIcon,
            rtpAniCursor, rtpRCData, rtpCustom:
              begin
                Stream := TFileStream.Create(SaveDlg.FileName, fmCreate);
                try
                  if Entry.FResType in [rtpGroupCursor, rtpGroupIcon]