/General-Purpose-Units/FMLImage.pas

Large files files are truncated, but you can click here to view the full file

unit FMLImage;

 // (*$Define General_Debug*)

// (*$DEFINE REVERSE_MODE*)

//(*$DEFINE DEBUG_MODE*)



interface

uses

  Windows, Classes, SysUtils, GeometryUnit,

  FeatureUnit, CollectionUnit, ComponentsUnit,

  ICLFeatureUnit, Graphics, MyTypes;

    

const

  UnknownPattern: Integer= 9999;

  UnImportantPattern: Integer= 9998;

type
  EFileNotFound= class (Exception);

  EInvalidImage= class (Exception);





  TByteFile= file of Byte;

  TInputKind= (ikNumeral, ikAlphabet, ikCheckBox, ikPicture, ikHelpBar);

  TMyBoolean= (mbTrue, mbFalse, mbUnSet);



  TFMLImage= class;

  TImageCollection= class;



  TImageType= (itMonoChrome, it8bit, it24bit, it32Bit, itNone);

  TBlackPixelCountInRow= Integer;

  TBlackPixelCountInColumn= Integer;

  TBlackPixelCountInRows= array of TBlackPixelCountInRow;

  TBlackPixelCountInColumns= array of TBlackPixelCountInColumn;



  TComponentCollection= class (TBaseCollection)

  private



    function GetComponent (Index: Integer): TComponent;

    function GetMaxPoint: TPoint;

    function GetMinPoint: TPoint;



    procedure FindMaxPoint;

    procedure FindMinPoint;

    procedure SetComponent (Index: Integer; const Value: TComponent);

  protected

    MinR, MinC, MaxR, MaxC: Integer;

    procedure AddComponent(Component: TComponent);



  public

    property Component [Index: Integer]: TComponent read GetComponent

      write SetComponent;

    property MinPoint: TPoint read GetMinPoint;

    property MaxPoint: TPoint read GetMaxPoint;



    constructor Create;

    destructor Destroy; override;



    function IsExists (r, c: Integer): Boolean;

    procedure RemoveInvalidComponents;

    procedure Delete (Index: Integer); override;



    procedure Add (NewComponent: TComponent);  

    procedure Clear; override;  



  end;



  TVector = class (TObject)

  private

    FLength: Extended;

    FTeta: Extended;

    Fx, Fy: Extended;

    function Getx: Extended;

    function Gety: Extended;

    

  public

    property Len: Extended read FLength;

    property Teta: Extended read FTeta;

    property x: Extended read Getx;

    property y: Extended read Gety;



    constructor Create; overload;

    constructor Create (r, Teta: Extended); overload;//Teta is in Degree;

    constructor CreateXY (x, y: Extended); overload;//Teta is in Degree;



    function Add (AnotherVector: TVector): TVector;//Create a new Vector

    function Multiply (ASize: Extended): TVector;//Create a new Vector



  end;



  TArrayofArrayofInt= array of array of Integer;

  TColoredImage= class;

  

  TBaseImage= class (TObject)

  private

    function GetPattern: Integer;

    function GetBodyColor (r, c: Integer): Integer;

    function GetScanLine (RowIndex: Integer): PInteger;



    procedure SetPattern (const Value: Integer);

    procedure SetRow (const Value: Integer);

    procedure SetColumn (const Value: Integer);

    procedure SetImageKind(const Value: TInputKind);



    function DoSmooth: TColoredImage;



  protected

    BLACK, WHITE: Integer;

    FBody: TArrayofArrayofInt;

    FRow, FColumn, FPattern: Integer;

    FImageKind: TInputKind;
    FIsBlank: TMyBoolean;
    HistogramIsCalced: Boolean;
    FImageType: TImageType;
    FBlackPixelCountInRows: TBlackPixelCountInRows;
    FBlackPixelCountInColumns: TBlackPixelCountInColumns;
    BlackPixCount: Integer;
    FCenterOfMass: TPoint;


    function NewInstance: TBaseImage; virtual; abstract;

  public

    function GetBlackColor: Integer; virtual; abstract;

    function GetWhiteColor: Integer; virtual; abstract;



    property ImageKind: TInputKind read FImageKind;

    (*ImageType determines how the image is stored in the FBody array*)

    property ImageType: TImageType read FImageType;

    property Pattern: Integer read GetPattern write SetPattern;

    property Row: Integer read FRow write SetRow;

    property Column: Integer read FColumn write SetColumn;

    property Kind: TInputKind read FImageKind write SetImageKind;

    property IsBlank: TMyBoolean read FIsBlank write FIsBlank;

    (*returns the value of pixel located in r and c*)

    property Body [r, c: Integer]: Integer read GetBodyColor;

    (*returns a pointer to the first integer in the rowindex'th row*)

    property ScanLine [RowIndex: Integer]: PInteger read GetScanLine;



    constructor Create (ImageType: TImageType= itMonoChrome);overload;

    destructor Destroy; override;



    procedure SaveAsBitmap (FileName: string);

    procedure LoadBitMap (FileName: String); overload;

    procedure LoadBitMap (Bitmap: TBitmap; Pattern: Integer= 9999);overload; virtual; abstract;

    function GetAsBitmap: TBitmap; virtual; abstract;



    (*Note than, FCenterofMass holds the sum of x and y of black pixels,

    not the centerofmass. Use this function to get COM.

    The ReCalc can be used to force the function to recalculates the

    COM*)

    function GetCenterOfMass (Recalc: Boolean= False):  TPoint;

    (*Returns the FBody array which stored the pixels of body.

      It can be used for fast work with pixels*)

    function GetBodyArray: TArrayofArrayofInt;



    (*Returns the ration of the black pixel in the column ColIndex by the BotRow- TopRow+ 1*)

    function IsHorizentalLineBlack (RowIndex: Integer; LeftCol, RightCol: Integer;

      Heigth: Integer= 1): Real;

    function IsVerticalLineBlack (ColIndex: Integer; TopRow, BotRow: Integer;

      Width: Integer= 1): Real;



    (*

      Copies a rectange from the image.

    *)

    function CopyPixels (TL, BR: TPoint): TBaseImage; virtual;



    (*Saves the image as text file.

      If the PrintBodyValue is false then it prints out the characters W and B.

      Otherwise, it prints the value of FBody.

      !!Note that PrintBodyValue= False  only works for images whose imagetype is itMonochrome*)

    procedure SaveAsText (FileName: String; PrintBodyValue: Boolean= False);



    (*Smoothes the image*)

    function Smooth (RepeatCount: Integer): TColoredImage;

    function ApplySobelAndGetGradiantIn8Dir: T8DirGradiantFeature;

    function GetSampleGradiantFor8Dir: TSampleGradiantIn8Dir;



    (*Returns the number of black pixel in the image. Current implementation

    doesn't look at Recalc and always re-calculate the value*)

    function BlackPixCountInImage (ReCalc: Boolean= False): Integer;

    

  end;



  TFMLImage= class (TBaseImage)

  private



    function RemoveColors(AColor: Integer): TFMLImage;



    procedure LoadPhotoCopiedImage (Bitmap: TBitmap); overload;



    function DeleteImage (NoiseColor: TColor; NoiseThr: Integer): TFMLImage;

    function FindAllComponents: TComponentCollection;

    function DoSmooth1: TFMLImage;

    function DoSmooth2: TFMLImage;



  protected

    function NewInstance: TBaseImage; override;

    

  public

    function GetBlackColor: Integer; override;

    function GetWhiteColor: Integer; override;



    (*Create an image whose black pixel are stored in PixelCollection.

    Note!! this constructor crops the image*)

    constructor Create (PixelCollection: TComponent);overload;

    (*Create an image whose black pixel are stored in ComponentCollection (which is a collection of PixelCollection)*)

    constructor Create (ComponentCollection: TComponentCollection);overload;

    (*Create an image whose black pixel are stored in a BlackPoints (which is a collection of TPoint)*)

    constructor Create (BlackPoints: TPointCollection);overload;



    (*Saves the image in the file whose handle in OutputFile by FML format*)

    procedure SaveInFMLFile (var OutputFile: TByteFile); overload;

    (*Saves the image in the stream whose handle in OutputStream by FML format*)

    procedure SaveInFMLStream (OutputStream: TFileStream); overload;

    (*Saves the image in the filename by FML Format*)

    procedure SaveInFMLFile (Filename: String); overload;



    (*Load an image which is filtered by photoshop "Photocopy" fileter.

      The pixels of transformation of an image under this filter will be

        0 or 255.*)

    procedure LoadPhotoCopiedImage (FileName: string); overload;



    procedure LoadBitMap (Bitmap: TBitmap; Pattern: Integer= 9999);override;



    procedure LoadFromFMLFile (var InputFile: TByteFile); overload;

    procedure LoadFromFMLStream (InputStream: TFileStream); 



    procedure LoadFromBMLFile (var InputFile: TByteFile); overload;

    procedure LoadFromBMLStream (InputStream: TFileStream);



    function GetAsBitmap: TBitmap; override;



    (*Adds the pixels in ImaePixels Component to the image (Self) and

      returns the self*)    

    function MixImage (ImagePixels: TComponent): TFMLImage;

    (*Sets the pixel in location r and c to black

      NOTE: This procedures do not perform range checking*)

    procedure SetPixelColor (r, c: Integer; NewColor: Integer); overload;

    procedure SetPixelColor (Point: TPoint; NewColor: Integer); overload;



    (*Clear the r'th row of the image

      NOTE: This procedure works when the ImageType is itMonochrome*)

    procedure ClearLine (r: Integer);

    (*Clear the c'th column of the image

      NOTE: This procedure works when the ImageType is itMonochrome*)

    procedure ClearColumn (c: Integer);



    (*Counts the black pixel in each row of image and returns them in an array.

    NOTE:: It works for Monochrome and 8 bit images. For 8 bit images, it calculates

    a threshold and ...*)

    function BlackPixelCountInRows: TBlackPixelCountInRows;

    function BlackPixelCountInColumns: TBlackPixelCountInColumns;



    (*

      This function finds all connected components () in the image using a BFS.

      TopLeft and BotRight indicate where the search area is and the boolean

      UseDialateBefExt indicates that if the image should be dialated or not.

    *)

    function FindAllComponentsInBox (TopLeft, BottomRight: TPoint): TComponentCollection;

    (*

      NOTE:: This procedure is not implemented Yet!!

    *)

    function FindAllComponentsHavePointInBox (TopLeft, BottomRight: TPoint): TComponentCollection;



    (*Dialtes the image and returns Self*)

    function Dilate (Mask: TArrayofArrayofInt): TFMLImage;

    (*Erodes the image and returns Self*)
    function Erode (Mask: TArrayofArrayofInt): TFMLImage;
    (*Apply Opening operator on the image and returns Self*)
    function Opening (Mask: TArrayofArrayofInt): TFMLImage;
    (*Apply Opening operator on the image and returns Self*)
    function Closing (Mask: TArrayofArrayofInt): TFMLImage;
    (*Apply Opening operator on the image and returns Self*)
    function HitAndMiss (Mask: TArrayofArrayofInt): TFMLImage;

    (*Thicks the image and returns Self*)
    function ThickTheImage: TFMLImage;
    (*Thins the image and returns Self*)

    function ThinTheImage: TFMLImage;

    (*returns an estimate for the pen width*)

    function ImageThickness: Integer;

    

    (*Crops the image and returns self*)
    function Crop: TFMLImage;

    (*
      NOTE:: This procedure is not implemented Yet!!

    *)

    procedure Write (PrintToFile: Boolean= False; FileName: String= '');



    (*

      NOTE:: This procedure is not implemented Yet!!

    *)

    procedure Add (Component: TComponent);



    (*

      Copies the rows in the range TopRowIndex and BottomRowIndex, inclusivly.

    *)

    function CopyRows (TopRowIndex, BottomRowIndex: Integer): TFMLImage;

    (*

      Rotates the image, and return the rotated image. 

      NOTE:: This function only works with it8bit images.

    *)

    function Rotate (AngleInDeg: Integer): TFMLImage;



    (*Resizes the image

    NOTE:: These functions are <B>not suitable</B> when one wants to shrink the image *)

    function Resize (NewRow, NewColumn: Integer): TFMLImage;

    (*Resizes the image*)

    function NewResize (NewRow, NewColumn: Integer; SaveAspectRatio: Boolean= False): TFMLImage;



    function GetComponentByOnePoint (APoint: TPoint): TComponent;





    function ExtractFeatures (NewSize: Integer; SmoothDegree: Integer;

       NumberOfMasks: Integer= 5): TFeatureVectorBasedOnGradiant; virtual;      

    function ExtractFreemanFeature: TFreemanFeature; virtual;



    (*Deletes a row from image*)

    procedure DeleteRow (Index: Integer);

    procedure DeleteRowsInRange (TopIndex, BotIndex: Integer);

    (*NOTE:: This function does not update the center of mass*)

    procedure DeleteColumnsInRange (TopIndex, BotIndex: Integer);



    (*Deletes the rows who have more than Percentage black pixel in them*)

    procedure DeleteVerticalBlackLine (Percentage: Extended= 1/2);

    procedure DeleteHorizentalBlackLine (Percentage: Extended= 1/2);



    (*Reverse the color of an FML Image, flip the WHITE pixels to BLACK and

      vice versa, and returns Self*)

    function ReverseColor: TFMLImage;



    destructor Destroy; override;



    function Copy (TL, BR: TPoint): TFMLImage;



  end;



  TColoredImage= class (TBaseImage)

  private



    procedure CalculateHistogram;

    function GetHistogram(Color: Integer): Integer;





  protected

    FHistogram: array [0..255] of Integer;

    function NewInstance: TBaseImage; override;



  public

    (*Histogram returns the number of occurence of each color. It only works when ImageType= it8bit*)

    property Histogram [Color: Integer]: Integer read GetHistogram;



    (*This function returns a new bitmap in Monochrome style, but doesn't change

     the image itself*)

    function ConvertToGrayScale: TColoredImage;

    (*Find a threshold for convertToBinary. It works for the images whose ImageType is it8Bit, only*)

    function GrayThreshold: Integer;



    function ConvertToBinary: TFMLImage;



    procedure LoadBitmap (Bitmap: TBitmap; Pattern: Integer= 9999); override;



    (*Returns a 8 or 24 bits Bitmap image*)

    function GetAsBitmap: TBitmap; override;



    constructor Create (ImageType: TImageType);

    function Copy (TL, BR: TPoint): TColoredImage;



    function GetBlackColor: Integer; override;

    function GetWhiteColor: Integer; override;



  end;



  TImageCollection= class (TBaseCollection)

  private
    function GetImageNumber: Integer;
    function GetImage (Index: Integer): TFMLImage;

  public
    property ImageNumber: Integer read GetImageNumber;
    property Image [Index: Integer]: TFMLImage read GetImage;

    procedure LoadFromFMLFile (FileName: string);
    procedure LoadFromBMLFile (FileName: string);
    procedure SaveToFile (FileName: string);
    procedure SaveFilesAsBitmap (BaseFileName: String);
    procedure AddImage (Image: TFMLImage);
    procedure AddImageCollection (ImageCollection: TimageCollection);
    procedure Dilate (Mask: TArrayofArrayofInt);

    constructor Create; overload;
    
    function ExtractAllImagesFeatures (NewSize, SmoothDegree: Integer): TFeatureVectorBasedOnGradiantCollection;
    function GetAllWithPattern (PatternIndex: Integer): TImageCollection;
    
  end;

implementation
uses

  {Borland.Vcl.Controls, System.Xml.XPath, }

  

  Math, ExceptionUnit, TypInfo, VectorUnit, JPeg;

  

type

  EFMLImageNotInitialized= class (Exception);

  ERangeCheckError= class (Exception);



  TArrArrInt= array of array of Integer;

  TArrInt= array of Integer;



function MyArcTan (x, y: Extended): Extended;//Result is in Degree.

begin

  if abs (x)< 1e-10 then

  begin

    if y< 0 then

      Result:= 3* Pi/ 2.0

    else

      Result:= Pi/ 2.0;



  end

  else

    Result:= ArcTan2 (x, y);



end;



function TFMLImage.GetAsBitmap: TBitmap;

var

//  Temp: Byte;

  r, c: Integer;

  PixPtr: PInteger;

  RowPtr: PByte;



begin

  Result:= TBitmap.Create;



  if IsBlank= mbTrue then

  begin

    Result.Width:= 1;

    Result.Height:= 1;

    Result.Monochrome:= True;

    Exit;



  end;



  if ImageType= itMonoChrome then

  begin

    Result.PixelFormat:= pf1bit;

    Result.Monochrome:= True;

    Result.Height:= FRow;

    Result.Width:= FColumn;





    for r:= 0 to Row- 1 do

    begin

      RowPtr:= Result.ScanLine [r];

      PixPtr:= @FBody [r, 0];

      RowPtr^:= 0;

      c:= 0;



      while c< FColumn do

      begin

        RowPtr^:= (1- PixPtr^) shl (7- c mod 8)+ RowPtr^;



        Inc (PixPtr);

        Inc (c);

        if c mod 8= 0 then

        begin

          Inc (RowPtr);

          RowPtr^:= 0;



        end;



      end;



    end;



  end

  else

    raise EInvalidImage.Create ('MonoChrome Image is needed');



end;



{

procedure TFMLImage.Load (var InputHandle: &File);

var

  r, c: Integer;

  b1, b2: Byte;

begin

  Read (InputHandle, b1, b2);

  Pattern:= b1+ b2 shl 8;



  b1:= Row mod 256;
  b2:= Row div 256;
  Write (InputHandle, b1, b2);

  b1:= Column mod 256;
  b2:= Column div 256;
  Write (InputHandle, b1, b2);

  for r:= 0 to Row- 1 do
    for c:= 0 to Column do
    begin
      b1:= FBody [r][c] mod 256;
      b2:= FBody [r][c] div 256;
      Write (InputHandle, b1, b2);
    end;
  b1:= 255;
  b2:= 255;
  Write (InputHandle, b1, b2);
end;

 }



procedure TFMLImage.LoadBitMap (Bitmap: TBitmap; Pattern: Integer);

var

  r, c, i: Integer;

  PixPtr: PInteger;

  RowPtr: PByte;

  cIndex: Integer;



begin

  Row:= Bitmap.Height;

  Column:= Bitmap.Width;

  

  if FCenterOfMass<> nil then

    FCenterOfMass.Free;

  FCenterOfMass:= TPoint.Create (0, 0);



  BlackPixCount:= 0;



  if Bitmap.PixelFormat= pf1bit then

  begin

    FImageType:= itMonoChrome;



    for r:= 0 to FRow- 1 do

    begin

      RowPtr:= Bitmap.ScanLine [r];

      PixPtr:= ScanLine [r];



      cIndex:= 0;

      for c:= 0 to (FColumn- 1) div 8- 1 do

      begin

        for i:= 0 to 7 do

        begin



 (*$IFNDEF REVERSE_MODE*)

          if (RowPtr^ shr (7- i)) and 1= 1 then

          begin

            PixPtr^:= BLACK;

            FCenterOfMass.Move (r, cIndex);

            Inc (BlackPixCount);



          end

          else

            PixPtr^:= WHITE;



 (*$ELSE*)

          if (RowPtr^ shr (7- i)) and 1= 0 then

          begin

            PixPtr^:= BLACK;

            FCenterOfMass.Move (r, cIndex);

            Inc (BlackPixCount);



          end

          else

              PixPtr^:= WHITE;

 (*$ENDIF*)



          Inc (cIndex);

          Inc (PixPtr);



        end;

        Inc (RowPtr);



      end;

      

      for i:= 0 to (FColumn- 1) mod 8 do

      begin



 (*$IFNDEF REVERSE_MODE*)

        if (RowPtr^ shr (7- i)) and 1= 1 then

        begin

          PixPtr^:= BLACK;

          FCenterOfMass.Move (r, cIndex);

          Inc (BlackPixCount);



        end

        else

          PixPtr^:= WHITE;

 (*$ELSE*)

        if (RowPtr^ shr (7- i)) and 1= 0 then

        begin

          PixPtr^:= BLACK;

          FCenterOfMass.Move (r, cIndex);

          Inc (BlackPixCount);



        end

        else

            PixPtr^:= WHITE;

 (*$ENDIF*)



        Inc (cIndex);

        Inc (PixPtr);

        

      end;

      

    end;

    

  end

  else

    raise Exception.Create ('Invalid filetype!');



  FPattern:= Pattern;

  

end;



{ TImageCollection }



procedure TImageCollection.AddImage (Image: TFMLImage);

begin

  inherited Add (Image);

  

end;



constructor TImageCollection.Create;

begin

  inherited;

  

end;



procedure TImageCollection.Dilate (Mask: TArrayofArrayofInt);

var

  i: Integer;

  Ptr: PObject;

  

begin

  Ptr:= GetPointerToFirst;

  

  for i:= 1 to Size do

  begin

    TFMLImage (Ptr^).Dilate (Mask);

    Inc (Ptr);

    

  end;





end;





function TImageCollection.ExtractAllImagesFeatures

    (NewSize, SmoothDegree: Integer): TFeatureVectorBasedOnGradiantCollection;

var

  i: Integer;



begin

  Result:= TFeatureVectorBasedOnGradiantCollection.Create;



  for i:= 0 to ImageNumber- 1 do

    Result.Add (Image [i].ExtractFeatures (NewSize, SmoothDegree));



end;



function TImageCollection.GetImage (Index: Integer): TFMLImage;

begin

  Result:= Member [Index] as TFMLImage;

  

end;



function TImageCollection.GetImageNumber: Integer;

begin

  Result:= Size;

  

end;



procedure TImageCollection.SaveToFile (FileName: string);

var

  i: Integer;

  OutputStream: TFileStream;

  b1, b2: Byte;

  

begin

  OutputStream:= TFileStream.Create (FileName, fmCreate);

{

  AssignFile (OutputFile, FileName);

  Rewrite (OutputFile);

}

  b1:= ImageNumber and 255;

  b2:= ImageNumber shr 8;

  OutputStream.Write (b1, 1);

  OutputStream.Write (b2, 1);

  

  for i:= 0 to ImageNumber- 1 do

    Image [i].SaveInFMLStream (OutputStream);



  OutputStream.Free;



end;



procedure TFMLImage.Write (PrintToFile: Boolean; FileName: String);

{var

  OutputFile: TextFile;

  i, j: Integer;

}

begin

  raise Exception.Create ('Not Implemented Yet!');

{

  if PrintToFile then

  begin

    AssignFile (OutputFile, FileName);

    Rewrite (OutputFile);

    for i:= 0 to Row- 1 do

    begin

      for j:= 0 to Column- 1 do

        Borland.Delphi.System.Write (OutputFile, Body [i, j]);

      Borland.Delphi.System.Writeln (OutputFile);

    end;



    Close (OutputFile);

  end;

  }

end;



function TFMLImage.Dilate (Mask: TArrayofArrayofInt): TFMLImage;

var

  NewBody: TArrayofArrayofInt;

  BodyPtr: PInteger;

  r, c,

  ir, ic,

  MaskRow, MaskCol: Integer;



begin

  Result:= Self;

  

  if IsBlank= mbTrue then

    Exit;

    

  MaskRow:= High (Mask);

  MaskCol:= High (Mask [0]);



  SetLength (NewBody, Row+ MaskRow);

  for r:= 0 to Row+ MaskRow- 1 do

  begin

    SetLength (NewBody [r], Column+ MaskCol);

    FillChar (NewBody [r, 0], SizeOf (NewBody [r]), WHITE);



  end;





  for r:= 0 to Row- 1 do

  begin

    BodyPtr:= ScanLine [r];

    

    for c:= 0 to Column- 1 do
    begin
      if BodyPtr^= BLACK then
        for ir:= 0 to MaskRow- 1 do
          for ic:= 0 to MaskCol- 1 do
            if Mask [ic, ic]= BLACK then
              NewBody [r+ ir, c+ ic]:= BLACK;

      Inc (BodyPtr);

    end;

  end;

  for r:= 0 to FRow- 1 do
    Move (NewBody [r][0], FBody [r][0], SizeOf (Integer)* FColumn);

  for r:= 0 to FRow+ MaskRow- 1 do

    SetLength (NewBody [r], 0);

  SetLength (NewBody, 0);



end;



function TFMLImage.Erode (Mask: TArrayofArrayofInt): TFMLImage;

var

  BodyPtr: PInteger;

  NewBody: TArrayofArrayofInt;

  r, c,

  ir, ic,

  MaskRow, MaskCol: Integer;



begin

  MaskRow:= Length (Mask);

  MaskCol:= Length (Mask [0]);



  SetLength (NewBody, Row);

  for r:= 0 to Row- 1 do

  begin

    SetLength (NewBody [r], FColumn);

    Move (FBody [r, 0], NewBody [r, 0], SizeOf (Integer)* FColumn);



  end;



  for r:= 0 to Row- MaskRow- 1 do
  begin
    BodyPtr:= ScanLine [r];

    for c:= 0 to Column- MaskCol- 1 do
    begin
      if BodyPtr^= WHITE then
        for ir:= 0 to MaskRow- 1 do
          for ic:= 0 to MaskCol- 1 do
            if Mask [ir, ic]= BLACK then
              NewBody [r+ ir, c+ ic]:= WHITE;
        
      Inc (BodyPtr);

    end;

  end;

  for r:= 0 to Row- 1 do
    SetLength (FBody [r], 0);
  SetLength (FBody, 0);

  FBody:= NewBody;
  Result:= Self;

end;

function TFMLImage.DeleteImage (NoiseColor: TColor; NoiseThr: Integer): TFMLImage;

begin

  raise ENotImplemented.Create ('TFMLImage.DeleteImage');



end;



constructor TFMLImage.Create (PixelCollection: TComponent);

var

  r, c,

  MinR, MinC,

  i: Integer;

  MinPoint, MaxPoint: TPoint;

  Pixel: TMyPixel;

  Ptr: PInteger;

  

begin

  inherited Create;



  FImageType:= itMonoChrome;

  HistogramIsCalced:= False;             

  FRow:= -1; FColumn:= -1; FPattern:= -1;

  FIsBlank:= mbUnSet;



  MinPoint:= PixelCollection.GetMinimum;

  MaxPoint:= PixelCollection.GetMaximum;

  MinC:= MinPoint.c; MinR:= MinPoint.r;



  Row:= MaxPoint.r- MinPoint.r+ 1;

  Column:= MaxPoint.c- MinPoint.c+ 1;



  for r:= 0 to Row- 1 do

  begin

    Ptr:= @FBody [r, 0];

    

    for c:= 0 to Column- 1 do

    begin

      Ptr^:= WHITE;

      Inc (Ptr);

      

    end;



  end;



  if PixelCollection.Count= 0 then

    FIsBlank:= mbTrue

  else

  begin

    FCenterOfMass:= TPoint.Create (0, 0);

    for i:= 0 to PixelCollection.Count- 1 do

    begin

      Pixel:= PixelCollection.GetPixel (i);

      FBody [Pixel.Location.r- MinR, Pixel.Location.c- MinC]:= BLACK;

      FCenterOfMass.Move (Pixel.Location);

      FCenterOfMass.Move (-MinR, -MinC);



    end;



  end;



  FPattern:= 0;

//  Self.SaveInFMLFile ('C:\ImageFromComp.FML');//??!!

  MinPoint.Free;

  MaxPoint.Free;



end;



constructor TFMLImage.Create (ComponentCollection: TComponentCollection);

var

  PixelCollection: TComponent;

  MinC, MinR,

  i, j: Integer;

  MinPoint, MaxPoint: TPoint;

  Pixel: TMyPixel;

  

begin

  inherited Create;



  FImageType:= itMonoChrome;

  HistogramIsCalced:= False;

  FRow:= -1; FColumn:= -1; FPattern:= UnImportantPattern;



  if ComponentCollection.Size= 0 then

  begin

    FIsBlank:= mbTrue;

    Exit;

    

  end

  else

    FIsBlank:= mbFalse;



  MinPoint:= ComponentCollection.MinPoint;

  MaxPoint:= ComponentCollection.MaxPoint;

  MinC:= MinPoint.c; MinR:= MinPoint.r;



  Row:= MaxPoint.r- MinPoint.r+ 1;

  Column:= MaxPoint.c- MinPoint.c+ 1;



  FCenterOfMass:= TPoint.Create (0, 0);

  

  for i:= 0 to ComponentCollection.Size- 1 do

  begin

    PixelCollection:= ComponentCollection.Component [i];



    for j:= 0 to PixelCollection.Count- 1 do

    begin

      Pixel:= PixelCollection.GetPixel (j);

      FBody [Pixel.Location.r- MinR, Pixel.Location.c- MinC]:= BLACK;

      FCenterOfMass.Move (Pixel.Location);



    end;



  end;

  

  MinPoint.Free;

  MaxPoint.Free;



end;



procedure TImageCollection.SaveFilesAsBitmap (BaseFileName: String);

var

  i: Integer;

  Ptr: PObject;



begin

  Ptr:= GetPointerToFirst;

  

  for i:= 1 to Size do

  begin

    TFMLImage (Ptr^).SaveAsBitmap (BaseFileName+ IntToStr (i)+ '.bmp');

    Inc (Ptr);

    

  end;

    

end;



procedure TImageCollection.LoadFromFMLFile (FileName: string);

var

  i: Integer;

  b1, b2: Byte;

  ImageNo: Integer;

  NewImage: TFMLImage;

  InputStream: TFileStream;

  Ptr: PObject;

  

begin

  if not FileExists (FileName) then

    raise EFileNotFound.Create (FileName);



  InputStream:= TFileStream.Create (FileName, fmOpenRead);

  InputStream.Read (b1, 1);

  InputStream.Read (b2, 1);

  ImageNo:= b1+ 256* b2;

  Allocate (ImageNo);



  Ptr:= GetPointerToFirst;

  for i:= 1 to ImageNo do

  begin

    NewImage:= TFMLImage.Create;

    NewImage.LoadFromFMLStream (InputStream);

    Ptr^:= NewImage;

    Inc (Ptr);

    

  end;



  InputStream.Free;

  

end;



function TImageCollection.GetAllWithPattern (

  PatternIndex: Integer): TImageCollection;

var

  i: Integer;



begin

  Result:= TImageCollection.Create;



  for i:= 0 to Size- 1 do

    if Image [i].Pattern= PatternIndex then

      Result.AddImage (Image [i]);



end;





procedure TFMLImage.Add (Component: TComponent);

begin

  raise ENotImplemented.Create ('TFMLImage.Add (Component: TComponent)');

{

  if FRow< Component.MaxX then

    for i:= 0 to Component.Count- 1 do

    begin

    end;

}  

end;



procedure TFMLImage.SetPixelColor (r, c: Integer; NewColor: Integer);

begin

  FBody [r, c]:= NewColor;



end;



procedure TFMLImage.SetPixelColor (Point: TPoint; NewColor: Integer);

begin

  FBody [Point.r, Point.c]:= NewColor;

    

end;





function TFMLImage.FindAllComponentsInBox (TopLeft, BottomRight: TPoint): TComponentCollection;

(*$J+*)

const

  P1: TPoint= nil;

  P2: TPoint= nil;

(*$J-*)



var

  NewImage: TFMLImage;



begin

  if P1= nil then

  begin

    P1:= TPoint.Create;

    P2:= TPoint.Create;

    

  end;



  P1.r:= Max (0, TopLeft.r);

  P1.c:= Max (0, TopLeft.c);

  P2.r:= Min (Row- 1, BottomRight.r);

  P2.c:= Min (Column- 1, BottomRight.c);

      

  NewImage:= Self.Copy (P1, P2);



  

(*$IFDEF DEBUG_MODE*)

  NewImage.SaveInFMLFile ('C:\Temp.FML');

(*$ENDIF*)



  Result:= NewImage.FindAllComponents;

  

  NewImage.Free;

  

end;



function TFMLImage.FindAllComponents: TComponentCollection;

var

  i, j, Turn,

  MaxCompIndex,

  r, c: Integer;

  PixPtr, LeftPixPtr,

  UpPixPtr, UpperLeftPixPtr,

  UpperRightPixPtr: PInteger;

  CurRowPtr,

  CurLeftPtr, LastRowPtr, LastLeftRowPtr,

  LastRightRowPtr

  : PInteger;

  ActiveComponent: TComponent;

  IsCopied: array of Boolean;

  LastRow, CurRow: TIntegerArray;

  CompPtr: PObject;

  ToBeReplacedComponent,

  ToBeRemovedComponent: TComponent;

  

(*$J+*)

const

  Rows: array [0..1] of TIntegerArray= (nil, nil);

  PtrArray: array [0..3] of ^PInteger= (nil, nil, nil, nil);

(*$J-*)

begin



  if Length (Rows [0])< FColumn then

  begin

    SetLength (Rows [0], FColumn);

    SetLength (Rows [1], FColumn);



  end;



  Result:= TComponentCollection.Create;



  FillChar (Rows [0, 0], SizeOf (Integer)* Length (Rows [0]), 255);

  FillChar (Rows [1, 0], SizeOf (Integer)* Length (Rows [1]), 255);



  PixPtr:= @FBody [0, 0];

  ActiveComponent:= nil;



  Turn:= 0;

  CurRow:= Rows [Turn];

  c:= 0;

//c is 0 and r is also 0

  if PixPtr^= BLACK then

  begin

    ActiveComponent:= TComponent.Create (Result.Size);

    ActiveComponent.Add (0, c);



    Result.Add (ActiveComponent);

    CurRow [c]:= Result.Size- 1;



  end;

  

  for c:= 1 to FColumn- 1 do

  begin

    LeftPixPtr:= PixPtr;

    Inc (PixPtr);



    if PixPtr^= BLACK then

    begin

      if LeftPixPtr^= BLACK then

      begin

        ActiveComponent.Add (0, c);

        CurRow [c]:= CurRow [c- 1];



      end

      else

      begin

        ActiveComponent:= TComponent.Create (Result.Size);

        ActiveComponent.Add (0, c);



        Result.Add (ActiveComponent);

        CurRow [c]:= Result.Size- 1;



      end;



    end

    else

     CurRow [c]:= -1;



  end;



  LastRow:= nil;

  PtrArray [0]:= @CurLeftPtr;

  PtrArray [1]:= @LastRowPtr;

  PtrArray [2]:= @LastLeftRowPtr;

  PtrArray [3]:= @LastRightRowPtr;



  for r:= 1 to FRow- 1 do

  begin

    Turn:= Turn xor 1;

    LastRow:= CurRow;

    CurRow:= Rows [Turn];



    PixPtr:= ScanLine [r];

    UpPixPtr:= ScanLine [r- 1];



    CurRowPtr:= @CurRow [0];

    LastRowPtr:= @LastRow [0];



    if PixPtr^= BLACK then

    begin

      if UpPixPtr^= Black then

      begin

        Result.Component [LastRowPtr^].Add (r, 0);

        CurRowPtr^:= LastRowPtr^;



      end

      else

      begin

        ActiveComponent:= TComponent.Create (Result.Size);

        ActiveComponent.Add (r, 0);



        Result.Add (ActiveComponent);

        CurRowPtr^:= Result.Size- 1;



      end;



    end;



    for c:= 1 to FColumn- 2 do

    begin

//      LeftPixPtr:= PixPtr;

//      UpperLeftPixPtr:= UpPixPtr;

      Inc (PixPtr);

//      Inc (UpPixPtr);



      CurLeftPtr:= CurRowPtr;

      LastLeftRowPtr:= LastRowPtr;

      Inc (CurRowPtr);

      Inc (LastRowPtr);

      LastRightRowPtr:= LastRowPtr;

      Inc (LastRightRowPtr);



      if PixPtr^= BLACK then

      begin

        MaxCompIndex:= Max (Max (CurLeftPtr^, LastRowPtr^),

          Max (LastLeftRowPtr^, LastRightRowPtr^));



        if MaxCompIndex= -1 then// All visited adjanced are white

        begin

          ActiveComponent:= TComponent.Create (Result.Size);

          ActiveComponent.Add (r, c);



          Result.AddComponent (ActiveComponent);

          CurRowPtr^:= Result.Size- 1;



        end

        else

        begin

          Result.Component [MaxCompIndex].Add (r, c);

          CurRowPtr^:= MaxCompIndex;



          for i:= 0 to 3 do

            if (PtrArray [i]^^<> -1) and  (PtrArray [i]^^<> MaxCompIndex) then

            begin

              Result.Component [MaxCompIndex].Merge (Result.Component [PtrArray [i]^^]);

              ToBeReplacedComponent:= Result.Component [MaxCompIndex];

              ToBeRemovedComponent:= Result.Component [PtrArray [i]^^];

              if ToBeReplacedComponent.ID<> ToBeRemovedComponent.ID then

              begin

                CompPtr:= Result.GetPointerToFirst;

                for j:= 1 to Result.Size  do

                begin

                  if CompPtr^= ToBeRemovedComponent then

                    CompPtr^:= ToBeReplacedComponent;

                  Inc (CompPtr);



                end;

                ToBeRemovedComponent.Free;



              end;

              

            end;



        end;



      end

      else

        CurRowPtr^:= -1;



    end;

    

    c:= FColumn- 1;

//    LeftPixPtr:= PixPtr;

//    UpperLeftPixPtr:= UpPixPtr;

    Inc (PixPtr);

//    Inc (UpPixPtr);



    CurLeftPtr:= CurRowPtr;

    LastLeftRowPtr:= LastRowPtr;

    Inc (CurRowPtr);

    Inc (LastRowPtr);

    

    if PixPtr^= BLACK then

    begin

      MaxCompIndex:= Max (Max (CurLeftPtr^, LastRowPtr^),

        LastLeftRowPtr^);



      if MaxCompIndex= -1 then// All visited adjanced are white

      begin

        ActiveComponent:= TComponent.Create (Result.Size);

        ActiveComponent.Add (r, c);



        Result.AddComponent (ActiveComponent);

        CurRowPtr^:= Result.Size- 1;



      end

      else

      begin

        Result.Component [MaxCompIndex].Add (r, c);

        CurRowPtr^:= MaxCompIndex;



        for i:= 0 to 2 do

          if (PtrArray [i]^^<> -1) and  (PtrArray [i]^^<> MaxCompIndex) then

          begin

            Result.Component [MaxCompIndex].Merge (Result.Component [PtrArray [i]^^]);

            ToBeReplacedComponent:= Result.Component [MaxCompIndex];

            ToBeRemovedComponent:= Result.Component [PtrArray [i]^^];

            if ToBeReplacedComponent.ID<> ToBeRemovedComponent.ID then

            begin

              CompPtr:= Result.GetPointerToFirst;

              for j:= 1 to Result.Size  do

              begin

                if CompPtr^= ToBeRemovedComponent then

                  CompPtr^:= ToBeReplacedComponent;

                Inc (CompPtr);



              end;

              ToBeRemovedComponent.Free;



            end;

              

          end;



      end;



    end;



  end;



  if Length (IsCopied)< Result.Size+ 1 then

    SetLength (IsCopied, Result.Size+ 1);

  FillChar (IsCopied [0], SizeOf (IsCopied), 0);



  CompPtr:= Result.GetPointerToFirst;

  j:= 0;

  for i:= 1 to Result.Size do

  begin

    if not IsCopied [TComponent (CompPtr^).ID] then

    begin

      Result.Component [j]:= TComponent (CompPtr^);

      Inc (j);

//      WriteLn (i, ' Saved: ', Result.FComponents [i].ID);

      IsCopied [TComponent (CompPtr^).ID]:= True;



    end;

    

    Inc (CompPtr);

    

  end;



  CompPtr:= Result.GetPointerToFirst;

  Inc (CompPtr, j);

  for i:= j to Result.Size- 1 do

  begin

    CompPtr^:= nil;

    Inc (CompPtr);

    

  end;

  Result.Allocate (j);



end;



procedure TBaseImage.SaveAsText (FileName: String; PrintBodyValue: Boolean);

var

  r, c: Integer;

  OutputFile: TextFile;



begin

  AssignFile (OutputFile, FileName);

  Rewrite (OutputFile);

  

  if FImageType= itMonoChrome then

    for r:= 0 to FRow- 1 do

    begin

      for c:= 0 to FColumn- 1 do

        if FBody [r, c]= WHITE then

          if PrintBodyValue then

            System.Write (OutputFile, ' (', FBody [r, c], ')')

          else

            System.Write (OutputFile, 'W')

        else

          if PrintBodyValue then

            System.Write (OutputFile, ' (', FBody [r, c], ')')

          else

            System.Write (OutputFile, 'B');



      Writeln (OutputFile);

    

    end

    

  else

  if FImageType= it8bit then

    for r:= 0 to FRow- 1 do

    begin

      for c:= 0 to FColumn- 1 do

        System.Write (OutputFile, ' (', FBody [r, c], ')');

      Writeln (OutputFile);

    

    end

    

  else

    raise EInvalidImage.Create ('The image format should be monochrome');

    

  CloseFile (OutputFile);



end;



function TFMLImage.FindAllComponentsHavePointInBox (TopLeft, BottomRight: TPoint):

  TComponentCollection;

begin

  raise ENotImplemented.Create ('FindAllComponentsHavePointInBox (');



end;



function TFMLImage.ExtractFeatures (NewSize: Integer; SmoothDegree: Integer;

       NumberOfMasks: Integer): TFeatureVectorBasedOnGradiant;

var

  ResizedImage: TFMLImage;

  SmoothedImage: TColoredImage;

  GradiantIn8Dir: T8DirGradiantFeature;



begin

  ResizedImage:= Self.NewResize (NewSize, NewSize, True);

 (*$IFDEF DEBUG_MODE*)

  ResizedImage.SaveAsText ('C:\Resized.00.txt');

 (*$ENDIF DEBUG_MODE*)



  SmoothedImage:= ResizedImage.Smooth (SmoothDegree);

 (*$IFDEF DEBUG_MODE*)

  SmoothedImage.ConvertToBinary.SaveAsText ('C:\Smoothed.00.txt');

  SmoothedImage.SaveAsBitmap ('C:\SmoothedImage.bmp');

 (*$ENDIF DEBUG_MODE*)



  GradiantIn8Dir:= SmoothedImage.ApplySobelAndGetGradiantIn8Dir;

  Result:= GradiantIn8Dir.SampleGradiant (NumberOfMasks);



  GradiantIn8Dir.Free;

  SmoothedImage.Free;

  ResizedImage.Free;



end;



function TBaseImage.Smooth (RepeatCount: Integer): TColoredImage;

var

  TempImage: TColoredImage;

  i: Integer;



begin

  if 0< RepeatCount then

  begin

    TempImage:= Self.DoSmooth;

    

    Result:= TempImage;

    

    for i:= 2 to RepeatCount do

    begin

      (*$IFDEF DEBUG_MODE*)

        TempImage.ConvertToBinary.SaveAsText ('R'+ IntToStr (i- 1)+ '.txt');

      (*$ENDIF DEBUG_MODE*)

      TempImage:= Result.DoSmooth;

      Result.Free;

      Result:= TempImage;

    

    end;

  end

  else

    Result:= nil;



end;



function TFMLImage.Resize (NewRow, NewColumn: Integer): TFMLImage;

var

  ix, iy: Integer;

  xc, yc: Double;

  xprimc, yprimc: Double;

  m10, m00, m01: Int64;

  Alpha, Beta,

  L: Double;

  r, c: Integer;

  Dummy: Integer;

  RowPtr: PInteger;

  

begin

  m10:= 0; m00:= 0; m01:= 0;



  for r:= 0 to FRow- 1 do

  begin

    RowPtr:= Self.ScanLine [r];



    for c:= 0 to FColumn- 1 do

    begin

      dummy:= RowPtr^;

      Inc (m00, dummy);

      Inc (m10, c* dummy);

      Inc (m01, r* dummy);

        

      Inc (RowPtr);

      

    end;

      

  end;



  xc:= m10/ m00;

  yc:= m01/ m00;

  xprimc:= FColumn/ 2.0;

  yprimc:= FRow/ 2.0;

    

  L:= Math.Max (Row, Column);



  if L= FRow then

  begin

    Beta:= NewRow/ L;

    Alpha:= Beta;



  end

  else

  begin

    Alpha:= NewColumn/ L;

    Beta:= Alpha;

      

  end;



  Result:= TFMLImage.Create;

  Result.FImageType:= Self.ImageType;

  Result.Column:= NewColumn;

  Result.Row:= NewRow;



  for r:= 0 to NewRow- 1 do

  begin

    RowPtr:= Result.ScanLine [r];

      

    for c:= 0 to NewColumn- 1 do

    begin

      ix:= Round ( (c- xprimc)/ Alpha+ xc);

      iy:= Round ( (r- yprimc)/ Beta+ yc);



      if (ix< FColumn) and (0<= ix ) and (iy< FRow) and (0<= iy) then

        RowPtr^:= FBody [iy, ix]

      else

        RowPtr^:= WHITE;



      Inc (RowPtr);



    end;



  end;



end;



 (*

  This function generate a new TFMLImage.

  The value of each pixel of the new FMLImage, is equal to the average of all members of it, in the original Image



  The argument RepeatCount told how many times it should be applied.

------------------------------------------------------------------

  The DP approach is to simply set

    Result.Pixels [r, c]:=

      (Result.Pixels [r- 1, c- 1]+ Result.Pixels [r- 1, c]+...+ Result.Pixels [r+ 1, c+ 1]) div 9;

    The Exectution time of this approach is 9*Row* Column.



  In this function, I implemented the folowing approach.

    At first step, set 

    TempResult.Pixels [r, c]:=

       Sum of all pixles in rectangle from (0, 0) to (r, c).

    So,

    TempResult.Pixels [r, c]:= TempResult.Pixels [r- 1, c]+

           TempResult.Pixels [r, c- 1]- TempResult.Pixels [r- 1, c- 1]+ Source [r, c];



    At second step, calculate the real value of each pixel:

      Result.Pixels [r, c]:= TempResult.Pixels [r+ 1, c+ 1]+

           Result.Pixels [r- 1, c- 1]- Result.Pixels [r- 1, c+ 1]

           - Result.Pixels [r+ 1, c- 1];

*)



function TBaseImage.DoSmooth: TColoredImage;

const

{$J+}

  SumOfPixels: array of array of Integer= nil;

  {The SumOfPixels is an static variable}

{$J-}



var

  r, c: Integer;

  SourcePtr,//

  TargetPtr//,

//  LastPixTPtr,//Pixel [r, c- 1]

//  LastRowTPtr,//Pixel [r- 1, c]

//  LastRowCelTPtr//Pixel [r- 1, c- 1]

  : PInteger;



procedure AllocateSumOfPixels;

var

  r: Integer;

  

begin

  if SumOfPixels= nil then

    SetLength (SumOfPixels, Row+ 4);



  if Length (SumOfPixels)< Row+ 4 then

  begin

   for r:= 0 to High (SumOfPixels) do

     SetLength (SumOfPixels [r], 0);

    SetLength (SumOfPixels, 0);



    SetLength (SumOfPixels, Row+ 4);

    for r:= 0 to Row+ 3 do

      SetLength (SumOfPixels [r], Column+ 4);



  end;



  if Length (SumOfPixels [0])< Column+ 4 then

    for r:= 0 to High (SumOfPixels) do

      SetLength (SumOfPixels [r], Column+ 4);



  for r:= 0 to Row+ 3 do

    FillChar (SumOfPixels [r][0], SizeOf (SumOfPixels [r]), 0);



end;



var

  ActiveSumOfPixelsPtr,// Points to SUmofPixels [r, c]

  R_1CSumOfPixelPtr, // Points to SUmofPixels [r- 1, c]

  RC_1SumOfPixelPtr, // Points to SUmofPixels [r, c- 1]

  R_1C_1SumOfPixelPtr,// Points to SUmofPixels [r- 1, c- 1]

  R__1C__1SumOfPixelPtr, // Points to SUmofPixels [r+ 1, c+ 1]

  R_2C_2SumOfPixelPtr, // Points to SUmofPixels [r- 2, c- 2]

  R_2C__1SumOfPixelPtr,// Points to SUmofPixels [r- 2, c+ 1]

  R__1C_2SumOfPixelPtr// Points to SUmofPixels [r+ 1, c- 2]

  : PInteger;

  MainImageType: TImageType;

  

begin

  MainImageType:= Self.ImageType;

  

  if Self.ImageType= itMonoChrome then

  begin

    for r:= 0 to FRow- 1 do

    begin

      SourcePtr:= Self.ScanLine [r];

      for c:= 0 to FColumn- 1 do

      begin

        SourcePtr^:= (1- SourcePtr^)* 255;

        Inc (SourcePtr);

        

      end;



    end;

    FImageType:= it8bit;

    

  end;

(*$IFDEF DEBUG_MODE*)

  Self.SaveAsText ('C:\Image.txt', True);

(*$ENDIF*)



  AllocateSumOfPixels;

  

  Result:= TColoredImage.Create (it8bit);

  Result.FImageType:= it8bit;

  Result.FPattern:= FPattern;

  Result.Column:= Column;

  Result.Row:= Row;

  

{Step 1: Calculating SumofPixels array }

   {putting white pixel around the main image and

    SumOfPixels [r, c] holds the sum of the pixels [i,j]

    for which i<= r and j<= c.

    0<= r<= Row+1, 0<= c<= Column+1,

    }



  {Calculating SumOfPixels for 0's Row}

  ActiveSumOfPixelsPtr:= @SumOfPixels [0][0];

  ActiveSumOfPixelsPtr^:= 255;

  RC_1SumOfPixelPtr:= ActiveSumOfPixelsPtr;

  Inc (ActiveSumOfPixelsPtr);



  for c:= 1 to FColumn+ 3 do

  begin

    ActiveSumOfPixelsPtr^:=

       RC_1SumOfPixelPtr^+ 255;



    Inc (ActiveSumOfPixelsPtr);

    Inc (RC_1SumOfPixelPtr);

    

  end;



  ActiveSumOfPixelsPtr:= @SumOfPixels [1][0];

  R_1CSumOfPixelPtr:= @SumOfPixels [0][0];

  for c:= 0 to FColumn+ 3 do

  begin

    ActiveSumOfPixelsPtr^:= 2* R_1CSumOfPixelPtr^;

    Inc (ActiveSumOfPixelsPtr);

    Inc (R_1CSumOfPixelPtr);



  end;





  for r:= 2 to FRow+ 1 do

  begin

  {Calculating SumOfPixels for r's Row}

    ActiveSumOfPixelsPtr:= @SumOfPixels [r][0];

    ActiveSumOfPixelsPtr^:= (r+ 1)* 255;

    ActiveSumOfPixelsPtr:= @SumOfPixels [r][1];

    ActiveSumOfPixelsPtr^:= 2* (r+ 1)* 255;



    R_1CSumOfPixelPtr:= @SumOfPixels [r- 1][2];

    R_1C_1SumOfPixelPtr:= @SumOfPixels [r- 1][1];

    RC_1SumOfPixelPtr:= @SumOfPixels [r][1];

    ActiveSumOfPixelsPtr:= @SumOfPixels [r][2];

    SourcePtr:= ScanLine [r- 2];



    for c:= 2 to Column+ 1 do

    begin

      ActiveSumOfPixelsPtr^:= R_1CSumOfPixelPtr^+

        RC_1SumOfPixelPtr^- R_1C_1SumOfPixelPtr^+ SourcePtr^;



      Inc (ActiveSumOfPixelsPtr);

      Inc (R_1CSumOfPixelPtr);

      Inc (R_1C_1SumOfPixelPtr);

      Inc (RC_1SumOfPixelPtr);

      Inc (SourcePtr);

      

    end;

    //SumOfPixels [r][FCol+ 2]

    ActiveSumOfPixelsPtr^:= R_1CSumOfPixelPtr^+

      RC_1SumOfPixelPtr^- R_1C_1SumOfPixelPtr^+ 255;



    Inc (ActiveSumOfPixelsPtr);

    Inc (R_1CSumOfPixelPtr);

    Inc (R_1C_1SumOfPixelPtr);

    Inc (RC_1SumOfPixelPtr);

    //SumOfPixels [r][FCol+ 3]

    ActiveSumOfPixelsPtr^:= R_1CSumOfPixelPtr^+

      RC_1SumOfPixelPtr^- R_1C_1SumOfPixelPtr^+ 255;



  end;



  {Calculating SumOfPixels for FRow+2's Row}

  for r:= FRow+ 2 to FRow+ 3 do

  begin

    ActiveSumOfPixelsPtr:= @SumOfPixels [r][0];

    ActiveSumOfPixelsPtr^:= (r+ 1)* 255;

    Inc (ActiveSumOfPixelsPtr);

    ActiveSumOfPixelsPtr^:= 2* (r+ 1)* 255;



    R_1CSumOfPixelPtr:= @SumOfPixels [r- 1][2];

    R_1C_1SumOfPixelPtr:= @SumOfPixels [r- 1][1];

    RC_1SumOfPixelPtr:= @SumOfPixels [r][1];

    ActiveSumOfPixelsPtr:= @SumOfPixels [r][2];



    for c:= 2 to Column+ 1 do

    begin

      ActiveSumOfPixelsPtr^:= R_1CSumOfPixelPtr^+

        RC_1SumOfPixelPtr^- R_1C_1SumOfPixelPtr^+ 255;



      Inc (ActiveSumOfPixelsPtr);

      Inc (R_1CSumOfPixelPtr);

      Inc (R_1C_1SumOfPixelPtr);

      Inc (RC_1SumOfPixelPtr);

      

    end;

    //SumOfPixels [r][FCol+ 2]

    ActiveSumOfPixelsPtr^:= R_1CSumOfPixelPtr^+

      RC_1SumOfPixelPtr^- R_1C_1SumOfPixelPtr^+ 255;



    Inc (ActiveSumOfPixelsPtr);

    Inc (R_1CSumOfPixelPtr);

    Inc (R_1C_1SumOfPixelPtr);

    Inc (RC_1SumOfPixelPtr);

    //SumOfPixels [r][FCol+ 3]

    ActiveSumOfPixelsPtr^:= R_1CSumOfPixelPtr^+

      RC_1SumOfPixelPtr^- R_1C_1SumOfPixelPtr^+ 255;



  end;



(*$IFDEF DEBUG_MODE*)

  AssignFile (Output, 'C:\Output.txt');

  Rewrite (Output);



  for r:= 0 to FRow+ 1 do

  begin

    for c:= 0 to FColumn+ 1 do

      System.Write (SumOfPixels [r][c], ' ');

    WriteLn;



  end;

  

  CloseFile (Output);

  

(*$ENDIF*)



{Step 2: Calculating Results Value }

  for r:= 2 to FRow+ 1 do

  begin

    TargetPtr:= Result.ScanLine [r- 2];



//    Result.FBody [r- 1, 0]:= SumOfPixels [r- 1, 

    R__1C__1SumOfPixelPtr:= @SumOfPixels [r+ 1][3];

    R__1C_2SumOfPixelPtr:= @SumOfPixels [r+ 1][0];

    R_2C__1SumOfPixelPtr:= @SumOfPixels [r- 2][3];

    R_2C_2SumOfPixelPtr:= @SumOfPixels [r- 2][0];

    for c:= 2 to FColumn+ 1 do

    begin

      TargetPtr^:= (R__1C__1SumOfPixelPtr^+

      R_2C_2SumOfPixelPtr^-

      R_2C__1SumOfPixelPtr^-

      R__1C_2SumOfPixelPtr^) div 9;

     

      Inc (R__1C__1SumOfPixelPtr);

      Inc (R__1C_2SumOfPixelPtr);

      Inc (R_2C__1SumOfPixelPtr);

      Inc (R_2C_2SumOfPixelPtr);

      Inc (TargetPtr);

      

    end;



  end;



(*$IFDEF DEBUG_MODE*)

  Result.SaveAsText ('C:\SmoothedImage.txt', True);

(*$ENDIF*)



  if MainImageType= itMonoChrome then

  begin

    for r:= 0 to FRow- 1 do

    begin

      SourcePtr:= Self.ScanLine [r];

      for c:= 0 to FColumn- 1 do

      begin

        SourcePtr^:= 1- SourcePtr^ div 255;

        Inc (SourcePtr);

        

      end;



    end;

    FImageType:= itMonoChrome;

  

  end;



end;



function TFMLImage.DoSmooth2: TFMLImage;

var

  S, i, j, k,

  r, c: Integer;



begin

  Result:= TFMLImage.Create;

  Result.Column:= Column;

  Result.Row:= Row;



  for r:= 0 to Row- 1 do

    for c:= 0 to Column- 1 do

    begin

      k:= 9;

      S:= 0;

      for i:= -1 to 1 do

        for j:= -1 to 1 do

          try

            S:= S+ Body [r+ i, c+ j];

          except

            on E: ERangeCheckError do

              Dec (k);

              

          end;



      if S div 2< k then

        Result.FBody [r, c]:= WHITE

      else

        Result.FBody [r, c]:= BLACK;

        

    end;



end;



function TFMLImage.DoSmooth1: TFMLImage;

var

  r, c: Integer;

  SourcePtr,//



  TargetPtr//Pixel [r, c]

  : PInteger;

  Count, ExcepCounter,

  Sum: Integer;

  TempResult: TFMLImage;

  

begin



  Result:= TFMLImage.Create;

  TempResult:= TFMLImage.Create;

  Result.Column:= Column;

  Result.Row:= Row;

  TempResult.Row:= Row+ 2;

  TempResult.Column:= Column+ 2;

//  Self.SaveAsText ('BeforeSmooth.txt');

  

{Step 1: Calculating TempResult's Values }



  for r:= 0 to Row- 1 do

  begin

    for c:= 0 to Column- 1 do

    begin

      Sum:= Self.FBody [r, c];

      Count:= 9;

      ExcepCounter:= 0;



      try

        Inc (Sum, TempResult.Body [r- 1, c]);

        

      except

        Dec (Count, 3);

        Inc (ExcepCounter);

        

      end;

      

      try

        Inc (Sum, TempResult.Body [r, c- 1]);

        

      except

        Dec (Count, 3);

        if ExcepCounter<> 0 then

          Inc (Count);

        

      end;



      try

        Dec (Sum, TempResult.Body [r- 1, c- 1]);

      except

        on E: ERangeCheckError do;

        

      end;



      if Sum< Count div 2 then

        TempResult.FBody [r, c]:= BLACK

      else

        TempResult.FBody [r, c]:= WHITE;



    end;



  end;



  for r:= 0 to Row do

    TempResult.FBody [r, Column+ 1]:=

            TempResult.FBody [r, Column];

              

  TargetPtr:= TempResult.ScanLine [Row+ 1];

  SourcePtr:= TempResult.ScanLine [Row];

    

  for c:= 0 to Column+ 1 do

  begin

    TargetPtr^:= SourcePtr^;

      

    Inc (TargetPtr);

    Inc (SourcePtr);

      

  end;



//    TempResult.SaveAsText ('TempResult.txt', True);



{Step 2: Calculating Results Value }

  r:= 0;

  TargetPtr:= Result.ScanLine [r];



  TargetPtr^:= TempResult.FBody [r+ 2, 2];



  if TargetPtr^< 3 then

    TargetPtr^:= BLACK

  else

    TargetPtr^:= WHITE;



  Inc (TargetPtr);



  for c:= 1 to Column- 1 do

  begin

    TargetPtr^:= TempResult.FBody [r+ 2, c+ 2]

       - TempResult.FBody [r+ 2, c- 1];



    if TargetPtr^< 3 then

      TargetPtr^:= BLACK

    else

      TargetPtr^:= WHITE;



    Inc (TargetPtr);



  end;

    

  for r:= 1 to Row- 1 do

  begin

    TargetPtr:= Result.ScanLine [r];



    TargetPtr^:= TempResult.FBody [r+ 2, 2]

       - TempResult.FBody [r- 1, 2];



    if r= Row- 1 then

    begin

      if TargetPtr^< 3 then

        TargetPtr^:= BLACK

 …