Relying on paintbox - How to keep up with mouse movements without delay?

I decided to do a bit of work on creating a map editor for a simple RPG game. The map will let you draw tiles at 32x32 in the map, nothing fancy, but give an idea:

I am using Lazarus again, but this applies to Delphi as well.

Now the problem I am having is drawing the tiles, if the mouse moves pretty fast then the tiles are not drawn and I think this is because the X, Y mouse coordinates were not able to be processed fast enough.

To give an idea, take a look at the image below:

What I was doing was starting with the left painted tiles to the right of the varnishing quickly, hence the gaps in between. I need to be able to draw to any of these cells, no matter how fast the mouse is moving.

Just notice, I am using TTimer

with Interval := 1

. Inside the method, OnTimer

I keep a record of which tiles should be drawn in the cell. The method TPaintbox

OnPaint

reads the records and draws tiles accordingly.

I can post some code if needed, but I believe the solution might be something that is not related to my code, as I notice this behavior in simple paint programs when painting brush strokes on the canvas.

Basically, when moving the mouse too fast, it seems that the application does not seem to be able to keep up with the movements of the mouse, and so the parts to be drawn are skipped. Moving the mouse at a slow / normal pace works fine, but when moving quickly, it doesn't seem to handle it.

So, when painting on Canvas / Paintbox, for example, how can I keep up with mouse movements, especially when the mouse is moving very quickly, since there seems to be some kind of application / system lag?

I've added the mostly complete source code below. This in no way means the final code or anything else, I just started this yesterday while I was messing around to figure out what I can do on my own, so I know some things can be done more efficiently, but this doesn’t mean that I would appreciate any advice or input you may have, perhaps I don’t know.

Main.pas

unit main;

{$mode objfpc}{$H+}

interface

uses
  Windows, Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
  ExtCtrls, ComCtrls, StdCtrls, ActnList;

type
  TMainForm = class(TForm)
    ActionList: TActionList;
    imgTileset: TImage;
    imgTilesetCursor: TImage;
    lblTiles: TLabel;
    lvwRecords: TListView;
    MapEditor: TPaintBox;
    MapViewer: TScrollBox;
    LeftSidePanel: TPanel;
    RightSidePanel: TPanel;
    ProjectManagerSplitter: TSplitter;
    StatusBar: TStatusBar;
    ProjectManagerTree: TTreeView;
    MouseTimer: TTimer;
    TilesetViewer: TScrollBox;
    ToolBar1: TToolBar;
    Image1: TImage;

    procedure FormCreate(Sender: TObject);

    procedure imgTilesetMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure imgTilesetMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure imgTilesetMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure MapEditorMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure MapEditorMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure MapEditorMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure MapEditorPaint(Sender: TObject);
    procedure MouseTimerTimer(Sender: TObject);
  private
    procedure DoDrawTile(X, Y: Integer);
    procedure FinishedDrawing;
  public
    { public declarations }
  end;

var
  MainForm: TMainForm;

implementation

uses
  generalutils,
  maputils,
  optionsdlg,
  systemutils;

{$R *.lfm}

{ ---------------------------------------------------------------------------- }

procedure TMainForm.DoDrawTile(X, Y: Integer);
begin
  if GetKeyPressed(VK_LBUTTON) then
  begin
    DeleteTileAtPosition(FMapTilePos.X, FMapTilePos.Y, lvwRecords);

    with lvwRecords.Items.Add do
    begin
      Caption := IntToStr(FMapTilePos.X);
      SubItems.Add(IntToStr(FMapTilePos.Y));
      SubItems.Add(IntToStr(FTilesetPos.X));
      SubItems.Add(IntToStr(FTilesetPos.Y));
    end;

    lblTiles.Caption := 'Tiles: ' + IntToStr(lvwRecords.Items.Count);
  end;
end;

{ ---------------------------------------------------------------------------- }

procedure TMainForm.FinishedDrawing;
begin
  CleanObsoleteMapTiles(lvwRecords);
  lblTiles.Caption := 'Tiles: ' + IntToStr(lvwRecords.Items.Count);
  FIsDrawing := False;
  FIsDeleting := False;
end;

{ ---------------------------------------------------------------------------- }

procedure TMainForm.FormCreate(Sender: TObject);
begin
  DoubleBuffered := True;
  TilesetViewer.DoubleBuffered := True;
  MapViewer.DoubleBuffered := True;
  MapEditor.Height := FMapHeight;
  MapEditor.Width := FMapWidth;
end;

{ ---------------------------------------------------------------------------- }

