Recent

Author Topic: Window and Bitmap  (Read 1783 times)

KodeZwerg

  • Hero Member
  • *****
  • Posts: 2054
  • Fifty shades of code.
    • Delphi & FreePascal
Re: Window and Bitmap
« Reply #15 on: February 20, 2024, 10:45:05 pm »
For later, when you know what you are doing:
Code: Pascal  [Select][+][-]
  1.   private
  2.     FColors: array[0..99] of TColor;
  3.  
  4. ---
  5.  
  6. implementation
  7.  
  8. procedure TForm1.FormCreate(Sender: TObject);
  9. var
  10.   i: Integer;
  11. begin
  12.   // initiate random number generator
  13.   Randomize;
  14.   // init the colors to use
  15.   for i :=  0 to  99 do
  16.     begin
  17.       // full color palette
  18.       // LColors[i] := RGBToColor(Random(256), Random(256), Random(256));
  19.       // optimized grey palette
  20.       FColors[i] := RGBToColor(255 - i * 255 div 100, 255 - i * 255 div 100, 255 - i * 255 div 100);
  21.     end;
  22.   // create the bitmap to draw on
  23.   FBitmap := TBitmap.Create;
  24.   // make it big
  25.   FBitmap.SetSize(Screen.Width, Screen.Height);
  26.   // choose a background color
  27.   FBitmap.Canvas.Brush.Color := clBlack;
  28.   // fill the background
  29.   FBitmap.Canvas.FillRect(0, 0, FBitmap.Width, FBitmap.Height);
  30.   // put it on screen
  31.   Image1.Picture.Bitmap.Assign(FBitmap);
  32. end;
  33.  
  34. procedure TForm1.Timer1Timer(Sender: TObject);
  35. var
  36.   i: Integer;
  37. begin
  38.   // cache dots
  39.   for i := 0 to 1000 do
  40.     DrawDot(FBitmap, Random(FBitmap.Width), Random(FBitmap.Height), Random(10) + 2, FColors[Random(Length(FColors))]);
  41.   // show them
  42.   Image1.Picture.Bitmap.Assign(FBitmap);
  43. end;
  44.  
  45. procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
  46. begin
  47.   Timer1.Enabled := False;
  48.   FBitmap.Free;
  49.   CloseAction := caFree;
  50. end;
  51.  
  52. procedure TForm1.DrawDot(const ABitmap: TBitmap; const AX, AY, ADotSize: Integer; const AColor: TColor);
  53. begin
  54.   // 2 is the minimum to draw an ellipse
  55.   if ADotSize < 2 then
  56.     Exit;
  57.   // set color
  58.   ABitmap.Canvas.Pen.Color := clBlack;
  59.   ABitmap.Canvas.Brush.Color := AColor;
  60.   // paint a dot in an individual size
  61.   ABitmap.Canvas.Ellipse(AX - ADotSize div 2, AY - ADotSize div 2, AX + ADotSize div 2, AY + ADotSize div 2);
  62. end;

Attention: If you start seeing things within application window, call a doctor!
« Last Edit: Tomorrow at 31:76:97 xm by KodeZwerg »

 

TinyPortal © 2005-2018