Desenho em uma caixa de pintura - Como acompanhar os movimentos do mouse sem demora?

Question

Aug 26, 2014, 05:07 PM

Desenho em uma caixa de pintura - Como acompanhar os movimentos do mouse sem demora?

Decidi tentar um editor de mapas para um jogo de RPG simples. O mapa permitirá desenhar blocos de 32x32 no mapa, nada muito chique, mas para dar uma idéia:

Estou usando o Lazarus novamente, mas isso se aplica ao Delphi também.

Agora, o problema que estou enfrentando é ao desenhar blocos, se o mouse for movido rapidamente, os blocos não serão desenhados e acho que isso é algo a ver com a incapacidade de processar as coordenadas do Mouse X, Y com rapidez suficiente.

Para ter uma ideia, veja a imagem abaixo:

O que eu fiz foi começar a partir dos azulejos pintados à esquerda, à direita da caixa de tinta, de maneira rápida, daí as lacunas entre elas. O que preciso é ser capaz de pintar em qualquer uma dessas células, independentemente da rapidez com que o mouse foi movido.

Apenas uma nota, eu estou usando umTTimer comInterval := 1. Dentro deOnTimer método Eu armazeno um registro de quais blocos devem ser desenhados em qual célula. oTPaintbox OnPaint O método lê os registros e desenha os blocos de acordo.

Posso postar algum código, se necessário, mas acredito que a solução pode ser algo que não esteja relacionado ao meu código, pois percebo esse comportamento em programas simples de pintura ao desenhar traçados de pincel em uma tela.

Basicamente, ao mover o mouse muito rápido, parece que o aplicativo não consegue acompanhar os movimentos do mouse e, portanto, as partes que devem ser desenhadas são puladas. Mover o mouse em um ritmo lento / normal funciona perfeitamente, mas se você estiver se movendo rapidamente, ele não o acompanhará.

Portanto, ao desenhar em um Canvas / Paintbox, por exemplo, como acompanho os movimentos do mouse, especialmente quando o mouse é movido muito rápido, pois parece haver algum tipo de atraso no aplicativo / sistema?

Eu adicionei principalmente o código fonte completo abaixo. Isso de forma alguma representa o código final ou algo assim, eu apenas comecei ontem ontem enquanto mexia para ver o que eu poderia fazer por conta própria, então estou ciente de que certas coisas podem ser feitas com mais eficiência, mas isso não significa que eu gostaria de receber alguma dica ou entrada que você possa ter e que possivelmente não estou ciente.

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.

Algumas notas:

ao lidar com as coordenadas X, Y, assuma que encaixamos em uma grade de 32x32, por exemplo: se X = 3, a célula é 96 etc.MapEditor é o nome da caixa de pintura.lvwRecords é apenas uma maneira rápida e suja de armazenar as posições do bloco em um TListView; posteriormente, usarei classes apropriadas para armazenar os dados.

O uso da listview para armazenar as posições do bloco se parece com isso (como eu disse, isso foi apenas para testes rápidos até eu usar classes ou registros de matriz adequados):

Obrigado.