Changeset 102

Timestamp:

Dec 9, 2024, 11:55:53 AM (12 days ago)

Author:

chronos

Message:

• Modified: Lowered minimal swipe distance.
• Modified: Show score and best score as boxes. Place them according window size.
• Modified: Updated Common package.

Location:

trunk

Files:

• Forms/FormMain.pas (modified) (1 diff)
• Game.pas (modified) (5 diffs)
• Languages/Game2048.cs.po (modified) (1 diff)
• Packages/Common/Common.lpk (modified) (2 diffs)
• Packages/Common/Common.pas (modified) (11 diffs)
• Packages/Common/CommonPackage.pas (modified) (1 diff)
• Packages/Common/FormEx.pas (modified) (1 diff)
• Packages/Common/Forms/FormAbout.lfm (modified) (3 diffs)
• Packages/Common/Languages/Common.cs.po (added)
• Packages/Common/ListViewSort.pas (modified) (1 diff)
• Packages/Common/PersistentForm.pas (modified) (1 diff)
• Packages/Common/Table.pas (modified) (1 diff)

trunk/Forms/FormMain.pas

@@ -137 +137 @@
   D: Real;
   Angle: Real;
+const
+  SwipeMinDistance = 50;
 begin
   if MouseDown then begin;
     D := MouseStart.Distance(Point(X, Y));
-    if D > ScaleX(100, 96) then begin
+    if D > ScaleX(SwipeMinDistance, 96) then begin
       MouseDown := False;
       Angle := AngleOfLine(MouseStart, Point(X, Y));

trunk/Game.pas

@@ -119 +119 @@
     procedure DoPaint;
     procedure RenderTile(Canvas: TCanvas; Tile: TTile; TileRect: TRect; WithText: Boolean);
+    procedure RenderControls(Canvas: TCanvas; Rect: TRect; Horizontal: Boolean);
+    function RenderTextBox(Canvas: TCanvas; Pos: TPoint; Title, Value: string): TSize;
     procedure GameOver;
     procedure SetColorPalette(AValue: TColorPalette);
@@ -185 +187 @@
 resourcestring
   SScore = 'Score';
-  STopScore = 'Top score';
+  STopScore = 'Best';
   SSkinLinear = 'Linear';
   SSkinPowerOfTwo = 'Power of two';
@@ -643 +645 @@
   X, Y: Integer;
   TileSize: TPoint;
-  ValueStr: string;
   Frame: TRect;
   TileRect: TRect;
   TopBarHeight: Integer;
+  LeftBarWidth: Integer;
   TileMargin: Integer;
   TileCenter: TPoint;
@@ -652 +654 @@
   MetaCanvas: TMetaCanvas;
   BorderSize: Integer;
-begin
+  ControlsRect: TRect;
+  BoardRect: TRect;
+  Horizontal: Boolean;
+begin
+  // Form.Canvas.Width and Form.Canvas.Height is not working correctly under Windows.
+  // So dimensions are provided by CanvasSize parameter.
+
   MetaCanvas := TMetaCanvas.Create;
   MetaCanvas.Size := Point(Canvas.Width, Canvas.Height);
 
-  TopBarHeight := ScaleY(24, 96);
+  // Clear background
   MetaCanvas.Brush.Style := bsSolid;
   MetaCanvas.Brush.Color := Core.Core.ThemeManager1.Theme.ColorControl;
   MetaCanvas.FillRect(0, 0, MetaCanvas.Width, MetaCanvas.Height);
 
-  ValueStr := SScore + ': ' + IntToStr(Score);
-  MetaCanvas.Brush.Style := bsClear;
-  MetaCanvas.Font.Color := Core.Core.ThemeManager1.Theme.ColorControlText;
-  MetaCanvas.Font.Height := Trunc(TopBarHeight * 0.7);
-  MetaCanvas.TextOut(ScaleY(16, 96), (TopBarHeight - MetaCanvas.TextHeight(ValueStr)) div 2, ValueStr);
-
-  ValueStr := STopScore + ': ' + IntToStr(TopScore);
-  MetaCanvas.Font.Color := Core.Core.ThemeManager1.Theme.ColorControlText;
-  MetaCanvas.Font.Height := Trunc(TopBarHeight * 0.7);
-  MetaCanvas.TextOut(ScaleY(136, 96), (TopBarHeight - MetaCanvas.TextHeight(ValueStr)) div 2, ValueStr);
-
-  // Form.Canvas.Width and Form.Canvas.Height is not working correctly under Windows.
-  // So dimensions are provided by CanvasSize parameter.
+  TopBarHeight := ScaleY(55, 96);
+  LeftBarWidth := ScaleY(90, 96);
+  if CanvasSize.X - LeftBarWidth < Canvas.Height then begin
+    ControlsRect := Rect(0, 0, CanvasSize.X, TopBarHeight);
+    BoardRect := Rect(0, TopBarHeight, CanvasSize.X, CanvasSize.Y);
+    Horizontal := True;
+  end else begin
+    ControlsRect := Rect(0, 0, LeftBarWidth, CanvasSize.Y);
+    BoardRect := Rect(LeftBarWidth, 0, CanvasSize.X, CanvasSize.Y);
+    Horizontal := False;
+  end;
+
+  RenderControls(MetaCanvas, ControlsRect, Horizontal);
+
   BorderSize := ScaleY(2, 96);