procedure TMainForm.imgTilesetMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if GetKeyPressed(VK_LBUTTON) then
  begin
    PositionTilesetCursor(imgTileset, imgTilesetCursor, X, Y);
    ConvertToSnapPosition(X, Y, FSnapX, FSnapY, FTilesetPos);
  end;
end;

{ ---------------------------------------------------------------------------- }

procedure TMainForm.imgTilesetMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if GetKeyPressed(VK_LBUTTON) then
  begin
    PositionTilesetCursor(imgTileset, imgTilesetCursor, X, Y);
    ConvertToSnapPosition(X, Y, FSnapX, FSnapY, FTilesetPos);
  end;
end;

{ ---------------------------------------------------------------------------- }

procedure TMainForm.imgTilesetMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  ConvertToSnapPosition(X, Y, FSnapX, FSnapY, FTilesetPos);
end;

{ ---------------------------------------------------------------------------- }

procedure TMainForm.MapEditorMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  FIsDrawing := GetKeyPressed(VK_LBUTTON);
  FIsDeleting := GetKeyPressed(VK_RBUTTON);
end;

{ ---------------------------------------------------------------------------- }

procedure TMainForm.MapEditorMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  FIsDrawing := GetKeyPressed(VK_LBUTTON);
  FIsDeleting := GetKeyPressed(VK_RBUTTON);
end;

{ ---------------------------------------------------------------------------- }

procedure TMainForm.MapEditorMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  FinishedDrawing();
end;

{ ---------------------------------------------------------------------------- }

procedure TMainForm.MapEditorPaint(Sender: TObject);
var
  I, J: Integer;
  TileX, TileY: Integer;
  MapX, MapY: Integer;
begin
  // draw empty/water tiles << NEEDS OPTIMIZATION >>
  {for I := 0 to GetMapTilesColumnCount(FMapWidth) do
  begin
    for J := 0 to GetMapTilesRowCount(FMapHeight) do
    begin
      DrawTileOnMap(Image1, 0, 0, I * FTileWidth, J * FTileHeight, MapEditor.Canvas);
    end;
  end;}

  // draw tiles
  with lvwRecords do
  begin
    for I := 0 to Items.Count -1 do
    begin
      MapX := StrToInt(Items[I].Caption);
      MapY := StrToInt(Items[I].SubItems[0]);
      TileX := StrToInt(Items[I].SubItems[1]);
      TileY := StrToInt(Items[I].SubItems[2]);
      DrawTileOnMap(imgTileset, TileX, TileY, MapX, MapY, MapEditor.Canvas);
    end;
  end;

  PaintGrid(MapEditor.Canvas, FMapWidth, FMapHeight, 32, 1, $00543B1B);
end;

{ ---------------------------------------------------------------------------- }

procedure TMainForm.MouseTimerTimer(Sender: TObject);
var
  Ctrl: TControl;
  Pt: TPoint;
begin
  FMapTileColumn := -1;
  FMapTileRow := -1;
  StatusBar.Panels[2].Text := '';

  // check if the cursor is above the map editor...
  Ctrl := FindControlAtPosition(Mouse.CursorPos, True);
  if Ctrl <> nil then
  begin
    if (Ctrl = MapEditor) then
    begin
      Pt := Mouse.CursorPos;
      Pt := MapEditor.ScreenToClient(Pt);
      ConvertToSnapPosition(Pt.X, Pt.Y, FSnapX, FSnapY, FMapTilePos);

      // assign the tile column and row, then update in statusbar
      FMapTileColumn := MapTilePositionToColumn(FMapTilePos.X);
      FMapTileRow := MapTilePositionToRow(FMapTilePos.Y);

      // check if the mouse is inside the map editor...
      if (FMapTileColumn > -1) and (FMapTileRow > -1) then
      begin
        // check if drawing and draw tile
        if FIsDrawing then
        begin
          DoDrawTile(FMapTilePos.X, FMapTilePos.Y);
        end;

        // check if deleting and delete tile
        if FIsDeleting then
        begin
          DeleteTileAtPosition(FMapTilePos.X, FMapTilePos.Y, lvwRecords);
        end;
      end;
    end;
  end;
end;

{ ---------------------------------------------------------------------------- }

end.

      

        
        
        
      

    

maputils.pas

unit maputils;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Controls, Graphics, ExtCtrls, ComCtrls;

procedure PaintGrid(MapCanvas: TCanvas; MapWidth, MapHeight: Integer;
  CellSize: Integer; LineWidth: Integer; GridColor: TColor);    
procedure ConvertToSnapPosition(X, Y: Integer; SnapX, SnapY: Integer;
  var APoint: TPoint);    
procedure PositionTilesetCursor(const Tileset, TilesetCursor: TImage;
  X, Y: Integer);
procedure PositionMapCursor(const Map, MapCursor: TControl; X, Y: Integer);
procedure DrawTileOnMap(const Tileset: TImage; TileX, TileY: Integer;
  MapX, MapY: Integer; OutCanvas: TCanvas);
function GetMapTilesColumnCount(MapWidth: Integer): Integer;
function GetMapTilesRowCount(MapHeight: Integer): Integer;
function MapTilePositionToColumn(MapX: Integer): Integer;
function MapTilePositionToRow(MapY: Integer): Integer;
function MapTileColumnIndexToPosition(ColumnIndex: Integer): Integer;
function MapTileRowIndexToPosition(RowIndex: Integer): Integer;
function IsTileAtPosition(MapX, MapY: Integer;
  const TileRecords: TListView): Boolean;
procedure DeleteTileAtPosition(MapX, MapY: Integer;
  const TileRecords: TListView);
procedure CleanObsoleteMapTiles(const TileRecords: TListView);

const
  FTileHeight = 32;         // height of each tile
  FTileWidth  = 32;         // width of each tile
  FSnapX      = 32;         // size of the X Snap
  FSnapY      = 32;         // size of the Y Snap

  FMapHeight  = 1280;       // height of the map
  FMapWidth   = 1280;       // width of the map

var
  FTilesetPos: TPoint;      // tile position in tileset
  FMapTilePos: TPoint;      // tile position in map
  FMapTileColumn: Integer;
  FMapTileRow: Integer;
  FIsDrawing: Boolean;      // flag to determine if drawing tile on map.
  FIsDeleting: Boolean;     // flag to determine if deleting tile from map.

implementation

{ ---------------------------------------------------------------------------- }

procedure PaintGrid(MapCanvas: TCanvas; MapWidth, MapHeight: Integer;
  CellSize: Integer; LineWidth: Integer; GridColor: TColor);
var
  ARect: TRect;
  X, Y: Integer;
begin
  ARect := Rect(0, 0, MapWidth, MapHeight);

  with MapCanvas do
  begin
    Pen.Mode  := pmCopy;
    Pen.Style := psSolid;
    Pen.Width := LineWidth;

    // horizontal lines
    Y := ARect.Top + CellSize;
    Pen.Color := GridColor;
    while Y <= ARect.Bottom do
    begin
      MoveTo(ARect.Left, Y -1);
      LineTo(ARect.Right, Y -1);
      Inc(Y, CellSize);
    end;

    // vertical lines
    X := ARect.Left + CellSize;
    Pen.Color := GridColor;
    while X <= ARect.Right do
    begin
      MoveTo(X -1, ARect.Top);
      LineTo(X -1, ARect.Bottom);
      Inc(X, CellSize);
    end;

    // draw left border
    MoveTo(LineWidth-1, LineWidth-1);
    LineTo(LineWidth-1, MapHeight);

    // draw top border
    MoveTo(LineWidth-1, LineWidth-1);
    LineTo(MapWidth, LineWidth-1);
  end;
end;

{ ---------------------------------------------------------------------------- }

procedure ConvertToSnapPosition(X, Y: Integer; SnapX, SnapY: Integer;
  var APoint: TPoint);
begin
  if (X > 0) then APoint.X := X div SnapX * SnapY;
  if (Y > 0) then APoint.Y := Y div SnapY * SnapX;
end;

{ ---------------------------------------------------------------------------- }

procedure PositionTilesetCursor(const Tileset, TilesetCursor: TImage;
  X, Y: Integer);
var
  Pt: TPoint;
begin
  ConvertToSnapPosition(X, Y, FSnapX, FSnapY, Pt);
  if (X > 0) and (X < Tileset.Width) then TilesetCursor.Left := Pt.X;
  if (Y > 0) and (Y < Tileset.Height) then TilesetCursor.Top := Pt.Y;
end;

{ ---------------------------------------------------------------------------- }

procedure PositionMapCursor(const Map, MapCursor: TControl; X, Y: Integer);
var
  Pt: TPoint;
begin
  ConvertToSnapPosition(X, Y, FSnapX, FSnapY, Pt);
  if (X > 0) and (X < Map.Width) then MapCursor.Left := Pt.X;
  if (Y > 0) and (Y < Map.Height) then MapCursor.Top := Pt.Y;
end;

{ ---------------------------------------------------------------------------- }

procedure DrawTileOnMap(const Tileset: TImage; TileX, TileY: Integer;
  MapX, MapY: Integer; OutCanvas: TCanvas);
var
  Bitmap: TBitmap;
