Changeset 64 for trunk


Ignore:
Timestamp:
Nov 9, 2019, 2:17:47 PM (5 years ago)
Author:
chronos
Message:
  • Added: Allow to slide blocks using mouse.
Location:
trunk/Forms
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • trunk/Forms/UFormMain.lfm

    r36 r64  
    1111  OnDestroy = FormDestroy
    1212  OnKeyUp = FormKeyUp
     13  OnMouseDown = FormMouseDown
     14  OnMouseMove = FormMouseMove
     15  OnMouseUp = FormMouseUp
    1316  OnPaint = FormPaint
    1417  OnShow = FormShow
  • trunk/Forms/UFormMain.pas

    r55 r64  
    66
    77uses
    8   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Menus,
     8  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Menus, Math,
    99  ActnList, ExtCtrls, StdCtrls, UGame, UPersistentForm, UApplicationInfo;
    1010
     
    3131    procedure FormDestroy(Sender: TObject);
    3232    procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
     33    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
     34      Shift: TShiftState; X, Y: Integer);
     35    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
     36    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
     37      Shift: TShiftState; X, Y: Integer);
    3338    procedure FormPaint(Sender: TObject);
    3439    procedure FormShow(Sender: TObject);
    3540    procedure TimerDrawTimer(Sender: TObject);
    3641  private
     42    MouseStart: TPoint;
     43    MouseDown: Boolean;
    3744    RedrawPending: Boolean;
    38     KeyBuffer: array of Word;
     45    MoveBuffer: array of TMoveDirection;
     46    procedure AddToMoveBuffer(Direction: TMoveDirection);
     47    procedure ProcessMoveBuffer;
    3948  public
    4049    procedure Redraw;
     
    5766begin
    5867  if Core.Game.Running then begin
    59     SetLength(KeyBuffer, Length(KeyBuffer) + 1);
    60     KeyBuffer[Length(KeyBuffer) - 1] := Key;
    61     if not Core.Game.Moving then begin
    62       while Length(KeyBuffer) > 0 do begin
    63         case KeyBuffer[0] of
    64           37: Core.Game.MoveAllAndUpdate(drLeft, True);
    65           38: Core.Game.MoveAllAndUpdate(drUp, True);
    66           39: Core.Game.MoveAllAndUpdate(drRight, True);
    67           40: Core.Game.MoveAllAndUpdate(drDown, True);
    68         end;
    69         if Length(KeyBuffer) > 1 then
    70           Move(KeyBuffer[1], KeyBuffer[0], (Length(KeyBuffer) - 1) * SizeOf(Word));
    71         if Length(KeyBuffer) > 0 then
    72           SetLength(KeyBuffer, Length(KeyBuffer) - 1);
    73       end;
    74     end else begin
    75     end;
    76   end;
     68    case Key of
     69      37: AddToMoveBuffer(drLeft);
     70      38: AddToMoveBuffer(drUp);
     71      39: AddToMoveBuffer(drRight);
     72      40: AddToMoveBuffer(drDown);
     73    end;
     74    ProcessMoveBuffer;
     75  end;
     76end;
     77
     78procedure TFormMain.FormMouseDown(Sender: TObject; Button: TMouseButton;
     79  Shift: TShiftState; X, Y: Integer);
     80begin
     81  MouseStart := Point(X, Y);
     82  MouseDown := True;
     83end;
     84
     85function AngleOfLine(const P1, P2: TPoint): Double;
     86begin
     87  if P2.X = P1.X then
     88    if P2.Y > P1.Y then
     89      Result := 90
     90    else
     91      Result := 270
     92  else
     93    Result := RadToDeg(ArcTan2(P2.Y - P1.Y, P2.X - P1.X));
     94  if Result < 0 then
     95    Result := Result + 360;
     96end;
     97
     98procedure TFormMain.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
     99  Y: Integer);
     100var
     101  D: Real;
     102  Angle: Real;
     103begin
     104  if MouseDown then begin;
     105    D := MouseStart.Distance(Point(X, Y));
     106    if D > ScaleX(100, 96) then begin
     107      MouseDown := False;
     108      Angle := AngleOfLine(MouseStart, Point(X, Y));
     109      if (Angle > 315) or (Angle <= 45) then AddToMoveBuffer(drRight)
     110      else if (Angle > 45) and (Angle <= 135) then AddToMoveBuffer(drDown)
     111      else if (Angle > 135) and (Angle <= 225) then AddToMoveBuffer(drLeft)
     112      else if (Angle > 225) and (Angle <= 315) then AddToMoveBuffer(drUp);
     113      ProcessMoveBuffer;
     114    end;
     115  end;
     116end;
     117
     118procedure TFormMain.FormMouseUp(Sender: TObject; Button: TMouseButton;
     119  Shift: TShiftState; X, Y: Integer);
     120begin
     121  MouseDown := False;
    77122end;
    78123
     
    114159end;
    115160
     161procedure TFormMain.AddToMoveBuffer(Direction: TMoveDirection);
     162begin
     163  SetLength(MoveBuffer, Length(MoveBuffer) + 1);
     164  MoveBuffer[Length(MoveBuffer) - 1] := Direction;
     165end;
     166
     167procedure TFormMain.ProcessMoveBuffer;
     168begin
     169  if not Core.Game.Moving then begin
     170    while Length(MoveBuffer) > 0 do begin
     171      Core.Game.MoveAllAndUpdate(MoveBuffer[0], True);
     172      if Length(MoveBuffer) > 1 then
     173        Move(MoveBuffer[1], MoveBuffer[0], (Length(MoveBuffer) - 1) * SizeOf(TMoveDirection));
     174      if Length(MoveBuffer) > 0 then
     175        SetLength(MoveBuffer, Length(MoveBuffer) - 1);
     176    end;
     177  end else begin
     178  end;
     179end;
     180
    116181procedure TFormMain.Redraw;
    117182begin
Note: See TracChangeset for help on using the changeset viewer.