Changeset 64

Timestamp:

Nov 9, 2019, 2:17:47 PM (4 years ago)

Author:

chronos

Message:

• Added: Allow to slide blocks using mouse.

Location:

trunk/Forms

Files:

• UFormMain.lfm (modified) (1 diff)
• UFormMain.pas (modified) (4 diffs)

trunk/Forms/UFormMain.lfm

@@ -11 +11 @@
   OnDestroy = FormDestroy
   OnKeyUp = FormKeyUp
+  OnMouseDown = FormMouseDown
+  OnMouseMove = FormMouseMove
+  OnMouseUp = FormMouseUp
   OnPaint = FormPaint
   OnShow = FormShow

trunk/Forms/UFormMain.pas

@@ -6 +6 @@
 
 uses
-  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Menus,
+  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Menus, Math,
   ActnList, ExtCtrls, StdCtrls, UGame, UPersistentForm, UApplicationInfo;
 
@@ -31 +31 @@
     procedure FormDestroy(Sender: TObject);
     procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
+    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
+      Shift: TShiftState; X, Y: Integer);
+    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
+    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
+      Shift: TShiftState; X, Y: Integer);
     procedure FormPaint(Sender: TObject);
     procedure FormShow(Sender: TObject);
     procedure TimerDrawTimer(Sender: TObject);
   private
+    MouseStart: TPoint;
+    MouseDown: Boolean;
     RedrawPending: Boolean;
-    KeyBuffer: array of Word;
+    MoveBuffer: array of TMoveDirection;
+    procedure AddToMoveBuffer(Direction: TMoveDirection);
+    procedure ProcessMoveBuffer;
   public
     procedure Redraw;
@@ -57 +66 @@
 begin
   if Core.Game.Running then begin
-    SetLength(KeyBuffer, Length(KeyBuffer) + 1);
-    KeyBuffer[Length(KeyBuffer) - 1] := Key;
-    if not Core.Game.Moving then begin
-      while Length(KeyBuffer) > 0 do begin
-        case KeyBuffer[0] of
-          37: Core.Game.MoveAllAndUpdate(drLeft, True);
-          38: Core.Game.MoveAllAndUpdate(drUp, True);
-          39: Core.Game.MoveAllAndUpdate(drRight, True);
-          40: Core.Game.MoveAllAndUpdate(drDown, True);
-        end;
-        if Length(KeyBuffer) > 1 then
-          Move(KeyBuffer[1], KeyBuffer[0], (Length(KeyBuffer) - 1) * SizeOf(Word));
-        if Length(KeyBuffer) > 0 then
-          SetLength(KeyBuffer, Length(KeyBuffer) - 1);
-      end;
-    end else begin
-    end;
-  end;
+    case Key of
+      37: AddToMoveBuffer(drLeft);
+      38: AddToMoveBuffer(drUp);
+      39: AddToMoveBuffer(drRight);
+      40: AddToMoveBuffer(drDown);
+    end;
+    ProcessMoveBuffer;
+  end;
+end;
+
+procedure TFormMain.FormMouseDown(Sender: TObject; Button: TMouseButton;
+  Shift: TShiftState; X, Y: Integer);
+begin
+  MouseStart := Point(X, Y);
+  MouseDown := True;
+end;
+
+function AngleOfLine(const P1, P2: TPoint): Double;
+begin
+  if P2.X = P1.X then
+    if P2.Y > P1.Y then
+      Result := 90
+    else
+      Result := 270
+  else
+    Result := RadToDeg(ArcTan2(P2.Y - P1.Y, P2.X - P1.X));
+  if Result < 0 then
+    Result := Result + 360;
+end;
+
+procedure TFormMain.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
+  Y: Integer);
+var
+  D: Real;
+  Angle: Real;
+begin
+  if MouseDown then begin;
+    D := MouseStart.Distance(Point(X, Y));
+    if D > ScaleX(100, 96) then begin
+      MouseDown := False;
+      Angle := AngleOfLine(MouseStart, Point(X, Y));
+      if (Angle > 315) or (Angle <= 45) then AddToMoveBuffer(drRight)
+      else if (Angle > 45) and (Angle <= 135) then AddToMoveBuffer(drDown)
+      else if (Angle > 135) and (Angle <= 225) then AddToMoveBuffer(drLeft)
+      else if (Angle > 225) and (Angle <= 315) then AddToMoveBuffer(drUp);
+      ProcessMoveBuffer;
+    end;
+  end;
+end;
+
+procedure TFormMain.FormMouseUp(Sender: TObject; Button: TMouseButton;
+  Shift: TShiftState; X, Y: Integer);
+begin
+  MouseDown := False;
 end;
 
@@ -114 +159 @@
 end;
 
+procedure TFormMain.AddToMoveBuffer(Direction: TMoveDirection);
+begin
+  SetLength(MoveBuffer, Length(MoveBuffer) + 1);
+  MoveBuffer[Length(MoveBuffer) - 1] := Direction;
+end;
+
+procedure TFormMain.ProcessMoveBuffer;
+begin
+  if not Core.Game.Moving then begin
+    while Length(MoveBuffer) > 0 do begin
+      Core.Game.MoveAllAndUpdate(MoveBuffer[0], True);
+      if Length(MoveBuffer) > 1 then
+        Move(MoveBuffer[1], MoveBuffer[0], (Length(MoveBuffer) - 1) * SizeOf(TMoveDirection));
+      if Length(MoveBuffer) > 0 then
+        SetLength(MoveBuffer, Length(MoveBuffer) - 1);
+    end;
+  end else begin
+  end;
+end;
+
 procedure TFormMain.Redraw;
 begin