* * *

Author Topic: How to handle moving and deleting of objects drawn on a bitmap?  (Read 6199 times)

Mr.Madguy

  • Full Member
  • ***
  • Posts: 200
Re: How to handle moving and deleting of objects drawn on a bitmap?
« Reply #30 on: May 18, 2017, 08:42:20 am »
I was wondering how to also delete a sprite under the mouse as I couldn't work it out? %)
It's obvious - the same way, you add it. You need to delete sprite from sprite list, update bitmap and make sure you no longer have any references to it (i.e. SpriteUnderCursor and FClickedSprite). Try doing it yourself first.

Also I think I noticed a bug, if lots of sprites are added very close together, when you resize the form the main bitmap changes and then just moving your mouse over the sprites again causes them to change again?
Errr. It's due to performance optimization, I've added in last version of my program - I wanted to make resizing faster. That's, what happens, when clipping doesn't work. That's because implicit clipping works for Canvas of control itself, but not for Bitmap. I've fixed it for Windows via adding explicit clipping to Bitmap too. But unfortunately, again, this feature has to be disabled on Linux - all code, related to FUpdateCount, has to be removed.  :'( Clipping is needed and as result we have all this problems with it, because I have to use Draw method of Canvas - not CopyRect. Masking doesn't work for CopyRect.

Code: Pascal  [Select]
  1. unit SpriteControl;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses {$ifdef windows}Windows,{$endif} Classes, Controls, Graphics, Fgl;
  8.  
  9. type
  10.   TSprite = class
  11.   protected
  12.     FBitmap:TBitmap;
  13.   public
  14.     Rect:TRect;
  15.     constructor Create(ABitmap:TBitmap;ACoord:TPoint);
  16.     destructor Destroy;override;
  17.     procedure Draw(ACanvas:TCanvas;ARect:TRect);
  18.     procedure Move(APoint:TPoint);
  19.     function HitTest(APoint:TPoint):Boolean;
  20.     property Bitmap:TBitmap read FBitmap;
  21.   end;
  22.  
  23.   TSpriteList = specialize TFPGObjectList<TSprite>;
  24.  
  25.   TSpriteControl = class(TCustomControl)
  26.   protected
  27.     FBitmap:TBitmap;
  28.     FSprites:TSpriteList;
  29.     FSpriteUnderCursor:TSprite;
  30.     {$ifdef windows}
  31.     FNeedUpdate:Boolean;
  32.     {$endif}
  33.     FClickedSprite:TSprite;
  34.     FClickedPoint:TPoint;
  35.     FClickedCoord:TPoint;
  36.     FDragging:Boolean;
  37.     procedure Paint;override;
  38.     procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer);override;
  39.     procedure MouseMove(Shift: TShiftState; X,Y: Integer);override;
  40.     procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X,Y:Integer);override;
  41.     procedure SetSpriteUnderCursor(ASprite:TSprite);
  42.   public
  43.     BackgroundColor:TColor;
  44.     constructor Create(AOwner: TComponent);override;
  45.     destructor Destroy;override;
  46.     procedure AddSprite(ASprite:TSprite);
  47.     procedure UpdateSprite(ASprite:TSprite);
  48.     property Bitmap:TBitmap read FBitmap;
  49.     property Sprites:TSpriteList read FSprites;
  50.     property SpriteUnderCursor:TSprite read FSpriteUnderCursor write SetSpriteUnderCursor;
  51.   end;
  52.  
  53.  
  54. implementation
  55.  
  56. uses SysUtils;
  57.  
  58. constructor TSprite.Create(ABitmap:TBitmap;ACoord:TPoint);
  59. begin
  60.   inherited Create;
  61.   FBitmap := ABitmap;
  62.   Rect := TRect.Create(ACoord, Bitmap.Width, Bitmap.Height);
  63. end;
  64.  
  65. destructor TSprite.Destroy;
  66. begin
  67.   FBitmap.Free;
  68.   inherited Destroy;
  69. end;
  70.  
  71. procedure TSprite.Draw(ACanvas:TCanvas;ARect:TRect);
  72. begin
  73.   if not (ARect * Rect).IsEmpty then begin
  74.     ACanvas.Draw(Rect.Left, Rect.Top, Bitmap);
  75.   end;
  76. end;
  77.  
  78. procedure TSprite.Move(APoint:TPoint);
  79. begin
  80.   Rect := TRect.Create(APoint, Bitmap.Width, Bitmap.Height);
  81. end;
  82.  
  83. function TSprite.HitTest(APoint:TPoint):Boolean;
  84. begin
  85.   Result := Rect.Contains(APoint);
  86.   if Result and Bitmap.Transparent then begin
  87.     APoint := APoint - Rect.TopLeft;
  88.     Result := Bitmap.Canvas.Pixels[APoint.X, APoint.Y] <> Bitmap.TransparentColor;
  89.   end;
  90. end;
  91.  
  92. constructor TSpriteControl.Create(AOwner: TComponent);
  93. begin
  94.   inherited Create(AOwner);
  95.   FBitmap := TBitmap.Create;
  96.   FSprites := TSpriteList.Create;
  97.   {$ifdef windows}
  98.   FNeedUpdate := True;
  99.   {$endif}
  100. end;
  101.  
  102. destructor TSpriteControl.Destroy;
  103. begin
  104.   FBitmap.Free;
  105.   FSprites.Free;
  106.   inherited Destroy;
  107. end;
  108.  
  109. procedure TSpriteControl.AddSprite(ASprite:TSprite);
  110. begin
  111.   Sprites.Insert(0, ASprite);
  112.   UpdateSprite(ASprite);
  113. end;
  114.  
  115. procedure TSpriteControl.UpdateSprite(ASprite:TSprite);
  116. begin
  117.   {$ifdef windows}
  118.     InvalidateRect(Handle, ASprite.Rect, False);
  119.     FNeedUpdate := True;
  120.   {$else}
  121.     Invalidate;
  122.   {$endif}
  123. end;
  124.  
  125. procedure TSpriteControl.Paint;
  126.   var Rect, ClipRect, PaintRect:TRect;
  127.   I:Integer;Sprite:TSprite;
  128.   FocusSprite:TSprite;
  129.   {$ifdef windows}
  130.   ClipRgn:HRGN;
  131.   {$endif}
  132. begin
  133.   inherited Paint;
  134.   Rect := TRect.Create(TPoint.Create(0, 0), Bitmap.Width, Bitmap.Height);
  135.   ClipRect := Canvas.ClipRect;
  136.   PaintRect := Rect * ClipRect;
  137.   {$ifdef windows}
  138.   if FNeedUpdate then begin
  139.   {$endif}
  140.     with Bitmap.Canvas do begin
  141.       {$ifdef windows}
  142.       ClipRgn := CreateRectRgn(PaintRect.Left, PaintRect.Top, PaintRect.Right, PaintRect.Bottom);
  143.       SelectClipRgn(Handle, ClipRgn);
  144.       {$endif}
  145.       Brush.Color := BackgroundColor;
  146.       FillRect(PaintRect);
  147.     end;
  148.     FocusSprite := nil;
  149.     for I := Sprites.Count - 1 downto 0 do begin
  150.       Sprite := Sprites[I];
  151.       Sprite.Draw(Bitmap.Canvas, PaintRect);
  152.       if Sprite = SpriteUnderCursor then begin
  153.         FocusSprite := Sprite;
  154.       end;
  155.     end;
  156.     if Assigned(FocusSprite) then begin
  157.       with Bitmap.Canvas do begin
  158.         DrawFocusRect(FocusSprite.Rect);
  159.       end;
  160.     end;
  161.   {$ifdef windows}
  162.     with Bitmap.Canvas do begin
  163.       SelectClipRgn(Handle, 0);
  164.       DeleteObject(ClipRgn);
  165.     end;
  166.     FNeedUpdate := False;
  167.   end;
  168.   {$endif}
  169.   Canvas.CopyRect(PaintRect, Bitmap.Canvas, PaintRect);
  170.   if not PaintRect.Contains(ClipRect) then begin
  171.     Canvas.Brush.Color := Color;
  172.     Rect := ClientRect;
  173.     Rect.Left := Bitmap.Width;
  174.     Rect.Intersect(ClipRect);
  175.     Canvas.FillRect(Rect);
  176.     Rect := ClientRect;
  177.     Rect.Top := Bitmap.Height;
  178.     Rect.Width := Bitmap.Width;
  179.     Rect.Intersect(ClipRect);
  180.     Canvas.FillRect(Rect);
  181.   end;
  182. end;
  183.  
  184. procedure TSpriteControl.MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer);
  185.   var I:Integer;Sprite, HitSprite:TSprite;
  186. begin
  187.   inherited MouseDown(Button, Shift, X, Y);
  188.   if Button = mbLeft then begin
  189.     HitSprite := nil;
  190.     for I := 0 to Sprites.Count - 1 do begin
  191.       Sprite := Sprites[I];
  192.       if Sprite.HitTest(TPoint.Create(X, Y)) then begin
  193.         HitSprite := Sprite;
  194.         FClickedPoint := TPoint.Create(X, Y);
  195.         FClickedCoord := Sprite.Rect.TopLeft;
  196.         Break;
  197.       end;
  198.     end;
  199.     FClickedSprite := HitSprite;
  200.   end;
  201. end;
  202.  
  203. procedure TSpriteControl.MouseMove(Shift: TShiftState; X,Y: Integer);
  204.   var I:Integer;Sprite, HitSprite:TSprite;
  205. begin
  206.   inherited MouseMove(Shift, X, Y);
  207.   if Assigned(FClickedSprite) then begin
  208.     if not FDragging then begin
  209.       if (Abs(X - FClickedPoint.X) > 5) or (Abs(Y - FClickedPoint.Y) > 5) then begin
  210.         FDragging := True;
  211.       end;
  212.     end;
  213.     if FDragging then begin
  214.       UpdateSprite(FClickedSprite);
  215.       FClickedSprite.Move(FClickedCoord + TPoint.Create(X, Y) - FClickedPoint);
  216.       UpdateSprite(FClickedSprite);
  217.       SpriteUnderCursor := FClickedSprite;
  218.       Exit;
  219.     end;
  220.   end;
  221.   HitSprite := nil;
  222.   for I := 0 to Sprites.Count - 1 do begin
  223.     Sprite := Sprites[I];
  224.     if Sprite.HitTest(TPoint.Create(X, Y)) then begin
  225.       HitSprite := Sprite;
  226.     end;
  227.   end;
  228.   SpriteUnderCursor := HitSprite;
  229. end;
  230.  
  231. procedure TSpriteControl.MouseUp(Button: TMouseButton; Shift:TShiftState; X,Y:Integer);
  232. begin
  233.   inherited MouseUp(Button, Shift, X, Y);
  234.   if Button = mbLeft then begin
  235.     if FDragging then begin
  236.       FDragging := False;
  237.     end
  238.     else begin
  239.       if Assigned(FClickedSprite) then begin
  240.         Sprites.Move(Sprites.IndexOf(FClickedSprite), 0);
  241.         UpdateSprite(FClickedSprite);
  242.       end;
  243.     end;
  244.     FClickedSprite := nil;
  245.   end;
  246. end;
  247.  
  248. procedure TSpriteControl.SetSpriteUnderCursor(ASprite:TSprite);
  249.   var OldSprite:TSprite;
  250. begin
  251.   if SpriteUnderCursor <> ASprite then begin
  252.     OldSprite := SpriteUnderCursor;
  253.     FSpriteUnderCursor := ASprite;
  254.     if Assigned(OldSprite) then begin
  255.       UpdateSprite(OldSprite);
  256.     end;
  257.     if Assigned(SpriteUnderCursor) then begin
  258.       UpdateSprite(SpriteUnderCursor);
  259.     end;
  260.   end;
  261. end;
  262.  
  263. end.
  264.  

