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

标签 delphi delphi-xe lazarus

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

enter image description here

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

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

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

enter image description here

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

请注意，我使用的是 TTimer与 Interval := 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/

    上一篇：arrays - 对数组进行排序并在Delphi中获取索引

    下一篇：delphi - 如何通过使用delphi替换给定字符串中带空格或不带空格的特殊字符

    相关文章：

    delphi - 将字符一一添加到TMemo

    delphi - 从鼠标光标下的像素获取 alpha channel 值

    linux - Indy 10 以 1024 个 block 发送数据。如何增加 block 大小？

    delphi - 创建无边框表单而不丢失 Windows 命令

    delphi - 使用 Unicode 数据从文件加载

    Lazarus 中的 Windows 模拟 Apache 模块

    delphi - Move() 从动态字符串数组中插入/删除项目

    delphi - 更换功能单元

    Delphi XE AnsiStrings 带有转义组合变音符号

    ©2024 IT工具网  联系我们