Changeset 576

Timestamp:

May 17, 2024, 9:21:22 AM (4 months ago)

Author:

chronos

Message:

• Added: Move tech tree form with pressed arrow keys for longer time.

Location:

trunk/LocalPlayer

Files:

• TechTree.lfm (modified) (4 diffs)
• TechTree.pas (modified) (9 diffs)

trunk/LocalPlayer/TechTree.lfm

@@ -1 +1 @@
 object TechTreeDlg: TTechTreeDlg
+  Cursor = 3
   Left = 1162
+  Height = 482
+  Top = 481
   Width = 611
-  Top = 481
-  Height = 482
-  Cursor = 3
   BorderIcons = []
   BorderStyle = bsNone
@@ -19 +19 @@
   Position = poDefault
   Scaled = False
+  OnClose = FormClose
   OnCreate = FormCreate
   OnDestroy = FormDestroy
+  OnKeyDown = FormKeyDown
   OnKeyUp = FormKeyUp
   OnMouseDown = FormMouseDown
@@ -30 +32 @@
   TextHeight = 16
   object CloseBtn: TButtonB
+    Cursor = crArrow
     Left = 568
+    Height = 25
     Top = 16
     Width = 25
-    Height = 25
-    Cursor = crArrow
     Down = False
     Permanent = False
@@ -40 +42 @@
     ButtonIndex = 0
   end
+  object TimerKeyPressed: TTimer
+    Enabled = False
+    Interval = 250
+    OnTimer = TimerKeyPressedTimer
+    Left = 177
+    Top = 180
+  end
 end

trunk/LocalPlayer/TechTree.pas

@@ -7 +7 @@
   ScreenTools, LCLIntf, LCLType, SysUtils, Classes, ButtonB, DrawDlg,
   {$IFDEF DPI}Dpi.Graphics, Dpi.Controls, Dpi.Forms{$ELSE}
-  Graphics, Controls, Forms{$ENDIF};
+  Graphics, Controls, Forms{$ENDIF}, Controls, ExtCtrls, Forms;
 
 type
@@ -15 +15 @@
   TTechTreeDlg = class(TDrawDlg)
     CloseBtn: TButtonB;
+    TimerKeyPressed: TTimer;
+    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
     procedure FormCreate(Sender: TObject);
     procedure FormDestroy(Sender: TObject);
+    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
     procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
     procedure FormPaint(Sender: TObject);
@@ -26 +29 @@
     procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
     procedure CloseBtnClick(Sender: TObject);
+    procedure TimerKeyPressedTimer(Sender: TObject);
   private
     Offset: TPoint;
@@ -31 +35 @@
     Image: TBitmap;
     Dragging: Boolean;
+    LeftPressed: Boolean;
+    RightPressed: Boolean;
+    UpPressed: Boolean;
+    DownPressed: Boolean;
     procedure Move(Diff: TPoint);
   end;
@@ -58 +66 @@
 function Min(A, B: Integer): Integer;
 begin
-  if A < B then
-    Result := A
-  else
-    Result := B;
+  if A < B then Result := A
+    else Result := B;
 end;
 
 function Max(A, B: Integer): Integer;
 begin
-  if A > B then
-    Result := A
-  else
-    Result := B;
+  if A > B then Result := A
+    else Result := B;
 end;
 
@@ -78 +82 @@
 end;
 
+procedure TTechTreeDlg.FormClose(Sender: TObject; var CloseAction: TCloseAction
+  );
+begin
+  TimerKeyPressed.Enabled := False;
+  RightPressed := False;
+  DownPressed := False;
+  LeftPressed := False;
+  UpPressed := False;
+end;
+
 procedure TTechTreeDlg.FormDestroy(Sender: TObject);
 begin
   FreeAndNil(Image);
+end;
+
+procedure TTechTreeDlg.FormKeyDown(Sender: TObject; var Key: Word;
+  Shift: TShiftState);
+begin
+  case Key of
+    37: RightPressed := True;
+    38: DownPressed := True;
+    39: LeftPressed := True;
+    40: UpPressed := True;
+  end;
+  TimerKeyPressedTimer(nil);
+  TimerKeyPressed.Enabled := RightPressed or DownPressed or LeftPressed or UpPressed;
 end;
 
 procedure TTechTreeDlg.FormKeyUp(Sender: TObject; var Key: Word;
   Shift: TShiftState);
-const
-  Diff = 50;
 begin
   case Key of
-    37: Move(Point(Diff, 0));
-    38: Move(Point(0, Diff));
-    39: Move(Point(-Diff, 0));
-    40: Move(Point(0, -Diff));
-  end;
+    37: RightPressed := False;
+    38: DownPressed := False;
+    39: LeftPressed := False;
+    40: UpPressed := False;
+  end;
+  TimerKeyPressed.Enabled := RightPressed or DownPressed or LeftPressed or UpPressed;
 end;
 
@@ -188 +214 @@
 
   // Fit window to image, center image in window, center window to screen
-  NewWidth := Min(Screen.Width - 40, Image.Width + LeftBorder + RightBorder + 2 * BlackBorder);
-  NewHeight := Min(Screen.Height - 40, Image.Height + TopBorder + BottomBorder + 2 * BlackBorder);
+  NewWidth := Min(Screen.Width - 40, Image.Width + LeftBorder + RightBorder +
+    2 * BlackBorder);
+  NewHeight := Min(Screen.Height - 40, Image.Height + TopBorder + BottomBorder +
+    2 * BlackBorder);
   BoundsRect := Bounds((Screen.Width - NewWidth) div 2,
-    (Screen.Height - NewHeight) div 2,
-    NewWidth, NewHeight);
+    (Screen.Height - NewHeight) div 2, NewWidth, NewHeight);
   CloseBtn.Left := Width - CloseBtn.Width - BlackBorder - 8;
   CloseBtn.Top := BlackBorder + 8;
@@ -229 +256 @@
 begin
   Close;
+end;
+
+procedure TTechTreeDlg.TimerKeyPressedTimer(Sender: TObject);
+const
+  Diff = 50;
+var
+  Change: TPoint;
+begin
+  Change := Point(0, 0);
+  if RightPressed then Change.X := Change.X + Diff;
+  if LeftPressed then Change.X := Change.X - Diff;
+  if DownPressed then Change.Y := Change.Y + Diff;
+  if UpPressed then Change.Y := Change.Y - Diff;
+
+  if (Change.X <> 0) or (Change.Y <> 0) then Move(Change);
 end;
 
@@ -241 +283 @@
   if Offset.Y > TopBorder then
     Offset.Y := TopBorder;
-  if Offset.Y < ClientHeight - 2 * BlackBorder - Image.Height - BottomBorder
-  then
+  if Offset.Y < ClientHeight - 2 * BlackBorder - Image.Height - BottomBorder then
     Offset.Y := ClientHeight - 2 * BlackBorder - Image.Height - BottomBorder;