-  Frame := Rect(BorderSize, BorderSize + TopBarHeight, CanvasSize.X - BorderSize, CanvasSize.Y - BorderSize);
+  Frame := Rect(BoardRect.Left + BorderSize, BoardRect.Top + BorderSize,
+    BoardRect.Right - BorderSize, BoardRect.Bottom - BorderSize);
+
   TileSize := Point(Frame.Width div Board.Size.X, Frame.Height div Board.Size.Y);
   if TileSize.X < TileSize.Y then TileSize.Y := TileSize.X;
@@ -849 +860 @@
 end;
 
+procedure TGame.RenderControls(Canvas: TCanvas; Rect: TRect; Horizontal: Boolean);
+var
+  Pos: TPoint;
+  Size: TSize;
+begin
+  if Horizontal then Pos := Point(ScaleY(16, 96), ScaleY(4, 96))
+    else Pos := Point(ScaleY(4, 96), ScaleY(16, 96));
+
+  Size := RenderTextBox(Canvas, Pos, SScore, IntToStr(Score));
+
+  if Horizontal then Pos := Point(ScaleY(16 + 16, 96) + Size.Width, ScaleY(4, 96))
+    else Pos := Point(ScaleY(4, 96), ScaleY(16 + 16, 96) + Size.Height);
+
+  Size := RenderTextBox(Canvas, Pos, STopScore, IntToStr(TopScore));
+end;
+
+function TGame.RenderTextBox(Canvas: TCanvas; Pos: TPoint; Title, Value: string
+  ): TSize;
+var
+  BoxSize: TSize;
+begin
+  with Canvas do begin
+    Font.Color := Core.Core.ThemeManager1.Theme.ColorControlText;
+    Font.Height := Trunc(24);
+
+    BoxSize := Size(TextWidth(Title), TextHeight(Title) + TextHeight(Value));
+    if BoxSize.Width < TextWidth(Value) then BoxSize.Width := TextWidth(Value);
+    BoxSize := Size(Round(BoxSize.Width * 1.2), Round(BoxSize.Height * 1));
+
+    Brush.Style := bsSolid;
+    Brush.Color := Core.Core.ThemeManager1.Theme.ColorWindow;
+    FillRect(Pos.X, Pos.Y, Pos.X + BoxSize.Width, Pos.Y + BoxSize.Height);
+
+    Brush.Style := bsClear;
+    TextOut(Pos.X + (BoxSize.Width - TextWidth(Title)) div 2, Pos.Y, Title);
+
+    Brush.Style := bsClear;
+    Font.Color := Core.Core.ThemeManager1.Theme.ColorControlText;
+    Font.Height := Trunc(24);
+    TextOut(Pos.X + (BoxSize.Width - TextWidth(Value)) div 2,
+      Pos.Y + TextHeight(Title), Value);
+  end;
+
+  Result := BoxSize;
+end;
+
 function TGame.CanUndo: Boolean;
 begin

trunk/Languages/Game2048.cs.po

@@ -129 +129 @@
 #: game.stopscore
 msgctxt "game.stopscore"
-msgid "Top score"
-msgstr "Nejvyšší skóre"
+msgid "Best"
+msgstr "Nejlepší"
 
 #: tcore.aabout.caption

trunk/Packages/Common/Common.lpk

@@ -43 +43 @@
     <License Value="Copy left."/>
     <Version Minor="12"/>
-    <Files Count="36">
+    <Files Count="37">
       <Item1>
         <Filename Value="StopWatch.pas"/>
@@ -201 +201 @@
         <UnitName Value="FormAbout"/>
       </Item36>
+      <Item37>
+        <Filename Value="Forms\FormKeyShortcuts.pas"/>
+        <UnitName Value="FormKeyShortcuts"/>
+      </Item37>
     </Files>
     <CompatibilityMode Value="True"/>

trunk/Packages/Common/Common.pas

@@ -55 +55 @@
 function EndsWith(Text, What: string): Boolean;
 function Explode(Separator: Char; Data: string): TStringArray;
