Janilabo

crash

Jul 21st, 2013
52
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Pascal 3.94 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, b, w, h: Integer;
  36. begin
  37.   b := High(TPA);
  38.   if (b > -1) then
  39.   begin
  40.     try
  41.       GetBitmapSize(bmp, w, h);
  42.     except
  43.       Exit;
  44.     end;
  45.     for a := 0 to b do
  46.       if ((TPA[a].X > -1) and (TPA[a].Y > -1) and (TPA[a].X < w) and (TPA[a].Y < h)) then
  47.         FastSetPixel(bmp, TPA[a].X, TPA[a].Y, color);
  48.   end;
  49. end;
  50.  
  51.  
  52. function FillShape(Shape:TPointArray): TPointArray;
  53. var
  54.   TBA: TBox;
  55.   x,y: Integer;
  56. begin
  57.   TBA:=GetTPABounds(Shape);
  58.   for x := TBA.x1 to TBA.x2 do
  59.     for y := TBA.y1 to TBA.y2 do
  60.       if InPoly(Point(x,y), Shape) then
  61.       begin
  62.         SetLength(Result, Length(Result)+1);
  63.         Result[High(Result)] := Point(x,y);
  64.       end;
  65. end;
  66.  
  67. function Xagon(Sides:Integer;C,S:TPoint): TPointArray;
  68. var
  69.   ptx,pty,dx,dy,i: Integer;
  70.   rads:Extended;
  71. begin
  72.   SetLength(Result,Sides+1);
  73.   ptx := S.x;
  74.   pty := S.y;
  75.   rads := Radians(360/sides);
  76.   for i:=0 to Sides do
  77.   begin
  78.     dx := ptx - c.x;
  79.     dy := pty - c.y;
  80.     ptx := Round((dy * Sin(rads)) + (dx * Cos(rads)) + c.x);
  81.     pty := Round((dy * Cos(rads)) - (dx * Sin(rads)) + c.y);
  82.     Result[i] := Point(ptx,pty);
  83.   end;
  84. end;
  85.  
  86.  
  87. //******* Plot a few shapes using this algorithm *******//
  88. var
  89.   Shape: TPointArray;
  90.   bmp: Integer;
  91.   ShowExample : Integer;
  92. begin
  93.   //Dynamic shapes from Example 6 and down:
  94.   ShowExample := 7;
  95.  
  96.   Case ShowExample of
  97.   1: // Manual: Arrow like shape //
  98.      Shape := [Point(70,90),Point(185,90),Point(185,116), Point(70,116), //Square +
  99.                Point(70,140),Point(35,105),Point(70,70)];                //Triangle
  100.  
  101.   2: // Manual: Triangle //
  102.      Shape := [Point(50,50),Point(0,100),Point(100,150)];
  103.  
  104.   3: // Manual: Raped pentagon //
  105.      Shape := [Point(10,25),Point(35,5),Point(82,22),Point(50,90),Point(4,60)];
  106.  
  107.   4: // Manual: Octagon //
  108.      Shape := [Point(100,30), Point(155,50),  //Top-Right
  109.                Point(180,110),Point(155,160), //Right-Bottom
  110.                Point(100,180),Point(45,160),  //Bottom-Left
  111.                Point(20,100), Point(45,50)];  //Left-Top
  112.  
  113.   5: // Manual: S-Shape //
  114.      Shape := [Point(135,50),Point(123,70),Point(103,58),Point(85,70),Point(85,85),
  115.                 Point(122,105),Point(132,125),Point(120,155),Point(78,164),Point(55,147),
  116.                 Point(64,128),Point(80,140),Point(100,140),Point(96,116),Point(62,98),
  117.                 Point(60,55),Point(111,35)];
  118.  
  119.   6: // Xagon: 15 corners //
  120.      Shape := Xagon(15, Point(100,100), Point(60,100));
  121.  
  122.   7: // Xagon: 9 corners //
  123.      Shape := Xagon(9, Point(100,100), Point(60,50));
  124.  
  125.   8: // Xagon: 5 corners AKA Pentagon //
  126.      Shape := Xagon(5, Point(100,100), Point(75,50));
  127.  
  128.   9: // Xagon: 3 corners AKA Triangle //
  129.      Shape := Xagon(3, Point(100,100), Point(48,48));
  130.   end;
  131.  
  132.   bmp := CreateBitmap(200, 200);
  133.   SetPixels(bmp, FillShape(Shape), 255);
  134.   DisplayDebugImgWindow(200, 200);
  135.   DrawBitmapDebugImg(bmp);
  136.   FreeBitmap(bmp);
  137. end.
Advertisement
Add Comment
Please, Sign In to add comment