gpt4 book ai didi

delphi - 在油漆盒上绘图 - 如何及时跟上鼠标的移动?

转载 作者:行者123 更新时间:2023-12-03 18:57:15 24 4
gpt4 key购买 nike

我决定自己动手为一个简单的 RPG 游戏制作 map 编辑器。该 map 将允许在 map 中绘制 32x32 的图 block ,没什么花哨的,但给出一个想法:

enter image description here

我再次使用 Lazarus,但这也适用于 Delphi。

现在我面临的问题是在绘制图 block 时,如果鼠标移动得相当快,则不会绘制图 block ,我认为这与无法足够快地处理鼠标 X、Y 坐标有关。

为了给出一个想法,请看下图:

enter image description here

我所做的是以快速的方式从左侧绘制的瓷砖开始到油漆盒的右侧,因此之间存在间隙。我需要的是能够绘制到任何这些单元格中,而不管鼠标移动的速度有多快。

请注意,我使用的是 TTimerInterval := 1 .里面OnTimer方法我存储应该在哪个单元格中绘制哪些图 block 的记录。 TPaintbox OnPaint方法读取记录并相应地绘制图 block 。

如果需要,我可以发布一些代码,但我相信解决方案可能与我的代码无关,因为我在 Canvas 上绘制画笔描边时在简单的绘图程序中注意到了这种行为。

基本上,当鼠标移动得太快时,应用程序似乎无法跟上鼠标的移动,因此跳过了应该绘制的部分。以慢速/正常速度移动鼠标效果很好,但如果移动速度很快,它似乎跟不上它。

因此,例如,在 Canvas /Paintbox 上绘图时,我如何跟上鼠标的移动,尤其是当鼠标移动得非常快时,因为似乎存在某种应用程序/系统延迟?

我在下面添加了大部分完整的源代码。这绝不代表最终的代码或任何东西,我昨天才开始这样做,同时四处乱逛,看看我自己能做什么,所以我知道某些事情可以更有效地完成,但这并不意味着我会感激任何提示或您可能有我可能不知道的输入。

主文件

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 中存储瓦片位置的一种快速而肮脏的方式,稍后我将使用适当的类来存储数据。

  • 使用 listview 存储图 block 位置看起来像这样(我说这只是为了快速测试,直到我使用正确的类或数组记录):

    enter image description here

    谢谢你。

    最佳答案

    不要使用 TTimer来控制你的绘图。当鼠标在 PaintBox 周围移动时,根据需要设置您的标志,并跟踪当前鼠标坐标,然后调用 PaintBox 的 Invalidate()当流控制返回消息队列时触发重绘的方法。每当 PaintBox 的 OnPaint任何原因触发事件,根据需要绘制 map 和图 block ,如果正在拖动图 block ,则在保存的鼠标坐标处绘制它。

    此外,在您的 DrawTileOnMap()方法,您不需要将图像复制到临时 TBitmap ,您可以从您的来源复制TImage直接到你的目标TCanvas .

    尝试更多类似的东西:

    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.

    procedure DrawTileOnMap(const Tileset: TImage; TileX, TileY: Integer;
    MapX, MapY: Integer; OutCanvas: TCanvas);
    begin
    OutCanvas.CopyRect(
    Rect(MapX, MapY, MapX + FTileWidth, MapY + FTileHeight),
    Tileset.Canvas,
    Rect(TileX, TileY, TileX + FTileWidth, TileY + FTileHeight));
    end;

    procedure TMainForm.FormCreate(Sender: TObject);
    begin
    FTilesetPos := Point(-1, -1);
    FMapTilePos := Point(-1, -1);
    FMapTileColumn = -1;
    FMapTileRow := -1;
    FIsDrawing := False;
    end;

    procedure TMainForm.MapEditorMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    begin
    if Button = mbMiddle then Exit;

    if Button = mbLeft then
    FIsDrawing := True
    end else
    DeleteTileAtPosition(FMapTilePos.X, FMapTilePos.Y, lvwRecords);

    MapEditor.Invalidate;
    end;

    procedure TMainForm.MapEditorMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    begin
    ConvertToSnapPosition(X, Y, FSnapX, FSnapY, FMapTilePos);

    FMapTileColumn := MapTilePositionToColumn(FMapTilePos.X);
    FMapTileRow := MapTilePositionToRow(FMapTilePos.Y);

    if (Button = mbLeft) and FDrawing then
    MapEditor.Invalidate;
    end;

    procedure TMainForm.MapEditorMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    begin
    if Button = mbLeft then
    begin
    FIsDrawing := False
    MapEditor.Invalidate;
    end;
    end;

    procedure TMainForm.MapEditorPaint(Sender: TObject);
    var
    I, J: Integer;
    TileX, TileY: Integer;
    MapX, MapY: Integer;
    begin
    // draw empty/water tiles << NEEDS OPTIMIZATION AS VERY SLOW >>
    {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);

    if (FMapTileColumn > -1) and (FMapTileRow > -1) and FDrawing then
    DoDrawTile(FMapTilePos.X, FMapTilePos.Y);
    end;

    关于delphi - 在油漆盒上绘图 - 如何及时跟上鼠标的移动?,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/25509235/

    24 4 0
    Copyright 2021 - 2024 cfsdn All Rights Reserved 蜀ICP备2022000587号
    广告合作:1813099741@qq.com 6ren.com