Changeset 180


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.
Location:
trunk
Files:
4 added
10 edited

Legend:

Unmodified
Added
Removed

  • trunk/Forms/UFormChat.pas

    r179 r180  
    4747    TextMessage.Text := EditMessage.Text;
    4848    Client.Send(cmdTextMessage, @TextMessage, nil);
     49    MemoChat.Lines.Add(Client.Name + ': ' + EditMessage.Text);
     50    EditMessage.Text := '';
    4951  end;
    50   MemoChat.Lines.Add(EditMessage.Text);
    51   EditMessage.Text := '';
    5252end;
    5353

  • trunk/Forms/UFormMain.lfm

    r170 r180  
    11object FormMain: TFormMain
    2   Left = 577
     2  Left = 447
    33  Height = 621
    4   Top = 309
     4  Top = 303
    55  Width = 775
    66  Caption = 'xTactics'
    77  ClientHeight = 596
    88  ClientWidth = 775
     9  DesignTimePPI = 120
    910  Menu = MainMenu1
    1011  OnClose = FormClose
    1112  OnCreate = FormCreate
    1213  OnDestroy = FormDestroy
    13   OnKeyUp = FormKeyUp
    1414  OnShow = FormShow
    15   LCLVersion = '1.6.4.0'
     15  LCLVersion = '1.8.0.6'
    1616  WindowState = wsMaximized
    17   object StatusBar1: TStatusBar
    18     Left = 0
    19     Height = 28
    20     Top = 568
    21     Width = 775
    22     Panels = <   
    23       item
    24         Width = 200
    25       end   
    26       item
    27         Width = 150
    28       end   
    29       item
    30         Width = 100
    31       end>
    32     SimplePanel = False
    33   end
    3417  object ToolBar1: TToolBar
    3518    Left = 0
    36     Height = 568
     19    Height = 40
    3720    Top = 0
    38     Width = 32
    39     Align = alLeft
     21    Width = 775
    4022    ButtonHeight = 32
    4123    ButtonWidth = 32
    … …  
    4426    PopupMenu = PopupMenuToolbar
    4527    ShowHint = True
    46     TabOrder = 1
     28    TabOrder = 0
    4729    object ToolButton1: TToolButton
    4830      Left = 1
    … …  
    5032      Action = Core.AGameNew
    5133    end
     34    object ToolButton3: TToolButton
     35      Left = 33
     36      Top = 2
     37      Action = Core.AGameEnd
     38    end
     39    object ToolButton4: TToolButton
     40      Left = 65
     41      Top = 2
     42      Action = Core.AGameRestart
     43    end
     44    object ToolButton5: TToolButton
     45      Left = 171
     46      Top = 2
     47      Action = Core.ASettings
     48    end
     49    object ToolButton9: TToolButton
     50      Left = 166
     51      Height = 32
     52      Top = 2
     53      Style = tbsDivider
     54    end
     55    object ToolButton11: TToolButton
     56      Left = 102
     57      Top = 2
     58      Action = Core.AGameLoad
     59    end
     60    object ToolButton12: TToolButton
     61      Left = 134
     62      Top = 2
     63      Action = Core.AGameSave
     64    end
     65    object ToolButton13: TToolButton
     66      Left = 203
     67      Top = 2
     68      Action = Core.AExit
     69    end
    5270    object ToolButton2: TToolButton
    53       Left = 1
    54       Top = 34
    55       Action = Core.AGameEndTurn
    56     end
    57     object ToolButton3: TToolButton
    58       Left = 1
    59       Top = 66
    60       Action = Core.AGameEnd
    61     end
    62     object ToolButton4: TToolButton
    63       Left = 1
    64       Top = 98
    65       Action = Core.AGameRestart
    66     end
    67     object ToolButton5: TToolButton
    68       Left = 1
    69       Top = 130
    70       Action = Core.ASettings
    71     end
    72     object ToolButton6: TToolButton
    73       Left = 1
    74       Top = 194
    75       Action = AZoomIn
    76     end
    77     object ToolButton7: TToolButton
    78       Left = 1
    79       Top = 226
    80       Action = AZoomOut
    81     end
    82     object ToolButton8: TToolButton
    83       Left = 1
    84       Top = 258
    85       Action = AZoomAll
    86     end
    87     object ToolButton9: TToolButton
    88       Left = 1
     71      Left = 97
    8972      Height = 32
    90       Top = 162
    91       Width = 32
    92       Style = tbsSeparator
    93     end
    94     object ToolButton10: TToolButton
    95       Left = 1
    96       Height = 32
    97       Top = 290
    98       Width = 32
    99       Style = tbsSeparator
    100     end
    101     object ToolButton11: TToolButton
    102       Left = 1
    103       Top = 322
    104       Action = Core.AGameLoad
    105     end
    106     object ToolButton12: TToolButton
    107       Left = 1
    108       Top = 354
    109       Action = Core.AGameSave
    110     end
    111     object ToolButton13: TToolButton
    112       Left = 1
    113       Top = 386
    114       Action = Core.AExit
    115     end
    116   end
    117   object PaintBox1: TPaintBox
    118     Left = 32
    119     Height = 568
    120     Top = 0
    121     Width = 743
     73      Top = 2
     74      Caption = 'ToolButton2'
     75      Style = tbsDivider
     76    end
     77  end
     78  object PanelMain: TPanel
     79    Left = 0
     80    Height = 556
     81    Top = 40
     82    Width = 775
    12283    Align = alClient
    123     OnMouseDown = PaintBox1MouseDown
    124     OnMouseLeave = PaintBox1MouseLeave
    125     OnMouseMove = PaintBox1MouseMove
    126     OnMouseUp = PaintBox1MouseUp
    127     OnMouseWheelDown = PaintBox1MouseWheelDown
    128     OnMouseWheelUp = PaintBox1MouseWheelUp
    129     OnPaint = PaintBox1Paint
    130     OnResize = PaintBox1Resize
     84    BevelOuter = bvNone
     85    TabOrder = 1
    13186  end
    13287  object MainMenu1: TMainMenu
    … …  
    167122      Caption = 'View'
    168123      object MenuItem11: TMenuItem
    169         Action = AZoomAll
     124        Caption = 'Zoom all'
     125        ImageIndex = 7
     126        ShortCut = 16449
    170127      end
    171128      object MenuItem12: TMenuItem
    172         Action = AZoomIn
     129        Caption = 'Zoom in'
     130        ImageIndex = 8
     131        ShortCut = 16491
    173132      end
    174133      object MenuItem13: TMenuItem
    175         Action = AZoomOut
     134        Caption = 'Zoom out'
     135        ImageIndex = 9
     136        ShortCut = 16493
    176137      end
    177138      object MenuItem19: TMenuItem
    … …  
    185146      end
    186147      object MenuItem22: TMenuItem
    187         Action = AStatusBarVisible
     148        Caption = 'Statusbar visible'
     149      end
     150      object MenuItem26: TMenuItem
     151        Caption = '-'
     152      end
     153      object MenuItem27: TMenuItem
     154        Action = Core.ANewSpectatorClient
    188155      end
    189156    end
    … …  
    220187    left = 280
    221188    top = 152
    222     object AZoomIn: TAction
    223       Caption = 'Zoom in'
    224       ImageIndex = 8
    225       OnExecute = AZoomInExecute
    226       ShortCut = 16491
    227     end
    228     object AZoomOut: TAction
    229       Caption = 'Zoom out'
    230       ImageIndex = 9
    231       OnExecute = AZoomOutExecute
    232       ShortCut = 16493
    233     end
    234     object AZoomAll: TAction
    235       Caption = 'Zoom all'
    236       ImageIndex = 7
    237       OnExecute = AZoomAllExecute
    238       ShortCut = 16449
    239     end
    240189    object AToolBarBigIcons: TAction
    241190      Caption = 'Toolbar big icons'
    … …  
    245194      Caption = 'Toolbar visible'
    246195      OnExecute = AToolBarVisibleExecute
    247     end
    248     object AStatusBarVisible: TAction
    249       Caption = 'Statusbar visible'
    250       OnExecute = AStatusBarVisibleExecute
    251196    end
    252197  end

  • 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

  • trunk/Languages/xtactics.cs.po

    r179 r180  
    7676msgstr "Nápověda"
    7777
     78#: tcore.anewspectatorclient.caption
     79msgid "New spectator client"
     80msgstr ""
     81
    7882#: tcore.asettings.caption
    7983msgctxt "tcore.asettings.caption"
    … …  
    144148msgstr "Pokec:"
    145149
     150#: tformclient.astatusbarvisible.caption
     151#, fuzzy
     152msgctxt "tformclient.astatusbarvisible.caption"
     153msgid "Statusbar visible"
     154msgstr "Viditelná stavová lišta"
     155
     156#: tformclient.atoolbarbigicons.caption
     157#, fuzzy
     158msgctxt "tformclient.atoolbarbigicons.caption"
     159msgid "Toolbar big icons"
     160msgstr "Velké ikony panelu"
     161
     162#: tformclient.atoolbarvisible.caption
     163#, fuzzy
     164msgctxt "tformclient.atoolbarvisible.caption"
     165msgid "Toolbar visible"
     166msgstr "Viditelný nástrojový panel"
     167
     168#: tformclient.azoomall.caption
     169#, fuzzy
     170msgctxt "tformclient.azoomall.caption"
     171msgid "Zoom all"
     172msgstr "Zobrazit vše"
     173
     174#: tformclient.azoomin.caption
     175#, fuzzy
     176msgctxt "tformclient.azoomin.caption"
     177msgid "Zoom in"
     178msgstr "Přiblížit"
     179
     180#: tformclient.azoomout.caption
     181#, fuzzy
     182msgctxt "tformclient.azoomout.caption"
     183msgid "Zoom out"
     184msgstr "Oddálit"
     185
     186#: tformclient.caption
     187msgid "Client"
     188msgstr ""
     189
    146190#: tformhelp.caption
    147191msgctxt "tformhelp.caption"
    … …  
    149193msgstr "Nápověda"
    150194
    151 #: tformmain.astatusbarvisible.caption
    152 msgid "Statusbar visible"
    153 msgstr "Viditelná stavová lišta"
    154 
    155195#: tformmain.atoolbarbigicons.caption
     196msgctxt "tformmain.atoolbarbigicons.caption"
    156197msgid "Toolbar big icons"
    157198msgstr "Velké ikony panelu"
    158199
    159200#: tformmain.atoolbarvisible.caption
     201msgctxt "tformmain.atoolbarvisible.caption"
    160202msgid "Toolbar visible"
    161203msgstr "Viditelný nástrojový panel"
    162 
    163 #: tformmain.azoomall.caption
    164 msgid "Zoom all"
    165 msgstr "Zobrazit vše"
    166 
    167 #: tformmain.azoomin.caption
    168 msgid "Zoom in"
    169 msgstr "Přiblížit"
    170 
    171 #: tformmain.azoomout.caption
    172 msgid "Zoom out"
    173 msgstr "Oddálit"
    174204
    175205#: tformmain.caption
    … …  
    179209
    180210#: tformmain.menuitem1.caption
     211msgctxt "tformmain.menuitem1.caption"
    181212msgid "Game"
    182213msgstr "Hra"
    183214
    184215#: tformmain.menuitem10.caption
     216msgctxt "tformmain.menuitem10.caption"
    185217msgid "View"
    186218msgstr "Zobrazení"
     219
     220#: tformmain.menuitem11.caption
     221#, fuzzy
     222msgctxt "tformmain.menuitem11.caption"
     223msgid "Zoom all"
     224msgstr "Zobrazit vše"
     225
     226#: tformmain.menuitem12.caption
     227#, fuzzy
     228msgctxt "tformmain.menuitem12.caption"
     229msgid "Zoom in"
     230msgstr "Přiblížit"
     231
     232#: tformmain.menuitem13.caption
     233#, fuzzy
     234msgctxt "tformmain.menuitem13.caption"
     235msgid "Zoom out"
     236msgstr "Oddálit"
    187237
    188238#: tformmain.menuitem16.caption
    … …  
    191241msgstr "Nápověda"
    192242
    193 #: tformmain.menuitem19.caption
    194 msgctxt "tformmain.menuitem19.caption"
    195 msgid "-"
    196 msgstr "-"
    197 
    198 #: tformmain.menuitem5.caption
    199 msgctxt "tformmain.menuitem5.caption"
    200 msgid "-"
    201 msgstr "-"
     243#: tformmain.menuitem22.caption
     244#, fuzzy
     245msgctxt "tformmain.menuitem22.caption"
     246msgid "Statusbar visible"
     247msgstr "Viditelná stavová lišta"
    202248
    203249#: tformmain.menuitem8.caption
    … …  
    208254
    209255#: tformmain.menuitemloadrecent.caption
     256msgctxt "tformmain.menuitemloadrecent.caption"
    210257msgid "Load recent"
    211258msgstr "Načíst nedávné"
     259
     260#: tformmain.toolbutton2.caption
     261msgid "ToolButton2"
     262msgstr ""
    212263
    213264#: tformmove.buttoncancel.caption
    … …  
    615666msgid "Occupied cells"
    616667msgstr "Obsazené buňky"
     668
     669#: uformclient.sturn
     670#, fuzzy
     671msgctxt "uformclient.sturn"
     672msgid "turn"
     673msgstr "tah"
    617674
    618675#: uformhelp.scontent
    … …  
    633690
    634691#: uformmain.sturn
     692msgctxt "uformmain.sturn"
    635693msgid "turn"
    636694msgstr "tah"
    … …  
    762820msgstr "Hráč"
    763821
     822#: ugame.sspectator
     823msgid "Spectator"
     824msgstr ""
     825
    764826#: ugame.sunfinishedbattle
    765827msgid "Unfinished battle"
    … …  
    777839msgid "Zero zoom not allowed"
    778840msgstr "Nulové přiblížení není povoleno"
     841

  • trunk/Languages/xtactics.po

    r179 r180  
    6666msgstr ""
    6767
     68#: tcore.anewspectatorclient.caption
     69msgid "New spectator client"
     70msgstr ""
     71
    6872#: tcore.asettings.caption
    6973msgctxt "tcore.asettings.caption"
    … …  
    134138msgstr ""
    135139
     140#: tformclient.astatusbarvisible.caption
     141msgctxt "tformclient.astatusbarvisible.caption"
     142msgid "Statusbar visible"
     143msgstr ""
     144
     145#: tformclient.atoolbarbigicons.caption
     146msgctxt "tformclient.atoolbarbigicons.caption"
     147msgid "Toolbar big icons"
     148msgstr ""
     149
     150#: tformclient.atoolbarvisible.caption
     151msgctxt "tformclient.atoolbarvisible.caption"
     152msgid "Toolbar visible"
     153msgstr ""
     154
     155#: tformclient.azoomall.caption
     156msgctxt "tformclient.azoomall.caption"
     157msgid "Zoom all"
     158msgstr ""
     159
     160#: tformclient.azoomin.caption
     161msgctxt "tformclient.azoomin.caption"
     162msgid "Zoom in"
     163msgstr ""
     164
     165#: tformclient.azoomout.caption
     166msgctxt "tformclient.azoomout.caption"
     167msgid "Zoom out"
     168msgstr ""
     169
     170#: tformclient.caption
     171msgid "Client"
     172msgstr ""
     173
    136174#: tformhelp.caption
    137175msgctxt "TFORMHELP.CAPTION"
    … …  
    139177msgstr ""
    140178
    141 #: tformmain.astatusbarvisible.caption
    142 msgid "Statusbar visible"
    143 msgstr ""
    144 
    145179#: tformmain.atoolbarbigicons.caption
     180msgctxt "tformmain.atoolbarbigicons.caption"
    146181msgid "Toolbar big icons"
    147182msgstr ""
    148183
    149184#: tformmain.atoolbarvisible.caption
     185msgctxt "tformmain.atoolbarvisible.caption"
    150186msgid "Toolbar visible"
    151 msgstr ""
    152 
    153 #: tformmain.azoomall.caption
    154 msgid "Zoom all"
    155 msgstr ""
    156 
    157 #: tformmain.azoomin.caption
    158 msgid "Zoom in"
    159 msgstr ""
    160 
    161 #: tformmain.azoomout.caption
    162 msgid "Zoom out"
    163187msgstr ""
    164188
    … …  
    169193
    170194#: tformmain.menuitem1.caption
     195msgctxt "tformmain.menuitem1.caption"
    171196msgid "Game"
    172197msgstr ""
    173198
    174199#: tformmain.menuitem10.caption
     200msgctxt "tformmain.menuitem10.caption"
    175201msgid "View"
     202msgstr ""
     203
     204#: tformmain.menuitem11.caption
     205msgctxt "tformmain.menuitem11.caption"
     206msgid "Zoom all"
     207msgstr ""
     208
     209#: tformmain.menuitem12.caption
     210msgctxt "tformmain.menuitem12.caption"
     211msgid "Zoom in"
     212msgstr ""
     213
     214#: tformmain.menuitem13.caption
     215msgctxt "tformmain.menuitem13.caption"
     216msgid "Zoom out"
    176217msgstr ""
    177218
    … …  
    181222msgstr ""
    182223
    183 #: tformmain.menuitem19.caption
    184 msgctxt "TFORMMAIN.MENUITEM19.CAPTION"
    185 msgid "-"
    186 msgstr ""
    187 
    188 #: tformmain.menuitem5.caption
    189 msgctxt "tformmain.menuitem5.caption"
    190 msgid "-"
     224#: tformmain.menuitem22.caption
     225msgctxt "tformmain.menuitem22.caption"
     226msgid "Statusbar visible"
    191227msgstr ""
    192228
    … …  
    197233
    198234#: tformmain.menuitemloadrecent.caption
     235msgctxt "tformmain.menuitemloadrecent.caption"
    199236msgid "Load recent"
     237msgstr ""
     238
     239#: tformmain.toolbutton2.caption
     240msgid "ToolButton2"
    200241msgstr ""
    201242
    … …  
    599640msgctxt "uformcharts.soccupiedcells"
    600641msgid "Occupied cells"
     642msgstr ""
     643
     644#: uformclient.sturn
     645msgctxt "uformclient.sturn"
     646msgid "turn"
    601647msgstr ""
    602648
    … …  
    612658
    613659#: uformmain.sturn
     660msgctxt "uformmain.sturn"
    614661msgid "turn"
    615662msgstr ""
    … …  
    741788msgstr ""
    742789
     790#: ugame.sspectator
     791msgid "Spectator"
     792msgstr ""
     793
    743794#: ugame.sunfinishedbattle
    744795msgid "Unfinished battle"

  • trunk/UCore.lfm

    r179 r180  
    8282      Caption = 'Unit moves'
    8383      OnExecute = AShowUnitMovesExecute
     84    end
     85    object ANewSpectatorClient: TAction
     86      Caption = 'New spectator client'
     87      OnExecute = ANewSpectatorClientExecute
    8488    end
    8589  end

  • trunk/UCore.pas

    r179 r180  
    88  Classes, SysUtils, XMLConf, FileUtil, ActnList, Controls, Dialogs, Forms,
    99  UGame, UApplicationInfo, UPersistentForm, UScaleDPI, UCoolTranslator,
    10   URegistry, ULastOpenedList, Registry, Menus, UGeometry;
     10  URegistry, ULastOpenedList, Registry, Menus, UGeometry, Contnrs, UFormClient;
    1111
    1212type
    … …  
    1616  TCore = class(TDataModule)
    1717    AAbout: TAction;
     18    ANewSpectatorClient: TAction;
    1819    AShowUnitMoves: TAction;
    1920    AShowCharts: TAction;
    … …  
    4748    procedure AGameSaveExecute(Sender: TObject);
    4849    procedure AHelpExecute(Sender: TObject);
     50    procedure ANewSpectatorClientExecute(Sender: TObject);
    4951    procedure ASettingsExecute(Sender: TObject);
    5052    procedure AShowChartsExecute(Sender: TObject);
    … …  
    6971    procedure GameNewTurnExecute(Sender: TObject);
    7072    procedure AutoSave;
    71     function GetPlayer: TPlayer;
    7273    procedure LoadConfig;
    7374    procedure SaveConfig;
    … …  
    7677    procedure SelectClient;
    7778    procedure LoadGame(FileName: string);
     79    procedure RedrawClients;
    7880  public
    7981    Game: TGame;
    … …  
    8385    AnimationSpeed: Integer;
    8486    AutoSaveEnabled: Boolean;
    85     CurrentClient: TClient;
     87    FormClients: TObjectList; // TFormClient
     88    //CurrentClient: TClient;
     89    LocalClients: TObjectList; // TClient
    8690    procedure UpdateActions;
    8791    procedure Init;
    … …  
    147151procedure TCore.DoOnWin(Player: TPlayer);
    148152begin
    149   FormMain.Redraw;
     153  RedrawClients;
    150154  ShowMessage(Format(SPlayerWins, [Player.Name]));
    151155end;
    … …  
    174178  Game.SaveToFile(GetAppConfigDir(False) + 'AutoSave.xtg');
    175179  Game.FileName := OldFileName;
    176 end;
    177 
    178 function TCore.GetPlayer: TPlayer;
    179 begin
    180   Result := Game.CurrentPlayer;
    181180end;
    182181
    … …  
    246245begin
    247246  FirstHuman := Game.Players.GetFirstHuman;
    248   if Assigned(FirstHuman) then CurrentClient := FirstHuman.Client
    249     else CurrentClient := TClient(Server.Clients.First);
     247  if Assigned(FirstHuman) then FormClient.Client := FirstHuman.Client
     248    else FormClient.Client := TClient(Server.Clients.First);
    250249end;
    251250
    … …  
    276275  if MessageDlg(SEndGame, SEndGameQuestion, mtConfirmation, mbYesNo, 0) = mrYes then begin
    277276    Game.Running := False;
    278     FormMain.Redraw;
     277    RedrawClients;
    279278    UpdateActions;
    280279  end;
    … …  
    286285    if Game.CurrentPlayer.Mode = pmComputer then begin
    287286      Game.CurrentPlayer.Computer.Process;
    288       FormMain.Redraw;
     287      RedrawClients;
    289288      Delay(Trunc((100 - AnimationSpeed) / 100 * 2000));
    290289    end;
    291290    Game.NextTurn;
    292     FormMain.Redraw;
     291    RedrawClients;
    293292    Application.ProcessMessages;
    294293    Sleep(1);
    … …  
    299298begin
    300299  Game.NextTurn;
    301   FormMain.Redraw;
     300  RedrawClients;
    302301  ProcessComputerTurns;
    303302  UpdateActions;
    … …  
    354353    FreeAndNil(FormHelp);
    355354  end;
     355end;
     356
     357procedure TCore.ANewSpectatorClientExecute(Sender: TObject);
     358var
     359  Form: TFormClient;
     360begin
     361  Form := TFormClient.Create(nil);
     362  Form.Client := Game.Server.Clients.New(SSpectator);
     363  //Form.Client.Form := Form;
     364  Form.AZoomAll.Execute;
     365  Form.Show;
    356366end;
    357367
    … …  
    401411  XMLConfig1.Filename := GetAppConfigDir(False) + 'Config.xml';
    402412  ForceDirectories(GetAppConfigDir(False));
     413  FormClients := TObjectList.Create;
    403414end;
    404415
    405416procedure TCore.DataModuleDestroy(Sender: TObject);
    406417begin
     418  FreeAndNil(FormClients);
    407419  FreeAndNil(StoredDimension);
    408420  Game.SaveConfig(XMLConfig1, 'Game');
    … …  
    429441  SelectClient;
    430442  LastOpenedList1.AddItem(FileName);
    431   with Core.CurrentClient do
     443  with FormClient.Client do
    432444    View.DestRect := TRect.CreateBounds(TPoint.Create(0, 0),
    433       TPoint.Create(FormMain.PaintBox1.Width, FormMain.PaintBox1.Height));
    434   FormMain.AZoomAll.Execute;
    435   FormMain.Redraw;
     445      TPoint.Create(FormClient.PaintBox1.Width, FormClient.PaintBox1.Height));
     446  FormClient.AZoomAll.Execute;
     447  RedrawClients;
    436448  if FormCharts.Visible then FormCharts.Redraw;
    437449  if FormUnitMoves.Visible then FormUnitMoves.ReloadList;
     450end;
     451
     452procedure TCore.RedrawClients;
     453var
     454  Form: TFormClient;
     455begin
     456  for Form in FormClients do
     457    Form.Redraw;
     458  FormClient.Redraw;
    438459end;
    439460
    … …  
    446467  if Game.Players.GetAliveCount = Game.Players.Count then Game.Running := True
    447468    else ShowMessage(Format(SPlayersNotInitialized, [Game.Players.Count, Game.Players.GetAliveCount]));
    448   FormMain.Redraw;
     469  RedrawClients;
    449470  if FormCharts.Visible then FormCharts.Redraw;
    450471  if FormUnitMoves.Visible then FormUnitMoves.ReloadList;
    … …  
    455476procedure TCore.DoPlayerChange(Sender: TObject);
    456477begin
    457   if Assigned(Game.CurrentPlayer) and Assigned(Game.CurrentPlayer.Client) then
    458     CurrentClient := Game.CurrentPlayer.Client;
     478  if Assigned(Game.CurrentPlayer) and Assigned(Game.CurrentPlayer.Client) then begin
     479    FormClient.Client := Game.CurrentPlayer.Client;
     480  end;
    459481  if FormCharts.Visible then FormCharts.Redraw;
    460482  if FormUnitMoves.Visible then FormUnitMoves.ReloadList;

  • trunk/UGame.pas

    r179 r180  
    66
    77uses
    8   Classes, SysUtils, ExtCtrls, Graphics, XMLConf, XMLRead, XMLWrite,
     8  Classes, SysUtils, ExtCtrls, Graphics, XMLConf, XMLRead, XMLWrite, Forms,
    99  DOM, Math, LazFileUtils, UXMLUtils, Dialogs, Types, LCLType, LCLIntf, fgl,
    1010  UGeometry, UGameSocket;
    … …  
    421421    FGame: TGame;
    422422    FControlPlayer: TPlayer;
     423    FOnChange: TNotifyEvent;
    423424    FOnReceive: TReceiveEvent;
    424425    procedure SetControlPlayer(AValue: TPlayer);
    425426    procedure SetGame(AValue: TGame);
     427    procedure DoChange;
    426428  public
     429    Form: TForm;
    427430    Name: string;
    428431    View: TView;
    … …  
    434437    property Game: TGame read FGame write SetGame;
    435438    property OnReceive: TReceiveEvent read FOnReceive write FOnReceive;
     439    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    436440  end;
    437441
    … …  
    440444  TClients = class(TFPGObjectList<TClient>)
    441445    Game: TGame;
    442     procedure New(Name: string);
     446    function New(Name: string): TClient;
    443447    constructor Create(FreeObjects: Boolean = True);
    444448  end;
    … …  
    534538    procedure SetGame(AValue: TGame);
    535539    procedure SetServerMode(AValue: TServerMode);
     540    procedure DoChange;
    536541  public
    537542    Clients: TClients;
    … …  
    565570resourcestring
    566571  SPlayer = 'Player';
     572  SSpectator = 'Spectator';
    567573
    568574
    … …  
    650656{ TClients }
    651657
    652 procedure TClients.New(Name: string);
    653 var
    654   NewClient: TClient;
    655 begin
    656   NewClient := TClient.Create;
    657   NewClient.Game := Game;
    658   NewClient.Name := Name;
    659   Add(NewClient);
     658function TClients.New(Name: string): TClient;
     659begin
     660  Result := TClient.Create;
     661  Result.Game := Game;
     662  Result.Name := Name;
     663  Add(Result);
    660664end;
    661665
    … …  
    673677  FGame := AValue;
    674678  View.Game := AValue;
     679end;
     680
     681procedure TClient.DoChange;
     682begin
     683  if Assigned(FOnChange) then
     684    FOnChange(Self);
    675685end;
    676686
    … …  
    32013211end;
    32023212
     3213procedure TServer.DoChange;
     3214var
     3215  Client: TClient;
     3216begin
     3217  for Client in Clients do
     3218    Client.DoChange;
     3219end;
     3220
    32033221procedure TServer.LoadConfig(Config: TXmlConfig; Path: string);
    32043222begin
    … …  
    32293247begin
    32303248  Clients.Clear;
    3231   Clients.New('Spectator');
     3249  Clients.New(SSpectator);
    32323250
    32333251  for Player in Game.Players do
    32343252  with Player do
    32353253  if Mode = pmHuman then begin
    3236     Clients.New(Player.Name);
    3237     Player.Client := TClient(Clients.Last);
     3254    Player.Client := Clients.New(Player.Name);
    32383255  end;
    32393256
    … …  
    35863603  // For computers take view from previous human
    35873604  //if CurrentPlayer.Mode = pmComputer then CurrentPlayer.View.Assign(PrevPlayer.View);
     3605  Server.DoChange;
    35883606end;
    35893607

  • trunk/xtactics.lpi

    r179 r180  
    100100      </Item6>
    101101    </RequiredPackages>
    102     <Units Count="16">
     102    <Units Count="18">
    103103      <Unit0>
    104104        <Filename Value="xtactics.lpr"/>
    … …  
    198198        <IsPartOfProject Value="True"/>
    199199      </Unit15>
     200      <Unit16>
     201        <Filename Value="UServerList.pas"/>
     202        <IsPartOfProject Value="True"/>
     203      </Unit16>
     204      <Unit17>
     205        <Filename Value="Forms/UFormClient.pas"/>
     206        <IsPartOfProject Value="True"/>
     207        <ComponentName Value="FormClient"/>
     208        <HasResources Value="True"/>
     209        <ResourceBaseClass Value="Form"/>
     210      </Unit17>
    200211    </Units>
    201212  </ProjectOptions>

  • trunk/xtactics.lpr

    r179 r180  
    1212  { you can add units after this },
    1313  SysUtils, UFormMain, UFormMove, UFormNew, UFormCharts, UFormUnitMoves,
    14   UFormChat, UGameSocket, UTCP;
     14  UFormChat, UGameSocket, UTCP, UServerList;
    1515
    1616{$R *.res}
Note: See TracChangeset for help on using the changeset viewer.