From 6064bfec538038fd1e1ccf4da54fa859241f98fa Mon Sep 17 00:00:00 2001 From: Pavel Perminov Date: Wed, 26 Sep 2012 19:14:19 +0000 Subject: Current line of development release (344 rev. truncated adjusted copy) git-svn-id: http://svn.miranda-ng.org/main/trunk@1669 1316c22d-e87f-b044-9b9b-93d7a3e3ba9c --- plugins/Chess4Net/BitmapResUnit.pas | 145 +- plugins/Chess4Net/ChessBoardHeaderUnit.pas | 6 + plugins/Chess4Net/ChessBoardUnit.dfm | 157 +- plugins/Chess4Net/ChessBoardUnit.pas | 1800 ++++++++++---------- plugins/Chess4Net/ChessClockUnit.pas | 113 ++ plugins/Chess4Net/ChessRulesEngine.pas | 1351 ++++++++++----- plugins/Chess4Net/ClientQueueUnit.pas | 6 + plugins/Chess4Net/ConnectingUnit.pas | 8 +- plugins/Chess4Net/ConnectionUnit.pas | 8 +- plugins/Chess4Net/ContinueUnit.pas | 8 +- plugins/Chess4Net/DialogUnit.pas | 75 +- plugins/Chess4Net/DontShowMessageDlgUnit.pas | 82 + plugins/Chess4Net/DraggedFigureUnit.pas | 6 + plugins/Chess4Net/GameChessBoardUnit.dfm | 166 ++ plugins/Chess4Net/GameChessBoardUnit.pas | 849 +++++++++ plugins/Chess4Net/GameOptionsUnit.dfm | 48 +- plugins/Chess4Net/GameOptionsUnit.pas | 8 +- plugins/Chess4Net/GlobalsUnit.pas | 14 + plugins/Chess4Net/InfoUnit.dfm | 2 +- plugins/Chess4Net/InfoUnit.pas | 10 +- plugins/Chess4Net/IniSettingsUnit.pas | 348 ++++ plugins/Chess4Net/Lang.ini | Bin 12304 -> 41582 bytes plugins/Chess4Net/LocalizerUnit.pas | 15 +- plugins/Chess4Net/LookFeelOptionsUnit.pas | 12 +- plugins/Chess4Net/MI/Chess4Net_MI.cfg.bak | 47 - plugins/Chess4Net/MI/Chess4Net_MI.dof | 64 +- plugins/Chess4Net/MI/Chess4Net_MI.dpr | 22 +- plugins/Chess4Net/MI/ConnectorUnit.pas | 211 +-- plugins/Chess4Net/MI/ControlUnit.pas | 6 + plugins/Chess4Net/MI/GlobalsLocalUnit.pas | 15 +- plugins/Chess4Net/MI/ManagerUnit.MI.pas | 56 +- plugins/Chess4Net/MI/PluginCommonUnit.pas | 12 +- plugins/Chess4Net/MI/TransmitGameSelectionUnit.pas | 6 + plugins/Chess4Net/ManagerUnit.dfm | 16 + plugins/Chess4Net/ManagerUnit.pas | 534 +++--- plugins/Chess4Net/MessageDialogUnit.pas | 6 + plugins/Chess4Net/ModalForm.pas | 118 +- plugins/Chess4Net/NonMainFormStayOnTopUnit.pas | 74 + plugins/Chess4Net/NonRefInterfacedObjectUnit.pas | 44 + plugins/Chess4Net/PosBaseChessBoardLayerUnit.pas | 620 +++++++ plugins/Chess4Net/PosBaseUnit.pas | 549 ++++-- plugins/Chess4Net/PromotionUnit.pas | 115 +- plugins/Chess4Net/Readme.txt | 46 +- plugins/Chess4Net/Readme_RU.txt | Bin 13846 -> 15044 bytes plugins/Chess4Net/TODO.txt | 18 + plugins/Chess4Net/URLVersionQueryUnit.dfm | 7 + plugins/Chess4Net/URLVersionQueryUnit.pas | 185 ++ plugins/Chess4Net/lib/XIE/XIE.pas | 333 ++++ 48 files changed, 5997 insertions(+), 2344 deletions(-) create mode 100644 plugins/Chess4Net/ChessClockUnit.pas create mode 100644 plugins/Chess4Net/DontShowMessageDlgUnit.pas create mode 100644 plugins/Chess4Net/GameChessBoardUnit.dfm create mode 100644 plugins/Chess4Net/GameChessBoardUnit.pas create mode 100644 plugins/Chess4Net/IniSettingsUnit.pas delete mode 100644 plugins/Chess4Net/MI/Chess4Net_MI.cfg.bak create mode 100644 plugins/Chess4Net/NonMainFormStayOnTopUnit.pas create mode 100644 plugins/Chess4Net/NonRefInterfacedObjectUnit.pas create mode 100644 plugins/Chess4Net/PosBaseChessBoardLayerUnit.pas create mode 100644 plugins/Chess4Net/URLVersionQueryUnit.dfm create mode 100644 plugins/Chess4Net/URLVersionQueryUnit.pas create mode 100644 plugins/Chess4Net/lib/XIE/XIE.pas (limited to 'plugins/Chess4Net') diff --git a/plugins/Chess4Net/BitmapResUnit.pas b/plugins/Chess4Net/BitmapResUnit.pas index bda6d1a1e9..28551b3887 100644 --- a/plugins/Chess4Net/BitmapResUnit.pas +++ b/plugins/Chess4Net/BitmapResUnit.pas @@ -1,3 +1,9 @@ +//////////////////////////////////////////////////////////////////////////////// +// All code below is exclusively owned by author of Chess4Net - Pavel Perminov +// (packpaul@mail.ru, packpaul1@gmail.com). +// Any changes, modifications, borrowing and adaptation are a subject for +// explicit permition from the owner. + unit BitmapResUnit; interface @@ -15,8 +21,14 @@ type m_iSetNumber: integer; m_iSquareSize: integer; procedure FCalculateClientBoardSizes(InitialSize: TSize); + function FGetOptimalBoardSize(const ClientSize: TSize; out iSetNumber: integer): TSize; + procedure FCalculateSetNumberFromSquareSize; + procedure FLoadPieceSet(iSetNumber: integer); + function FGetBoardResName(iSetNumber: integer): string; + function FGetSetResName(iSetNumber: integer): string; public - constructor Create(const ClientBoardSize: TSize); + constructor Create(const ClientBoardSize: TSize); overload; + constructor Create(iSquareSize: integer); overload; destructor Destroy; override; procedure CreateBoardBitmap(ClientBoardSize: TSize; const BackgroundColor: TColor; out Bitmap: TBitmap); @@ -38,17 +50,23 @@ const CHB_RES_X = 4; CHB_RES_Y = 4; // starting coordinates of A8 field in resources var - g_BitmapResInstance: TBitmapRes = nil; arrClientBoardSizes: array[1..7] of TSize; - bClientBoardSizesCalculated: boolean = FALSE; + g_bClientBoardSizesCalculated: boolean = FALSE; //////////////////////////////////////////////////////////////////////////////// // TBitmapRes constructor TBitmapRes.Create(const ClientBoardSize: TSize); begin - if (not bClientBoardSizesCalculated) then - FCalculateClientBoardSizes(ClientBoardSize); + inherited Create; + FCalculateClientBoardSizes(ClientBoardSize); +end; + + +constructor TBitmapRes.Create(iSquareSize: integer); +begin + inherited Create; + m_iSquareSize := iSquareSize; end; @@ -64,38 +82,58 @@ procedure TBitmapRes.CreateBoardBitmap(ClientBoardSize: TSize; const BackgroundC var Png: TPngObject; ResBoard: TBitmap; + iSetNumber: integer; begin Png := nil; ResBoard := nil; - m_iSquareSize := 0; - GetOptimalBoardSize(ClientBoardSize); // To refresh m_iSetNumber - if (m_iSetNumber = 0) then + FGetOptimalBoardSize(ClientBoardSize, iSetNumber); + + if (iSetNumber = 0) then exit; Bitmap := TBitMap.Create; with Bitmap do try Png := TPngObject.Create; - Png.LoadFromResourceName(HInstance, 'BOARD' + IntToStr(m_iSetNumber)); + Png.LoadFromResourceName(HInstance, FGetBoardResName(iSetNumber)); ResBoard := TBitmap.Create; ResBoard.Assign(Png); - Width := arrClientBoardSizes[m_iSetNumber].cx; - Height := arrClientBoardSizes[m_iSetNumber].cy; + Width := arrClientBoardSizes[iSetNumber].cx; + Height := arrClientBoardSizes[iSetNumber].cy; Canvas.Brush.Color := BackgroundColor; Canvas.FillRect(Bounds(0, 0, Width, Height)); Canvas.Draw(CHB_X - CHB_RES_X, CHB_Y - CHB_RES_Y, ResBoard); // Load appropriate set - FreeAndNil(m_ResSet); - Png.LoadFromResourceName(HInstance, 'SET' + IntToStr(m_iSetNumber)); + FLoadPieceSet(iSetNumber); + + finally; + m_iSetNumber := iSetNumber; + ResBoard.Free; + Png.Free; + end; +end; + + +procedure TBitmapRes.FLoadPieceSet(iSetNumber: integer); +var + Png: TPngObject; +begin + if (Assigned(m_ResSet) and (iSetNumber = m_iSetNumber)) then + exit; + + FreeAndNil(m_ResSet); + + Png := TPngObject.Create; + try + Png.LoadFromResourceName(HInstance, FGetSetResName(iSetNumber)); m_ResSet := TBitmap.Create; m_ResSet.Assign(Png); m_iSquareSize := m_ResSet.Height; - finally; - ResBoard.Free; + finally Png.Free; end; end; @@ -105,38 +143,76 @@ procedure TBitmapRes.CreateFigureBitmap(const Figure: TFigure; out Bitmap: TBitm const PNG_SET_POS: array[TFigure] of integer = (2, 4, 6, 8, 10, 12, 0, 3, 5, 7, 9, 11, 13); var - iSquareSize, iWidth: integer; + iWidth: integer; begin if (m_iSetNumber = 0) then - exit; + begin + FCalculateSetNumberFromSquareSize; + if (m_iSetNumber = 0) then + exit; + end; - iSquareSize := m_ResSet.Height; + FLoadPieceSet(m_iSetNumber); - iWidth := IfThen((Figure = ES), iSquareSize + iSquareSize, iSquareSize); + iWidth := IfThen((Figure = ES), m_iSquareSize + m_iSquareSize, m_iSquareSize); Bitmap := TBitMap.Create; Bitmap.Width := iWidth; - Bitmap.Height := iSquareSize; + Bitmap.Height := m_iSquareSize; - Bitmap.Canvas.CopyRect(Bounds(0, 0, iWidth, iSquareSize), m_ResSet.Canvas, - Bounds(iSquareSize * PNG_SET_POS[Figure], 0, iWidth, iSquareSize)); + Bitmap.Canvas.CopyRect(Bounds(0, 0, iWidth, m_iSquareSize), m_ResSet.Canvas, + Bounds(m_iSquareSize * PNG_SET_POS[Figure], 0, iWidth, m_iSquareSize)); Bitmap.Transparent:= TRUE; end; -function TBitmapRes.GetOptimalBoardSize(ClientSize: TSize): TSize; +procedure TBitmapRes.FCalculateSetNumberFromSquareSize; var i: integer; begin m_iSetNumber := 0; + with TPngObject.Create do + try + for i := High(arrClientBoardSizes) downto Low(arrClientBoardSizes) do + begin + LoadFromResourceName(HInstance, FGetSetResName(i)); + + if (Height <= m_iSquareSize) then + begin + m_iSetNumber := i; + exit; + end; + end; + + finally + Free; + end; + +end; + + +function TBitmapRes.GetOptimalBoardSize(ClientSize: TSize): TSize; +var + iDummy: integer; +begin + Result := FGetOptimalBoardSize(ClientSize, iDummy); +end; + + +function TBitmapRes.FGetOptimalBoardSize(const ClientSize: TSize; out iSetNumber: integer): TSize; +var + i: integer; +begin + iSetNumber := 0; + for i := High(arrClientBoardSizes) downto Low(arrClientBoardSizes) do begin if ((ClientSize.cx >= arrClientBoardSizes[i].cx) and (ClientSize.cy >= arrClientBoardSizes[i].cy)) then begin Result := arrClientBoardSizes[i]; - m_iSetNumber := i; + iSetNumber := i; exit; end; end; { for i } @@ -148,17 +224,18 @@ end; procedure TBitmapRes.FCalculateClientBoardSizes(InitialSize: TSize); var i: integer; - strResName: string; iOptimal: integer; iAddX, iAddY: integer; begin + if (g_bClientBoardSizesCalculated) then + exit; + // Load board sizes from resources with TPngObject.Create do try for i := Low(arrClientBoardSizes) to High(arrClientBoardSizes) do begin - strResName := 'BOARD' + IntToStr(i); - LoadFromResourceName(HInstance, strResName); + LoadFromResourceName(HInstance, FGetBoardResName(i)); arrClientBoardSizes[i] := Size(Width, Height); end; finally @@ -187,7 +264,19 @@ begin inc(arrClientBoardSizes[i].cy, iAddY); end; - bClientBoardSizesCalculated := TRUE; + g_bClientBoardSizesCalculated := TRUE; +end; + + +function TBitmapRes.FGetBoardResName(iSetNumber: integer): string; +begin + Result := 'BOARD' + IntToStr(iSetNumber); +end; + + +function TBitmapRes.FGetSetResName(iSetNumber: integer): string; +begin + Result := 'SET' + IntToStr(iSetNumber); end; end. diff --git a/plugins/Chess4Net/ChessBoardHeaderUnit.pas b/plugins/Chess4Net/ChessBoardHeaderUnit.pas index 26ffb341a7..b0226e3321 100644 --- a/plugins/Chess4Net/ChessBoardHeaderUnit.pas +++ b/plugins/Chess4Net/ChessBoardHeaderUnit.pas @@ -1,3 +1,9 @@ +//////////////////////////////////////////////////////////////////////////////// +// All code below is exclusively owned by author of Chess4Net - Pavel Perminov +// (packpaul@mail.ru, packpaul1@gmail.com). +// Any changes, modifications, borrowing and adaptation are a subject for +// explicit permition from the owner. + unit ChessBoardHeaderUnit; interface diff --git a/plugins/Chess4Net/ChessBoardUnit.dfm b/plugins/Chess4Net/ChessBoardUnit.dfm index b9f17a075d..3976a60187 100644 --- a/plugins/Chess4Net/ChessBoardUnit.dfm +++ b/plugins/Chess4Net/ChessBoardUnit.dfm @@ -1,32 +1,27 @@ object ChessBoard: TChessBoard - Left = 429 - Top = 209 + Left = 715 + Top = 238 Width = 364 - Height = 412 - BorderIcons = [biSystemMenu] + Height = 381 + Caption = 'ChessBoard' Color = clBtnFace - TransparentColorValue = clBackground Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText - Font.Height = -13 + Font.Height = -11 Font.Name = 'MS Sans Serif' - Font.Style = [fsBold] - KeyPreview = True + Font.Style = [] OldCreateOrder = False - OnActivate = FormActivate OnCanResize = FormCanResize - OnClose = FormClose OnCreate = FormCreate OnDestroy = FormDestroy - OnKeyDown = FormKeyDown OnResize = FormResize PixelsPerInch = 96 - TextHeight = 16 + TextHeight = 13 object PBoxBoard: TPaintBox Left = 0 - Top = 33 + Top = 0 Width = 356 - Height = 352 + Height = 354 Align = alClient Color = clSilver DragCursor = crHandPoint @@ -46,141 +41,11 @@ object ChessBoard: TChessBoard OnPaint = PBoxBoardPaint OnStartDrag = PBoxBoardStartDrag end - object TimePanel: TPanel - Left = 0 - Top = 0 - Width = 356 - Height = 33 - Align = alTop - BevelInner = bvLowered - TabOrder = 0 - OnResize = TimePanelResize - object WhitePanel: TPanel - Left = 8 - Top = 4 - Width = 145 - Height = 25 - BevelOuter = bvNone - TabOrder = 0 - DesignSize = ( - 145 - 25) - object WhiteTimeLabel: TLabel - Left = 71 - Top = 0 - Width = 68 - Height = 25 - Align = alLeft - AutoSize = False - Caption = '0:00:00' - Font.Charset = DEFAULT_CHARSET - Font.Color = clWindowText - Font.Height = -19 - Font.Name = 'MS Sans Serif' - Font.Style = [fsBold] - ParentFont = False - Layout = tlCenter - end - object WhiteFlagButton: TSpeedButton - Left = 115 - Top = 2 - Width = 23 - Height = 22 - Anchors = [akTop, akRight] - Glyph.Data = { - 66010000424D6601000000000000760000002800000014000000140000000100 - 040000000000F000000000000000000000001000000000000000000000000000 - 8000008000000080800080000000800080008080000080808000C0C0C0000000 - FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00FFFFFFFFFFFF - FFFFFFFF0000FFFFFFFFFFFFFFFFFFFF0000FFFFFFFFFFFFFFFFFFFF0000FFFF - FFFFFFFFFFFFFFFF0000FFFFFFFFFFFFFFFFFFFF0000FFFFFFFFFFFFFFF83FFF - 0000FFFF99FFFFFFFFF33FFF0000FFFFF99FFFFFFF83FFFF0000FFFFF999FFFF - FF33FFFF0000F99999999FFFF33FFFFF0000FF99999999FF83FFFFFF0000FFF9 - 9999999F33FFFFFF0000FFFF999999983FFFFFFF0000FFFFFF9999993FFFFFFF - 0000FFFFFF999999FFFFFFFF0000FFFFFFF9999FFFFFFFFF0000FFFFFFF9999F - FFFFFFFF0000FFFFFFFF99FFFFFFFFFF0000FFFFFFFF9FFFFFFFFFFF0000FFFF - FFFFFFFFFFFFFFFF0000} - Visible = False - OnClick = FlagButtonClick - end - object WhiteLabel: TTntLabel - Left = 0 - Top = 0 - Width = 71 - Height = 25 - Align = alLeft - Caption = 'White ' - Font.Charset = DEFAULT_CHARSET - Font.Color = clWindowText - Font.Height = -19 - Font.Name = 'Microsoft Sans Serif' - Font.Style = [fsBold] - ParentFont = False - end - end - object BlackPanel: TPanel - Left = 184 - Top = 4 - Width = 145 - Height = 25 - BevelOuter = bvNone - TabOrder = 1 - DesignSize = ( - 145 - 25) - object BlackTimeLabel: TLabel - Left = 68 - Top = 0 - Width = 68 - Height = 25 - Align = alLeft - AutoSize = False - Caption = '0:00:00' - Font.Charset = DEFAULT_CHARSET - Font.Color = clWindowText - Font.Height = -19 - Font.Name = 'MS Sans Serif' - Font.Style = [fsBold] - ParentFont = False - Layout = tlCenter - end - object BlackLabel: TTntLabel - Left = 0 - Top = 0 - Width = 68 - Height = 25 - Align = alLeft - Caption = 'Black ' - Font.Charset = DEFAULT_CHARSET - Font.Color = clWindowText - Font.Height = -19 - Font.Name = 'Microsoft Sans Serif' - Font.Style = [fsBold] - ParentFont = False - end - object BlackFlagButton: TSpeedButton - Left = 115 - Top = 2 - Width = 23 - Height = 22 - Anchors = [akTop, akRight] - Visible = False - OnClick = FlagButtonClick - end - end - end - object GameTimer: TTimer - Enabled = False - Interval = 100 - OnTimer = GameTimerTimer - Left = 8 - Top = 40 - end object AnimateTimer: TTimer Enabled = False Interval = 1 OnTimer = AnimateTimerTimer - Left = 40 - Top = 40 + Left = 8 + Top = 8 end end diff --git a/plugins/Chess4Net/ChessBoardUnit.pas b/plugins/Chess4Net/ChessBoardUnit.pas index 6b655058ad..8a7042f292 100644 --- a/plugins/Chess4Net/ChessBoardUnit.pas +++ b/plugins/Chess4Net/ChessBoardUnit.pas @@ -1,410 +1,396 @@ +//////////////////////////////////////////////////////////////////////////////// +// All code below is exclusively owned by author of Chess4Net - Pavel Perminov +// (packpaul@mail.ru, packpaul1@gmail.com). +// Any changes, modifications, borrowing and adaptation are a subject for +// explicit permition from the owner. + unit ChessBoardUnit; interface uses - Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, TntForms, - Dialogs, StdCtrls, TntStdCtrls, ExtCtrls, Buttons, - // Chess4net - ChessBoardHeaderUnit, ChessRulesEngine, BitmapResUnit, LocalizerUnit; + Forms, ExtCtrls, Classes, Controls, Graphics, Types, Messages, + // + ChessRulesEngine, BitmapResUnit, PromotionUnit; type - TMode = (mView, mGame); // состояние доски - TChessBoardEvent = - (cbeMoved, cbeMate, cbeStaleMate, cbeInsuffMaterial, cbeKeyPressed, - cbeClockSwitched, cbeTimeOut, cbeExit, cbeMenu, cbeActivate, cbeFormMoving, - cbeRefreshAll); // возможно добавление новых событий - // cbeRefreshAll сигнализирует, что были изменены глобальные опции. + TMode = (mView, mGame, mAnalyse, mEdit); // Board mode + + TAnimation = (aNo, aSlow, aQuick); + + TChessBoardEvent = (cbeMate, cbeStaleMate, cbeMoved, cbePosSet, cbeMenu); TChessBoardHandler = procedure(e: TChessBoardEvent; d1: pointer = nil; d2: pointer = nil) of object; - TAnimation = (aNo, aSlow, aQuick); -{$IFDEF THREADED_CHESSCLOCK} - TChessBoard = class; - TTimeLabelThread = class(TThread) - private - ChessBoard: TChessBoard; - player_time: array[TFigureColor] of TDateTime; - protected - procedure Execute; override; - public - WhiteTime, BlackTime: string; - constructor Create(ChessBoard: TChessBoard); - end; -{$ENDIF} + TChessBoardLayerBase = class; - TChessBoard = class(TTntForm, ILocalizable, IChessRulesEngineable) + TChessBoard = class(TForm, IChessRulesEngineable) PBoxBoard: TPaintBox; - TimePanel: TPanel; - WhiteLabel: TTntLabel; - WhiteTimeLabel: TLabel; - BlackLabel: TTntLabel; - BlackTimeLabel: TLabel; - GameTimer: TTimer; AnimateTimer: TTimer; - WhiteFlagButton: TSpeedButton; - BlackFlagButton: TSpeedButton; - WhitePanel: TPanel; - BlackPanel: TPanel; + procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); + procedure FormCanResize(Sender: TObject; var NewWidth, + NewHeight: Integer; var Resize: Boolean); + procedure FormResize(Sender: TObject); + procedure AnimateTimerTimer(Sender: TObject); procedure PBoxBoardPaint(Sender: TObject); procedure PBoxBoardDragDrop(Sender, Source: TObject; X, Y: Integer); procedure PBoxBoardDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure PBoxBoardEndDrag(Sender, Target: TObject; X, Y: Integer); - procedure PBoxBoardMouseDown(Sender: TObject; Button: TMouseButton; - Shift: TShiftState; X, Y: Integer); - procedure PBoxBoardMouseMove(Sender: TObject; Shift: TShiftState; X, - Y: Integer); + procedure PBoxBoardMouseDown(Sender: TObject; + Button: TMouseButton; Shift: TShiftState; X, Y: Integer); + procedure PBoxBoardMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure PBoxBoardMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); - procedure PBoxBoardStartDrag(Sender: TObject; - var DragObject: TDragObject); - procedure AnimateTimerTimer(Sender: TObject); - procedure GameTimerTimer(Sender: TObject); - procedure FormClose(Sender: TObject; var Action: TCloseAction); - procedure FormKeyDown(Sender: TObject; var Key: Word; - Shift: TShiftState); - procedure FormActivate(Sender: TObject); - procedure FlagButtonClick(Sender: TObject); - procedure FormCanResize(Sender: TObject; var NewWidth, NewHeight: Integer; - var Resize: Boolean); - procedure FormResize(Sender: TObject); - procedure TimePanelResize(Sender: TObject); + procedure PBoxBoardStartDrag(Sender: TObject; var DragObject: TDragObject); private m_ChessRulesEngine: TChessRulesEngine; + m_BitmapRes: TBitmapRes; // Manager for bitmaps - m_i0, m_j0: integer; - m_fig: TFigure; + FHandler: TChessBoardHandler; - mode_var: TMode; dx, dy: integer; // Расстояние от курсора до верхнего левого угла x0, y0: integer; // Предыдущие координаты курсора _flipped: boolean; // Доска перевёрнута или нет - hilighted: boolean; // Подсветка делаемого хода + m_bHilighted: boolean; // Hilight the move that is being done + + m_i0, m_j0: integer; + m_fig: TFigure; + + m_Mode: TMode; + m_bViewGaming: boolean; + m_bmHiddenBoard: TBitmap; m_bmChessBoard: TBitmap; m_bmFigure: array[TFigure] of TBitmap; m_bmBuf: TBitmap; - Handler: TChessBoardHandler; + m_iSquareSize: integer; // Size of one chess board field - m_animation: TAnimation; // скорость анимации + m_animation: TAnimation; // Animation speed + m_iAnimStep, m_iPrevAnimStep, m_iAnimStepsCount: integer; + anim_dx, anim_dy: real; // Variables for animation of a dragged piece - anim_dx, anim_dy: real; // переменные для анимации перемещения фигуры - anim_step, anim_step_num: integer; // количество шагов в анимации - player_color: TFigureColor; // цвет игрока клиента - dragged_moved: boolean; // индикатор включения перетаскивания - last_hilight: boolean; // флаг подсветки последнего хода - m_bFlash_move: boolean; // flag for flashing on icoming move - coord_show: boolean; // флаг координат - - auto_flag: boolean; // индикатор автофлага - player_time: array[TFigureColor] of TDateTime; // время белых и чёрных - past_time: TDateTime; // время начала обдумывания хода - unlimited_var: array[TFigureColor] of boolean; // партия без временного контроля - clock_color: TFigureColor; // цвет анимируемой фигуры - - shuted: boolean; // индикатор внешнего закрытия окна + m_PlayerColor: TFigureColor; // Color of player client + m_bDraggedMoved: boolean; // Flag for switching of dragging + last_hilight: boolean; // Flag for hilighting of the last move done + coord_show: boolean; // Flag for showing coordinates // Resizing m_ResizingType: (rtNo, rtHoriz, rtVert); m_iDeltaWidthHeight: integer; - m_BitmapRes: TBitmapRes; // Manager for bitmaps - m_iTimePanelInitialWidth: integer; - m_iWhitePanelInitialLeft, m_iBlackPanelInitialLeft: integer; - m_iWhitePanelInitialWidth, m_iBlackPanelInitialWidth: integer; - m_TimeFont: TFont; + m_bDeltaWidthHeightFlag: boolean; - m_bViewGaming: boolean; + m_PromotionForm: TPromotionForm; -{$IFDEF THREADED_CHESSCLOCK} - TimeLabelThread: TTimeLabelThread; // нить используется для борьбы с лагом в Миранде -{$ENDIF} + m_EditPiece: TFigure; + + m_iUpdateCounter: integer; + + m_lstLayers: TList; procedure HilightLastMove; - procedure WhatSquare(const P: TPoint; var i: Integer; var j: Integer); - procedure Animate(const i, j: integer); // Анимирует перемещение фигуры с (i0,j0) до (i,j) - procedure SetMode(const m: TMode); - procedure ShowTime(const c: TFigureColor); - procedure SetPlayerColor(const color: TFigureColor); - procedure SetTime(color: TFigureColor; const tm: TDateTime); - function GetTime(color: TFigureColor): TDateTime; - procedure SetUnlimited(color: TFigureColor; const unl: boolean); - function GetUnlimited(color: TFigureColor): boolean; procedure Evaluate; - procedure SetHilightLastMove(const yes: boolean); - procedure SetCoordinates(const yes: boolean); - procedure SetFlipped(const f: boolean); // Переварачивает позицию при отображении - function GetStayOnTop: boolean; - procedure SetStayOnTop(onTop: boolean); - procedure FCancelAnimationDragging; // отмена анимации и перетаскивания для удаления грязи при прорисовки - procedure SetAutoFlag(auto_flag: boolean); - procedure FFlashWindow; - // Localization - procedure ILocalizable.Localize = FLocalize; - procedure FLocalize; - - procedure WMMoving(var Msg: TWMMoving); message WM_MOVING; - procedure WMSizing(var Msg: TMessage); message WM_SIZING; - function FGetPositinoColor: TFigureColor; + function FGetLastMove: PMoveAbs; + property lastMove: PMoveAbs read FGetLastMove; + function FGetPosition: PChessPosition; + property Position: PChessPosition read FGetPosition; + function AskPromotionFigure(FigureColor: TFigureColor): TFigureName; - function FGetLastMove: PMoveAbs; + procedure FSetMode(const Value: TMode); + + function FDoMove(i, j: integer; prom_fig: TFigureName = K): boolean; + procedure FOnAfterMoveDone; + procedure FOnAfterSetPosition; + + procedure FAnimate(const i, j: integer); // Animates a disposition of a piece from (i0,j0) to (i,j) + procedure FDoAnimationStep; + procedure FEndAnimation; + procedure FWhatSquare(const P: TPoint; var i: Integer; var j: Integer); + + procedure FSetPlayerColor(const Value: TFigureColor); + procedure FCancelAnimationDragging; // Caneling of animation and dragging for trace removal after draw + procedure FSetFlipped(Value: boolean); // Flips chess position + procedure FSetCoordinatesShown(Value: boolean); + procedure FSetLastMoveHilighted(Value: boolean); function FGetPositionsList: TList; + function FGetPositionColor: TFigureColor; + function FGetMoveNotationFormat: TMoveNotationFormat; + procedure FSetMoveNotationFormat(Value: TMoveNotationFormat); + function FGetFENFormat: boolean; + procedure FSetFENFormat(bValue: boolean); - procedure FOnAfterMoveDone; + procedure FDrawHiddenBoard; + function FGetHiddenBoardCanvas: TCanvas; - property ChessRulesEngine: TChessRulesEngine read m_ChessRulesEngine; - property Position: PChessPosition read FGetPosition; + procedure FDrawBoard; + procedure FOnDrawLayerUpdate(const ADrawLayer: TChessBoardLayerBase); - property lastMove: PMoveAbs read FGetLastMove; + function FGetMovesOffset: integer; + function FGetColorStarts: TFigureColor; - protected - iSquareSize: integer; // Size of a chess board field - bmHiddenBoard: TBitmap; - procedure RDrawBoard; + procedure WMSizing(var Msg: TMessage); message WM_SIZING; - procedure RDrawHiddenBoard; virtual; - procedure ROnAfterSetPosition; virtual; - function RDoMove(i, j: integer; prom_fig: TFigureName = K): boolean; - procedure ROnAfterMoveDone; virtual; + procedure FDoHandler(e: TChessBoardEvent; d1: pointer = nil; d2: pointer = nil); - property PositionsList: TList read FGetPositionsList; + property SquareSize: integer read m_iSquareSize; + property PositionsList: TList read FGetPositionsList; public - constructor Create(Owner: TComponent; h: TChessBoardHandler = nil); reintroduce; + constructor Create(Owner: TComponent; AHandler: TChessBoardHandler = nil); reintroduce; - procedure TakeBack; // взятие хода обратно - procedure SwitchClock(clock_color: TFigureColor); + function DoMove(const strMove: string): boolean; + procedure ResetMoveList; + function SetPosition(const strPosition: string): boolean; + function GetPosition: string; procedure InitPosition; procedure PPRandom; - procedure StopClock; + procedure TakeBack; + function NMoveDone: integer; + function NPlysDone: integer; - procedure ResetMoveList; - function SetPosition(const posstr: string): boolean; - function GetPosition: string; - function NMoveDone: integer; // количество сделанных ходов - function DoMove(move_str: string): boolean; - procedure Shut; - - property Unlimited[color: TFigureColor]: boolean read GetUnlimited write SetUnlimited; - property Time[color: TFigureColor]: TDateTime read GetTime write SetTime; - property PlayerColor: TFigureColor read player_color write SetPlayerColor; - property PositionColor: TFigureColor read FGetPositinoColor; // чей ход в текущей позиции - property ClockColor: TFigureColor read clock_color; - property Mode: TMode read mode_var write SetMode; - property CoordinatesShown: boolean read coord_show write SetCoordinates; - - property flipped: boolean read _flipped write SetFlipped; - property LastMoveHilighted: boolean read last_hilight write SetHilightLastMove; - property FlashOnMove: boolean read m_bFlash_move write m_bFlash_move; - property StayOnTop: boolean read GetStayOnTop write SetStayOnTop; - property AutoFlag: boolean read auto_flag write SetAutoFlag; - property animation: TAnimation read m_animation write m_animation; + function IsMoveAnimating: boolean; + + procedure BeginUpdate; + procedure EndUpdate; + + procedure AddLayer(const ALayer: TChessBoardLayerBase); + procedure RemoveLayer(const ALayer: TChessBoardLayerBase); + + property PlayerColor: TFigureColor read m_PlayerColor write FSetPlayerColor; + property Mode: TMode read m_Mode write FSetMode; + property CoordinatesShown: boolean read coord_show write FSetCoordinatesShown; + property Flipped: boolean read _flipped write FSetFlipped; + property LastMoveHilighted: boolean read last_hilight write FSetLastMoveHilighted; + property Animation: TAnimation read m_animation write m_animation; property ViewGaming: boolean read m_bViewGaming write m_bViewGaming; + property PositionColor: TFigureColor read FGetPositionColor; // Whos move it is in the current position + property MoveNotationFormat: TMoveNotationFormat + read FGetMoveNotationFormat write FSetMoveNotationFormat; + property MovesOffset: integer read FGetMovesOffset; + property FENFormat: boolean read FGetFENFormat write FSetFENFormat; + property EditPiece: TFigure read m_EditPiece write m_EditPiece; end; -implementation -{$J+} + TChessBoardLayerBase = class + private + m_ChessBoard: TChessBoard; + function FGetSquareSize: integer; + function FGetCanvas: TCanvas; + function FGetPosition: PChessPosition; + function FGetPositionsList: TList; + protected + procedure RDraw; virtual; abstract; + function RGetColorStarts: TFigureColor; + + procedure RDoUpdate; + + procedure ROnAfterMoveDone; virtual; + procedure ROnAfterSetPosition; virtual; + procedure ROnAfterModeSet(const OldValue, NewValue: TMode); virtual; + procedure ROnResetMoveList; virtual; + + property ChessBoard: TChessBoard read m_ChessBoard write m_ChessBoard; + property SquareSize: integer read FGetSquareSize; + property Canvas: TCanvas read FGetCanvas; + property Position: PChessPosition read FGetPosition; + property PositionsList: TList read FGetPositionsList; + end; + +implementation {$R *.dfm} uses - StrUtils, Math, DateUtils, - // Chess4Net - PromotionUnit; + Math, SysUtils, Windows, + // + ChessBoardHeaderUnit; const HILIGHT_WIDTH = 1; HILIGHT_COLOR: TColor = clRed; HILIGHT_LAST_MOVE_WIDTH = 1; HILIGHT_LAST_MOVE_COLOR: TColor = clBlue; - ANIMATION_SLOW = 30; // Время анимации хода в фреймах >= 1 + ANIMATION_SLOW = 30; // Time of animation in frames >= 1 ANIMATION_QUICK = 9; CHB_WIDTH = 4; - TIME_COLOR = clBlack; -// FULL_TIME_FORMAT = 'h:n:s"."z'; - HOUR_TIME_FORMAT = 'h:nn:ss'; - MIN_TIME_FORMAT = 'n:ss'; - ZEITNOT_BOARDER = 10; // сек - цетйтнотная граница - ZEITNOT_COLOR = clMaroon; - ZEITNOT_FORMAT = 's"."zzz'; -// CHEAT_TIME_CONST = 1.5; // > 1 - WHITE_LONG_LABEL: WideString = 'White '; - WHITE_MEDIUM_LABEL: WideString = 'White '; - WHITE_SHORT_LABEL: WideString = 'W '; - BLACK_LONG_LABEL: WideString = 'Black '; - BLACK_MEDIUM_LABEL: WideString = 'Black '; - BLACK_SHORT_LABEL: WideString = 'B '; //////////////////////////////////////////////////////////////////////////////// -// Globals +// TChessBoard -function TChessBoard.DoMove(move_str: string): boolean; +constructor TChessBoard.Create(Owner: TComponent; AHandler: TChessBoardHandler = nil); begin - // Отмена анимации - if (AnimateTimer.Enabled) then - begin - AnimateTimer.Enabled := FALSE; - anim_step := anim_step_num; - AnimateTimerTimer(nil); - end; + FHandler := AHandler; + inherited Create(Owner); +end; - Result := ChessRulesEngine.DoMove(move_str); - if (Result) then - begin - FOnAfterMoveDone; - Animate(lastMove.i, lastMove.j); - SwitchClock(PositionColor); - if (m_bFlash_move and (mode_var = mGame)) then - FFlashWindow; - end; +procedure TChessBoard.AnimateTimerTimer(Sender: TObject); +begin + FDoAnimationStep; + if (m_iAnimStep >= m_iAnimStepsCount) then + FEndAnimation; end; -procedure TChessBoard.ShowTime(const c: TFigureColor); +procedure TChessBoard.FDoAnimationStep; var - time_label: TLabel; + iX, iY: integer; + rect: TRect; begin - if c = fcWhite then time_label:= WhiteTimeLabel - else time_label:= BlackTimeLabel; - - if unlimited_var[c] then - begin - time_label.Caption:= ''; - exit; - end; + if (m_iAnimStep < m_iAnimStepsCount) then + begin + inc(m_iAnimStep); - time_label.Font.Color:= TIME_COLOR; + iX := round(x0 + anim_dx * m_iAnimStep); + iY := round(y0 + anim_dy * m_iAnimStep); + dx := iX - x0 - Round(anim_dx * m_iPrevAnimStep); + dy := iY - y0 - Round(anim_dy * m_iPrevAnimStep); - LongTimeFormat:= MIN_TIME_FORMAT; - if player_time[c] >= EncodeTime(1, 0, 0, 0) then - LongTimeFormat:= HOUR_TIME_FORMAT - else - if (player_time[c] < EncodeTime(0, 0, ZEITNOT_BOARDER, 0)) and - (player_time[c] > 0) then - begin - LongTimeFormat:= ZEITNOT_FORMAT; - time_label.Font.Color:= ZEITNOT_COLOR; - end; + // Восстановить фрагмент на m_bmHiddenBoard + m_bmHiddenBoard.Canvas.Draw(iX - dx, iY - dy, m_bmBuf); + // Копировать новый фрагмент в буфер + m_bmBuf.Canvas.CopyRect(Bounds(0, 0, m_iSquareSize, m_iSquareSize), + m_bmHiddenBoard.Canvas, Bounds(iX, iY, m_iSquareSize, m_iSquareSize)); + // Нарисовать перетаскиваемую фигуру в новой позиции + m_bmHiddenBoard.Canvas.Draw(iX, iY, m_bmFigure[m_fig]); + // Перенести новый фрагмент на экран + rect := Bounds(Min(iX - dx, iX), Min(iY - dy, iY), + abs(dx) + m_iSquareSize, abs(dy) + m_iSquareSize); + PBoxBoard.Canvas.CopyRect(rect, m_bmHiddenBoard.Canvas, rect); + end; - time_label.Caption:= TimeToStr(player_time[c]); + m_iPrevAnimStep := m_iAnimStep; + end; - -procedure TChessBoard.SetFlipped(const f: boolean); +procedure TChessBoard.FEndAnimation; begin - // TODO: ??? - _flipped:= f; - RDrawBoard; -end; + AnimateTimer.Enabled := FALSE; + m_iAnimStep := m_iAnimStepsCount; -procedure TChessBoard.ResetMoveList; -begin - ChessRulesEngine.ResetMoveList; + FDrawBoard; + HilightLastMove; + Evaluate; end; -function TChessBoard.SetPosition(const posstr: string): boolean; +procedure TChessBoard.FDrawBoard; +var + i: integer; begin - Result := ChessRulesEngine.SetPosition(posstr); - if (not Result) then + if (csDestroying in ComponentState) then exit; - FCancelAnimationDragging; - ROnAfterSetPosition; - clock_color := Position.color; - RDrawBoard; -end; + if (m_iUpdateCounter > 0) then + exit; + FDrawHiddenBoard; -function TChessBoard.GetPosition: string; -begin - Result := ChessRulesEngine.GetPosition; + for i := 0 to m_lstLayers.Count - 1 do + TChessBoardLayerBase(m_lstLayers[i]).RDraw; + + PBoxBoardPaint(nil); end; -procedure TChessBoard.FormCreate(Sender: TObject); +procedure TChessBoard.HilightLastMove; +var + i, j, l, + _i0, _j0, x, y: integer; begin - m_iDeltaWidthHeight := Width - Height; - - m_iTimePanelInitialWidth := TimePanel.Width; - m_iWhitePanelInitialLeft := WhitePanel.Left; - m_iWhitePanelInitialWidth := WhitePanel.Width; - m_iBlackPanelInitialLeft := BlackPanel.Left; - m_iBlackPanelInitialWidth := BlackPanel.Width; - - m_TimeFont := TFont.Create; - m_TimeFont.Assign(WhiteTimeLabel.Font); - - m_BitmapRes := TBitmapRes.Create(Size(PBoxBoard.Width, PBoxBoard.Height)); - - BlackFlagButton.Glyph := WhiteFlagButton.Glyph; // чтоб не тащить лишнего - coord_show:= TRUE; - last_hilight:= FALSE; - m_animation := aQuick; - - TLocalizer.Instance.AddSubscriber(self); - FLocalize; + if (not (m_Mode in [mGame, mAnalyse])) then + exit; + + // Output the last move done + if (last_hilight and (lastMove.i0 <> 0)) then + begin + if (_flipped) then + begin + _i0 := 9 - lastMove.i0; + _j0 := lastMove.j0; + i := 9 - lastMove.i; + j := lastMove.j; + end + else + begin + _i0 := lastMove.i0; + _j0 := 9 - lastMove.j0; + i := lastMove.i; + j := 9 - lastMove.j; + end; - m_ChessRulesEngine := TChessRulesEngine.Create(self); + x := m_iSquareSize * (_i0 - 1) + CHB_X; + y := m_iSquareSize * (_j0 - 1) + CHB_Y; + m_bmHiddenBoard.Canvas.Pen.Color := HILIGHT_LAST_MOVE_COLOR; + m_bmHiddenBoard.Canvas.Pen.Width := HILIGHT_LAST_MOVE_WIDTH; - // Clock initialization - SetUnlimited(fcWhite, TRUE); SetUnlimited(fcBlack, TRUE); + for l := 1 to 2 do + with m_bmHiddenBoard.Canvas do + begin + MoveTo(x, y); + LineTo(x + m_iSquareSize - 1, y); + LineTo(x + m_iSquareSize - 1, y + m_iSquareSize - 1); + LineTo(x, y + m_iSquareSize - 1); + LineTo(x, y); - InitPosition; + x := m_iSquareSize * (i - 1) + CHB_X; + y := m_iSquareSize * (j - 1) + CHB_Y; + end; + PBoxBoardPaint(nil); + end; end; -procedure TChessBoard.RDrawHiddenBoard; +procedure TChessBoard.FDrawHiddenBoard; var i, j: integer; x, y: integer; begin - if (not Assigned(bmHiddenBoard)) then + if (not Assigned(m_bmHiddenBoard)) then exit; // Copy empty board to the hidden one - with bmHiddenBoard do + with m_bmHiddenBoard do begin Canvas.CopyRect(Bounds(0,0, Width,Height), m_bmChessBoard.Canvas, Bounds(0,0, Width,Height)); end; // Draw coordinates if (coord_show) then - with bmHiddenBoard, bmHiddenBoard.Canvas do + with m_bmHiddenBoard, m_bmHiddenBoard.Canvas do begin - x:= CHB_X + iSquareSize div 2; - y:= (bmHiddenBoard.Height + CHB_Y + 8 * iSquareSize + CHB_WIDTH) div 2; + x:= CHB_X + m_iSquareSize div 2; + y:= (m_bmHiddenBoard.Height + CHB_Y + 8 * m_iSquareSize + CHB_WIDTH) div 2; if _flipped then j := ord('h') else j:= ord('a'); for i:= 1 to 8 do // буквы begin TextOut(x - TextWidth(chr(j)) div 2, y + 1 - TextHeight(chr(j)) div 2 , chr(j)); - x := x + iSquareSize; + x := x + m_iSquareSize; if _flipped then dec(j) else inc(j); end; x:= (CHB_X - CHB_WIDTH) div 2; - y:= CHB_Y + iSquareSize div 2; + y:= CHB_Y + m_iSquareSize div 2; if _flipped then j:= ord('1') else j := ord('8'); for i := 1 to 8 do // цифры begin TextOut(x - TextWidth(chr(j)) div 2, y - TextHeight(chr(j)) div 2, chr(j)); - y:= y + iSquareSize; + y:= y + m_iSquareSize; if _flipped then inc(j) else dec(j); end; @@ -417,251 +403,171 @@ begin if ((Position.board[i,j] = ES)) then continue; // There's nothing to draw if not _flipped then // Загрузить нужную фигуру из ресурса и нарисовать - bmHiddenBoard.Canvas.Draw(CHB_X + iSquareSize * (i-1), - CHB_Y + iSquareSize * (8-j), + m_bmHiddenBoard.Canvas.Draw(CHB_X + m_iSquareSize * (i-1), + CHB_Y + m_iSquareSize * (8-j), m_bmFigure[Position.board[i,j]]) else // Black is below - bmHiddenBoard.Canvas.Draw(CHB_X + iSquareSize * (8-i), - CHB_Y + iSquareSize * (j-1), + m_bmHiddenBoard.Canvas.Draw(CHB_X + m_iSquareSize * (8-i), + CHB_Y + m_iSquareSize * (j-1), m_bmFigure[Position.board[i,j]]); end; end; -procedure TChessBoard.RDrawBoard; +function TChessBoard.FGetHiddenBoardCanvas: TCanvas; begin - RDrawHiddenBoard; - PBoxBoardPaint(nil); + if (Assigned(m_bmHiddenBoard)) then + Result := m_bmHiddenBoard.Canvas + else + Result := nil; end; -procedure TChessBoard.PBoxBoardPaint(Sender: TObject); +procedure TChessBoard.Evaluate; begin - PBoxBoard.Canvas.Draw(0,0, bmHiddenBoard); // Вывод скрытой доски на форму -// PBoxBoard.Canvas.StretchDraw(Bounds(0, 0, PBoxBoard.Width, PBoxBoard.Height), bmHiddenBoard); + case m_ChessRulesEngine.GetEvaluation of + evMate: + FDoHandler(cbeMate, self); + evStaleMate: + FDoHandler(cbeStaleMate, self); + end; end; -constructor TChessBoard.Create(Owner: TComponent; h: TChessBoardHandler); +procedure TChessBoard.PBoxBoardPaint(Sender: TObject); begin - inherited Create(Owner); - Handler:= h; + PBoxBoard.Canvas.Draw(0, 0, m_bmHiddenBoard); // Draw hidden board on the form +// PBoxBoard.Canvas.StretchDraw(Bounds(0, 0, PBoxBoard.Width, PBoxBoard.Height), m_bmHiddenBoard); end; -procedure TChessBoard.FormDestroy(Sender: TObject); -var - _fig: TFigure; +function TChessBoard.FGetLastMove: PMoveAbs; begin - m_ChessRulesEngine.Free; - - bmHiddenBoard.Free; - m_bmBuf.Free; - - for _fig := Low(TFigure) to High(TFigure) do - m_bmFigure[_fig].Free; - m_bmChessBoard.Free; + Result := m_ChessRulesEngine.lastMove; +end; - m_BitmapRes.Free; - m_TimeFont.Free; - TLocalizer.Instance.DeleteSubscriber(self); +function TChessBoard.FGetPosition: PChessPosition; +begin + Result := m_ChessRulesEngine.Position; end; -procedure TChessBoard.PBoxBoardDragDrop(Sender, Source: TObject; X, - Y: Integer); +function TChessBoard.AskPromotionFigure(FigureColor: TFigureColor): TFigureName; var - i, j: Integer; + frmOwner: TForm; begin - WhatSquare(Point(X, Y), i, j); - if (Mode = mGame) then + if (Owner is TForm) then + frmOwner := TForm(Owner) + else + frmOwner := self; + + if (Showing) then begin - if (RDoMove(i, j)) then - begin - SwitchClock(PositionColor); - dragged_moved:= TRUE; + m_PromotionForm := TPromotionForm.Create(frmOwner, m_BitmapRes); + try + Result := m_PromotionForm.ShowPromotion(FigureColor); + finally + FreeAndNil(m_PromotionForm); end; - end; // if + end + else + Result := Q; end; -procedure TChessBoard.PBoxBoardDragOver(Sender, Source: TObject; X, - Y: Integer; State: TDragState; var Accept: Boolean); -var - rect: TRect; - i, j: integer; +procedure TChessBoard.FSetPlayerColor(const Value: TFigureColor); begin - case State of - dsDragEnter: - hilighted:= FALSE; - dsDragMove: - begin - // Восстановить фрагмент на bmHiddenBoard - bmHiddenBoard.Canvas.Draw(x0 - dx, y0 - dy, m_bmBuf); - // Копировать новый фрагмент в буфер - m_bmBuf.Canvas.CopyRect(Bounds(0, 0, iSquareSize, iSquareSize), - bmHiddenBoard.Canvas, Bounds(X - dx, Y - dy, iSquareSize, iSquareSize)); - // Нарисовать перетаскиваемую фигуру в новой позиции - bmHiddenBoard.Canvas.Draw(X - dx, Y - dy, m_bmFigure[m_fig]); - // Перенести новый фрагмент на экран - rect:= Bounds(Min(x0,X) - dx, Min(y0, Y) - dy, - abs(X - x0) + iSquareSize, abs(Y - y0) + iSquareSize); - PBoxBoard.Canvas.CopyRect(rect, bmHiddenBoard.Canvas, rect); - - x0 := X; - y0 := Y; - - WhatSquare(Point(X,Y), i,j); - - Accept := ((i in [1..8]) and (j in [1..8])); - end; - end; + FCancelAnimationDragging; + m_PlayerColor := Value; + if (m_PlayerColor = fcWhite) then + FSetFlipped(FALSE) + else // fcBlack + FSetFlipped(TRUE); end; -procedure TChessBoard.PBoxBoardEndDrag(Sender, Target: TObject; X, - Y: Integer); +procedure TChessBoard.FCancelAnimationDragging; begin - if hilighted then - with bmHiddenBoard.Canvas do - begin - Pen.Color:= HILIGHT_COLOR; - Pen.Width := HILIGHT_WIDTH; - x0:= x0 - dx; - y0:= y0 - dy; - MoveTo(x0,y0); - LineTo(x0 + iSquareSize - 1, y0); - LineTo(x0 + iSquareSize - 1, y0 + iSquareSize - 1); - LineTo(x0, y0 + iSquareSize - 1); - LineTo(x0,y0); - - PBoxBoardPaint(nil); - end - else - begin - RDrawBoard; - if dragged_moved then - begin - HilightLastMove; - Evaluate; - dragged_moved:= FALSE; - end; - end; + // Cancel animation and dragging + if (AnimateTimer.Enabled) then + begin + AnimateTimer.Enabled := FALSE; + // iAnimStep := iAnimStepsCount; + // AnimateTimerTimer(nil); + end; + + if (PBoxBoard.Dragging) then + begin + m_bDraggedMoved := FALSE; + PBoxBoard.EndDrag(FALSE); + end; end; -procedure TChessBoard.WhatSquare(const P: TPoint; - var i: Integer; var j: Integer); +procedure TChessBoard.FSetFlipped(Value: boolean); begin - with P do - begin - i := (X - CHB_X + iSquareSize) div iSquareSize; - j := 8 - (Y - CHB_Y) div iSquareSize; - if (_flipped) then - begin - i := 9 - i; - j := 9 - j; - end; - end; + // TODO: ??? + _flipped := Value; + FDrawBoard; end; -procedure TChessBoard.PBoxBoardMouseDown(Sender: TObject; - Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +procedure TChessBoard.FSetMode(const Value: TMode); var - i, j: Integer; - f: TFigure; + OldMode: TMode; + i: integer; begin - WhatSquare(Point(X, Y), i, j); - if (not ((i in [1..8]) and (j in [1..8]))) then + if (m_Mode = Value) then exit; - f := Position.board[i,j]; - - case Mode of - mGame: - begin - if (ViewGaming) then - exit; - if (Button <> mbLeft) or (Position.color <> player_color) or - (((Position.color <> fcWhite) or (f >= ES)) and - ((Position.color <> fcBlack) or (f <= ES))) then - exit; - end; - else - exit; - end; + OldMode := m_Mode; + m_Mode := Value; - if (anim_step < anim_step_num) then - begin - anim_step:= anim_step_num; - AnimateTimerTimer(nil); - end; + if ((m_Mode in [mView, mEdit]) and (Assigned(m_PromotionForm))) then + m_PromotionForm.Close; - if ((i = m_i0) and (j = m_j0)) then - hilighted := (hilighted xor TRUE) - else - hilighted:= TRUE; + for i := 0 to m_lstLayers.Count - 1 do + TChessBoardLayerBase(m_lstLayers[i]).ROnAfterModeSet(OldMode, m_Mode); - m_fig := f; - m_i0 := i; - m_j0 := j; + FDrawBoard; + HilightLastMove; +end; - dx := (X - CHB_X) mod iSquareSize; - dy := (Y - CHB_Y) mod iSquareSize; - x0 := X; - y0 := Y; - dragged_moved := TRUE; - PBoxBoard.BeginDrag(FALSE); +procedure TChessBoard.FSetCoordinatesShown(Value: boolean); +begin + coord_show := Value; + FDrawBoard; + HilightLastMove; end; -procedure TChessBoard.PBoxBoardMouseMove(Sender: TObject; - Shift: TShiftState; X, Y: Integer); -var - f: TFigure; - i,j: Integer; +procedure TChessBoard.FSetLastMoveHilighted(Value: boolean); begin - WhatSquare(Point(X,Y), i,j); - if (not ((i in [1..8]) and (j in [1..8]))) then - begin - PBoxBoard.Cursor:= crDefault; - exit; - end; + last_hilight := Value; + FDrawBoard; + HilightLastMove; +end; - f := Position.board[i,j]; - case Mode of - mGame: - begin - if (ViewGaming) then - exit; - - if (player_color = Position.color) and - (((Position.color = fcWhite) and (f < ES)) or - ((Position.color = fcBlack) and (f > ES))) then - PBoxBoard.Cursor:= crHandPoint - else - PBoxBoard.Cursor:= crDefault; - end; +function TChessBoard.DoMove(const strMove: string): boolean; +begin + Result := FALSE; - else - PBoxBoard.Cursor:= crDefault; - end; -end; + if (m_Mode = mEdit) then + exit; + // Animation canceling + if (AnimateTimer.Enabled) then + FEndAnimation; -procedure TChessBoard.ROnAfterMoveDone; -var - strLastMove: string; -begin - if (Assigned(Handler) and - ((Mode = mGame) and (Position.color <> player_color))) then + Result := m_ChessRulesEngine.DoMove(strMove); + + if (Result) then begin - strLastMove := ChessRulesEngine.LastMoveStr; - Handler(cbeMoved, @strLastMove, self); + FOnAfterMoveDone; + FAnimate(lastMove.i, lastMove.j); end; end; @@ -669,6 +575,8 @@ end; procedure TChessBoard.FOnAfterMoveDone; var _fig: TFigure; + strLastMove: string; + i: integer; begin m_i0 := lastMove.i0; m_j0 := lastMove.j0; @@ -684,499 +592,615 @@ begin else m_fig := _fig; - ROnAfterMoveDone; -end; + strLastMove := m_ChessRulesEngine.LastMoveStr; + FDoHandler(cbeMoved, @strLastMove, self); + if (m_Mode = mAnalyse) then + m_PlayerColor := PositionColor; -function TChessBoard.RDoMove(i, j: integer; prom_fig: TFigureName = K): boolean; -begin - Result := ChessRulesEngine.DoMove(m_i0, m_j0, i, j, prom_fig); - if (Result) then - FOnAfterMoveDone; + for i := 0 to m_lstLayers.Count - 1 do + TChessBoardLayerBase(m_lstLayers[i]).ROnAfterMoveDone; end; -function TChessBoard.FGetPositionsList: TList; -begin - Result := ChessRulesEngine.PositionsList; -end; - - -procedure TChessBoard.PBoxBoardMouseUp(Sender: TObject; - Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +procedure TChessBoard.FAnimate(const i, j: integer); var - i, j: integer; -begin - case Button of - mbLeft: - case Mode of - mGame: - begin - if (not hilighted) then - exit; - WhatSquare(Point(X, Y), i, j); - if (dragged_moved) then - RDrawBoard - else - begin - hilighted:= FALSE; - if (RDoMove(i, j)) then - begin - Animate(i, j); - SwitchClock(PositionColor); - end - else - RDrawBoard; - end; - end; - end; - - mbRight: - if (Assigned(Handler)) then - Handler(cbeMenu, self); - end; -end; - -procedure TChessBoard.PBoxBoardStartDrag(Sender: TObject; - var DragObject: TDragObject); + x, y: integer; begin - // Копировать изображение пустого поля в m_bmBuf - m_bmBuf.Width:= iSquareSize; m_bmBuf.Height:= iSquareSize; - if (((m_i0 + m_j0) and 1) <> 0) then - m_bmBuf.Canvas.CopyRect(Bounds(0,0, iSquareSize, iSquareSize), - m_bmFigure[ES].Canvas, Bounds(0,0, iSquareSize, iSquareSize)) - else - m_bmBuf.Canvas.CopyRect(Bounds(0,0, iSquareSize, iSquareSize), - m_bmFigure[ES].Canvas, Bounds(iSquareSize,0, iSquareSize, iSquareSize)); - - dragged_moved:= FALSE; -end; + if (not Showing) then + exit; + if ((m_i0 = 0) or (m_j0 = 0)) then + exit; -procedure TChessBoard.Animate(const i, j: integer); -var - x, y: integer; -begin - if not Showing then exit; + if (AnimateTimer.Enabled) then + begin + m_iAnimStep := m_iAnimStepsCount; + exit; + end; case animation of - aNo: anim_step_num:= 1; - aSlow: anim_step_num:= ANIMATION_SLOW; - aQuick: anim_step_num:= ANIMATION_QUICK; + aNo: + m_iAnimStepsCount := 1; + aSlow: + m_iAnimStepsCount := ANIMATION_SLOW; + aQuick: + m_iAnimStepsCount := ANIMATION_QUICK; end; if (_flipped) then begin - x0 := (8 - m_i0) * iSquareSize + CHB_X; - y0 := (m_j0 - 1) * iSquareSize + CHB_Y; - x := (8 - i) * iSquareSize + CHB_X; - y := (j - 1) * iSquareSize + CHB_Y; + x0 := (8 - m_i0) * m_iSquareSize + CHB_X; + y0 := (m_j0 - 1) * m_iSquareSize + CHB_Y; + x := (8 - i) * m_iSquareSize + CHB_X; + y := (j - 1) * m_iSquareSize + CHB_Y; end else begin - x0:= (m_i0 - 1) * iSquareSize + CHB_X; - y0:= (8 - m_j0) * iSquareSize + CHB_Y; - x:= (i - 1) * iSquareSize + CHB_X; - y:= (8 - j) * iSquareSize + CHB_Y; + x0 := (m_i0 - 1) * m_iSquareSize + CHB_X; + y0 := (8 - m_j0) * m_iSquareSize + CHB_Y; + x := (i - 1) * m_iSquareSize + CHB_X; + y := (8 - j) * m_iSquareSize + CHB_Y; end; - anim_dx:= (x-x0) / anim_step_num; - anim_dy:= (y-y0) / anim_step_num; + anim_dx := (x - x0) / m_iAnimStepsCount; + anim_dy := (y - y0) / m_iAnimStepsCount; - anim_step:= 0; + m_iAnimStep := 0; + m_iPrevAnimStep := m_iAnimStep; - // Копировать изображение пустого поля в m_bmBuf - m_bmBuf.Width := iSquareSize; - m_bmBuf.Height := iSquareSize; + // Copy image of the empty square to m_bmBuf + m_bmBuf.Width := m_iSquareSize; + m_bmBuf.Height := m_iSquareSize; if (((m_i0 + m_j0) and 1) <> 0) then - m_bmBuf.Canvas.CopyRect(Bounds(0, 0, iSquareSize, iSquareSize), - m_bmFigure[ES].Canvas, Bounds(0, 0, iSquareSize, iSquareSize)) + m_bmBuf.Canvas.CopyRect(Bounds(0, 0, m_iSquareSize, m_iSquareSize), + m_bmFigure[ES].Canvas, Bounds(0, 0, m_iSquareSize, m_iSquareSize)) else - m_bmBuf.Canvas.CopyRect(Bounds(0, 0, iSquareSize, iSquareSize), - m_bmFigure[ES].Canvas, Bounds(iSquareSize, 0, iSquareSize, iSquareSize)); + m_bmBuf.Canvas.CopyRect(Bounds(0, 0, m_iSquareSize, m_iSquareSize), + m_bmFigure[ES].Canvas, Bounds(m_iSquareSize, 0, m_iSquareSize, m_iSquareSize)); AnimateTimer.Enabled := TRUE; end; -procedure TChessBoard.AnimateTimerTimer(Sender: TObject); +procedure TChessBoard.ResetMoveList; var - X,Y: integer; - rect: TRect; + i: integer; begin - inc(anim_step); - if (anim_step < anim_step_num) then - begin - X := round(x0 + anim_dx * anim_step); - Y := round(y0 + anim_dy * anim_step); - dx := X - x0 - round(anim_dx * (anim_step - 1)); - dy := Y - y0 - round(anim_dy * (anim_step - 1)); + m_ChessRulesEngine.ResetMoveList; - // Восстановить фрагмент на bmHiddenBoard - bmHiddenBoard.Canvas.Draw(X - dx, Y - dy, m_bmBuf); - // Копировать новый фрагмент в буфер - m_bmBuf.Canvas.CopyRect(Bounds(0, 0, iSquareSize, iSquareSize), - bmHiddenBoard.Canvas, Bounds(X, Y, iSquareSize, iSquareSize)); - // Нарисовать перетаскиваемую фигуру в новой позиции - bmHiddenBoard.Canvas.Draw(X, Y, m_bmFigure[m_fig]); - // Перенести новый фрагмент на экран - rect := Bounds(Min(X - dx, X), Min(Y - dy, Y), - abs(dx) + iSquareSize, abs(dy) + iSquareSize); - PBoxBoard.Canvas.CopyRect(rect, bmHiddenBoard.Canvas, rect); - end - else + for i := 0 to m_lstLayers.Count - 1 do + TChessBoardLayerBase(m_lstLayers[i]).ROnResetMoveList; +end; + + +function TChessBoard.SetPosition(const strPosition: string): boolean; +begin + Result := m_ChessRulesEngine.SetPosition(strPosition); + if (Result) then begin - AnimateTimer.Enabled := FALSE; - RDrawBoard; - HilightLastMove; - Evaluate; + FCancelAnimationDragging; + FOnAfterSetPosition; + FDrawBoard; end; end; -procedure TChessBoard.InitPosition; +function TChessBoard.GetPosition: string; begin - ChessRulesEngine.InitNewGame; - RDrawBoard; + Result := m_ChessRulesEngine.GetPosition; end; -procedure TChessBoard.SetMode(const m: TMode); +procedure TChessBoard.FOnAfterSetPosition; +var + strPosition: string; + i: integer; begin - mode_var := m; - RDrawBoard; - HilightLastMove; - if (mode_var <> mGame) then - begin - WhiteFlagButton.Visible := FALSE; - BlackFlagButton.Visible := FALSE; + case m_Mode of + mAnalyse: + m_PlayerColor := PositionColor; + + mEdit: + ResetMoveList; end; + + m_i0 := 0; + m_j0 := 0; + + strPosition := GetPosition; + FDoHandler(cbePosSet, @strPosition, self); + + for i := 0 to m_lstLayers.Count - 1 do + TChessBoardLayerBase(m_lstLayers[i]).ROnAfterSetPosition; end; -procedure TChessBoard.SetTime(color: TFigureColor; const tm: TDateTime); +procedure TChessBoard.FormCreate(Sender: TObject); begin - if (not Unlimited[color]) then - begin - if ((not auto_flag) and (not ViewGaming)) then - begin - case color of - fcWhite: - WhiteFlagButton.Visible := ((player_color = fcBlack) and (tm = 0.0)); - fcBlack: - BlackFlagButton.Visible := ((player_color = fcWhite) and (tm = 0.0)); - end; - end; - player_time[color]:= tm; - ShowTime(color); - end; + // m_iDeltaWidthHeight := Width - Height; + + m_BitmapRes := TBitmapRes.Create(Size(PBoxBoard.Width, PBoxBoard.Height)); + + coord_show:= TRUE; + last_hilight:= FALSE; + m_animation := aQuick; + + m_ChessRulesEngine := TChessRulesEngine.Create(self); + m_lstLayers := TList.Create; end; -function TChessBoard.GetTime(color: TFigureColor): TDateTime; +procedure TChessBoard.FormDestroy(Sender: TObject); +var + _fig: TFigure; + i: integer; begin - Result:= player_time[color]; + for i := m_lstLayers.Count - 1 downto 0 do + RemoveLayer(m_lstLayers[i]); + m_lstLayers.Free; + + m_ChessRulesEngine.Free; + + m_bmHiddenBoard.Free; + m_bmBuf.Free; + + for _fig := Low(TFigure) to High(TFigure) do + m_bmFigure[_fig].Free; + m_bmChessBoard.Free; + + m_BitmapRes.Free; end; -procedure TChessBoard.GameTimerTimer(Sender: TObject); +procedure TChessBoard.PBoxBoardDragDrop(Sender, Source: TObject; X, + Y: Integer); +var + i, j: Integer; begin - if unlimited_var[clock_color] then + FWhatSquare(Point(X, Y), i, j); + case m_Mode of + mGame, mAnalyse: begin - GameTimer.Enabled := FALSE; - exit; + if (FDoMove(i, j)) then + m_bDraggedMoved := TRUE; end; - // TODO: cheating check - player_time[clock_color] := player_time[clock_color] - (Now - past_time); - if player_time[clock_color] <= 0.0 then - begin - player_time[clock_color] := 0.0; - ShowTime(clock_color); - if ((not auto_flag) and (player_color <> clock_color) and (not ViewGaming)) then - begin - case clock_color of - fcWhite: - WhiteFlagButton.Visible := TRUE; - fcBlack: - BlackFlagButton.Visible := TRUE; - end; - end; - if ((player_color <> clock_color) and Assigned(Handler) and (Mode = mGame) and (auto_flag)) then - Handler(cbeTimeOut, self); - GameTimer.Enabled := FALSE; - end; -{$IFNDEF THREADED_CHESSCLOCK} - ShowTime(clock_color); -{$ENDIF} - past_time:= Now; + mEdit: + m_bDraggedMoved := TRUE; + end; end; -procedure TChessBoard.SetUnlimited(color: TFigureColor; const unl: boolean); +procedure TChessBoard.FWhatSquare(const P: TPoint; + var i: Integer; var j: Integer); begin - unlimited_var[color]:= unl; - ShowTime(color); + with P do + begin + i := (X - CHB_X + m_iSquareSize) div m_iSquareSize; + j := 8 - (Y - CHB_Y) div m_iSquareSize; + if (_flipped) then + begin + i := 9 - i; + j := 9 - j; + end; + end; end; -function TChessBoard.GetUnlimited(color: TFigureColor): boolean; +function TChessBoard.FDoMove(i, j: integer; prom_fig: TFigureName = K): boolean; begin - Result := unlimited_var[color]; + Result := m_ChessRulesEngine.DoMove(m_i0, m_j0, i, j, prom_fig); + if (Result) then + FOnAfterMoveDone; end; -procedure TChessBoard.SwitchClock(clock_color: TFigureColor); +procedure TChessBoard.PBoxBoardDragOver(Sender, Source: TObject; X, + Y: Integer; State: TDragState; var Accept: Boolean); +var + rect: TRect; + i, j: integer; begin - self.clock_color := clock_color; - if (not GameTimer.Enabled) then - begin - past_time := Now; - GameTimer.Enabled := TRUE; - end; - if (Assigned(Handler) and (Mode = mGame)) then - Handler(cbeClockSwitched, self); - ShowTime(clock_color); + case State of + dsDragEnter: + m_bHilighted := FALSE; + + dsDragMove: + begin + // Repaint a fragment on m_bmHiddenBoard + m_bmHiddenBoard.Canvas.Draw(x0 - dx, y0 - dy, m_bmBuf); + // Copy new fragment to the buffer + m_bmBuf.Canvas.CopyRect(Bounds(0, 0, m_iSquareSize, m_iSquareSize), + m_bmHiddenBoard.Canvas, Bounds(X - dx, Y - dy, m_iSquareSize, m_iSquareSize)); + // Draw the dragging piece in a new position + m_bmHiddenBoard.Canvas.Draw(X - dx, Y - dy, m_bmFigure[m_fig]); + // Copy the new fragment to the screen + rect:= Bounds(Min(x0,X) - dx, Min(y0, Y) - dy, + abs(X - x0) + m_iSquareSize, abs(Y - y0) + m_iSquareSize); + PBoxBoard.Canvas.CopyRect(rect, m_bmHiddenBoard.Canvas, rect); -{$IFDEF THREADED_CHESSCLOCK} - if (not Assigned(TimeLabelThread)) then - TimeLabelThread := TTimeLabelThread.Create(self); -{$ENDIF} + x0 := X; + y0 := Y; + + FWhatSquare(Point(X,Y), i, j); + + Accept := ((i in [1..8]) and (j in [1..8])); + end; + end; end; -procedure TChessBoard.HilightLastMove; +procedure TChessBoard.PBoxBoardEndDrag(Sender, Target: TObject; X, Y: Integer); var - i, j, l, - _i0, _j0, x, y: integer; + i, j: integer; + bRes: boolean; begin - // вывод последнего сделанного хода - if (last_hilight and (lastMove.i0 <> 0)) then - begin - if (_flipped) then - begin - _i0 := 9 - lastMove.i0; - _j0 := lastMove.j0; - i := 9 - lastMove.i; - j := lastMove.j; - end - else + case m_Mode of + mGame, mAnalyse: begin - _i0 := lastMove.i0; - _j0 := 9 - lastMove.j0; - i := lastMove.i; - j := 9 - lastMove.j; + if (m_bHilighted) then + begin + with m_bmHiddenBoard.Canvas do + begin + Pen.Color:= HILIGHT_COLOR; + Pen.Width := HILIGHT_WIDTH; + x0:= x0 - dx; + y0:= y0 - dy; + MoveTo(x0,y0); + LineTo(x0 + m_iSquareSize - 1, y0); + LineTo(x0 + m_iSquareSize - 1, y0 + m_iSquareSize - 1); + LineTo(x0, y0 + m_iSquareSize - 1); + LineTo(x0, y0); + + PBoxBoardPaint(nil); + end; + end + else + begin + if (AnimateTimer.Enabled) then + AnimateTimer.Enabled := FALSE; + FDrawBoard; + if (m_bDraggedMoved) then + begin + HilightLastMove; + Evaluate; + m_bDraggedMoved := FALSE; + end; + end; end; - x := iSquareSize * (_i0 - 1) + CHB_X; - y := iSquareSize * (_j0 - 1) + CHB_Y; - bmHiddenBoard.Canvas.Pen.Color := HILIGHT_LAST_MOVE_COLOR; - bmHiddenBoard.Canvas.Pen.Width := HILIGHT_LAST_MOVE_WIDTH; - - for l := 1 to 2 do - with bmHiddenBoard.Canvas do + mEdit: + begin + if (m_bDraggedMoved) then begin - MoveTo(x, y); - LineTo(x + iSquareSize - 1, y); - LineTo(x + iSquareSize - 1, y + iSquareSize - 1); - LineTo(x, y + iSquareSize - 1); - LineTo(x, y); + FWhatSquare(Point(X, Y), i, j); + bRes := (((i <> m_i0) or (j <> m_j0)) and Position.SetPiece(i, j, m_fig)); + end + else + bRes := TRUE; - x := iSquareSize * (i - 1) + CHB_X; - y := iSquareSize * (j - 1) + CHB_Y; + if (bRes) then + begin + Position.SetPiece(m_i0, m_j0, ES); + FOnAfterSetPosition; end; - PBoxBoardPaint(nil); - end; + + FDrawBoard; + end; + end; // case end; -procedure TChessBoard.SetPlayerColor(const color: TFigureColor); +procedure TChessBoard.PBoxBoardMouseDown(Sender: TObject; + Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +var + i, j: Integer; + f: TFigure; begin - FCancelAnimationDragging; - player_color:= color; - if (player_color = fcWhite) then - SetFlipped(FALSE) + if (Button <> mbLeft) then + exit; + + FWhatSquare(Point(X, Y), i, j); + if (not ((i in [1..8]) and (j in [1..8]))) then + exit; + + m_bDraggedMoved := FALSE; + + f := Position.board[i,j]; + + case m_Mode of + mGame, mAnalyse: + begin + if (m_bViewGaming) then + exit; + if ((Position.color <> m_PlayerColor) or + (((Position.color <> fcWhite) or (f >= ES)) and + ((Position.color <> fcBlack) or (f <= ES)))) then + exit; + + if ((i = m_i0) and (j = m_j0)) then + m_bHilighted := (m_bHilighted xor TRUE) + else + m_bHilighted := TRUE; + end; + + mEdit: + begin + if (f = ES) then + exit; + end; + else - SetFlipped(TRUE); // player_color = fcBlack -end; + exit; + end; + if (m_iAnimStep < m_iAnimStepsCount) then + FEndAnimation; -procedure TChessBoard.StopClock; -begin - GameTimer.Enabled := FALSE; - WhiteFlagButton.Visible := FALSE; - BlackFlagButton.Visible := FALSE; + m_fig := f; + m_i0 := i; + m_j0 := j; + + dx := (X - CHB_X) mod m_iSquareSize; + dy := (Y - CHB_Y) mod m_iSquareSize; + x0 := X; + y0 := Y; + + m_bDraggedMoved := TRUE; + PBoxBoard.BeginDrag(FALSE); end; -procedure TChessBoard.FormCanResize(Sender: TObject; var NewWidth, - NewHeight: Integer; var Resize: Boolean); +procedure TChessBoard.PBoxBoardMouseMove(Sender: TObject; Shift: TShiftState; + X, Y: Integer); var - - NewBoardSize: TSize; + f: TFigure; + i,j: Integer; begin - Resize := (m_ResizingType <> rtNo); - if (not Resize) then + FWhatSquare(Point(X,Y), i,j); + if (not ((i in [1..8]) and (j in [1..8]))) then + begin + PBoxBoard.Cursor:= crDefault; exit; + end; - if (m_ResizingType = rtVert) then - NewWidth := NewHeight + m_iDeltaWidthHeight - else // rtHoriz - NewHeight := NewWidth - m_iDeltaWidthHeight; + f := Position.board[i,j]; - NewBoardSize := m_BitmapRes.GetOptimalBoardSize( - Size(PBoxBoard.Width + (NewWidth - Width), PBoxBoard.Height + (NewHeight - Height))); + case m_Mode of + mGame, mAnalyse: + begin + if (m_bViewGaming) then + exit; - Resize := (NewBoardSize.cx > 0) and (NewBoardSize.cy > 0) and - ((NewBoardSize.cx <> PBoxBoard.Width) or (NewBoardSize.cy <> PBoxBoard.Height)); - if (Resize) then - begin - NewWidth := Width + (NewBoardSize.cx - PBoxBoard.Width); - NewHeight := Height + (NewBoardSize.cy - PBoxBoard.Height); + if (m_PlayerColor = Position.color) and + (((Position.color = fcWhite) and (f < ES)) or + ((Position.color = fcBlack) and (f > ES))) then + PBoxBoard.Cursor:= crHandPoint + else + PBoxBoard.Cursor:= crDefault; + end; + + mEdit: + begin + if (f <> ES) then + PBoxBoard.Cursor:= crHandPoint + else + PBoxBoard.Cursor:= crDefault; + end; + + else + PBoxBoard.Cursor := crDefault; end; end; -procedure TChessBoard.FormClose(Sender: TObject; var Action: TCloseAction); +function TChessBoard.FGetPositionsList: TList; begin - if ((not shuted) and Assigned(Handler)) then - begin - Handler(cbeExit, self); - Action:= caNone; - end - else - shuted := FALSE; + Result := m_ChessRulesEngine.PositionsList; end; -procedure TChessBoard.Shut; +function TChessBoard.FGetColorStarts: TFigureColor; begin - shuted:= TRUE; - Close; + Result := m_ChessRulesEngine.GetColorStarts; end; -procedure TChessBoard.Evaluate; +procedure TChessBoard.PBoxBoardMouseUp(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); +var + i, j: integer; begin - if (Assigned(Handler)) then - begin - case ChessRulesEngine.GetEvaluation of - evMate: - Handler(cbeMate, self); - evStaleMate: - Handler(cbeStaleMate, self); + case Button of + mbLeft: + begin + case m_Mode of + mGame, mAnalyse: + begin + if (not m_bHilighted) then + exit; + FWhatSquare(Point(X, Y), i, j); + if (m_bDraggedMoved) then + FDrawBoard + else + begin + m_bHilighted := FALSE; + if (FDoMove(i, j)) then + FAnimate(i, j) + else + FDrawBoard; + end; + end; + + mEdit: + begin + if (m_bDraggedMoved) then + exit; + // Assert(empty field) + FWhatSquare(Point(X, Y), i, j); + if (Position.SetPiece(i, j, m_EditPiece)) then + begin + FOnAfterSetPosition; + FDrawBoard; + end; + end; + + end; // case end; + + mbRight: + begin + FDoHandler(cbeMenu, self); + end; + end; end; -procedure TChessBoard.PPRandom; +procedure TChessBoard.PBoxBoardStartDrag(Sender: TObject; + var DragObject: TDragObject); begin - ChessRulesEngine.InitNewPPRandomGame; - RDrawBoard; + // Copy image of an empty square to m_bmBuf + m_bmBuf.Width := m_iSquareSize; + m_bmBuf.Height:= m_iSquareSize; + if (((m_i0 + m_j0) and 1) <> 0) then + m_bmBuf.Canvas.CopyRect(Bounds(0,0, m_iSquareSize, m_iSquareSize), + m_bmFigure[ES].Canvas, Bounds(0,0, m_iSquareSize, m_iSquareSize)) + else + m_bmBuf.Canvas.CopyRect(Bounds(0,0, m_iSquareSize, m_iSquareSize), + m_bmFigure[ES].Canvas, Bounds(m_iSquareSize,0, m_iSquareSize, m_iSquareSize)); + + m_bDraggedMoved := FALSE; end; -procedure TChessBoard.TakeBack; +procedure TChessBoard.InitPosition; begin - if (not ChessRulesEngine.TakeBack) then - exit; - ROnAfterSetPosition; - // TODO: animation - RDrawBoard; + m_ChessRulesEngine.InitNewGame; + + FCancelAnimationDragging; + FOnAfterSetPosition; + + FDrawBoard; end; -procedure TChessBoard.SetHilightLastMove(const yes: boolean); +procedure TChessBoard.PPRandom; begin - last_hilight := yes; - RDrawBoard; - HilightLastMove; + m_ChessRulesEngine.InitNewPPRandomGame; + + FCancelAnimationDragging; + FOnAfterSetPosition; + + FDrawBoard; end; -procedure TChessBoard.SetCoordinates(const yes: boolean); +procedure TChessBoard.TakeBack; begin - coord_show := yes; - RDrawBoard; - HilightLastMove; + if (m_Mode = mEdit) then + exit; + + if (not m_ChessRulesEngine.TakeBack) then + exit; + + FOnAfterSetPosition; + // TODO: animation + FDrawBoard; end; function TChessBoard.NMoveDone: integer; begin - Result := ChessRulesEngine.NMovesDone; + Result := m_ChessRulesEngine.NMovesDone; end; -procedure TChessBoard.ROnAfterSetPosition; +function TChessBoard.NPlysDone: integer; begin + Result := m_ChessRulesEngine.NPlysDone; end; -{$IFDEF THREADED_CHESSCLOCK} -procedure TTimeLabelThread.Execute; + +function TChessBoard.FGetMovesOffset: integer; begin - while ChessBoard.GameTimer.Enabled do - begin - if self.player_time[fcWhite] <> ChessBoard.player_time[fcWhite] then - ChessBoard.ShowTime(fcWhite); - if self.player_time[fcBlack] <> ChessBoard.player_time[fcBlack] then - ChessBoard.ShowTime(fcBlack); - Sleep(ChessBoard.GameTimer.Interval div 2); - end; - ChessBoard.TimeLabelThread := nil; + Result := m_ChessRulesEngine.MovesOffset; end; -constructor TTimeLabelThread.Create(ChessBoard: TChessBoard); +function TChessBoard.FGetPositionColor: TFigureColor; begin - self.ChessBoard := ChessBoard; - self.player_time[fcWhite] := ChessBoard.player_time[fcWhite]; - self.player_time[fcBlack] := ChessBoard.player_time[fcBlack]; - - inherited Create(TRUE); -//Priority := tpNormal; - FreeOnTerminate := TRUE; - Resume; + Result := Position.color; end; -{$ENDIF} -procedure TChessBoard.FormKeyDown(Sender: TObject; var Key: Word; - Shift: TShiftState); + +procedure TChessBoard.FormCanResize(Sender: TObject; var NewWidth, + NewHeight: Integer; var Resize: Boolean); +var + NewBoardSize: TSize; begin - if Assigned(Handler) then - Handler(cbeKeyPressed, Pointer(Key), self); -end; + if (not m_bDeltaWidthHeightFlag) then + begin + m_iDeltaWidthHeight := Width - Height; + m_bDeltaWidthHeightFlag := TRUE; + end; + Resize := (m_ResizingType <> rtNo); + if (not Resize) then + exit; -function TChessBoard.GetStayOnTop: boolean; -begin - Result := (self.FormStyle = fsStayOnTop); -end; + if (m_ResizingType = rtVert) then + NewWidth := NewHeight + m_iDeltaWidthHeight + else // rtHoriz + NewHeight := NewWidth - m_iDeltaWidthHeight; + NewBoardSize := m_BitmapRes.GetOptimalBoardSize( + Size(PBoxBoard.Width + (NewWidth - Width), PBoxBoard.Height + (NewHeight - Height))); -procedure TChessBoard.SetStayOnTop(onTop: boolean); -begin - if (onTop) then - self.FormStyle := fsStayOnTop - else - self.FormStyle := fsNormal; + Resize := (NewBoardSize.cx > 0) and (NewBoardSize.cy > 0) and + ((NewBoardSize.cx <> PBoxBoard.Width) or (NewBoardSize.cy <> PBoxBoard.Height)); + if (Resize) then + begin + NewWidth := Width + (NewBoardSize.cx - PBoxBoard.Width); + NewHeight := Height + (NewBoardSize.cy - PBoxBoard.Height); + end; end; -procedure TChessBoard.FormActivate(Sender: TObject); +procedure TChessBoard.FormResize(Sender: TObject); +var + _fig: TFigure; begin - if Assigned(Handler) then - Handler(cbeActivate, self); -end; + FreeAndNil(m_bmChessBoard); + m_BitmapRes.CreateBoardBitmap(Size(PBoxBoard.Width, PBoxBoard.Height), self.Color, + m_bmChessBoard); + m_iSquareSize := m_BitmapRes.SquareSize; + + for _fig := Low(TFigure) to High(TFigure) do + begin + FreeAndNil(m_bmFigure[_fig]); + m_BitmapRes.CreateFigureBitmap(_fig, m_bmFigure[_fig]); + end; + // Graphics initialization + if (not Assigned(m_bmHiddenBoard)) then + begin + m_bmHiddenBoard := Graphics.TBitmap.Create; + m_bmHiddenBoard.Palette := m_bmChessBoard.Palette; + m_bmHiddenBoard.Canvas.Font := PBoxBoard.Font; // Характеристики шрифта координат задаются в инспекторе + m_bmHiddenBoard.Canvas.Brush.Style := bsClear; + end; + m_bmHiddenBoard.Width := m_bmChessBoard.Width; + m_bmHiddenBoard.Height := m_bmChessBoard.Height; -procedure TChessBoard.WMMoving(var Msg: TWMMoving); -begin - // TODO: it's possible to handle if form is outside of the screen - if Assigned(Handler) then - Handler(cbeFormMoving, Pointer(Msg.DragRect.Left - Left), Pointer(Msg.DragRect.Top - Top)); - inherited; + if (not Assigned(m_bmBuf)) then + begin + m_bmBuf := Graphics.TBitmap.Create; + m_bmBuf.Palette:= m_bmChessBoard.Palette; + end; + + FDrawBoard; end; @@ -1193,199 +1217,165 @@ begin PRect(Msg.LParam).Left := Left; PRect(Msg.LParam).Top := Top; end; - end; { case } + end; // case end; -function TChessBoard.FGetPositinoColor: TFigureColor; +procedure TChessBoard.FDoHandler(e: TChessBoardEvent; d1: pointer = nil; d2: pointer = nil); begin - Result := Position.color; + if (Assigned(FHandler)) then + FHandler(e, d1, d2); end; -function TChessBoard.FGetPosition: PChessPosition; +function TChessBoard.FGetMoveNotationFormat: TMoveNotationFormat; begin - Result := ChessRulesEngine.Position; + Result := m_ChessRulesEngine.MoveNotationFormat; end; -function TChessBoard.AskPromotionFigure(FigureColor: TFigureColor): TFigureName; +procedure TChessBoard.FSetMoveNotationFormat(Value: TMoveNotationFormat); begin - if (Showing) then - begin - with TPromotionForm.Create(self, m_BitmapRes) do - try - Result := ShowPromotion(FigureColor); - finally - Free; - end; - end - else - Result := Q; + m_ChessRulesEngine.MoveNotationFormat := Value; end; -function TChessBoard.FGetLastMove: PMoveAbs; +function TChessBoard.FGetFENFormat: boolean; begin - Result := ChessRulesEngine.lastMove; + Result := m_ChessRulesEngine.FENFormat; end; -procedure TChessBoard.FCancelAnimationDragging; +procedure TChessBoard.FSetFENFormat(bValue: boolean); begin - // Отмена анимации и перетаскивания - if (AnimateTimer.Enabled) then - begin - AnimateTimer.Enabled := FALSE; - // anim_step := anim_step_num; - // AnimateTimerTimer(nil); - end; - if (PBoxBoard.Dragging) then - begin - dragged_moved := FALSE; - PBoxBoard.EndDrag(FALSE); - end; + m_ChessRulesEngine.FENFormat := bValue; end; -procedure TChessBoard.FlagButtonClick(Sender: TObject); +procedure TChessBoard.BeginUpdate; begin - if Assigned(Handler) and (Mode = mGame) then - Handler(cbeTimeOut, self); + inc(m_iUpdateCounter); end; -procedure TChessBoard.SetAutoFlag(auto_flag: boolean); +procedure TChessBoard.EndUpdate; begin - self.auto_flag := auto_flag; - if (auto_flag) then + if (m_iUpdateCounter > 0) then begin - WhiteFlagButton.Visible := FALSE; - BlackFlagButton.Visible := FALSE; + dec(m_iUpdateCounter); + if (m_iUpdateCounter = 0) then + FDrawBoard; end; end; -procedure TChessBoard.FormResize(Sender: TObject); -var - _fig: TFigure; +procedure TChessBoard.FOnDrawLayerUpdate(const ADrawLayer: TChessBoardLayerBase); begin - FreeAndNil(m_bmChessBoard); - m_BitmapRes.CreateBoardBitmap(Size(PBoxBoard.Width, PBoxBoard.Height), self.Color, - m_bmChessBoard); - iSquareSize := m_BitmapRes.SquareSize; + if (not AnimateTimer.Enabled) then + FDrawBoard; +end; - for _fig := Low(TFigure) to High(TFigure) do - begin - FreeAndNil(m_bmFigure[_fig]); - m_BitmapRes.CreateFigureBitmap(_fig, m_bmFigure[_fig]); - end; - // Graphics initialization - if (not Assigned(bmHiddenBoard)) then - begin - bmHiddenBoard := TBitmap.Create; - bmHiddenBoard.Palette := m_bmChessBoard.Palette; - bmHiddenBoard.Canvas.Font := PBoxBoard.Font; // Характеристики шрифта координат задаются в инспекторе - bmHiddenBoard.Canvas.Brush.Style := bsClear; - end; - bmHiddenBoard.Width := m_bmChessBoard.Width; - bmHiddenBoard.Height := m_bmChessBoard.Height; +procedure TChessBoard.AddLayer(const ALayer: TChessBoardLayerBase); +begin + if (m_lstLayers.IndexOf(ALayer) >= 0) then + exit; - if (not Assigned(m_bmBuf)) then + ALayer.ChessBoard := self; + m_lstLayers.Add(ALayer); + + FOnDrawLayerUpdate(ALayer); +end; + + +procedure TChessBoard.RemoveLayer(const ALayer: TChessBoardLayerBase); +begin + if (m_lstLayers.Remove(ALayer) >= 0) then begin - m_bmBuf := TBitmap.Create; - m_bmBuf.Palette:= m_bmChessBoard.Palette; + ALayer.ChessBoard := nil; + + FOnDrawLayerUpdate(ALayer); end; +end; - RDrawBoard; + +function TChessBoard.IsMoveAnimating: boolean; +begin + Result := AnimateTimer.Enabled; end; +//////////////////////////////////////////////////////////////////////////////// +// TChessBoardDrawBase -procedure TChessBoard.TimePanelResize(Sender: TObject); -var - rRatio: real; +procedure TChessBoardLayerBase.RDoUpdate; +begin + if (Assigned(m_ChessBoard)) then + m_ChessBoard.FOnDrawLayerUpdate(self); +end; + + +function TChessBoardLayerBase.FGetSquareSize: integer; begin - // Adjust panels on TimePanel - rRatio := TimePanel.Width / m_iTimePanelInitialWidth; - WhitePanel.Left := Round(rRatio * m_iWhitePanelInitialLeft); - WhitePanel.Width := m_iWhitePanelInitialWidth; - BlackPanel.Left := Round(rRatio * m_iBlackPanelInitialLeft); - BlackPanel.Width := m_iBlackPanelInitialWidth; + if (Assigned(m_ChessBoard)) then + Result := m_ChessBoard.SquareSize + else + Result := 0; +end; - WhiteTimeLabel.Font.Assign(m_TimeFont); - BlackTimeLabel.Font.Assign(m_TimeFont); - if (WhitePanel.Left + WhitePanel.Width < BlackPanel.Left) then - begin - WhiteLabel.Caption := WHITE_LONG_LABEL; - BlackLabel.Caption := BLACK_LONG_LABEL; - end +function TChessBoardLayerBase.FGetCanvas: TCanvas; +begin + if (Assigned(m_ChessBoard)) then + Result := m_ChessBoard.FGetHiddenBoardCanvas else - begin - WhitePanel.Left := 4; - WhitePanel.Width := TimePanel.Width div 2; - BlackPanel.Left := TimePanel.Width div 2; - BlackPanel.Width := TimePanel.Width div 2 - 4; + Result := nil; +end; - WhiteLabel.Caption := WHITE_MEDIUM_LABEL; - BlackLabel.Caption := BLACK_MEDIUM_LABEL; - end; - // Adjust color labels - if ((WhiteTimeLabel.Left + WhiteTimeLabel.Width > WhitePanel.Width) or - (BlackTimeLabel.Left + BlackTimeLabel.Width > BlackPanel.Width)) then - begin - WhiteTimeLabel.Font.Size := WhiteTimeLabel.Font.Size - 4; - BlackTimeLabel.Font.Size := BlackTimeLabel.Font.Size - 4; - WhiteLabel.Caption := WHITE_SHORT_LABEL; - BlackLabel.Caption := BLACK_SHORT_LABEL; - end; +function TChessBoardLayerBase.FGetPosition: PChessPosition; +begin + if (Assigned(m_ChessBoard)) then + Result := m_ChessBoard.Position + else + Result := nil; end; -procedure TChessBoard.FFlashWindow; -var - flushWindowInfo: TFlashWInfo; +function TChessBoardLayerBase.RGetColorStarts: TFigureColor; begin - // Flash with taskbar - flushWindowInfo.cbSize := SizeOf(flushWindowInfo); - flushWindowInfo.hwnd := Application.Handle; - flushWindowInfo.dwflags := FLASHW_TRAY; // FLASHW_ALL; //FLASHW_TRAY; - flushWindowInfo.ucount := 3; // Flash times - flushWindowInfo.dwtimeout := 0; // speed in msec, 0 - frequency of cursor flashing - FlashWindowEx(flushWindowInfo); + if (Assigned(m_ChessBoard)) then + Result := m_ChessBoard.FGetColorStarts + else + Result := fcWhite; +end; + - if (self.Focused) then - exit; - // Flash window - flushWindowInfo.hwnd := self.Handle; // handle of the flashing window - flushWindowInfo.dwflags := FLASHW_CAPTION; // FLASHW_TRAY; // FLASHW_ALL; //FLASHW_TRAY; - FlashWindowEx(flushWindowInfo); +function TChessBoardLayerBase.FGetPositionsList: TList; +begin + if (Assigned(m_ChessBoard)) then + Result := m_ChessBoard.PositionsList + else + Result := nil; end; -procedure TChessBoard.FLocalize; +procedure TChessBoardLayerBase.ROnAfterMoveDone; begin - with TLocalizer.Instance do - begin - WHITE_LONG_LABEL := GetLabel(13); - WHITE_MEDIUM_LABEL := GetLabel(14); - WHITE_SHORT_LABEL := GetLabel(15); - BLACK_LONG_LABEL := GetLabel(16); - BLACK_MEDIUM_LABEL := GetLabel(17); - BLACK_SHORT_LABEL := GetLabel(18); - end; +end; - TimePanelResize(nil); + +procedure TChessBoardLayerBase.ROnAfterSetPosition; +begin end; -initialization +procedure TChessBoardLayerBase.ROnAfterModeSet(const OldValue, NewValue: TMode); begin - Randomize; // для PP Random end; -finalization + +procedure TChessBoardLayerBase.ROnResetMoveList; +begin +end; end. diff --git a/plugins/Chess4Net/ChessClockUnit.pas b/plugins/Chess4Net/ChessClockUnit.pas new file mode 100644 index 0000000000..9e587af9f2 --- /dev/null +++ b/plugins/Chess4Net/ChessClockUnit.pas @@ -0,0 +1,113 @@ +unit ChessClockUnit; + +interface + +type + TChessClock = class + public + class function IsZeitnot(const time: TDateTime): boolean; + class function ConvertToStr(const time: TDateTime): string; + class function ConvertToFullStr(const time: TDateTime; + bIncludeMSec: boolean = TRUE): string; + class function ConvertFromFullStr(const strTime: string): TDateTime; + end; + +implementation + +uses + SysUtils; + +const + FULL_TIME_FORMAT = 'h":"n":"s"."z'; + HOUR_TIME_FORMAT = 'h":"nn":"ss'; + MIN_TIME_FORMAT = 'n":"ss'; + ZEITNOT_FORMAT = 's"."zzz'; + ZEITNOT_BOARDER = 10; // sec. - zeitnot border + +//////////////////////////////////////////////////////////////////////////////// +// TChessClock + +class function TChessClock.IsZeitnot(const time: TDateTime): boolean; +begin + Result := ((time > 0) and (time < EncodeTime(0, 0, ZEITNOT_BOARDER, 0))); +end; + + +class function TChessClock.ConvertToStr(const time: TDateTime): string; +begin + LongTimeFormat := MIN_TIME_FORMAT; + if (time >= EncodeTime(1, 0, 0, 0)) then + LongTimeFormat := HOUR_TIME_FORMAT + else if (IsZeitnot(time)) then + LongTimeFormat := ZEITNOT_FORMAT; + + Result := TimeToStr(time); +end; + + +class function TChessClock.ConvertToFullStr(const time: TDateTime; + bIncludeMSec: boolean = TRUE): string; +begin + if (bIncludeMSec) then + LongTimeFormat := FULL_TIME_FORMAT + else + LongTimeFormat := HOUR_TIME_FORMAT; + + Result := TimeToStr(time); +end; + + +class function TChessClock.ConvertFromFullStr(const strTime: string): TDateTime; + + procedure NParse(strTime: string; out Hour, Min, Sec, MSec: Word); + const + TIME_DELIM = ':'; + MSEC_DELIM = '.'; + var + iPos: integer; + str: string; + begin + Hour := 0; + Min := 0; + Sec := 0; + MSec := 0; + + iPos := LastDelimiter(MSEC_DELIM, strTime); + if (iPos > 0) then + begin + str := Copy(strTime, iPos + 1, MaxInt); + strTime := Copy(strTime, 1, iPos - 1); + MSec := StrToInt(str); + end; + + strTime := TIME_DELIM + strTime; + + iPos := LastDelimiter(TIME_DELIM, strTime); + if (iPos = 0) then + exit; + str := Copy(strTime, iPos + 1, MaxInt); + strTime := Copy(strTime, 1, iPos - 1); + Sec := StrToInt(str); + + iPos := LastDelimiter(TIME_DELIM, strTime); + if (iPos = 0) then + exit; + str := Copy(strTime, iPos + 1, MaxInt); + strTime := Copy(strTime, 1, iPos - 1); + Min := StrToInt(str); + + iPos := LastDelimiter(TIME_DELIM, strTime); + if (iPos = 0) then + exit; + str := Copy(strTime, iPos + 1, MaxInt); + Hour := StrToInt(str); + end; + +var + Hour, Min, Sec, MSec: Word; +begin // .ConvertFromFullStr + NParse(strTime, Hour, Min, Sec, MSec); + Result := EncodeTime(Hour, Min, Sec, MSec); +end; + +end. diff --git a/plugins/Chess4Net/ChessRulesEngine.pas b/plugins/Chess4Net/ChessRulesEngine.pas index feb471b48b..466f7b9190 100644 --- a/plugins/Chess4Net/ChessRulesEngine.pas +++ b/plugins/Chess4Net/ChessRulesEngine.pas @@ -1,3 +1,9 @@ +//////////////////////////////////////////////////////////////////////////////// +// All code below is exclusively owned by author of Chess4Net - Pavel Perminov +// (packpaul@mail.ru, packpaul1@gmail.com). +// Any changes, modifications, borrowing and adaptation are a subject for +// explicit permition from the owner. + unit ChessRulesEngine; interface @@ -11,13 +17,20 @@ type BK, BQ, BR, BB, BN, BP); // ES - Empty Square TFigureColor = (fcWhite, fcBlack); + TCastlingCapability = set of ( + WhiteKingSide, WhiteQueenSide, BlackKingSide, BlackQueenSide); + PChessPosition = ^TChessPosition; - TChessPosition = record // шахматная позиция + TChessPosition = object // Chess position board: array[1..8, 1..8] of TFigure; - color: TFigureColor; // Чей ход - castling: set of (WhiteKingSide, WhiteQueenSide, // Возможность рокировки - BlackKingSide, BlackQueenSide); - en_passant: 0..8; // Вертикаль возможности взятия e.p. 0 - нету e.p. + color: TFigureColor; // Who moves + castling: TCastlingCapability; + en_passant: 0..8; // possibility of e.p 0 - no e.p. + private + procedure FUpdateKingSideCastling(AColor: TFigureColor); + procedure FUpdateQueenSideCastling(AColor: TFigureColor); + public + function SetPiece(i, j: integer; APiece: TFigure): boolean; end; PMoveAbs = ^TMoveAbs; @@ -32,33 +45,40 @@ type TEvaluation = (evInGame, evMate, evStaleMate); + TMoveNotationFormat = (mnfCh4N, mnfCh4NEx); // TODO: mnfPGN + TChessRulesEngine = class private m_ChessRulesEngineable: IChessRulesEngineable; m_Position: TChessPosition; - m_i0, m_j0: integer; // Предыдущие координаты фигуры - m_fig: TFigure; // Перетаскиваемая фигура - m_lastMove: TMoveAbs; // Последний сделанный ход + m_iMovesOffset: integer; + m_i0, m_j0: integer; // Previous position of piece + m_fig: TFigure; // Piece that moves + m_lastMove: TMoveAbs; // Last move done m_strLastMoveStr: string; // last move in algebraic notation + m_MoveNotationFormat: TMoveNotationFormat; + m_bFENFormat: boolean; m_lstPosition: TList; function FGetPosition: PChessPosition; function FAskPromotionFigure(FigureColor: TFigureColor): TFigureName; - procedure FAddPosMoveToList; // Добавляет позицию и ход из неё в список + procedure FAddPosMoveToList; // Add position and its move to the list function FMove2Str(const pos: TChessPosition): string; function FCheckMove(const chp: TChessPosition; var chp_res: TChessPosition; i0, j0, i, j: integer; var prom_fig: TFigureName): boolean; function FGetLastMove: PMoveAbs; - procedure FDelPosList; // Удаляет текущую позицию из списка + procedure FDeleteLastPositionFromPositionList; - function FDoMove(i, j: integer; prom_fig: TFigureName = K): boolean; overload; + function FDoMove(i, j: integer; prom_fig: TFigureName = K): boolean; - class function FFieldUnderAttack(const pos: TChessPosition; i0,j0: integer): boolean; // TODO: -> private ? + class function FFieldUnderAttack(const pos: TChessPosition; i0,j0: integer): boolean; class function FCheckCheck(const pos: TChessPosition): boolean; function FCanMove(pos: TChessPosition): boolean; + procedure FSetMovesOffset(iValue: integer); + property i0: integer read m_i0 write m_i0; property j0: integer read m_j0 write m_j0; property fig: TFigure read m_fig write m_fig; @@ -70,18 +90,25 @@ type function DoMove(move_str: string): boolean; overload; function DoMove(i0, j0, i, j: integer; prom_fig: TFigureName = K): boolean; overload; function TakeBack: boolean; - function SetPosition(const posstr: string): boolean; + function SetPosition(strValue: string): boolean; function GetPosition: string; + function GetColorStarts: TFigureColor; procedure InitNewGame; procedure InitNewPPRandomGame; - procedure ResetMoveList; // очищает список позиций + procedure ResetMoveList; // Clears positions list function NMovesDone: integer; // amount of moves done + function NPlysDone: integer; // amount of plys done + function GetFENMoveNumber: integer; function GetEvaluation: TEvaluation; property Position: PChessPosition read FGetPosition; property lastMove: PMoveAbs read FGetLastMove; property lastMoveStr: string read m_strLastMoveStr; + property MovesOffset: integer read m_iMovesOffset write FSetMovesOffset; property PositionsList: TList read m_lstPosition; + property MoveNotationFormat: TMoveNotationFormat + read m_MoveNotationFormat write m_MoveNotationFormat; + property FENFormat: boolean read m_bFENFormat write m_bFENFormat; end; PPosMove = ^TPosMove; @@ -93,6 +120,8 @@ type const INITIAL_CHESS_POSITION = 'rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR w KQkq -'; EMPTY_CHESS_POSITION = '8/8/8/8/8/8/8/8 w - -'; + INITIAL_FEN = 'rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR w KQkq - 0 1'; + EMPTY_FEN = '8/8/8/8/8/8/8/8 w - - 0 1'; implementation @@ -128,21 +157,19 @@ const constructor TChessRulesEngine.Create(ChessRulesEngineable: IChessRulesEngineable = nil); begin inherited Create; - m_ChessRulesEngineable := ChessRulesEngineable; - // Инициализация списка позиций + m_ChessRulesEngineable := ChessRulesEngineable; m_lstPosition := TList.Create; + + InitNewGame; end; destructor TChessRulesEngine.Destroy; -var - i: integer; begin - for i := 0 to m_lstPosition.Count - 1 do - Dispose(m_lstPosition[i]); + ResetMoveList; m_lstPosition.Free; - + inherited; end; @@ -258,163 +285,201 @@ var _fig: TFigure; pos: TChessPosition; begin - Result:= FALSE; - if not ((i0 in [1..8]) and (j0 in [1..8]) and - (i in [1..8]) and (j in [1..8])) then exit; + Result := FALSE; + + if (not ((i0 in [1..8]) and (j0 in [1..8]) and + (i in [1..8]) and (j in [1..8]))) then + exit; _fig := chp.board[i0, j0]; - if ((chp.color = fcWhite) and (_fig > ES)) or - ((chp.color = fcBlack) and (_fig < ES)) then + if (((chp.color = fcWhite) and (_fig > ES)) or + ((chp.color = fcBlack) and (_fig < ES))) then exit; f := TFigureName(ord(_fig) - ord(chp.color) * ord(BK)); - for l:= 1 to 8 do + for l := 1 to 8 do with DELTA_MOVE[f], chp do begin - if (dx[l] = 0) and (dy[l] = 0) then break; // Все ходы просмотрены - ti:= i0; tj:= j0; + if (dx[l] = 0) and (dy[l] = 0) then + break; // All moves have been viewed + + ti := i0; + tj := j0; + case f of P: - begin - if (l = 1) and - not(((color = fcWhite) and (j0 = 2) and (board[i0,3] = ES)) or - ((color = fcBlack) and (j0 = 7) and (board[i0,6] = ES))) - then continue; // Пешка - не на 2/7 гор. - не делаем длинный ход. - case color of - fcWhite: - begin - ti:= ti + dx[l]; tj:= tj + dy[l]; - end; - fcBlack: - begin - ti:= ti - dx[l]; tj:= tj - dy[l]; - end; + begin + if ((l = 1) and + (not (((color = fcWhite) and (j0 = 2) and (board[i0,3] = ES)) or + ((color = fcBlack) and (j0 = 7) and (board[i0,6] = ES))))) then + continue; // Pawn is not on 2/7 row - long move is impossible + + case color of + fcWhite: + begin + inc(ti, dx[l]); + inc(tj, dy[l]); end; - if not(ti in [1..8]) or not(tj in [1..8]) then continue; - if (l <= 2) and (board[ti,tj] <> ES) - then continue; // Перед пешкой фигура - выход - if (l >= 3) and not(((color = fcWhite) and ((board[ti,tj] > ES) or + + fcBlack: + begin + dec(ti, dx[l]); + dec(tj, dy[l]); + end; + end; + + if (not (ti in [1..8]) or not(tj in [1..8])) then + continue; + if ((l <= 2) and (board[ti,tj] <> ES)) then + continue; // There's a piece before the pawn -> exit + + if ((l >= 3) and (not (((color = fcWhite) and ((board[ti,tj] > ES) or ((j0 = 5) and (en_passant = ti)))) or ((color = fcBlack) and ((board[ti,tj] < ES) or - ((j0 = 4) and (en_passant = ti))))) - then continue; - if (ti = i) and (tj = j) then goto here; - end; - else + ((j0 = 4) and (en_passant = ti))))))) then + continue; + + if ((ti = i) and (tj = j)) then + goto here; + end; + + else + begin repeat - ti:= ti + dx[l]; tj:= tj + dy[l]; - if not(ti in [1..8]) or not(tj in [1..8]) or - ((color = fcWhite) and ((board[ti,tj] < ES) or - ((board[ti,tj] > ES) and ((ti <> i) or (tj <> j))))) or - ((color = fcBlack) and ((board[ti,tj] > ES) or - ((board[ti,tj] < ES) and ((ti <> i) or (tj <> j))))) - then break; - if (ti = i) and (tj = j) then goto here; - until not longRange; + inc(ti, dx[l]); + inc(tj, dy[l]); + + if ((not (ti in [1..8])) or (not (tj in [1..8])) or + ((color = fcWhite) and ((board[ti,tj] < ES) or + ((board[ti,tj] > ES) and ((ti <> i) or (tj <> j))))) or + ((color = fcBlack) and ((board[ti,tj] > ES) or + ((board[ti,tj] < ES) and ((ti <> i) or (tj <> j)))))) then + break; + + if ((ti = i) and (tj = j)) then + goto here; + + until (not longRange); + end; + end; { case } end; - if f = K then // Проверка на возможность рокировки + if (f = K) then // Checking against castling + begin with chp do + begin + if (i-i0 = 2) and (j = j0) and + (((color = fcWhite) and (WhiteKingSide in castling)) or + ((color = fcBlack) and (BlackKingSide in castling))) then begin - if (i-i0 = 2) and (j = j0) and - (((color = fcWhite) and (WhiteKingSide in castling)) or - ((color = fcBlack) and (BlackKingSide in castling))) then - begin - if ((board[6,j0] <> ES) or (board[7,j0] <> ES) or // 0-0 - FFieldUnderAttack(chp,5,j0) or - FFieldUnderAttack(chp,6,j0)) then exit; - end - else if ((i-i0 = -2) and (j = j0) and - (((color = fcWhite) and (WhiteQueenSide in castling)) or - ((color = fcBlack) and (BlackQueenSide in castling)))) then - begin - if ((board[4,j0] <> ES) or (board[3,j0] <> ES) or // 0-0-0 - (board[2,j0] <> ES) or - FFieldUnderAttack(chp,5,j0) or - FFieldUnderAttack(chp,4,j0)) then - exit; - end - else exit; - - goto here; - end; - exit; // передвижение фигуры не по правилам + if ((board[6,j0] <> ES) or (board[7,j0] <> ES) or // 0-0 + FFieldUnderAttack(chp,5,j0) or + FFieldUnderAttack(chp,6,j0)) then exit; + end + else if ((i-i0 = -2) and (j = j0) and + (((color = fcWhite) and (WhiteQueenSide in castling)) or + ((color = fcBlack) and (BlackQueenSide in castling)))) then + begin + if ((board[4,j0] <> ES) or (board[3,j0] <> ES) or // 0-0-0 + (board[2,j0] <> ES) or + FFieldUnderAttack(chp,5,j0) or + FFieldUnderAttack(chp,4,j0)) then + exit; + end + else + exit; + + goto here; + end; + end; + + exit; // The piece was moved not according to rules + here: - // Реализация хода на pos - pos:= chp; + // Making move on pos + pos := chp; + with pos do - begin - case f of - P: - begin - if (((color = fcWhite) and (j0 = 5)) or - ((color = fcBlack) and (j0 = 4))) and (i = en_passant) - then board[i,j0]:= ES; // убрать при e.p. враж. пешку - end; - K: + begin + case f of + P: + begin + if (((color = fcWhite) and (j0 = 5)) or + ((color = fcBlack) and (j0 = 4))) and (i = en_passant) then + board[i,j0]:= ES; // remove enemy pawn with e.p. + end; + + K: + begin + if i-i0 = 2 then begin - if i-i0 = 2 then - begin - board[6,j0]:= board[8,j0]; // 0-0 - board[8,j0]:= ES; - end - else - if i0-i = 2 then - begin - board[4,j0]:= board[1,j0]; // 0-0-0 - board[1,j0]:= ES; - end; - case color of - fcWhite: - castling:= castling - [WhiteKingSide, WhiteQueenSide]; - fcBlack: - castling:= castling - [BlackKingSide, BlackQueenSide]; - end; - end; - R: + board[6,j0]:= board[8,j0]; // 0-0 + board[8,j0]:= ES; + end + else + if i0-i = 2 then begin - if ((i0 = 8) and (j0 = 1)) or ((i = 8) and (j = 1)) - then castling:= castling - [WhiteKingSide] - else - if ((i0 = 1) and (j0 = 1)) or ((i = 1) and (j = 1)) - then castling:= castling - [WhiteQueenSide] - else - if ((i0 = 8) and (j0 = 8)) or ((i = 8) and (j = 8)) - then castling:= castling - [BlackKingSide] - else - if ((i0 = 1) and (j0 = 8)) or ((i = 1) and (j = 8)) - then castling:= castling - [BlackQueenSide]; + board[4,j0]:= board[1,j0]; // 0-0-0 + board[1,j0]:= ES; end; + case color of + fcWhite: + castling:= castling - [WhiteKingSide, WhiteQueenSide]; + fcBlack: + castling:= castling - [BlackKingSide, BlackQueenSide]; + end; end; - if (f = P) and (abs(j-j0) = 2) and - (((i > 1) and (((color = fcWhite) and (board[i-1,j] = BP)) or - ((color = fcBlack) and (board[i-1,j] = WP)))) or - ((i < 8) and (((color = fcWhite) and (board[i+1,j] = BP)) or - ((color = fcBlack) and (board[i+1,j] = WP))))) then - en_passant := i0 // вкл. e.p. - else - en_passant := 0; // выкл. e.p. - // Сделать ход - board[i0, j0]:= ES; - board[i, j] := _fig; - if (FCheckCheck(pos)) then - exit; // ход невозможен из-за шаха - if (f = P) and ((j = 1) or (j = 8)) then + + R: begin - case prom_fig of - Q..N: ; - else - prom_fig := FAskPromotionFigure(pos.color); - end; // case - board[i, j] := TFigure(ord(color) * ord(BK) + ord(prom_fig)); + if ((i0 = 8) and (j0 = 1)) or ((i = 8) and (j = 1)) then + castling := castling - [WhiteKingSide] + else if ((i0 = 1) and (j0 = 1)) or ((i = 1) and (j = 1)) then + castling := castling - [WhiteQueenSide] + else if ((i0 = 8) and (j0 = 8)) or ((i = 8) and (j = 8)) then + castling := castling - [BlackKingSide] + else if ((i0 = 1) and (j0 = 8)) or ((i = 1) and (j = 8)) then + castling := castling - [BlackQueenSide]; end; - if color = fcWhite then color:= fcBlack - else color:= fcWhite; end; - chp_res:= pos; + if ((f = P) and (abs(j-j0) = 2) and + (((i > 1) and (((color = fcWhite) and (board[i-1,j] = BP)) or + ((color = fcBlack) and (board[i-1,j] = WP)))) or + ((i < 8) and (((color = fcWhite) and (board[i+1,j] = BP)) or + ((color = fcBlack) and (board[i+1,j] = WP)))))) then + en_passant := i0 // e.p. on + else + en_passant := 0; // e.p. off + + // make the move + + board[i0, j0]:= ES; + board[i, j] := _fig; + + if (FCheckCheck(pos)) then + exit; // move is impossible because of check + + if (f = P) and ((j = 1) or (j = 8)) then + begin + case prom_fig of + Q..N: ; + else + prom_fig := FAskPromotionFigure(pos.color); + end; // case + board[i, j] := TFigure(ord(color) * ord(BK) + ord(prom_fig)); + end; + + if (color = fcWhite) then + color := fcBlack + else + color := fcWhite; + end; // with + + chp_res := pos; + Result:= TRUE; end; @@ -461,18 +526,30 @@ begin until not longRange; end; end; - Result:= FALSE; + + Result := FALSE; end; function TChessRulesEngine.DoMove(move_str: string): boolean; label - l1, l2; + l1; var l: byte; f, prom_f: TFigureName; - i, j, ti,tj: integer; + i, j: integer; + ti, tj: integer; + saved_i, saved_j: integer; begin + Result := FALSE; + + l := length(move_str); + if ((l <= 1)) then // at least two characters + exit; + + if ((move_str[l] in ['+', '#'])) then + move_str := LeftStr(move_str, l - 1); + // Проверка на рокировку if (move_str = '0-0') then begin @@ -489,130 +566,166 @@ begin move_str:= 'Ke8c8'; end; + l := length(move_str); + i0 := 0; j0 := 0; i := 0; j := 0; - l := length(move_str); prom_f := K; case move_str[l] of 'Q': prom_f := Q; 'R': prom_f := R; 'B': prom_f := B; 'N': prom_f := N; - else goto l1; + else + inc(l); end; + dec(l); -l1: + if move_str[l] in ['1'..'8'] then - begin - j:= StrToInt(move_str[l]); - dec(l); - end; + begin + j := StrToInt(move_str[l]); + dec(l); + end; if move_str[l] in ['a'..'h'] then - begin - i:= ord(move_str[l]) - ord('a') + 1; - dec(l); - end; + begin + i := ord(move_str[l]) - ord('a') + 1; + dec(l); + end; if (l > 0) and (move_str[l] in ['1'..'8']) then - begin - j0 := StrToInt(move_str[l]); - dec(l); - end; + begin + j0 := StrToInt(move_str[l]); + dec(l); + end; if (l > 0) and (move_str[l] in ['a'..'h']) then - begin - i0 := ord(move_str[l]) - ord('a') + 1; - dec(l); + begin + i0 := ord(move_str[l]) - ord('a') + 1; + dec(l); + end; + + if (l = 0) then + f := P + else + begin + case move_str[l] of + 'K': f:= K; + 'Q': f:= Q; + 'R': f:= R; + 'B': f:= B; + 'N': f:= N; end; + end; - if l = 0 then f:= P - else - case move_str[l] of - 'K': f:= K; - 'Q': f:= Q; - 'R': f:= R; - 'B': f:= B; - 'N': f:= N; - end; + with m_Position do + begin + fig := TFigure(ord(f) + ord(Position.color) * ord(BK)); - with Position^ do - begin - fig := TFigure(ord(f) + ord(Position.color) * ord(BK)); + case f of + K..N: // Ход Кр - К + begin + if ((i0 > 0) and (j0 > 0)) then + begin + Result := FDoMove(i, j, prom_f); + exit; + end; - case f of - K..N: // Ход Кр - К + for l := 1 to 8 do + begin + with DELTA_MOVE[f] do begin - for l:= 1 to 8 do - with DELTA_MOVE[f] do - begin - if (dx[l] = 0) and (dy[l] = 0) then break; // Все ходы просмотрены - ti:= i; tj:= j; - repeat - ti:= ti + dx[l]; tj:= tj + dy[l]; - if not ((ti in [1..8]) and (tj in [1..8])) or - ((board[ti,tj] <> ES) and (board[ti,tj] <> fig)) then break; - - if ((i0 = 0) or (i0 = ti)) and ((j0 = 0) or (j0 = tj)) and - (board[ti,tj] = fig) then - begin // Ходящая фигура найдена - i0 := ti; - j0 := tj; - goto l2; - end; - until (f = K) or (f = N); // Если Кр или К, то выход + if (dx[l] = 0) and (dy[l] = 0) then break; // Все ходы просмотрены + ti:= i; + tj:= j; + repeat + ti:= ti + dx[l]; + tj:= tj + dy[l]; + if not ((ti in [1..8]) and (tj in [1..8])) or + ((board[ti,tj] <> ES) and (board[ti,tj] <> fig)) then + break; + + if ((i0 = 0) or (i0 = ti)) and ((j0 = 0) or (j0 = tj)) and + (board[ti, tj] = fig) then + begin // Ходящая фигура найдена + saved_i := i0; + saved_j := j0; + + i0 := ti; + j0 := tj; + Result := FDoMove(i, j, prom_f); + if (Result) then + exit; + + i0 := saved_i; + j0 := saved_j; end; - end; - P: // Ход пешкой + until (f = K) or (f = N); // Если Кр или К, то выход + end; // with + end; // for + end; // K..N + + P: // Ход пешкой + begin + if (i0 <> 0) and (i0 <> i) then // взятие пешкой + begin + for l := 2 to 7 do begin - if (i0 <> 0) and (i0 <> i) then // взятие пешкой + if (board[i0, l] = fig) and ((j0 = 0) or (j0 = l)) then + begin + if color = fcWhite then begin - for l:= 2 to 7 do - if (board[i0, l] = fig) and ((j0 = 0) or (j0 = l)) then - if color = fcWhite then - begin - if ((board[i,l+1] > ES) or - ((l = 5) and (en_passant = i))) and - ((j = 0) or (j = l+1)) and (abs(i - i0) = 1) then - begin - j0 := l; - j := l + 1; - goto l2; - end; - end - else // color = fcBlack - if ((board[i,l-1] < ES) or - ((l = 4) and (en_passant = i))) and - ((j = 0) or (j = l-1)) and (abs(i - i0) = 1) then - begin - j0 := l; - j := l-1; - goto l2; - end; + if ((board[i, l + 1] > ES) or + ((l = 5) and (en_passant = i))) and + ((j = 0) or (j = l+1)) and (abs(i - i0) = 1) then + begin + j0 := l; + j := l + 1; + Result := FDoMove(i, j, prom_f); + if (Result) then + exit; + end; end - else // Ход прямо + else // color = fcBlack + if ((board[i,l - 1] < ES) or + ((l = 4) and (en_passant = i))) and + ((j = 0) or (j = l-1)) and (abs(i - i0) = 1) then begin - i0 := i; - if color = fcWhite then - begin - if board[i, j - 1] = fig then - j0 := j - 1 - else if (j = 4) and (board[i, 3] = ES) and - (board[i,2] = fig) then - j0 := 2; - end - else // color = fcBlack - if board[i,j+1] = fig then - j0 := j + 1 - else if (j = 5) and (board[i,6] = ES) and - (board[i, 7] = fig) then - j0 := 7; + j0 := l; + j := l - 1; + Result := FDoMove(i, j, prom_f); + if (Result) then + exit; end; + end; // if + end; // for + end + else // Ход прямо + begin + i0 := i; + if color = fcWhite then + begin + if board[i, j - 1] = fig then + j0 := j - 1 + else if (j = 4) and (board[i, 3] = ES) and + (board[i,2] = fig) then + j0 := 2; + end + else // color = fcBlack + begin + if (board[i, j + 1] = fig) then + j0 := j + 1 + else if (j = 5) and (board[i,6] = ES) and (board[i, 7] = fig) then + j0 := 7; end; - end; - end; -l2: - Result := FDoMove(i, j, prom_f); + + Result := FDoMove(i, j, prom_f); + end; // if + end; // P: + + end; // case + end; end; @@ -620,10 +733,10 @@ function TChessRulesEngine.FDoMove(i, j: integer; prom_fig: TFigureName = K): bo var newPosition: TChessPosition; begin - Result := FCheckMove(Position^, newPosition, i0, j0, i, j, prom_fig); + Result := FCheckMove(m_Position, newPosition, i0, j0, i, j, prom_fig); if (Result) then begin - // запоминание сделанного хода + // Store the move done lastMove.i0 := i0; lastMove.j0 := j0; lastMove.i := i; @@ -633,7 +746,8 @@ begin FAddPosMoveToList; m_strLastMoveStr := FMove2Str(newPosition); - Position^ := newPosition; + + m_Position := newPosition; end; end; @@ -657,21 +771,37 @@ var pm: PPosMove; begin new(pm); - pm.pos := Position^; + pm.pos := m_Position; pm.move := lastMove^; PositionsList.Add(pm); end; function TChessRulesEngine.FMove2Str(const pos: TChessPosition): string; + + procedure NExtendWithCheckOrMate(var strMove: string); + begin + if (strMove = '') then + exit; + + if (FCheckCheck(pos)) then + begin + if (FCanMove(pos)) then + strMove := strMove + '+' + else + strMove := strMove + '#'; + end; + end; + var f: TFigureName; l: byte; ti, tj: integer; ambig, hor, ver: boolean; _fig: TFigure; -begin - if lastMove.i0 = 0 then // Ход не задан + DummyPosition: TChessPosition; +begin // .FMove2Str + if (lastMove.i0 = 0) then // No move begin Result:= ''; exit; @@ -679,37 +809,62 @@ begin _fig := Position.board[lastMove.i0, lastMove.j0]; f := TFigureName(ord(_fig) + (ord(pos.color) - 1) * ord(BK)); - // Ход пешкой + + // Pawn moves if (f = P) then begin with pos do begin - if ((lastMove.i - lastMove.i0) = 0) then // ход - Result:= chr(ord('a') + lastMove.i - 1) + IntToStr(lastMove.j) - else // взятие + if ((lastMove.i - lastMove.i0) = 0) then // move + Result := chr(ord('a') + lastMove.i - 1) + IntToStr(lastMove.j) + else // capturing + begin + Result := chr(ord('a') + lastMove.i0 - 1) + chr(ord('a') + lastMove.i - 1); + + for l := 2 to 7 do // Checking against ambiguity of capturing begin - Result:= chr(ord('a') + lastMove.i0 - 1) + chr(ord('a') + lastMove.i - 1); - - for l := 2 to 7 do // Проверка на двусмысленность взятия - if (((board[lastMove.i0, l] = WP) and ((Position.board[lastMove.i, l+1] > ES) or - ((Position.en_passant = lastMove.i) and (l = 5)))) and (color = fcBlack)) or - (((board[lastMove.i0, l] = BP) and ((Position.board[lastMove.i, l-1] < ES) or - ((Position.en_passant = lastMove.i) and (l = 4)))) and (color = fcWhite)) - then Result:= Result + IntToStr(lastMove.j); + if (board[lastMove.i0, l] = WP) then + tj := l + 1 + else if (board[lastMove.i0, l] = BP) then + tj := l - 1 + else + continue; + + if ((((tj > l) and ((Position.board[lastMove.i, tj] > ES) or + ((Position.en_passant = lastMove.i) and (l = 5)))) and (color = fcBlack)) or + (((tj < l) and ((Position.board[lastMove.i, tj] < ES) or + ((Position.en_passant = lastMove.i) and (l = 4)))) and (color = fcWhite))) then + begin + if ((MoveNotationFormat <> mnfCh4NEx) or + FCheckMove(m_Position, DummyPosition, lastMove.i0, l, lastMove.i, tj, + lastMove.prom_fig)) then + begin + Result := Result + IntToStr(lastMove.j); + end; + end; + end; + end; - if (lastMove.j = 8) or (lastMove.j = 1) then // Пешка превратилась + if (lastMove.j = 8) or (lastMove.j = 1) then // The pawn has been promoted + begin case board[lastMove.i,lastMove.j] of - WQ,BQ: Result:= Result + 'Q'; - WR,BR: Result:= Result + 'R'; - WB,BB: Result:= Result + 'B'; - WN,BN: Result:= Result + 'N'; + WQ,BQ: Result := Result + 'Q'; + WR,BR: Result := Result + 'R'; + WB,BB: Result := Result + 'B'; + WN,BN: Result := Result + 'N'; end; + end; + + if (m_MoveNotationFormat = mnfCh4NEx) then + NExtendWithCheckOrMate(Result); + exit; - end; + + end; // with end; // if - // <Фигура> + // case f of K: Result:= 'K'; Q: Result:= 'Q'; @@ -717,50 +872,73 @@ begin B: Result:= 'B'; N: Result:= 'N'; end; - // [<Вертикаль>][<Горизонталь>] + + // [][] ambig:= FALSE; hor:= FALSE; ver:= FALSE; + for l := 1 to 8 do + begin with pos, DELTA_MOVE[f] do - begin - if (dx[l] = 0) and (dy[l] = 0) then - break; // Все ходы просмотрены - ti := lastMove.i; - tj := lastMove.j; - repeat - ti:= ti + dx[l]; tj:= tj + dy[l]; - if not (ti in [1..8]) or not (tj in [1..8]) or - ((board[ti,tj] <> ES) and (board[ti,tj] <> _fig)) then - break; - if (board[ti,tj] = _fig) then - begin - ambig:= TRUE; - ver:= ver or (ti = lastMove.i0); hor:= hor or (tj = lastMove.j0); - break; - end; - until (f = K) or (f = N); // Если Кр или К, то выход - end; - - if ambig then begin - if not ver or hor then - Result:= Result + chr(ord('a') + lastMove.i0 - 1); - if ver then - Result := Result + IntToStr(lastMove.j0); + if (dx[l] = 0) and (dy[l] = 0) then + break; // All moves have been viewed + + ti := lastMove.i; + tj := lastMove.j; + + repeat + inc(ti, dx[l]); + inc(tj, dy[l]); + + if ((not (ti in [1..8])) or (not (tj in [1..8]))) then + break; + + if (board[ti,tj] = ES) then + continue; + + if (board[ti, tj] <> _fig) then + break; + + if ((m_MoveNotationFormat <> mnfCh4NEx) or + FCheckMove(m_Position, DummyPosition, ti, tj, lastMove.i, lastMove.j, + lastMove.prom_fig)) then + begin + ambig := TRUE; + ver := (ver or (ti = lastMove.i0)); + hor := (hor or (tj = lastMove.j0)); + + break; + end; + + until (f = K) or (f = N); // If K or N -> exit + end; + end; // for l + + if (ambig) then + begin + if ((not ver) or hor) then + Result := Result + chr(ord('a') + lastMove.i0 - 1); + if (ver) then + Result := Result + IntToStr(lastMove.j0); + end; - // <Конечное поле> + // Result := Result + chr(ord('a') + lastMove.i - 1) + IntToStr(lastMove.j); - // <Короткая рокировка> | <Длинная рокировка> - if f = K then + // | + if (f = K) then begin - if lastMove.i - lastMove.i0 = 2 then - Result:= '0-0' - else if lastMove.i0 - lastMove.i = 2 then - Result:= '0-0-0'; + if ((lastMove.i - lastMove.i0) = 2) then + Result := '0-0' + else if (lastMove.i0 - lastMove.i = 2) then + Result := '0-0-0'; end; + + if (m_MoveNotationFormat = mnfCh4NEx) then + NExtendWithCheckOrMate(Result); end; @@ -768,123 +946,213 @@ function TChessRulesEngine.TakeBack: boolean; begin Result := (PositionsList.Count > 0); if (Result) then - FDelPosList; + begin + FDeleteLastPositionFromPositionList; + lastMove.i0 := 0; + end; end; -procedure TChessRulesEngine.FDelPosList; +procedure TChessRulesEngine.FDeleteLastPositionFromPositionList; var i: integer; begin i := PositionsList.Count - 1; if (i >= 0) then begin - Position^ := PPosMove(PositionsList[i]).pos; + m_Position := PPosMove(PositionsList[i]).pos; Dispose(PositionsList[i]); PositionsList.Delete(i); end; end; -function TChessRulesEngine.SetPosition(const posstr: string): boolean; +function TChessRulesEngine.SetPosition(strValue: string): boolean; + + function NNextToken(var str: string): string; + var + iPos: integer; + begin + str := TrimLeft(str); + if (str = '') then + Result := '' + else + begin + iPos := Pos(' ', str); + if (iPos > 0) then + begin + Result := LeftStr(str, Pred(iPos)); + str := Copy(str, iPos, MaxInt); + end + else + begin + Result := str; + str := ''; + end; + end; + end; + var - i, j, k: integer; - l: byte; pos: TChessPosition; -begin - Result:= FALSE; - l := 1; - for j := 8 downto 1 do + function NSetPlacingOfPieces: boolean; + var + strPos: string; + iPos: integer; + j, i, k: integer; begin - i := 1; - repeat - case posstr[l] of - 'K': pos.board[i,j]:= WK; - 'Q': pos.board[i,j]:= WQ; - 'R': pos.board[i,j]:= WR; - 'B': pos.board[i,j]:= WB; - 'N': pos.board[i,j]:= WN; - 'P': pos.board[i,j]:= WP; - - 'k': pos.board[i,j]:= BK; - 'q': pos.board[i,j]:= BQ; - 'r': pos.board[i,j]:= BR; - 'b': pos.board[i,j]:= BB; - 'n': pos.board[i,j]:= BN; - 'p': pos.board[i,j]:= BP; - - '1'..'8': // Вставка пустых полей - begin - k:= StrToInt(posstr[l]); - repeat - pos.board[i,j]:= ES; - dec(k); inc(i); - until k = 0; - dec(i); - end; + Result := FALSE; - ' ': break; // Позиция прочитана - выход из цикла + strPos := NNextToken(strValue); - else exit; // ошибка в posstr - end; - inc(i); inc(l); - until (posstr[l] = '/') or (i > 8); // Повтор до появления '/' или пока на горизонтали - inc(l); - end; + iPos := 1; - case posstr[l] of - 'w': pos.color:= fcWhite; - 'b': pos.color:= fcBlack; - else exit; + for j := 8 downto 1 do + begin + i := 1; + repeat + if (iPos > Length(strPos)) then + exit; + + case strPos[iPos] of + 'K': pos.board[i,j]:= WK; + 'Q': pos.board[i,j]:= WQ; + 'R': pos.board[i,j]:= WR; + 'B': pos.board[i,j]:= WB; + 'N': pos.board[i,j]:= WN; + 'P': pos.board[i,j]:= WP; + + 'k': pos.board[i,j]:= BK; + 'q': pos.board[i,j]:= BQ; + 'r': pos.board[i,j]:= BR; + 'b': pos.board[i,j]:= BB; + 'n': pos.board[i,j]:= BN; + 'p': pos.board[i,j]:= BP; + + '1'..'8': // Insert empty fields + begin + k := StrToInt(strPos[iPos]); + repeat + pos.board[i,j]:= ES; + dec(k); inc(i); + until k = 0; + dec(i); + end; + + ' ': break; // Position is read -> exit from loop + + else + exit; // Error in strPos + end; + + inc(i); + inc(iPos); + + until ((i > 8) or (strPos[iPos] = '/')); // Repeat until '/' or if not on the row + + inc(iPos); + + end; // for j + + Result := TRUE; end; - inc(l,2); - pos.castling:= []; - while posstr[l] <> ' ' do +var + i: integer; + iMovesOffset: integer; + strToken: string; +begin // .SetPosition + Result := NSetPlacingOfPieces; + if (not Result) then + exit; + + // Defaults + pos.color := fcWhite; + pos.castling := []; + pos.en_passant := 0; + iMovesOffset := 0; + + try + strToken := NNextToken(strValue); + if (strToken = '') then + exit; + + case strToken[1] of + 'w': + pos.color := fcWhite; + 'b': + pos.color := fcBlack; + else + exit; + end; + + strToken := NNextToken(strValue); + if (strToken = '') then + exit; + + for i := 1 to Length(strToken) do begin with pos do - case posstr[l] of - 'K': castling:= castling + [WhiteKingSide]; - 'Q': castling:= castling + [WhiteQueenSide]; - 'k': castling:= castling + [BlackKingSide]; - 'q': castling:= castling + [BlackQueenSide]; + begin + case strToken[i] of + 'K': + Include(castling, WhiteKingSide); + 'Q': + Include(castling, WhiteQueenSide); + 'k': + Include(castling, BlackKingSide); + 'q': + Include(castling, BlackQueenSide); '-': - if castling <> [] then exit - else - begin - inc(l); - break; - end; + castling := []; else exit; end; - inc(l); - end; + end; - inc(l); - with pos do - case posstr[l] of - 'a'..'h': en_passant:= ord(posstr[l]) - ord('a') + 1; - '-': en_passant:= 0; - else + end; // for + + strToken := NNextToken(strValue); + if (strToken = '') then exit; + + with pos do + begin + case strToken[1] of + 'a'..'h': + en_passant := ord(strToken[1]) - ord('a') + 1; + end; end; - if (Trim(RightStr(posstr, length(posstr) - l)) <> '') then - exit; + strToken := NNextToken(strValue); + if (strToken = '') then + exit; - Position^ := pos; - lastMove.i0 := 0; // предыдущего хода ещё не было + // Skip 50-moves counter + + strToken := NNextToken(strValue); + if (strToken = '') then + exit; + + iMovesOffset := StrToIntDef(strToken, 1) - 1; + if (iMovesOffset < 0) then + iMovesOffset := 0; + + finally + ResetMoveList; + m_Position := pos; + m_iMovesOffset := iMovesOffset; + end; - Result := TRUE; end; procedure TChessRulesEngine.InitNewGame; +var + bRes: boolean; begin - SetPosition(INITIAL_CHESS_POSITION); - ResetMoveList; + bRes := SetPosition(INITIAL_CHESS_POSITION); + Assert(bRes); end; @@ -895,76 +1163,127 @@ begin for i := 0 to PositionsList.Count - 1 do Dispose(PositionsList[i]); PositionsList.Clear; + + lastMove.i0 := 0; end; function TChessRulesEngine.GetPosition: string; -var - i,j: Integer; - k: byte; - chFig: char; -begin - Result:= ''; - with Position^ do + function NGetPlacingOfPieces: string; + var + i, j: Integer; + k: byte; + chFig: char; + begin + Result := ''; + + // Placing of pieces + for j := 8 downto 1 do begin - // Расстановка фигур - for j := 8 downto 1 do + k := 0; + + for i := 1 to 8 do + begin + case Position.board[i, j] of + WK: chFig := 'K'; + WQ: chFig := 'Q'; + WR: chFig := 'R'; + WB: chFig := 'B'; + WN: chFig := 'N'; + WP: chFig := 'P'; + BK: chFig := 'k'; + BQ: chFig := 'q'; + BR: chFig := 'r'; + BB: chFig := 'b'; + BN: chFig := 'n'; + BP: chFig := 'p'; + ES: + begin + inc(k); + continue; + end; + end; + + if (k > 0) then begin - k:= 0; - for i:= 1 to 8 do - begin - case board[i,j] of - WK: chFig := 'K'; - WQ: chFig := 'Q'; - WR: chFig := 'R'; - WB: chFig := 'B'; - WN: chFig := 'N'; - WP: chFig := 'P'; - BK: chFig := 'k'; - BQ: chFig := 'q'; - BR: chFig := 'r'; - BB: chFig := 'b'; - BN: chFig := 'n'; - BP: chFig := 'p'; - ES: - begin - inc(k); - continue; - end; - end; + Result := Result + IntToStr(k); + k := 0; + end; - if k > 0 then - begin - Result:= Result + IntToStr(k); - k:= 0; - end; + Result := Result + chFig; + end; // for i - Result := Result + chFig; - end; + if (k > 0) then + Result := Result + IntToStr(k); + if (j = 1) then + Result := Result + ' ' + else + Result := Result + '/'; // i <= 7 + end; // for j - if k > 0 then Result:= Result + IntToStr(k); - if j = 1 then Result:= Result + ' ' - else Result:= Result + '/'; // i <= 7 - end; + end; - if color = fcWhite then Result:= Result + 'w ' - else Result:= Result + 'b '; // color = fcBlack - // Рокировка - if castling = [] then Result:= Result + '-' - else - begin - if WhiteKingSide in castling then Result:= Result + 'K'; - if WhiteQueenSide in castling then Result:= Result + 'Q'; - if BlackKingSide in castling then Result:= Result + 'k'; - if BlackQueenSide in castling then Result:= Result + 'q'; - end; - // en-passant - if (en_passant = 0) then - Result := Result + ' -' - else - Result := Result + ' ' + Chr(Ord('a') - 1 + en_passant); - end; +begin // .GetPosition + Result := NGetPlacingOfPieces; + + if (Position.color = fcWhite) then + Result := Result + 'w ' + else + Result := Result + 'b '; // color = fcBlack + + // Castling + if (Position.castling = []) then + Result := Result + '-' + else + begin + if (WhiteKingSide in Position.castling) then + Result := Result + 'K'; + if (WhiteQueenSide in Position.castling) then + Result := Result + 'Q'; + if (BlackKingSide in Position.castling) then + Result := Result + 'k'; + if (BlackQueenSide in Position.castling) then + Result := Result + 'q'; + end; + + // en-passant + if (Position.en_passant = 0) then + Result := Result + ' -' + else + begin + Result := Result + ' ' + Chr(Ord('a') - 1 + Position.en_passant); + end; + + if (not FENFormat) then + exit; + + if (Position.en_passant <> 0) then + begin + if (Position.color = fcWhite) then + Result := Result + '6' + else + Result := Result + '3'; // Black + end; + + Result := Result + ' 0'; // TODO: 50-moves rule + + Result := Result + ' ' + IntToStr(GetFENMoveNumber); +end; + + +function TChessRulesEngine.GetFENMoveNumber: integer; +begin + Result := NMovesDone; + if ((m_Position.color = fcWhite) or (Result = 0)) then + inc(Result); +end; + + +procedure TChessRulesEngine.FSetMovesOffset(iValue: integer); +begin + Assert(iValue >= 0); + m_iMovesOffset := iValue; end; @@ -978,6 +1297,7 @@ var f: boolean; begin InitNewGame; + if (Random(2) = 0) then SQR[5] := 1 // с какой стороны оставляем ладью else @@ -990,24 +1310,52 @@ begin f := FALSE; for j := 0 to i-1 do f := f or (rnd_sqr[i] = rnd_sqr[j]); until not (f or ((i = 1) and (((rnd_sqr[0] xor rnd_sqr[1]) and 1) = 0))); - Position.board[rnd_sqr[i], 1] := TFigure(ord(FIG[i])); - Position.board[rnd_sqr[i], 8] := TFigure(ord(BK) + ord(FIG[i])); + m_Position.board[rnd_sqr[i], 1] := TFigure(ord(FIG[i])); + m_Position.board[rnd_sqr[i], 8] := TFigure(ord(BK) + ord(FIG[i])); end; end; function TChessRulesEngine.NMovesDone: integer; +var + iMovesCount: integer; begin - Result := (PositionsList.Count + 1) shr 1; // div 2 + if ((PositionsList.Count = 0) and (m_iMovesOffset = 0)) then + iMovesCount := 0 + else + begin + if (GetColorStarts = fcWhite) then + iMovesCount := ((PositionsList.Count + 1) div 2) + else // GetColorStarts = fcBlack + iMovesCount := ((PositionsList.Count + 2) div 2); + end; + + Result := m_iMovesOffset + iMovesCount; +end; + + +function TChessRulesEngine.GetColorStarts: TFigureColor; +begin + if (Odd(PositionsList.Count) and (m_Position.color = fcBlack)) or + (not Odd(PositionsList.Count) and (m_Position.color = fcWhite)) then + Result := fcWhite + else + Result := fcBlack; +end; + + +function TChessRulesEngine.NPlysDone: integer; // amount of plys done +begin + Result := (2 * m_iMovesOffset) + PositionsList.Count; end; function TChessRulesEngine.GetEvaluation: TEvaluation; begin Result := evInGame; - if (not FCanMove(Position^)) then + if (not FCanMove(m_Position)) then begin - if (FCheckCheck(Position^)) then + if (FCheckCheck(m_Position)) then Result := evMate else Result := evStaleMate; @@ -1015,4 +1363,119 @@ begin // TODO: Evaluate position for possible technical draw end; + +function TChessPosition.SetPiece(i, j: integer; APiece: TFigure): boolean; +var + SavedPiece: TFigure; +begin + Result := ((i in [1..8]) and (j in [1..8])); + if (not Result) then + exit; + + SavedPiece := board[i, j]; + board[i, j] := APiece; + + if (SavedPiece = APiece) then + exit; + + if ((i = 5) and (j = 1)) then + begin + FUpdateKingSideCastling(fcWhite); + FUpdateQueenSideCastling(fcWhite); + end + else if ((i = 8) and (j = 1)) then + FUpdateKingSideCastling(fcWhite) + else if ((i = 1) and (j = 1)) then + FUpdateQueenSideCastling(fcWhite) + else if ((i = 5) and (j = 8)) then + begin + FUpdateKingSideCastling(fcBlack); + FUpdateQueenSideCastling(fcBlack); + end + else if ((i = 8) and (j = 8)) then + FUpdateKingSideCastling(fcBlack) + else if ((i = 1) and (j = 8)) then + FUpdateQueenSideCastling(fcBlack); +end; + + +procedure TChessPosition.FUpdateKingSideCastling(AColor: TFigureColor); +var + j: integer; + King, Rook: TFigure; +begin + if (AColor = fcWhite) then + begin + j := 1; + King := WK; + Rook := WR; + end + else // fcBlack + begin + j := 8; + King := BK; + Rook := BR; + end; + + if ((board[5, j] = King) and (board[8, j] = Rook)) then + begin + if (AColor = fcWhite) then + Include(castling, WhiteKingSide) + else + Include(castling, BlackKingSide); + end + else + begin + if (AColor = fcWhite) then + Exclude(castling, WhiteKingSide) + else + Exclude(castling, BlackKingSide); + end; + +end; + + +procedure TChessPosition.FUpdateQueenSideCastling(AColor: TFigureColor); +var + j: integer; + King, Rook: TFigure; +begin + if (AColor = fcWhite) then + begin + j := 1; + King := WK; + Rook := WR; + end + else // fcBlack + begin + j := 8; + King := BK; + Rook := BR; + end; + + if ((board[5, j] = King) and (board[1, j] = Rook)) then + begin + if (AColor = fcWhite) then + Include(castling, WhiteQueenSide) + else + Include(castling, BlackQueenSide); + end + else + begin + if (AColor = fcWhite) then + Exclude(castling, WhiteQueenSide) + else + Exclude(castling, BlackQueenSide); + end; + +end; + +initialization + +begin + Randomize; // It's for PP Random +end; + +finalization + end. diff --git a/plugins/Chess4Net/ClientQueueUnit.pas b/plugins/Chess4Net/ClientQueueUnit.pas index 68e6b50558..7dd7d4c511 100644 --- a/plugins/Chess4Net/ClientQueueUnit.pas +++ b/plugins/Chess4Net/ClientQueueUnit.pas @@ -1,3 +1,9 @@ +//////////////////////////////////////////////////////////////////////////////// +// All code below is exclusively owned by author of Chess4Net - Pavel Perminov +// (packpaul@mail.ru, packpaul1@gmail.com). +// Any changes, modifications, borrowing and adaptation are a subject for +// explicit permition from the owner. + unit ClientQueueUnit; interface diff --git a/plugins/Chess4Net/ConnectingUnit.pas b/plugins/Chess4Net/ConnectingUnit.pas index 9b7bae3c05..567f049b46 100644 --- a/plugins/Chess4Net/ConnectingUnit.pas +++ b/plugins/Chess4Net/ConnectingUnit.pas @@ -1,9 +1,15 @@ +//////////////////////////////////////////////////////////////////////////////// +// All code below is exclusively owned by author of Chess4Net - Pavel Perminov +// (packpaul@mail.ru, packpaul1@gmail.com). +// Any changes, modifications, borrowing and adaptation are a subject for +// explicit permition from the owner. + unit ConnectingUnit; interface uses - Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, TntStdCtrls, + Windows, Messages, SysUtils, Classes, Graphics, Controls, TntStdCtrls, Forms, {Dialogs, }ExtCtrls, StdCtrls, DialogUnit, ModalForm; diff --git a/plugins/Chess4Net/ConnectionUnit.pas b/plugins/Chess4Net/ConnectionUnit.pas index 482094afe4..b5c12fef1e 100644 --- a/plugins/Chess4Net/ConnectionUnit.pas +++ b/plugins/Chess4Net/ConnectionUnit.pas @@ -1,9 +1,15 @@ +//////////////////////////////////////////////////////////////////////////////// +// All code below is exclusively owned by author of Chess4Net - Pavel Perminov +// (packpaul@mail.ru, packpaul1@gmail.com). +// Any changes, modifications, borrowing and adaptation are a subject for +// explicit permition from the owner. + unit ConnectionUnit; interface uses - Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, Mask; type diff --git a/plugins/Chess4Net/ContinueUnit.pas b/plugins/Chess4Net/ContinueUnit.pas index 9e6fd49c34..d6a38a662f 100644 --- a/plugins/Chess4Net/ContinueUnit.pas +++ b/plugins/Chess4Net/ContinueUnit.pas @@ -1,9 +1,15 @@ +//////////////////////////////////////////////////////////////////////////////// +// All code below is exclusively owned by author of Chess4Net - Pavel Perminov +// (packpaul@mail.ru, packpaul1@gmail.com). +// Any changes, modifications, borrowing and adaptation are a subject for +// explicit permition from the owner. + unit ContinueUnit; interface uses - Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, {Dialogs, }ExtCtrls, StdCtrls, TntStdCtrls, DialogUnit, ModalForm; diff --git a/plugins/Chess4Net/DialogUnit.pas b/plugins/Chess4Net/DialogUnit.pas index 921d630dba..a8eeeb006e 100644 --- a/plugins/Chess4Net/DialogUnit.pas +++ b/plugins/Chess4Net/DialogUnit.pas @@ -1,3 +1,9 @@ +//////////////////////////////////////////////////////////////////////////////// +// All code below is exclusively owned by author of Chess4Net - Pavel Perminov +// (packpaul@mail.ru, packpaul1@gmail.com). +// Any changes, modifications, borrowing and adaptation are a subject for +// explicit permition from the owner. + unit DialogUnit; interface @@ -13,7 +19,7 @@ type procedure ButtonClick(Sender: TObject); private m_ModID: TModalFormID; - msgDlg: TForm; + m_MsgDlg: TForm; function GetCaption: TCaption; procedure SetCaption(capt: TCaption); protected @@ -25,6 +31,10 @@ type function GetTop_: integer; override; procedure SetTop_(y: integer); override; function GetModalID: TModalFormID; override; + function RGetModalResult: TModalResult; override; + procedure RSetModalResult(Value: TModalResult); override; + + property MsgDlg: TForm read m_MsgDlg; public constructor Create(frmOwner: TForm; const wstrMsg: WideString; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; modID: TModalFormID = mfNone; @@ -58,16 +68,16 @@ begin m_ModID := modID; RHandler := msgDlgHandler; - msgDlg := MessageDialogUnit.CreateMessageDialog(frmOwner, wstrMsg, DlgType, Buttons, + m_MsgDlg := MessageDialogUnit.CreateMessageDialog(frmOwner, wstrMsg, DlgType, Buttons, bStayOnTopIfNoOwner); // msgDlg.FormStyle := frmOwner.FormStyle; - msgDlg.OnShow := FormShow; - msgDlg.OnClose := FormClose; + m_MsgDlg.OnShow := FormShow; + m_MsgDlg.OnClose := FormClose; - for i := 0 to (msgDlg.ComponentCount - 1) do + for i := 0 to (m_MsgDlg.ComponentCount - 1) do begin - if (msgDlg.Components[i] is TButton) then - TButton(msgDlg.Components[i]).OnClick := ButtonClick; + if (m_MsgDlg.Components[i] is TButton) then + TButton(m_MsgDlg.Components[i]).OnClick := ButtonClick; end; end; @@ -83,7 +93,7 @@ end; procedure TDialogForm.FormShow(Sender: TObject); begin - inherited FormShow(msgDlg); + inherited FormShow(m_MsgDlg); end; @@ -91,10 +101,10 @@ procedure TDialogForm.FormClose(Sender: TObject; var Action: TCloseAction); begin if Assigned(dlgOwner) then dlgOwner.UnsetShowing(self); - if (fsModal in msgDlg.FormState) then + if (fsModal in m_MsgDlg.FormState) then exit; if (Assigned(RHandler)) then - RHandler(TModalForm(msgDlg), GetModalID); + RHandler(self, GetModalID); // Action := caFree; Release; end; @@ -102,89 +112,89 @@ end; procedure TDialogForm.Show; begin - msgDlg.Show; + m_MsgDlg.Show; end; procedure TDialogForm.Close; begin - msgDlg.Close; + m_MsgDlg.Close; end; function TDialogForm.ShowModal: integer; begin - Result := msgDlg.ShowModal; + Result := m_MsgDlg.ShowModal; end; procedure TDialogForm.ButtonClick(Sender: TObject); begin - if not (fsModal in msgDlg.FormState) then - msgDlg.Close; + if not (fsModal in m_MsgDlg.FormState) then + m_MsgDlg.Close; end; destructor TDialogForm.Destroy; begin - msgDlg.Release; + m_MsgDlg.Release; inherited; end; function TDialogForm.GetCaption: TCaption; begin - Result := msgDlg.Caption; + Result := m_MsgDlg.Caption; end; procedure TDialogForm.SetCaption(capt: TCaption); begin - msgDlg.Caption := capt; + m_MsgDlg.Caption := capt; end; function TDialogForm.GetHandle: hWnd; begin - Result := msgDlg.Handle; + Result := m_MsgDlg.Handle; end; function TDialogForm.GetEnabled_: boolean; begin - Result := msgDlg.Enabled; + Result := m_MsgDlg.Enabled; end; procedure TDialogForm.SetEnabled_(flag: boolean); begin - msgDlg.Enabled := flag; + m_MsgDlg.Enabled := flag; end; procedure TDialogForm.SetFocus; begin - msgDlg.SetFocus; - msgDlg.Show; + m_MsgDlg.SetFocus; + m_MsgDlg.Show; end; function TDialogForm.GetLeft_: integer; begin - Result := msgDlg.Left; + Result := m_MsgDlg.Left; end; procedure TDialogForm.SetLeft_(x: integer); begin - msgDlg.Left := x; + m_MsgDlg.Left := x; end; function TDialogForm.GetTop_: integer; begin - Result := msgDlg.Top; + Result := m_MsgDlg.Top; end; procedure TDialogForm.SetTop_(y: integer); begin - msgDlg.Top := y; + m_MsgDlg.Top := y; end; @@ -193,4 +203,15 @@ begin Result := m_ModID; end; +function TDialogForm.RGetModalResult: TModalResult; +begin + Result := m_MsgDlg.ModalResult; +end; + + +procedure TDialogForm.RSetModalResult(Value: TModalResult); +begin + m_MsgDlg.ModalResult := Value; +end; + end. diff --git a/plugins/Chess4Net/DontShowMessageDlgUnit.pas b/plugins/Chess4Net/DontShowMessageDlgUnit.pas new file mode 100644 index 0000000000..357b56c8be --- /dev/null +++ b/plugins/Chess4Net/DontShowMessageDlgUnit.pas @@ -0,0 +1,82 @@ +//////////////////////////////////////////////////////////////////////////////// +// All code below is exclusively owned by author of Chess4Net - Pavel Perminov +// (packpaul@mail.ru, packpaul1@gmail.com). +// Any changes, modifications, borrowing and adaptation are a subject for +// explicit permition from the owner. + +unit DontShowMessageDlgUnit; + +interface + +uses + Forms, StdCtrls, + // + DialogUnit, ModalForm; + +type + TDontShowMessageDlg = class(TDialogForm) + private + m_DontShowCheckBox: TCheckBox; + function FGetDontShow: boolean; + procedure FSetDontShow(bValue: boolean); + protected + function GetModalID: TModalFormID; override; + public + class function Create(const ADialogs: TDialogs; const wstrMsg: WideString): TDontShowMessageDlg; overload; + constructor Create(Owner: TForm; modHandler: TModalFormHandler = nil); overload; override; + property DontShow: boolean read FGetDontShow write FSetDontShow; + end; + +implementation + +uses + Dialogs, Controls; + +//////////////////////////////////////////////////////////////////////////////// +// TDontShowMessageDlg + +var + g_wstrMsg: WideString; + +constructor TDontShowMessageDlg.Create(Owner: TForm; modHandler: TModalFormHandler = nil); +begin + inherited Create(Owner, g_wstrMsg, mtInformation, [mbOK], GetModalID, modHandler); + + MsgDlg.Height := MsgDlg.Height + 10; + + m_DontShowCheckBox := TCheckBox.Create(MsgDlg); + m_DontShowCheckBox.Parent := MsgDlg; + m_DontShowCheckBox.Caption := 'Don''t Show'; // TODO: Localize + + m_DontShowCheckBox.Left := 10; + m_DontShowCheckBox.Top := MsgDlg.ClientHeight - m_DontShowCheckBox.Height - 5; +end; + + +class function TDontShowMessageDlg.Create(const ADialogs: TDialogs; + const wstrMsg: WideString): TDontShowMessageDlg; +begin + g_wstrMsg := wstrMsg; + Result := ADialogs.CreateDialog(TDontShowMessageDlg) as TDontShowMessageDlg; + g_wstrMsg := ''; +end; + + +function TDontShowMessageDlg.FGetDontShow: boolean; +begin + Result := m_DontShowCheckBox.Checked; +end; + + +procedure TDontShowMessageDlg.FSetDontShow(bValue: boolean); +begin + m_DontShowCheckBox.Checked := bValue; +end; + + +function TDontShowMessageDlg.GetModalID: TModalFormID; +begin + Result := mfDontShowDlg; +end; + +end. diff --git a/plugins/Chess4Net/DraggedFigureUnit.pas b/plugins/Chess4Net/DraggedFigureUnit.pas index bbf513ae77..780e3bb840 100644 --- a/plugins/Chess4Net/DraggedFigureUnit.pas +++ b/plugins/Chess4Net/DraggedFigureUnit.pas @@ -1,3 +1,9 @@ +//////////////////////////////////////////////////////////////////////////////// +// All code below is exclusively owned by author of Chess4Net - Pavel Perminov +// (packpaul@mail.ru, packpaul1@gmail.com). +// Any changes, modifications, borrowing and adaptation are a subject for +// explicit permition from the owner. + unit DraggedFigureUnit; interface diff --git a/plugins/Chess4Net/GameChessBoardUnit.dfm b/plugins/Chess4Net/GameChessBoardUnit.dfm new file mode 100644 index 0000000000..33bbfcefee --- /dev/null +++ b/plugins/Chess4Net/GameChessBoardUnit.dfm @@ -0,0 +1,166 @@ +object GameChessBoard: TGameChessBoard + Left = 429 + Top = 209 + Width = 372 + Height = 421 + BorderIcons = [biSystemMenu] + Color = clBtnFace + TransparentColorValue = clBackground + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -13 + Font.Name = 'MS Sans Serif' + Font.Style = [fsBold] + KeyPreview = True + OldCreateOrder = False + OnActivate = FormActivate + OnCanResize = FormCanResize + OnClose = FormClose + OnCreate = FormCreate + OnDestroy = FormDestroy + OnKeyDown = FormKeyDown + DesignSize = ( + 356 + 385) + PixelsPerInch = 96 + TextHeight = 16 + object ChessBoardPanel: TPanel + Left = 0 + Top = 32 + Width = 354 + Height = 352 + Anchors = [akLeft, akTop, akRight, akBottom] + BevelOuter = bvNone + TabOrder = 1 + end + object TimePanel: TPanel + Left = 0 + Top = 0 + Width = 356 + Height = 33 + Align = alTop + BevelInner = bvLowered + TabOrder = 0 + OnResize = TimePanelResize + object WhitePanel: TPanel + Left = 8 + Top = 4 + Width = 145 + Height = 25 + BevelOuter = bvNone + TabOrder = 0 + DesignSize = ( + 145 + 25) + object WhiteTimeLabel: TLabel + Left = 71 + Top = 0 + Width = 68 + Height = 25 + Align = alLeft + AutoSize = False + Caption = '0:00:00' + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -19 + Font.Name = 'MS Sans Serif' + Font.Style = [fsBold] + ParentFont = False + Layout = tlCenter + end + object WhiteFlagButton: TSpeedButton + Left = 115 + Top = 2 + Width = 23 + Height = 22 + Anchors = [akTop, akRight] + Glyph.Data = { + 66010000424D6601000000000000760000002800000014000000140000000100 + 040000000000F000000000000000000000001000000000000000000000000000 + 8000008000000080800080000000800080008080000080808000C0C0C0000000 + FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00FFFFFFFFFFFF + FFFFFFFF0000FFFFFFFFFFFFFFFFFFFF0000FFFFFFFFFFFFFFFFFFFF0000FFFF + FFFFFFFFFFFFFFFF0000FFFFFFFFFFFFFFFFFFFF0000FFFFFFFFFFFFFFF83FFF + 0000FFFF99FFFFFFFFF33FFF0000FFFFF99FFFFFFF83FFFF0000FFFFF999FFFF + FF33FFFF0000F99999999FFFF33FFFFF0000FF99999999FF83FFFFFF0000FFF9 + 9999999F33FFFFFF0000FFFF999999983FFFFFFF0000FFFFFF9999993FFFFFFF + 0000FFFFFF999999FFFFFFFF0000FFFFFFF9999FFFFFFFFF0000FFFFFFF9999F + FFFFFFFF0000FFFFFFFF99FFFFFFFFFF0000FFFFFFFF9FFFFFFFFFFF0000FFFF + FFFFFFFFFFFFFFFF0000} + Visible = False + OnClick = FlagButtonClick + end + object WhiteLabel: TTntLabel + Left = 0 + Top = 0 + Width = 71 + Height = 25 + Align = alLeft + Caption = 'White ' + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -19 + Font.Name = 'Microsoft Sans Serif' + Font.Style = [fsBold] + ParentFont = False + end + end + object BlackPanel: TPanel + Left = 184 + Top = 4 + Width = 145 + Height = 25 + BevelOuter = bvNone + TabOrder = 1 + DesignSize = ( + 145 + 25) + object BlackTimeLabel: TLabel + Left = 68 + Top = 0 + Width = 68 + Height = 25 + Align = alLeft + AutoSize = False + Caption = '0:00:00' + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -19 + Font.Name = 'MS Sans Serif' + Font.Style = [fsBold] + ParentFont = False + Layout = tlCenter + end + object BlackLabel: TTntLabel + Left = 0 + Top = 0 + Width = 68 + Height = 25 + Align = alLeft + Caption = 'Black ' + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -19 + Font.Name = 'Microsoft Sans Serif' + Font.Style = [fsBold] + ParentFont = False + end + object BlackFlagButton: TSpeedButton + Left = 115 + Top = 2 + Width = 23 + Height = 22 + Anchors = [akTop, akRight] + Visible = False + OnClick = FlagButtonClick + end + end + end + object GameTimer: TTimer + Enabled = False + Interval = 100 + OnTimer = GameTimerTimer + Left = 8 + Top = 40 + end +end diff --git a/plugins/Chess4Net/GameChessBoardUnit.pas b/plugins/Chess4Net/GameChessBoardUnit.pas new file mode 100644 index 0000000000..779d90f309 --- /dev/null +++ b/plugins/Chess4Net/GameChessBoardUnit.pas @@ -0,0 +1,849 @@ +//////////////////////////////////////////////////////////////////////////////// +// All code below is exclusively owned by author of Chess4Net - Pavel Perminov +// (packpaul@mail.ru, packpaul1@gmail.com). +// Any changes, modifications, borrowing and adaptation are a subject for +// explicit permition from the owner. + +unit GameChessBoardUnit; + +interface + +uses + ExtCtrls, TntStdCtrls, Buttons, Controls, StdCtrls, Classes, Forms, TntForms, + Graphics, Messages, + // Chess4net + ChessBoardHeaderUnit, ChessBoardUnit, ChessRulesEngine, + LocalizerUnit, PosBaseChessBoardLayerUnit; + +type + TGameChessBoardEvent = + (cbeMoved, cbeMate, cbeStaleMate, cbeInsuffMaterial, cbeKeyPressed, + cbeClockSwitched, cbeTimeOut, cbeExit, cbeMenu, cbeActivate, cbeFormMoving, + cbeRefreshAll); + // It's possible to add new events. cbeRefreshAll signals that global options had been changed + + TGameChessBoardHandler = procedure(e: TGameChessBoardEvent; + d1: pointer = nil; d2: pointer = nil) of object; + +{$IFDEF THREADED_CHESSCLOCK} + TGameChessBoard = class; + + TTimeLabelThread = class(TThread) + private + ChessBoard: TGameChessBoard; + player_time: array[TFigureColor] of TDateTime; + protected + procedure Execute; override; + public + WhiteTime, BlackTime: string; + constructor Create(ChessBoard: TGameChessBoard); + end; +{$ENDIF} + + TGameChessBoard = class(TTntForm, ILocalizable) + TimePanel: TPanel; + WhiteLabel: TTntLabel; + WhiteTimeLabel: TLabel; + BlackLabel: TTntLabel; + BlackTimeLabel: TLabel; + GameTimer: TTimer; + WhiteFlagButton: TSpeedButton; + BlackFlagButton: TSpeedButton; + WhitePanel: TPanel; + BlackPanel: TPanel; + ChessBoardPanel: TPanel; + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure GameTimerTimer(Sender: TObject); + procedure FormClose(Sender: TObject; var Action: TCloseAction); + procedure FormKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); + procedure FormActivate(Sender: TObject); + procedure FlagButtonClick(Sender: TObject); + procedure FormCanResize(Sender: TObject; var NewWidth, NewHeight: Integer; + var Resize: Boolean); + procedure TimePanelResize(Sender: TObject); + + private + m_ChessBoard: TChessBoard; + m_PosBaseChessBoardLayer: TPosBaseChessBoardLayer; + + FHandler: TGameChessBoardHandler; + + auto_flag: boolean; // индикатор автофлага + player_time: array[TFigureColor] of TDateTime; // время белых и чёрных + past_time: TDateTime; // время начала обдумывания хода + unlimited_var: array[TFigureColor] of boolean; // партия без временного контроля + clock_color: TFigureColor; // цвет анимируемой фигуры + + shuted: boolean; // индикатор внешнего закрытия окна + + // Resizing + m_ResizingType: (rtNo, rtHoriz, rtVert); +// m_iDeltaWidthHeight: integer; + + m_iTimePanelInitialWidth: integer; + m_iWhitePanelInitialLeft, m_iBlackPanelInitialLeft: integer; + m_iWhitePanelInitialWidth, m_iBlackPanelInitialWidth: integer; + m_TimeFont: TFont; + + m_bFlashOnMove: boolean; // flag for flashing window on icoming move + +{$IFDEF THREADED_CHESSCLOCK} + TimeLabelThread: TTimeLabelThread; // нить используется для борьбы с лагом в Миранде +{$ENDIF} + + function FGetMode: TMode; + procedure FSetMode(const Value: TMode); + procedure ShowTime(const c: TFigureColor); + function FGetPlayerColor: TFigureColor; + procedure FSetPlayerColor(const Value: TFigureColor); + function FGetFlipped: boolean; + procedure FSetFlipped(bValue: boolean); + function FGetTime(color: TFigureColor): TDateTime; + procedure FSetTime(color: TFigureColor; const tm: TDateTime); + procedure FSetUnlimited(color: TFigureColor; const unl: boolean); + function FGetUnlimited(color: TFigureColor): boolean; + function FGetLastMoveHilighted: boolean; + procedure FSetLastMoveHilighted(bValue: boolean); + function FGetCoordinatesShown: boolean; + procedure FSetCoordinatesShown(bValue: boolean); + function GetStayOnTop: boolean; + procedure FSetStayOnTop(onTop: boolean); + procedure FSetAutoFlag(auto_flag: boolean); + procedure FFlashWindow; + function FGetAnimation: TAnimation; + procedure FSetAnimation(const Value: TAnimation); + function FGetViewGaming: boolean; + procedure FSetViewGaming(bValue: boolean); + + // Localization + procedure ILocalizable.Localize = FLocalize; + procedure FLocalize; + + procedure WMMoving(var Msg: TWMMoving); message WM_MOVING; + procedure WMSizing(var Msg: TMessage); message WM_SIZING; + + function FGetPositionColor: TFigureColor; + + function FGetTrainingMode: boolean; + procedure FSetTrainingMode(bValue: boolean); + + function FGetUseUserBase: boolean; + procedure FSetUseUserBase(bValue: boolean); + + procedure FChessBoardHandler(e: TChessBoardEvent; d1: pointer = nil; + d2: pointer = nil); + procedure FDoHandler(e: TGameChessBoardEvent; d1: pointer = nil; + d2: pointer = nil); + + public + constructor Create(Owner: TComponent; AHandler: TGameChessBoardHandler = nil; + const strPosBaseName: string = ''); reintroduce; + + procedure FCreateChessBoard(const strPosBaseName: string); + procedure FDestroyChessBoard; + + procedure TakeBack; // взятие хода обратно + procedure SwitchClock(clock_color: TFigureColor); + procedure InitPosition; + procedure PPRandom; + procedure StopClock; + + procedure ResetMoveList; + function SetPosition(const strPosition: string): boolean; + function GetPosition: string; + function NMoveDone: integer; // количество сделанных ходов + function DoMove(const strMove: string): boolean; + procedure Shut; + + procedure WriteGameToBase(vGameResult: TGameResult); + procedure SetExternalBase(const strExtPosBaseName: string); + procedure UnsetExternalBase; + + property Unlimited[color: TFigureColor]: boolean read FGetUnlimited write FSetUnlimited; + property Time[color: TFigureColor]: TDateTime read FGetTime write FSetTime; + property PlayerColor: TFigureColor read FGetPlayerColor write FSetPlayerColor; + property PositionColor: TFigureColor read FGetPositionColor; // Whos move it is in the current position + property ClockColor: TFigureColor read clock_color; + property Mode: TMode read FGetMode write FSetMode; + property CoordinatesShown: boolean read FGetCoordinatesShown write FSetCoordinatesShown; + + property Flipped: boolean read FGetFlipped write FSetFlipped; + property LastMoveHilighted: boolean read FGetLastMoveHilighted write FSetLastMoveHilighted; + property FlashOnMove: boolean read m_bFlashOnMove write m_bFlashOnMove; + property StayOnTop: boolean read GetStayOnTop write FSetStayOnTop; + property AutoFlag: boolean read auto_flag write FSetAutoFlag; + property Animation: TAnimation read FGetAnimation write FSetAnimation; + property ViewGaming: boolean read FGetViewGaming write FSetViewGaming; + + property pTrainingMode: boolean read FGetTrainingMode write FSetTrainingMode; + property pUseUserBase: boolean read FGetUseUserBase write FSetUseUserBase; + end; + +implementation + +{$J+} + +{$R *.dfm} + +uses + SysUtils, Types, Windows, + // + ChessClockUnit; + +const + TIME_COLOR = clBlack; + + ZEITNOT_COLOR = clMaroon; +// CHEAT_TIME_CONST = 1.5; // > 1 + WHITE_LONG_LABEL: WideString = 'White '; + WHITE_MEDIUM_LABEL: WideString = 'White '; + WHITE_SHORT_LABEL: WideString = 'W '; + BLACK_LONG_LABEL: WideString = 'Black '; + BLACK_MEDIUM_LABEL: WideString = 'Black '; + BLACK_SHORT_LABEL: WideString = 'B '; + +//////////////////////////////////////////////////////////////////////////////// +// TTimeLabelThread + +{$IFDEF THREADED_CHESSCLOCK} +procedure TTimeLabelThread.Execute; +begin + while ChessBoard.GameTimer.Enabled do + begin + if self.player_time[fcWhite] <> ChessBoard.player_time[fcWhite] then + ChessBoard.ShowTime(fcWhite); + if self.player_time[fcBlack] <> ChessBoard.player_time[fcBlack] then + ChessBoard.ShowTime(fcBlack); + Sleep(ChessBoard.GameTimer.Interval div 2); + end; + ChessBoard.TimeLabelThread := nil; +end; + + +constructor TTimeLabelThread.Create(ChessBoard: TGameChessBoard); +begin + self.ChessBoard := ChessBoard; + self.player_time[fcWhite] := ChessBoard.player_time[fcWhite]; + self.player_time[fcBlack] := ChessBoard.player_time[fcBlack]; + + inherited Create(TRUE); +//Priority := tpNormal; + FreeOnTerminate := TRUE; + Resume; +end; +{$ENDIF} + +//////////////////////////////////////////////////////////////////////////////// +// TGameChessBoard + +function TGameChessBoard.DoMove(const strMove: string): boolean; +begin + Result := m_ChessBoard.DoMove(strMove); + if (Result) then + begin + if (m_bFlashOnMove and (Mode = mGame)) then + FFlashWindow; + end; +end; + + +procedure TGameChessBoard.ShowTime(const c: TFigureColor); +var + time_label: TLabel; +begin + if c = fcWhite then time_label:= WhiteTimeLabel + else time_label:= BlackTimeLabel; + + if unlimited_var[c] then + begin + time_label.Caption:= ''; + exit; + end; + + if (TChessClock.IsZeitnot(player_time[c])) then + time_label.Font.Color := ZEITNOT_COLOR + else + time_label.Font.Color := TIME_COLOR; + + time_label.Caption := TChessClock.ConvertToStr(player_time[c]); +end; + + +procedure TGameChessBoard.ResetMoveList; +begin + m_ChessBoard.ResetMoveList; +end; + + +function TGameChessBoard.SetPosition(const strPosition: string): boolean; +begin + Result := m_ChessBoard.SetPosition(strPosition); + if (Result) then + clock_color := PositionColor; +end; + + +function TGameChessBoard.GetPosition: string; +begin + Result := m_ChessBoard.GetPosition; +end; + + +procedure TGameChessBoard.FormCreate(Sender: TObject); +begin + m_iTimePanelInitialWidth := TimePanel.Width; + m_iWhitePanelInitialLeft := WhitePanel.Left; + m_iWhitePanelInitialWidth := WhitePanel.Width; + m_iBlackPanelInitialLeft := BlackPanel.Left; + m_iBlackPanelInitialWidth := BlackPanel.Width; + + m_TimeFont := TFont.Create; + m_TimeFont.Assign(WhiteTimeLabel.Font); + + BlackFlagButton.Glyph := WhiteFlagButton.Glyph; // For size minimization + + TLocalizer.Instance.AddSubscriber(self); + FLocalize; + + // Clock initialization + FSetUnlimited(fcWhite, TRUE); + FSetUnlimited(fcBlack, TRUE); +end; + + +constructor TGameChessBoard.Create(Owner: TComponent; + AHandler: TGameChessBoardHandler = nil; const strPosBaseName: string = ''); +begin + FHandler := AHandler; + inherited Create(Owner); + FCreateChessBoard(strPosBaseName); +end; + + +procedure TGameChessBoard.FCreateChessBoard(const strPosBaseName: string); +begin + m_ChessBoard := TChessBoard.Create(self, FChessBoardHandler); + m_PosBaseChessBoardLayer := TPosBaseChessBoardLayer.Create(strPosBaseName); + + m_ChessBoard.AddLayer(m_PosBaseChessBoardLayer); + + with ChessBoardPanel do + SetBounds(Left, Top, m_ChessBoard.ClientWidth, m_ChessBoard.ClientHeight); + + m_ChessBoard.BorderStyle := bsNone; + m_ChessBoard.Align := alClient; + m_ChessBoard.Parent := ChessBoardPanel; + m_ChessBoard.Visible := TRUE; + + InitPosition; +end; + + +procedure TGameChessBoard.FDestroyChessBoard; +begin + m_ChessBoard.RemoveLayer(m_PosBaseChessBoardLayer); // m_ChessBoard is destroyed by its parent + FreeAndNil(m_PosBaseChessBoardLayer); +end; + + +procedure TGameChessBoard.FormDestroy(Sender: TObject); +begin + TLocalizer.Instance.DeleteSubscriber(self); + + m_TimeFont.Free; + + FDestroyChessBoard; +end; + + +procedure TGameChessBoard.InitPosition; +begin + m_ChessBoard.InitPosition; +end; + + +procedure TGameChessBoard.FSetMode(const Value: TMode); +begin + m_ChessBoard.Mode := Value; + if (Value <> mGame) then + begin + WhiteFlagButton.Visible := FALSE; + BlackFlagButton.Visible := FALSE; + end; +end; + + +function TGameChessBoard.FGetMode: TMode; +begin + Result := m_ChessBoard.Mode; +end; + + +procedure TGameChessBoard.FSetTime(color: TFigureColor; const tm: TDateTime); +begin + if (not Unlimited[color]) then + begin + if ((not auto_flag) and (not ViewGaming)) then + begin + case color of + fcWhite: + WhiteFlagButton.Visible := ((PlayerColor = fcBlack) and (tm = 0.0)); + fcBlack: + BlackFlagButton.Visible := ((PlayerColor = fcWhite) and (tm = 0.0)); + end; + end; + player_time[color] := tm; + ShowTime(color); + end; +end; + + +function TGameChessBoard.FGetTime(color: TFigureColor): TDateTime; +begin + Result:= player_time[color]; +end; + + +procedure TGameChessBoard.GameTimerTimer(Sender: TObject); +begin + if unlimited_var[clock_color] then + begin + GameTimer.Enabled := FALSE; + exit; + end; + // TODO: cheating check + player_time[clock_color] := player_time[clock_color] - (Now - past_time); + if player_time[clock_color] <= 0.0 then + begin + player_time[clock_color] := 0.0; + ShowTime(clock_color); + if ((not auto_flag) and (PlayerColor <> clock_color) and (not ViewGaming)) then + begin + case clock_color of + fcWhite: + WhiteFlagButton.Visible := TRUE; + fcBlack: + BlackFlagButton.Visible := TRUE; + end; + end; + if ((PlayerColor <> clock_color) and (Mode = mGame) and (auto_flag)) then + FDoHandler(cbeTimeOut, self); + GameTimer.Enabled := FALSE; + end; +{$IFNDEF THREADED_CHESSCLOCK} + ShowTime(clock_color); +{$ENDIF} + + past_time:= Now; +end; + + +procedure TGameChessBoard.FSetUnlimited(color: TFigureColor; const unl: boolean); +begin + unlimited_var[color]:= unl; + ShowTime(color); +end; + + +function TGameChessBoard.FGetUnlimited(color: TFigureColor): boolean; +begin + Result := unlimited_var[color]; +end; + + +procedure TGameChessBoard.SwitchClock(clock_color: TFigureColor); +begin + self.clock_color := clock_color; + if (not GameTimer.Enabled) then + begin + past_time := Now; + GameTimer.Enabled := TRUE; + end; + if (Mode = mGame) then + FDoHandler(cbeClockSwitched, self); + ShowTime(clock_color); + +{$IFDEF THREADED_CHESSCLOCK} + if (not Assigned(TimeLabelThread)) then + TimeLabelThread := TTimeLabelThread.Create(self); +{$ENDIF} +end; + + +procedure TGameChessBoard.FSetPlayerColor(const Value: TFigureColor); +begin + m_ChessBoard.PlayerColor := Value; +end; + + +function TGameChessBoard.FGetPlayerColor: TFigureColor; +begin + Result := m_ChessBoard.PlayerColor; +end; + + +procedure TGameChessBoard.StopClock; +begin + GameTimer.Enabled := FALSE; + WhiteFlagButton.Visible := FALSE; + BlackFlagButton.Visible := FALSE; +end; + + +procedure TGameChessBoard.FormCanResize(Sender: TObject; var NewWidth, + NewHeight: Integer; var Resize: Boolean); +var + iNewChessBoardWidth, iNewChessBoardHeight: integer; +begin + Resize := (m_ResizingType <> rtNo); + if (not Resize) then + exit; + + iNewChessBoardWidth := m_ChessBoard.Width + (NewWidth - self.Width); + iNewChessBoardHeight := m_ChessBoard.Height + (NewHeight - self.Height); + + m_ChessBoard.FormCanResize(self, iNewChessBoardWidth, iNewChessBoardHeight, Resize); + if (Resize) then + begin + NewWidth := self.Width + (iNewChessBoardWidth - m_ChessBoard.Width); + NewHeight := self.Height + (iNewChessBoardHeight - m_ChessBoard.Height); + end; +end; + +procedure TGameChessBoard.FormClose(Sender: TObject; var Action: TCloseAction); +begin + if (not shuted) then + begin + FDoHandler(cbeExit, self); + Action:= caNone; + end + else + shuted := FALSE; +end; + + +procedure TGameChessBoard.Shut; +begin + shuted:= TRUE; + Close; +end; + + +procedure TGameChessBoard.PPRandom; +begin + m_ChessBoard.PPRandom; +end; + + +procedure TGameChessBoard.TakeBack; +begin + m_ChessBoard.TakeBack; +end; + + +function TGameChessBoard.FGetLastMoveHilighted: boolean; +begin + Result := m_ChessBoard.LastMoveHilighted; +end; + + +procedure TGameChessBoard.FSetLastMoveHilighted(bValue: boolean); +begin + m_ChessBoard.LastMoveHilighted := bValue; +end; + + +procedure TGameChessBoard.FSetCoordinatesShown(bValue: boolean); +begin + m_ChessBoard.CoordinatesShown := bValue; +end; + + +function TGameChessBoard.FGetCoordinatesShown: boolean; +begin + Result := m_ChessBoard.CoordinatesShown; +end; + + +function TGameChessBoard.NMoveDone: integer; +begin + Result := m_ChessBoard.NMoveDone; +end; + + +procedure TGameChessBoard.FormKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); +begin + FDoHandler(cbeKeyPressed, Pointer(Key), self); +end; + + +function TGameChessBoard.GetStayOnTop: boolean; +begin + Result := (self.FormStyle = fsStayOnTop); +end; + + +procedure TGameChessBoard.FSetStayOnTop(onTop: boolean); +begin + if (onTop) then + self.FormStyle := fsStayOnTop + else + self.FormStyle := fsNormal; +end; + + +procedure TGameChessBoard.FormActivate(Sender: TObject); +begin + FDoHandler(cbeActivate, self); +end; + + +procedure TGameChessBoard.WMMoving(var Msg: TWMMoving); +begin + // TODO: it's possible to handle if form is outside of the screen + FDoHandler(cbeFormMoving, Pointer(Msg.DragRect.Left - Left), Pointer(Msg.DragRect.Top - Top)); + inherited; +end; + + +procedure TGameChessBoard.WMSizing(var Msg: TMessage); +begin + m_ChessBoard.Perform(Msg.Msg, Msg.WParam, Msg.LParam); + + case Msg.WParam of + WMSZ_RIGHT, WMSZ_LEFT, WMSZ_BOTTOMRIGHT, WMSZ_TOPLEFT: + m_ResizingType := rtHoriz; + WMSZ_BOTTOM, WMSZ_TOP: + m_ResizingType := rtVert; + else + begin + m_ResizingType := rtNo; + PRect(Msg.LParam).Left := Left; + PRect(Msg.LParam).Top := Top; + end; + end; // case +end; + + +function TGameChessBoard.FGetPositionColor: TFigureColor; +begin + Result := m_ChessBoard.PositionColor; +end; + + +procedure TGameChessBoard.FlagButtonClick(Sender: TObject); +begin + if (Mode = mGame) then + FDoHandler(cbeTimeOut, self); +end; + + +procedure TGameChessBoard.FSetAutoFlag(auto_flag: boolean); +begin + self.auto_flag := auto_flag; + if (auto_flag) then + begin + WhiteFlagButton.Visible := FALSE; + BlackFlagButton.Visible := FALSE; + end; +end; + + +procedure TGameChessBoard.TimePanelResize(Sender: TObject); +var + rRatio: real; +begin + // Adjust panels on TimePanel + rRatio := TimePanel.Width / m_iTimePanelInitialWidth; + WhitePanel.Left := Round(rRatio * m_iWhitePanelInitialLeft); + WhitePanel.Width := m_iWhitePanelInitialWidth; + BlackPanel.Left := Round(rRatio * m_iBlackPanelInitialLeft); + BlackPanel.Width := m_iBlackPanelInitialWidth; + + + WhiteTimeLabel.Font.Assign(m_TimeFont); + BlackTimeLabel.Font.Assign(m_TimeFont); + + if (WhitePanel.Left + WhitePanel.Width < BlackPanel.Left) then + begin + WhiteLabel.Caption := WHITE_LONG_LABEL; + BlackLabel.Caption := BLACK_LONG_LABEL; + end + else + begin + WhitePanel.Left := 4; + WhitePanel.Width := TimePanel.Width div 2; + BlackPanel.Left := TimePanel.Width div 2; + BlackPanel.Width := TimePanel.Width div 2 - 4; + + WhiteLabel.Caption := WHITE_MEDIUM_LABEL; + BlackLabel.Caption := BLACK_MEDIUM_LABEL; + end; + + // Adjust color labels + if ((WhiteTimeLabel.Left + WhiteTimeLabel.Width > WhitePanel.Width) or + (BlackTimeLabel.Left + BlackTimeLabel.Width > BlackPanel.Width)) then + begin + WhiteLabel.Caption := WHITE_MEDIUM_LABEL; + BlackLabel.Caption := BLACK_MEDIUM_LABEL; + if ((WhiteTimeLabel.Left + WhiteTimeLabel.Width <= WhitePanel.Width) and + (BlackTimeLabel.Left + BlackTimeLabel.Width <= BlackPanel.Width)) then + exit; // TODO: a KLUDGE - make it nice! + + WhiteTimeLabel.Font.Size := WhiteTimeLabel.Font.Size - 4; + BlackTimeLabel.Font.Size := BlackTimeLabel.Font.Size - 4; + WhiteLabel.Caption := WHITE_SHORT_LABEL; + BlackLabel.Caption := BLACK_SHORT_LABEL; + end; +end; + + +procedure TGameChessBoard.FFlashWindow; +var + flushWindowInfo: TFlashWInfo; +begin + // Flash with taskbar + flushWindowInfo.cbSize := SizeOf(flushWindowInfo); + flushWindowInfo.hwnd := Application.Handle; + flushWindowInfo.dwflags := FLASHW_TRAY; // FLASHW_ALL; //FLASHW_TRAY; + flushWindowInfo.ucount := 3; // Flash times + flushWindowInfo.dwtimeout := 0; // speed in msec, 0 - frequency of cursor flashing + FlashWindowEx(flushWindowInfo); + + if (self.Focused) then + exit; + // Flash window + flushWindowInfo.hwnd := self.Handle; // handle of the flashing window + flushWindowInfo.dwflags := FLASHW_CAPTION; // FLASHW_TRAY; // FLASHW_ALL; //FLASHW_TRAY; + FlashWindowEx(flushWindowInfo); +end; + + +procedure TGameChessBoard.FLocalize; +begin + with TLocalizer.Instance do + begin + WHITE_LONG_LABEL := GetLabel(13); + WHITE_MEDIUM_LABEL := GetLabel(14); + WHITE_SHORT_LABEL := GetLabel(15); + BLACK_LONG_LABEL := GetLabel(16); + BLACK_MEDIUM_LABEL := GetLabel(17); + BLACK_SHORT_LABEL := GetLabel(18); + end; + + TimePanelResize(nil); +end; + + +procedure TGameChessBoard.WriteGameToBase(vGameResult: TGameResult); +begin + m_PosBaseChessBoardLayer.WriteGameToBase(vGameResult); +end; + + +procedure TGameChessBoard.SetExternalBase(const strExtPosBaseName: string); +begin + m_PosBaseChessBoardLayer.SetExternalBase(strExtPosBaseName); +end; + + +procedure TGameChessBoard.UnsetExternalBase; +begin + m_PosBaseChessBoardLayer.UnsetExternalBase; +end; + + +function TGameChessBoard.FGetTrainingMode: boolean; +begin + Result := m_PosBaseChessBoardLayer.TrainingMode; +end; + + +procedure TGameChessBoard.FSetTrainingMode(bValue: boolean); +begin + m_PosBaseChessBoardLayer.TrainingMode := bValue; +end; + + +function TGameChessBoard.FGetUseUserBase: boolean; +begin + Result := m_PosBaseChessBoardLayer.UseUserBase; +end; + + +procedure TGameChessBoard.FSetUseUserBase(bValue: boolean); +begin + m_PosBaseChessBoardLayer.UseUserBase := bValue; +end; + + +function TGameChessBoard.FGetFlipped: boolean; +begin + Result := m_ChessBoard.Flipped; +end; + + +procedure TGameChessBoard.FSetFlipped(bValue: boolean); +begin + m_ChessBoard.Flipped := bValue; +end; + + +function TGameChessBoard.FGetAnimation: TAnimation; +begin + Result := m_ChessBoard.Animation; +end; + + +procedure TGameChessBoard.FSetAnimation(const Value: TAnimation); +begin + m_ChessBoard.Animation := Value; +end; + + +function TGameChessBoard.FGetViewGaming: boolean; +begin + Result := m_ChessBoard.ViewGaming; +end; + + +procedure TGameChessBoard.FSetViewGaming(bValue: boolean); +begin + m_ChessBoard.ViewGaming := bValue; +end; + + +procedure TGameChessBoard.FChessBoardHandler(e: TChessBoardEvent; d1: pointer = nil; + d2: pointer = nil); +begin + case e of + ChessBoardUnit.cbeMate: + FDoHandler(cbeMate, self); + + ChessBoardUnit.cbeStaleMate: + FDoHandler(cbeStaleMate, self); + + ChessBoardUnit.cbeMoved: + begin + if ((Mode = mGame) and (PositionColor <> PlayerColor)) then + FDoHandler(cbeMoved, d1, self); + SwitchClock(PositionColor); + end; + + ChessBoardUnit.cbeMenu: + FDoHandler(cbeMenu, self); + end; +end; + + +procedure TGameChessBoard.FDoHandler(e: TGameChessBoardEvent; d1: pointer = nil; + d2: pointer = nil); +begin + if (Assigned(FHandler)) then + FHandler(e, d1, d2); +end; + +end. diff --git a/plugins/Chess4Net/GameOptionsUnit.dfm b/plugins/Chess4Net/GameOptionsUnit.dfm index d1a5804a6f..6c529ecf8c 100644 --- a/plugins/Chess4Net/GameOptionsUnit.dfm +++ b/plugins/Chess4Net/GameOptionsUnit.dfm @@ -5,7 +5,7 @@ object GameOptionsForm: TGameOptionsForm BorderStyle = bsDialog Caption = 'Game Options' ClientHeight = 503 - ClientWidth = 387 + ClientWidth = 412 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText @@ -18,7 +18,7 @@ object GameOptionsForm: TGameOptionsForm PixelsPerInch = 96 TextHeight = 13 object OkButton: TTntButton - Left = 304 + Left = 328 Top = 16 Width = 75 Height = 25 @@ -28,7 +28,7 @@ object GameOptionsForm: TGameOptionsForm TabOrder = 3 end object CancelButton: TTntButton - Left = 304 + Left = 328 Top = 48 Width = 75 Height = 25 @@ -40,7 +40,7 @@ object GameOptionsForm: TGameOptionsForm object TimeControlGroupBox: TTntGroupBox Left = 8 Top = 8 - Width = 281 + Width = 305 Height = 265 Caption = 'Time Control' TabOrder = 0 @@ -58,17 +58,17 @@ object GameOptionsForm: TGameOptionsForm object YouGroupBox: TTntGroupBox Left = 32 Top = 48 - Width = 225 + Width = 249 Height = 97 Caption = 'Your time' TabOrder = 1 DesignSize = ( - 225 + 249 97) object YouMinLabel: TTntLabel Left = 16 Top = 42 - Width = 129 + Width = 145 Height = 14 AutoSize = False Caption = 'Minutes per game:' @@ -76,7 +76,7 @@ object GameOptionsForm: TGameOptionsForm object YouIncLabel: TTntLabel Left = 16 Top = 66 - Width = 129 + Width = 145 Height = 14 AutoSize = False Caption = 'Increment in seconds:' @@ -105,7 +105,7 @@ object GameOptionsForm: TGameOptionsForm object YouUnlimitedCheckBox: TTntCheckBox Left = 16 Top = 16 - Width = 193 + Width = 217 Height = 17 Anchors = [akLeft, akTop, akRight] Caption = 'Unlimited' @@ -136,17 +136,17 @@ object GameOptionsForm: TGameOptionsForm object OpponentGroupBox: TTntGroupBox Left = 32 Top = 152 - Width = 225 + Width = 249 Height = 97 Caption = 'Opponent'#39's time' TabOrder = 2 DesignSize = ( - 225 + 249 97) object OpponentMinLabel: TTntLabel Left = 16 Top = 42 - Width = 129 + Width = 145 Height = 13 AutoSize = False Caption = 'Minutes per game:' @@ -154,7 +154,7 @@ object GameOptionsForm: TGameOptionsForm object OpponentIncLabel: TTntLabel Left = 16 Top = 66 - Width = 129 + Width = 145 Height = 13 AutoSize = False Caption = 'Increment in seconds:' @@ -183,7 +183,7 @@ object GameOptionsForm: TGameOptionsForm object OpponentUnlimitedCheckBox: TTntCheckBox Left = 16 Top = 16 - Width = 193 + Width = 217 Height = 17 Anchors = [akLeft, akTop, akRight] Caption = 'Unlimited' @@ -215,18 +215,18 @@ object GameOptionsForm: TGameOptionsForm object Panel1: TPanel Left = 8 Top = 390 - Width = 281 + Width = 305 Height = 105 BevelInner = bvRaised BevelOuter = bvLowered TabOrder = 2 DesignSize = ( - 281 + 305 105) object AutoFlagCheckBox: TTntCheckBox Left = 8 Top = 80 - Width = 265 + Width = 289 Height = 17 Anchors = [akLeft, akTop, akRight] Caption = 'Auto Flag' @@ -237,7 +237,7 @@ object GameOptionsForm: TGameOptionsForm object TakeBackCheckBox: TTntCheckBox Left = 8 Top = 56 - Width = 265 + Width = 289 Height = 17 Anchors = [akLeft, akTop, akRight] Caption = 'Allow takebacks to your partner' @@ -246,7 +246,7 @@ object GameOptionsForm: TGameOptionsForm object GamePauseCheckBox: TTntCheckBox Left = 8 Top = 8 - Width = 265 + Width = 289 Height = 17 Anchors = [akLeft, akTop, akRight] Caption = 'Game can be paused' @@ -255,7 +255,7 @@ object GameOptionsForm: TGameOptionsForm object GameAdjournCheckBox: TTntCheckBox Left = 8 Top = 32 - Width = 265 + Width = 289 Height = 17 Anchors = [akLeft, akTop, akRight] Caption = 'Game can be adjourned' @@ -265,12 +265,12 @@ object GameOptionsForm: TGameOptionsForm object TrainingModeGroupBox: TTntGroupBox Left = 8 Top = 280 - Width = 281 + Width = 305 Height = 97 Caption = 'Training Mode' TabOrder = 1 DesignSize = ( - 281 + 305 97) object ExtBaseLabel: TTntLabel Left = 16 @@ -292,7 +292,7 @@ object GameOptionsForm: TGameOptionsForm object ExtBaseComboBox: TTntComboBox Left = 104 Top = 36 - Width = 145 + Width = 169 Height = 21 Enabled = False ItemHeight = 13 @@ -306,7 +306,7 @@ object GameOptionsForm: TGameOptionsForm object UsrBaseCheckBox: TTntCheckBox Left = 40 Top = 64 - Width = 233 + Width = 257 Height = 17 Anchors = [akLeft, akTop, akRight] Caption = 'Use user base' diff --git a/plugins/Chess4Net/GameOptionsUnit.pas b/plugins/Chess4Net/GameOptionsUnit.pas index 23f2b5db07..0c8fd6cdeb 100644 --- a/plugins/Chess4Net/GameOptionsUnit.pas +++ b/plugins/Chess4Net/GameOptionsUnit.pas @@ -1,9 +1,15 @@ +//////////////////////////////////////////////////////////////////////////////// +// All code below is exclusively owned by author of Chess4Net - Pavel Perminov +// (packpaul@mail.ru, packpaul1@gmail.com). +// Any changes, modifications, borrowing and adaptation are a subject for +// explicit permition from the owner. + unit GameOptionsUnit; interface uses - Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, + Windows, Messages, SysUtils, Classes, Graphics, Controls, Dialogs, StdCtrls, TntStdCtrls, ExtCtrls, ComCtrls, ModalForm; diff --git a/plugins/Chess4Net/GlobalsUnit.pas b/plugins/Chess4Net/GlobalsUnit.pas index 435cde0831..2cd0619882 100644 --- a/plugins/Chess4Net/GlobalsUnit.pas +++ b/plugins/Chess4Net/GlobalsUnit.pas @@ -1,9 +1,23 @@ +//////////////////////////////////////////////////////////////////////////////// +// All code below is exclusively owned by author of Chess4Net - Pavel Perminov +// (packpaul@mail.ru, packpaul1@gmail.com). +// Any changes, modifications, borrowing and adaptation are a subject for +// explicit permition from the owner. + unit GlobalsUnit; interface const DIALOG_CAPTION = 'Chess4Net'; + GAME_LOG_FILE = 'Chess4Net_GAMELOG.txt'; + + INITIAL_CLOCK_TIME = '5 0 5 0'; // 5:00 5:00 + +var + Chess4NetPath: string; + Chess4NetIniFilePath: string; + Chess4NetGamesLogPath: string; implementation diff --git a/plugins/Chess4Net/InfoUnit.dfm b/plugins/Chess4Net/InfoUnit.dfm index c3e62247cc..a153dac36b 100644 --- a/plugins/Chess4Net/InfoUnit.dfm +++ b/plugins/Chess4Net/InfoUnit.dfm @@ -51,7 +51,7 @@ object InfoForm: TInfoForm Height = 13 Alignment = taCenter AutoSize = False - Caption = #169' 2007-2010 no rights reserved' + Caption = #169' 2007-2011 no rights reserved' end object Label4: TLabel Left = 38 diff --git a/plugins/Chess4Net/InfoUnit.pas b/plugins/Chess4Net/InfoUnit.pas index 66dfdc222d..f4b349a71d 100644 --- a/plugins/Chess4Net/InfoUnit.pas +++ b/plugins/Chess4Net/InfoUnit.pas @@ -1,9 +1,15 @@ +//////////////////////////////////////////////////////////////////////////////// +// All code below is exclusively owned by author of Chess4Net - Pavel Perminov +// (packpaul@mail.ru, packpaul1@gmail.com). +// Any changes, modifications, borrowing and adaptation are a subject for +// explicit permition from the owner. + unit InfoUnit; interface uses - Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ShellAPI; type @@ -64,7 +70,7 @@ end; procedure TInfoForm.FormCreate(Sender: TObject); begin - PlayingViaLabel.Caption := PLUGIN_PLAYING_VIA; + PlayingViaLabel.Caption := PLUGIN_PLAYING_OVER; PluginNameLabel.Caption := PLUGIN_INFO_NAME; URLLabel.Caption := PLUGIN_URL; EMailLabel.Caption := PLUGIN_EMAIL; diff --git a/plugins/Chess4Net/IniSettingsUnit.pas b/plugins/Chess4Net/IniSettingsUnit.pas new file mode 100644 index 0000000000..468035404e --- /dev/null +++ b/plugins/Chess4Net/IniSettingsUnit.pas @@ -0,0 +1,348 @@ +//////////////////////////////////////////////////////////////////////////////// +// All code below is exclusively owned by author of Chess4Net - Pavel Perminov +// (packpaul@mail.ru, packpaul1@gmail.com). +// Any changes, modifications, borrowing and adaptation are a subject for +// explicit permition from the owner. + +unit IniSettingsUnit; + +interface + +uses + TntIniFiles, + // + ChessBoardUnit, ChessRulesEngine; + +type + TIniSettingsID = (isidLastMoveHilighted, isidFlashOnMove, isidCoordinatesShown, + isidStayOnTop, isidExtraExit, isidActiveLanguage, isidDontShowLastVersion, + isidDontShowCredits, isidClock, isidTrainingMode, isidCanPauseGame, + isidCanAdjournGame, isidExternalBaseName, isidUseUserBase, isidAllowTakebacks, + isidAutoFlag, isidAdjourned); + + TIniSettings = class + private + m_IniFile: TTntIniFile; + + m_strOpponentId: string; + + constructor FCreate; + function FGetIniFileName: string; + + function FGetBooleanValue(ID: TIniSettingsID): boolean; + procedure FSetBooleanValue(ID: TIniSettingsID; bValue: boolean); + + function FGetIntegerValue(ID: TIniSettingsID): integer; + procedure FSetIntegerValue(ID: TIniSettingsID; iValue: integer); + + function FGetStringValue(ID: TIniSettingsID): string; + procedure FSetStringValue(ID: TIniSettingsID; const strValue: string); + + function FGetAnimation: TAnimation; + procedure FSetAnimation(Value: TAnimation); + + function FGetCommonSectionName: string; + + function FGetPlayerColor: TFigureColor; + procedure FSetPlayerColor(Value: TFigureColor); + + public + destructor Destroy; override; + + class function Instance: TIniSettings; + class procedure FreeInstance; reintroduce; + + procedure SetOpponentId(const strValue: string); + function HasCommonSettings: boolean; + + // private settings + property Animation: TAnimation + read FGetAnimation write FSetAnimation; + property LastMoveHilighted: boolean index isidLastMoveHilighted + read FGetBooleanValue write FSetBooleanValue; + property FlashOnMove: boolean index isidFlashOnMove + read FGetBooleanValue write FSetBooleanValue; + property CoordinatesShown: boolean index isidCoordinatesShown + read FGetBooleanValue write FSetBooleanValue; + property StayOnTop: boolean index isidStayOnTop + read FGetBooleanValue write FSetBooleanValue; + property ExtraExit: boolean index isidExtraExit + read FGetBooleanValue write FSetBooleanValue; + property ActiveLanguage: integer index isidActiveLanguage + read FGetIntegerValue write FSetIntegerValue; + property DontShowLastVersion: integer index isidDontShowLastVersion + read FGetIntegerValue write FSetIntegerValue; + property DontShowCredits: boolean index isidDontShowCredits + read FGetBooleanValue write FSetBooleanValue; + + // common settings + property PlayerColor: TFigureColor + read FGetPlayerColor write FSetPlayerColor; + property Clock: string index isidClock + read FGetStringValue write FSetStringValue; + property TrainingMode: boolean index isidTrainingMode + read FGetBooleanValue write FSetBooleanValue; + property CanPauseGame: boolean index isidCanPauseGame + read FGetBooleanValue write FSetBooleanValue; + property CanAdjournGame: boolean index isidCanAdjournGame + read FGetBooleanValue write FSetBooleanValue; + property ExternalBaseName: string index isidExternalBaseName + read FGetStringValue write FSetStringValue; + property UseUserBase: boolean index isidUseUserBase + read FGetBooleanValue write FSetBooleanValue; + property AllowTakebacks: boolean index isidAllowTakebacks + read FGetBooleanValue write FSetBooleanValue; + property AutoFlag: boolean index isidAutoFlag + read FGetBooleanValue write FSetBooleanValue; + property Adjourned: string index isidAdjourned + read FGetStringValue write FSetStringValue; + end; + +implementation + +uses + SysUtils, + // + GlobalsUnit, GlobalsLocalUnit; + +const + INI_FILE_NAME = 'Chess4Net.ini'; + + PRIVATE_SECTION_NAME = 'Private'; + COMMON_SECTION_PREFIX = 'Common'; + ANIMATION_KEY_NAME = 'Animation'; + HILIGHT_LAST_MOVE_KEY_NAME = 'HilightLastMove'; + FLASH_ON_MOVE_NAME = 'FlashOnMove'; + SHOW_COORDINATES_KEY_NAME = 'ShowCoordinates'; + STAY_ON_TOP_KEY_NAME = 'StayOnTop'; + EXTRA_EXIT_KEY_NAME = 'ExtraExit'; + CAN_PAUSE_GAME_KEY_NAME = 'CanPauseGame'; + CAN_ADJOURN_GAME_KEY_NAME = 'CanAdjournGame'; + ALLOW_TAKEBACKS_KEY_NAME = 'AllowTakebacks'; + EXTERNAL_BASE_NAME_KEY_NAME = 'ExternalBaseName'; + USE_USER_BASE_KEY_NAME = 'UseUserBase'; + AUTO_FLAG_KEY_NAME = 'AutoFlag'; + TRAINING_MODE_KEY_NAME = 'TrainingMode'; + PLAYER_COLOR_KEY_NAME = 'PlayerColor'; + CLOCK_KEY_NAME = 'Clock'; + ADJOURNED_KEY_NAME = 'Adjourned'; + LANGUAGE_KEY_NAME = 'Language'; + DONT_SHOW_CREDITS = 'DontShowCredits'; + DONT_SHOW_LAST_VERSION = 'DontShowLastVersion'; + +var + g_Instance: TIniSettings = nil; + +//////////////////////////////////////////////////////////////////////////////// +// TIniSettings + +constructor TIniSettings.FCreate; +begin + inherited Create; + m_IniFile := TTntIniFile.Create(FGetIniFileName); +end; + + +destructor TIniSettings.Destroy; +begin + m_IniFile.Free; + inherited; +end; + + +class function TIniSettings.Instance: TIniSettings; +begin + if (not Assigned(g_Instance)) then + g_Instance := TIniSettings.FCreate; + Result := g_Instance; +end; + + +class procedure TIniSettings.FreeInstance; +begin + FreeAndNil(g_Instance); +end; + + +function TIniSettings.FGetIniFileName: string; +begin + Result := Chess4NetIniFilePath + INI_FILE_NAME; +end; + + +function TIniSettings.FGetAnimation: TAnimation; +begin + Result := TAnimation(m_IniFile.ReadInteger(PRIVATE_SECTION_NAME, ANIMATION_KEY_NAME, Ord(aQuick))) +end; + + +procedure TIniSettings.FSetAnimation(Value: TAnimation); +begin + m_IniFile.WriteInteger(PRIVATE_SECTION_NAME, ANIMATION_KEY_NAME, Ord(Value)); +end; + + +function TIniSettings.FGetBooleanValue(ID: TIniSettingsID): boolean; +begin + case ID of + isidLastMoveHilighted: + Result := m_IniFile.ReadBool(PRIVATE_SECTION_NAME, HILIGHT_LAST_MOVE_KEY_NAME, FALSE); + isidFlashOnMove: + Result := m_IniFile.ReadBool(PRIVATE_SECTION_NAME, FLASH_ON_MOVE_NAME, FALSE); + isidCoordinatesShown: + Result := m_IniFile.ReadBool(PRIVATE_SECTION_NAME, SHOW_COORDINATES_KEY_NAME, TRUE); + isidStayOnTop: + Result := m_IniFile.ReadBool(PRIVATE_SECTION_NAME, STAY_ON_TOP_KEY_NAME, FALSE); + isidExtraExit: + Result := m_IniFile.ReadBool(PRIVATE_SECTION_NAME, EXTRA_EXIT_KEY_NAME, FALSE); + isidDontShowCredits: + Result := m_IniFile.ReadBool(PRIVATE_SECTION_NAME, DONT_SHOW_CREDITS, FALSE); + isidTrainingMode: + Result := m_IniFile.ReadBool(FGetCommonSectionName, TRAINING_MODE_KEY_NAME, FALSE); + isidCanPauseGame: + Result := m_IniFile.ReadBool(FGetCommonSectionName, CAN_PAUSE_GAME_KEY_NAME, FALSE); + isidCanAdjournGame: + Result := m_IniFile.ReadBool(FGetCommonSectionName, CAN_ADJOURN_GAME_KEY_NAME, FALSE); + isidUseUserBase: + Result := m_IniFile.ReadBool(FGetCommonSectionName, USE_USER_BASE_KEY_NAME, FALSE); + isidAllowTakebacks: + Result := m_IniFile.ReadBool(FGetCommonSectionName, ALLOW_TAKEBACKS_KEY_NAME, FALSE); + isidAutoFlag: + Result := m_IniFile.ReadBool(FGetCommonSectionName, AUTO_FLAG_KEY_NAME, FALSE); + else + Result := FALSE; + Assert(FALSE); + end; +end; + + +procedure TIniSettings.FSetBooleanValue(ID: TIniSettingsID; bValue: boolean); +begin + case ID of + isidLastMoveHilighted: + m_IniFile.WriteBool(PRIVATE_SECTION_NAME, HILIGHT_LAST_MOVE_KEY_NAME, bValue); + isidFlashOnMove: + m_IniFile.WriteBool(PRIVATE_SECTION_NAME, FLASH_ON_MOVE_NAME, bValue); + isidCoordinatesShown: + m_IniFile.WriteBool(PRIVATE_SECTION_NAME, SHOW_COORDINATES_KEY_NAME, bValue); + isidStayOnTop: + m_IniFile.WriteBool(PRIVATE_SECTION_NAME, STAY_ON_TOP_KEY_NAME, bValue); + isidExtraExit: + m_IniFile.WriteBool(PRIVATE_SECTION_NAME, EXTRA_EXIT_KEY_NAME, bValue); + isidDontShowCredits: + m_IniFile.WriteBool(PRIVATE_SECTION_NAME, DONT_SHOW_CREDITS, bValue); + isidTrainingMode: + m_IniFile.WriteBool(FGetCommonSectionName, TRAINING_MODE_KEY_NAME, bValue); + isidCanPauseGame: + m_IniFile.WriteBool(FGetCommonSectionName, CAN_PAUSE_GAME_KEY_NAME, bValue); + isidCanAdjournGame: + m_IniFile.WriteBool(FGetCommonSectionName, CAN_ADJOURN_GAME_KEY_NAME, bValue); + isidUseUserBase: + m_IniFile.WriteBool(FGetCommonSectionName, USE_USER_BASE_KEY_NAME, bValue); + isidAllowTakebacks: + m_IniFile.WriteBool(FGetCommonSectionName, ALLOW_TAKEBACKS_KEY_NAME, bValue); + isidAutoFlag: + m_IniFile.WriteBool(FGetCommonSectionName, AUTO_FLAG_KEY_NAME, bValue); + else + Assert(FALSE); + end; +end; + + +function TIniSettings.FGetIntegerValue(ID: TIniSettingsID): integer; +begin + case ID of + isidActiveLanguage: + Result := m_IniFile.ReadInteger(PRIVATE_SECTION_NAME, LANGUAGE_KEY_NAME, 1) - 1; + isidDontShowLastVersion: + Result := m_IniFile.ReadInteger(PRIVATE_SECTION_NAME, DONT_SHOW_LAST_VERSION, CHESS4NET_VERSION); + else + Result := 0; + Assert(FALSE); + end; +end; + + +procedure TIniSettings.FSetIntegerValue(ID: TIniSettingsID; iValue: integer); +begin + case ID of + isidActiveLanguage: + m_IniFile.WriteInteger(PRIVATE_SECTION_NAME, LANGUAGE_KEY_NAME, iValue + 1); + isidDontShowLastVersion: + m_IniFile.WriteInteger(PRIVATE_SECTION_NAME, DONT_SHOW_LAST_VERSION, iValue); + else + Assert(FALSE); + end; +end; + + +function TIniSettings.FGetStringValue(ID: TIniSettingsID): string; +begin + case ID of + isidClock: + Result := m_IniFile.ReadString(FGetCommonSectionName, CLOCK_KEY_NAME, INITIAL_CLOCK_TIME); + isidExternalBaseName: + Result := m_IniFile.ReadString(FGetCommonSectionName, EXTERNAL_BASE_NAME_KEY_NAME, ''); + isidAdjourned: + Result := m_IniFile.ReadString(FGetCommonSectionName, ADJOURNED_KEY_NAME, ''); + else + Result := ''; + Assert(FALSE); + end; +end; + + +procedure TIniSettings.FSetStringValue(ID: TIniSettingsID; const strValue: string); +begin + case ID of + isidClock: + m_IniFile.WriteString(FGetCommonSectionName, CLOCK_KEY_NAME, strValue); + isidExternalBaseName: + m_IniFile.WriteString(FGetCommonSectionName, EXTERNAL_BASE_NAME_KEY_NAME, strValue); + isidAdjourned: + begin + m_IniFile.WriteString(FGetCommonSectionName, ADJOURNED_KEY_NAME, strValue); + m_IniFile.UpdateFile; + end; + else + Assert(FALSE); + end; +end; + + +procedure TIniSettings.SetOpponentId(const strValue: string); +begin + m_strOpponentId := strValue; +end; + + +function TIniSettings.HasCommonSettings: boolean; +begin + Result := m_IniFile.SectionExists(FGetCommonSectionName); +end; + + +function TIniSettings.FGetCommonSectionName: string; +begin + Result := COMMON_SECTION_PREFIX + ' ' + m_strOpponentId; +end; + + +function TIniSettings.FGetPlayerColor: TFigureColor; +begin + Result := TFigureColor(m_IniFile.ReadInteger( + FGetCommonSectionName, PLAYER_COLOR_KEY_NAME, Ord(fcBlack))) +end; + + +procedure TIniSettings.FSetPlayerColor(Value: TFigureColor); +begin + m_IniFile.WriteInteger(FGetCommonSectionName, PLAYER_COLOR_KEY_NAME, Ord(Value)); +end; + +initialization + +finalization + TIniSettings.FreeInstance; + +end. diff --git a/plugins/Chess4Net/Lang.ini b/plugins/Chess4Net/Lang.ini index 8131f9dea4..6aa5de5595 100644 Binary files a/plugins/Chess4Net/Lang.ini and b/plugins/Chess4Net/Lang.ini differ diff --git a/plugins/Chess4Net/LocalizerUnit.pas b/plugins/Chess4Net/LocalizerUnit.pas index 71f63367a7..bd4644bbc3 100644 --- a/plugins/Chess4Net/LocalizerUnit.pas +++ b/plugins/Chess4Net/LocalizerUnit.pas @@ -1,3 +1,9 @@ +//////////////////////////////////////////////////////////////////////////////// +// All code below is exclusively owned by author of Chess4Net - Pavel Perminov +// (packpaul@mail.ru, packpaul1@gmail.com). +// Any changes, modifications, borrowing and adaptation are a subject for +// explicit permition from the owner. + unit LocalizerUnit; interface @@ -47,13 +53,14 @@ implementation uses StrUtils, Forms, TntIniFiles, - GlobalsLocalUnit; + // + GlobalsUnit; const LOCALIZER_INI_FILE = 'Lang.ini'; // Labels are used to name interface controls s.a. TLabel and the like - DEFAULT_LABELS: array[0..67] of WideString = + DEFAULT_LABELS: array[0..69] of WideString = ('Look & Feel Options', {0} 'Animate Move:', 'No', @@ -121,7 +128,9 @@ const 'If you liked plying Chess4Net give your credits at', '&Close', 'Don''t show again', - 'Transmit Game' + 'Transmit Game', + 'Select Skype contact', + 'Broadcast...' ); // Messages are used in message boxes diff --git a/plugins/Chess4Net/LookFeelOptionsUnit.pas b/plugins/Chess4Net/LookFeelOptionsUnit.pas index 138ab498ae..7fe03b2a70 100644 --- a/plugins/Chess4Net/LookFeelOptionsUnit.pas +++ b/plugins/Chess4Net/LookFeelOptionsUnit.pas @@ -1,9 +1,15 @@ +//////////////////////////////////////////////////////////////////////////////// +// All code below is exclusively owned by author of Chess4Net - Pavel Perminov +// (packpaul@mail.ru, packpaul1@gmail.com). +// Any changes, modifications, borrowing and adaptation are a subject for +// explicit permition from the owner. + unit LookFeelOptionsUnit; interface uses - Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, ModalForm, TntStdCtrls, // Chess4Net units @@ -47,10 +53,6 @@ procedure TLookFeelOptionsForm.FormCreate(Sender: TObject); var i: integer; begin -{$IFDEF SKYPE} - StayOnTopBox.Enabled := FALSE; // TODO: this was done to prevent non-modal dialogs be overlapped by ChessForm. Resolve later -{$ENDIF} - // Fill GUI Languages combo box GUILangComboBox.Clear; with TLocalizer.Instance do diff --git a/plugins/Chess4Net/MI/Chess4Net_MI.cfg.bak b/plugins/Chess4Net/MI/Chess4Net_MI.cfg.bak deleted file mode 100644 index c2321660ff..0000000000 --- a/plugins/Chess4Net/MI/Chess4Net_MI.cfg.bak +++ /dev/null @@ -1,47 +0,0 @@ --$A8 --$B- --$C+ --$D+ --$E- --$F- --$G+ --$H+ --$I- --$J+ --$K- --$L+ --$M- --$N+ --$O- --$P+ --$Q- --$R- --$S- --$T- --$U- --$V+ --$W- --$X+ --$YD --$Z1 --cg --vn --vr --AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; --H+ --W+ --M --$M16384,1048576 --K$00400000 --E"..\..\Testing\IMEServices\IMEClient2\Plugins" --N".\dcu" --LE"c:\program files\borland\delphi7\Projects\Bpl" --LN"c:\program files\borland\delphi7\Projects\Bpl" --U"c:\program files\borland\delphi7\Lib\Debug;.\MirandaINC;..\lib\FastMM4;..\lib\PNGImage;..\lib\TntUnicodeControls\Source" --O"c:\program files\borland\delphi7\Lib\Debug;.\MirandaINC;..\lib\FastMM4;..\lib\PNGImage;..\lib\TntUnicodeControls\Source" --I"c:\program files\borland\delphi7\Lib\Debug;.\MirandaINC;..\lib\FastMM4;..\lib\PNGImage;..\lib\TntUnicodeControls\Source" --R"c:\program files\borland\delphi7\Lib\Debug;.\MirandaINC;..\lib\FastMM4;..\lib\PNGImage;..\lib\TntUnicodeControls\Source" --DMIRANDA;xFASTMM4;xDEBUG_LOG --w-UNSAFE_TYPE --w-UNSAFE_CODE --w-UNSAFE_CAST diff --git a/plugins/Chess4Net/MI/Chess4Net_MI.dof b/plugins/Chess4Net/MI/Chess4Net_MI.dof index b7ba2c3184..5b7c6eacea 100644 --- a/plugins/Chess4Net/MI/Chess4Net_MI.dof +++ b/plugins/Chess4Net/MI/Chess4Net_MI.dof @@ -94,17 +94,21 @@ OutputDir=..\bin UnitOutputDir=.\dcu PackageDLLOutputDir= PackageDCPOutputDir= -SearchPath=.\MirandaINC;..\lib\FastMM4;..\lib\PNGImage;..\lib\TntUnicodeControls\Source +SearchPath=.\MirandaINC;..\res\Delphi;..\lib\FastMM4;..\lib\PNGImage;..\lib\XIE;..\lib\TntUnicodeControls\Source Packages=vcl;rtl;dbrtl;vcldb;vclx;bdertl;delphiclxide;proide;delphivclide;direct;vclie;stride;VclSmp;vclactnband Conditionals=MIRANDA;xFASTMM4;xDEBUG_LOG DebugSourceDirs= UsePackages=0 [Parameters] RunParams= -HostApplication=C:\Documents and Settings\Pavel\Мои документы\Programming\Chess4Net\Testing\Client1\TestingHost.exe +HostApplication= Launcher= UseLauncher=0 DebugCWD= +[Language] +ActiveLang= +ProjectLang= +RootDir= [Version Info] IncludeVerInfo=0 AutoIncBuild=0 @@ -131,42 +135,36 @@ ProductName= ProductVersion=1.0.0.0 Comments= [HistoryLists\hlConditionals] -Count=14 -Item0=MIRANDA;xFASTMM4;xDEBUG_LOG -Item1=SOCKET;xFASTMM4 -Item2=QIP;xFASTMM4; -Item3=AND_RQ;xFASTMM4 -Item4=TRILLIAN;xFASTMM4 -Item5=SOCKET;FASTMM4 -Item6=MIRANDA;FASTMM4 -Item7=MIRANDA;xFASTMM4 -Item8=xFASTMM4;TRILLIAN -Item9=SOCKET -Item10=QIP -Item11=AND_RQ -Item12=TRILLIAN -Item13=MIRANDA +Count=15 +Item0=SKYPE;xFASTMM4;TESTING;SKYPE_API +Item1=SKYPE;xFASTMM4;xTESTING;SKYPE_API +Item2=SKYPE;xFASTMM4;xTESTING;xSKYPE_API +Item3=SKYPE;xFASTMM4;xTESTING;xSKYPE_API;TESTING +Item4=SKYPE;xFASTMM4;xTESTING;SKYPE_API;TESTING +Item5=SKYPE;xFASTMM4;xTESTING;SKYPE_API;xDEBUG_LOG +Item6=SKYPE;xFASTMM4;TESTING;SKYPE_API;xDEBUG_LOG +Item7=SKYPE;xFASTMM4;xTESTING;xSKYPE_API;xDEBUG_LOG +Item8=SKYPE;xFASTMM4;TESTING;xSKYPE_API;xDEBUG_LOG;xTESTING +Item9=SKYPE;xFASTMM4;TESTING;xSKYPE_API;xDEBUG_LOG;TESTING +Item10=SOCKET;xFASTMM4 +Item11=SKYPE;xFASTMM4;xTESTING;xSKYPE_API;xDEBUG_LOG;TESTING +Item12=SKYPE;xFASTMM4;xTESTING;xSKYPE_API;DEBUG_LOG +Item13=SKYPE;xFASTMM4;TESTING;xSKYPE_API;DEBUG_LOG +Item14=SKYPE;xFASTMM4;TESTING;xSKYPE_API;xDEBUG_LOG [HistoryLists\hlUnitAliases] Count=1 Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; [HistoryLists\hlSearchPath] -Count=11 -Item0=.\MirandaINC;..\lib\FastMM4;..\lib\PNGImage;..\lib\TntUnicodeControls\Source -Item1=$(DELPHI)\Lib\Debug;.\MirandaINC;..\lib\FastMM4;..\lib\PNGImage;..\lib\TntUnicodeControls\Source -Item2=..\lib\FastMM4;..\lib\PNGImage;..\lib\TntUnicodeControls\Source -Item3=$(DELPHI)\Lib\Debug;..\lib\FastMM4;..\lib\PNGImage;..\lib\TntUnicodeControls\Source -Item4=.\MirandaINC;..\lib\FastMM4;..\lib\PNGImage;..\lib\TntUnicodeControls -Item5=$(DELPHI)\Lib\Debug;..\lib\FastMM4;..\lib\PNGImage;.\MirandaINC -Item6=$(DELPHI)\Lib\Debug;..\lib\FastMM4;..\lib\PNGImage -Item7=..\lib\FastMM4;..\lib\PNGImage;.\MirandaINC -Item8=..\lib\FastMM4;..\lib\PNGImage;.\MI\MirandaINC -Item9=..\lib\FastMM4;..\lib\PNGImage -Item10=..\lib\PNGImage +Count=5 +Item0=$(DELPHI)\Lib\Debug;..\lib\FastMM4;..\lib\PNGImage;..\lib\XIE;..\lib\TntUnicodeControls\Source;.\SkypeAPI +Item1=..\lib\FastMM4;..\lib\PNGImage;..\lib\XIE;..\lib\TntUnicodeControls\Source;.\SkypeAPI +Item2=$(DELPHI)\Lib\Debug;..\lib\FastMM4;..\lib\PNGImage;..\lib\TntUnicodeControls\Source +Item3=..\lib\FastMM4;..\lib\PNGImage;..\lib\TntUnicodeControls\Source;.\SkypeAPI +Item4=$(DELPHI)\Lib\Debug;..\lib\FastMM4;..\lib\PNGImage;..\lib\TntUnicodeControls\Source;.\SkypeAPI [HistoryLists\hlUnitOutputDirectory] -Count=2 +Count=1 Item0=.\dcu -Item1=..\dcu [HistoryLists\hlOutputDirectorry] Count=2 -Item0=..\bin -Item1=C:\Documents and Settings\Pavel\Мои документы\Programming\Chess4Net\Testing\Client1\Plugins +Item0=..\bin\Chess4Net_Skype +Item1=..\bin diff --git a/plugins/Chess4Net/MI/Chess4Net_MI.dpr b/plugins/Chess4Net/MI/Chess4Net_MI.dpr index 0779b4eb35..bc07ffc32c 100644 --- a/plugins/Chess4Net/MI/Chess4Net_MI.dpr +++ b/plugins/Chess4Net/MI/Chess4Net_MI.dpr @@ -1,3 +1,9 @@ +//////////////////////////////////////////////////////////////////////////////// +// All code below is exclusively owned by author of Chess4Net - Pavel Perminov +// (packpaul@mail.ru, packpaul1@gmail.com). +// Any changes, modifications, borrowing and adaptation are a subject for +// explicit permition from the owner. + library Chess4Net_MI; {******************************* plugin library for Miranda @@ -19,6 +25,8 @@ uses BitmapResUnit in '..\BitmapResUnit.pas', ChessBoardHeaderUnit in '..\ChessBoardHeaderUnit.pas', ChessBoardUnit in '..\ChessBoardUnit.pas' {ChessBoard}, + PosBaseChessBoardLayerUnit in '..\PosBaseChessBoardLayerUnit.pas', + GameChessBoardUnit in '..\GameChessBoardUnit.pas' {GameChessBoard}, ConnectingUnit in '..\ConnectingUnit.pas' {ConnectingForm}, ConnectorUnit in 'ConnectorUnit.pas', ContinueUnit in '..\ContinueUnit.pas' {ContinueForm}, @@ -34,12 +42,16 @@ uses MessageDialogUnit in '..\MessageDialogUnit.pas', ModalForm in '..\ModalForm.pas', PluginCommonUnit in 'PluginCommonUnit.pas', - PosBaseChessBoardUnit in '..\PosBaseChessBoardUnit.pas', PosBaseUnit in '..\PosBaseUnit.pas', PromotionUnit in '..\PromotionUnit.pas' {PromotionForm}, ChessRulesEngine in '..\ChessRulesEngine.pas', ManagerUnit.MI in 'ManagerUnit.MI.pas', - TransmitGameSelectionUnit in 'TransmitGameSelectionUnit.pas' {TransmitGameSelectionForm}; + TransmitGameSelectionUnit in 'TransmitGameSelectionUnit.pas' {TransmitGameSelectionForm}, + ChessClockUnit in '..\ChessClockUnit.pas', + URLVersionQueryUnit in '..\URLVersionQueryUnit.pas', + DontShowMessageDlgUnit in '..\DontShowMessageDlgUnit.pas', + IniSettingsUnit in '..\IniSettingsUnit.pas', + NonRefInterfacedObjectUnit in '..\NonRefInterfacedObjectUnit.pas'; {$R ..\Chess4Net.res} @@ -50,11 +62,11 @@ begin with _PluginInfo^ do begin shortName := 'Chess4Net'; - version := MakeMirandaPluginVersion(201,0,0,1); // 2010.0 - description := PLUGIN_PLAYING_VIA; + version := MakeMirandaPluginVersion(201,1,0,1); // 2010.0 + description := PLUGIN_PLAYING_OVER; author := 'Pavel Perminov'; authorEmail := 'packpaul@mail.ru'; - copyright := '(c) 2007-2010 No Copyrights'; + copyright := '(c) 2007-2011 No Copyrights'; homepage := 'http://www.chess4net.ru'; end; diff --git a/plugins/Chess4Net/MI/ConnectorUnit.pas b/plugins/Chess4Net/MI/ConnectorUnit.pas index 5a50610324..525ebb3b22 100644 --- a/plugins/Chess4Net/MI/ConnectorUnit.pas +++ b/plugins/Chess4Net/MI/ConnectorUnit.pas @@ -1,3 +1,9 @@ +//////////////////////////////////////////////////////////////////////////////// +// All code below is exclusively owned by author of Chess4Net - Pavel Perminov +// (packpaul@mail.ru, packpaul1@gmail.com). +// Any changes, modifications, borrowing and adaptation are a subject for +// explicit permition from the owner. + unit ConnectorUnit; interface @@ -28,6 +34,7 @@ type _msg_sending, _unformated_msg_sending: string; _cntrMsgIn: integer; // счётчик входящих сообщений _cntrMsgOut: integer; // счётчик исходящих сообщений + m_iLastCntrMsgOutInFormatting: integer; _msg_buf: string; // буфер сообщений // системное сообщение _systemDataList: TStringList; @@ -53,6 +60,7 @@ type procedure FNotifySender; procedure FSendSystemData(sd: string); function FDeformatMsg(var msg: string; out lstId, msgCntr: integer): boolean; + // Formatting of outgoing messages function FFormatMsg(const msg: string): string; function FGetOwnerID: integer; function FGetMultiSession: boolean; @@ -172,6 +180,83 @@ begin end; +function NotifySender(wParam: WPARAM; lParam_: LPARAM): int; cdecl; +const + MSG_TRYS: integer = 1; +var + connector: TConnector; + hContact: THandle; +begin + Result := 0; + hContact := PACKDATA(lParam_).hContact; + + if (PACKDATA(lParam_).type_ <> ACKTYPE_MESSAGE) then + exit; + + case PACKDATA(lParam_)^.result_ of + ACKRESULT_SUCCESS: + begin + MSG_TRYS := 1; + + connector := g_connectorList.GetFirstConnector(hContact); + while Assigned(connector) do + begin + if (connector._msg_sending <> '') then + connector.FNotifySender; + connector := g_connectorList.GetNextConnector; + end; + end; + + ACKRESULT_FAILED: + begin + inc(MSG_TRYS); + if (MSG_TRYS <= MAX_MSG_TRYS) then + begin + connector := g_connectorList.GetFirstConnector(hContact); + while (Assigned(connector)) do + begin + if connector._msg_sending <> '' then + with connector do + begin + _msg_buf := _unformated_msg_sending + _msg_buf; + _sendTimer.Enabled := TRUE; + end; + connector := g_connectorList.GetNextConnector; + end; // while + end + else + begin + connector := g_connectorList.GetFirstConnector(hContact); + while (Assigned(connector)) do + begin + if (connector._msg_sending <> '') then + begin + connector.FPluginConnectorHandler(ceError); + end; + connector := g_connectorList.GetNextConnector; + end; + end; // if (MSG_TRYS <= MAX_MSG_TRYS) + end; // ACKRESULT_FAILED + end; // case PACKDATA +end; + + +procedure TConnector.FNotifySender; +begin +{$IFDEF DEBUG_LOG} + WriteToLog('<< ' + _msg_sending); +{$ENDIF} + if (Connected and (_msg_sending <> MSG_INVITATION)) then + begin + _unformated_msg_sending := ''; + inc(_cntrMsgOut); + if (_cntrMsgOut > m_iLastCntrMsgOutInFormatting) then + _cntrMsgOut := m_iLastCntrMsgOutInFormatting + 1; + end; + _msg_sending := ''; +end; + + // деформатирование входящих сообщений. TRUE - если декодирование удалось function TConnector.FDeformatMsg(var msg: string; out lstId, msgCntr: integer): boolean; var @@ -310,30 +395,23 @@ begin { TConnector.FFilterMsg } end else // Connected begin -{ - if (_msg_sending <> '') then - begin - _msg_sending := ''; - _unformated_msg_sending := ''; - inc(_cntrMsgOut); - end; -} - if (FDeformatMsg(msg, lstId, cntrMsg) and ((not g_bMultisession) or (lstId = _lstId))) then begin Result := TRUE; - if cntrMsg > _cntrMsgIn then + if (cntrMsg > _cntrMsgIn) then + begin + inc(_cntrMsgIn); + if (cntrMsg > _cntrMsgIn) then begin - inc(_cntrMsgIn); - if (cntrMsg > _cntrMsgIn) then - begin - FPluginConnectorHandler(ceError); // пакет исчез - exit; - end; - end - else - exit; // пропуск пакетов с более низкими номерами + FPluginConnectorHandler(ceError); // пакет исчез + exit; + end; + end + else if (cntrMsg < _cntrMsgIn) then + exit; // skipping packets with lower numbers + + // if (cntrMsg = _cntrMsgIn) there's no garantee that packets are synchronized, but let's hope it's so. NProceedData(msg); end @@ -343,21 +421,6 @@ begin { TConnector.FFilterMsg } end; -procedure TConnector.FNotifySender; -begin -{$IFDEF DEBUG_LOG} - WriteToLog('<< ' + _msg_sending); -{$ENDIF} - if (Connected and (_msg_sending <> MSG_INVITATION)) then - begin - _unformated_msg_sending := ''; - inc(_cntrMsgOut); - end; - _msg_sending := ''; -end; - - -// форматирование исходящих сообщений function TConnector.FFormatMsg(const msg: string): string; var contactLstIdStr: string; @@ -367,6 +430,7 @@ begin else // -1 contactLstIdStr := ''; Result := PROMPT_HEAD + contactLstIdStr + PROMPT_SEPARATOR + IntToStr(_cntrMsgOut) + PROMPT_TAIL + msg; + m_iLastCntrMsgOutInFormatting := _cntrMsgOut; end; @@ -473,67 +537,6 @@ begin end; -function NotifySender(wParam: WPARAM; lParam_: LPARAM): int; cdecl; -const - MSG_TRYS: integer = 1; -var - connector: TConnector; - hContact: THandle; -begin - Result := 0; - hContact := PACKDATA(lParam_).hContact; - - if (PACKDATA(lParam_).type_ <> ACKTYPE_MESSAGE) then - exit; - - case PACKDATA(lParam_)^.result_ of - ACKRESULT_SUCCESS: - begin - MSG_TRYS := 1; - - connector := g_connectorList.GetFirstConnector(hContact); - while Assigned(connector) do - begin - if (connector._msg_sending <> '') then - connector.FNotifySender; - connector := g_connectorList.GetNextConnector; - end; - end; - - ACKRESULT_FAILED: - begin - inc(MSG_TRYS); - if (MSG_TRYS <= MAX_MSG_TRYS) then - begin - connector := g_connectorList.GetFirstConnector(hContact); - while (Assigned(connector)) do - begin - if connector._msg_sending <> '' then - with connector do - begin - _msg_buf := _unformated_msg_sending + _msg_buf; - _sendTimer.Enabled := TRUE; - end; - connector := g_connectorList.GetNextConnector; - end; // while - end - else - begin - connector := g_connectorList.GetFirstConnector(hContact); - while (Assigned(connector)) do - begin - if (connector._msg_sending <> '') then - begin - connector.FPluginConnectorHandler(ceError); - end; - connector := g_connectorList.GetNextConnector; - end; - end; // if (MSG_TRYS <= MAX_MSG_TRYS) - end; // ACKRESULT_FAILED - end; // case PACKDATA -end; - - constructor TConnector.Create(hContact: THandle); const ID_COUNTER: Longword = 0; @@ -783,6 +786,15 @@ begin end; +procedure TConnector.FSendSystemData(sd: string); +begin + if ((sd <> MSG_INVITATION) and (sd <> CMD_CLOSE)) then + sd := sd + DATA_SEPARATOR; + _systemDataList.Add(sd); + _sendSystemTimer.Enabled := TRUE; +end; + + procedure TConnector.FsendSystemTimerTimer(Sender: TObject); begin if _systemDataList.Count = 0 then @@ -798,15 +810,6 @@ begin end; -procedure TConnector.FSendSystemData(sd: string); -begin - if ((sd <> MSG_INVITATION) and (sd <> CMD_CLOSE)) then - sd := sd + DATA_SEPARATOR; - _systemDataList.Add(sd); - _sendSystemTimer.Enabled := TRUE; -end; - - function TConnector.FGetOwnerID: integer; begin Result := OWNER_ID; diff --git a/plugins/Chess4Net/MI/ControlUnit.pas b/plugins/Chess4Net/MI/ControlUnit.pas index f9f8694e86..5a2743ca3c 100644 --- a/plugins/Chess4Net/MI/ControlUnit.pas +++ b/plugins/Chess4Net/MI/ControlUnit.pas @@ -1,3 +1,9 @@ +//////////////////////////////////////////////////////////////////////////////// +// All code below is exclusively owned by author of Chess4Net - Pavel Perminov +// (packpaul@mail.ru, packpaul1@gmail.com). +// Any changes, modifications, borrowing and adaptation are a subject for +// explicit permition from the owner. + unit ControlUnit; interface diff --git a/plugins/Chess4Net/MI/GlobalsLocalUnit.pas b/plugins/Chess4Net/MI/GlobalsLocalUnit.pas index 3e1c6018ff..30eef7a2a8 100644 --- a/plugins/Chess4Net/MI/GlobalsLocalUnit.pas +++ b/plugins/Chess4Net/MI/GlobalsLocalUnit.pas @@ -1,3 +1,9 @@ +//////////////////////////////////////////////////////////////////////////////// +// All code below is exclusively owned by author of Chess4Net - Pavel Perminov +// (packpaul@mail.ru, packpaul1@gmail.com). +// Any changes, modifications, borrowing and adaptation are a subject for +// explicit permition from the owner. + unit GlobalsLocalUnit; // Модуль для глобальных переменных и констант версии для Миранды @@ -9,21 +15,20 @@ uses const CHESS4NET = 'Chess4Net'; - CHESS4NET_VERSION = 201000; // 2010.0 - CHESS4NET_TITLE = 'Chess4Net 2010.0 (http://chess4net.ru)'; + CHESS4NET_VERSION = 201100; // 2011.0 + CHESS4NET_TITLE = 'Chess4Net 2011.0 (http://chess4net.ru)'; MSG_INVITATION = 'Wellcome to Chess4Net. If you don''t have it, please download it from http://chess4net.ru'; PROMPT_HEAD = 'Ch4N'; MSG_DATA_SEPARATOR = '&&'; PLUGIN_NAME = CHESS4NET; PLUGIN_VERSION = CHESS4NET_VERSION; - PLUGIN_PLAYING_VIA = 'Plugin for playing chess via Miranda'; - PLUGIN_INFO_NAME = 'Chess4Net 2010.0.1'; + PLUGIN_PLAYING_OVER = 'Plugin for playing chess over Miranda'; + PLUGIN_INFO_NAME = 'Chess4Net 2011.0.0'; PLUGIN_URL = 'http://chess4net.ru'; PLUGIN_EMAIL = 'packpaul@mail.ru'; var - Chess4NetPath: string; Chess4NetIcon, pluginIcon: TIcon; implementation diff --git a/plugins/Chess4Net/MI/ManagerUnit.MI.pas b/plugins/Chess4Net/MI/ManagerUnit.MI.pas index a27ff73463..c50aa58e4d 100644 --- a/plugins/Chess4Net/MI/ManagerUnit.MI.pas +++ b/plugins/Chess4Net/MI/ManagerUnit.MI.pas @@ -1,3 +1,9 @@ +//////////////////////////////////////////////////////////////////////////////// +// All code below is exclusively owned by author of Chess4Net - Pavel Perminov +// (packpaul@mail.ru, packpaul1@gmail.com). +// Any changes, modifications, borrowing and adaptation are a subject for +// explicit permition from the owner. + unit ManagerUnit.MI; interface @@ -5,16 +11,9 @@ interface uses SysUtils, // - ControlUnit, ManagerUnit, ConnectorUnit, ModalForm; + ControlUnit, ManagerUnit, ConnectorUnit, ModalForm, NonRefInterfacedObjectUnit; type - TNonRefInterfacedObject = class(TObject, IInterface) - protected - function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall; - function _AddRef: Integer; stdcall; - function _Release: Integer; stdcall; - end; - TManagerMIFactory = class(TNonRefInterfacedObject, IMirandaPlugin) private m_Connector: TConnector; @@ -46,7 +45,8 @@ implementation uses Types, StrUtils, Classes, Dialogs, Controls, // - LocalizerUnit, TransmitGameSelectionUnit, GlobalsLocalUnit, ChessBoardUnit; + LocalizerUnit, TransmitGameSelectionUnit, GlobalsLocalUnit, ChessBoardUnit, + GameChessBoardUnit; type TManagerMI = class(TManager, IMirandaPlugin) // abstract @@ -93,6 +93,7 @@ type private m_GamingManager: TGamingManagerMI; m_bReady: boolean; // ready for transmition + property Ready: boolean read m_bReady; protected procedure Start; procedure ROnCreate; override; @@ -182,7 +183,7 @@ end; procedure TGamingManagerMI.FSetGameContextToTransmitter(ATransmitter: TTransmittingManagerMI); begin - if (not (Assigned(ATransmitter) and ATransmitter.m_bReady)) then + if (not (Assigned(ATransmitter) and ATransmitter.Ready)) then exit; ATransmitter.RSendData(CMD_NICK_ID + ' ' + PlayerNickId + ' ' + OpponentNickId + ' ' + OpponentNick); @@ -294,12 +295,10 @@ begin ceError: begin Connector.Close; - inherited ConnectorHandler(e, d1, d2); end; - - else - inherited ConnectorHandler(e, d1, d2); end; // case + + inherited ConnectorHandler(e, d1, d2); end; @@ -347,7 +346,7 @@ begin for i := 0 to m_lstTransmittingManagers.Count - 1 do begin ATransmitter := m_lstTransmittingManagers[i]; - if (Assigned(ATransmitter) and (ATransmitter.m_bReady)) then + if (Assigned(ATransmitter) and (ATransmitter.Ready)) then ATransmitter.RSendData(strCmd); end; end; @@ -645,29 +644,6 @@ begin end; // case end; -//////////////////////////////////////////////////////////////////////////////// -// TNonRefInterfacedObject - -function TNonRefInterfacedObject.QueryInterface(const IID: TGUID; out Obj): HResult; -begin - if GetInterface(IID, Obj) then - Result := 0 - else - Result := E_NOINTERFACE; -end; - - -function TNonRefInterfacedObject._AddRef: Integer; -begin - Result := -1; -end; - - -function TNonRefInterfacedObject._Release: Integer; -begin - Result := -1; -end; - //////////////////////////////////////////////////////////////////////////////// // TTransmittingManagerMI @@ -767,13 +743,13 @@ begin end else if (sl = CMD_GOODBYE) then begin - Stop; + Stop; end else if (sl = CMD_WELCOME) then begin RSendData(CMD_WELCOME); m_bReady := TRUE; - m_GamingManager.FSetGameContextToTransmitter(self); + m_GamingManager.FSetGameContextToTransmitter(self); end; end; diff --git a/plugins/Chess4Net/MI/PluginCommonUnit.pas b/plugins/Chess4Net/MI/PluginCommonUnit.pas index c2c2bd8d32..30cbdccec5 100644 --- a/plugins/Chess4Net/MI/PluginCommonUnit.pas +++ b/plugins/Chess4Net/MI/PluginCommonUnit.pas @@ -1,3 +1,9 @@ +//////////////////////////////////////////////////////////////////////////////// +// All code below is exclusively owned by author of Chess4Net - Pavel Perminov +// (packpaul@mail.ru, packpaul1@gmail.com). +// Any changes, modifications, borrowing and adaptation are a subject for +// explicit permition from the owner. + unit PluginCommonUnit; interface @@ -14,9 +20,9 @@ procedure ErrorDuringPluginStart; implementation uses - Windows, Forms, Dialogs, Graphics, SysUtils, Controls + Windows, Forms, Dialogs, Graphics, SysUtils, Controls, // plugin units - , GlobalsLocalUnit, ManagerUnit.MI, ModalForm; + GlobalsUnit, GlobalsLocalUnit, ManagerUnit.MI, ModalForm; function CreatePluginInstance(Connector: TConnector): IMirandaPlugin; begin @@ -30,6 +36,8 @@ begin Chess4NetPath := MirandaPluginPath; if (not DirectoryExists(Chess4NetPath)) then CreateDir(Chess4NetPath); + Chess4NetIniFilePath := Chess4NetPath; + Chess4NetGamesLogPath := Chess4NetPath; Chess4NetIcon := TIcon.Create; Chess4NetIcon.Handle := LoadIcon(hInstance, 'MAINICON'); pluginIcon := Chess4NetIcon; diff --git a/plugins/Chess4Net/MI/TransmitGameSelectionUnit.pas b/plugins/Chess4Net/MI/TransmitGameSelectionUnit.pas index 8e87d67d66..a70eb65ef5 100644 --- a/plugins/Chess4Net/MI/TransmitGameSelectionUnit.pas +++ b/plugins/Chess4Net/MI/TransmitGameSelectionUnit.pas @@ -1,3 +1,9 @@ +//////////////////////////////////////////////////////////////////////////////// +// All code below is exclusively owned by author of Chess4Net - Pavel Perminov +// (packpaul@mail.ru, packpaul1@gmail.com). +// Any changes, modifications, borrowing and adaptation are a subject for +// explicit permition from the owner. + unit TransmitGameSelectionUnit; interface diff --git a/plugins/Chess4Net/ManagerUnit.dfm b/plugins/Chess4Net/ManagerUnit.dfm index 1e055ddc4e..744ec26f31 100644 --- a/plugins/Chess4Net/ManagerUnit.dfm +++ b/plugins/Chess4Net/ManagerUnit.dfm @@ -31,6 +31,10 @@ object Manager: TManager Caption = 'About...' OnExecute = AboutActionExecute end + object BroadcastAction: TTntAction + Caption = 'Broadcast...' + OnExecute = BroadcastActionExecute + end end object ConnectedPopupMenu: TTntPopupMenu AutoPopup = False @@ -69,6 +73,12 @@ object Manager: TManager object N1: TTntMenuItem Caption = '-' end + object BroadcastConnected: TTntMenuItem + Action = BroadcastAction + end + object N3: TTntMenuItem + Caption = '-' + end object AboutConnected: TTntMenuItem Action = AboutAction end @@ -117,6 +127,12 @@ object Manager: TManager object N2: TTntMenuItem Caption = '-' end + object Broadcast: TTntMenuItem + Action = BroadcastAction + end + object N7: TTntMenuItem + Caption = '-' + end object AboutGame: TTntMenuItem Action = AboutAction end diff --git a/plugins/Chess4Net/ManagerUnit.pas b/plugins/Chess4Net/ManagerUnit.pas index 8797f76623..a20cb4c1bc 100644 --- a/plugins/Chess4Net/ManagerUnit.pas +++ b/plugins/Chess4Net/ManagerUnit.pas @@ -1,3 +1,9 @@ +//////////////////////////////////////////////////////////////////////////////// +// All code below is exclusively owned by author of Chess4Net - Pavel Perminov +// (packpaul@mail.ru, packpaul1@gmail.com). +// Any changes, modifications, borrowing and adaptation are a subject for +// explicit permition from the owner. + unit ManagerUnit; {$DEFINE GAME_LOG} @@ -5,15 +11,15 @@ unit ManagerUnit; interface uses - Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Menus, TntMenus, ActnList, TntActnList, ExtCtrls, {$IFDEF TRILLIAN} plugin, {$ENDIF} // Chess4Net Units - ChessBoardHeaderUnit, ChessRulesEngine, ChessBoardUnit, PosBaseChessBoardUnit, - ConnectorUnit, ConnectingUnit, GameOptionsUnit, - ModalForm, DialogUnit, ContinueUnit, LocalizerUnit; + ChessBoardHeaderUnit, ChessRulesEngine, ChessBoardUnit, + GameChessBoardUnit, ConnectorUnit, ConnectingUnit, GameOptionsUnit, + ModalForm, DialogUnit, ContinueUnit, LocalizerUnit, URLVersionQueryUnit; type TManager = class(TForm, ILocalizable) @@ -44,6 +50,12 @@ type N5: TTntMenuItem; N6: TTntMenuItem; + BroadcastAction: TTntAction; + N3: TTntMenuItem; + BroadcastConnected: TTntMenuItem; + N7: TTntMenuItem; + Broadcast: TTntMenuItem; + ConnectorTimer: TTimer; procedure FormCreate(Sender: TObject); @@ -66,13 +78,13 @@ type procedure StartAdjournedGameConnectedClick(Sender: TObject); procedure AdjournGameClick(Sender: TObject); procedure GamePopupMenuPopup(Sender: TObject); + procedure BroadcastActionExecute(Sender: TObject); private - m_strAdjourned: string; m_ConnectingForm: TConnectingForm; m_ContinueForm: TContinueForm; m_Connector: TConnector; - m_ChessBoard: TPosBaseChessBoard; + m_ChessBoard: TGameChessBoard; m_Dialogs: TDialogs; m_ExtBaseList: TStringList; @@ -86,11 +98,10 @@ type contactlistEntry: TTtkContactListEntry; {$ENDIF} {$IFDEF SKYPE} - m_bSkypeConnectionError: boolean; m_bDontShowCredits: boolean; {$ENDIF} m_lwOpponentClientVersion: LongWord; - // для ChessBoard + // It's for ChessBoard you_unlimited, opponent_unlimited: boolean; you_time, opponent_time, you_inc, opponent_inc: word; @@ -109,6 +120,9 @@ type m_bTransmittable: boolean; + m_iDontShowLastVersion: integer; + m_iQueriedDontShowLastVersion: integer; + {$IFDEF GAME_LOG} // for game log gameLog: string; @@ -116,11 +130,11 @@ type procedure FWriteToGameLog(const s: string); procedure FlushGameLog; {$ENDIF} - procedure ChessBoardHandler(e: TChessBoardEvent; - d1: pointer = nil; d2: pointer = nil); + procedure ChessBoardHandler(e: TGameChessBoardEvent; + d1: pointer = nil; d2: pointer = nil); procedure SetClock; overload; procedure SetClock(var sr: string); overload; - procedure DialogFormHandler(modSender: TModalForm; msgDlgID: TModalFormID); + procedure FPopulateExtBaseList; function FReadCommonSettings(setToOpponent: boolean): boolean; @@ -137,6 +151,9 @@ type procedure FBuildAdjournedStr; procedure FStartAdjournedGame; + function FGetAdjournedStr: string; + procedure FSetAdjournedStr(const strValue: string); + function FGetPlayerColor: TFigureColor; procedure FSetPlayerColor(Value: TFigureColor); @@ -147,7 +164,9 @@ type procedure FSetTransmittable(bValue: boolean); - property AdjournedStr: string read m_strAdjourned write m_strAdjourned; + procedure FOnURLQueryReady(Sender: TURLVersionQuery); + + property AdjournedStr: string read FGetAdjournedStr write FSetAdjournedStr; property _PlayerColor: TFigureColor read FGetPlayerColor write FSetPlayerColor; protected @@ -183,23 +202,25 @@ type procedure RReleaseWithConnectorGracefully; procedure RRetransmit(const strCmd: string); virtual; + procedure RBroadcast; virtual; procedure RUpdateChessBoardCaption; + procedure DialogFormHandler(modSender: TModalForm; msgDlgID: TModalFormID); virtual; + property Connector: TConnector read m_Connector write m_Connector; - property ChessBoard: TPosBaseChessBoard read m_ChessBoard write m_ChessBoard; + property ChessBoard: TGameChessBoard read m_ChessBoard write m_ChessBoard; property PlayerNick: string read m_strPlayerNick write m_strPlayerNick; property PlayerNickId: string read m_strPlayerNickId write m_strPlayerNickId; property OpponentNick: string read m_strOpponentNick write m_strOpponentNick; property OpponentId: string read m_strOpponentId write m_strOpponentId; - property OpponentNickId: string read FGetOpponentNickId write m_strOverridedOpponentNickId; + property OpponentNickId: string read FGetOpponentNickId write m_strOverridedOpponentNickId; property Transmittable: boolean read m_bTransmittable write FSetTransmittable; -{$IFDEF SKYPE} - property SkypeConnectionError: boolean read m_bSkypeConnectionError; -{$ENDIF} + property pDialogs: TDialogs read m_Dialogs; + public {$IFDEF AND_RQ} class function Create: TManager; reintroduce; @@ -209,17 +230,14 @@ type {$ENDIF} {$IFDEF TRILLIAN} class function Create(const vContactlistEntry: TTtkContactListEntry): TManager; reintroduce; -{$ENDIF} -{$IFDEF SKYPE} - class function Create: TManager; reintroduce; {$ENDIF} end; const - CMD_DELIMITER = '&&'; // CMD_DELIMITER has to be present in arguments + CMD_DELIMITER = '&&'; // CMD_DELIMITER has to be present in arguments CMD_VERSION = 'ver'; - CMD_WELCOME = 'wlcm'; // Accept of connection + CMD_WELCOME = 'wlcm'; // Accept of connection CMD_GOODBYE = 'gdb'; // Refusion of connection CMD_TRANSMITTING = 'trnsm'; CMD_NICK_ID = 'nkid'; @@ -233,8 +251,10 @@ implementation uses // Chess4Net - DateUtils, Math, StrUtils, TntIniFiles, Dialogs, - LookFeelOptionsUnit, GlobalsLocalUnit, InfoUnit + DateUtils, Math, StrUtils, Dialogs, + // + LookFeelOptionsUnit, GlobalsUnit, GlobalsLocalUnit, InfoUnit, ChessClockUnit, + DontShowMessageDlgUnit, IniSettingsUnit, PosBaseChessBoardLayerUnit {$IFDEF AND_RQ} , CallExec {$ENDIF} @@ -242,18 +262,15 @@ uses , ControlUnit {$ENDIF} {$IFDEF SKYPE} - , SelectSkypeContactUnit, CreditsFormUnit + , CreditsFormUnit {$ENDIF} ; const USR_BASE_NAME = 'Chess4Net'; - INI_FILE_NAME = 'Chess4net.ini'; - INITIAL_CLOCK_TIME = '5 0 5 0'; // 5:00 5:00 NO_CLOCK_TIME ='u u'; - FULL_TIME_FORMAT = 'h:n:s"."z'; HOUR_TIME_FORMAT = 'h:nn:ss'; // Command shorthands for Connector @@ -300,36 +317,11 @@ const CMD_ADJOURN_GAME_NO = 'adjno'; CMD_START_ADJOURNED_GAME = 'strtadj'; -// CMD_DELIMITER = '&&'; // CMD_DELIMITER has to be present in arguments - + // CMD_DELIMITER = '&&'; // CMD_DELIMITER has to be present in arguments // CMD_CLOSE = 'ext' - IS RESERVED - // INI-file - PRIVATE_SECTION_NAME = 'Private'; - COMMON_SECTION_PREFIX = 'Common'; - ANIMATION_KEY_NAME = 'Animation'; - HILIGHT_LAST_MOVE_KEY_NAME = 'HilightLastMove'; - FLASH_ON_MOVE_NAME = 'FlashOnMove'; - SHOW_COORDINATES_KEY_NAME = 'ShowCoordinates'; - STAY_ON_TOP_KEY_NAME = 'StayOnTop'; - EXTRA_EXIT_KEY_NAME = 'ExtraExit'; - CAN_PAUSE_GAME_KEY_NAME = 'CanPauseGame'; - CAN_ADJOURN_GAME_KEY_NAME = 'CanAdjournGame'; - ALLOW_TAKEBACKS_KEY_NAME = 'AllowTakebacks'; - EXTERNAL_BASE_NAME_KEY_NAME = 'ExternalBaseName'; - USE_USER_BASE_KEY_NAME = 'UseUserBase'; - AUTO_FLAG_KEY_NAME = 'AutoFlag'; - TRAINING_MODE_KEY_NAME = 'TrainingMode'; - PLAYER_COLOR_KEY_NAME = 'PlayerColor'; - CLOCK_KEY_NAME = 'Clock'; - ADJOURNED_KEY_NAME = 'Adjourned'; - LANGUAGE_KEY_NAME = 'Language'; -{$IFDEF SKYPE} - DONT_SHOW_CREDITS = 'DontShowCredits'; -{$ENDIF} - type - TManagerDefault = class(TManager) // TODO: TRILLIAN, AND_RQ, QIP, SKYPE -> own classes + TManagerDefault = class(TManager) // TODO: TRILLIAN, AND_RQ, QIP-> own classes protected procedure ROnCreate; override; procedure ROnDestroy; override; @@ -351,14 +343,17 @@ type procedure TManager.RCreateChessBoardAndDialogs; begin -// m_ChessBoard := TPosBaseChessBoard.Create(self, ChessBoardHandler, Chess4NetPath + USR_BASE_NAME); - m_ChessBoard := TPosBaseChessBoard.Create(nil, ChessBoardHandler, Chess4NetPath + USR_BASE_NAME); +// m_ChessBoard := TGameChessBoard.Create(self, ChessBoardHandler, Chess4NetPath + USR_BASE_NAME); + m_ChessBoard := TGameChessBoard.Create(nil, ChessBoardHandler, Chess4NetGamesLogPath + USR_BASE_NAME); m_Dialogs := TDialogs.Create(ChessBoard, DialogFormHandler); end; procedure TManager.FormCreate(Sender: TObject); begin +{$IFNDEF SKYPE} + BroadcastAction.Visible := TRUE; +{$ENDIF} ROnCreate; end; @@ -370,7 +365,7 @@ begin end; -procedure TManager.ChessBoardHandler(e: TChessBoardEvent; +procedure TManager.ChessBoardHandler(e: TGameChessBoardEvent; d1: pointer = nil; d2: pointer = nil); var s: string; @@ -504,8 +499,8 @@ begin if (ClockColor <> _PlayerColor) then begin Time[_PlayerColor] := IncSecond(Time[_PlayerColor], you_inc); - LongTimeFormat:= FULL_TIME_FORMAT; - s := TimeToStr(Time[_PlayerColor]); + s := TChessClock.ConvertToFullStr(Time[_PlayerColor]); + if ((not Unlimited[_PlayerColor]) or (m_lwOpponentClientVersion < 200706)) then begin strSwitchClockCmd := CMD_SWITCH_CLOCK + ' ' + s; @@ -610,11 +605,6 @@ begin case e of ceConnected: begin -{$IFDEF SKYPE} - PlayerNick := Connector.UserHandle; - OpponentNick := Connector.ContactHandle; - OpponentId := OpponentNick; -{$ENDIF} if (Assigned(m_ConnectingForm)) then m_ConnectingForm.Shut; RSendData(CMD_VERSION + ' ' + IntToStr(CHESS4NET_VERSION)); @@ -623,12 +613,7 @@ begin ceDisconnected: begin if (not Connector.connected) then - begin -{$IFDEF SKYPE} - Application.Terminate; // KLUDGE -{$ENDIF} exit; - end; if (Transmittable) then begin @@ -681,31 +666,6 @@ begin 'Chess4Net won''t start.', mtWarning, [mbOk], mfMsgLeave); end; {$ENDIF} -{$IFDEF SKYPE} - ceSkypeError: - begin - m_bSkypeConnectionError := TRUE; - // TODO: Localize - m_Dialogs.MessageDlg('Chess4Net was unable to attach to your Skype application' + sLineBreak + - 'This can happen due to the following reasons:' + sLineBreak + - ' 1) You have an old version of Skype. OR' + sLineBreak + - ' 2) Your Skype is blocking Chess4Net. OR' + sLineBreak + - ' 3) Your Skype doesn''t support Skype applications. OR' + sLineBreak + - ' 4) Other reasons.' + sLineBreak + - 'Chess4Net won''t start.', mtWarning, [mbOk], mfMsgLeave); - end; - - ceShowConnectableUsers: - begin - if (Assigned(ConnectingForm)) then - ConnectingForm.ShowSkypeAcceptLogo := FALSE; - with m_Dialogs.CreateDialog(TSelectSkypeContactForm) as TSelectSkypeContactForm do - begin - Init(d1); - Show; - end; - end; -{$ENDIF} ceData: begin @@ -732,6 +692,42 @@ end; procedure TManager.RSetConnectionOccured; begin m_bConnectionOccured := TRUE; +{$IFNDEF TESTING} + with TURLVersionQuery.Create do + begin + OnQueryReady := FOnURLQueryReady; + {$IFDEF SKYPE} + Query(aidSkype, CHESS4NET_VERSION, osidWindows); + {$ELSE} + Free; // TODO: URL query for other clients + {$ENDIF} + end; +{$ENDIF} +end; + + +procedure TManager.FOnURLQueryReady(Sender: TURLVersionQuery); +begin + if (not Assigned(Sender)) then + exit; + + try + if ((Sender.LastVersion <= m_iDontShowLastVersion)) then + exit; + + if (Sender.Info <> '') then + begin + with TDontShowMessageDlg.Create(m_Dialogs, Sender.Info) do + begin + m_iQueriedDontShowLastVersion := Sender.LastVersion; + Show; + end; + end; + + finally + Sender.Free; + end; + end; @@ -746,7 +742,6 @@ procedure TManager.RHandleConnectorDataCommand(sl: string); var AMode: TMode; sr: string; - ms: string; strSavedCmd: string; wstrMsg: WideString; begin @@ -771,10 +766,9 @@ begin m_Dialogs.MessageDlg(TLocalizer.Instance.GetMessage(8), mtWarning, [mbOK], mfNone); // Your opponent is using an older version of Chess4Net. ... end; - - // 2007.4 is the first client with a backward compatibility - // For incompatible versions: - // else RSendData(CMD_GOODBYE); + // 2007.4 is the first client with a backward compatibility + // For incompatible versions: + // else RSendData(CMD_GOODBYE); end else if (sl = CMD_WELCOME) then begin @@ -991,21 +985,20 @@ begin with ChessBoard do begin RSplitStr(sr, sl, sr); - ms := RightStr(sl, length(sl) - LastDelimiter(':.', sl)); - sl := LeftStr(sl, length(sl) - length(ms) - 1); + if (Transmittable) then begin if (PositionColor = fcWhite) then - Time[fcBlack] := StrToTime(sl) + EncodeTime(0, 0, 0, StrToInt(ms)) + Time[fcBlack] := TChessClock.ConvertFromFullStr(sl) else - Time[fcWhite] := StrToTime(sl) + EncodeTime(0, 0, 0, StrToInt(ms)); + Time[fcWhite] := TChessClock.ConvertFromFullStr(sl); end else begin if (_PlayerColor = fcWhite) then - Time[fcBlack] := StrToTime(sl) + EncodeTime(0, 0, 0, StrToInt(ms)) + Time[fcBlack] := TChessClock.ConvertFromFullStr(sl) else - Time[fcWhite] := StrToTime(sl) + EncodeTime(0, 0, 0, StrToInt(ms)); + Time[fcWhite] := TChessClock.ConvertFromFullStr(sl); end; end; // with RRetransmit(strSavedCmd); @@ -1200,6 +1193,8 @@ begin m_ChessBoard := nil; end; m_Dialogs.Free; + + TIniSettings.FreeInstance; end; @@ -1246,15 +1241,17 @@ end; procedure TManager.ChangeColorConnectedClick(Sender: TObject); begin - if (ChessBoard.Mode = mGame) then - exit; - ChangeColor; - if (Transmittable) then - exit; + begin + ChangeColor; + end + else if (ChessBoard.Mode = mView) then + begin + ChangeColor; - RSendData(CMD_CHANGE_COLOR); - RRetransmit(CMD_CHANGE_COLOR); + RSendData(CMD_CHANGE_COLOR); + RRetransmit(CMD_CHANGE_COLOR); + end; end; @@ -1458,14 +1455,6 @@ begin end; {$ENDIF} -{$IFDEF SKYPE} -class function TManager.Create: TManager; -begin - Result := TManagerDefault.Create; -end; -{$ENDIF} - - procedure TManager.DialogFormHandler(modSender: TModalForm; msgDlgID: TModalFormID); var modRes: TModalResult; @@ -1557,7 +1546,7 @@ begin begin RSendData(CMD_DRAW_ACCEPTED); RRetransmit(CMD_DRAW_ACCEPTED); - + FExitGameMode; {$IFDEF GAME_LOG} FWriteToGameLog('=' + sLineBreak + '1/2 - 1/2'); @@ -1636,7 +1625,7 @@ begin begin strCmd := CMD_SET_CLOCK + ' ' + s; RSendData(strCmd); - RRetransmit(strCmd); + RRetransmit(strCmd); end; RSendData(CMD_ALLOW_TAKEBACKS + IfThen(TakeBackCheckBox.Checked, ' 1', ' 0')); end; @@ -1718,25 +1707,13 @@ begin else // modRes = mrNo RSendData(CMD_PAUSE_GAME_NO); end; -{$IFDEF SKYPE} - mfSelectSkypeContact: + + mfDontShowDlg: begin - if (modRes = mrOk) then - begin - with modSender as TSelectSkypeContactForm do - begin - Connector.ConnectToContact(SelectedContactIndex); - end; - end - else - begin - if (Assigned(ConnectingForm)) then - ConnectingForm.Close - else - Close; - end; + if ((modSender as TDontShowMessageDlg).DontShow) then + m_iDontShowLastVersion := m_iQueriedDontShowLastVersion; end; -{$ENDIF} + end; end; @@ -1750,7 +1727,7 @@ begin gameLog := ''; - LongTimeFormat:= HOUR_TIME_FORMAT; + LongTimeFormat := HOUR_TIME_FORMAT; FWriteToGameLog('[' + DateTimeToStr(Now) + ']' + sLineBreak); FWriteToGameLog(RGetGameName); @@ -1834,20 +1811,23 @@ begin if (not move_done) then exit; - AssignFile(gameLogFile, Chess4NetPath + 'Chess4Net_GAMELOG.txt'); + AssignFile(gameLogFile, Chess4NetGamesLogPath + GAME_LOG_FILE); {$I-} Append(gameLogFile); {$I+} - if IOResult <> 0 then + if (IOResult <> 0) then begin Rewrite(gameLogFile); - if IOResult = 0 then + if (IOResult = 0) then writeln(gameLogFile, gameLog); end else writeln(gameLogFile, sLineBreak + gameLog); CloseFile(gameLogFile); +{$IFDEF SKYPE} + CreateLinkForGameLogFile; +{$ENDIF} end; {$ENDIF} @@ -1879,43 +1859,36 @@ end; procedure TManager.RReadPrivateSettings; var - iniFile: TTntIniFile; initialClockTime: string; begin // Общие настройки по умолчанию initialClockTime := INITIAL_CLOCK_TIME; SetClock(initialClockTime); + ChessBoard.AutoFlag := TRUE; you_takebacks := FALSE; opponent_takebacks := FALSE; - // Считывание личных настроек из INI-файла - iniFile := TTntIniFile.Create(Chess4NetPath + INI_FILE_NAME); - try - ChessBoard.animation := TAnimation(iniFile.ReadInteger(PRIVATE_SECTION_NAME, ANIMATION_KEY_NAME, Ord(aQuick))); - ChessBoard.LastMoveHilighted := iniFile.ReadBool(PRIVATE_SECTION_NAME, HILIGHT_LAST_MOVE_KEY_NAME, FALSE); - ChessBoard.FlashOnMove := iniFile.ReadBool(PRIVATE_SECTION_NAME, FLASH_ON_MOVE_NAME, FALSE); - ChessBoard.CoordinatesShown := iniFile.ReadBool(PRIVATE_SECTION_NAME, SHOW_COORDINATES_KEY_NAME, TRUE); - ChessBoard.StayOnTop := iniFile.ReadBool(PRIVATE_SECTION_NAME, STAY_ON_TOP_KEY_NAME, FALSE); - extra_exit := iniFile.ReadBool(PRIVATE_SECTION_NAME, EXTRA_EXIT_KEY_NAME, FALSE); - TLocalizer.Instance.ActiveLanguage := iniFile.ReadInteger(PRIVATE_SECTION_NAME, LANGUAGE_KEY_NAME, 1) - 1; + // Reading private settings + ChessBoard.animation := TIniSettings.Instance.Animation; + ChessBoard.LastMoveHilighted := TIniSettings.Instance.LastMoveHilighted; + ChessBoard.FlashOnMove := TIniSettings.Instance.FlashOnMove; + ChessBoard.CoordinatesShown := TIniSettings.Instance.CoordinatesShown; + // TODO: read screen position and size + ChessBoard.StayOnTop := TIniSettings.Instance.StayOnTop; + extra_exit := TIniSettings.Instance.ExtraExit; + TLocalizer.Instance.ActiveLanguage := TIniSettings.Instance.ActiveLanguage; + m_iDontShowLastVersion := TIniSettings.Instance.DontShowLastVersion; {$IFDEF SKYPE} - m_bDontShowCredits := iniFile.ReadBool(PRIVATE_SECTION_NAME, DONT_SHOW_CREDITS, FALSE); + m_bDontShowCredits := TIniSettings.Instance.DontShowCredits; {$ENDIF} - - finally - iniFile.Free; - end; end; function TManager.FReadCommonSettings(setToOpponent: boolean): boolean; var - iniFile: TTntIniFile; - commonSectionName: string; - APlayerColor: TFigureColor; - clockStr: string; - flag: boolean; + strClock: string; + bFlag: boolean; begin if (m_lwOpponentClientVersion < 200705) then // For 2007.4 common settings are not applied begin @@ -1924,138 +1897,120 @@ begin end; Result := FALSE; - iniFile := TTntIniFile.Create(Chess4NetPath + INI_FILE_NAME); - try - commonSectionName := COMMON_SECTION_PREFIX + ' ' + OpponentId; - if (not iniFile.SectionExists(commonSectionName)) then - exit; - if (setToOpponent) then + TIniSettings.Instance.SetOpponentId(OpponentId); + if (not TIniSettings.Instance.HasCommonSettings) then + exit; + + if (setToOpponent) then + begin + if (_PlayerColor = TIniSettings.Instance.PlayerColor) then // Every time change the saved color to opposite one begin - APlayerColor := TFigureColor(iniFile.ReadInteger(commonSectionName, PLAYER_COLOR_KEY_NAME, Ord(fcBlack))); - if (_PlayerColor = APlayerColor) then // Every time change the saved color to opposite one - begin - ChangeColor; - RSendData(CMD_CHANGE_COLOR); - RRetransmit(CMD_CHANGE_COLOR); - end; - clockStr := iniFile.ReadString(commonSectionName, CLOCK_KEY_NAME, INITIAL_CLOCK_TIME); - if (clockStr <> ClockToStr) then + ChangeColor; + RSendData(CMD_CHANGE_COLOR); + RRetransmit(CMD_CHANGE_COLOR); + end; + + strClock := TIniSettings.Instance.Clock; + if (strClock <> ClockToStr) then + begin + SetClock(strClock); + RSendData(CMD_SET_CLOCK + ' ' + ClockToStr); + end; + + bFlag := TIniSettings.Instance.TrainingMode; + if (ChessBoard.pTrainingMode <> bFlag) then + begin + ChessBoard.pTrainingMode := bFlag; + RSendData(CMD_SET_TRAINING + IfThen(ChessBoard.pTrainingMode, ' 1', ' 0')); + end; + + if (m_lwOpponentClientVersion >= 200706) then + begin + bFlag := TIniSettings.Instance.CanPauseGame; + if (can_pause_game <> bFlag) then begin - SetClock(clockStr); - RSendData(CMD_SET_CLOCK + ' ' + ClockToStr); + can_pause_game := bFlag; + RSendData(CMD_CAN_PAUSE_GAME + IfThen(can_pause_game, ' 1', ' 0')); end; + end; { if opponentClientVersion >= 200706} - flag := iniFile.ReadBool(commonSectionName, TRAINING_MODE_KEY_NAME, FALSE); - if (ChessBoard.pTrainingMode <> flag) then + if (m_lwOpponentClientVersion >= 200801) then + begin + bFlag := TIniSettings.Instance.CanAdjournGame; + if (can_adjourn_game <> bFlag) then begin - ChessBoard.pTrainingMode := flag; - RSendData(CMD_SET_TRAINING + IfThen(ChessBoard.pTrainingMode, ' 1', ' 0')); + can_adjourn_game := bFlag; + RSendData(CMD_CAN_ADJOURN_GAME + IfThen(can_adjourn_game, ' 1', ' 0')); end; + end; { opponentClientVersion >= 200801 } + end; { if setToOpponent } - if (m_lwOpponentClientVersion >= 200706) then - begin - flag := iniFile.ReadBool(commonSectionName, CAN_PAUSE_GAME_KEY_NAME, FALSE); - if (can_pause_game <> flag) then - begin - can_pause_game := flag; - RSendData(CMD_CAN_PAUSE_GAME + IfThen(can_pause_game, ' 1', ' 0')); - end; - end; { if opponentClientVersion >= 200706} + m_strExtBaseName := TIniSettings.Instance.ExternalBaseName; + if (m_strExtBaseName <> '') then + ChessBoard.SetExternalBase(Chess4NetPath + m_strExtBaseName) + else + ChessBoard.UnsetExternalBase; - if (m_lwOpponentClientVersion >= 200801) then - begin - flag := iniFile.ReadBool(commonSectionName, CAN_ADJOURN_GAME_KEY_NAME, FALSE); - if (can_adjourn_game <> flag) then - begin - can_adjourn_game := flag; - RSendData(CMD_CAN_ADJOURN_GAME + IfThen(can_adjourn_game, ' 1', ' 0')); - end; - end; { opponentClientVersion >= 200801 } - end; { if setToOpponent } + ChessBoard.pUseUserBase := TIniSettings.Instance.UseUserBase; - m_strExtBaseName := iniFile.ReadString(commonSectionName, EXTERNAL_BASE_NAME_KEY_NAME, ''); - if (m_strExtBaseName <> '') then - ChessBoard.SetExternalBase(Chess4NetPath + m_strExtBaseName) - else - ChessBoard.UnsetExternalBase; + bFlag := TIniSettings.Instance.AllowTakebacks; + if (you_takebacks <> bFlag) then + begin + you_takebacks := bFlag; + RSendData(CMD_ALLOW_TAKEBACKS + IfThen(you_takebacks, ' 1', ' 0')); + end; - ChessBoard.pUseUserBase := iniFile.ReadBool(commonSectionName, USE_USER_BASE_KEY_NAME, FALSE); - flag := iniFile.ReadBool(commonSectionName, ALLOW_TAKEBACKS_KEY_NAME, FALSE); - if you_takebacks <> flag then - begin - you_takebacks := flag; - RSendData(CMD_ALLOW_TAKEBACKS + IfThen(you_takebacks, ' 1', ' 0')); - end; - ChessBoard.AutoFlag := iniFile.ReadBool(commonSectionName, AUTO_FLAG_KEY_NAME, FALSE); + ChessBoard.AutoFlag := TIniSettings.Instance.AutoFlag; - TakebackGame.Visible := (opponent_takebacks or ChessBoard.pTrainingMode); - GamePause.Visible := can_pause_game; + TakebackGame.Visible := (opponent_takebacks or ChessBoard.pTrainingMode); + GamePause.Visible := can_pause_game; - if (m_lwOpponentClientVersion >= 200801) then + if (m_lwOpponentClientVersion >= 200801) then + begin + if (AdjournedStr <> '') then begin - AdjournedStr := iniFile.ReadString(commonSectionName, ADJOURNED_KEY_NAME, ''); - if (AdjournedStr <> '') then - begin - RSendData(CMD_SET_ADJOURNED + ' ' + AdjournedStr); - iniFile.WriteString(commonSectionName, ADJOURNED_KEY_NAME, ''); - end; + RSendData(CMD_SET_ADJOURNED + ' ' + AdjournedStr); end; - - finally - iniFile.Free; end; - Result := TRUE; + Result := TRUE; end; procedure TManager.FWritePrivateSettings; -var - iniFile: TTntIniFile; begin // Write private settings - iniFile := TTntIniFile.Create(Chess4NetPath + INI_FILE_NAME); - try - iniFile.WriteInteger(PRIVATE_SECTION_NAME, ANIMATION_KEY_NAME, Ord(ChessBoard.animation)); - iniFile.WriteBool(PRIVATE_SECTION_NAME, HILIGHT_LAST_MOVE_KEY_NAME, ChessBoard.LastMoveHilighted); - iniFile.WriteBool(PRIVATE_SECTION_NAME, FLASH_ON_MOVE_NAME, ChessBoard.FlashOnMove); - iniFile.WriteBool(PRIVATE_SECTION_NAME, SHOW_COORDINATES_KEY_NAME, ChessBoard.CoordinatesShown); - iniFile.WriteBool(PRIVATE_SECTION_NAME, STAY_ON_TOP_KEY_NAME, ChessBoard.StayOnTop); - iniFile.WriteBool(PRIVATE_SECTION_NAME, EXTRA_EXIT_KEY_NAME, extra_exit); - iniFile.WriteInteger(PRIVATE_SECTION_NAME, LANGUAGE_KEY_NAME, TLocalizer.Instance.ActiveLanguage + 1); + TIniSettings.Instance.Animation := ChessBoard.Animation; + TIniSettings.Instance.LastMoveHilighted := ChessBoard.LastMoveHilighted; + TIniSettings.Instance.FlashOnMove := ChessBoard.FlashOnMove; + TIniSettings.Instance.CoordinatesShown := ChessBoard.CoordinatesShown; + // TODO: write screen position + TIniSettings.Instance.StayOnTop := ChessBoard.StayOnTop; + TIniSettings.Instance.ExtraExit := extra_exit; + TIniSettings.Instance.ActiveLanguage := TLocalizer.Instance.ActiveLanguage; + if (m_iDontShowLastVersion > CHESS4NET_VERSION) then + TIniSettings.Instance.DontShowLastVersion := m_iDontShowLastVersion; {$IFDEF SKYPE} - if (m_bDontShowCredits) then - iniFile.WriteBool(PRIVATE_SECTION_NAME, DONT_SHOW_CREDITS, m_bDontShowCredits); + if (m_bDontShowCredits) then + TIniSettings.Instance.DontShowCredits := m_bDontShowCredits; {$ENDIF} - finally - iniFile.Free; - end; end; procedure TManager.FWriteCommonSettings; -var - iniFile: TTntIniFile; - strCommonSectionName: string; begin - iniFile := TTntIniFile.Create(Chess4NetPath + INI_FILE_NAME); - try - strCommonSectionName := COMMON_SECTION_PREFIX + ' ' + OpponentId; - iniFile.WriteInteger(strCommonSectionName, PLAYER_COLOR_KEY_NAME, Ord(_PlayerColor)); - iniFile.WriteString(strCommonSectionName, CLOCK_KEY_NAME, ClockToStr); - iniFile.WriteBool(strCommonSectionName, TRAINING_MODE_KEY_NAME, ChessBoard.pTrainingMode); - iniFile.WriteString(strCommonSectionName, EXTERNAL_BASE_NAME_KEY_NAME, m_strExtBaseName); - iniFile.WriteBool(strCommonSectionName, USE_USER_BASE_KEY_NAME, ChessBoard.pUseUserBase); - iniFile.WriteBool(strCommonSectionName, ALLOW_TAKEBACKS_KEY_NAME, you_takebacks); - iniFile.WriteBool(strCommonSectionName, CAN_PAUSE_GAME_KEY_NAME, can_pause_game); - iniFile.WriteBool(strCommonSectionName, CAN_ADJOURN_GAME_KEY_NAME, can_adjourn_game); - iniFile.WriteBool(strCommonSectionName, AUTO_FLAG_KEY_NAME, ChessBoard.AutoFlag); - iniFile.WriteString(strCommonSectionName, ADJOURNED_KEY_NAME, AdjournedStr); + TIniSettings.Instance.SetOpponentId(OpponentId); - finally - iniFile.Free; - end; + TIniSettings.Instance.PlayerColor := _PlayerColor; + TIniSettings.Instance.Clock := ClockToStr; + TIniSettings.Instance.TrainingMode := ChessBoard.pTrainingMode; + TIniSettings.Instance.ExternalBaseName := m_strExtBaseName; + TIniSettings.Instance.UseUserBase := ChessBoard.pUseUserBase; + TIniSettings.Instance.AllowTakebacks := you_takebacks; + TIniSettings.Instance.CanPauseGame := can_pause_game; + TIniSettings.Instance.CanAdjournGame := can_adjourn_game; + TIniSettings.Instance.AutoFlag := ChessBoard.AutoFlag; end; @@ -2179,8 +2134,8 @@ begin //