P.S. I've replaced FUpdateCount with FNeedUpdate.

P.P.S. I have some crazy idea for software rendering example, but unfortunately I was very busy yesterday and will also be busy for next two days. If I will have some free time - I'll do it.
« Last Edit: May 18, 2017, 01:33:10 pm by Mr.Madguy »
Completely overhauling DynamicData 1.0 on it's way to 2.0
Crazy unit testing

knuckles

  • Full Member
  • ***
  • Posts: 100
Re: How to handle moving and deleting of objects drawn on a bitmap?
« Reply #31 on: May 18, 2017, 05:16:31 pm »
I came up with this for the deletion:

Code: Pascal  [Select]
  1. procedure TSpriteControl.DeleteSpriteUnderMouse;
  2. var
  3.   I: Integer;
  4. begin
  5.   if SpriteUnderCursor <> nil then
  6.   begin
  7.     for I := Sprites.Count -1 downto 0 do
  8.     begin
  9.       if Sprites.Items[I] = SpriteUnderCursor then
  10.       begin
  11.         Sprites.Delete(I);
  12.         Exit;
  13.       end;
  14.     end;
  15.   end;
  16. end;

I guess that should be good enough?

EDIT: It seems there is more still to do, as your last comment suggests I need to update the bitmap still as ghost sprites are still left behind...



As for the update I haven't properly tested but it seems ok thanks.

It sounds like the current implementation has limitations as you described with the clipping of the bitmap etc. Anyway you've already done a great amount of work here so you shouldn't push yourself anymore, having said that though if you were to come back when you have some free time and post your crazy idea that would be interesting to see for sure, but again dont feel obliged that you have to I already appreciate your efforts ;)
« Last Edit: May 18, 2017, 05:42:40 pm by knuckles »

Mr.Madguy

  • Full Member
  • ***
  • Posts: 200
Re: How to handle moving and deleting of objects drawn on a bitmap?
« Reply #32 on: May 18, 2017, 06:22:38 pm »
I came up with this for the deletion:

Code: Pascal  [Select]
  1. procedure TSpriteControl.DeleteSpriteUnderMouse;
  2. var
  3.   I: Integer;
  4. begin
  5.   if SpriteUnderCursor <> nil then
  6.   begin
  7.     for I := Sprites.Count -1 downto 0 do
  8.     begin
  9.       if Sprites.Items[I] = SpriteUnderCursor then
  10.       begin
  11.         Sprites.Delete(I);
  12.         Exit;
  13.       end;
  14.     end;
  15.   end;
  16. end;

I guess that should be good enough?

There is shorter and faster way to do it:
Code: Pascal  [Select]
  1. if Assigned(SpriteUnderCursor) then begin
  2.    Sprites.Remove(SpriteUnderCursor);
  3. end;
  4.  

EDIT: It seems there is more still to do, as your last comment suggests I need to update the bitmap still as ghost sprites are still left behind...

It's not that hard:
1) UpdateSprite(SpriteUnderCursor);
2) if FClickedSprite = SpriteUnderCursor  then begin FClickedSprite := nil; FDragging := False; end; 
3) SpriteUnderCursor := nil; 



As for the update I haven't properly tested but it seems ok thanks.

It sounds like the current implementation has limitations as you described with the clipping of the bitmap etc. Anyway you've already done a great amount of work here so you shouldn't push yourself anymore, having said that though if you were to come back when you have some free time and post your crazy idea that would be interesting to see for sure, but again dont feel obliged that you have to I already appreciate your efforts ;)
No. There is simple rule in programming: most obvious algorithm is usually the slowest one. It's just tweaks and optimizations to maximize performance via minimizing amount of redrawing, cuz redrawing - is the most expensive part. And it's iterative process. In my real program even more advanced algorithm is used. As you can see, no sprites are being redrawn at all, if none are updated - we just copy Bitmap to Canvas and that's it. Also clipping allows us to redraw only those sprites, that intersect with current update rect - other sprites stay unaffected. Plus I take old versions of Windows into account. They don't have built-in double-buffering (cuz Canvas has been drawn into temporary texture to be rendered via Direct3D since Vista only) - therefore any direct drawing on Canvas can cause flickering. Plus I try to use minimal amount of memory - just one back buffer. There are more simple, but much slower solutions. Most obvious one - just redraw all sprites every time. Another solution, that is a little bit slower, but should be cross platform - triple-buffering. You should also understand, that if you need to draw background, that is grid of sprites - more simple decomposition algorithms can be used to detect visibility and hit testing.

Of course other methods are possible, but they can't be based solely on GDI - they require either software rendering or using OpenGL/Direct3D.
« Last Edit: May 18, 2017, 06:33:05 pm by Mr.Madguy »
Completely overhauling DynamicData 1.0 on it's way to 2.0
Crazy unit testing

knuckles

  • Full Member
  • ***
  • Posts: 100
Re: How to handle moving and deleting of objects drawn on a bitmap?
« Reply #33 on: May 18, 2017, 06:42:32 pm »
There is shorter and faster way to do it:
Code: Pascal  [Select]
  1. if Assigned(SpriteUnderCursor) then begin
  2.    Sprites.Remove(SpriteUnderCursor);
  3. end;
  4.  

......

It's not that hard:
1) UpdateSprite(SpriteUnderCursor);
2) if FClickedSprite = SpriteUnderCursor  then begin FClickedSprite := nil; FDragging := False; end; 
3) SpriteUnderCursor := nil;

