procedure rmath(case:integer); var pid:integer; value:real; begin pid:=PidNumber; value:=GetNumber('Constant:', 10.0); if case=1 then ImageMath('copy', pid, pid, 1, value, pid) else if case=2 then ImageMath('copy real', pid, pid, 1, value, 'Real Result') else if case=3 then ImageMath('copy', pid, pid, value, 0, pid) else ImageMath('copy real', pid, pid, value, 0, 'Real Result'); end; macro 'Add Constant - 8-bit resultÉ'; begin rmath(1); end; macro 'Add Constant - real resultÉ'; begin rmath(2); end; macro 'Multiply by Constant - 8-bit resultÉ'; begin rmath(3); end; macro 'Multiply by Constant - real resultÉ'; begin rmath(4); end; macro '(---'; begin end; procedure StackMath(op: string); {Performs, slice by slice, the specied operation on two stacks and stores the result in the second stack.} var i, d1, d2, d3, scale: integer; offset, result: real; begin if nPics<>2 then begin PutMessage('This macro operates on exactly two stacks.'); exit; end; SelectPic(1); KillRoi; d1:=nSlices; SelectPic(2); KillRoi; d2:=nSlices; if d1<=d2 then d3:=d1 else d3:=d2; if d3<2 then begin PutMessage('This macro requires two stacks.'); exit; end; scale := 1.0; offset := 0.0; if op = 'add' then scale := 0.5 else if op = 'subtract' then begin scale := 0.5; offset := 128; end else if op = 'multiply' then scale := 1 else if op = 'divide' then scale := 255; if (op = 'add') or (op = 'subtract') or (op = 'multiply') or (op = 'divide') then scale := GetNumber('Scale factor:', scale); if op = 'subtract' then offset := GetNumber('Offset:', offset); SelectPic(2); result := PidNumber; for i:=1 to d3 do begin SelectPic(1); SelectSlice(i); SelectPic(2); SelectSlice(i); ImageMath(op, 1, 2, scale, offset, result); end; end; Macro 'Add Two Stacks'; begin StackMath('Add'); end; Macro 'Subtract Two Stacks'; begin StackMath('Subtract'); end; Macro 'Multiply Two Stacks'; begin StackMath('Multiply'); end; Macro 'Divide Two Stacks'; begin StackMath('Divide'); end; Macro 'AND Two Stacks'; begin StackMath('AND'); end; Macro 'OR Two Stacks'; begin StackMath('OR'); end; Macro 'Max of Two Stacks'; begin StackMath('Max'); end; Macro 'Min of Two Stacks'; begin StackMath('Min'); end; macro '(---'; begin end; macro 'Absolute Difference'; begin if nPics <> 2 then begin beep; PutMessage('Exactly two images required.'); exit; end; ImageMath('subtract', 1, 2, 1, 0, 'A-B'); ImageMath('subtract', 2, 1, 1, 0, 'B-A'); ImageMath('max', 3, 4, 1, 0, 'Absolute Difference'); SelectWindow('A-B'); Dispose; SelectWindow('B-A'); Dispose; end;