出来たみたいですがまだ…

[imaging/Image-pattern.git] / fourier / Unit2.pas

diff --git a/fourier/Unit2.pas b/fourier/Unit2.pas
index 668e511..b9424ab 100644 (file)
--- a/fourier/Unit2.pas
+++ b/fourier/Unit2.pas
@@ -3,7 +3,7 @@ unit Unit2;
 interface
 
 uses
-  FMX.Graphics, FMX.Types, System.UITypes, System.Types;
+  FMX.Graphics, FMX.Types, System.UITypes, System.Types, Math;
 
 type
   TBinary = array of array of integer;
@@ -14,24 +14,24 @@ type
 
   TModel = class
   const
-    MAX_REPRESENTATIVE = 20;
+    MAX_REPRESENTATIVE = 50;
   private
-    FReal1: array [0 .. MAX_REPRESENTATIVE - 1] of Double;
-    FReal2: array [0 .. MAX_REPRESENTATIVE - 1] of Double;
-    FImag1: array [0 .. MAX_REPRESENTATIVE - 1] of Double;
-    FImag2: array [0 .. MAX_REPRESENTATIVE - 1] of Double;
+    FReal1: array [0 .. MAX_REPRESENTATIVE - 1] of Single;
+    FReal2: array [0 .. MAX_REPRESENTATIVE - 1] of Single;
+    FImag1: array [0 .. MAX_REPRESENTATIVE - 1] of Single;
+    FImag2: array [0 .. MAX_REPRESENTATIVE - 1] of Single;
     FName: string;
-    function GetcoParam(X: integer; const Index: integer): Double;
-    procedure SetcoParam(X: integer; const Index: integer; const Value: Double);
+    function GetcoParam(X: integer; const Index: integer): Single;
+    procedure SetcoParam(X: integer; const Index: integer; const Value: Single);
   public
     numDescriptor: integer;
-    property coReal1[X: integer]: Double index 0 read GetcoParam
+    property coReal1[X: integer]: Single index 0 read GetcoParam
       write SetcoParam;
-    property coReal2[X: integer]: Double index 1 read GetcoParam
+    property coReal2[X: integer]: Single index 1 read GetcoParam
       write SetcoParam;
-    property coImag1[X: integer]: Double index 2 read GetcoParam
+    property coImag1[X: integer]: Single index 2 read GetcoParam
       write SetcoParam;
-    property coImag2[X: integer]: Double index 3 read GetcoParam
+    property coImag2[X: integer]: Single index 3 read GetcoParam
       write SetcoParam;
     property name: string read FName write FName;
   end;
@@ -40,10 +40,8 @@ type
   const
     MAX_POINT = 1000;
   public
-    X, Y: array [0 .. MAX_POINT - 1] of Double;
-    numP: integer;
+    X, Y: array [0 .. MAX_POINT - 1] of Single;
     Count: integer;
-    Area: integer;
   end;
 
   TFourier = class
@@ -79,10 +77,10 @@ type
     procedure BinaryGray(bmp: TBitmap; th: integer; flagBinaryDisp: Boolean);
     procedure DetectArea(bmp: TBitmap);
     procedure sortingPos;
