Question

我决定自己做一个简单的RPG游戏的地图编辑器。地图将允许将32x32的图块绘制到地图中，没有什么太花哨，但是要提出一个想法：

enter image description here

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

现在我面临的问题是绘制图块时，如果鼠标移动得相当快，那么就不会绘制图块，我认为这与无法快速处理鼠标X，Y坐标有关。

要提出想法，请查看下图：

enter image description here

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

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

使用listview存储磁贴位置看起来像这样（我说这只是为了快速测试，直到我使用正确的类或数组记录）：

enter image description here

谢谢。

Answer 1

请勿使用TTimer来控制您的绘图。当鼠标在PaintBox中移动时，根据需要设置标记，并跟踪当前鼠标坐标，然后调用PaintBox的Invalidate()方法，以在流控制返回消息队列时触发重绘。每当PaintBox的OnPaint事件因任何原因被触发时，根据需要绘制地图和图块，如果正在拖动图块，则在保存的鼠标坐标处绘制它。

此外，在您的DrawTileOnMap()方法中，您无需将图片复制到临时TBitmap，您可以从源[{1}}直接复制到目标{{1 }}

尝试更像这样的事情：

TImage

Answer 2

你的做法是错误的。您遭受的延迟主要是因为计时器。

以下是一些指导：

在单个（屏幕外）位图上绘图。
在PaintBox OnPaint事件上，只需复制屏幕外位图。
直接在MouseMove，MouseUp上画画（如果需要）
将瓷砖预加载为不同的位图，或将它们组合成更大的位图。
永远不要在绘制时创建位图。

Answer 3

你应该在OnMouseMove事件中收集鼠标坐标，否则你只会在计时器触发时获得一个新的鼠标位置。

除此之外，使用GetMouseMovePointsEx以获得错过的64个鼠标位置。

在绘图箱上绘图 - 如何及时跟上鼠标移动？

3 个答案: