Zeichnen auf einem Malkasten - Wie kann man mit Mausbewegungen ohne Verzögerung Schritt halten?

Question

Aug 26, 2014, 05:07 PM

Zeichnen auf einem Malkasten - Wie kann man mit Mausbewegungen ohne Verzögerung Schritt halten?

Ich beschloss, selbst einen Karteneditor für ein einfaches RPG-Spiel zu entwickeln. Auf der Karte können Kacheln mit einer Größe von 32 x 32 in die Karte gezeichnet werden.

Ich benutze Lazarus wieder, aber das gilt auch für Delphi.

Das Problem beim Zeichnen von Kacheln besteht nun darin, dass die Kacheln nicht gezeichnet wurden, wenn die Maus ziemlich schnell bewegt wurde. Ich denke, dies hat damit zu tun, dass die X- und Y-Koordinaten der Maus nicht schnell genug verarbeitet werden konnten.

Sehen Sie sich das folgende Bild an, um eine Idee zu geben:

Was ich tat, war, schnell von den links bemalten Kacheln auf die rechte Seite des Malkastens zu gehen, daher die Lücken zwischen den Kacheln. Was ich brauche, ist, in eine dieser Zellen malen zu können, unabhängig davon, wie schnell die Maus bewegt wurde.

Nur eine Anmerkung, ich benutze eineTTimer mitInterval := 1. In derOnTimer Methode Ich speichere eine Aufzeichnung, welche Kacheln in welcher Zelle gezeichnet werden sollen. DasTPaintbox OnPaint Methode liest die Datensätze und zeichnet die Kacheln entsprechend.

Ich kann bei Bedarf Code posten, aber ich glaube, die Lösung könnte etwas sein, das nicht mit meinem Code zusammenhängt, da ich dieses Verhalten in einfachen Malprogrammen beim Zeichnen von Pinselstrichen auf einer Leinwand bemerke.

Wenn Sie die Maus zu schnell bewegen, scheint die Anwendung nicht in der Lage zu sein, mit den Mausbewegungen Schritt zu halten. Daher werden Teile, die gezeichnet werden sollen, übersprungen. Das Bewegen der Maus mit langsamer / normaler Geschwindigkeit funktioniert einwandfrei, aber wenn sie sich schnell bewegt, scheint sie nicht mitzuhalten.

Wie kann ich beispielsweise beim Zeichnen auf einem Canvas / Paintbox mit den Mausbewegungen Schritt halten, insbesondere wenn die Maus sehr schnell bewegt wird, da es den Anschein hat, als gäbe es eine Art Verzögerung zwischen Anwendung und System?

Ich habe meistens den vollständigen Quellcode unten hinzugefügt. Dies stellt keineswegs den endgültigen Code oder etwas anderes dar. Ich habe erst gestern angefangen, während ich herumgespielt habe, um zu sehen, was ich selbst tun kann, damit ich weiß, dass bestimmte Dinge effizienter erledigt werden können, aber das bedeutet nicht, dass ich Tipps schätzen würde oder eine Eingabe, die Sie möglicherweise haben, die ich möglicherweise nicht kenne.

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.

Ein paar Anmerkungen:

Bei den X- und Y-Koordinaten wird davon ausgegangen, dass ein Raster von 32 x 32 erstellt wird. Beispiel: Wenn X = 3, ist die Zelle 96 usw.MapEditor ist der Name des Farbkastens.lvwRecords ist nur eine schnelle und schmutzige Art, die Kachelpositionen in einer TListView zu speichern. Später werde ich geeignete Klassen verwenden, um die Daten zu speichern.

Die Verwendung der Listenansicht zum Speichern der Kachelpositionen sieht folgendermaßen aus (wie ich bereits sagte, diente dies nur zum schnellen Testen, bis ich die richtigen Klassen oder Array-Datensätze verwende):

Danke.