Advertisement
Janilabo

Untitled

Nov 5th, 2013
73
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Pascal 3.08 KB | None | 0 0
  1. {$loadlib pumbaa.dll}
  2.  
  3. const
  4.   BMP_WIDTH = 500;  //Disabled
  5.   BMP_HEIGHT = 500; //Disabled
  6.   ITERATIONS = 50;
  7.  
  8. var
  9.   TPA: TPointArray;
  10.  
  11. procedure Setup;
  12. begin
  13.   TPA := [Point(150, 250), Point(250, 151), Point(358, 252), Point(400, 100), Point(355, 351)];
  14. end;
  15.  
  16. procedure TPADilation(var TPA: TPointArray; iterations: Integer);
  17. var
  18.   w, h, l, i, j, c, s, g, n, t, q,a: Integer;
  19.   m: T2DIntegerArray;
  20.   o, d: TIntegerArray;
  21.   se: TStructuringElement;
  22.   p: TPoint;
  23.   b: TBox;
  24. begin
  25.   if (iterations > 0) then
  26.   begin
  27.     l := Length(TPA);
  28.     if (l > 0) then
  29.     begin
  30.       b := pp_TPABounds(TPA);
  31.       pp_BoxResize(b, (iterations + 1));
  32.       pp_BoxDimensions(b, w, h);
  33.       m := pp_Create(0, w, h);
  34.       se := pp_SE_Cross(1, 1, -1, 1, 1);
  35.       q := 1;
  36.       a := 0;
  37.       g := 3;
  38.       c := 0;
  39.       for i := 0 to (l - 1) do
  40.         if not (m[(TPA[i].X - b.X1)][(TPA[i].Y - b.Y1)] = 1) then
  41.         begin
  42.           m[(TPA[i].X - b.X1)][(TPA[i].Y - b.Y1)] := 1;
  43.           TPA[c] := TPA[i];
  44.           c := (c + 1);
  45.         end;
  46.       l := (l - (l - c));
  47.       s := (l - 1);
  48.       if (c > 0) then
  49.         SetLength(TPA, l);
  50.       d := pp_TIAByRange(0, (w * h));
  51.       o := pp_Clone(d);
  52.       t := 0;
  53.       repeat
  54.         n := 0;
  55.         case (t and 1) of
  56.           0:
  57.           for i := 0 to s do
  58.             for j := 0 to g do
  59.             begin
  60.               p.X := (TPA[o[i]].X + se[j].pixel.X);
  61.               p.Y := (TPA[o[i]].Y + se[j].pixel.Y);
  62.               if (m[(p.X - b.X1)][(p.Y - b.Y1)] = 0) then
  63.               begin
  64.                 Inc(a);
  65.                 if a>=q then
  66.                 begin
  67.                   q := q+q;
  68.                   SetLength(TPA, q);
  69.                 end;
  70.                 TPA[l] := p;
  71.                 m[(p.X - b.X1)][(p.Y - b.Y1)] := 1;
  72.                 d[n] := l;
  73.                 n := (n + 1);
  74.                 l := (l + 1);
  75.               end;
  76.             end;
  77.           1:
  78.           for i := 0 to s do
  79.             for j := 0 to g do
  80.             begin
  81.               p.X := (TPA[d[i]].X + se[j].pixel.X);
  82.               p.Y := (TPA[d[i]].Y + se[j].pixel.Y);
  83.               if (m[(p.X - b.X1)][(p.Y - b.Y1)] = 0) then
  84.               begin
  85.                 Inc(a);
  86.                 if a>=q then
  87.                 begin
  88.                   q := q+q;
  89.                   SetLength(TPA, q);
  90.                 end;
  91.                 TPA[l] := p;
  92.                 m[(p.X - b.X1)][(p.Y - b.Y1)] := 1;
  93.                 o[n] := l;
  94.                 n := (n + 1);
  95.                 l := (l + 1);
  96.               end;
  97.             end;
  98.         end;
  99.         s := (n - 1);
  100.         t := (t + 1);
  101.       until (t >= iterations);
  102.     end;
  103.   end;
  104.   SetLength(TPA, l+a);
  105. end;
  106.  
  107. procedure DebugBitmap(bmp: Integer);
  108. var
  109.   w, h: Integer;
  110. begin
  111.   GetBitmapSize(bmp, w, h);
  112.   DisplayDebugImgWindow(w, h);
  113.   DrawBitmapDebugImg(bmp);
  114. end;
  115.  
  116. var
  117.   t, b: Integer;
  118.  
  119. begin
  120.   b := CreateBitmap(500, 500);
  121.   Setup;
  122.   t := GetTimeRunning;
  123.   TPADilation(TPA, ITERATIONS);
  124.   WriteLn(GetTimeRunning - t);
  125.   DrawTPABitmap(b, TPA, 255);
  126.   DebugBitmap(b);
  127. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement