- Timestamp:
- Feb 8, 2018, 5:32:31 PM (7 years ago)
- Location:
- trunk
- Files:
-
- 4 added
- 10 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Forms/UFormChat.pas
r179 r180 47 47 TextMessage.Text := EditMessage.Text; 48 48 Client.Send(cmdTextMessage, @TextMessage, nil); 49 MemoChat.Lines.Add(Client.Name + ': ' + EditMessage.Text); 50 EditMessage.Text := ''; 49 51 end; 50 MemoChat.Lines.Add(EditMessage.Text);51 EditMessage.Text := '';52 52 end; 53 53 -
trunk/Forms/UFormMain.lfm
r170 r180 1 1 object FormMain: TFormMain 2 Left = 5772 Left = 447 3 3 Height = 621 4 Top = 30 94 Top = 303 5 5 Width = 775 6 6 Caption = 'xTactics' 7 7 ClientHeight = 596 8 8 ClientWidth = 775 9 DesignTimePPI = 120 9 10 Menu = MainMenu1 10 11 OnClose = FormClose 11 12 OnCreate = FormCreate 12 13 OnDestroy = FormDestroy 13 OnKeyUp = FormKeyUp14 14 OnShow = FormShow 15 LCLVersion = '1. 6.4.0'15 LCLVersion = '1.8.0.6' 16 16 WindowState = wsMaximized 17 object StatusBar1: TStatusBar18 Left = 019 Height = 2820 Top = 56821 Width = 77522 Panels = <23 item24 Width = 20025 end26 item27 Width = 15028 end29 item30 Width = 10031 end>32 SimplePanel = False33 end34 17 object ToolBar1: TToolBar 35 18 Left = 0 36 Height = 56819 Height = 40 37 20 Top = 0 38 Width = 32 39 Align = alLeft 21 Width = 775 40 22 ButtonHeight = 32 41 23 ButtonWidth = 32 … … 44 26 PopupMenu = PopupMenuToolbar 45 27 ShowHint = True 46 TabOrder = 128 TabOrder = 0 47 29 object ToolButton1: TToolButton 48 30 Left = 1 … … 50 32 Action = Core.AGameNew 51 33 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 52 70 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 89 72 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 122 83 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 131 86 end 132 87 object MainMenu1: TMainMenu … … 167 122 Caption = 'View' 168 123 object MenuItem11: TMenuItem 169 Action = AZoomAll 124 Caption = 'Zoom all' 125 ImageIndex = 7 126 ShortCut = 16449 170 127 end 171 128 object MenuItem12: TMenuItem 172 Action = AZoomIn 129 Caption = 'Zoom in' 130 ImageIndex = 8 131 ShortCut = 16491 173 132 end 174 133 object MenuItem13: TMenuItem 175 Action = AZoomOut 134 Caption = 'Zoom out' 135 ImageIndex = 9 136 ShortCut = 16493 176 137 end 177 138 object MenuItem19: TMenuItem … … 185 146 end 186 147 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 188 155 end 189 156 end … … 220 187 left = 280 221 188 top = 152 222 object AZoomIn: TAction223 Caption = 'Zoom in'224 ImageIndex = 8225 OnExecute = AZoomInExecute226 ShortCut = 16491227 end228 object AZoomOut: TAction229 Caption = 'Zoom out'230 ImageIndex = 9231 OnExecute = AZoomOutExecute232 ShortCut = 16493233 end234 object AZoomAll: TAction235 Caption = 'Zoom all'236 ImageIndex = 7237 OnExecute = AZoomAllExecute238 ShortCut = 16449239 end240 189 object AToolBarBigIcons: TAction 241 190 Caption = 'Toolbar big icons' … … 245 194 Caption = 'Toolbar visible' 246 195 OnExecute = AToolBarVisibleExecute 247 end248 object AStatusBarVisible: TAction249 Caption = 'Statusbar visible'250 OnExecute = AStatusBarVisibleExecute251 196 end 252 197 end -
trunk/Forms/UFormMain.pas
r171 r180 7 7 uses 8 8 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; 11 10 12 11 const … … 19 18 20 19 TFormMain = class(TForm) 21 AStatusBarVisible: TAction;22 20 AToolBarVisible: TAction; 23 21 AToolBarBigIcons: TAction; 24 AZoomIn: TAction;25 AZoomAll: TAction;26 AZoomOut: TAction;27 22 ActionList1: TActionList; 28 23 MainMenu1: TMainMenu; … … 45 40 MenuItem24: TMenuItem; 46 41 MenuItem25: TMenuItem; 42 MenuItem26: TMenuItem; 43 MenuItem27: TMenuItem; 47 44 MenuItemLoadRecent: TMenuItem; 48 45 MenuItem3: TMenuItem; … … 53 50 MenuItem8: TMenuItem; 54 51 MenuItem9: TMenuItem; 55 Pa intBox1: TPaintBox;52 PanelMain: TPanel; 56 53 PopupMenuToolbar: TPopupMenu; 57 StatusBar1: TStatusBar;58 54 Timer1: TTimer; 59 55 ToolBar1: TToolBar; 60 56 ToolButton1: TToolButton; 61 ToolButton10: TToolButton;62 57 ToolButton11: TToolButton; 63 58 ToolButton12: TToolButton; … … 67 62 ToolButton4: TToolButton; 68 63 ToolButton5: TToolButton; 69 ToolButton6: TToolButton;70 ToolButton7: TToolButton;71 ToolButton8: TToolButton;72 64 ToolButton9: TToolButton; 73 procedure AStatusBarVisibleExecute(Sender: TObject);74 65 procedure AToolBarBigIconsExecute(Sender: TObject); 75 66 procedure AToolBarVisibleExecute(Sender: TObject); 76 procedure AZoomAllExecute(Sender: TObject);77 procedure AZoomInExecute(Sender: TObject);78 procedure AZoomOutExecute(Sender: TObject);79 67 procedure FormShow(Sender: TObject); 80 68 procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); 81 69 procedure FormCreate(Sender: TObject); 82 70 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);96 71 procedure EraseBackground(DC: HDC); override; 97 procedure PaintBox1Resize(Sender: TObject);98 72 procedure Timer1Timer(Sender: TObject); 99 73 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;109 74 public 110 75 procedure LoadConfig(Config: TXmlConfig; Path: string); 111 76 procedure SaveConfig(Config: TXmlConfig; Path: string); 112 77 procedure ReloadView; 113 procedure Redraw;114 78 end; 115 79 … … 120 84 121 85 uses 122 UCore ;86 UCore, UFormClient; 123 87 124 88 resourcestring … … 129 93 { TFormMain } 130 94 131 procedure TFormMain.PaintBox1Paint(Sender: TObject);132 var133 DrawStart: TDateTime;134 const135 BackgroundColor = $404040;136 begin137 DrawStart := Now;138 if Assigned(Core.CurrentClient) then139 with Core.CurrentClient do begin140 View.DestRect := TRect.CreateBounds(TPoint.Create(0, 0), TPoint.Create(PaintBox1.Width, PaintBox1.Height));141 if csOpaque in PaintBox1.ControlStyle then begin142 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 begin149 {$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 160 95 procedure TFormMain.EraseBackground(DC: HDC); 161 96 begin 162 97 // Do nothing, all background space covered by controls 163 end;164 165 procedure TFormMain.PaintBox1Resize(Sender: TObject);166 begin167 if Assigned(Core.CurrentClient) then168 with Core.CurrentClient do169 View.DestRect := TRect.CreateBounds(TPoint.Create(0, 0), TPoint.Create(PaintBox1.Width, PaintBox1.Height));170 Redraw;171 98 end; 172 99 … … 175 102 NewCaption: string; 176 103 begin 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; 192 108 end; 193 109 … … 197 113 AToolBarBigIcons.Checked := GetValue(DOMString(Path + '/LargeIcons'), False); 198 114 AToolBarVisible.Checked := GetValue(DOMString(Path + '/ToolBarVisible'), True); 199 AStatusBarVisible.Checked := GetValue(DOMString(Path + '/StatusBarVisible'), False);200 115 end; 201 116 end; … … 206 121 SetValue(DOMString(Path + '/LargeIcons'), AToolBarBigIcons.Checked); 207 122 SetValue(DOMString(Path + '/ToolBarVisible'), AToolBarVisible.Checked); 208 SetValue(DOMString(Path + '/StatusBarVisible'), AStatusBarVisible.Checked);209 123 end; 210 124 end; … … 226 140 end; 227 141 ToolBar1.Visible := AToolBarVisible.Checked; 228 StatusBar1.Visible := AStatusBarVisible.Checked;229 end;230 231 procedure TFormMain.Redraw;232 begin233 RedrawPending := True;234 142 end; 235 143 236 144 procedure TFormMain.FormCreate(Sender: TObject); 237 145 begin 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; 264 150 end; 265 151 … … 270 156 end; 271 157 272 procedure TFormMain.AStatusBarVisibleExecute(Sender: TObject);273 begin274 AStatusBarVisible.Checked := not AStatusBarVisible.Checked;275 ReloadView;276 end;277 278 158 procedure TFormMain.AToolBarVisibleExecute(Sender: TObject); 279 159 begin 280 160 AToolBarVisible.Checked := not AToolBarVisible.Checked; 281 161 ReloadView; 282 end;283 284 procedure TFormMain.AZoomInExecute(Sender: TObject);285 begin286 with Core.CurrentClient do begin287 View.Zoom := View.Zoom * ZoomFactor;288 end;289 Redraw;290 end;291 292 procedure TFormMain.AZoomOutExecute(Sender: TObject);293 //var294 // D: TPoint;295 begin296 with Core.CurrentClient do begin297 //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;306 162 end; 307 163 … … 316 172 procedure TFormMain.FormDestroy(Sender: TObject); 317 173 begin 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; 329 175 end; 330 176 … … 335 181 Core.PersistentForm.Load(Self, wsMaximized); 336 182 ReloadView; 337 Redraw;338 end;339 340 procedure TFormMain.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;341 Shift: TShiftState; X, Y: Integer);342 begin343 if Button = mbLeft then begin344 if Assigned(Core.CurrentClient) then begin345 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 begin354 MoveActive := False;355 end;356 357 procedure TFormMain.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,358 Y: Integer);359 var360 Cell: TCell;361 OldCell: TCell;362 CellPos: TPoint;363 begin364 if Assigned(Core.CurrentClient) then begin365 if MoveActive then366 if (Abs(StartMousePoint.X - X) > Trunc(Screen.PixelsPerInch * MouseMinDiff)) or367 (Abs(StartMousePoint.Y - Y) > Trunc(Screen.PixelsPerInch * MouseMinDiff)) then368 with Core.Game.CurrentPlayer, Core.CurrentClient do begin369 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 do377 Cell := Map.PosToCell(Core.CurrentClient.View.CanvasToCellPos(TPoint.Create(X, Y)), Core.CurrentClient.View );378 if Assigned(Cell) then begin379 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 begin383 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 begin395 if (Abs(StartMousePoint.X - X) < Trunc(Screen.PixelsPerInch * MouseMinDiff)) and396 (Abs(StartMousePoint.Y - Y) < Trunc(Screen.PixelsPerInch * MouseMinDiff)) then begin397 if Core.Game.Running and (Core.Game.CurrentPlayer.Mode = pmHuman) then begin398 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 begin408 AZoomOut.Execute;409 end;410 411 procedure TFormMain.PaintBox1MouseWheelUp(Sender: TObject; Shift: TShiftState;412 MousePos: TPoint; var Handled: Boolean);413 begin414 AZoomIn.Execute;415 183 end; 416 184 -
trunk/Languages/xtactics.cs.po
r179 r180 76 76 msgstr "Nápověda" 77 77 78 #: tcore.anewspectatorclient.caption 79 msgid "New spectator client" 80 msgstr "" 81 78 82 #: tcore.asettings.caption 79 83 msgctxt "tcore.asettings.caption" … … 144 148 msgstr "Pokec:" 145 149 150 #: tformclient.astatusbarvisible.caption 151 #, fuzzy 152 msgctxt "tformclient.astatusbarvisible.caption" 153 msgid "Statusbar visible" 154 msgstr "Viditelná stavová lišta" 155 156 #: tformclient.atoolbarbigicons.caption 157 #, fuzzy 158 msgctxt "tformclient.atoolbarbigicons.caption" 159 msgid "Toolbar big icons" 160 msgstr "Velké ikony panelu" 161 162 #: tformclient.atoolbarvisible.caption 163 #, fuzzy 164 msgctxt "tformclient.atoolbarvisible.caption" 165 msgid "Toolbar visible" 166 msgstr "Viditelný nástrojový panel" 167 168 #: tformclient.azoomall.caption 169 #, fuzzy 170 msgctxt "tformclient.azoomall.caption" 171 msgid "Zoom all" 172 msgstr "Zobrazit vše" 173 174 #: tformclient.azoomin.caption 175 #, fuzzy 176 msgctxt "tformclient.azoomin.caption" 177 msgid "Zoom in" 178 msgstr "Přiblížit" 179 180 #: tformclient.azoomout.caption 181 #, fuzzy 182 msgctxt "tformclient.azoomout.caption" 183 msgid "Zoom out" 184 msgstr "Oddálit" 185 186 #: tformclient.caption 187 msgid "Client" 188 msgstr "" 189 146 190 #: tformhelp.caption 147 191 msgctxt "tformhelp.caption" … … 149 193 msgstr "Nápověda" 150 194 151 #: tformmain.astatusbarvisible.caption152 msgid "Statusbar visible"153 msgstr "Viditelná stavová lišta"154 155 195 #: tformmain.atoolbarbigicons.caption 196 msgctxt "tformmain.atoolbarbigicons.caption" 156 197 msgid "Toolbar big icons" 157 198 msgstr "Velké ikony panelu" 158 199 159 200 #: tformmain.atoolbarvisible.caption 201 msgctxt "tformmain.atoolbarvisible.caption" 160 202 msgid "Toolbar visible" 161 203 msgstr "Viditelný nástrojový panel" 162 163 #: tformmain.azoomall.caption164 msgid "Zoom all"165 msgstr "Zobrazit vše"166 167 #: tformmain.azoomin.caption168 msgid "Zoom in"169 msgstr "Přiblížit"170 171 #: tformmain.azoomout.caption172 msgid "Zoom out"173 msgstr "Oddálit"174 204 175 205 #: tformmain.caption … … 179 209 180 210 #: tformmain.menuitem1.caption 211 msgctxt "tformmain.menuitem1.caption" 181 212 msgid "Game" 182 213 msgstr "Hra" 183 214 184 215 #: tformmain.menuitem10.caption 216 msgctxt "tformmain.menuitem10.caption" 185 217 msgid "View" 186 218 msgstr "Zobrazení" 219 220 #: tformmain.menuitem11.caption 221 #, fuzzy 222 msgctxt "tformmain.menuitem11.caption" 223 msgid "Zoom all" 224 msgstr "Zobrazit vše" 225 226 #: tformmain.menuitem12.caption 227 #, fuzzy 228 msgctxt "tformmain.menuitem12.caption" 229 msgid "Zoom in" 230 msgstr "Přiblížit" 231 232 #: tformmain.menuitem13.caption 233 #, fuzzy 234 msgctxt "tformmain.menuitem13.caption" 235 msgid "Zoom out" 236 msgstr "Oddálit" 187 237 188 238 #: tformmain.menuitem16.caption … … 191 241 msgstr "Nápověda" 192 242 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 245 msgctxt "tformmain.menuitem22.caption" 246 msgid "Statusbar visible" 247 msgstr "Viditelná stavová lišta" 202 248 203 249 #: tformmain.menuitem8.caption … … 208 254 209 255 #: tformmain.menuitemloadrecent.caption 256 msgctxt "tformmain.menuitemloadrecent.caption" 210 257 msgid "Load recent" 211 258 msgstr "Načíst nedávné" 259 260 #: tformmain.toolbutton2.caption 261 msgid "ToolButton2" 262 msgstr "" 212 263 213 264 #: tformmove.buttoncancel.caption … … 615 666 msgid "Occupied cells" 616 667 msgstr "Obsazené buňky" 668 669 #: uformclient.sturn 670 #, fuzzy 671 msgctxt "uformclient.sturn" 672 msgid "turn" 673 msgstr "tah" 617 674 618 675 #: uformhelp.scontent … … 633 690 634 691 #: uformmain.sturn 692 msgctxt "uformmain.sturn" 635 693 msgid "turn" 636 694 msgstr "tah" … … 762 820 msgstr "Hráč" 763 821 822 #: ugame.sspectator 823 msgid "Spectator" 824 msgstr "" 825 764 826 #: ugame.sunfinishedbattle 765 827 msgid "Unfinished battle" … … 777 839 msgid "Zero zoom not allowed" 778 840 msgstr "Nulové přiblížení není povoleno" 841 -
trunk/Languages/xtactics.po
r179 r180 66 66 msgstr "" 67 67 68 #: tcore.anewspectatorclient.caption 69 msgid "New spectator client" 70 msgstr "" 71 68 72 #: tcore.asettings.caption 69 73 msgctxt "tcore.asettings.caption" … … 134 138 msgstr "" 135 139 140 #: tformclient.astatusbarvisible.caption 141 msgctxt "tformclient.astatusbarvisible.caption" 142 msgid "Statusbar visible" 143 msgstr "" 144 145 #: tformclient.atoolbarbigicons.caption 146 msgctxt "tformclient.atoolbarbigicons.caption" 147 msgid "Toolbar big icons" 148 msgstr "" 149 150 #: tformclient.atoolbarvisible.caption 151 msgctxt "tformclient.atoolbarvisible.caption" 152 msgid "Toolbar visible" 153 msgstr "" 154 155 #: tformclient.azoomall.caption 156 msgctxt "tformclient.azoomall.caption" 157 msgid "Zoom all" 158 msgstr "" 159 160 #: tformclient.azoomin.caption 161 msgctxt "tformclient.azoomin.caption" 162 msgid "Zoom in" 163 msgstr "" 164 165 #: tformclient.azoomout.caption 166 msgctxt "tformclient.azoomout.caption" 167 msgid "Zoom out" 168 msgstr "" 169 170 #: tformclient.caption 171 msgid "Client" 172 msgstr "" 173 136 174 #: tformhelp.caption 137 175 msgctxt "TFORMHELP.CAPTION" … … 139 177 msgstr "" 140 178 141 #: tformmain.astatusbarvisible.caption142 msgid "Statusbar visible"143 msgstr ""144 145 179 #: tformmain.atoolbarbigicons.caption 180 msgctxt "tformmain.atoolbarbigicons.caption" 146 181 msgid "Toolbar big icons" 147 182 msgstr "" 148 183 149 184 #: tformmain.atoolbarvisible.caption 185 msgctxt "tformmain.atoolbarvisible.caption" 150 186 msgid "Toolbar visible" 151 msgstr ""152 153 #: tformmain.azoomall.caption154 msgid "Zoom all"155 msgstr ""156 157 #: tformmain.azoomin.caption158 msgid "Zoom in"159 msgstr ""160 161 #: tformmain.azoomout.caption162 msgid "Zoom out"163 187 msgstr "" 164 188 … … 169 193 170 194 #: tformmain.menuitem1.caption 195 msgctxt "tformmain.menuitem1.caption" 171 196 msgid "Game" 172 197 msgstr "" 173 198 174 199 #: tformmain.menuitem10.caption 200 msgctxt "tformmain.menuitem10.caption" 175 201 msgid "View" 202 msgstr "" 203 204 #: tformmain.menuitem11.caption 205 msgctxt "tformmain.menuitem11.caption" 206 msgid "Zoom all" 207 msgstr "" 208 209 #: tformmain.menuitem12.caption 210 msgctxt "tformmain.menuitem12.caption" 211 msgid "Zoom in" 212 msgstr "" 213 214 #: tformmain.menuitem13.caption 215 msgctxt "tformmain.menuitem13.caption" 216 msgid "Zoom out" 176 217 msgstr "" 177 218 … … 181 222 msgstr "" 182 223 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 225 msgctxt "tformmain.menuitem22.caption" 226 msgid "Statusbar visible" 191 227 msgstr "" 192 228 … … 197 233 198 234 #: tformmain.menuitemloadrecent.caption 235 msgctxt "tformmain.menuitemloadrecent.caption" 199 236 msgid "Load recent" 237 msgstr "" 238 239 #: tformmain.toolbutton2.caption 240 msgid "ToolButton2" 200 241 msgstr "" 201 242 … … 599 640 msgctxt "uformcharts.soccupiedcells" 600 641 msgid "Occupied cells" 642 msgstr "" 643 644 #: uformclient.sturn 645 msgctxt "uformclient.sturn" 646 msgid "turn" 601 647 msgstr "" 602 648 … … 612 658 613 659 #: uformmain.sturn 660 msgctxt "uformmain.sturn" 614 661 msgid "turn" 615 662 msgstr "" … … 741 788 msgstr "" 742 789 790 #: ugame.sspectator 791 msgid "Spectator" 792 msgstr "" 793 743 794 #: ugame.sunfinishedbattle 744 795 msgid "Unfinished battle" -
trunk/UCore.lfm
r179 r180 82 82 Caption = 'Unit moves' 83 83 OnExecute = AShowUnitMovesExecute 84 end 85 object ANewSpectatorClient: TAction 86 Caption = 'New spectator client' 87 OnExecute = ANewSpectatorClientExecute 84 88 end 85 89 end -
trunk/UCore.pas
r179 r180 8 8 Classes, SysUtils, XMLConf, FileUtil, ActnList, Controls, Dialogs, Forms, 9 9 UGame, UApplicationInfo, UPersistentForm, UScaleDPI, UCoolTranslator, 10 URegistry, ULastOpenedList, Registry, Menus, UGeometry ;10 URegistry, ULastOpenedList, Registry, Menus, UGeometry, Contnrs, UFormClient; 11 11 12 12 type … … 16 16 TCore = class(TDataModule) 17 17 AAbout: TAction; 18 ANewSpectatorClient: TAction; 18 19 AShowUnitMoves: TAction; 19 20 AShowCharts: TAction; … … 47 48 procedure AGameSaveExecute(Sender: TObject); 48 49 procedure AHelpExecute(Sender: TObject); 50 procedure ANewSpectatorClientExecute(Sender: TObject); 49 51 procedure ASettingsExecute(Sender: TObject); 50 52 procedure AShowChartsExecute(Sender: TObject); … … 69 71 procedure GameNewTurnExecute(Sender: TObject); 70 72 procedure AutoSave; 71 function GetPlayer: TPlayer;72 73 procedure LoadConfig; 73 74 procedure SaveConfig; … … 76 77 procedure SelectClient; 77 78 procedure LoadGame(FileName: string); 79 procedure RedrawClients; 78 80 public 79 81 Game: TGame; … … 83 85 AnimationSpeed: Integer; 84 86 AutoSaveEnabled: Boolean; 85 CurrentClient: TClient; 87 FormClients: TObjectList; // TFormClient 88 //CurrentClient: TClient; 89 LocalClients: TObjectList; // TClient 86 90 procedure UpdateActions; 87 91 procedure Init; … … 147 151 procedure TCore.DoOnWin(Player: TPlayer); 148 152 begin 149 FormMain.Redraw;153 RedrawClients; 150 154 ShowMessage(Format(SPlayerWins, [Player.Name])); 151 155 end; … … 174 178 Game.SaveToFile(GetAppConfigDir(False) + 'AutoSave.xtg'); 175 179 Game.FileName := OldFileName; 176 end;177 178 function TCore.GetPlayer: TPlayer;179 begin180 Result := Game.CurrentPlayer;181 180 end; 182 181 … … 246 245 begin 247 246 FirstHuman := Game.Players.GetFirstHuman; 248 if Assigned(FirstHuman) then CurrentClient := FirstHuman.Client249 else CurrentClient := TClient(Server.Clients.First);247 if Assigned(FirstHuman) then FormClient.Client := FirstHuman.Client 248 else FormClient.Client := TClient(Server.Clients.First); 250 249 end; 251 250 … … 276 275 if MessageDlg(SEndGame, SEndGameQuestion, mtConfirmation, mbYesNo, 0) = mrYes then begin 277 276 Game.Running := False; 278 FormMain.Redraw;277 RedrawClients; 279 278 UpdateActions; 280 279 end; … … 286 285 if Game.CurrentPlayer.Mode = pmComputer then begin 287 286 Game.CurrentPlayer.Computer.Process; 288 FormMain.Redraw;287 RedrawClients; 289 288 Delay(Trunc((100 - AnimationSpeed) / 100 * 2000)); 290 289 end; 291 290 Game.NextTurn; 292 FormMain.Redraw;291 RedrawClients; 293 292 Application.ProcessMessages; 294 293 Sleep(1); … … 299 298 begin 300 299 Game.NextTurn; 301 FormMain.Redraw;300 RedrawClients; 302 301 ProcessComputerTurns; 303 302 UpdateActions; … … 354 353 FreeAndNil(FormHelp); 355 354 end; 355 end; 356 357 procedure TCore.ANewSpectatorClientExecute(Sender: TObject); 358 var 359 Form: TFormClient; 360 begin 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; 356 366 end; 357 367 … … 401 411 XMLConfig1.Filename := GetAppConfigDir(False) + 'Config.xml'; 402 412 ForceDirectories(GetAppConfigDir(False)); 413 FormClients := TObjectList.Create; 403 414 end; 404 415 405 416 procedure TCore.DataModuleDestroy(Sender: TObject); 406 417 begin 418 FreeAndNil(FormClients); 407 419 FreeAndNil(StoredDimension); 408 420 Game.SaveConfig(XMLConfig1, 'Game'); … … 429 441 SelectClient; 430 442 LastOpenedList1.AddItem(FileName); 431 with Core.CurrentClient do443 with FormClient.Client do 432 444 View.DestRect := TRect.CreateBounds(TPoint.Create(0, 0), 433 TPoint.Create(Form Main.PaintBox1.Width, FormMain.PaintBox1.Height));434 Form Main.AZoomAll.Execute;435 FormMain.Redraw;445 TPoint.Create(FormClient.PaintBox1.Width, FormClient.PaintBox1.Height)); 446 FormClient.AZoomAll.Execute; 447 RedrawClients; 436 448 if FormCharts.Visible then FormCharts.Redraw; 437 449 if FormUnitMoves.Visible then FormUnitMoves.ReloadList; 450 end; 451 452 procedure TCore.RedrawClients; 453 var 454 Form: TFormClient; 455 begin 456 for Form in FormClients do 457 Form.Redraw; 458 FormClient.Redraw; 438 459 end; 439 460 … … 446 467 if Game.Players.GetAliveCount = Game.Players.Count then Game.Running := True 447 468 else ShowMessage(Format(SPlayersNotInitialized, [Game.Players.Count, Game.Players.GetAliveCount])); 448 FormMain.Redraw;469 RedrawClients; 449 470 if FormCharts.Visible then FormCharts.Redraw; 450 471 if FormUnitMoves.Visible then FormUnitMoves.ReloadList; … … 455 476 procedure TCore.DoPlayerChange(Sender: TObject); 456 477 begin 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; 459 481 if FormCharts.Visible then FormCharts.Redraw; 460 482 if FormUnitMoves.Visible then FormUnitMoves.ReloadList; -
trunk/UGame.pas
r179 r180 6 6 7 7 uses 8 Classes, SysUtils, ExtCtrls, Graphics, XMLConf, XMLRead, XMLWrite, 8 Classes, SysUtils, ExtCtrls, Graphics, XMLConf, XMLRead, XMLWrite, Forms, 9 9 DOM, Math, LazFileUtils, UXMLUtils, Dialogs, Types, LCLType, LCLIntf, fgl, 10 10 UGeometry, UGameSocket; … … 421 421 FGame: TGame; 422 422 FControlPlayer: TPlayer; 423 FOnChange: TNotifyEvent; 423 424 FOnReceive: TReceiveEvent; 424 425 procedure SetControlPlayer(AValue: TPlayer); 425 426 procedure SetGame(AValue: TGame); 427 procedure DoChange; 426 428 public 429 Form: TForm; 427 430 Name: string; 428 431 View: TView; … … 434 437 property Game: TGame read FGame write SetGame; 435 438 property OnReceive: TReceiveEvent read FOnReceive write FOnReceive; 439 property OnChange: TNotifyEvent read FOnChange write FOnChange; 436 440 end; 437 441 … … 440 444 TClients = class(TFPGObjectList<TClient>) 441 445 Game: TGame; 442 procedure New(Name: string);446 function New(Name: string): TClient; 443 447 constructor Create(FreeObjects: Boolean = True); 444 448 end; … … 534 538 procedure SetGame(AValue: TGame); 535 539 procedure SetServerMode(AValue: TServerMode); 540 procedure DoChange; 536 541 public 537 542 Clients: TClients; … … 565 570 resourcestring 566 571 SPlayer = 'Player'; 572 SSpectator = 'Spectator'; 567 573 568 574 … … 650 656 { TClients } 651 657 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); 658 function TClients.New(Name: string): TClient; 659 begin 660 Result := TClient.Create; 661 Result.Game := Game; 662 Result.Name := Name; 663 Add(Result); 660 664 end; 661 665 … … 673 677 FGame := AValue; 674 678 View.Game := AValue; 679 end; 680 681 procedure TClient.DoChange; 682 begin 683 if Assigned(FOnChange) then 684 FOnChange(Self); 675 685 end; 676 686 … … 3201 3211 end; 3202 3212 3213 procedure TServer.DoChange; 3214 var 3215 Client: TClient; 3216 begin 3217 for Client in Clients do 3218 Client.DoChange; 3219 end; 3220 3203 3221 procedure TServer.LoadConfig(Config: TXmlConfig; Path: string); 3204 3222 begin … … 3229 3247 begin 3230 3248 Clients.Clear; 3231 Clients.New( 'Spectator');3249 Clients.New(SSpectator); 3232 3250 3233 3251 for Player in Game.Players do 3234 3252 with Player do 3235 3253 if Mode = pmHuman then begin 3236 Clients.New(Player.Name); 3237 Player.Client := TClient(Clients.Last); 3254 Player.Client := Clients.New(Player.Name); 3238 3255 end; 3239 3256 … … 3586 3603 // For computers take view from previous human 3587 3604 //if CurrentPlayer.Mode = pmComputer then CurrentPlayer.View.Assign(PrevPlayer.View); 3605 Server.DoChange; 3588 3606 end; 3589 3607 -
trunk/xtactics.lpi
r179 r180 100 100 </Item6> 101 101 </RequiredPackages> 102 <Units Count="1 6">102 <Units Count="18"> 103 103 <Unit0> 104 104 <Filename Value="xtactics.lpr"/> … … 198 198 <IsPartOfProject Value="True"/> 199 199 </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> 200 211 </Units> 201 212 </ProjectOptions> -
trunk/xtactics.lpr
r179 r180 12 12 { you can add units after this }, 13 13 SysUtils, UFormMain, UFormMove, UFormNew, UFormCharts, UFormUnitMoves, 14 UFormChat, UGameSocket, UTCP ;14 UFormChat, UGameSocket, UTCP, UServerList; 15 15 16 16 {$R *.res}
Note:
See TracChangeset
for help on using the changeset viewer.