From 9c3b4c21ae26fca2bf2b6e7fce8b7e7cc17781fa Mon Sep 17 00:00:00 2001
From: yamat0jp <yamat0jp@yahoo.co.jp>
Date: Sun, 27 May 2018 21:58:56 +0900
Subject: [PATCH] =?utf8?q?binary=E3=83=9C=E3=82=BF=E3=83=B3=E3=81=8C?=
 =?utf8?q?=E5=AE=8C=E6=88=90?=
MIME-Version: 1.0
Content-Type: text/plain; charset=utf8
Content-Transfer-Encoding: 8bit

ScanLineが上下逆じゃないか気になっていたんですがあんまりにも当たり前に読める気がして自分の間違いと思っていました。
単純単純。
---
 binary/Unit1.dfm |  16 +++++--
 binary/Unit1.pas | 136 ++++++++++++++++++++++++++++++++++++++++++++++++++++++-
 2 files changed, 147 insertions(+), 5 deletions(-)

diff --git a/binary/Unit1.dfm b/binary/Unit1.dfm
index ea5c819..570bb6f 100644
--- a/binary/Unit1.dfm
+++ b/binary/Unit1.dfm
@@ -18,9 +18,10 @@ object Form1: TForm1
   TextHeight = 13
   object Image1: TImage
     Left = 489
-    Top = 87
+    Top = 135
     Width = 193
     Height = 193
+    Anchors = [akTop, akRight]
     Picture.Data = {
       07544269746D6170D6F31600424DD6F316000000000036000000280000004A03
       0000530200000100180000000000A0F31600120B0000120B0000000000000000
@@ -47046,9 +47047,18 @@ object Form1: TForm1
     Width = 75
     Height = 25
     Anchors = [akTop, akRight]
-    Caption = 'Button1'
+    Caption = 'binary'
     TabOrder = 0
     OnClick = Button1Click
-    ExplicitLeft = 504
+  end
+  object Button2: TButton
+    Left = 559
+    Top = 72
+    Width = 75
+    Height = 25
+    Anchors = [akTop, akRight]
+    Caption = 'border'
+    TabOrder = 1
+    OnClick = Button2Click
   end
 end
diff --git a/binary/Unit1.pas b/binary/Unit1.pas
index ecbcc42..b1f8e9a 100644
--- a/binary/Unit1.pas
+++ b/binary/Unit1.pas
@@ -14,12 +14,16 @@ type
     Image1: TImage;
     Button1: TButton;
     Image2: TImage;
+    Button2: TButton;
     procedure Button1Click(Sender: TObject);
+    procedure Button2Click(Sender: TObject);
   private
     { Private éŒ¾ }
     function thinning4(nx, ny: integer; img: TRawImg): integer;
     function connect(a: array of integer): integer;
     procedure getBinaryImage(bmp: TBitmap; arr: TRawImg);
+    procedure getBorder4(nx, ny: integer; f, border: TRawImg);
+    procedure chase4(i, j, code: integer; f, border: TRawImg);
   public
     { Public éŒ¾ }
   end;
@@ -50,7 +54,7 @@ begin
     color.rgbtBlue := 255;
     color.rgbtGreen := 255;
     color.rgbtRed := 255;
-    for j := 0 to ny - 1 do
+    for j := ny - 1 downto 0 do
     begin
       Pointer(g) := bmp.ScanLine[j];
       for i := 0 to nx - 1 do
@@ -64,6 +68,115 @@ begin
   Finalize(f);
 end;
 
+procedure TForm1.Button2Click(Sender: TObject);
+var
+  bmp1, bmp2: TBitmap;
+  f, border: TRawImg;
+  g: array of TRGBTriple;
+  c: TRGBTriple;
+  nx, ny: integer;
+  i: integer;
+  j: integer;
+begin
+  bmp1 := TBitmap.Create;
+  bmp2 := TBitmap.Create;
+  try
+    bmp1.Assign(Image1.Picture.Bitmap);
+    nx := bmp1.Width;
+    ny := bmp1.Height;
+    bmp2.Width := nx;
+    bmp2.Height := ny;
+    bmp2.Canvas.FloodFill(0, 0, clWhite, fsSurface);
+    SetLength(f, nx, ny);
+    SetLength(border, nx, ny);
+    getBinaryImage(bmp1, f);
+    for j := 0 to ny - 1 do
+      for i := 0 to nx - 1 do
+        border[i, j] := 0;
+    getBorder4(nx, ny, f, border);
+    for j := ny - 1 downto 0 do
+    begin
+      Pointer(g) := bmp2.ScanLine[j];
+      for i := 0 to nx - 1 do
+        if border[i, j] = 1 then
+        begin
+          c.rgbtBlue := 0;
+          c.rgbtGreen := 0;
+          c.rgbtRed := 0;
+          g[i] := c;
+        end;
+    end;
+    Image2.Picture.Assign(bmp2);
+  finally
+    bmp1.Free;
+    bmp2.Free;
+  end;
+  Finalize(f);
+  Finalize(border);
+end;
+
+procedure TForm1.chase4(i, j, code: integer; f, border: TRawImg);
+var
+  i1, i2, j1, j2, ist, jst: integer;
+begin
+  i1 := i;
+  j1 := j;
+  ist := i;
+  jst := j;
+  i2 := 0;
+  j2 := 0;
+  while (i2 <> ist) or (j2 <> jst) do
+  begin
+    case code of
+      0:
+        begin
+          i2 := i1;
+          j2 := j1 + 1;
+          if f[i2, j2] = 1 then
+            code := 6
+          else
+            code := 2;
+        end;
+      2:
+        begin
+          i2 := i1 + 1;
+          j2 := j1;
+          if f[i2, j2] = 1 then
+            code := 0
+          else
+            code := 4;
+          break;
+        end;
+      4:
+        begin
+          i2 := i1;
+          j2 := j1 - 1;
+          if f[i2, j2] = 1 then
+            code := 2
+          else
+            code := 6;
+          break;
+        end;
+      6:
+        begin
+          i2 := i1 - 1;
+          j2 := j1;
+          if f[i2, j2] = 1 then
+            code := 4
+          else
+            code := 0;
+          break;
+        end;
+    end;
+    if f[i2, j2] = 1 then
+    begin
+      border[i2, j2] := 1;
+      i1 := i2;
+      j1 := j2;
+    end;
+  end;
+end;
+
 function TForm1.connect(a: array of integer): integer;
 var
   i: integer;
@@ -83,7 +196,7 @@ var
 begin
   wid := bmp.Width;
   hei := bmp.Height;
-  for j := 0 to hei - 1 do
+  for j := hei - 1 downto 0 do
   begin
     Pointer(g) := bmp.ScanLine[j];
     for i := 0 to wid - 1 do
@@ -98,6 +211,25 @@ begin
   end;
 end;
 
+procedure TForm1.getBorder4(nx, ny: integer; f, border: TRawImg);
+var
+  i, j, code: integer;
+begin
+  for j := 0 to ny - 1 do
+    for i := 0 to nx - 1 do
+      if (f[i, j] = 1) and (border[i, j] = 0) then
+        if f[i - 1, j] = 0 then
+        begin
+          code := 0;
+          chase4(i, j, code, f, border);
+        end
+        else if f[i + 1, j] = 0 then
+        begin
+          code := 4;
+          chase4(i, j, code, f, border);
+        end;
+end;
+
 function TForm1.thinning4(nx, ny: integer; img: TRawImg): integer;
 var
   i, j, k, c: integer;
-- 
2.11.0