Janilabo

asd

Jul 20th, 2013
66
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Pascal 5.87 KB | None | 0 0
  1. {------------------------------------------------------------------------------]
  2.  Check if a point is within a polygon/shape by the given outline points (poly)
  3.  The points must be in order, as if you would draw a line trough each point.
  4. [------------------------------------------------------------------------------}
  5. function InPoly(pt:TPoint; poly:TPointArray): Boolean;
  6. var
  7.   N,I, xint: Integer;
  8.   p1,p2: TPoint;
  9. begin
  10.   N := Length(poly);
  11.   Result := False;
  12.   if N>2 then
  13.   begin
  14.     p1 := poly[0];
  15.     for I:=0 to N do
  16.     begin
  17.       p2 := poly[I mod N];
  18.       if (pt.y > min(p1.y,p2.y))  and
  19.          (pt.y <= max(p1.y,p2.y)) and
  20.          (pt.x <= max(p1.x,p2.x)) then
  21.       begin
  22.         if (p1.y <> p2.y) then
  23.           xint := (pt.y - p1.y) * (p2.x - p1.x) div (p2.y - p1.y) + p1.x;
  24.         if (p1.x = p2.x) or (pt.x < xint) then
  25.           Result := Not(Result);
  26.       end;
  27.       p1 := p2;
  28.     end;
  29.   end;
  30. end;
  31.  
  32. //******* DIRTY EXAMPLE BELLOW: *******//
  33. procedure SetPixels(bmp: Integer; TPA: TPointArray; color: Integer);
  34. var
  35.   a, z, w, h: Integer;
  36. begin
  37.   z := High(TPA);
  38.   if (z > -1) then
  39.   begin
  40.     GetBitmapSize(bmp, w, h);
  41.     for a := 0 to z do
  42.       if ((TPA[a].X >= 0) and (TPA[a].Y >= 0) and (TPA[a].X < w) and (TPA[a].Y < h)) then
  43.         FastSetPixel(bmp, TPA[a].X, TPA[a].Y, color);
  44.   end;
  45. end;
  46.  
  47. procedure SetPixelsMP(bmp: Integer; TPA: TPointArray; color: Integer);
  48. var
  49.   a, z, w, h: Integer;
  50. begin
  51.   z := High(TPA);
  52.   if (z > -1) then
  53.   begin
  54.     GetBitmapSize(bmp, w, h);
  55.     for a := 0 to z do
  56.       if ((TPA[a].X > 0) and (TPA[a].Y > 0) and (TPA[a].X < w-1) and (TPA[a].Y < h-1)) then
  57.       begin
  58.         FastSetPixel(bmp, TPA[a].X-1, TPA[a].Y, color);
  59.         FastSetPixel(bmp, TPA[a].X+1, TPA[a].Y, color);
  60.         FastSetPixel(bmp, TPA[a].X, TPA[a].Y+1, color);
  61.         FastSetPixel(bmp, TPA[a].X, TPA[a].Y-1, color);
  62.       end;
  63.   end;
  64. end;
  65.  
  66.  
  67. function FillShape(Shape:TPointArray): TPointArray;
  68. var
  69.   TBA: TBox;
  70.   x,y: Integer;
  71. begin
  72.   TBA:=GetTPABounds(Shape);
  73.   for x := TBA.x1 to TBA.x2 do
  74.     for y := TBA.y1 to TBA.y2 do
  75.       if InPoly(Point(x,y), Shape) then
  76.       begin
  77.         SetLength(Result, Length(Result)+1);
  78.         Result[High(Result)] := Point(x,y);
  79.       end;
  80. end;
  81.  
  82. function Xagon(Sides:Integer;C,S:TPoint): TPointArray;
  83. var
  84.   ptx,pty,dx,dy,i: Integer;
  85.   rads:Extended;
  86. begin
  87.   SetLength(Result,Sides+1);
  88.   ptx := S.x;
  89.   pty := S.y;
  90.   rads := Radians(360/sides);
  91.   for i:=0 to Sides do
  92.   begin
  93.     dx := ptx - c.x;
  94.     dy := pty - c.y;
  95.     ptx := Round((dy * Sin(rads)) + (dx * Cos(rads)) + c.x);
  96.     pty := Round((dy * Cos(rads)) - (dx * Sin(rads)) + c.y);
  97.     Result[i] := Point(ptx,pty);
  98.   end;
  99. end;
  100.  
  101.  
  102. procedure TPAEdge(var TPA: TPointArray);
  103. var
  104.   v, x, y, h, r: Integer;
  105.   B: array of TBoolArray;
  106.   bx: TBox;
  107. begin;
  108.   h := High(TPA);
  109.   if (h > 3) then
  110.   begin
  111.     bx := IntToBox(TPA[0].X, TPA[0].Y, TPA[0].X, TPA[0].Y);
  112.     for v := 1 to h do
  113.     begin
  114.       if (TPA[v].X < bx.X1) then
  115.         bx.X1 := TPA[v].X
  116.       else
  117.         if (TPA[v].X > bx.X2) then
  118.           bx.X2 := TPA[v].X;
  119.       if (TPA[v].Y < bx.Y1) then
  120.         bx.Y1 := TPA[v].Y
  121.       else
  122.         if (TPA[v].Y > bx.Y2) then
  123.           bx.Y2 := TPA[v].Y;
  124.     end;
  125.     bx := IntToBox((bx.X1 - 1), (bx.Y1 - 1), (bx.X2 + 1), (bx.Y2 + 1));
  126.     SetLength(B, ((bx.X2 - bx.X1) + 1));
  127.     for v := 0 to (bx.X2 - bx.X1) do
  128.       SetLength(B[v], ((bx.Y2 - bx.Y1) + 1));
  129.     for v := 0 to h do
  130.       if not B[(TPA[v].X - bx.X1)][(TPA[v].Y - bx.Y1)] then
  131.         B[(TPA[v].X - bx.X1)][(TPA[v].Y - bx.Y1)] := True;
  132.     for y := 1 to ((bx.Y2 - bx.Y1) - 1) do
  133.       for x := 1 to ((bx.X2 - bx.X1) - 1) do
  134.         if B[x][y] then
  135.           if not (B[(x - 1)][y] and B[x][(y - 1)] and B[(x + 1)][y] and B[x][(y + 1)]) then
  136.           begin
  137.             TPA[r].X := (x + bx.X1);
  138.             TPA[r].Y := (y + bx.Y1);
  139.             Inc(r);
  140.           end;
  141.     SetLength(TPA, r);
  142.     SetLength(B, 0);
  143.   end;
  144. end;
  145.  
  146. //******* Plot a few shapes using this algorithm *******//
  147. var
  148.   Shape, TPA: TPointArray;
  149.   bmp: Integer;
  150.   ShowExample,ShowPoints: Integer;
  151. begin
  152.   //Dynamic shapes from Example 6 and down:
  153.   ShowExample := 7; //1 - 9
  154.   ShowPoints := 0;  //0 or 1
  155.  
  156.   Case ShowExample of
  157.   1: // Manual: Arrow like shape //
  158.      Shape := [Point(70,90),Point(185,90),Point(185,116), Point(70,116), //Square +
  159.                Point(70,140),Point(35,105),Point(70,70)];                //Triangle
  160.  
  161.   2: // Manual: Triangle //
  162.      Shape := [Point(50,50),Point(0,100),Point(100,150)];
  163.  
  164.   3: // Manual: Raped pentagon //
  165.      Shape := [Point(10,25),Point(35,5),Point(82,22),Point(50,90),Point(4,60)];
  166.  
  167.   4: // Manual: Octagon //
  168.      Shape := [Point(100,30), Point(155,50),  //Top-Right
  169.                Point(180,110),Point(155,160), //Right-Bottom
  170.                Point(100,180),Point(45,160),  //Bottom-Left
  171.                Point(20,100), Point(45,50)];  //Left-Top
  172.  
  173.   5: // Manual: S-Shape //
  174.      Shape := [Point(135,50),Point(123,70),Point(103,58),Point(85,70),Point(85,85),
  175.                 Point(122,105),Point(132,125),Point(120,155),Point(78,164),Point(55,147),
  176.                 Point(64,128),Point(80,140),Point(100,140),Point(96,116),Point(62,98),
  177.                 Point(60,55),Point(111,35)];
  178.  
  179.   6: // Xagon: 15 corners //
  180.      Shape := Xagon(15, Point(100,100), Point(60,100));
  181.  
  182.   7: // Xagon: 9 corners //
  183.      Shape := Xagon(9, Point(100,100), Point(60,50));
  184.  
  185.   8: // Xagon: 5 corners AKA Pentagon //
  186.      Shape := Xagon(5, Point(100,100), Point(75,50));
  187.  
  188.   9: // Xagon: 3 corners AKA Triangle //
  189.      Shape := Xagon(3, Point(100,100), Point(48,48));
  190.   end;
  191.  
  192.   bmp := CreateBitmap(200, 200);
  193.   TPA := FillShape(Shape);
  194.   TPAEdge(TPA);
  195.   SetPixels(bmp, TPA, 357435);
  196.   if ShowPoints=1 then
  197.     SetPixelsMP(bmp, Shape, 16777215);
  198.   DisplayDebugImgWindow(200, 200);
  199.   DrawBitmapDebugImg(bmp);
  200.   FreeBitmap(bmp);
  201. end.
Advertisement
Add Comment
Please, Sign In to add comment