Рисование на коробке с красками - Как не отставать от движений мыши без задержки?
Я решил немного заняться созданием редактора карт для простой RPG-игры. Карта позволит рисовать плитки размером 32x32 на карте, ничего особенного, но чтобы дать представление:
Я снова использую Lazarus, но это относится и к Delphi.
Теперь проблема, с которой я сталкиваюсь, заключается в том, что при рисовании плиток, если мышь перемещается довольно быстро, тогда плитки не рисуются, и я думаю, что это связано с тем, что не удалось обработать координаты мыши X, Y достаточно быстро.
Чтобы дать идею, посмотрите на изображение ниже:
То, что я делал, начинало с левой крашеной плитки справа от коробки с краской, отсюда и промежутки между ними. Что мне нужно, так это уметь рисовать в любую из этих ячеек независимо от скорости перемещения мыши.
Просто заметка, я используюTTimer
сInterval := 1
, ВнутриOnTimer
Метод Я храню запись о том, какие плитки должны быть нарисованы в какой ячейке.TPaintbox
OnPaint
Метод читает записи и соответственно рисует плитки.
Я могу опубликовать некоторый код, если требуется, но я считаю, что решение может быть чем-то, что не связано с моим кодом, поскольку я замечаю это поведение в простых программах рисования при рисовании мазков кисти на холсте.
В основном, при слишком быстром перемещении мыши кажется, что приложение не в состоянии не отставать от движений мыши, и поэтому части, которые должны быть нарисованы, пропускаются. Движение мыши в медленном / нормальном темпе работает отлично, но если двигаться быстро, то оно, похоже, не поспевает за ней.
Итак, при рисовании на Canvas / Paintbox, например, как мне не отставать от движений мыши, особенно когда мышь перемещается очень быстро, поскольку кажется, что есть какая-то задержка приложения / системы?
Я добавил в основном полный исходный код ниже. Это ни в коем случае не представляет собой окончательный код или что-то еще, я только начал это вчера, когда возился, чтобы посмотреть, что я могу сделать сам, поэтому я знаю, что некоторые вещи можно сделать более эффективно, но это не значит, что я буду признателен за любые советы или у вас есть информация, о которой я, возможно, не знаю.
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.
Несколько заметок:
при работе с координатами X, Y предполагаем, что мы привязываемся к сетке 32x32, например: если X = 3, то ячейка равна 96 и т. д.MapEditor
это имя палитры.lvwRecords
это просто быстрый и грязный способ хранения позиций листов в TListView, позже я буду использовать надлежащие классы для хранения данных.Использование списка для хранения позиций плитки выглядит следующим образом (как я уже сказал, это было просто для быстрого тестирования, пока я не использую соответствующие классы или записи массива):
Спасибо.