-procedure ExecuteProgram(Executable: string; Parameters: array of string);
+procedure ExecuteProgram(Executable: string; Parameters: array of string;
+  Environment: array of string; CurrentDirectory: string = '');
+procedure ExecuteProgramOutput(Executable: string; Parameters: array of string;
+  Environment: array of string; out Output, Error: string;
+  out ExitCode: Integer; CurrentDirectory: string = '');
 procedure FileDialogUpdateFilterFileType(FileDialog: TOpenDialog);
 procedure FreeThenNil(var Obj);
@@ -63 +67 @@
 function GetBit(Variable: QWord; Index: Byte): Boolean;
 function GetStringPart(var Text: string; Separator: string): string;
+function GetEnvironmentVariables: TStringArray;
 function GenerateNewName(OldName: string): string;
 function GetFileFilterItemExt(Filter: string; Index: Integer): string;
 function IntToBin(Data: Int64; Count: Byte): string;
-function Implode(Separator: string; List: TList<string>): string;
-function Implode(Separator: string; List: TStringList; Around: string = ''): string;
+function Implode(Separator: string; List: TList<string>): string; overload;
+function Implode(Separator: string; List: array of string): string; overload;
+function Implode(Separator: string; List: TStringList; Around: string = ''): string; overload;
 function LastPos(const SubStr: String; const S: String): Integer;
 function LoadFileToStr(const FileName: TFileName): AnsiString;
@@ -98 +104 @@
 implementation
 
+resourcestring
+  SExecutionError = 'Excution error: %s (exit code: %d)';
+
 function StartsWith(Text, What: string): Boolean;
 begin
@@ -108 +117 @@
 end;
 
-function BinToInt(BinStr : string) : Int64;
-var
-  i : byte;
-  RetVar : Int64;
+function BinToInt(BinStr: string): Int64;
+var
+  I: Byte;
+  RetVar: Int64;
 begin
   BinStr := UpperCase(BinStr);
-  if BinStr[length(BinStr)] = 'B' then Delete(BinStr,length(BinStr),1);
+  if BinStr[length(BinStr)] = 'B' then Delete(BinStr, Length(BinStr), 1);
   RetVar := 0;
-  for i := 1 to length(BinStr) do begin
-    if not (BinStr[i] in ['0','1']) then begin
+  for I := 1 to Length(BinStr) do begin
+    if not (BinStr[I] in ['0','1']) then begin
       RetVar := 0;
       Break;
     end;
-    RetVar := (RetVar shl 1) + (byte(BinStr[i]) and 1) ;
+    RetVar := (RetVar shl 1) + (Byte(BinStr[I]) and 1);
   end;
 
@@ -136 +145 @@
   end;
 end;
-
 
 procedure DeleteFiles(APath, AFileSpec: string);
@@ -154 +162 @@
   FindClose(SearchRec);
 end;
-
 
 function GetFileFilterItemExt(Filter: string; Index: Integer): string;
@@ -177 +184 @@
   if FileExt <> '.*' then
     FileDialog.FileName := ChangeFileExt(FileDialog.FileName, FileExt)
+end;
+
+function GetEnvironmentVariables: TStringArray;
+var
+  I: Integer;
+begin
+  SetLength(Result, GetEnvironmentVariableCount);
+  for I := 0 to GetEnvironmentVariableCount - 1 do
+    Result[I] := GetEnvironmentString(I);
 end;
 
@@ -219 +235 @@
 end;*)
 
+function Implode(Separator: string; List: array of string): string;
+var
+  I: Integer;
+begin
+  Result := '';
+  for I := 0 to Length(List) - 1 do begin
+    Result := Result + List[I];
+    if I < Length(List) - 1 then Result := Result + Separator;
+  end;
+end;
+
 function Implode(Separator: string; List: TStringList; Around: string = ''): string;
 var
@@ -494 +521 @@
 end;
 
-procedure ExecuteProgram(Executable: string; Parameters: array of string);
+procedure ExecuteProgram(Executable: string; Parameters: array of string;
+  Environment: array of string; CurrentDirectory: string = '');
 var
   Process: TProcess;
   I: Integer;
 begin
+  Process := TProcess.Create(nil);
   try
-    Process := TProcess.Create(nil);
     Process.Executable := Executable;
     for I := 0 to Length(Parameters) - 1 do
       Process.Parameters.Add(Parameters[I]);
+    for I := 0 to Length(Environment) - 1 do
+      Process.Environment.Add(Environment[I]);
+    Process.CurrentDirectory := CurrentDirectory;
+    Process.ShowWindow := swoHIDE;
     Process.Options := [poNoConsole];
     Process.Execute;
@@ -511 +543 @@
 end;
 