Umm maybe I did something wrong :-[

This leaves ghost images behind still sometimes: %)

Code: Pascal  [Select]
  1. procedure TSpriteControl.DeleteSpriteUnderMouse;
  2. begin
  3.   if Assigned(SpriteUnderCursor) then begin
  4.     Sprites.Remove(SpriteUnderCursor);
  5.     UpdateSprite(SpriteUnderCursor);
  6.  
  7.     if FClickedSprite = SpriteUnderCursor then begin
  8.       FClickedSprite := nil;
  9.       FDragging := False;
  10.     end;
  11.  
  12.     SpriteUnderCursor := nil;
  13.   end;
  14. end;

argb32

  • Jr. Member
  • **
  • Posts: 71
    • Pascal IDE based on IntelliJ platform
Re: How to handle moving and deleting of objects drawn on a bitmap?
« Reply #34 on: May 18, 2017, 07:37:06 pm »
Yeah. BIOS functions were slow just because they were altering just one bit in video memory (4-plane 1bpp EGA for example), but had to calculate it's address, bitmask to access it and set up video adapter registers for every single pixel. My library had to overcome this problem too. But still - horizontal moving of sprites and horizontal scrolling were limited to 8-pixel blocks only. It's actually very noticeable in some old DOS games - that horizontal scrolling is quantized.

Most games still drew sprites at arbitrary coordinates. But it required some additional processing.
As of scrolling - EGA adapters had special register which controlled starting address of video memory which is visible at screen's top left corner.
Changing that register is a sort of hardware accelerated scrolling. But it scrolled with 8 pixels granularity.
But there was another one register which controlled starting bit or something like this.
Manipulating both of the registers gave pixel-precise scrolling.
I did this - it worked.
Games like Dangerous Dave also used this.

I.e. what do you have to do to scroll your level on PC? On modern computers you can redraw everything from scratch. Back in that old days CPUs were too weak to do it. You had to shift image via copying it. And even simple memory copying was too slow on my 12Mhz Intel 80286, just because you had to use movsb, that was twice slower, than movsw, just because video adapter latch register was just 8bit wide - it was taking whole CPU time in EGA 640x350 mode (that's why all old games usually used 320x200, besides of having compatibility with VGA 8bpp mode). And what do you have to do on NES? Just 5 instructions:

Games like Duke Nukem used the "total redraw" method and ran well on my 8MHz PC XT

Mr.Madguy

  • Full Member
  • ***
  • Posts: 200
Re: How to handle moving and deleting of objects drawn on a bitmap?
« Reply #35 on: May 18, 2017, 07:48:12 pm »
Umm maybe I did something wrong :-[

This leaves ghost images behind still sometimes: %)

Code: Pascal  [Select]
  1. procedure TSpriteControl.DeleteSpriteUnderMouse;
  2. begin
  3.   if Assigned(SpriteUnderCursor) then begin
  4.     Sprites.Remove(SpriteUnderCursor);
  5.     UpdateSprite(SpriteUnderCursor);
  6.  
  7.     if FClickedSprite = SpriteUnderCursor then begin
  8.       FClickedSprite := nil;
  9.       FDragging := False;
  10.     end;
  11.  
  12.     SpriteUnderCursor := nil;
  13.   end;
  14. end;
Try this:
Code: Pascal  [Select]
  1. procedure TSpriteControl.DeleteSpriteUnderCursor;
  2.   var Temp:TSprite;
  3. begin
  4.   if Assigned(SpriteUnderCursor) then begin
  5.     Temp := SpriteUnderCursor;
  6.     if FClickedSprite = Temp then begin
  7.       FClickedSprite := nil;
  8.       FDragging := False;
  9.     end;
  10.     SpriteUnderCursor := nil;
  11.     Sprites.Remove(Temp);
  12.   end;
  13. end;
  14.  
I don't see any ghost sprites in both cases, but that's may be because target is 64bit by default for me. But initial code is still unsafe, cuz Sprites - is object list and it destroys object, when it's removed. May be that's, why you sometimes get ghost sprites. UpdateSprite is removed, cuz SpriteUnderCursor := nil; does the same.

P.S. And don't be afraid of clipping. Windows itself works this way (emm, worked in the past). In order to simulate whole window system from scratch, you need just 3 things: rects, clipping and Z-ordered lists.
« Last Edit: May 18, 2017, 10:26:32 pm by Mr.Madguy »
Completely overhauling DynamicData 1.0 on it's way to 2.0
Crazy unit testing

knuckles

  • Full Member
  • ***
  • Posts: 100
Re: How to handle moving and deleting of objects drawn on a bitmap?
« Reply #36 on: May 18, 2017, 07:56:14 pm »
That seems to work thanks Mr.Madguy ;D

I'm gonna play around with your code some more and try and understand it better its quite interesting 8-)

Mr.Madguy

  • Full Member
  • ***
  • Posts: 200
Re: How to handle moving and deleting of objects drawn on a bitmap?
« Reply #37 on: May 18, 2017, 08:24:39 pm »
Most games still drew sprites at arbitrary coordinates. But it required some additional processing.
As of scrolling - EGA adapters had special register which controlled starting address of video memory which is visible at screen's top left corner.
Changing that register is a sort of hardware accelerated scrolling. But it scrolled with 8 pixels granularity.
But there was another one register which controlled starting bit or something like this.
Manipulating both of the registers gave pixel-precise scrolling.
I did this - it worked.
Games like Dangerous Dave also used this.
As I remember, I actually tried all this methods and something didn't work well. That's, what I'm talking about: there was ton of info about adapters themselves, but no working examples of real applications. For example IRQ 2 on retrace would be useful, but it was used as cascade one.

P.S. And yeah, shifting bits - was slow operation too. May be it was possible to store 8 copies of the same sprites, but I just decided to use 8-pixel blocks instead.  %)

P.S.S. As I remember, I even tried to copy pages of video memory via DMA memory-memory mode.  :o

And on NES everything is quite simple. You don't even need any timers, as framerate is fixed. Your app usually works this way:
Code: [Select]
Init;
while True do begin
   WaitForFrameStart;
   //PPU is now busy - we can do our stuff
   ReadJoystics;
   DoGameLogic;
   //We should prepare this in advance, cuz retrace period is short
   FillBuffersWithDataForPPU;
end;

//NMI interrupt - is thing, whole program is built around
procedure OnRetrace;
begin
   //PPU is busy during frame rendering
   //Short period, when we can send data to it
   UpdatePPU;
   //Framerate is fixed, so retrace is used for sound timing
   //Since PPU is updated, there is no reason for hurrying
   //But we shouldn't waste whole processor time
   //Some room should be left for game logic
   UpdateSound;
end;

Games like Duke Nukem used the "total redraw" method and ran well on my 8MHz PC XT
That's most amazing thing about games from that period of time. Even if you knew asm and low level optimizing, you still couldn't imagine, how such games could be made. But at the same time they existed, so it was possible and you could actually reproduce them from scratch. And this idea was just blowing your mind. Because it was amazing, how it was possible to make such games on machines, that barely could copy data from one place to another within time of one frame.
« Last Edit: May 18, 2017, 10:24:33 pm by Mr.Madguy »
Completely overhauling DynamicData 1.0 on it's way to 2.0
Crazy unit testing

knuckles

  • Full Member
  • ***
  • Posts: 100
Re: How to handle moving and deleting of objects drawn on a bitmap?
« Reply #38 on: May 18, 2017, 11:02:35 pm »
It really is fascinating how games could run so well on old low spec machines, the discussions in this thread are rather insightful and interesting :) 8-)

Mr.Madguy

  • Full Member
  • ***
  • Posts: 200
