{
Date: Thu, 3 Oct 1996 08:31:06 -0500 (CDT)
From: arnout@odin.mdacc.tmc.edu (Arnout Ruifrok)
To: Multiple recipients of list <nih-image@Soils.Umn.EDU>
Subject: Re: Feature AND

>Dear Imagers,
>
>I am working with Photographic images in order to do 3D reconstruction of
>a porous medium. I am needing urgently a procedure of making the
>logical operation: Feature AND.
>Can you tell me how can i do it or where can i find it?

The following macro will do the trick, although not very fast (but very
cheap). This is a slightly adapted version from the original 'feature-add'
macro. My apologies to the original author, I lost his name.

Arnout C. C. Ruifrok

Reference: "The Image Processing Handbook" by John Russ
}

var
  Pid1, Pid2: integer;

procedure FeatureAnd (Pic1st, Pic2nd);
var
  i : integer;
  OldBlackArea1, NewBlackArea1,OldBlackArea2, NewBlackArea2, : real;
begin
  i := 1;
  ImageMath('and', Pic1st, Pic2nd, 1, 0, 'feature and-1');
  Pid1 := Pidnumber;
  Duplicate('feature and-2');
  Pid2 := PidNumber;
  SelectAll;
  SetBinaryCount (1);
  Measure;
  NewBlackArea := histogram [255];

  ScaleMath(False);
    repeat
       i := i+1;
        OldBlackArea1 := NewBlackArea1;
        OldBlackArea2 := NewBlackArea2;
       ChoosePic(Pid1);
       dilate;
       ChoosePic(pic1st);
       SelectAll;
       Copy;
       ChoosePic(Pid1);
       SelectAll;
       Paste;
       SetOption;
       DoAnd;
       Measure;
       NewBlackArea1 := histogram [255];
       ResetCounter;
       ChoosePic(Pid2);
       dilate;
       ChoosePic(pic2nd);
       SelectAll;
       Copy;
       ChoosePic(Pid2);
       SelectAll;
       Paste;
       SetOption;
       DoAnd;
       Measure;
       NewBlackArea2 := histogram [255];
       ResetCounter;

    until (OldBlackArea1 = NewBlackArea1) AND (OldBlackArea2 = NewBlackArea2);
end;

Macro 'Feature-And';
begin
  if nPics <> 2 then
     exit('Two binary images required.');
  SetCursor ('watch');
  FeatureAnd (1, 2);
  SetCursor ('arrow');
  PutMessage ('ready');
  SelectPic (Pid1);
end;

Macro 'Feature-Xor';
begin
  if nPics <> 2 then
     exit('Two binary images required.');
  SetCursor ('watch');
  FeatureAnd (1,2);
  ChoosePic(1);
  SelectAll;
  Copy;
  ChoosePic(Pid1);
  Paste;
  SetOption;
  DoXor;
  ChoosePic(2);
  SelectAll;
  Copy;
  ChoosePic(Pid2);
  Paste;
  SetOption;
  DoXor;
end