Ignore:
Timestamp:
Feb 8, 2018, 5:32:31 PM (7 years ago)
Author:
chronos
Message:
  • Modified: Client related interface moved from FormMain to FormClient. This code change will later allow to implement network client-server gameplay.
  • Added: Allow to open other spectator client windows.
File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/Forms/UFormMain.pas

    r171 r180  
    77uses
    88  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
    9   UGame, LCLType, Menus, ActnList, ComCtrls, dateutils, XMLConf, DOM,
    10   UGeometry;
     9  UGame, LCLType, Menus, ActnList, ComCtrls, dateutils, XMLConf, DOM;
    1110
    1211const
    … …  
    1918
    2019  TFormMain = class(TForm)
    21     AStatusBarVisible: TAction;
    2220    AToolBarVisible: TAction;
    2321    AToolBarBigIcons: TAction;
    24     AZoomIn: TAction;
    25     AZoomAll: TAction;
    26     AZoomOut: TAction;
    2722    ActionList1: TActionList;
    2823    MainMenu1: TMainMenu;
    … …  
    4540    MenuItem24: TMenuItem;
    4641    MenuItem25: TMenuItem;
     42    MenuItem26: TMenuItem;
     43    MenuItem27: TMenuItem;
    4744    MenuItemLoadRecent: TMenuItem;
    4845    MenuItem3: TMenuItem;
    … …  
    5350    MenuItem8: TMenuItem;
    5451    MenuItem9: TMenuItem;
    55     PaintBox1: TPaintBox;
     52    PanelMain: TPanel;
    5653    PopupMenuToolbar: TPopupMenu;
    57     StatusBar1: TStatusBar;
    5854    Timer1: TTimer;
    5955    ToolBar1: TToolBar;
    6056    ToolButton1: TToolButton;
    61     ToolButton10: TToolButton;
    6257    ToolButton11: TToolButton;
    6358    ToolButton12: TToolButton;
    … …  
    6762    ToolButton4: TToolButton;
    6863    ToolButton5: TToolButton;
    69     ToolButton6: TToolButton;
    70     ToolButton7: TToolButton;
    71     ToolButton8: TToolButton;
    7264    ToolButton9: TToolButton;
    73     procedure AStatusBarVisibleExecute(Sender: TObject);
    7465    procedure AToolBarBigIconsExecute(Sender: TObject);
    7566    procedure AToolBarVisibleExecute(Sender: TObject);
    76     procedure AZoomAllExecute(Sender: TObject);
    77     procedure AZoomInExecute(Sender: TObject);
    78     procedure AZoomOutExecute(Sender: TObject);
    7967    procedure FormShow(Sender: TObject);
    8068    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    8169    procedure FormCreate(Sender: TObject);
    8270    procedure FormDestroy(Sender: TObject);
    83     procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
    84     procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
    85       Shift: TShiftState; X, Y: Integer);
    86     procedure PaintBox1MouseLeave(Sender: TObject);
    87     procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
    88       Y: Integer);
    89     procedure PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
    90       Shift: TShiftState; X, Y: Integer);
    91     procedure PaintBox1MouseWheelDown(Sender: TObject; Shift: TShiftState;
    92       MousePos: TPoint; var Handled: Boolean);
    93     procedure PaintBox1MouseWheelUp(Sender: TObject; Shift: TShiftState;
    94       MousePos: TPoint; var Handled: Boolean);
    95     procedure PaintBox1Paint(Sender: TObject);
    9671    procedure EraseBackground(DC: HDC); override;
    97     procedure PaintBox1Resize(Sender: TObject);
    9872    procedure Timer1Timer(Sender: TObject);
    9973  private
    100     TempBitmap: TBitmap;
    101     StartMousePoint: TPoint;
    102     StartViewPoint: TPoint;
    103     MoveActive: Boolean;
    104     RedrawPending: Boolean;
    105     Drawing: Boolean;
    106     DrawDuration: TDateTime;
    107     LastTimerTime: TDateTime;
    108     TimerPeriod: TDateTime;
    10974  public
    11075    procedure LoadConfig(Config: TXmlConfig; Path: string);
    11176    procedure SaveConfig(Config: TXmlConfig; Path: string);
    11277    procedure ReloadView;
    113     procedure Redraw;
    11478  end;
    11579
    … …  
    12084
    12185uses
    122   UCore;
     86  UCore, UFormClient;
    12387
    12488resourcestring
    … …  
    12993{ TFormMain }
    13094
    131 procedure TFormMain.PaintBox1Paint(Sender: TObject);
    132 var
    133   DrawStart: TDateTime;
    134 const
    135   BackgroundColor = $404040;
    136 begin
    137   DrawStart := Now;
    138   if Assigned(Core.CurrentClient) then
    139   with Core.CurrentClient do begin
    140     View.DestRect := TRect.CreateBounds(TPoint.Create(0, 0), TPoint.Create(PaintBox1.Width, PaintBox1.Height));
    141     if csOpaque in PaintBox1.ControlStyle then begin
    142       TempBitmap.SetSize(PaintBox1.Width, PaintBox1.Height);
    143       TempBitmap.Canvas.Brush.Color := BackGroundColor; //clBackground; //PaintBox1.GetColorResolvingParent;
    144       TempBitmap.Canvas.FillRect(0, 0, PaintBox1.Width, PaintBox1.Height);
    145       if Assigned(ControlPlayer) then ControlPlayer.Paint(TempBitmap.Canvas, View)
    146         else Core.Game.Map.Paint(TempBitmap.Canvas, View);
    147       PaintBox1.Canvas.Draw(0, 0, TempBitmap);
    148     end else begin
    149       {$ifdef WINDOWS}
    150       PaintBox1.Canvas.Brush.Color := BackgroundColor; //clBackground; //PaintBox1.GetColorResolvingParent;
    151       PaintBox1.Canvas.FillRect(0, 0, PaintBox1.Width, PaintBox1.Height);
    152       {$endif}
    153       if Assigned(ControlPlayer) then ControlPlayer.Paint(PaintBox1.Canvas, View)
    154         else Core.Game.Map.Paint(PaintBox1.Canvas, View);
    155     end;
    156   end;
    157   DrawDuration := (9 * DrawDuration + (Now - DrawStart)) / 10;
    158 end;
    159 
    16095procedure TFormMain.EraseBackground(DC: HDC);
    16196begin
    16297  // Do nothing, all background space covered by controls
    163 end;
    164 
    165 procedure TFormMain.PaintBox1Resize(Sender: TObject);
    166 begin
    167   if Assigned(Core.CurrentClient) then
    168   with Core.CurrentClient do
    169     View.DestRect := TRect.CreateBounds(TPoint.Create(0, 0), TPoint.Create(PaintBox1.Width, PaintBox1.Height));
    170   Redraw;
    17198end;
    17299
    … …  
    175102  NewCaption: string;
    176103begin
    177   if RedrawPending and not Drawing then begin
    178     Drawing := True;
    179     if not Core.DevelMode then RedrawPending := False;
    180     TimerPeriod := (9 * TimerPeriod + (Now - LastTimerTime)) / 10;
    181     LastTimerTime := Now;
    182     PaintBox1.Repaint;
    183     StatusBar1.Panels[1].Text := IntToStr(Trunc(DrawDuration / OneMillisecond)) + ' / ' +
    184       IntToStr(Trunc(TimerPeriod / OneMillisecond)) + ' ms' +
    185       ' ' + IntToStr(Core.Game.Map.CellLinks.Count);
    186     NewCaption := 'xTactics';
    187     if Assigned(Core.Game.CurrentPlayer) then
    188       NewCaption := Core.Game.CurrentPlayer.Name + ' - ' + STurn + ' ' + IntToStr(Core.Game.TurnCounter) + ' - ' + NewCaption;
    189     Caption := NewCaption;
    190     Drawing := False;
    191   end;
     104  NewCaption := 'xTactics';
     105  if Assigned(Core.Game.CurrentPlayer) then
     106    NewCaption := Core.Game.CurrentPlayer.Name + ' - ' + STurn + ' ' + IntToStr(Core.Game.TurnCounter) + ' - ' + NewCaption;
     107  Caption := NewCaption;
    192108end;
    193109
    … …  
    197113    AToolBarBigIcons.Checked := GetValue(DOMString(Path + '/LargeIcons'), False);
    198114    AToolBarVisible.Checked := GetValue(DOMString(Path + '/ToolBarVisible'), True);
    199     AStatusBarVisible.Checked := GetValue(DOMString(Path + '/StatusBarVisible'), False);
    200115  end;
    201116end;
    … …  
    206121    SetValue(DOMString(Path + '/LargeIcons'), AToolBarBigIcons.Checked);
    207122    SetValue(DOMString(Path + '/ToolBarVisible'), AToolBarVisible.Checked);
    208     SetValue(DOMString(Path + '/StatusBarVisible'), AStatusBarVisible.Checked);
    209123  end;
    210124end;
    … …  
    226140  end;
    227141  ToolBar1.Visible := AToolBarVisible.Checked;
    228   StatusBar1.Visible := AStatusBarVisible.Checked;
    229 end;
    230 
    231 procedure TFormMain.Redraw;
    232 begin
    233   RedrawPending := True;
    234142end;
    235143
    236144procedure TFormMain.FormCreate(Sender: TObject);
    237145begin
    238   {$IFDEF Linux}
    239   //PaintBox1.ControlStyle := PaintBox1.ControlStyle + [csOpaque];
    240   {$ENDIF}
    241   //DoubleBuffered := True;
    242   TempBitmap := TBitmap.Create;
    243   TimerPeriod := 0;
    244   LastTimerTime := Now;
    245 end;
    246 
    247 procedure TFormMain.AZoomAllExecute(Sender: TObject);
    248 var
    249   Factor: TPointF;
    250   MapRect: TRect;
    251   NewZoom: Single;
    252 begin
    253   with Core, Game, CurrentClient, View do begin
    254     MapRect := Map.CalculatePixelRect;
    255     Factor := TPointF.Create(DestRect.Size.X / MapRect.Size.X,
    256       DestRect.Size.Y / MapRect.Size.Y);
    257     if Factor.X < Factor.Y then NewZoom := Factor.X
    258       else NewZoom := Factor.Y;
    259     if NewZoom = 0 then NewZoom := 1;
    260     Zoom := NewZoom;
    261     CenterMap;
    262   end;
    263   Redraw;
     146  FormClient := TFormClient.Create(nil);
     147  FormClient.ManualDock(PanelMain, nil, alClient);
     148  FormClient.Align := alClient;
     149  FormClient.Show;
    264150end;
    265151
    … …  
    270156end;
    271157
    272 procedure TFormMain.AStatusBarVisibleExecute(Sender: TObject);
    273 begin
    274   AStatusBarVisible.Checked := not AStatusBarVisible.Checked;
    275   ReloadView;
    276 end;
    277 
    278158procedure TFormMain.AToolBarVisibleExecute(Sender: TObject);
    279159begin
    280160  AToolBarVisible.Checked := not AToolBarVisible.Checked;
    281161  ReloadView;
    282 end;
    283 
    284 procedure TFormMain.AZoomInExecute(Sender: TObject);
    285 begin
    286   with Core.CurrentClient do begin
    287     View.Zoom := View.Zoom * ZoomFactor;
    288   end;
    289   Redraw;
    290 end;
    291 
    292 procedure TFormMain.AZoomOutExecute(Sender: TObject);
    293 //var
    294 //  D: TPoint;
    295 begin
    296   with Core.CurrentClient do begin
    297     //D := Point(Trunc(MousePos.X - View.Left / ViewZoom),
    298     //  Trunc(MousePos.Y - View.Top / ViewZoom));
    299     View.Zoom := View.Zoom / ZoomFactor;
    300     //View := Bounds(Trunc((D.X - MousePos.X) * ViewZoom),
    301     //  Trunc((D.Y - MousePos.Y) * ViewZoom),
    302     //  View.Right - View.Left,
    303     //  View.Bottom - View.Top);
    304   end;
    305   Redraw;
    306162end;
    307163
    … …  
    316172procedure TFormMain.FormDestroy(Sender: TObject);
    317173begin
    318   TempBitmap.Free;
    319 end;
    320 
    321 procedure TFormMain.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState
    322   );
    323 begin
    324   if (Key = 27) or (Key = 17) then
    325   if Assigned(Core.Game.CurrentPlayer) then begin
    326     Core.CurrentClient.View.SelectedCell := nil;
    327     Redraw;
    328   end;
     174  FormClient.Free;
    329175end;
    330176
    … …  
    335181  Core.PersistentForm.Load(Self, wsMaximized);
    336182  ReloadView;
    337   Redraw;
    338 end;
    339 
    340 procedure TFormMain.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
    341   Shift: TShiftState; X, Y: Integer);
    342 begin
    343   if Button = mbLeft then begin
    344     if Assigned(Core.CurrentClient) then begin
    345       StartMousePoint := TPoint.Create(X, Y);
    346       StartViewPoint := Core.CurrentClient.View.SourceRect.P1;
    347       MoveActive := True;
    348     end;
    349   end;
    350 end;
    351 
    352 procedure TFormMain.PaintBox1MouseLeave(Sender: TObject);
    353 begin
    354   MoveActive := False;
    355 end;
    356 
    357 procedure TFormMain.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
    358   Y: Integer);
    359 var
    360   Cell: TCell;
    361   OldCell: TCell;
    362   CellPos: TPoint;
    363 begin
    364   if Assigned(Core.CurrentClient) then begin
    365     if MoveActive then
    366     if (Abs(StartMousePoint.X - X) > Trunc(Screen.PixelsPerInch * MouseMinDiff)) or
    367     (Abs(StartMousePoint.Y - Y) > Trunc(Screen.PixelsPerInch * MouseMinDiff)) then
    368     with Core.Game.CurrentPlayer, Core.CurrentClient do begin
    369       View.SourceRect := TRect.CreateBounds(TPoint.Create(Trunc(StartViewPoint.X + (StartMousePoint.X - X) / View.Zoom),
    370         Trunc(StartViewPoint.Y + (StartMousePoint.Y - Y) / View.Zoom)),
    371         View.SourceRect.Size);
    372       Redraw;
    373     end;
    374     Cell := nil;
    375     OldCell := Core.CurrentClient.View.FocusedCell;
    376     with Core.Game do
    377       Cell := Map.PosToCell(Core.CurrentClient.View.CanvasToCellPos(TPoint.Create(X, Y)), Core.CurrentClient.View );
    378     if Assigned(Cell) then begin
    379       Core.CurrentClient.View.FocusedCell := Cell;
    380       StatusBar1.Panels[0].Text := '[' + IntToStr(Cell.PosPx.X) + ', ' + IntToStr(Cell.PosPx.Y) +
    381         '] (' + IntToStr(Cell.MovesFrom.Count) + ', ' + IntToStr(Cell.MovesTo.Count) + ')';
    382     end else begin
    383       Core.CurrentClient.View.FocusedCell := nil;
    384       StatusBar1.Panels[0].Text := '';
    385     end;
    386     CellPos := Core.CurrentClient.View.CanvasToCellPos(TPoint.Create(X, Y));
    387     StatusBar1.Panels[2].Text := 'CellPos: ' + IntToStr(CellPos.X) + ', ' + IntToStr(CellPos.Y);
    388     if Cell <> OldCell then Redraw;
    389   end else StatusBar1.Panels[0].Text := '';
    390 end;
    391 
    392 procedure TFormMain.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
    393   Shift: TShiftState; X, Y: Integer);
    394 begin
    395   if (Abs(StartMousePoint.X - X) < Trunc(Screen.PixelsPerInch * MouseMinDiff)) and
    396   (Abs(StartMousePoint.Y - Y) < Trunc(Screen.PixelsPerInch * MouseMinDiff)) then begin
    397     if Core.Game.Running and (Core.Game.CurrentPlayer.Mode = pmHuman) then begin
    398       Core.CurrentClient.View.SelectCell(TPoint.Create(X, Y), Core.Game.CurrentPlayer, Shift);
    399       Redraw;
    400     end;
    401   end;
    402   MoveActive := False;
    403 end;
    404 
    405 procedure TFormMain.PaintBox1MouseWheelDown(Sender: TObject;
    406   Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
    407 begin
    408   AZoomOut.Execute;
    409 end;
    410 
    411 procedure TFormMain.PaintBox1MouseWheelUp(Sender: TObject; Shift: TShiftState;
    412   MousePos: TPoint; var Handled: Boolean);
    413 begin
    414   AZoomIn.Execute;
    415183end;
    416184
Note: See TracChangeset for help on using the changeset viewer.