Script request - Copy/paste Areas to/from clipboard

Post Reply
Mke
Posts: 642
Joined: 15 Jun 14 14:39

Script request - Copy/paste Areas to/from clipboard

Post by Mke »

If someone has the time and ability, I'd love a script that can copy & paste face Areas to and from the clipboard.

I've (another) batch of photos coming up where I'll have many of the same people in multiple images, and being able to copy & paste Areas between them would save a significant amount of time, even after adjusting the Area positions in the destination photos.

I can also think of a few non-essential 'on paste' refinements that could be considered:
- if 0 People labels have already been assigned to an image, paste People labels + their Areas (obviously requiring People + Areas to be copied)
- if >0 People labels have already been assigned to an image, paste only the Areas corresponding to those people
- if the size of the pasted-to and pasted-from images differ by more than say 2%, pro-rata the size and position of the pasted Areas

Sadly this is way beyond my own coding ability :(

Can anyone help?
Hert
Posts: 7347
Joined: 13 Sep 03 6:24

Re: Script request - Copy/paste Areas to/from clipboard

Post by Hert »

Here is a script that allows copy/paste of areas.

There is one caveat, which is also the reason that this script will not be added to the repository and that is that after pasting you will have to move to another image and back before you see the change. A script cannot interact with the viewer.

Code: Select all

const
  cPreIDStr  = 'psu_areas_';
  cPostIDStr = '_psu_areas_end';

var
  ClipboardStr: WideString;

  procedure HandleCopyToClipboard(ACatItem: TCatalogItem);
  var
    AAreas: TCatalogAreas;
  begin
    AAreas := TCatalogAreas.Create(TCatalogArea, '');
    try
      if PublicCatalog.EnumAreasForItem(ACatItem, AAreas) then
      begin
        CopyTextToClipboard(cPreIDStr + AAreas.AsString + cPostIDStr);
        Say(IntToStr(AAreas.Count) + ' areas copied to clipboard');
      end;
    finally
      AAreas.Free;
    end;
  end;

  procedure HandlePasteFromClipboard(ACatItem: TCatalogItem);
  var
    AAreas: TCatalogAreas;
    AArea, AOldArea: TCatalogArea;
    AHit, i: Integer;
  begin
    AOldArea := TCatalogArea.Create(nil);
    AAreas := TCatalogAreas.Create(TCatalogArea, '');
    try
      AAreas.FromString(ClipboardStr);

      AHit := 0;
      for i := 0 to AAreas.Count - 1 do
      begin
        AArea := AAreas.Items[i];

        if PublicCatalog.FindAreaByGUID(AArea.GUID, AOldARea) then
        begin
          // do not allow pasting to the same image
          if AOldArea.ItemGUID = ACatItem.GUID then
            Continue;
        end;

        AArea.GUID := NewGUID;
        AArea.ItemGUID := ACatItem.GUID;
        PublicCatalog.UpdateArea(AArea);
        Inc(AHit);
      end;
    finally
      AAreas.Free;
      AOldArea.Free;
    end;

    Say(IntToStr(AHit) + ' areas pasted');
  end;

var
  ACatItem: TCatalogItem;
  ASl: TTntStringList;
  AChecked: Boolean;
  ARes: Integer;
begin
  if Selected.Count <> 1 then
  begin
    Say('Please select exactly one image.');
    exit;
  end;

  ASl := TTntStringList.Create;
  ACatItem := TCatalogItem.Create(nil);
  try
    if not PublicCatalog.FindImageCombined(Selected.Items[0], ACatItem, False, vptNone) then
    begin
      Say('Image not found in Catalog');
      exit;
    end;

    ASl.Add('Copy Areas to clipboard');
    ClipboardStr := CopyTextFromClipboard;
    if (LeftStr (ClipboardStr, Length(cPreIDStr))  = cPreIDStr) and
       (RightStr(ClipboardStr, Length(cPostIDStr)) = cPostIDStr)
    then
    begin
      ASl.Add('Paste Areas from clipboard');

      ClipboardStr := MidStr(ClipboardStr, Length(cPreIDStr) + 1, Length(ClipboardStr));
      ClipboardStr := MidStr(ClipboardStr, 1, Length(ClipboardStr) - Length(cPostIDStr));
    end
    else
      ClipboardStr := '';

    if ASl.Count = 1 then
      HandleCopyToClipboard(ACatItem)
    else
    begin
      AChecked := False;
      ARes := AskCustom(
                'What operation to perform?',
                '',
                '',   // 'info text'
                '',   // 'check this'
                AChecked,
                ASl
              );
      if ARes <> -1 then
      begin
        if ARes = 0 then
          HandleCopyToClipboard(ACatItem)
        else if ARes = 1 then
          HandlePasteFromClipboard(ACatItem)
        else
          Say('Unknown option selected');
      end;
    end;
  finally
    ACatItem.Free;
    ASl.Free;
  end;
end;
This is a user-to-user forum. If you need product support then please send a message
Hert
Posts: 7347
Joined: 13 Sep 03 6:24

Re: Script request - Copy/paste Areas to/from clipboard

Post by Hert »

The script above was just updated. If you had already copied it then please update.
This is a user-to-user forum. If you need product support then please send a message
Mke
Posts: 642
Joined: 15 Jun 14 14:39

Re: Script request - Copy/paste Areas to/from clipboard

Post by Mke »

Hi Hert,

Many thanks for taking a look at this - it's going to be very useful :)

...although at the moment, using the updated code, I'm unfortunately getting the following error message:

Syntax error.
Source position: 1,1
Hert
Posts: 7347
Joined: 13 Sep 03 6:24

Re: Script request - Copy/paste Areas to/from clipboard

Post by Hert »

I had copied in the message as code.
Please try again
This is a user-to-user forum. If you need product support then please send a message
Mke
Posts: 642
Joined: 15 Jun 14 14:39

Re: Script request - Copy/paste Areas to/from clipboard

Post by Mke »

Many thanks Hert - it works perfectly and is really appreciated!
Post Reply