Resource Basics

Resource Details

Author Information

Script

const
  cFormWidth  = 350;
  cFormHeight = 150;

var
  FThreshold: Integer;
  FAreaIndex: TStringList;

  AForm: TvxSceneForm;
  AFormCaption: String;
  AThreshold: TvxNumberBox;

function BuildForm: TvxSceneForm;
var
  ALabel: TvxLabel;
  AEdit: TvxTextBox;
  ACombo: TvxPopupBox;
  AOk: TvxButton;
  ASave: TvxButton;
  ALoad: TvxButton;
  AMacroButton: TvxButton;
  ASampleButton: TvxButton;
begin
  result := TvxSceneForm.Create(nil);
  result.Caption  := AFormCaption;
  result.Position := poScreenCenter;
  result.Width := Round(cFormWidth * result.DPIFactor);
  result.Height := Round(cFormHeight * result.DPIFactor);

  ALabel := TvxLabel.Create(result.Root);
  result.Root.AddObject(ALabel);
  ALabel.Text := 'Overlap Threshold %';
  ALabel.TextAlign := vgTextAlignNear;
  ALabel.Position.Point := vgPoint(20, 20);

  AEdit := TvxNumberBox.Create(result.Root);
  result.Root.AddObject(AEdit);
  TvxNumberBox(AEdit).Min := 1;
  TvxNumberBox(AEdit).Max := 100;
  AEdit.Width := 200;
  TvxNumberBox(AEdit).Value := FThreshold;
  AEdit.Position.Point := vgPoint(ALabel.Position.X, ALabel.Position.Y + ALabel.Height + 0);
  AThreshold := AEdit;

  AOk := TvxButton.Create(result.Root);
  result.Root.AddObject(AOk);
  AOk.ModalResult := mrOk;
  AOk.Position.Point := vgPoint(AEdit.Position.X, (result.Height / result.DPIFactor) - 10 - AOk.Height);
  AOk.Text := 'OK';
  AOk.Default := True;
end;

function Initialize: Boolean;
begin
  result := True;

  FAreaIndex := TStringList.Create;

  FHit := 0;
  FThreshold    := 10;  // allow overlap of 10%
  FThreshold    := ReadFromRegistry ('Scripts', 'FilterOverlapAreas', FThreshold);

  AFormCaption := 'Filter Overlapping Areas';
  AForm := BuildForm;
  AForm.ShowModal;
  result := (AForm.ModalResult = mrOk);
  if result then
    FThreshold := Trim(AThreshold.Value);
  AForm.Free;
end;

procedure Finalize;
var
  i: Integer;
begin
  WriteToRegistry ('Scripts', 'FilterOverlapAreas', FThreshold);

  for i := 0 to FAreaIndex.Count - 1 do
  begin
    FAreaIndex.Objects[i].Free;
    FAreaIndex.Objects[i] := nil;
  end;

  FAreaIndex.Free;
end;

function FindAreasForImage(AImage: TImageItem): TCatalogAreas;
var
  AIdx: Integer;
begin
  AIdx := FAreaIndex.IndexOf(AImage.GUID);
  if AIdx = -1 then
  begin
    result := TCatalogAreas.Create(TCatalogArea, '');
    FAreaIndex.AddObject(AImage.GUID, result);
    PublicCatalog.EnumAreasForImage(AImage, result);
  end
  else
    result := TCatalogAreas(FAreaIndex.Objects[AIdx]);
end;

function HasAreaOverlap(AAreas: TCatalogAreas; AThreshold: Integer): Boolean;
var
  i, j: Integer;
  ARect1, ARect2, AOverlap: TvxRect;
  ARect1Surface, ARect2Surface, AOverlapSurface: Double;
  AThresholdFactor: Double;
begin
  result := False;

  AThresholdFactor := AThreshold / 100;

  for i := 0 to AAreas.Count - 1 do
  begin
    ARect1 := vgRect(
                      AAreas.Items[i].AreaLeft,
                      AAreas.Items[i].AreaTop,
                      AAreas.Items[i].AreaRight,
                      AAreas.Items[i].AreaBottom
                    );
    ARect1Surface := vgRectWidth(ARect1) * vgRectHeight(ARect1);
    if ARect1Surface > 0.0 then
    begin
      for j := 0 to AAreas.Count - 1 do
      begin
        if i = j then Continue;

        ARect2 := vgRect(
                          AAreas.Items[j].AreaLeft,
                          AAreas.Items[j].AreaTop,
                          AAreas.Items[j].AreaRight,
                          AAreas.Items[j].AreaBottom
                        );

        ARect2Surface := vgRectWidth(ARect2) * vgRectHeight(ARect2);
        if ARect2Surface > 0.0 then
        begin
          AOverlap := vgRect(0, 0, 0, 0);
          if vgIntersectRect(AOverlap, ARect1, ARect2) then
          begin
            // check the threshold
            AOverlapSurface := vgRectWidth(AOverlap) * vgRectHeight(AOverlap);

            if (AOverlapSurface / ARect1Surface) > AThresholdFactor then
              result := True;
          end;
        end;

        if result then break;
      end;
    end;

    if result then break;
  end;
end;

procedure BeforeFilter;
begin
  Screen.Cursor := crHourglass;
end;

procedure AfterFilter;
begin
  Screen.Cursor := crDefault;
end;

function Filter(AItem: TImageItem): Boolean;
var
  AAreas: TCatalogAreas;
begin
  result := False;
  if (FThreshold < 0) or (FThreshold > 100) then
    exit;

  AAreas := FindAreasForImage(AItem);
  if AAreas.Count = 0 then
    exit;

  result := HasAreaOverlap(AAreas, FThreshold);
end;