+procedure ExecuteProgramOutput(Executable: string; Parameters: array of string;
+  Environment: array of string; out Output, Error: string; out ExitCode: Integer;
+  CurrentDirectory: string);
+var
+  Process: TProcess;
+  I: Integer;
+  ReadCount: Integer;
+  Buffer: string;
+const
+  BufferSize = 1000;
+begin
+  Process := TProcess.Create(nil);
+  try
+    Process.Executable := Executable;
+    for I := 0 to Length(Parameters) - 1 do
+      Process.Parameters.Add(Parameters[I]);
+    for I := 0 to Length(Environment) - 1 do
+      Process.Environment.Add(Environment[I]);
+    Process.CurrentDirectory := CurrentDirectory;
+    Process.ShowWindow := swoHIDE;
+    Process.Options := [poNoConsole, poUsePipes];
+    Process.Execute;
+
+    Output := '';
+    Error := '';
+    Buffer := '';
+    SetLength(Buffer, BufferSize);
+    while Process.Running do begin
+      if Process.Output.NumBytesAvailable > 0 then begin
+        ReadCount := Process.Output.Read(Buffer[1], Length(Buffer));
+        Output := Output + Copy(Buffer, 1, ReadCount);
+      end;
+
+      if Process.Stderr.NumBytesAvailable > 0 then begin
+        ReadCount := Process.Stderr.Read(Buffer[1], Length(Buffer));
+        Error := Error + Copy(Buffer, 1, ReadCount)
+      end;
+
+      Sleep(10);
+    end;
+
+    if Process.Output.NumBytesAvailable > 0 then begin
+      ReadCount := Process.Output.Read(Buffer[1], Length(Buffer));
+      Output := Output + Copy(Buffer, 1, ReadCount);
+    end;
+
+    if Process.Stderr.NumBytesAvailable > 0 then begin
+      ReadCount := Process.Stderr.Read(Buffer[1], Length(Buffer));
+      Error := Error + Copy(Buffer, 1, ReadCount);
+    end;
+
+    ExitCode := Process.ExitCode;
+
+    if (ExitCode <> 0) or (Error <> '') then
+      raise Exception.Create(Format(SExecutionError, [Output + Error, ExitCode]));
+  finally
+    Process.Free;
+  end;
+end;
+
 procedure FreeThenNil(var Obj);
 begin
@@ -529 +621 @@
 procedure OpenFileInShell(FileName: string);
 begin
-  ExecuteProgram('cmd.exe', ['/c', 'start', FileName]);
+  ExecuteProgram('cmd.exe', ['/c', 'start', FileName], []);
 end;
 

trunk/Packages/Common/CommonPackage.pas

@@ -14 +14 @@
   ScaleDPI, Theme, StringTable, MetaCanvas, Geometric, Translator, Languages, 
   PixelPointer, DataFile, TestCase, Generics, Table, FormEx, FormTests, 
-  FormTest, FormAbout, LazarusPackageIntf;
+  FormTest, FormAbout, FormKeyShortcuts, LazarusPackageIntf;
 
 implementation

trunk/Packages/Common/FormEx.pas

@@ -82 +82 @@
 procedure TFormEx.DoClose(var CloseAction: TCloseAction);
 begin
-  if  (not (csDesigning in ComponentState)) then begin
+  if (not (csDesigning in ComponentState)) then begin
     PersistentForm.FormFullScreen := FullScreen;
     PersistentForm.Save(Self);

trunk/Packages/Common/Forms/FormAbout.lfm

@@ -1 +1 @@
 object FormAbout: TFormAbout
-  Left = 929
+  Left = 624
   Height = 402
-  Top = 519
+  Top = 622
   Width = 702
   Caption = 'About'
@@ -10 +10 @@
   OnShow = FormShow
   Position = poScreenCenter
-  LCLVersion = '3.4.0.0'
+  LCLVersion = '2.2.6.0'
   object LabelDescription: TLabel
     Left = 30
@@ -88 +88 @@
       Anchors = [akLeft, akBottom]
       Caption = 'Home page'
+      OnClick = ButtonHomePageClick
       ParentFont = False
       TabOrder = 0
-      OnClick = ButtonHomePageClick
     end
     object ButtonClose: TButton

trunk/Packages/Common/ListViewSort.pas

@@ -358 +358 @@
     List.Clear;
     List.AddRange(Source);
-  end else List.Clear;
+  end;
   if ListView.Items.Count <> List.Count then
     ListView.Items.Count := List.Count;

trunk/Packages/Common/PersistentForm.pas

@@ -336 +336 @@
     end;
     Form.OnWindowStateChange := OldHandler;
+    FormFullScreen := True;
     {$ENDIF}
   end else begin

trunk/Packages/Common/Table.pas

@@ -4 +4 @@
 
 uses
-  Classes, SysUtils, Generics.Collections, ComCtrls, XMLRead, XMLWrite, DOM;
+  Classes, SysUtils, Generics.Collections, ComCtrls, XMLRead, DOM;
 
 type