Advertisement
WarPie90

HeatMap stuff

Jan 4th, 2023 (edited)
1,782
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 1.48 KB | None | 0 0
  1. program new;
  2. {$I SRL/osr.simba}
  3.  
  4. var
  5.   BMP: TMufasaBitmap;
  6.   x: Int32;
  7.   P: TPoint;
  8.   rect: TRectangle;
  9.   M: TSingleMatrix;
  10.   n: Double;
  11.   TPA: TPointArray;
  12.   mouses: TPointArray;
  13.   h,s,l: Extended;
  14.   pts: TPointArray;
  15. begin
  16.   SRL_GAUSS_CUTOFF := 5.5;
  17.  
  18.   BMP := GetMufasaBitmap(CreateBitmap(500, 500));
  19.   BMP.Debug();
  20.   M.SetSize(500,500);
  21.  
  22.   rect := Box(Random(190, 200), Random(190, 200), Random(250, 350), Random(250, 350)).ToRectangle.Rotate(Radians(Random(360)));
  23.   pts := [[Random(100, 400),Random(100, 400)],[Random(100, 400),Random(100, 400)],[Random(100, 400),Random(100, 400)],[Random(100, 400),Random(100, 400)]];
  24.  
  25.   repeat
  26.     BMP.DrawRect(rect, clOrange);
  27.     for x:=1 to 3 do
  28.     begin
  29.       if x <> 3 then
  30.         P := pts[x]
  31.       else
  32.         P := Mouse.Position();
  33.  
  34.       mouses.append(p);
  35.       for 0 to 10000 do
  36.         with srl.rowp(P, rect) do
  37.         begin
  38.           M[Y,X] += 1;
  39.           M[Y+1,X] += 1;
  40.           M[Y-1,X] += 1;
  41.           M[Y,X-1] += 1;
  42.           M[Y,X+1] += 1;
  43.           TPA.Append(Point(X,Y));
  44.         end;
  45.     end;
  46.     //max of heatmap
  47.     n := M.Max();
  48.  
  49.     //value to heat
  50.     for p in TPA do
  51.       BMP.SetPixel(p.X, p.Y, HSLToColor(90 - M[p.Y,p.X] / n * 90, 100, 60));
  52.  
  53.     for p in mouses do
  54.       BMP.DrawCircleFilled(P, 5, False, clRed);
  55.  
  56.     DrawBitmapDebugImg(bmp.getIndex());
  57.     BMP.Clear();
  58.     TPA := [];
  59.     mouses := [];
  60.     M.Fill(TBox([0,0,490,490]), 0);
  61.   until False;
  62.  
  63.  
  64.  
  65.   BMP.Free();
  66. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement