Recent

Author Topic: Drawing, shapes? Canvas? Disk Defrag map style  (Read 2576 times)

Tony Stone

  • Jr. Member
  • **
  • Posts: 96
Drawing, shapes? Canvas? Disk Defrag map style
« on: September 25, 2021, 03:18:33 am »
So I have an idea to draw a 'progress map' one of my programs.  Think of the old disc derangementer disc representation squares...  See my attached screen shots.

So below is my code so far.  Works pretty good EXCEPT... it is VERY slow at creating the squares and distributing them in the scrollbox.  I may end up wanting over 100k squares...  It takes about a minute to make 400 squares on my i7 3.xghz

What could I do to make thousands and thousands of squares substantially faster?  I also need to have a hint for each square and need to change color properties as i go....  any other comments about my code would be appreciated as the truth is, i barely know what I am doing.  :D

Code: Pascal  [Select][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls,
  9.   Spin, StdCtrls;
  10.  
  11. type
  12.  
  13.   { TForm1 }
  14.  
  15.   TForm1 = class(TForm)
  16.     btnCreate: TButton;
  17.     btnDestroy: TButton;
  18.     btnRedistribute: TButton;
  19.     chkDoRandom: TCheckBox;
  20.     ScrollBox1: TScrollBox;
  21.     SpinEdit1: TSpinEdit;
  22.     tmrRndDarken: TTimer;
  23.     tmrReRnd: TTimer;
  24.     procedure btnCreateClick(Sender: TObject);
  25.     procedure btnDestroyClick(Sender: TObject);
  26.     procedure btnRedistributeClick(Sender: TObject);
  27.     procedure chkDoRandomChange(Sender: TObject);
  28.     procedure Distribute(Sender: TObject);
  29.     procedure FormResize(Sender: TObject);
  30.     procedure tmrRndDarkenTimer(Sender: TObject);
  31.     procedure tmrReRndTimer(Sender: TObject);
  32.  
  33.   private
  34.  
  35.   public
  36.     totalsquares: Int64;
  37.     rightmost: Integer;
  38.  
  39.     sqCompleteness: array of Integer;
  40.     sqReady2Dis: Boolean;
  41.  
  42.  
  43.   end;
  44.  
  45. aSquare = record
  46.         hits: Integer;
  47.         RiClr: Integer;
  48.         GiClr: Integer;
  49.         BiClr: Integer;
  50.         square: TShape;
  51. end;
  52.  
  53. var
  54.   Form1: TForm1;
  55.   aSquareArray: Array of aSquare;
  56. implementation
  57.  
  58. {$R *.lfm}
  59.  
  60. { TForm1 }
  61.  
  62.  
  63.  
  64. procedure TForm1.btnCreateClick(Sender: TObject);
  65. var
  66.   i: Int64;
  67.  
  68. begin
  69.   totalsquares:=SpinEdit1.Value;
  70.   Randomize;
  71.   for i:= 0 to totalsquares-1 do begin
  72.     SetLength(aSquareArray,i+1);
  73.     aSquareArray[i].square:=TShape.Create(ScrollBox1);
  74.     aSquareArray[i].square.Parent:=ScrollBox1;
  75.     //aSquareArray[i].square.Shape:=stRoundRect;
  76.     aSquareArray[i].square.Brush.Color:=clWhite;
  77.     aSquareArray[i].RiClr:=0;
  78.     aSquareArray[i].GiClr:=0;
  79.     aSquareArray[i].BiClr:=0;
  80.     aSquareArray[i].square.hint:='Square: #' + IntToStr(i+1);
  81.   end;
  82.  
  83.   btnCreate.Enabled:=False;
  84.   sqReady2Dis:=True;
  85.   Distribute(Self);
  86. end;
  87.  
  88. procedure TForm1.btnDestroyClick(Sender: TObject);
  89. var
  90.   i: Integer;
  91. begin
  92.   tmrRndDarken.Enabled:=False;
  93.   chkDoRandom.Checked:=False;
  94.  
  95.   for i:= 0 to totalsquares-1 do begin
  96.     aSquareArray[i].square.Destroy;
  97.   end;
  98.  
  99.   SetLength(aSquareArray,0);
  100.   btnCreate.Enabled:=true;
  101.   sqReady2Dis:=False;
  102. end;
  103.  
  104. procedure TForm1.btnRedistributeClick(Sender: TObject);
  105. begin
  106.   Distribute(self);
  107. end;
  108.  
  109.  
  110. procedure TForm1.chkDoRandomChange(Sender: TObject);
  111. begin
  112.   tmrRndDarken.Enabled:=chkDoRandom.Checked;
  113. end;
  114.  
  115.  
  116.  
  117. procedure TForm1.Distribute(Sender: TObject);
  118. var
  119.   i: Integer;
  120.   lastleft: integer;
  121.   lasttop: Integer;
  122.   sqSpacing: integer = 1;
  123.   sqWidth: Integer = 10;
  124.   sqHeight: Integer = 10;
  125.   maxleft: Integer;
  126. begin
  127.  
  128.   maxleft:=ScrollBox1.Width - sqWidth - sqSpacing - ScrollBox1.VertScrollBar.Size;
  129.   lastleft:=sqSpacing;
  130.   lasttop:=sqSpacing;
  131.  
  132.   for i:= 0 to totalsquares-1 do begin
  133.     if lastleft > maxleft then begin
  134.       lasttop:=lasttop+sqHeight+sqSpacing;
  135.       lastleft:=sqSpacing;
  136.     end;
  137.     aSquareArray[i].square.Top:=lasttop+sqSpacing;
  138.     aSquareArray[i].square.Left:=lastleft;
  139.     aSquareArray[i].square.Width:=sqWidth;
  140.     aSquareArray[i].square.Height:=sqHeight;
  141.  
  142.     lastleft:=sqWidth+aSquareArray[i].square.left+sqSpacing;
  143.  
  144.   end;
  145. end;
  146.  
  147. procedure TForm1.FormResize(Sender: TObject);
  148. begin
  149.   //if sqReady2Dis then Distribute(Self);
  150. end;
  151.  
  152. procedure TForm1.tmrRndDarkenTimer(Sender: TObject);
  153. var
  154.   rndSQR: integer;
  155.   myR, myG, myB: Integer;
  156. begin
  157.  
  158.   if totalsquares > 2 then begin
  159.  
  160.     rndSQR:=random(totalsquares);
  161.     if aSquareArray[rndSQR].GiClr = 0 then begin
  162.      aSquareArray[rndSQR].GiClr:=255;
  163.     end;
  164.  
  165.     if aSquareArray[rndSQR].GiClr > 1 then dec(aSquareArray[rndSQR].GiClr,1);
  166.  
  167.     aSquareArray[rndSQR].square.Brush.Color:=RGBToColor(aSquareArray[rndSQR].RiClr,aSquareArray[rndSQR].GiClr,aSquareArray[rndSQR].BiClr);
  168.   end;
  169. end;
  170.  
  171. procedure TForm1.tmrReRndTimer(Sender: TObject);
  172. begin
  173.   Randomize;
  174. end;
  175.  
  176.  
  177. end.
  178.  
  179.  

jamie

  • Hero Member
  • *****
  • Posts: 4917
Re: Drawing, shapes? Canvas? Disk Defrag map style
« Reply #1 on: September 25, 2021, 04:08:21 am »
That isn't going to spawn much fruit..

 You should not be creating a GUI control for each square, you will hit a way and things will just stop!

Also, the scrollbox has a limit on the scrolling range and client size limits will change depending on the screen size.

 You should look at the TDrawGrid and implement drawing your own square areas...
The only true wisdom is knowing you know nothing

m.abudrais

  • Jr. Member
  • **
  • Posts: 52
Re: Drawing, shapes? Canvas? Disk Defrag map style
« Reply #2 on: September 25, 2021, 04:12:21 am »
try TImage
Code: Pascal  [Select][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls, dateutils;
  9.  
  10. type
  11.  
  12.   { TForm1 }
  13.  
  14.   TForm1 = class(TForm)
  15.     Button1: TButton;
  16.     Image1: TImage;
  17.     Timer1: TTimer;
  18.     procedure Button1Click(Sender: TObject);
  19.     procedure Timer1Timer(Sender: TObject);
  20.   private
  21.     LastTime: TDateTime;
  22.     TimeCounter: integer;
  23.     procedure UpdateImage;
  24.   public
  25.  
  26.   end;
  27.  
  28. var
  29.   Form1: TForm1;
  30.  
  31. implementation
  32.  
  33. {$R *.lfm}
  34.  
  35. { TForm1 }
  36.  
  37. procedure TForm1.Button1Click(Sender: TObject);
  38. begin
  39.   TimeCounter := 0;
  40.   UpdateImage;
  41. end;
  42.  
  43. procedure TForm1.Timer1Timer(Sender: TObject);
  44. var
  45.   M: int64;
  46. begin
  47.   UpdateImage;
  48.   Inc(TimeCounter);
  49.   M := MilliSecondsBetween(LastTime, Now);
  50.   if M > 5000 then
  51.   begin
  52.     Form1.Caption := round(50 * 100 * TimeCounter / (M / 1000)).ToString();
  53.     LastTime := Now;
  54.   end;
  55. end;
  56.  
  57. procedure TForm1.UpdateImage;
  58. var
  59.   k: integer;
  60.   m: integer;
  61.   c: TCanvas;
  62.   R: int64;
  63. begin
  64.   c := Image1.Canvas;
  65.   c.Brush.Color := clBlack;
  66.   c.FillRect(0, 0, Image1.Width, Image1.Height);
  67.   c.Brush.Color := clBlue;
  68.   for k := 0 to 50 do
  69.   begin
  70.     for m := 0 to 100 do
  71.     begin
  72.       R := Random(10);
  73.       if R > 5 then
  74.         c.Brush.Color := clBlue
  75.       else
  76.         c.Brush.Color := clGreen;
  77.       c.FillRect(m * 10, k * 10, m * 10 + 8, k * 10 + 8);
  78.     end;
  79.   end;
  80. end;
  81.  
  82. end.
  83.  
if you need more performance you can use other lib like https://wiki.freepascal.org/BGRABitmap
« Last Edit: September 27, 2021, 02:24:51 pm by m.abudrais »

Handoko

  • Hero Member
  • *****
  • Posts: 4346
  • My goal: build my own game engine using Lazarus
Re: Drawing, shapes? Canvas? Disk Defrag map style
« Reply #3 on: September 25, 2021, 04:31:07 am »
TCanvas is slow, and TShape uses TCanvas. Using arrays of TShape to draw thousands of shapes is both slow and not memory-wise.

Here has a simple demo showing how to draw thousands of objects using buffer for (slightly) improving the performance (try moving2):
https://forum.lazarus.freepascal.org/index.php/topic,38136.msg263143.html#msg263143

TDrawGrid as suggested by jamie or using a TImage is better than using array of TShapes. But if you need better performance, you should consider to use hardware accelerated graphics libraries like Allegro.pas, TOpenGLControl, SDL.
https://wiki.freepascal.org/Game_framework

If learning a hardware-accelerated graphics library is too difficult, you may try Graphics32. I heard it is not hardware-accelerated but still very fast.
https://en.wikipedia.org/wiki/Graphics32

Tony Stone

  • Jr. Member
  • **
  • Posts: 96
Re: Drawing, shapes? Canvas? Disk Defrag map style
« Reply #4 on: September 25, 2021, 04:33:35 am »
So this is cool.  I copied it into a new project.  It looks like it performs quite well.  However, I would like to be able to display a Hint for each square.  Each squares is gonna represent some information so in a way I need to have some information stored with each square... which might be possible to associate the square coordinates with a mouse over event and trigger a hint.  Just seems like a lot of work.  I feel like there is something easy I am overlooking?

Thanks for your demo either way.  It is a start for sure!  And it only took you about 15 minutes to put that together?  Mine took me several hours.   :-[


try TImage
Code: Pascal  [Select][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls, dateutils;
  9.  
  10. type
  11.  
  12.   { TForm1 }
  13.  
  14.   TForm1 = class(TForm)
  15.     Button1: TButton;
  16.     Image1: TImage;
  17.     Timer1: TTimer;
  18.     procedure Button1Click(Sender: TObject);
  19.     procedure Timer1Timer(Sender: TObject);
  20.   private
  21.     LastTime: TDateTime;
  22.     TimeCounter: integer;
  23.     procedure UpdateImage;
  24.   public
  25.  
  26.   end;
  27.  
  28. var
  29.   Form1: TForm1;
  30.  
  31. implementation
  32.  
  33. {$R *.lfm}
  34.  
  35. { TForm1 }
  36.  
  37. procedure TForm1.Button1Click(Sender: TObject);
  38. begin
  39.   TimeCounter := 0;
  40.   UpdateImage;
  41. end;
  42.  
  43. procedure TForm1.Timer1Timer(Sender: TObject);
  44. var
  45.   M: int64;
  46. begin
  47.   UpdateImage;
  48.   Inc(TimeCounter);
  49.   M := MilliSecondsBetween(LastTime, Now);
  50.   if M > 5000 then
  51.   begin
  52.     Form1.Caption := round(50 * 100 * TimeCounter / (M / 1000)).ToString();
  53.     LastTime := Now;
  54.   end;
  55. end;
  56.  
  57. procedure TForm1.UpdateImage;
  58. var
  59.   k: integer;
  60.   m: integer;
  61.   c: TCanvas;
  62.   R: int64;
  63. begin
  64.   c := Image1.Canvas;
  65.   c.Brush.Color := clBlack;
  66.   c.FillRect(0, 0, Image1.Width, Image1.Height);
  67.   c.Brush.Color := clBlue;
  68.   for k := 0 to 50 do
  69.   begin
  70.     for m := 0 to 100 do
  71.     begin
  72.       R := Random(10);
  73.       if R > 5 then
  74.         c.Brush.Color := clBlue
  75.       else
  76.         c.Brush.Color := clGreen;
  77.       c.FillRect(m * 10, k * 10, m * 10 + 8, k * 10 + 8);
  78.     end;
  79.   end;
  80. end;
  81.  
  82. end.
  83.  
if you need more performance you use other lib like https://wiki.freepascal.org/BGRABitmap

Tony Stone

  • Jr. Member
  • **
  • Posts: 96
Re: Drawing, shapes? Canvas? Disk Defrag map style
« Reply #5 on: September 25, 2021, 05:07:21 am »
That isn't going to spawn much fruit..

 You should not be creating a GUI control for each square, you will hit a way and things will just stop!

Also, the scrollbox has a limit on the scrolling range and client size limits will change depending on the screen size.

 You should look at the TDrawGrid and implement drawing your own square areas...

Yeah... spawned square fruit... slowly. lol

It did kind of "work" at least.   I am looking at drawgrid now.  I think I looked at it initially and stopped focusing on it as i believe its the control that looked like a spreadsheet type control...

Tony Stone

  • Jr. Member
  • **
  • Posts: 96
Re: Drawing, shapes? Canvas? Disk Defrag map style
« Reply #6 on: September 25, 2021, 05:11:02 am »
That isn't going to spawn much fruit..

 You should not be creating a GUI control for each square, you will hit a way and things will just stop!

Also, the scrollbox has a limit on the scrolling range and client size limits will change depending on the screen size.

 You should look at the TDrawGrid and implement drawing your own square areas...

So drawgrid may be the solution.  I will have to revisit the progressbar in a cell of a tstringgrid that you helped me with a few weeks ago... hmmm....

loaded

  • Sr. Member
  • ****
  • Posts: 307
Re: Drawing, shapes? Canvas? Disk Defrag map style
« Reply #7 on: September 25, 2021, 09:42:04 am »
Actually, the fastest drawing method is OpenGL, but if you are going to make queries and similar operations other than drawing, you will find a lot of problems on your lap.
Another alternative is to use Image object and Thread, there seems to be no problem this duo can't handle. Of course for me :)

You can use the mathematical order you created for the squares during the query. It doesn't matter if you have thousands of frames. Thus, you can easily understand which frame the mouse is on the screen.
CAD software also works on this logic.
Lazarus V2.0.10 32 Bit + Intel I5 8250U + 12GB RAM + Win 10 Home 64 Bit = red pill
Morpheus: "You take the blue pill...the story ends, you wake up in your bed and believe whatever you want to believe. You take the red pill...you stay in Wonderland, and I show you how deep the rabbit hole goes."

wp

  • Hero Member
  • *****
  • Posts: 8897
Re: Drawing, shapes? Canvas? Disk Defrag map style
« Reply #8 on: September 25, 2021, 10:39:34 am »
Your initial solution using the TShape controls is probably slow only because the ScrollBox recalculates its size and repaints itself whenver you add or move each Shape. I cannot check it (you should always add a compilable project rather than pasting a code snippet which is useless for somebody who wants to test your code), but I guess that temporarily turning off AutoScroll could prevent that.

For the DrawGrid solution you were asking about how to show a hint for each cell. Turn on the grid's ShowHint, activate the option goCellHints and write a handler for OnGetCellHint to provide the hint text for the particular cell specified by the row/column index parameters.
Mainly Lazarus trunk / fpc 3.2.0 / all 32-bit on Win-10, but many more...

Tony Stone

  • Jr. Member
  • **
  • Posts: 96
Re: Drawing, shapes? Canvas? Disk Defrag map style
« Reply #9 on: September 25, 2021, 03:42:10 pm »
Your initial solution using the TShape controls is probably slow only because the ScrollBox recalculates its size and repaints itself whenver you add or move each Shape. I cannot check it (you should always add a compilable project rather than pasting a code snippet which is useless for somebody who wants to test your code), but I guess that temporarily turning off AutoScroll could prevent that.

For the DrawGrid solution you were asking about how to show a hint for each cell. Turn on the grid's ShowHint, activate the option goCellHints and write a handler for OnGetCellHint to provide the hint text for the particular cell specified by the row/column index parameters.

I actually was going to add a compilable project however I am running the trunk version of Lazarus... And for whatever reason it seems no one can ever open my projects unless they are on trunk version as well.  Some thing I have been meaning to look into and report a bug if needed... 

Tony Stone

  • Jr. Member
  • **
  • Posts: 96
Re: Drawing, shapes? Canvas? Disk Defrag map style
« Reply #10 on: September 25, 2021, 04:21:43 pm »
Actually, the fastest drawing method is OpenGL, but if you are going to make queries and similar operations other than drawing, you will find a lot of problems on your lap.
Another alternative is to use Image object and Thread, there seems to be no problem this duo can't handle. Of course for me :)

You can use the mathematical order you created for the squares during the query. It doesn't matter if you have thousands of frames. Thus, you can easily understand which frame the mouse is on the screen.
CAD software also works on this logic.

I was thinking last night this may be cool to handle with an additional thread.  I just couldn't exactly figure out in my head the best way to get started with it being as the thread can't handle GUI stuff directly.  I think maybe my first step will be to figure out how to do my drawing with the timage.  Then I will certainly be back with relevant questions


So tonight when I get time to play I am gonna try a drawgrid implementation and start the timage....  See you all soon.  Unless of course someone comes up with an even better way not discussed yet. :).  And I don't think I'm ready to tackle OpenGL... In a few years I'll try.

Seenkao

  • Full Member
  • ***
  • Posts: 249
Re: Drawing, shapes? Canvas? Disk Defrag map style
« Reply #11 on: September 25, 2021, 06:50:51 pm »
На самом деле OpenGL или DirectX (Windows) будет лучшим решением для данного решения. Но Bitmap тоже можно использовать, но вы должны уметь им достаточно быстро выводить квадратики. В данном случае лучше всего нарисовать изображение квадратика и спрайтом выводить его, в том количестве, в каком это необходимо. Используя буфер. И в конечном итоге выводить этот буфер на экран. Это будет работать достаточно быстро!

Yandex translate:
In fact, OpenGL or DirectX (Windows) will be the best solution for this solution. But Bitmap can also be used, but you should be able to output squares with it quickly enough. In this case, it is best to draw an image of a square and output it with a sprite, in the amount in which it is necessary. To do this, use the buffer. And eventually output this buffer to the screen. This will work fast enough!

An example of a program where I made a game. Note this code at the end:
  Buf.Canvas.Draw(Tank[1].x, Tank[1].y, Tanki[1, Tank[1].Povorot, Tank[1].Anim]);
  Form1. Canvas. Draw(0, 0, Buf);
this is the basis for displaying all sprites on the screen (i apologize for the comments in Russian... I just copied the code).
Code: Pascal  [Select][+][-]
  1. unit Unit1;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  7.   Dialogs, ExtCtrls;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     Timer1: TTimer;
  12.     procedure FormCreate(Sender: TObject);
  13.     procedure Timer1Timer(Sender: TObject);
  14.     procedure FormKeyDown(Sender: TObject; var Key: Word;
  15.       Shift: TShiftState);
  16.     procedure FormKeyUp(Sender: TObject; var Key: Word;
  17.       Shift: TShiftState);
  18.   private
  19.     { Private declarations }
  20.   public
  21.     { Public declarations }
  22.   end;
  23.  
  24. type
  25.   TTank = record
  26.     Speed, x, y, Povorot, Anim: Integer;      // скорость, координаты, направление
  27.     Go, Fight, Vistrel, Visible: Boolean;  // движемся или стоим?, стрельба, выстрелили ли мы уже?, видим или нет
  28.     Zaderhka_Visrela, Max_Vistrel: Integer;  // таймер задержки выстрела, и сама задержка
  29.     poyehal: Boolean;
  30.   end;
  31.  
  32. type
  33.   TPulya = record
  34.     x, y, Speed, Povorot: Integer;      // координаты, скорость, направление
  35.     visible: Boolean;                   // видна ли пуля?
  36.   end;
  37.  
  38. type
  39.   TFlag = record
  40.     x, y: integer;
  41.     Pic: TBitmap;
  42.   end;
  43.  
  44. var
  45.   Form1: TForm1;
  46.   Tanki: array[1..2, 1..4, 1..4] of TBitmap;  // 1-2 - два вида танков, 1-4 - направление
  47.                                               // 1-2 движение гусениц фнимация и 3-4 - анимация с выстрелом
  48.  
  49.   Textures: array[1..3, 1..3] of TBitmap;     // Массив картинок карты (земля, вода, лес)(.. .. последнее зима)
  50.   Flag: array[1..2] of TFlag;           // написано что характеристики и картинки флагов соперников на карте????
  51.   Map: array[0..10, 0..10] of Integer;  // Массив клеток игровой карты
  52.   Tank: array[1..4] of TTank;
  53.   Puli: array[1..20] of TPulya;
  54.   Pulya: array[1..4] of TBitmap;
  55.   Buf: TBitmap;        //Рисунок пули и буфер
  56.   path: string;               // будет хранить путь к игре
  57.   qUp, qDown, qLeft, qRight: Boolean;
  58.   i, j, k: Integer;
  59.  
  60. implementation
  61.  
  62. {$R *.dfm}
  63.  
  64. procedure TForm1.FormCreate(Sender: TObject);
  65. var
  66.   i, j: Integer;
  67. begin
  68.   path := ExtractFileDir(Application.ExeName);
  69.   //загрузка картинок танков
  70.   for i := 1 to 4 do
  71.     for j := 1 to 4 do
  72.     begin
  73.       Tanki[1, j, i] := TBitmap.Create;                 // загружаем картинки для первого танка (нашего, основного)
  74.       Tanki[1, j, i].TransparentColor := clWhite;
  75.       Tanki[1, j, i].Transparent := True;
  76.       Tanki[1, j, i].LoadFromFile(path + '\img\' + 'т1' + IntToStr(j) + IntToStr(i) + '.bmp');
  77.       Tanki[2, j, i] := TBitmap.Create;                 // загружаем картинки для второго танка (противник)
  78.       Tanki[2, j, i].TransparentColor := clWhite;       // картинки надо переделать
  79.       Tanki[2, j, i].Transparent := True;
  80.       Tanki[2, j, i].LoadFromFile(path + '\img\' + 'т2' + IntToStr(j) + IntToStr(i) + '.bmp');
  81.     end;
  82.  
  83.  
  84. //загружаем текстуры
  85.   for i := 1 to 3 do
  86.   begin
  87.     Textures[1, i] := TBitmap.Create;                                              // земля - полностью проходима
  88.     Textures[1, i].LoadFromFile(path + '\img\' + 'земля' + IntToStr(i) + '.bmp');
  89.     Textures[2, i] := TBitmap.Create;                                              // вода - проходима только зимой (один раз, лёд ломается)
  90.     Textures[2, i].LoadFromFile(path + '\img\' + 'вода' + IntToStr(i) + '.bmp');
  91.     Textures[3, i] := TBitmap.Create;                                              // лес - проходим, но скрывает танк,
  92. //    Textures[3, i].TransparentColor := Textures[3, i]
  93.     Textures[3, i].LoadFromFile(path + '\img\' + 'лес' + IntToStr(i) + '.bmp');    // надо установить прозрачность
  94.   end;
  95.  
  96. //загружаем рисунок пули в массив
  97.   for i := 1 to 4 do
  98.   begin
  99.     Pulya[i] := TBitmap.Create;
  100.     Pulya[i].TransparentColor := clWhite;
  101.     Pulya[i].Transparent := True;
  102.     Pulya[i].LoadFromFile(path + '\img\' + 'снаряд' + IntToStr(i) + '.bmp');
  103.   end;
  104.  
  105.   Buf := TBitmap.Create; // буфер для визуальной карты
  106.   Buf.Width := 600;
  107.   Buf.Height := 600;
  108.  
  109.   qLeft := False; //объект стоит и сообщаем что все кнопки отжаты
  110.   qUp := False;
  111.   qDown := False;
  112.   qRight := False;
  113.  
  114.   Tank[1].Speed := 10;
  115.   Tank[1].x := 60;
  116.   Tank[1].y := 540;
  117.   Tank[1].Povorot := 1;
  118.   Tank[1].Go := False;
  119.   Tank[1].Anim := 1;
  120.   Tank[1].Fight := False;
  121.   Tank[1].Zaderhka_Visrela := 0;
  122.   Tank[1].Max_Vistrel := 10;
  123.   Tank[1].Vistrel := False;
  124.   Tank[1].Visible := True;
  125.  
  126.   Tank[2].Speed := 7;
  127.   Tank[2].x := 480;
  128.   Tank[2].y := 0;
  129.   Tank[2].Povorot := 3;
  130.   Tank[2].Go := False;
  131.   Tank[2].Anim := 1;
  132.   Tank[2].Fight := False;
  133.   Tank[2].Zaderhka_Visrela := 0;
  134.   Tank[2].Max_Vistrel := 10;
  135.   Tank[2].Vistrel := False;
  136.   Tank[2].poyehal := False;
  137.   Tank[2].Visible := True;
  138.  
  139.   Tank[3].Speed := 5;
  140.   Tank[3].x := 540;
  141.   Tank[3].y := 60;
  142.   Tank[3].Povorot := 3;
  143.   Tank[3].Go := False;
  144.   Tank[3].Anim := 1;
  145.   Tank[3].Fight := False;
  146.   Tank[3].Zaderhka_Visrela := 0;
  147.   Tank[3].Max_Vistrel := 5;
  148.   Tank[3].Vistrel := False;
  149.   Tank[3].poyehal := False;
  150.   Tank[3].Visible := True;
  151.  
  152.   for i := 1 to 20 do
  153.   begin
  154.     Puli[i].x := 0;
  155.     Puli[i].y := 0;
  156.     Puli[i].Speed := 20;
  157.     Puli[i].Povorot := 0;
  158.     Puli[i].visible := False;
  159.   end;
  160.  
  161.   Flag[1].x := 9;
  162.   Flag[1].y := 0;
  163.   Flag[2].x := 0;
  164.   Flag[2].y := 9;
  165.   Flag[1].Pic := TBitmap.Create;
  166. //  Flag[1].Pic.TransparentColor := clWhite;
  167.   Flag[1].Pic.Transparent := True;
  168.   Flag[2].Pic := TBitmap.Create;
  169.   Flag[2].Pic.Transparent := True;
  170.   Flag[1].Pic.LoadFromFile(path + '\img\флаг1.bmp');
  171.   Flag[2].Pic.LoadFromFile(path + '\img\флаг2.bmp');
  172.  
  173.  
  174.  
  175.   //случайное генерирование карты
  176.   Randomize;
  177.   k := Random(3) + 1;   //выбираем один из 3-х факторов, вроде зима, лето, осень...
  178.   for i := 0 to 9 do
  179.     for j:= 0 to 9 do
  180.     begin
  181.       Map[i, j] := Random(100) + 1;
  182.       if Map[i, j] <= 50 then Map[i, j] := 1;
  183.       if (Map[i, j] > 50) and (Map[i, j] <= 80) then Map[i, j] := 3;
  184.       if Map[i, j] > 80 then Map[i, j] := 2;
  185.     end;
  186.     Map[Trunc(Tank[1].x / 60), Trunc(Tank[1].y / 60)] := 1;
  187. end;
  188.  
  189. procedure TForm1.Timer1Timer(Sender: TObject);
  190. var
  191.   i, j: Integer;
  192. begin
  193. // рисуем карту и танк на ней
  194.   for i := 0 to 9 do
  195.     for j := 0 to 9 do
  196.       Buf.Canvas.Draw(i * 60, j * 60, Textures[Map[i, j], k]);
  197.  
  198.   if Tank[1].Go = True then
  199.   begin
  200.     if Tank[1].Anim = 1 then Tank[1].Anim := 2
  201.     else Tank[1].Anim := 1;
  202.  
  203.     // UP
  204.     if (Tank[1].Povorot = 1) and (Map[Trunc(Tank[1].x / 60), Trunc((Tank[1].y - Tank[1].Speed) / 60)] = 1)
  205.         and (Map[Trunc((Tank[1].x + 59) / 60), Trunc((Tank[1].y - Tank[1].Speed) / 60)] = 1)
  206.         and (Tank[1].y - Tank[1].Speed >= 0) then Tank[1].y := Tank[1].y - Tank[1].Speed;
  207.     // расписываю. Если движение наверх и при этом выше левого угла танка нет препятствия и выше правого угла
  208.     // нет препятствия и при этом не находимся на самом верху карты, то продолжаем двигаться наверх.
  209.  
  210.     //DOWN
  211.     if (Tank[1].Povorot = 3) and (Map[Trunc(Tank[1].x / 60), Trunc((Tank[1].y + Tank[1].Speed + 59) / 60)] = 1)
  212.         and (Map[Trunc((Tank[1].x + 59 )/ 60), Trunc((Tank[1].y + Tank[1].Speed + 59)/60)] = 1)
  213.         and (Tank[1].y + Tank[1].Speed <= 540) then Tank[1].y := Tank[1].y + Tank[1].Speed;
  214.  
  215.     //RIGHT
  216.     if (Tank[1].Povorot = 2) and (Map[Trunc((Tank[1].x + Tank[1].Speed + 59) / 60), Trunc(Tank[1].y / 60)] = 1)
  217.         and (Map[Trunc((Tank[1].x + Tank[1].Speed + 59) / 60), Trunc((Tank[1].y + 59) / 60)] = 1)
  218.         and (Tank[1].x + Tank[1].Speed <= 540) then Tank[1].x := Tank[1].x + Tank[1].Speed;
  219.  
  220.     //LEFT
  221.     if (Tank[1].Povorot = 4) then
  222.       if (Map[Trunc((Tank[1].x - Tank[1].Speed) / 60), Trunc(Tank[1].y / 60)] = 1)
  223.         and (Map[Trunc((Tank[1].x - Tank[1].Speed) / 60), Trunc((Tank[1].y + 59) / 60)] = 1)
  224.         and (Tank[1].x - Tank[1].Speed >= 0) then
  225.      //   begin
  226.           Tank[1].x := Tank[1].x - Tank[1].Speed;
  227.       //    Tank[1].
  228.       //  end;
  229.   end;
  230.   Buf.Canvas.Draw(Tank[1].x, Tank[1].y, Tanki[1, Tank[1].Povorot, Tank[1].Anim]);
  231.   Form1.Canvas.Draw(0, 0, Buf);
  232. end;
  233.  
  234. procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  235.   Shift: TShiftState);
  236. begin
  237.   if Key = 87 then
  238.   begin
  239.     qUp := True;
  240.     Tank[1].Go := True;
  241.     Tank[1].Povorot := 1;
  242.   end;
  243.   if Key = 65 then
  244.   begin
  245.     qLeft := True;
  246.     Tank[1].Go := True;
  247.     Tank[1].Povorot := 4;
  248.   end;
  249.   if Key = 83 then
  250.   begin
  251.     qDown := True;
  252.     Tank[1].Go := True;
  253.     Tank[1].Povorot := 3;
  254.   end;
  255.   if Key = 68 then
  256.   begin
  257.     qRight := True;
  258.     Tank[1].Go := True;
  259.     Tank[1].Povorot := 2;
  260.   end;
  261. end;
  262.  
  263. procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word;
  264.   Shift: TShiftState);
  265. begin
  266.   if (Key = 87) then qUp := False;
  267.   if Key = 65 then qLeft := False;
  268.   if Key = 83 then qDown := False;
  269.   if Key = 68 then qRight := False;
  270.   if (qUp = False) and (qLeft = False) and (qRight = False) and (qDown = False) then Tank[1].Go := False;
  271. end;
  272.  
  273. end.

wp

  • Hero Member
  • *****
  • Posts: 8897
Re: Drawing, shapes? Canvas? Disk Defrag map style
« Reply #12 on: September 25, 2021, 07:34:35 pm »
I actually was going to add a compilable project however I am running the trunk version of Lazarus... And for whatever reason it seems no one can ever open my projects unless they are on trunk version as well.  Some thing I have been meaning to look into and report a bug if needed...
Go to Project Options > Miscellaneous and check the box "Maximize compatibility of project files (LPI and LPS)" - this way the old file format will be written and users of Laz 2.0.x or older still can open the project.

Users not having Lazarus trunk/2.2RC1 can convert a project from the new to the old format by using the utility "FixLP" on CCR (https://sourceforge.net/p/lazarus-ccr/svn/HEAD/tree/applications/fixlp/).
Mainly Lazarus trunk / fpc 3.2.0 / all 32-bit on Win-10, but many more...

loaded

  • Sr. Member
  • ****
  • Posts: 307
Re: Drawing, shapes? Canvas? Disk Defrag map style
« Reply #13 on: September 25, 2021, 08:28:29 pm »
I was thinking last night this may be cool to handle with an additional thread.  I just couldn't exactly figure out in my head the best way to get started with it being as the thread can't handle GUI stuff directly.  I think maybe my first step will be to figure out how to do my drawing with the timage.  Then I will certainly be back with relevant questions
So tonight when I get time to play I am gonna try a drawgrid implementation and start the timage....  See you all soon.  Unless of course someone comes up with an even better way not discussed yet. :).  And I don't think I'm ready to tackle OpenGL... In a few years I'll try.
Threads cannot access the user graphics unit directly. This is true. But the trick is, you do the drawing process to an object of tbitmap type (we call it buffering) in the thread, you transfer the timage object over the main thread with the synchronized method at an interval you specify while the drawing process continues, you complete the drawing without any disturbing situation for the user.
I say it again. This is how CAD applications work. Thus, they overcome scenarios of drawing and interrogating thousands of shape objects on the screen.
If you are dealing with graphic works and if you are going to deal with it in the future, it is very useful to learn this method.
Lazarus V2.0.10 32 Bit + Intel I5 8250U + 12GB RAM + Win 10 Home 64 Bit = red pill
Morpheus: "You take the blue pill...the story ends, you wake up in your bed and believe whatever you want to believe. You take the red pill...you stay in Wonderland, and I show you how deep the rabbit hole goes."

paweld

  • Sr. Member
  • ****
  • Posts: 312
Re: Drawing, shapes? Canvas? Disk Defrag map style
« Reply #14 on: September 25, 2021, 09:39:08 pm »
DrawGrid?
Best regards
paweld

 

TinyPortal © 2005-2018