Re: How to handle moving and deleting of objects drawn on a bitmap?
« Reply #39 on: May 20, 2017, 08:57:04 pm »
Ok. First of all - small fix for original program:
Code: Pascal  [Select]
  1. unit TestMain;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, SpriteControl,
  9.   LCLType;
  10.  
  11. type
  12.  
  13.   { TSpriteTestForm }
  14.  
  15.   TSpriteTestForm = class(TForm)
  16.     procedure FormCreate(Sender: TObject);
  17.     procedure FormDestroy(Sender: TObject);
  18.     procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
  19.     procedure SpriteControlMouseUp(Sender: TObject; Button: TMouseButton;
  20.       Shift: TShiftState; X, Y: Integer);
  21.   private
  22.     { private declarations }
  23.   public
  24.     { public declarations }
  25.     SpriteControl:TSpriteControl;
  26.     SpriteBitmap:TBitmap;
  27.     function CreateSprite(AIndex:Integer):TBitmap;
  28.   end;
  29.  
  30. var
  31.   SpriteTestForm: TSpriteTestForm;
  32.  
  33. implementation
  34.  
  35. {$R *.lfm}
  36.  
  37. { TSpriteTestForm }
  38.  
  39. procedure TSpriteTestForm.FormCreate(Sender: TObject);
  40. begin
  41.   Randomize;
  42.   SpriteBitmap := TBitmap.Create;
  43.   SpriteBitmap.LoadFromFile('Sprites.bmp');
  44.   SpriteControl := TSpriteControl.Create(Self);
  45.   with SpriteControl do begin
  46.     Parent := Self;
  47.     OnMouseUp := @SpriteControlMouseUp;
  48.     Align := alClient;
  49.     Bitmap.Width := 640;
  50.     Bitmap.Height := 480;
  51.     BackgroundColor := clGreen;
  52.   end;
  53. end;
  54.  
  55. procedure TSpriteTestForm.FormDestroy(Sender: TObject);
  56. begin
  57.   SpriteBitmap.Free;
  58. end;
  59.  
  60. procedure TSpriteTestForm.FormKeyDown(Sender: TObject; var Key: Word;
  61.   Shift: TShiftState);
  62. begin
  63.   if Key = VK_DELETE then begin
  64.     SpriteControl.DeleteSpriteUnderCursor;
  65.   end;
  66. end;
  67.  
  68. procedure TSpriteTestForm.SpriteControlMouseUp(Sender: TObject; Button: TMouseButton;
  69.   Shift: TShiftState; X, Y: Integer);
  70. begin
  71.   if Button = mbRight then begin
  72.     SpriteControl.AddSprite(TSprite.Create(CreateSprite(Random(12 * 8 - 1)), TPoint.Create(X - 40, Y - 40)));
  73.   end;
  74. end;
  75.  
  76. function TSpriteTestForm.CreateSprite(AIndex:Integer):TBitmap;
  77.   var Src, Dest:TRect;
  78. begin
  79.   Result := nil;
  80.   if (AIndex >= 0) and (AIndex < 12 * 8) then begin
  81.     Result := TBitmap.Create;
  82.     with Result do begin
  83.       Width := 81;
  84.       Height := 81;
  85.       Dest := TRect.Create(TPoint.Create(0, 0), 81, 81);
  86.       Src := Dest;
  87.       Src.Offset(5 + 81 * (AIndex mod 12), 5 + 81 * (AIndex div 12));
  88.       Canvas.CopyRect(Dest, SpriteBitmap.Canvas, Src);
  89.       Transparent := True;
  90.       TransparentColor := clBlack;
  91.       Mask(clBlack);
  92.     end;
  93.   end;
  94. end;
  95.  
  96. end.
  97.  
Code: Pascal  [Select]
  1. unit SpriteControl;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses {$ifdef windows}Windows,{$endif} Classes, Controls, Graphics, Fgl;
  8.  
  9. type
  10.   TSprite = class
  11.   protected
  12.     FBitmap:TBitmap;
  13.     FRect:TRect;
  14.   public
  15.     constructor Create(ABitmap:TBitmap;ACoord:TPoint);
  16.     destructor Destroy;override;
  17.     procedure Draw(ACanvas:TCanvas;ARect:TRect);
  18.     procedure Move(APoint:TPoint);
  19.     function HitTest(APoint:TPoint):Boolean;
  20.     property Bitmap:TBitmap read FBitmap;
  21.     property Rect:TRect read FRect;
  22.   end;
  23.  
  24.   TSpriteList = specialize TFPGObjectList<TSprite>;
  25.  
  26.   TSpriteControl = class(TCustomControl)
  27.   protected
  28.     FBitmap:TBitmap;
  29.     FSprites:TSpriteList;
  30.     FSpriteUnderCursor:TSprite;
  31.     {$ifdef windows}
  32.     FNeedUpdate:Boolean;
  33.     {$endif}
  34.     FClickedSprite:TSprite;
  35.     FClickedPoint:TPoint;
  36.     FClickedCoord:TPoint;
  37.     FDragging:Boolean;
  38.     procedure Paint;override;
  39.     procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer);override;
  40.     procedure MouseMove(Shift: TShiftState; X,Y: Integer);override;
  41.     procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X,Y:Integer);override;
  42.     procedure SetSpriteUnderCursor(ASprite:TSprite);
  43.   public
  44.     BackgroundColor:TColor;
  45.     constructor Create(AOwner: TComponent);override;
  46.     destructor Destroy;override;
  47.     procedure AddSprite(ASprite:TSprite);
  48.     procedure UpdateSprite(ASprite:TSprite);
  49.     procedure DeleteSpriteUnderCursor;
  50.     property Bitmap:TBitmap read FBitmap;
  51.     property Sprites:TSpriteList read FSprites;
  52.     property SpriteUnderCursor:TSprite read FSpriteUnderCursor write SetSpriteUnderCursor;
  53.   end;
  54.  
  55.  
  56. implementation
  57.  
  58. constructor TSprite.Create(ABitmap:TBitmap;ACoord:TPoint);
  59. begin
  60.   inherited Create;
  61.   FBitmap := ABitmap;
  62.   FRect := TRect.Create(ACoord, Bitmap.Width, Bitmap.Height);
  63. end;
  64.  
  65. destructor TSprite.Destroy;
  66. begin
  67.   FBitmap.Free;
  68.   inherited Destroy;
  69. end;
  70.  
  71. procedure TSprite.Draw(ACanvas:TCanvas;ARect:TRect);
  72. begin
  73.   if not (ARect * Rect).IsEmpty then begin
  74.     ACanvas.Draw(Rect.Left, Rect.Top, Bitmap);
  75.   end;
  76. end;
  77.  
  78. procedure TSprite.Move(APoint:TPoint);
  79. begin
  80.   FRect := TRect.Create(APoint, Bitmap.Width, Bitmap.Height);
  81. end;
  82.  
  83. function TSprite.HitTest(APoint:TPoint):Boolean;
  84. begin
  85.   Result := Rect.Contains(APoint);
  86.   if Result and Bitmap.Transparent then begin
  87.     APoint := APoint - Rect.TopLeft;
  88.     Result := Bitmap.Canvas.Pixels[APoint.X, APoint.Y] <> Bitmap.TransparentColor;
  89.   end;
  90. end;
  91.  
  92. constructor TSpriteControl.Create(AOwner: TComponent);
  93. begin
  94.   inherited Create(AOwner);
  95.   FBitmap := TBitmap.Create;
  96.   FSprites := TSpriteList.Create;
  97.   {$ifdef windows}
  98.   FNeedUpdate := True;
  99.   {$endif}
  100. end;
  101.  
  102. destructor TSpriteControl.Destroy;
  103. begin
  104.   FBitmap.Free;
  105.   FSprites.Free;
  106.   inherited Destroy;
  107. end;
  108.  
  109. procedure TSpriteControl.AddSprite(ASprite:TSprite);
  110. begin
  111.   Sprites.Insert(0, ASprite);
  112.   UpdateSprite(ASprite);
  113. end;
  114.  
  115. procedure TSpriteControl.UpdateSprite(ASprite:TSprite);
  116. begin
  117.   {$ifdef windows}
  118.     InvalidateRect(Handle, ASprite.Rect, False);
  119.     FNeedUpdate := True;
  120.   {$else}
  121.     Invalidate;
  122.   {$endif}
  123. end;
  124.  
  125. procedure TSpriteControl.DeleteSpriteUnderCursor;
  126.   var Temp:TSprite;
  127. begin
  128.   if Assigned(SpriteUnderCursor) then begin
  129.     Temp := SpriteUnderCursor;
  130.     if FClickedSprite = Temp then begin
  131.       FClickedSprite := nil;
  132.       FDragging := False;
  133.     end;
  134.     SpriteUnderCursor := nil;
  135.     Sprites.Remove(Temp);
  136.   end;
  137. end;
  138.  
  139. procedure TSpriteControl.Paint;
  140.   var Rect, ClipRect, PaintRect:TRect;
  141.   I:Integer;
  142.   {$ifdef windows}
  143.   ClipRgn:HRGN;
  144.   {$endif}
  145. begin
  146.   inherited Paint;
  147.   Rect := TRect.Create(TPoint.Create(0, 0), Bitmap.Width, Bitmap.Height);
  148.   ClipRect := Canvas.ClipRect;
  149.   PaintRect := Rect * ClipRect;
  150.   {$ifdef windows}
  151.   if FNeedUpdate then begin
  152.   {$endif}
  153.     with Bitmap.Canvas do begin
  154.       {$ifdef windows}
  155.       ClipRgn := CreateRectRgn(PaintRect.Left, PaintRect.Top, PaintRect.Right, PaintRect.Bottom);
  156.       SelectClipRgn(Handle, ClipRgn);
  157.       {$endif}
  158.       Brush.Color := BackgroundColor;
  159.       FillRect(PaintRect);
  160.     end;
  161.     for I := Sprites.Count - 1 downto 0 do begin
  162.       Sprites[I].Draw(Bitmap.Canvas, PaintRect);
  163.     end;
  164.     if Assigned(SpriteUnderCursor) and
  165.       not (SpriteUnderCursor.Rect * PaintRect).IsEmpty then
  166.     begin
  167.       with Bitmap.Canvas do begin
  168.         DrawFocusRect(SpriteUnderCursor.Rect);
  169.       end;
  170.     end;
  171.   {$ifdef windows}
  172.     with Bitmap.Canvas do begin
  173.       SelectClipRgn(Handle, 0);
  174.       DeleteObject(ClipRgn);
  175.     end;
  176.     FNeedUpdate := False;
  177.   end;
  178.   {$endif}
  179.   Canvas.CopyRect(PaintRect, Bitmap.Canvas, PaintRect);
  180.   if not PaintRect.Contains(ClipRect) then begin
  181.     Canvas.Brush.Color := Color;
  182.     Rect := ClientRect;
  183.     Rect.Left := Bitmap.Width;
  184.     Rect.Intersect(ClipRect);
  185.     Canvas.FillRect(Rect);
  186.     Rect := ClientRect;
  187.     Rect.Top := Bitmap.Height;
  188.     Rect.Width := Bitmap.Width;
  189.     Rect.Intersect(ClipRect);
  190.     Canvas.FillRect(Rect);
  191.   end;
  192. end;
  193.  
  194. procedure TSpriteControl.MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer);
  195.   var I:Integer;Sprite, HitSprite:TSprite;
  196. begin
  197.   inherited MouseDown(Button, Shift, X, Y);
  198.   if Button = mbLeft then begin
  199.     HitSprite := nil;
  200.     for I := 0 to Sprites.Count - 1 do begin
  201.       Sprite := Sprites[I];
  202.       if Sprite.HitTest(TPoint.Create(X, Y)) then begin
  203.         HitSprite := Sprite;
  204.         FClickedPoint := TPoint.Create(X, Y);
  205.         FClickedCoord := Sprite.Rect.TopLeft;
  206.         Break;
  207.       end;
  208.     end;
  209.     FClickedSprite := HitSprite;
  210.   end;
  211. end;
  212.  
  213. procedure TSpriteControl.MouseMove(Shift: TShiftState; X,Y: Integer);
  214.   var I:Integer;Sprite, HitSprite:TSprite;
  215. begin
  216.   inherited MouseMove(Shift, X, Y);
  217.   if Assigned(FClickedSprite) then begin
  218.     if not FDragging then begin
  219.       if (Abs(X - FClickedPoint.X) > 5) or (Abs(Y - FClickedPoint.Y) > 5) then begin
  220.         FDragging := True;
  221.       end;
  222.     end;
  223.     if FDragging then begin
  224.       UpdateSprite(FClickedSprite);
  225.       FClickedSprite.Move(FClickedCoord + TPoint.Create(X, Y) - FClickedPoint);
  226.       UpdateSprite(FClickedSprite);
  227.       SpriteUnderCursor := FClickedSprite;
  228.       Exit;
  229.     end;
  230.   end;
  231.   HitSprite := nil;
  232.   for I := 0 to Sprites.Count - 1 do begin
  233.     Sprite := Sprites[I];
  234.     if Sprite.HitTest(TPoint.Create(X, Y)) then begin
  235.       HitSprite := Sprite;
  236.     end;
  237.   end;
  238.   SpriteUnderCursor := HitSprite;
  239. end;
  240.  
  241. procedure TSpriteControl.MouseUp(Button: TMouseButton; Shift:TShiftState; X,Y:Integer);
  242. begin
  243.   inherited MouseUp(Button, Shift, X, Y);
  244.   if Button = mbLeft then begin
  245.     if FDragging then begin
  246.       FDragging := False;
  247.     end
  248.     else begin
  249.       if Assigned(FClickedSprite) then begin
  250.         Sprites.Move(Sprites.IndexOf(FClickedSprite), 0);
  251.         UpdateSprite(FClickedSprite);
  252.       end;
  253.     end;
  254.     FClickedSprite := nil;
  255.   end;
  256. end;
  257.  
  258. procedure TSpriteControl.SetSpriteUnderCursor(ASprite:TSprite);
  259.   var OldSprite:TSprite;
  260. begin
  261.   if SpriteUnderCursor <> ASprite then begin
  262.     OldSprite := SpriteUnderCursor;
  263.     FSpriteUnderCursor := ASprite;
  264.     if Assigned(OldSprite) then begin
  265.       UpdateSprite(OldSprite);
  266.     end;
  267.     if Assigned(SpriteUnderCursor) then begin
  268.       UpdateSprite(SpriteUnderCursor);
  269.     end;
  270.   end;
  271. end;
  272.  
  273. end.
  274.  
Completely overhauling DynamicData 1.0 on it's way to 2.0
Crazy unit testing

Mr.Madguy

  • Full Member
  • ***
  • Posts: 200
Re: How to handle moving and deleting of objects drawn on a bitmap?
« Reply #40 on: May 20, 2017, 08:57:21 pm »
Aaaaaaaaaaaand now! Are you ready for some software rendering madness?????????? ::)

(Windows only :'()
Code: Pascal  [Select]
  1. unit TestMain;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, SpriteControl,
  9.   LCLType, SoftwareRendering;
  10.  
  11. type
  12.  
  13.   { TSpriteTestForm }
  14.  
  15.   TSpriteTestForm = class(TForm)
  16.     procedure FormCreate(Sender: TObject);
  17.     procedure FormDestroy(Sender: TObject);
  18.     procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
  19.     procedure SpriteControlMouseUp(Sender: TObject; Button: TMouseButton;
  20.       Shift: TShiftState; X, Y: Integer);
  21.   private
  22.     { private declarations }
  23.   public
  24.     { public declarations }
  25.     SpriteControl:TSpriteControl;
  26.     SpriteBitmap:TBitmap;
  27.     function CreateSprite(AIndex:Integer):TBitmap;
  28.   end;
  29.  
  30. var
  31.   SpriteTestForm: TSpriteTestForm;
  32.  
  33. implementation
  34.  
  35. {$R *.lfm}
  36.  
  37. { TSpriteTestForm }
  38.  
  39. procedure TSpriteTestForm.FormCreate(Sender: TObject);
  40. begin
  41.   Randomize;
  42.   SpriteBitmap := TBitmap.Create;
  43.   SpriteBitmap.LoadFromFile('Sprites.bmp');
  44.   SpriteControl := TSpriteControl.Create(Self);
  45.   with SpriteControl do begin
  46.     Parent := Self;
  47.     OnMouseUp := @SpriteControlMouseUp;
  48.     Align := alClient;
  49.     Bitmap.BackgroundColor := clGreen;
  50.   end;
  51. end;
  52.  
  53. procedure TSpriteTestForm.FormDestroy(Sender: TObject);
  54. begin
  55.   SpriteBitmap.Free;
  56. end;
  57.  
  58. procedure TSpriteTestForm.FormKeyDown(Sender: TObject; var Key: Word;
  59.   Shift: TShiftState);
  60. begin
  61.   if Key = VK_DELETE then begin
  62.     SpriteControl.DeleteSpriteUnderCursor;
  63.   end;
  64. end;
  65.  
  66. procedure TSpriteTestForm.SpriteControlMouseUp(Sender: TObject; Button: TMouseButton;
  67.   Shift: TShiftState; X, Y: Integer);
  68.   var Temp:TBitmap;Bitmap:TSoftwareBitmap;
  69. begin
  70.   if Button = mbRight then begin
  71.     Temp := CreateSprite(Random(12 * 8 - 1));
  72.     Bitmap := TSoftwareBitmap.Create(Temp, $000000);
  73.     SpriteControl.AddSprite(TSoftwareSprite.Create(Bitmap, TPoint.Create(X - 40, Y - 40)));
  74.     Temp.Free;
  75.   end;
  76. end;
  77.  
  78. function TSpriteTestForm.CreateSprite(AIndex:Integer):TBitmap;
  79.   var Src, Dest:TRect;
  80. begin
  81.   Result := nil;
  82.   if (AIndex >= 0) and (AIndex < 12 * 8) then begin
  83.     Result := TBitmap.Create;
  84.     with Result do begin
  85.       Width := 81;
  86.       Height := 81;
  87.       Dest := TRect.Create(TPoint.Create(0, 0), 81, 81);
  88.       Src := Dest;
  89.       Src.Offset(5 + 81 * (AIndex mod 12), 5 + 81 * (AIndex div 12));
  90.       Canvas.CopyRect(Dest, SpriteBitmap.Canvas, Src);
  91.       Transparent := True;
  92.       TransparentColor := clBlack;
  93.       Mask(clBlack);
  94.     end;
  95.   end;
  96. end;
  97.  
  98. end.
  99.  
Code: Pascal  [Select]
  1. unit SpriteControl;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses Windows, Classes, Controls, Graphics, Fgl, SoftwareRendering;
  8.  
  9. type
  10.   TSpriteList = specialize TFPGObjectList<TSoftwareSprite>;
  11.  
  12.   TSpriteControl = class(TCustomControl)
  13.   protected
  14.     FBitmap:TSoftwareDevice;
  15.     FSprites:TSpriteList;
  16.     FSpriteUnderCursor:TSoftwareSprite;
  17.     FNeedUpdate:Boolean;
  18.     FClickedSprite:TSoftwareSprite;
  19.     FClickedPoint:TPoint;
  20.     FClickedCoord:TPoint;
  21.     FDragging:Boolean;
  22.     procedure Paint;override;
  23.     procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer);override;
  24.     procedure MouseMove(Shift: TShiftState; X,Y: Integer);override;
  25.     procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X,Y:Integer);override;
  26.     function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean;override;
  27.     function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean;override;
  28.     procedure SetSpriteUnderCursor(ASprite:TSoftwareSprite);
  29.   public
  30.     constructor Create(AOwner: TComponent);override;
  31.     destructor Destroy;override;
  32.     procedure AddSprite(ASprite:TSoftwareSprite);
  33.     procedure UpdateSprite(ASprite:TSoftwareSprite;ADoSpriteUpdate:Boolean = True);
  34.     procedure DeleteSpriteUnderCursor;
  35.     property Bitmap:TSoftwareDevice read FBitmap;
  36.     property Sprites:TSpriteList read FSprites;
  37.     property SpriteUnderCursor:TSoftwareSprite read FSpriteUnderCursor write SetSpriteUnderCursor;
  38.   end;
  39.  
  40.  
  41. implementation
  42.  
  43. uses SysUtils;
  44.  
  45. constructor TSpriteControl.Create(AOwner: TComponent);
  46. begin
  47.   inherited Create(AOwner);
  48.   FBitmap := TSoftwareDevice.Create(640, 480);
  49.   FSprites := TSpriteList.Create;
  50.   FNeedUpdate := True;
  51. end;
  52.  
  53. destructor TSpriteControl.Destroy;
  54. begin
  55.   FBitmap.Free;
  56.   FSprites.Free;
  57.   inherited Destroy;
  58. end;
  59.  
  60. procedure TSpriteControl.AddSprite(ASprite:TSoftwareSprite);
  61. begin
  62.   Sprites.Insert(0, ASprite);
  63.   UpdateSprite(ASprite);
  64. end;
  65.  
  66. procedure TSpriteControl.UpdateSprite(ASprite:TSoftwareSprite;ADoSpriteUpdate:Boolean);
  67. begin
  68.   InvalidateRect(Handle, ASprite.Rect, False);
  69.   if ADoSpriteUpdate then begin
  70.     FNeedUpdate := True;
  71.   end;
  72. end;
  73.  
  74. procedure TSpriteControl.DeleteSpriteUnderCursor;
  75.   var Temp:TSoftwareSprite;
  76. begin
  77.   if Assigned(SpriteUnderCursor) then begin
  78.     Bitmap.ClipRect := SpriteUnderCursor.Rect;
  79.     Bitmap.Clear;
  80.     Temp := SpriteUnderCursor;
  81.     if FClickedSprite = Temp then begin
  82.       FClickedSprite := nil;
  83.       FDragging := False;
  84.     end;
  85.     SpriteUnderCursor := nil;
  86.     Sprites.Remove(Temp);
  87.     UpdateSprite(Temp);
  88.   end;
  89. end;
  90.  
  91. procedure TSpriteControl.Paint;
  92.   var Rect, ClipRect, PaintRect:TRect;
  93.   I:Integer;Sprite:TSoftwareSprite;
  94. begin
  95.   inherited Paint;
  96.   Rect := Bitmap.Rect;
  97.   ClipRect := Canvas.ClipRect;
  98.   PaintRect := Rect * ClipRect;
  99.   Bitmap.ClipRect := PaintRect;
  100.   Bitmap.FocusRect := TRect.Create(0, 0, 0, 0);
  101.   if FNeedUpdate then begin
  102.     Bitmap.Clear;
  103.     for I := Sprites.Count - 1 downto 0 do begin
  104.       Sprite := Sprites[I];
  105.       Bitmap.DrawSprite(Sprite);
  106.     end;
  107.     FNeedUpdate := False;
  108.   end;
  109.   if Assigned(SpriteUnderCursor) then begin
  110.     Bitmap.FocusRect := SpriteUnderCursor.Rect;
  111.   end;
  112.   Bitmap.DrawToCanvas(Canvas);
  113.   if not PaintRect.Contains(ClipRect) then begin
  114.     Canvas.Brush.Color := Color;
  115.     Rect := ClientRect;
  116.     Rect.Left := Bitmap.Rect.Width;
  117.     Rect.Intersect(ClipRect);
  118.     Canvas.FillRect(Rect);
  119.     Rect := ClientRect;
  120.     Rect.Top := Bitmap.Rect.Height;
  121.     Rect.Width := Bitmap.Rect.Width;
  122.     Rect.Intersect(ClipRect);
  123.     Canvas.FillRect(Rect);
  124.   end;
  125. end;
  126.  
  127. procedure TSpriteControl.MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer);
  128. begin
  129.   inherited MouseDown(Button, Shift, X, Y);
  130.   if Button = mbLeft then begin
  131.     FClickedSprite := Bitmap.HitTest(TPoint.Create(X, Y));
  132.     if Assigned(FClickedSprite) then begin
  133.       FClickedPoint := TPoint.Create(X, Y);
  134.       FClickedCoord := FClickedSprite.Rect.TopLeft;
  135.     end;
  136.   end;
  137. end;
  138.  
  139. procedure TSpriteControl.MouseMove(Shift: TShiftState; X,Y: Integer);
  140. begin
  141.   inherited MouseMove(Shift, X, Y);
  142.   if Assigned(FClickedSprite) then begin
  143.     if not FDragging then begin
  144.       if (Abs(X - FClickedPoint.X) > 5) or (Abs(Y - FClickedPoint.Y) > 5) then begin
  145.         FDragging := True;
  146.       end;
  147.     end;
  148.     if FDragging then begin
  149.       UpdateSprite(FClickedSprite);
  150.       FClickedSprite.Move(FClickedCoord + TPoint.Create(X, Y) - FClickedPoint);
  151.       UpdateSprite(FClickedSprite);
  152.       SpriteUnderCursor := FClickedSprite;
  153.       Exit;
  154.     end;
  155.   end;
  156.   SpriteUnderCursor := Bitmap.HitTest(TPoint.Create(X, Y));
  157. end;
  158.  
  159. procedure TSpriteControl.MouseUp(Button: TMouseButton; Shift:TShiftState; X,Y:Integer);
  160. begin
  161.   inherited MouseUp(Button, Shift, X, Y);
  162.   if Button = mbLeft then begin
  163.     if FDragging then begin
  164.       FDragging := False;
  165.     end
  166.     else begin
  167.       if Assigned(FClickedSprite) then begin
  168.         Sprites.Move(Sprites.IndexOf(FClickedSprite), 0);
  169.         UpdateSprite(FClickedSprite);
  170.       end;
  171.     end;
  172.     FClickedSprite := nil;
  173.   end;
  174. end;
  175.  
  176. function TSpriteControl.DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean;
  177. begin
  178.   Result := inherited DoMouseWheelDown(Shift, MousePos);
  179.   if Assigned(SpriteUnderCursor) then begin
  180.     SpriteUnderCursor.Z := SpriteUnderCursor.Z - 1;
  181.     UpdateSprite(SpriteUnderCursor);
  182.   end;
  183. end;
  184.  
  185. function TSpriteControl.DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean;
  186. begin
  187.   Result := inherited DoMouseWheelUp(Shift, MousePos);
  188.   if Assigned(SpriteUnderCursor) then begin
  189.     SpriteUnderCursor.Z := SpriteUnderCursor.Z + 1;
  190.     UpdateSprite(SpriteUnderCursor);
  191.   end;
  192. end;
  193.  
  194. procedure TSpriteControl.SetSpriteUnderCursor(ASprite:TSoftwareSprite);
  195.   var OldSprite:TSoftwareSprite;
  196. begin
  197.   if SpriteUnderCursor <> ASprite then begin
  198.     OldSprite := SpriteUnderCursor;
  199.     FSpriteUnderCursor := ASprite;
  200.     if Assigned(OldSprite) then begin
  201.       UpdateSprite(OldSprite, False);
  202.     end;
  203.     if Assigned(SpriteUnderCursor) then begin
  204.       UpdateSprite(SpriteUnderCursor, False);
  205.     end;
  206.   end;
  207. end;
  208.  
  209. end.
  210.  
Code: Pascal  [Select]
  1. unit SoftwareRendering;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses Windows, Graphics;
  8.  
  9. type
  10.   TSoftwareBitmap = class
  11.   protected
  12.     FColorKey:TColor;
  13.     FBitmapInfo:TBitmapInfo;
  14.     FRect:TRect;
  15.     FBits:PColor;
  16.   public
  17.     constructor Create(ABitmap:TBitmap;AColorKey:TColor);
  18.     destructor Destroy;override;
  19.     property Rect:TRect read FRect;
  20.     property ColorKey:TColor read FColorKey;
  21.     property Bits:PColor read FBits;
  22.   end;
  23.  
  24.   TSoftwareSprite = class
  25.   protected
  26.     FZ:Integer;
  27.     FRect:TRect;
  28.     FBitmap:TSoftwareBitmap;
  29.     procedure SetZ(AZ:Integer);
  30.   public
  31.     constructor Create(ABitmap:TSoftwareBitmap;ACoord:TPoint);
  32.     destructor Destroy;override;
  33.     procedure Move(APoint:TPoint);
  34.     procedure BringToFront;
  35.     property Z:Integer read FZ write SetZ;
  36.     property Rect:TRect read FRect;
  37.     property Bitmap:TSoftwareBitmap read FBitmap;
  38.   end;
  39.  
  40.   TSoftwareDevice = class
  41.   protected
  42.     FBitmapInfo:TBitmapInfo;
  43.     FRect:TRect;
  44.     FBits:PColor;
  45.     FSelectBuffer:PPointer;
  46.     FFocusRect:TRect;
  47.     procedure SetFocusRect(ARect:TRect);
  48.   public
  49.     BackgroundColor:TColor;
  50.     ClipRect:TRect;
  51.     constructor Create(AWidth, AHeight:Integer);
  52.     destructor Destroy;override;
  53.     procedure DrawSprite(ASprite:TSoftwareSprite);
  54.     procedure Clear;
  55.     procedure DrawFocusRect(AFocusRect:TRect);
  56.     procedure DrawToCanvas(ACanvas:TCanvas);
  57.     function HitTest(APoint:TPoint):TSoftwareSprite;
  58.     property Rect:TRect read FRect;
  59.     property FocusRect:TRect read FFocusRect write SetFocusRect;
  60.   end;
  61.  
  62. implementation
  63.  
  64. constructor TSoftwareBitmap.Create(ABitmap:TBitmap;AColorKey:TColor);
  65. begin
  66.   inherited Create;
  67.   FColorKey := AColorKey;
  68.   with FBitmapInfo.bmiHeader do begin
  69.     biSize := SizeOf(FBitmapInfo.bmiHeader);
  70.     biWidth := ABitmap.Width;
  71.     biHeight := -ABitmap.Height;
  72.     biPlanes := 1;
  73.     biBitCount := 32;
  74.     biCompression := BI_RGB;
  75.     biSizeImage := 0;
  76.     biXPelsPerMeter := 0;
  77.     biYPelsPerMeter := 0;
  78.     biClrUsed := 0;
  79.     biClrImportant := 0;
  80.   end;
  81.   FBits := GetMem(ABitmap.Width * ABitmap.Height * SizeOf(TColor));
  82.   GetDIBits(ABitmap.Canvas.Handle, ABitmap.Handle, 0, ABitmap.Height, FBits, FBitmapInfo, DIB_RGB_COLORS);
  83.   FRect := TRect.Create(TPoint.Create(0, 0), ABitmap.Width, ABitmap.Height);
  84. end;
  85.  
  86. destructor TSoftwareBitmap.Destroy;
  87. begin
  88.   FreeMem(FBits);
  89.   inherited Destroy;
  90. end;
  91.  
  92. constructor TSoftwareSprite.Create(ABitmap:TSoftwareBitmap;ACoord:TPoint);
  93. begin
  94.   inherited Create;
  95.   FBitmap := ABitmap;
  96.   FRect := TRect.Create(ACoord, ABitmap.Rect.Width, ABitmap.Rect.Height);
  97. end;
  98.  
  99. destructor TSoftwareSprite.Destroy;
  100. begin
  101.   FBitmap.Free;
  102.   inherited Destroy;
  103. end;
  104.  
  105. procedure TSoftwareSprite.SetZ(AZ:Integer);
  106. begin
  107.   if AZ >= 0 then begin
  108.     FZ := AZ;
  109.   end;
  110. end;
  111.  
  112. procedure TSoftwareSprite.Move(APoint:TPoint);
  113. begin
  114.   FRect := TRect.Create(APoint, Bitmap.Rect.Width, Bitmap.Rect.Height);
  115. end;
  116.  
  117. procedure TSoftwareSprite.BringToFront;
  118. begin
  119.   FZ := 0;
  120. end;
  121.  
  122. constructor TSoftwareDevice.Create(AWidth, AHeight:Integer);
  123. begin
  124.   inherited Create;
  125.   with FBitmapInfo.bmiHeader do begin
  126.     biSize := SizeOf(FBitmapInfo.bmiHeader);
  127.     biWidth := AWidth;
  128.     biHeight := -AHeight;
  129.     biPlanes := 1;
  130.     biBitCount := 32;
  131.     biCompression := BI_RGB;
  132.     biSizeImage := 0;
  133.     biXPelsPerMeter := 0;
  134.     biYPelsPerMeter := 0;
  135.     biClrUsed := 0;
  136.     biClrImportant := 0;
  137.   end;
  138.   FBits := GetMem(AWidth * AHeight * SizeOf(TColor));
  139.   FSelectBuffer := GetMem(AWidth * AHeight * SizeOf(Pointer));
  140.   FRect := TRect.Create(TPoint.Create(0, 0), AWidth, AHeight);
  141. end;
  142.  
  143. destructor TSoftwareDevice.Destroy;
  144. begin
  145.   FreeMem(FBits);
  146.   FreeMem(FSelectBuffer);
  147.   inherited Destroy;
  148. end;
  149.  
  150. procedure TSoftwareDevice.SetFocusRect(ARect:TRect);
  151. begin
  152.   if FFocusRect <> ARect then begin
  153.     if not FFocusRect.IsEmpty then begin
  154.       DrawFocusRect(FFocusRect);
  155.     end;
  156.     if not ARect.IsEmpty then begin
  157.       DrawFocusRect(ARect);
  158.     end;
  159.     FFocusRect := ARect;
  160.   end;
  161. end;
  162.  
  163. procedure TSoftwareDevice.DrawSprite(ASprite:TSoftwareSprite);
  164.   var Src, Dest:TRect;SrcData,DestData:PColor;SelectData:PPointer;
  165.     SrcOffset, DestOffset:Integer;ColorKey:TColor;
  166.     I, J:Integer;
  167. begin
  168.   Dest := ASprite.Rect * ClipRect * Rect;
  169.   Src := Dest;
  170.   Src.Offset(-ASprite.Rect.TopLeft.X, -ASprite.Rect.TopLeft.Y);
  171.   Src := Src * ASprite.Bitmap.Rect;
  172.   Dest := Src;
  173.   Dest.Offset(ASprite.Rect.TopLeft);
  174.   SrcData := ASprite.Bitmap.Bits + (Src.Top * ASprite.Rect.Width + Src.Left);
  175.   DestData := FBits + (Dest.Top * Rect.Width + Dest.Left);
  176.   SelectData := FSelectBuffer + (Dest.Top * Rect.Width + Dest.Left);
  177.   SrcOffset := ASprite.Rect.Width - Src.Width;
  178.   DestOffset := Rect.Width - Dest.Width;
  179.   ColorKey := ASprite.Bitmap.ColorKey;
  180.   for I := 0 to Src.Height - 1 do begin
  181.     for J := 0 to Src.Width - 1 do begin
  182.       if SrcData^ <> ColorKey  then begin
  183.         if (not Assigned(SelectData^)) or (TSoftwareSprite(SelectData^).Z >= ASprite.Z) then begin
  184.           DestData^ := SrcData^;
  185.           SelectData^ := Pointer(ASprite);
  186.         end;
  187.       end;
  188.       Inc(SrcData);
  189.       Inc(DestData);
  190.       Inc(SelectData);
  191.     end;
  192.     Inc(SrcData, SrcOffset);
  193.     Inc(DestData, DestOffset);
  194.     Inc(SelectData, DestOffset);
  195.   end;
  196. end;
  197.  
  198. procedure TSoftwareDevice.Clear;
  199.   var Dest:TRect;DestData:PColor;SelectData:PPointer;
  200.     DestOffset:Integer;I, J:Integer;
  201. begin
  202.   Dest := ClipRect * Rect;
  203.   DestData := FBits + (Dest.Top * Rect.Width + Dest.Left);
  204.   SelectData := FSelectBuffer + (Dest.Top * Rect.Width + Dest.Left);
  205.   DestOffset := Rect.Width - Dest.Width;
  206.   for I := 0 to Dest.Height - 1 do begin
  207.     for J := 0 to Dest.Width - 1 do begin
  208.       DestData^ := BackgroundColor;
  209.       SelectData^ := nil;
  210.       Inc(DestData);
  211.       Inc(SelectData);
  212.     end;
  213.     Inc(DestData, DestOffset);
  214.     Inc(SelectData, DestOffset);
  215.   end;
  216. end;
  217.  
  218. procedure TSoftwareDevice.DrawFocusRect(AFocusRect:TRect);
  219.   var Dest:TRect;DestData:PColor;
  220.   I:Integer;Fill:Boolean;
  221. begin
  222.   Dest := AFocusRect * ClipRect * Rect;
  223.   if Dest.Top = AFocusRect.Top then begin
  224.     Fill := ((Dest.Left and 1) xor (Dest.Top and 1)) = 1;
  225.     DestData := FBits + (Dest.Top * Rect.Width + Dest.Left);
  226.     for I := 0 to Dest.Width - 1 do begin
  227.       if Fill then begin
  228.         DestData^ := (not DestData^) and $ffffff;
  229.       end;
  230.       Inc(DestData);
  231.       Fill := not Fill;
  232.     end;
  233.   end;
  234.   if Dest.Left = AFocusRect.Left then begin
  235.     Fill := ((Dest.Left and 1) xor (Dest.Top and 1)) = 1;
  236.     DestData := FBits + (Dest.Top * Rect.Width + Dest.Left);
  237.     for I := 0 to Dest.Height - 1 do begin
  238.       if Fill then begin
  239.         DestData^ := (not DestData^) and $ffffff;
  240.       end;
  241.       Inc(DestData, Rect.Width);
  242.       Fill := not Fill;
  243.     end;
  244.   end;
  245.   if Dest.Bottom = AFocusRect.Bottom then begin
  246.     Fill := ((Dest.Left and 1) xor ((Dest.Bottom - 1) and 1)) = 1;
  247.     DestData := FBits + ((Dest.Bottom - 1) * Rect.Width + Dest.Left);
  248.     for I := 0 to Dest.Width - 1 do begin
  249.       if Fill then begin
  250.         DestData^ := (not DestData^) and $ffffff;
  251.       end;
  252.       Inc(DestData);
  253.       Fill := not Fill;
  254.     end;
  255.   end;
  256.   if Dest.Right = AFocusRect.Right then begin
  257.     Fill := (((Dest.Right - 1) and 1) xor (Dest.Top and 1)) = 1;
  258.     DestData := FBits + (Dest.Top * Rect.Width + (Dest.Right - 1));
  259.     for I := 0 to Dest.Height - 1 do begin
  260.       if Fill then begin
  261.         DestData^ := (not DestData^) and $ffffff;
  262.       end;
  263.       Inc(DestData, Rect.Width);
  264.       Fill := not Fill;
  265.     end;
  266.   end;
  267. end;
  268.  
  269. function TSoftwareDevice.HitTest(APoint:TPoint):TSoftwareSprite;
  270. begin
  271.   Result := nil;
  272.   if Rect.Contains(APoint) then begin
  273.     Result := TSoftwareSprite((FSelectBuffer + (APoint.Y * Rect.Width + APoint.X))^);
  274.   end;
  275. end;
  276.  
  277. procedure TSoftwareDevice.DrawToCanvas(ACanvas:TCanvas);
  278.   var PaintRect:TRect;
  279. begin
  280.   PaintRect := Rect * ClipRect;
  281.   SetDIBitsToDevice(
  282.     ACanvas.Handle,
  283.     PaintRect.Left,
  284.     PaintRect.Top,
  285.     PaintRect.Width,
  286.     PaintRect.Height,
  287.     PaintRect.Left,
  288.     Rect.Height - PaintRect.Height - PaintRect.Top,
  289.     0,
  290.     Rect.Height,
  291.     FBits,
  292.     FBitmapInfo,
  293.     DIB_RGB_COLORS
  294.   );
  295. end;
  296.  
  297. end.
  298.  

I'm not sure about it's performance - you should figure it out by yourself. I tried to optimize everything, I could. But it's obviously more CPU and RAM hungry due to obvious reasons. %)

Functionality should be exactly the same, but there is completely new cool feature. Software Z-buffer!  8-) (That is also used as software selection buffer to boost hit detection performance) You can now assign explicit Z coordinate to every sprite! It's done via mouse wheel. By default all sprites are topmost. But via scrolling mouse wheel up you can increase their Z coordinate. Mouse wheel down obviously decreases it. And since that moment order of sprites will matter only for sprites with the same Z coordinate. No matter, what order sprites will have - sprites with lower Z coordinate will always be above sprites with higher one. Left mouse click still brings sprite to the top of sprite list, as earlier - and this still will change order of sprites with the same Z coordinate.

P.S. As we have software Z-buffer now - software 3D rendering is possible via this software renderer.  >:D
« Last Edit: May 21, 2017, 10:10:35 am by Mr.Madguy »
Completely overhauling DynamicData 1.0 on it's way to 2.0
Crazy unit testing

knuckles

  • Full Member
  • ***
  • Posts: 100
Re: How to handle moving and deleting of objects drawn on a bitmap?
« Reply #41 on: May 21, 2017, 08:54:09 pm »
woah how cool is that 8-) thanks for sharing  ;D