begin
  Bitmap := TBitmap.Create;
  try
    Bitmap.PixelFormat := pf24Bit;
    Bitmap.SetSize(FTileWidth, FTileHeight);
    Bitmap.Canvas.CopyRect(
      Rect(0, 0, FTileWidth, FTileHeight),
      Tileset.Canvas,
      Rect(TileX, TileY, TileX + FTileWidth, TileY + FTileHeight));
    OutCanvas.Draw(MapX, MapY, Bitmap);
  finally
    Bitmap.Free;
  end;
end;

{ ---------------------------------------------------------------------------- }

function GetMapTilesColumnCount(MapWidth: Integer): Integer;
var
  LCount: Integer;
begin
  LCount := 0;
  Result := 0;

  repeat
    Inc(LCount, FTileWidth);
  until
    LCount = MapWidth;

  Result := LCount div FTileWidth;
end;

{ ---------------------------------------------------------------------------- }

function GetMapTilesRowCount(MapHeight: Integer): Integer;
var
  LCount: Integer;
begin
  LCount := 0;
  Result := 0;

  repeat
    Inc(LCount, FTileHeight);
  until
    LCount = MapHeight;

  Result := LCount div FTileHeight;
end;

{ ---------------------------------------------------------------------------- }

function MapTilePositionToColumn(MapX: Integer): Integer;
begin
  Result := MapX div FTileWidth;
end;

{ ---------------------------------------------------------------------------- }

function MapTilePositionToRow(MapY: Integer): Integer;
begin
  Result := MapY div FTileHeight;
end;

{ ---------------------------------------------------------------------------- }

function MapTileColumnIndexToPosition(ColumnIndex: Integer): Integer;
begin
  Result := ColumnIndex * FTileWidth;
end;

{ ---------------------------------------------------------------------------- }

function MapTileRowIndexToPosition(RowIndex: Integer): Integer;
begin
  Result := RowIndex * FTileHeight;
end;

{ ---------------------------------------------------------------------------- }

function IsTileAtPosition(MapX, MapY: Integer;
  const TileRecords: TListView): Boolean;
var
  I: Integer;
  LMapX, LMapY: Integer;
begin
  Result := False;

  with TileRecords do
  begin
    for I := 0 to Items.Count -1 do
    begin
      LMapX := StrToInt(Items[I].Caption);
      LMapY := StrToInt(Items[I].SubItems[0]);
      if (MapX = LMapX) and (MapY = LMapY) then
      begin
        Result := True;
        Break;
      end;
    end;
  end;
end;

{ ---------------------------------------------------------------------------- }

procedure DeleteTileAtPosition(MapX, MapY: Integer;
  const TileRecords: TListView);
var
  I: Integer;
  LMapX, LMapY: Integer;
begin
  if IsTileAtPosition(MapX, MapY, TileRecords) then
  begin
    with TileRecords do
    begin
      for I := Items.Count -1 downto 0 do
      begin
        LMapX := StrToInt(Items[I].Caption);
        LMapY := StrToInt(Items[I].SubItems[0]);

        if (MapX = LMapX) and (MapY = LMapY) then
        begin
          Items.Delete(I);
        end;
      end;
    end;
  end;
end;

{ ---------------------------------------------------------------------------- }

procedure CleanObsoleteMapTiles(const TileRecords: TListView);
var
  I, J: Integer;
begin
  with TileRecords do
  begin
    Items.BeginUpdate;
    try
      SortType := stText;

      for I := Items.Count -1 downto 0 do
      begin
        for J := Items.Count -1 downto I + 1 do
        begin
          if  SameText(Items[I].Caption, Items[J].Caption) and
              SameText(Items[I].SubItems[0], Items[J].SubItems[0]) and
              SameText(Items[I].SubItems[1], Items[J].SubItems[1]) and
              SameText(Items[I].SubItems[2], Items[J].SubItems[2]) then
          begin
            Items.Delete(J);
          end;
        end;
      end;
      TileRecords.SortType := stNone;
    finally
      TileRecords.Items.EndUpdate;
    end;
  end;
end;

{ ---------------------------------------------------------------------------- }

end.

      

        
        
        
      

    

A few notes:

• when working with X, Y coordinates, it is assumed that we are snapped to a 32x32 grid, for example: if X = 3, then the cell is 96, etc.
• MapEditor
  
  is the name of the paintbox.
• lvwRecords
  
  is just a quick and dirty way to store tile positions in a TListView, I will use the appropriate classes to store the data later.

Using a listview to store tile positions looks like this (as I said, this was just for quick testing, until I use the appropriate classes or array entries):

Thank.