Janilabo

Untitled

Sep 12th, 2013
56
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Pascal 1.57 KB | None | 0 0
  1. {$loadlib pumbaa.dll}
  2.  
  3. const
  4.   BITMAP_WIDTH = 800;
  5.   BITMAP_HEIGHT = 600;
  6.   AREA_X1 = 25;
  7.   AREA_Y1 = 25;
  8.   AREA_X2 = 775;
  9.   AREA_Y2 = 575;
  10.   PART_WIDTH = 25;
  11.   PART_HEIGHT = 100;
  12.   GENERATE_SIZE = 1000000; // Size of random points generated to area..
  13.   DUPLICATES = FALSE;
  14.  
  15. {==============================================================================]
  16.   Explanation: Sets points from TPA that are inside bmp as color.
  17. [==============================================================================}
  18. procedure SetPixels(bmp: Integer; TPA: TPointArray; color: Integer);
  19. var
  20.   a, z: Integer;
  21.   c: TIntegerArray;
  22. begin
  23.   z := High(TPA);
  24.   if (z > -1) then
  25.   begin
  26.     pp_Create(color, (z + 1), c);
  27.     FastSetPixels(bmp, TPA, c);
  28.   end;
  29. end;
  30.  
  31. var
  32.   bmp, h, i, t: Integer;
  33.   TPA, p: TPointArray;
  34.   ATPA: T2DPointArray;
  35.   bxs: TBoxArray;
  36.   a, b: TBox;
  37.  
  38. begin
  39.   ClearDebug;
  40.   b := pp_Box((AREA_X1 + 1), (AREA_Y1 + 1), (AREA_X2 - 1), (AREA_Y2 - 1));
  41.   pp_TPAFromBox(b, GENERATE_SIZE, DUPLICATES, TPA);
  42.   WriteLn('TPA size: ' + IntToStr(Length(TPA)));
  43.   bmp := CreateBitmap(BITMAP_WIDTH, BITMAP_HEIGHT);
  44.   b := pp_Box(AREA_X1, AREA_Y1, AREA_X2, AREA_Y2);
  45.   pp_BoxPartition(b, PART_WIDTH, PART_HEIGHT, bxs);
  46.   pp_TPAFromBoxEdge(bxs, p);
  47.   t := GetSystemTime;
  48.   pp_TPAGrab(TPA, bxs, ATPA);
  49.   WriteLn('TPAGrab took ' + IntToStr(GetSystemTime - t) + ' ms.');
  50.   h := High(ATPA);
  51.   SetPixels(bmp, p, 255);
  52.   for i := 0 to h do
  53.     SetPixels(bmp, ATPA[i], Random(16777216));
  54.   DisplayDebugImgWindow(BITMAP_WIDTH, BITMAP_HEIGHT);
  55.   DrawBitmapDebugImg(bmp);
  56. end.
Advertisement
Add Comment
Please, Sign In to add comment