I wouldn't even know where to begin trying to understand it all especially when it comes to working with the bitmap bits and stuff  %) %)

EDIT:

So do you think this is more likely how the older Game Makers achieved this especially when the really old versions were before XP days when hardware was really low spec? or would your first examples have been more likely? I guess both seem feasible and no one will ever truly know without completely reverse engineering the logic but trying to get in the mind of another developer and finding out how certain tasks may have been approached and implemented is quite interesting, some of the techniques demonstrated here I would not ever even thought of %)
« Last Edit: May 21, 2017, 09:01:44 pm by knuckles »

Mr.Madguy

  • Full Member
  • ***
  • Posts: 200
Re: How to handle moving and deleting of objects drawn on a bitmap?
« Reply #42 on: May 22, 2017, 07:32:18 am »
woah how cool is that 8-) thanks for sharing  ;D

I wouldn't even know where to begin trying to understand it all especially when it comes to working with the bitmap bits and stuff  %) %)

EDIT:

So do you think this is more likely how the older Game Makers achieved this especially when the really old versions were before XP days when hardware was really low spec? or would your first examples have been more likely? I guess both seem feasible and no one will ever truly know without completely reverse engineering the logic but trying to get in the mind of another developer and finding out how certain tasks may have been approached and implemented is quite interesting, some of the techniques demonstrated here I would not ever even thought of %)
I don't know. According to Wiki since version 3.0 Game Maker has been using DirectDraw and since version 5.3 it has been using Direct3D. Whether it had been using GDI or software rendering prior to 3.0 - depended on whether it needed advanced rendering features or not. As you can see, GDI can be successfully used for sprite rendering, but at the same time GDI is very limited. Alpha blending isn't supported for example. And via software rendering you can simulate the way, old (even DOS) games worked - i.e. any arbitrary effects. Also hardware capabilities should be taken into account. You should know, that in the past there was some period of time, when video cards were too expensive and not all people had good ones. That's, when software rendering was more widespread. But at some moment load started to shift towards video cards. I.e. hardware acceleration was used in order to free CPU and system RAM for another tasks.
Completely overhauling DynamicData 1.0 on it's way to 2.0
Crazy unit testing

 

Recent

Get Lazarus at SourceForge.net. Fast, secure and Free Open Source software downloads Open Hub project report for Lazarus