-    function Correlation(A, B: array of Double; cnt: integer): Double;
-    procedure sortingSmall(A: array of Double; id: array of integer;
+    function Correlation(A, B: array of Single; cnt: integer): Single;
+    procedure sortingSmall(A: array of Single; id: array of integer;
       n: integer);
-    procedure sortingBig(A: array of Double; id: array of integer; n: integer);
+    procedure sortingBig(A: array of Single; id: array of integer; n: integer);
   end;
 
 implementation
@@ -129,27 +127,20 @@ begin
   end;
 end;
 
-function TFourier.Correlation(A, B: array of Double; cnt: integer): Double;
+function TFourier.Correlation(A, B: array of Single; cnt: integer): Single;
 var
-  sigA, sigB, sig: Double;
   i: integer;
 begin
-  sigA := 0;
-  sigB := 0;
-  sig := 0;
+  result := 0;
   for i := 0 to cnt - 1 do
-  begin
-    sigA := sigA + A[i] * A[i];
-    sigB := sigB + B[i] * B[i];
-    sig := sig + A[i] * B[i];
-  end;
-  result := sig / (Sqrt(sigA) * Sqrt(sigB));
+    result := result + A[i] * B[i];
+  result := result / (Norm(A) * Norm(B) + 0.01);
 end;
 
 constructor TFourier.Create;
 begin
   inherited;
-  SetnumEntry(10);
+  SetnumEntry(1);
 end;
 
 procedure TFourier.DetectArea(bmp: TBitmap);
@@ -179,7 +170,6 @@ begin
   i := 10;
   j := 10;
   numRect := 0;
-  boundary[0].Count := 0;
   while j < ny - 10 do
   begin
     if (farr[i, j] = 1) and (id[i, j] = 0) then
@@ -204,14 +194,9 @@ begin
         ar[numRect].Height := 3;
         code := 7;
         if labelborder8(nx, ny, i, j, code, numRect, id) = true then
-        begin
-          boundary[numRect].Area:=numRect;
-          inc(numRect);
-        end;
-        if numRect < numEntry then
-          boundary[numRect].Count := 0
+          inc(numRect)
         else
-          break;
+          SetnumEntry(numEntry - 1);
       end
       else if farr[i + 1, j] = 0 then
       begin
@@ -226,7 +211,7 @@ begin
     Stroke.color := color;
     StrokeThickness := 3;
     BeginScene;
-    for i := 0 to MAX_RECT - 1 do
+    for i := 0 to numRect - 1 do
       bmp.Canvas.DrawRect(RectF(ar[i].Left - 3, ar[i].Top - 3, ar[i].Right + 3,
         ar[i].Bottom + 3), 0, 0, [], 1.0);
     EndScene;
@@ -246,6 +231,8 @@ begin
   i2 := 0;
   j2 := 0;
   ii := 0;
+  SetnumEntry(cnt + 1);
+  boundary[cnt].Count := 0;
   while (i2 <> X) or (j2 <> Y) do
   begin
     case code of
@@ -342,13 +329,13 @@ begin
       j1 := j2;
       if ii < TBoundary.MAX_POINT then
       begin
-        boundary[cnt].X[ii] := i1;
-        boundary[cnt].Y[ii] := j1;
+        boundary[cnt].X[ii] := i1 - ar[cnt].Left + 5;
+        boundary[cnt].Y[ii] := j1 - ar[cnt].Top + 5;
         inc(boundary[cnt].Count);
       end
       else
       begin
-        result:=false;
+        result := false;
         Exit;
       end;
       inc(ii);
@@ -362,11 +349,11 @@ begin
   result := not((ar[cnt].Width < minWidth) or (ar[cnt].Height < minHeight));
 end;
 
-procedure TFourier.sortingBig(A: array of Double; id: array of integer;
+procedure TFourier.sortingBig(A: array of Single; id: array of integer;
   n: integer);
 var
   k, kk, i: integer;
-  min: Double;
+  min: Single;
 begin
   for k := 0 to n - 1 do
   begin
@@ -385,7 +372,7 @@ end;
 
 procedure TFourier.sortingPos;
 const
-  eps = 10;
+  eps = 30;
 var
   i: integer;
   j: integer;
@@ -397,7 +384,7 @@ begin
     ar0 := ar[i];
     center := ar[i].CenterPoint;
     for j := i to numRect do
-      if (center.Y > ar[j].CenterPoint.Y - eps) or
+      if (center.Y > ar[j].CenterPoint.Y + eps) or
         ((Abs(center.Y - ar[j].CenterPoint.Y) < eps) and
         (center.X > ar[j].CenterPoint.X)) then
       begin
@@ -409,11 +396,11 @@ begin
   end;
 end;
 
-procedure TFourier.sortingSmall(A: array of Double; id: array of integer;
+procedure TFourier.sortingSmall(A: array of Single; id: array of integer;
   n: integer);
 var
   k, kk, i: integer;
-  max: Double;
+  max: Single;
 begin
   for k := 0 to n - 1 do
   begin
@@ -475,18 +462,24 @@ procedure TFourier.SetnumEntry(const Value: integer);
 var
   i: integer;
 begin
+  if Value > FnumEntry then
+    for i := FnumEntry to Value - 1 do
+    begin
+      FModels[i] := TModel.Create;
+      FBoundary[i] := TBoundary.Create;
+    end
+  else if Value < FnumEntry then
+    for i := Value to FnumEntry - 1 do
+    begin
+      FModels[i].Free;
+      FBoundary[i].Free;
+    end;
   FnumEntry := Value;
-  Clear;
-  for i := 0 to Value - 1 do
-  begin
-    FModels[i] := TModel.Create;
-    FBoundary[i] := TBoundary.Create;
-  end;
 end;
 
 { TModel }
 
-function TModel.GetcoParam(X: integer; const Index: integer): Double;
+function TModel.GetcoParam(X: integer; const Index: integer): Single;
 begin
   result := 0;
   case Index of
@@ -502,7 +495,7 @@ begin
 end;
 
 procedure TModel.SetcoParam(X: integer; const Index: integer;
-  const Value: Double);
+  const Value: Single);
 begin
   case Index of
     0: