diff options
| author | Pavel Perminov <packpaul@mail.ru> | 2012-09-26 19:14:19 +0000 |
|---|---|---|
| committer | Pavel Perminov <packpaul@mail.ru> | 2012-09-26 19:14:19 +0000 |
| commit | 6064bfec538038fd1e1ccf4da54fa859241f98fa (patch) | |
| tree | 818a480b08186f16382a84df47c4716c87934216 /plugins | |
| parent | 9f54d2d2fe173c2a426dc790e70f14a585829431 (diff) | |
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
Diffstat (limited to 'plugins')
48 files changed, 5991 insertions, 2338 deletions
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_animation: TAnimation; // скорость анимации
-
- 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; // флаг координат
+ m_iSquareSize: integer; // Size of one chess board field
- auto_flag: boolean; // индикатор автофлага
- player_time: array[TFigureColor] of TDateTime; // время белых и чёрных
- past_time: TDateTime; // время начала обдумывания хода
- unlimited_var: array[TFigureColor] of boolean; // партия без временного контроля
- clock_color: TFigureColor; // цвет анимируемой фигуры
+ m_animation: TAnimation; // Animation speed
+ m_iAnimStep, m_iPrevAnimStep, m_iAnimStepsCount: integer;
+ anim_dx, anim_dy: real; // Variables for animation of a dragged piece
- 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;
+
+ m_EditPiece: TFigure;
-{$IFDEF THREADED_CHESSCLOCK}
- TimeLabelThread: TTimeLabelThread; // нить используется для борьбы с лагом в Миранде
-{$ENDIF}
+ 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,45 +403,346 @@ 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.Evaluate;
+begin
+ case m_ChessRulesEngine.GetEvaluation of
+ evMate:
+ FDoHandler(cbeMate, self);
+ evStaleMate:
+ FDoHandler(cbeStaleMate, self);
+ end;
end;
procedure TChessBoard.PBoxBoardPaint(Sender: TObject);
begin
- PBoxBoard.Canvas.Draw(0,0, bmHiddenBoard); // Вывод скрытой доски на форму
-// PBoxBoard.Canvas.StretchDraw(Bounds(0, 0, PBoxBoard.Width, PBoxBoard.Height), bmHiddenBoard);
+ 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;
-constructor TChessBoard.Create(Owner: TComponent; h: TChessBoardHandler);
+function TChessBoard.FGetLastMove: PMoveAbs;
begin
- inherited Create(Owner);
- Handler:= h;
+ Result := m_ChessRulesEngine.lastMove;
+end;
+
+
+function TChessBoard.FGetPosition: PChessPosition;
+begin
+ Result := m_ChessRulesEngine.Position;
+end;
+
+
+function TChessBoard.AskPromotionFigure(FigureColor: TFigureColor): TFigureName;
+var
+ frmOwner: TForm;
+begin
+ if (Owner is TForm) then
+ frmOwner := TForm(Owner)
+ else
+ frmOwner := self;
+
+ if (Showing) then
+ begin
+ m_PromotionForm := TPromotionForm.Create(frmOwner, m_BitmapRes);
+ try
+ Result := m_PromotionForm.ShowPromotion(FigureColor);
+ finally
+ FreeAndNil(m_PromotionForm);
+ end;
+ end
+ else
+ Result := Q;
+end;
+
+
+procedure TChessBoard.FSetPlayerColor(const Value: TFigureColor);
+begin
+ FCancelAnimationDragging;
+ m_PlayerColor := Value;
+ if (m_PlayerColor = fcWhite) then
+ FSetFlipped(FALSE)
+ else // fcBlack
+ FSetFlipped(TRUE);
+end;
+
+
+procedure TChessBoard.FCancelAnimationDragging;
+begin
+ // 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.FSetFlipped(Value: boolean);
+begin
+ // TODO: ???
+ _flipped := Value;
+ FDrawBoard;
+end;
+
+
+procedure TChessBoard.FSetMode(const Value: TMode);
+var
+ OldMode: TMode;
+ i: integer;
+begin
+ if (m_Mode = Value) then
+ exit;
+
+ OldMode := m_Mode;
+ m_Mode := Value;
+
+ if ((m_Mode in [mView, mEdit]) and (Assigned(m_PromotionForm))) then
+ m_PromotionForm.Close;
+
+ for i := 0 to m_lstLayers.Count - 1 do
+ TChessBoardLayerBase(m_lstLayers[i]).ROnAfterModeSet(OldMode, m_Mode);
+
+ FDrawBoard;
+ HilightLastMove;
+end;
+
+
+procedure TChessBoard.FSetCoordinatesShown(Value: boolean);
+begin
+ coord_show := Value;
+ FDrawBoard;
+ HilightLastMove;
+end;
+
+
+procedure TChessBoard.FSetLastMoveHilighted(Value: boolean);
+begin
+ last_hilight := Value;
+ FDrawBoard;
+ HilightLastMove;
+end;
+
+
+function TChessBoard.DoMove(const strMove: string): boolean;
+begin
+ Result := FALSE;
+
+ if (m_Mode = mEdit) then
+ exit;
+
+ // Animation canceling
+ if (AnimateTimer.Enabled) then
+ FEndAnimation;
+
+ Result := m_ChessRulesEngine.DoMove(strMove);
+
+ if (Result) then
+ begin
+ FOnAfterMoveDone;
+ FAnimate(lastMove.i, lastMove.j);
+ end;
+end;
+
+
+procedure TChessBoard.FOnAfterMoveDone;
+var
+ _fig: TFigure;
+ strLastMove: string;
+ i: integer;
+begin
+ m_i0 := lastMove.i0;
+ m_j0 := lastMove.j0;
+
+ _fig := Position.board[lastMove.i, lastMove.j];
+ if (lastMove.prom_fig in [Q, R, B, N]) then
+ begin
+ if (_fig < ES) then
+ m_fig := WP
+ else
+ m_fig := BP;
+ end
+ else
+ m_fig := _fig;
+
+ strLastMove := m_ChessRulesEngine.LastMoveStr;
+ FDoHandler(cbeMoved, @strLastMove, self);
+
+ if (m_Mode = mAnalyse) then
+ m_PlayerColor := PositionColor;
+
+ for i := 0 to m_lstLayers.Count - 1 do
+ TChessBoardLayerBase(m_lstLayers[i]).ROnAfterMoveDone;
+end;
+
+
+procedure TChessBoard.FAnimate(const i, j: integer);
+var
+ x, y: integer;
+begin
+ if (not Showing) then
+ exit;
+
+ if ((m_i0 = 0) or (m_j0 = 0)) then
+ exit;
+
+ if (AnimateTimer.Enabled) then
+ begin
+ m_iAnimStep := m_iAnimStepsCount;
+ exit;
+ end;
+
+ case animation of
+ aNo:
+ m_iAnimStepsCount := 1;
+ aSlow:
+ m_iAnimStepsCount := ANIMATION_SLOW;
+ aQuick:
+ m_iAnimStepsCount := ANIMATION_QUICK;
+ end;
+
+ if (_flipped) then
+ begin
+ 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) * 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) / m_iAnimStepsCount;
+ anim_dy := (y - y0) / m_iAnimStepsCount;
+
+ m_iAnimStep := 0;
+ m_iPrevAnimStep := m_iAnimStep;
+
+ // 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, 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));
+
+ AnimateTimer.Enabled := TRUE;
+end;
+
+
+procedure TChessBoard.ResetMoveList;
+var
+ i: integer;
+begin
+ m_ChessRulesEngine.ResetMoveList;
+
+ 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
+ FCancelAnimationDragging;
+ FOnAfterSetPosition;
+ FDrawBoard;
+ end;
+end;
+
+
+function TChessBoard.GetPosition: string;
+begin
+ Result := m_ChessRulesEngine.GetPosition;
+end;
+
+
+procedure TChessBoard.FOnAfterSetPosition;
+var
+ strPosition: string;
+ i: integer;
+begin
+ 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.FormCreate(Sender: TObject);
+begin
+ // 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;
procedure TChessBoard.FormDestroy(Sender: TObject);
var
_fig: TFigure;
+ i: integer;
begin
+ for i := m_lstLayers.Count - 1 downto 0 do
+ RemoveLayer(m_lstLayers[i]);
+ m_lstLayers.Free;
+
m_ChessRulesEngine.Free;
- bmHiddenBoard.Free;
+ m_bmHiddenBoard.Free;
m_bmBuf.Free;
for _fig := Low(TFigure) to High(TFigure) do
@@ -463,9 +750,6 @@ begin m_bmChessBoard.Free;
m_BitmapRes.Free;
- m_TimeFont.Free;
-
- TLocalizer.Instance.DeleteSubscriber(self);
end;
@@ -474,15 +758,41 @@ procedure TChessBoard.PBoxBoardDragDrop(Sender, Source: TObject; X, var
i, j: Integer;
begin
- WhatSquare(Point(X, Y), i, j);
- if (Mode = mGame) then
+ FWhatSquare(Point(X, Y), i, j);
+ case m_Mode of
+ mGame, mAnalyse:
+ begin
+ if (FDoMove(i, j)) then
+ m_bDraggedMoved := TRUE;
+ end;
+
+ mEdit:
+ m_bDraggedMoved := TRUE;
+ end;
+end;
+
+
+procedure TChessBoard.FWhatSquare(const P: TPoint;
+ var i: Integer; var j: Integer);
+begin
+ with P do
begin
- if (RDoMove(i, j)) then
+ i := (X - CHB_X + m_iSquareSize) div m_iSquareSize;
+ j := 8 - (Y - CHB_Y) div m_iSquareSize;
+ if (_flipped) then
begin
- SwitchClock(PositionColor);
- dragged_moved:= TRUE;
+ i := 9 - i;
+ j := 9 - j;
end;
- end; // if
+ end;
+end;
+
+
+function TChessBoard.FDoMove(i, j: integer; prom_fig: TFigureName = K): boolean;
+begin
+ Result := m_ChessRulesEngine.DoMove(m_i0, m_j0, i, j, prom_fig);
+ if (Result) then
+ FOnAfterMoveDone;
end;
@@ -494,25 +804,26 @@ var begin
case State of
dsDragEnter:
- hilighted:= FALSE;
+ m_bHilighted := 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]);
- // Перенести новый фрагмент на экран
+ // 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) + iSquareSize, abs(Y - y0) + iSquareSize);
- PBoxBoard.Canvas.CopyRect(rect, bmHiddenBoard.Canvas, rect);
+ abs(X - x0) + m_iSquareSize, abs(Y - y0) + m_iSquareSize);
+ PBoxBoard.Canvas.CopyRect(rect, m_bmHiddenBoard.Canvas, rect);
x0 := X;
y0 := Y;
- WhatSquare(Point(X,Y), i,j);
+ FWhatSquare(Point(X,Y), i, j);
Accept := ((i in [1..8]) and (j in [1..8]));
end;
@@ -520,50 +831,64 @@ begin end;
-procedure TChessBoard.PBoxBoardEndDrag(Sender, Target: TObject; X,
- Y: Integer);
+procedure TChessBoard.PBoxBoardEndDrag(Sender, Target: TObject; X, Y: Integer);
+var
+ i, j: integer;
+ bRes: boolean;
begin
- if hilighted then
- with bmHiddenBoard.Canvas do
+ case m_Mode of
+ mGame, mAnalyse:
+ begin
+ if (m_bHilighted) then
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);
+ 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
- RDrawBoard;
- if dragged_moved then
+ else
+ begin
+ if (AnimateTimer.Enabled) then
+ AnimateTimer.Enabled := FALSE;
+ FDrawBoard;
+ if (m_bDraggedMoved) then
begin
HilightLastMove;
Evaluate;
- dragged_moved:= FALSE;
+ m_bDraggedMoved := FALSE;
end;
+ end;
end;
-end;
-
-procedure TChessBoard.WhatSquare(const P: TPoint;
- var i: Integer; var j: Integer);
-begin
- with P do
+ mEdit:
begin
- i := (X - CHB_X + iSquareSize) div iSquareSize;
- j := 8 - (Y - CHB_Y) div iSquareSize;
- if (_flipped) then
+ if (m_bDraggedMoved) then
begin
- i := 9 - i;
- j := 9 - j;
+ 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;
+
+ if (bRes) then
+ begin
+ Position.SetPiece(m_i0, m_j0, ES);
+ FOnAfterSetPosition;
end;
- end;
+
+ FDrawBoard;
+ end;
+ end; // case
end;
@@ -573,58 +898,67 @@ var i, j: Integer;
f: TFigure;
begin
- WhatSquare(Point(X, Y), i, j);
+ 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 Mode of
- mGame:
+ case m_Mode of
+ mGame, mAnalyse:
begin
- if (ViewGaming) then
+ if (m_bViewGaming) 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
+ 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;
- else
- exit;
- end;
- if (anim_step < anim_step_num) then
+ mEdit:
begin
- anim_step:= anim_step_num;
- AnimateTimerTimer(nil);
+ if (f = ES) then
+ exit;
end;
- if ((i = m_i0) and (j = m_j0)) then
- hilighted := (hilighted xor TRUE)
else
- hilighted:= TRUE;
+ exit;
+ end;
+
+ if (m_iAnimStep < m_iAnimStepsCount) then
+ FEndAnimation;
m_fig := f;
m_i0 := i;
m_j0 := j;
- dx := (X - CHB_X) mod iSquareSize;
- dy := (Y - CHB_Y) mod iSquareSize;
+ dx := (X - CHB_X) mod m_iSquareSize;
+ dy := (Y - CHB_Y) mod m_iSquareSize;
x0 := X;
y0 := Y;
- dragged_moved := TRUE;
+ m_bDraggedMoved := TRUE;
PBoxBoard.BeginDrag(FALSE);
end;
-procedure TChessBoard.PBoxBoardMouseMove(Sender: TObject;
- Shift: TShiftState; X, Y: Integer);
+procedure TChessBoard.PBoxBoardMouseMove(Sender: TObject; Shift: TShiftState;
+ X, Y: Integer);
var
f: TFigure;
i,j: Integer;
begin
- WhatSquare(Point(X,Y), i,j);
+ FWhatSquare(Point(X,Y), i,j);
if (not ((i in [1..8]) and (j in [1..8]))) then
begin
PBoxBoard.Cursor:= crDefault;
@@ -633,388 +967,185 @@ begin f := Position.board[i,j];
- case Mode of
- mGame:
+ case m_Mode of
+ mGame, mAnalyse:
begin
- if (ViewGaming) then
+ if (m_bViewGaming) then
exit;
-
- if (player_color = Position.color) and
+
+ 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;
-
- else
- PBoxBoard.Cursor:= crDefault;
- end;
-end;
-
-
-procedure TChessBoard.ROnAfterMoveDone;
-var
- strLastMove: string;
-begin
- if (Assigned(Handler) and
- ((Mode = mGame) and (Position.color <> player_color))) then
- begin
- strLastMove := ChessRulesEngine.LastMoveStr;
- Handler(cbeMoved, @strLastMove, self);
- end;
-end;
-
+ end;
-procedure TChessBoard.FOnAfterMoveDone;
-var
- _fig: TFigure;
-begin
- m_i0 := lastMove.i0;
- m_j0 := lastMove.j0;
+ mEdit:
+ begin
+ if (f <> ES) then
+ PBoxBoard.Cursor:= crHandPoint
+ else
+ PBoxBoard.Cursor:= crDefault;
+ end;
- _fig := Position.board[lastMove.i, lastMove.j];
- if (lastMove.prom_fig in [Q, R, B, N]) then
- begin
- if (_fig < ES) then
- m_fig := WP
- else
- m_fig := BP;
- end
else
- m_fig := _fig;
-
- ROnAfterMoveDone;
+ PBoxBoard.Cursor := crDefault;
+ end;
end;
-function TChessBoard.RDoMove(i, j: integer; prom_fig: TFigureName = K): boolean;
+function TChessBoard.FGetPositionsList: TList;
begin
- Result := ChessRulesEngine.DoMove(m_i0, m_j0, i, j, prom_fig);
- if (Result) then
- FOnAfterMoveDone;
+ Result := m_ChessRulesEngine.PositionsList;
end;
-function TChessBoard.FGetPositionsList: TList;
+function TChessBoard.FGetColorStarts: TFigureColor;
begin
- Result := ChessRulesEngine.PositionsList;
+ Result := m_ChessRulesEngine.GetColorStarts;
end;
-procedure TChessBoard.PBoxBoardMouseUp(Sender: TObject;
- Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
+procedure TChessBoard.PBoxBoardMouseUp(Sender: TObject; Button: TMouseButton;
+ Shift: TShiftState; X, Y: Integer);
var
i, j: integer;
begin
case Button of
mbLeft:
- case Mode of
- mGame:
+ 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
- if (not hilighted) then
- exit;
- WhatSquare(Point(X, Y), i, j);
- if (dragged_moved) then
- RDrawBoard
+ m_bHilighted := FALSE;
+ if (FDoMove(i, j)) then
+ FAnimate(i, j)
else
- begin
- hilighted:= FALSE;
- if (RDoMove(i, j)) then
- begin
- Animate(i, j);
- SwitchClock(PositionColor);
- end
- else
- RDrawBoard;
- end;
+ FDrawBoard;
end;
- 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:
- if (Assigned(Handler)) then
- Handler(cbeMenu, self);
+ begin
+ FDoHandler(cbeMenu, self);
+ end;
+
end;
end;
+
procedure TChessBoard.PBoxBoardStartDrag(Sender: TObject;
var DragObject: TDragObject);
begin
- // Копировать изображение пустого поля в m_bmBuf
- m_bmBuf.Width:= iSquareSize; m_bmBuf.Height:= iSquareSize;
+ // 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, 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));
- dragged_moved:= FALSE;
-end;
-
-
-procedure TChessBoard.Animate(const i, j: integer);
-var
- x, y: integer;
-begin
- if not Showing then exit;
-
- case animation of
- aNo: anim_step_num:= 1;
- aSlow: anim_step_num:= ANIMATION_SLOW;
- aQuick: anim_step_num:= 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;
- 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;
- end;
-
- anim_dx:= (x-x0) / anim_step_num;
- anim_dy:= (y-y0) / anim_step_num;
-
- anim_step:= 0;
-
- // Копировать изображение пустого поля в 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));
-
- AnimateTimer.Enabled := TRUE;
-end;
-
-
-procedure TChessBoard.AnimateTimerTimer(Sender: TObject);
-var
- X,Y: integer;
- rect: TRect;
-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));
-
- // Восстановить фрагмент на 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
- begin
- AnimateTimer.Enabled := FALSE;
- RDrawBoard;
- HilightLastMove;
- Evaluate;
- end;
+ m_bDraggedMoved := FALSE;
end;
procedure TChessBoard.InitPosition;
begin
- ChessRulesEngine.InitNewGame;
- RDrawBoard;
-end;
+ m_ChessRulesEngine.InitNewGame;
+ FCancelAnimationDragging;
+ FOnAfterSetPosition;
-procedure TChessBoard.SetMode(const m: TMode);
-begin
- mode_var := m;
- RDrawBoard;
- HilightLastMove;
- if (mode_var <> mGame) then
- begin
- WhiteFlagButton.Visible := FALSE;
- BlackFlagButton.Visible := FALSE;
- end;
+ FDrawBoard;
end;
-procedure TChessBoard.SetTime(color: TFigureColor; const tm: TDateTime);
+procedure TChessBoard.PPRandom;
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;
-end;
+ m_ChessRulesEngine.InitNewPPRandomGame;
-
-function TChessBoard.GetTime(color: TFigureColor): TDateTime;
-begin
- Result:= player_time[color];
+ FCancelAnimationDragging;
+ FOnAfterSetPosition;
+
+ FDrawBoard;
end;
-procedure TChessBoard.GameTimerTimer(Sender: TObject);
+procedure TChessBoard.TakeBack;
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 (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;
-end;
+ if (m_Mode = mEdit) then
+ exit;
+ if (not m_ChessRulesEngine.TakeBack) then
+ exit;
-procedure TChessBoard.SetUnlimited(color: TFigureColor; const unl: boolean);
-begin
- unlimited_var[color]:= unl;
- ShowTime(color);
+ FOnAfterSetPosition;
+ // TODO: animation
+ FDrawBoard;
end;
-function TChessBoard.GetUnlimited(color: TFigureColor): boolean;
+function TChessBoard.NMoveDone: integer;
begin
- Result := unlimited_var[color];
+ Result := m_ChessRulesEngine.NMovesDone;
end;
-procedure TChessBoard.SwitchClock(clock_color: TFigureColor);
+function TChessBoard.NPlysDone: 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);
-
-{$IFDEF THREADED_CHESSCLOCK}
- if (not Assigned(TimeLabelThread)) then
- TimeLabelThread := TTimeLabelThread.Create(self);
-{$ENDIF}
+ Result := m_ChessRulesEngine.NPlysDone;
end;
-procedure TChessBoard.HilightLastMove;
-var
- i, j, l,
- _i0, _j0, x, y: integer;
+function TChessBoard.FGetMovesOffset: integer;
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
- begin
- _i0 := lastMove.i0;
- _j0 := 9 - lastMove.j0;
- i := lastMove.i;
- j := 9 - lastMove.j;
- 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
- begin
- MoveTo(x, y);
- LineTo(x + iSquareSize - 1, y);
- LineTo(x + iSquareSize - 1, y + iSquareSize - 1);
- LineTo(x, y + iSquareSize - 1);
- LineTo(x, y);
-
- x := iSquareSize * (i - 1) + CHB_X;
- y := iSquareSize * (j - 1) + CHB_Y;
- end;
- PBoxBoardPaint(nil);
- end;
+ Result := m_ChessRulesEngine.MovesOffset;
end;
-procedure TChessBoard.SetPlayerColor(const color: TFigureColor);
+function TChessBoard.FGetPositionColor: TFigureColor;
begin
- FCancelAnimationDragging;
- player_color:= color;
- if (player_color = fcWhite) then
- SetFlipped(FALSE)
- else
- SetFlipped(TRUE); // player_color = fcBlack
-end;
-
-
-procedure TChessBoard.StopClock;
-begin
- GameTimer.Enabled := FALSE;
- WhiteFlagButton.Visible := FALSE;
- BlackFlagButton.Visible := FALSE;
+ Result := Position.color;
end;
procedure TChessBoard.FormCanResize(Sender: TObject; var NewWidth,
NewHeight: Integer; var Resize: Boolean);
var
-
NewBoardSize: TSize;
begin
+ if (not m_bDeltaWidthHeightFlag) then
+ begin
+ m_iDeltaWidthHeight := Width - Height;
+ m_bDeltaWidthHeightFlag := TRUE;
+ end;
+
Resize := (m_ResizingType <> rtNo);
if (not Resize) then
exit;
@@ -1037,355 +1168,214 @@ begin end;
-procedure TChessBoard.FormClose(Sender: TObject; var Action: TCloseAction);
-begin
- if ((not shuted) and Assigned(Handler)) then
- begin
- Handler(cbeExit, self);
- Action:= caNone;
- end
- else
- shuted := FALSE;
-end;
-
-
-procedure TChessBoard.Shut;
+procedure TChessBoard.FormResize(Sender: TObject);
+var
+ _fig: TFigure;
begin
- shuted:= TRUE;
- Close;
-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;
-procedure TChessBoard.Evaluate;
-begin
- if (Assigned(Handler)) then
+ // Graphics initialization
+ if (not Assigned(m_bmHiddenBoard)) then
begin
- case ChessRulesEngine.GetEvaluation of
- evMate:
- Handler(cbeMate, self);
- evStaleMate:
- Handler(cbeStaleMate, self);
- end;
+ m_bmHiddenBoard := Graphics.TBitmap.Create;
+ m_bmHiddenBoard.Palette := m_bmChessBoard.Palette;
+ m_bmHiddenBoard.Canvas.Font := PBoxBoard.Font; // Характеристики шрифта координат задаются в инспекторе
+ m_bmHiddenBoard.Canvas.Brush.Style := bsClear;
end;
-end;
+ m_bmHiddenBoard.Width := m_bmChessBoard.Width;
+ m_bmHiddenBoard.Height := m_bmChessBoard.Height;
+ if (not Assigned(m_bmBuf)) then
+ begin
+ m_bmBuf := Graphics.TBitmap.Create;
+ m_bmBuf.Palette:= m_bmChessBoard.Palette;
+ end;
-procedure TChessBoard.PPRandom;
-begin
- ChessRulesEngine.InitNewPPRandomGame;
- RDrawBoard;
+ FDrawBoard;
end;
-procedure TChessBoard.TakeBack;
+procedure TChessBoard.WMSizing(var Msg: TMessage);
begin
- if (not ChessRulesEngine.TakeBack) then
- exit;
- ROnAfterSetPosition;
- // TODO: animation
- RDrawBoard;
+ 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;
-procedure TChessBoard.SetHilightLastMove(const yes: boolean);
+procedure TChessBoard.FDoHandler(e: TChessBoardEvent; d1: pointer = nil; d2: pointer = nil);
begin
- last_hilight := yes;
- RDrawBoard;
- HilightLastMove;
+ if (Assigned(FHandler)) then
+ FHandler(e, d1, d2);
end;
-procedure TChessBoard.SetCoordinates(const yes: boolean);
+function TChessBoard.FGetMoveNotationFormat: TMoveNotationFormat;
begin
- coord_show := yes;
- RDrawBoard;
- HilightLastMove;
+ Result := m_ChessRulesEngine.MoveNotationFormat;
end;
-function TChessBoard.NMoveDone: integer;
+procedure TChessBoard.FSetMoveNotationFormat(Value: TMoveNotationFormat);
begin
- Result := ChessRulesEngine.NMovesDone;
+ m_ChessRulesEngine.MoveNotationFormat := Value;
end;
-procedure TChessBoard.ROnAfterSetPosition;
-begin
-end;
-
-{$IFDEF THREADED_CHESSCLOCK}
-procedure TTimeLabelThread.Execute;
+function TChessBoard.FGetFENFormat: boolean;
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.FENFormat;
end;
-constructor TTimeLabelThread.Create(ChessBoard: TChessBoard);
+procedure TChessBoard.FSetFENFormat(bValue: boolean);
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}
-
-procedure TChessBoard.FormKeyDown(Sender: TObject; var Key: Word;
- Shift: TShiftState);
-begin
- if Assigned(Handler) then
- Handler(cbeKeyPressed, Pointer(Key), self);
+ m_ChessRulesEngine.FENFormat := bValue;
end;
-function TChessBoard.GetStayOnTop: boolean;
+procedure TChessBoard.BeginUpdate;
begin
- Result := (self.FormStyle = fsStayOnTop);
+ inc(m_iUpdateCounter);
end;
-procedure TChessBoard.SetStayOnTop(onTop: boolean);
+procedure TChessBoard.EndUpdate;
begin
- if (onTop) then
- self.FormStyle := fsStayOnTop
- else
- self.FormStyle := fsNormal;
+ if (m_iUpdateCounter > 0) then
+ begin
+ dec(m_iUpdateCounter);
+ if (m_iUpdateCounter = 0) then
+ FDrawBoard;
+ end;
end;
-procedure TChessBoard.FormActivate(Sender: TObject);
+procedure TChessBoard.FOnDrawLayerUpdate(const ADrawLayer: TChessBoardLayerBase);
begin
- if Assigned(Handler) then
- Handler(cbeActivate, self);
+ if (not AnimateTimer.Enabled) then
+ FDrawBoard;
end;
-procedure TChessBoard.WMMoving(var Msg: TWMMoving);
+procedure TChessBoard.AddLayer(const ALayer: TChessBoardLayerBase);
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;
-end;
+ if (m_lstLayers.IndexOf(ALayer) >= 0) then
+ exit;
+ ALayer.ChessBoard := self;
+ m_lstLayers.Add(ALayer);
-procedure TChessBoard.WMSizing(var Msg: TMessage);
-begin
- 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 }
+ FOnDrawLayerUpdate(ALayer);
end;
-function TChessBoard.FGetPositinoColor: TFigureColor;
+procedure TChessBoard.RemoveLayer(const ALayer: TChessBoardLayerBase);
begin
- Result := Position.color;
-end;
-
+ if (m_lstLayers.Remove(ALayer) >= 0) then
+ begin
+ ALayer.ChessBoard := nil;
-function TChessBoard.FGetPosition: PChessPosition;
-begin
- Result := ChessRulesEngine.Position;
+ FOnDrawLayerUpdate(ALayer);
+ end;
end;
-function TChessBoard.AskPromotionFigure(FigureColor: TFigureColor): TFigureName;
+function TChessBoard.IsMoveAnimating: boolean;
begin
- if (Showing) then
- begin
- with TPromotionForm.Create(self, m_BitmapRes) do
- try
- Result := ShowPromotion(FigureColor);
- finally
- Free;
- end;
- end
- else
- Result := Q;
+ Result := AnimateTimer.Enabled;
end;
+////////////////////////////////////////////////////////////////////////////////
+// TChessBoardDrawBase
-function TChessBoard.FGetLastMove: PMoveAbs;
+procedure TChessBoardLayerBase.RDoUpdate;
begin
- Result := ChessRulesEngine.lastMove;
+ if (Assigned(m_ChessBoard)) then
+ m_ChessBoard.FOnDrawLayerUpdate(self);
end;
-procedure TChessBoard.FCancelAnimationDragging;
+function TChessBoardLayerBase.FGetSquareSize: integer;
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;
+ if (Assigned(m_ChessBoard)) then
+ Result := m_ChessBoard.SquareSize
+ else
+ Result := 0;
end;
-procedure TChessBoard.FlagButtonClick(Sender: TObject);
+function TChessBoardLayerBase.FGetCanvas: TCanvas;
begin
- if Assigned(Handler) and (Mode = mGame) then
- Handler(cbeTimeOut, self);
+ if (Assigned(m_ChessBoard)) then
+ Result := m_ChessBoard.FGetHiddenBoardCanvas
+ else
+ Result := nil;
end;
-procedure TChessBoard.SetAutoFlag(auto_flag: boolean);
+function TChessBoardLayerBase.FGetPosition: PChessPosition;
begin
- self.auto_flag := auto_flag;
- if (auto_flag) then
- begin
- WhiteFlagButton.Visible := FALSE;
- BlackFlagButton.Visible := FALSE;
- end;
+ if (Assigned(m_ChessBoard)) then
+ Result := m_ChessBoard.Position
+ else
+ Result := nil;
end;
-procedure TChessBoard.FormResize(Sender: TObject);
-var
- _fig: TFigure;
+function TChessBoardLayerBase.RGetColorStarts: TFigureColor;
begin
- FreeAndNil(m_bmChessBoard);
- m_BitmapRes.CreateBoardBitmap(Size(PBoxBoard.Width, PBoxBoard.Height), self.Color,
- m_bmChessBoard);
- 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(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;
-
- if (not Assigned(m_bmBuf)) then
- begin
- m_bmBuf := TBitmap.Create;
- m_bmBuf.Palette:= m_bmChessBoard.Palette;
- end;
-
- RDrawBoard;
+ if (Assigned(m_ChessBoard)) then
+ Result := m_ChessBoard.FGetColorStarts
+ else
+ Result := fcWhite;
end;
-procedure TChessBoard.TimePanelResize(Sender: TObject);
-var
- rRatio: real;
+function TChessBoardLayerBase.FGetPositionsList: TList;
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
+ if (Assigned(m_ChessBoard)) then
+ Result := m_ChessBoard.PositionsList
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;
+procedure TChessBoardLayerBase.ROnAfterMoveDone;
+begin
end;
-procedure TChessBoard.FFlashWindow;
-var
- flushWindowInfo: TFlashWInfo;
+procedure TChessBoardLayerBase.ROnAfterSetPosition;
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 TChessBoard.FLocalize;
+procedure TChessBoardLayerBase.ROnAfterModeSet(const OldValue, NewValue: TMode);
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;
-initialization
+procedure TChessBoardLayerBase.ROnResetMoveList;
begin
- Randomize; // для PP Random
end;
-finalization
-
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
- // <Фигура>
+ // <Piece>
case f of
K: Result:= 'K';
Q: Result:= 'Q';
@@ -717,50 +872,73 @@ begin B: Result:= 'B';
N: Result:= 'N';
end;
- // [<Вертикаль>][<Горизонталь>]
+
+ // [<Line>][<Row>]
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;
- // <Конечное поле>
+ // <Destination field>
Result := Result + chr(ord('a') + lastMove.i - 1) + IntToStr(lastMove.j);
- // <Короткая рокировка> | <Длинная рокировка>
- if f = K then
+ // <Short castling> | <Long castling>
+ 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 Binary files differindex 8131f9dea4..6aa5de5595 100644 --- a/plugins/Chess4Net/Lang.ini +++ b/plugins/Chess4Net/Lang.ini 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;
@@ -646,29 +645,6 @@ begin 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
constructor TTransmittingManagerMI.Create(Connector: TConnector; GamingManager: TGamingManagerMI);
@@ -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;
@@ -210,16 +231,13 @@ type {$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 // <time control>
str := str + ClockToStr + '&';
// <current time>
- LongTimeFormat := HOUR_TIME_FORMAT;
- str := str + TimeToStr(Time[fcWhite]) + ' ' + TimeToStr(Time[fcBlack]);
+ str := str + TChessClock.ConvertToFullStr(Time[fcWhite], FALSE) + ' ' +
+ TChessClock.ConvertToFullStr(Time[fcBlack], FALSE);
end;
Result := str;
@@ -2214,6 +2169,18 @@ begin end;
+function TManager.FGetAdjournedStr: string;
+begin
+ Result := TIniSettings.Instance.Adjourned;
+end;
+
+
+procedure TManager.FSetAdjournedStr(const strValue: string);
+begin
+ TIniSettings.Instance.Adjourned := strValue;
+end;
+
+
procedure TManager.RSetGameContext(const strValue: string);
var
str: string;
@@ -2225,7 +2192,7 @@ begin // strValue ::= <position>&<this player's color>&<time control>&<current time>
- str := strValue;
+ str := strValue;
l := pos('&', str);
strPosition := LeftStr(str, l - 1);
@@ -2239,7 +2206,7 @@ begin strTimeControl := LeftStr(str, l - 1);
strCurrentTime := RightStr(str, length(str) - l);
- SetClock(strTimeControl);
+ SetClock(strTimeControl);
if (((_PlayerColor = fcWhite) and (strPlayerColor <> 'w')) or
((_PlayerColor = fcBlack) and (strPlayerColor <> 'b'))) then
@@ -2250,9 +2217,9 @@ begin SetPosition(strPosition);
RSplitStr(strCurrentTime, str, strCurrentTime);
- LongTimeFormat := HOUR_TIME_FORMAT;
- Time[fcWhite] := StrToTime(str);
- Time[fcBlack] := StrToTime(strCurrentTime);
+
+ Time[fcWhite] := TChessClock.ConvertFromFullStr(str);
+ Time[fcBlack] := TChessClock.ConvertFromFullStr(strCurrentTime);
end;
end;
@@ -2284,6 +2251,7 @@ begin AdjournGame.Caption := GetLabel(61);
GamePause.Caption := GetLabel(62);
TakebackGame.Caption := GetLabel(63);
+ BroadcastAction.Caption := GetLabel(69);
end;
end;
@@ -2306,11 +2274,14 @@ begin StartAdjournedGameConnected.Visible := FALSE;
StartStandartGameConnected.Visible := FALSE;
StartPPRandomGameConnected.Visible := FALSE;
- N5.Visible := FALSE;
- ChangeColorConnected.Visible := FALSE;
+// ChangeColorConnected.Visible := FALSE;
GameOptionsConnected.Visible := FALSE;
- ChessBoard.ViewGaming := TRUE;
+{$IFDEF SKYPE}
+ BroadcastAction.Visible := FALSE;
+{$ENDIF}
+
+ ChessBoard.ViewGaming := TRUE;
end;
end;
@@ -2369,6 +2340,17 @@ begin Result := OpponentNick + ' - ' + PlayerNick;
end;
+
+procedure TManager.BroadcastActionExecute(Sender: TObject);
+begin
+ RBroadcast;
+end;
+
+
+procedure TManager.RBroadcast;
+begin
+end;
+
////////////////////////////////////////////////////////////////////////////////
// TManagerDefault
diff --git a/plugins/Chess4Net/MessageDialogUnit.pas b/plugins/Chess4Net/MessageDialogUnit.pas index 941057991b..2d367c02c6 100644 --- a/plugins/Chess4Net/MessageDialogUnit.pas +++ b/plugins/Chess4Net/MessageDialogUnit.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 MessageDialogUnit;
interface
diff --git a/plugins/Chess4Net/ModalForm.pas b/plugins/Chess4Net/ModalForm.pas index b40c199c37..165fee6b86 100644 --- a/plugins/Chess4Net/ModalForm.pas +++ b/plugins/Chess4Net/ModalForm.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 ModalForm;
interface
uses
- Forms, TntForms, Dialogs, Classes, Windows;
+ Forms, TntForms, Dialogs, Classes, Windows, Controls;
type
TModalForm = class;
@@ -11,14 +17,13 @@ type TModalFormID = (mfNone, mfMsgClose, mfMsgLeave, mfMsgAbort, mfMsgResign,
mfMsgDraw, mfMsgTakeBack, mfMsgAdjourn, mfConnecting, mfGameOptions,
- mfLookFeel, mfCanPause, mfContinue, mfIncompatible
+ mfLookFeel, mfCanPause, mfContinue, mfIncompatible, mfDontShowDlg
{$IFDEF SKYPE}
, mfSelectSkypeContact
{$ENDIF}
{$IFDEF MIRANDA}
, mfTransmitting, mfTransmitGame
{$ENDIF}
-
);
TModalFormHandler = procedure(modSender: TModalForm; modID: TModalFormID) of object;
@@ -61,8 +66,9 @@ type protected
RHandler: TModalFormHandler;
dlgOwner: TDialogs;
- constructor Create(Owner: TForm; modHandler: TModalFormHandler = nil); reintroduce; overload; virtual;
+
constructor Create(dlgOwner: TDialogs; modHandler: TModalFormHandler); reintroduce; overload; virtual;
+
function GetHandle: hWnd; virtual;
function GetEnabled_: boolean; virtual;
procedure SetEnabled_(flag: boolean); virtual;
@@ -73,7 +79,12 @@ type function GetModalID: TModalFormID; virtual;
+ function RGetModalResult: TModalResult; virtual;
+ procedure RSetModalResult(Value: TModalResult); virtual;
+
public
+ constructor Create(Owner: TForm; modHandler: TModalFormHandler = nil); reintroduce; overload; virtual;
+
procedure Show; virtual;
procedure Close; virtual;
@@ -81,12 +92,14 @@ type property Enabled: boolean read GetEnabled_ write SetEnabled_;
property Left: integer read GetLeft_ write SetLeft_;
property Top: integer read GetTop_ write SetTop_;
+
+ property ModalResult: TModalResult read RGetModalResult write RSetModalResult;
end;
implementation
uses
- SysUtils, StdCtrls, Controls,
+ SysUtils, StdCtrls,
DialogUnit, GlobalsUnit;
var
@@ -128,6 +141,7 @@ var iLeft, iTop: integer;
begin // TModalForm.FormShow
selfForm := Sender as TForm;
+ frmOwner := nil;
if (Assigned(Owner)) then
begin
@@ -269,9 +283,63 @@ begin inherited Top := y;
end;
+
+function TModalForm.RGetModalResult: TModalResult;
+begin
+ Result := inherited ModalResult;
+end;
+
+procedure TModalForm.RSetModalResult(Value: TModalResult);
+begin
+ inherited ModalResult := Value;
+end;
+
////////////////////////////////////////////////////////////////////////////////
// TDialogs
+constructor TDialogs.Create(Owner: TForm; Handler: TModalFormHandler);
+var
+ i: TModalFormID;
+begin
+ inherited Create;
+
+ self.Owner := Owner;
+ self.RHandler := Handler;
+ frmList := TList.Create;
+ for i := Low(TModalFormID) to High(TModalFormID) do
+ IDCount[i] := 0;
+
+ if (not Assigned(g_lstDialogs)) then
+ g_lstDialogs := TList.Create;
+ g_lstDialogs.Add(self);
+end;
+
+
+destructor TDialogs.Destroy;
+var
+ i: integer;
+ ModalForm: TModalForm;
+begin
+ if (Assigned(g_lstDialogs)) then
+ begin
+ g_lstDialogs.Remove(self);
+ if (g_lstDialogs.Count = 0) then
+ FreeAndNil(g_lstDialogs);
+ end;
+
+ for i := 0 to frmList.Count - 1 do
+ begin
+ ModalForm := frmList[i];
+ ModalForm.RHandler := nil;
+ ModalForm.dlgOwner := nil;
+// ModalForm.Release;
+ ModalForm.Free;
+ end;
+
+ inherited;
+end;
+
+
function TDialogs.GetShowing: boolean;
var
i: TModalFormID;
@@ -359,46 +427,6 @@ begin end;
-constructor TDialogs.Create(Owner: TForm; Handler: TModalFormHandler);
-var
- i: TModalFormID;
-begin
- inherited Create;
-
- self.Owner := Owner;
- self.RHandler := Handler;
- frmList := TList.Create;
- for i := Low(TModalFormID) to High(TModalFormID) do
- IDCount[i] := 0;
-
- if (not Assigned(g_lstDialogs)) then
- g_lstDialogs := TList.Create;
- g_lstDialogs.Add(self);
-end;
-
-
-destructor TDialogs.Destroy;
-var
- i: integer;
- ModalForm: TModalForm;
-begin
- if (Assigned(g_lstDialogs)) then
- begin
- g_lstDialogs.Remove(self);
- FreeAndNil(g_lstDialogs);
- end;
-
- for i := 0 to frmList.Count - 1 do
- begin
- ModalForm := frmList[i];
- ModalForm.RHandler := nil;
- ModalForm.Release;
- end;
-
- inherited;
-end;
-
-
procedure TDialogs.SetShowing(msgDlg: TModalForm);
begin
inc(IDCount[msgDlg.GetModalID]);
diff --git a/plugins/Chess4Net/NonMainFormStayOnTopUnit.pas b/plugins/Chess4Net/NonMainFormStayOnTopUnit.pas new file mode 100644 index 0000000000..47ded58c89 --- /dev/null +++ b/plugins/Chess4Net/NonMainFormStayOnTopUnit.pas @@ -0,0 +1,74 @@ +////////////////////////////////////////////////////////////////////////////////
+// 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 NonMainFormStayOnTopUnit;
+
+// Inclusion of this unit enables all non-main forms with FormStyle = fsStayOnTop
+// to stay on top even if application is deactivated
+
+interface
+
+implementation
+
+uses
+ Forms, SysUtils, Classes, Messages, Windows;
+
+type
+ TApplicationObjSubclasser = class
+ private
+ m_NewObj, m_OldObj: pointer;
+ procedure FWndProc(var Message: TMessage);
+ public
+ constructor Create;
+ destructor Destroy; override;
+ end;
+
+var
+ g_ApplicationObjSubclasserInstance: TApplicationObjSubclasser = nil;
+
+////////////////////////////////////////////////////////////////////////////////
+// TApplicationObjSubclasser
+
+constructor TApplicationObjSubclasser.Create;
+begin
+ inherited Create;
+
+ m_NewObj := Classes.MakeObjectInstance(FWndProc);
+ m_OldObj := Pointer (SetWindowLong(Application.Handle, GWL_WNDPROC,
+ Cardinal(m_NewObj)));
+end;
+
+
+destructor TApplicationObjSubclasser.Destroy;
+begin
+ SetWindowLong(Application.Handle, GWL_WNDPROC, Cardinal(m_OldObj));
+ Classes.FreeObjectInstance(m_NewObj);
+
+ inherited;
+end;
+
+
+procedure TApplicationObjSubclasser.FWndProc(var Message: TMessage);
+begin
+ Message.Result := CallWindowProc (m_OldObj, Application.Handle,
+ Message.Msg, Message.wParam, Message.lParam);
+
+ case Message.Msg of
+ WM_ACTIVATEAPP:
+ begin
+ if (not TWMActivateApp(Message).Active) then
+ Application.RestoreTopMosts;
+ end;
+ end;
+end;
+
+initialization
+ g_ApplicationObjSubclasserInstance := TApplicationObjSubclasser.Create;
+
+finalization
+ FreeAndNil(g_ApplicationObjSubclasserInstance);
+
+end.
\ No newline at end of file diff --git a/plugins/Chess4Net/NonRefInterfacedObjectUnit.pas b/plugins/Chess4Net/NonRefInterfacedObjectUnit.pas new file mode 100644 index 0000000000..a6a32f2901 --- /dev/null +++ b/plugins/Chess4Net/NonRefInterfacedObjectUnit.pas @@ -0,0 +1,44 @@ +////////////////////////////////////////////////////////////////////////////////
+// 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 NonRefInterfacedObjectUnit;
+
+interface
+
+type
+ TNonRefInterfacedObject = class(TObject, IInterface)
+ protected
+ function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
+ function _AddRef: Integer; stdcall;
+ function _Release: Integer; stdcall;
+ end;
+
+implementation
+
+////////////////////////////////////////////////////////////////////////////////
+// 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;
+
+end.
diff --git a/plugins/Chess4Net/PosBaseChessBoardLayerUnit.pas b/plugins/Chess4Net/PosBaseChessBoardLayerUnit.pas new file mode 100644 index 0000000000..535f181e9c --- /dev/null +++ b/plugins/Chess4Net/PosBaseChessBoardLayerUnit.pas @@ -0,0 +1,620 @@ +////////////////////////////////////////////////////////////////////////////////
+// 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 PosBaseChessBoardLayerUnit;
+
+interface
+
+uses
+ Classes,
+ //
+ ChessBoardUnit, PosBaseUnit;
+
+
+type
+ TGameResult = (grWin, grWinTime, grDraw, grLost, grLostTime);
+
+ // Layer extended with Position DB
+ TPosBaseChessBoardLayer = class(TChessBoardLayerBase)
+ private
+ m_bTrainingMode: boolean;
+ m_lstMovePrior: TList;
+ m_bUseUserBase: boolean;
+ m_PosBase, m_ExtPosBase: TPosBase;
+ m_strPosBaseName, m_strExtPosBaseName: string;
+
+ procedure FSetTrainingMode(bValue: boolean);
+ procedure FSetUseUserBase(bValue: boolean);
+
+ procedure FClearMovePriorList;
+ procedure FReadFromBase;
+ procedure FWriteGameToBase;
+ protected
+ procedure RDraw; override;
+ procedure ROnAfterMoveDone; override;
+ procedure ROnAfterSetPosition; override;
+ procedure ROnAfterModeSet(const OldValue, NewValue: TMode); override;
+ procedure ROnResetMoveList; override;
+ public
+ constructor Create(const strPosBaseName: string = '');
+ destructor Destroy; override;
+ procedure SetExternalBase(const strExtPosBaseName: string);
+ procedure WriteGameToBase(AGameResult: TGameResult);
+ procedure UnsetExternalBase;
+ property TrainingMode: boolean read m_bTrainingMode write FSetTrainingMode;
+ property UseUserBase: boolean read m_bUseUserBase write FSetUseUserBase;
+ end;
+
+implementation
+
+uses
+ Graphics, SysUtils,
+ //
+ ChessRulesEngine, ChessBoardHeaderUnit;
+
+type
+ TPrior = (mpNo, mpHigh, mpMid, mpLow);
+
+ PMovePrior = ^TMovePrior;
+ TMovePrior = record
+ move: TMoveAbs;
+ prior: TPrior;
+ end;
+
+ TPosBaseOperator = class(TThread)
+ private
+ m_Operation: (opRead, opWrite);
+ m_Layer: TPosBaseChessBoardLayer;
+ constructor FCreateRead(ALayer: TPosBaseChessBoardLayer;
+ vbFreeOnTerminate: boolean = TRUE);
+ constructor FCreateWrite(ALayer: TPosBaseChessBoardLayer);
+ protected
+ procedure Execute; override;
+ public
+ class function CreateRead(ALayer: TPosBaseChessBoardLayer;
+ vbFreeOnTerminate: boolean = TRUE): TPosBaseOperator;
+ class function CreateWrite(ALayer: TPosBaseChessBoardLayer): TPosBaseOperator;
+ procedure WaitFor;
+ end;
+
+var
+ gameResult: TGameResult; // Not threadsafe
+ gameID: word; // It's used for writing unique positions (not threadsafe)
+
+const
+ NUM_PRIORITIES = 3; // Maximal number of priorities
+{$IFDEF RESTRICT_TRAINING_DB}
+ MAX_PLY_TO_BASE = 60;
+{$ELSE}
+ MAX_PLY_TO_BASE = -1; // The whole game is saved to the DB
+{$ENDIF}
+
+////////////////////////////////////////////////////////////////////////////////
+// TPosBaseChessBoardLayer
+
+constructor TPosBaseChessBoardLayer.Create(const strPosBaseName: string = '');
+begin
+ inherited Create;
+
+ m_bUseUserBase := TRUE;
+ m_strPosBaseName := strPosBaseName;
+
+ m_lstMovePrior := TList.Create;
+end;
+
+
+destructor TPosBaseChessBoardLayer.Destroy;
+begin
+ FClearMovePriorList;
+ m_lstMovePrior.Free;
+
+ TrainingMode := FALSE;
+
+ inherited;
+end;
+
+
+procedure TPosBaseChessBoardLayer.RDraw;
+const
+ ARROW_END_LENGTH = 10; // в пикселях
+ ARROW_END_ANGLE = 15 * (Pi / 180); // угол концов стрелки
+ ARROW_INDENT = 7;
+
+ HIGH_ARROW_COLOR = clRed;
+ HIGH_ARROW_WIDTH = 2;
+ MID_ARROW_COLOR = clTeal;
+ MID_ARROW_WIDTH = 2;
+ LOW_ARROW_COLOR = clSkyBlue;
+ LOW_ARROW_WIDTH = 1;
+
+var
+ i, x0, y0, x, y: integer;
+ xa, ya, ca, sa: double;
+ move: TMoveAbs;
+begin
+ if (not (Assigned(ChessBoard) and Assigned(Canvas))) then
+ exit;
+
+ if (not (m_bTrainingMode and (ChessBoard.Mode in [mGame, mAnalyse]) and
+ (ChessBoard.PlayerColor = ChessBoard.PositionColor))) then
+ exit;
+
+ Canvas.Pen.Style := psSolid;
+
+ for i := 0 to m_lstMovePrior.Count - 1 do
+ begin
+ case PMovePrior(m_lstMovePrior[i]).prior of
+ mpNo: continue;
+ mpHigh:
+ begin
+ Canvas.Pen.Color := HIGH_ARROW_COLOR;
+ Canvas.Pen.Width := HIGH_ARROW_WIDTH;
+ end;
+ mpMid:
+ begin
+ Canvas.Pen.Color := MID_ARROW_COLOR;
+ Canvas.Pen.Width := MID_ARROW_WIDTH;
+ end;
+ mpLow:
+ begin
+ Canvas.Pen.Color := LOW_ARROW_COLOR;
+ Canvas.Pen.Width := LOW_ARROW_WIDTH;
+ end;
+ end;
+
+ move := PMovePrior(m_lstMovePrior[i]).move;
+
+ if (not ChessBoard.Flipped) then
+ begin
+ x0 := CHB_X + SquareSize * (move.i0 - 1) + (SquareSize div 2);
+ y0 := CHB_Y + SquareSize * (8 - move.j0) + (SquareSize div 2);
+ x := CHB_X + SquareSize * (move.i - 1) + (SquareSize div 2);
+ y := CHB_Y + SquareSize * (8 - move.j) + (SquareSize div 2);
+ end
+ else
+ begin
+ x0 := CHB_X + SquareSize * (8 - move.i0) + (SquareSize div 2);
+ y0 := CHB_Y + SquareSize * (move.j0 - 1) + (SquareSize div 2);
+ x := CHB_X + SquareSize * (8 - move.i) + (SquareSize div 2);
+ y := CHB_Y + SquareSize * (move.j - 1) + (SquareSize div 2);
+ end;
+
+ // Draw an arrow
+ ca := (x - x0) / sqrt(sqr(x - x0) + sqr(y - y0));
+ sa := (y - y0) / sqrt(sqr(x - x0) + sqr(y - y0));
+ x0 := x0 + Round(ARROW_INDENT * ca);
+ y0 := y0 + Round(ARROW_INDENT * sa);
+ x := x - Round(ARROW_INDENT * ca);
+ y := y - Round(ARROW_INDENT * sa);
+
+ Canvas.MoveTo(x0, y0);
+ Canvas.LineTo(x, y);
+
+ xa := x + (-ARROW_END_LENGTH * cos(ARROW_END_ANGLE)) * ca -
+ (ARROW_END_LENGTH * sin(ARROW_END_ANGLE)) * sa;
+ ya := y + (-ARROW_END_LENGTH * cos(ARROW_END_ANGLE)) * sa +
+ (ARROW_END_LENGTH * sin(ARROW_END_ANGLE)) * ca;
+
+ Canvas.LineTo(Round(xa), Round(ya));
+
+ xa := x + (-ARROW_END_LENGTH * cos(ARROW_END_ANGLE)) * ca -
+ (-ARROW_END_LENGTH * sin(ARROW_END_ANGLE)) * sa;
+ ya := y + (-ARROW_END_LENGTH * cos(ARROW_END_ANGLE)) * sa +
+ (-ARROW_END_LENGTH * sin(ARROW_END_ANGLE)) * ca;
+
+ Canvas.MoveTo(x, y);
+ Canvas.LineTo(Round(xa), Round(ya));
+ end;
+
+end;
+
+
+procedure Reestimate(lstMoveEsts: TList; viRec: integer);
+var
+ est: SmallInt;
+ id: word;
+begin
+ id := LongWord(lstMoveEsts[viRec]) shr 16;
+ if id = gameID then
+ exit; // позиция дублируется в рамках одной партии
+
+ est := SmallInt(lstMoveEsts[viRec]);
+ case gameResult of
+ grWin: inc(est, 2);
+ grWinTime: inc(est);
+ grDraw: ;
+ grLost: dec(est, 2);
+ grLostTime: dec(est);
+ end;
+ lstMoveEsts[viRec] := Pointer((gameID shl 16) or Word(est));
+end;
+
+
+procedure TPosBaseChessBoardLayer.FSetTrainingMode(bValue: boolean);
+begin
+ if (m_bTrainingMode = bValue) then
+ exit;
+
+ m_bTrainingMode := bValue;
+
+ try
+ if (m_bTrainingMode) then
+ begin
+ if (m_strPosBaseName <> '') then
+ m_PosBase := TPosBase.Create(m_strPosBaseName, Reestimate);
+ if (m_strExtPosBaseName <> '') then
+ m_ExtPosBase := TPosBase.Create(m_strExtPosBaseName);
+ with TPosBaseOperator.CreateRead(self, FALSE) do
+ try
+ WaitFor;
+ finally
+ Free;
+ end;
+ end
+ else
+ begin
+ FreeAndNil(m_PosBase);
+ FreeAndNil(m_ExtPosBase);
+ end;
+
+ RDoUpdate;
+
+ except
+ on Exception do
+ begin
+ FreeAndNil(m_PosBase);
+ FreeAndNil(m_ExtPosBase);
+ m_bTrainingMode := FALSE;
+ end;
+ end;
+
+end;
+
+
+procedure TPosBaseChessBoardLayer.FSetUseUserBase(bValue: boolean);
+begin
+ if (m_bUseUserBase = bValue) then
+ exit;
+ m_bUseUserBase := bValue;
+ TPosBaseOperator.CreateRead(self, FALSE);
+end;
+
+
+procedure TPosBaseChessBoardLayer.ROnAfterMoveDone;
+begin
+ if (m_bTrainingMode) then
+ begin
+ if (Assigned(ChessBoard) and
+ (ChessBoard.PlayerColor = ChessBoard.PositionColor)) then
+ TPosBaseOperator.CreateRead(self) // Read from PosBase and update
+ end;
+end;
+
+
+procedure TPosBaseChessBoardLayer.ROnAfterSetPosition;
+begin
+ if (m_bTrainingMode) then
+ begin
+ with TPosBaseOperator.CreateRead(self, FALSE) do // Read from DB and update
+ try
+ WaitFor;
+ finally
+ Free;
+ end;
+ end;
+end;
+
+
+procedure TPosBaseChessBoardLayer.SetExternalBase(const strExtPosBaseName: string);
+begin
+ if (m_bTrainingMode) then
+ begin
+ if (m_strExtPosBaseName = strExtPosBaseName) then
+ exit;
+ FreeAndNil(m_ExtPosBase);
+ m_ExtPosBase := TPosBase.Create(strExtPosBaseName);
+ TPosBaseOperator.CreateRead(self, FALSE);
+ end;
+
+ m_strExtPosBaseName := strExtPosBaseName;
+end;
+
+
+procedure TPosBaseChessBoardLayer.WriteGameToBase(AGameResult: TGameResult);
+begin
+ if (m_bTrainingMode) then
+ begin
+ gameResult := AGameResult;
+ TPosBaseOperator.CreateWrite(self);
+ end;
+end;
+
+
+procedure TPosBaseChessBoardLayer.UnsetExternalBase;
+begin
+ FreeAndNil(m_ExtPosBase);
+end;
+
+
+procedure TPosBaseChessBoardLayer.ROnAfterModeSet(const OldValue, NewValue: TMode);
+begin
+ if (OldValue = mEdit) then
+ ROnAfterSetPosition; // Read from PosBase
+end;
+
+
+procedure TPosBaseChessBoardLayer.ROnResetMoveList;
+begin
+ if (ChessBoard.Mode = mEdit) then
+ FClearMovePriorList;
+end;
+
+
+procedure TPosBaseChessBoardLayer.FClearMovePriorList;
+var
+ i: integer;
+begin
+ for i := 0 to m_lstMovePrior.Count - 1 do
+ Dispose(m_lstMovePrior[i]);
+ m_lstMovePrior.Clear;
+end;
+
+
+function EstComape(item1, item2: pointer): integer;
+begin
+ Result := SmallInt(PMoveEst(item2).estimate and $FFFF) - SmallInt(PMoveEst(item1).estimate and $FFFF);
+end;
+
+
+procedure TPosBaseChessBoardLayer.FReadFromBase;
+
+ procedure ClasterMoves(var rlstMove: TList);
+ var
+ i, j, num_clast, i_min, j_min, curr_assoc: integer;
+ modus_min: double;
+ clastWeights: array of record
+ grav: double;
+ assoc: integer;
+ end;
+ mp: PMovePrior;
+ p: TPrior;
+ begin
+ if rlstMove.Count = 0 then
+ exit;
+
+ rlstMove.Sort(EstComape);
+ SetLength(clastWeights, rlstMove.Count);
+
+ num_clast := rlstMove.Count;
+ for i := 0 to num_clast - 1 do
+ begin
+ clastWeights[i].assoc := i + 1;
+ clastWeights[i].grav := SmallInt(PMoveEst(rlstMove[i]).estimate and $FFFF);
+ end;
+
+ repeat
+ i_min := 0;
+ j_min := 0;
+ modus_min := $7FFF; // $7FFF - макс. значение для оценки
+ curr_assoc := 0; // текущий просматриваемый кластер
+
+ for i := 0 to length(clastWeights) - 2 do
+ begin
+ if curr_assoc = clastWeights[i].assoc then
+ continue;
+ curr_assoc := clastWeights[i].assoc;
+ for j := i + 1 to length(clastWeights) - 1 do
+ if (clastWeights[j].assoc <> clastWeights[j-1].assoc) and
+ (curr_assoc <> clastWeights[j].assoc) and
+ (abs(clastWeights[i].grav - clastWeights[j].grav) <= modus_min) then
+ begin
+ i_min := i;
+ j_min := j;
+ modus_min := abs(clastWeights[i].grav - clastWeights[j].grav);
+ end;
+ end;
+
+ if (num_clast > Ord(High(TPrior))) or (modus_min = 0.0) then
+ begin
+ for i := High(clastWeights) downto j_min do
+ if clastWeights[i].assoc = clastWeights[j_min].assoc then
+ clastWeights[i].assoc := clastWeights[i_min].assoc;
+ clastWeights[i_min].grav := (clastWeights[i_min].grav + clastWeights[j_min].grav) / 2;
+ end;
+
+ dec(num_clast);
+ until (num_clast <= Ord(High(TPrior))) and ((modus_min <> 0.0) or (num_clast < 1));
+
+ p := mpHigh;
+ for i := 0 to rlstMove.Count - 1 do
+ begin
+ new(mp);
+ if (i > 0) and (clastWeights[i].assoc > clastWeights[i-1].assoc) then
+ p := Succ(p);
+ mp.move := PMoveEst(rlstMove[i]).move;
+ mp.prior := p;
+ Dispose(rlstMove[i]);
+ rlstMove[i] := mp;
+ end;
+
+ SetLength(clastWeights, 0);
+ end;
+
+var
+ lstUsrMove, lstExtMove: TList;
+
+ procedure MergeMoves;
+ function NEqualMoves(i,j: integer): boolean;
+ begin
+ with PMovePrior(lstExtMove[i])^, PMovePrior(m_lstMovePrior[j]).move do
+ Result := (i0 = move.i0) and (j0 = move.j0) and (j = move.j) and (i = move.i) and
+ (prom_fig = move.prom_fig);
+ end;
+
+ var
+ i, j, n: integer;
+ const
+ PRIOR_CALC: array[TPrior, TPrior] of TPrior =
+ ((mpNo, mpNo, mpNo, mpNo), // UsrPrior = mpNo - ?, т.к. ещё нигде не исп.
+ (mpHigh, mpHigh, mpHigh, mpMid), // UsrPrior = mpHigh
+ (mpMid, mpMid, mpMid, mpMid), // UsrPrior = mpMid
+ (mpLow, mpMid, mpLow, mpLow)); // UsrPrior = mpLow
+ begin
+ for i := 0 to lstUsrMove.Count - 1 do
+ m_lstMovePrior.Add(lstUsrMove[i]);
+
+ // Merging of lists
+ n := m_lstMovePrior.Count;
+
+ for i := 0 to lstExtMove.Count - 1 do
+ begin
+ j := n - 1;
+ while (j >= 0) do
+ begin
+ if NEqualMoves(i,j) then
+ begin
+ PMovePrior(m_lstMovePrior[j]).prior :=
+ PRIOR_CALC[PMovePrior(m_lstMovePrior[j]).prior,
+ PMovePrior(lstExtMove[j]).prior];
+ Dispose(lstExtMove[i]);
+ break;
+ end;
+ dec(j);
+ end;
+ if (j < 0) then
+ m_lstMovePrior.Add(lstExtMove[i]);
+ end; // for
+ end;
+
+begin // .FReadFromBase
+ FClearMovePriorList;
+
+ if (not Assigned(Position)) then
+ exit;
+
+ lstExtMove := nil;
+ lstUsrMove := TList.Create;
+ try
+ lstExtMove := TList.Create;
+
+ if (m_bUseUserBase or (not Assigned(m_ExtPosBase))) then
+ begin
+ if (Assigned(m_PosBase)) then
+ m_PosBase.Find(Position^, lstUsrMove);
+ end;
+ if (Assigned(m_ExtPosBase)) then
+ m_ExtPosBase.Find(Position^, lstExtMove);
+
+ // TODO: Handle wrong DB
+
+ ClasterMoves(lstUsrMove);
+ ClasterMoves(lstExtMove);
+
+ MergeMoves;
+
+ finally
+ lstExtMove.Free;
+ lstUsrMove.Free;
+ end;
+
+end;
+
+
+procedure TPosBaseChessBoardLayer.FWriteGameToBase;
+var
+ ply: integer;
+begin
+ if (not (Assigned(m_PosBase) and Assigned(PositionsList))) then
+ exit;
+
+ gameID := Random($FFFF) + 1;
+
+ if (ChessBoard.PlayerColor = RGetColorStarts) then
+ ply := 0
+ else
+ ply := 1;
+
+ while ((ply < PositionsList.Count) and ((MAX_PLY_TO_BASE < 0) or (ply <= MAX_PLY_TO_BASE))) do
+ begin
+ m_PosBase.Add(PPosMove(PositionsList[ply])^);
+ inc(ply, 2);
+ end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////
+// TPosBaseOperator
+
+constructor TPosBaseOperator.FCreateRead(ALayer: TPosBaseChessBoardLayer;
+ vbFreeOnTerminate: boolean = TRUE);
+begin
+ m_Operation := opRead;
+ m_Layer := ALayer;
+
+ inherited Create(TRUE);
+ Priority := tpNormal;
+ FreeOnTerminate := vbFreeOnTerminate;
+ Resume;
+end;
+
+
+constructor TPosBaseOperator.FCreateWrite(ALayer: TPosBaseChessBoardLayer);
+begin
+ m_Layer := ALayer;
+ m_Operation := opWrite;
+
+ inherited Create(TRUE);
+
+ Priority := tpNormal;
+ FreeOnTerminate := TRUE;
+
+ Resume;
+end;
+
+
+class function TPosBaseOperator.CreateRead(ALayer: TPosBaseChessBoardLayer;
+ vbFreeOnTerminate: boolean = TRUE): TPosBaseOperator;
+begin
+ Result := nil;
+
+ if (Assigned(ALayer.ChessBoard) and (ALayer.ChessBoard.Mode <> mEdit)) then
+ Result := TPosBaseOperator.FCreateRead(ALayer, vbFreeOnTerminate);
+end;
+
+
+class function TPosBaseOperator.CreateWrite(ALayer: TPosBaseChessBoardLayer): TPosBaseOperator;
+begin
+ Result := nil;
+
+ if (Assigned(ALayer.ChessBoard) and (ALayer.ChessBoard.Mode <> mEdit)) then
+ Result := TPosBaseOperator.FCreateWrite(ALayer);
+end;
+
+
+procedure TPosBaseOperator.Execute;
+begin
+ case m_Operation of
+ opRead:
+ begin
+ m_Layer.FReadFromBase;
+ Synchronize(m_Layer.RDoUpdate);
+ end;
+ opWrite:
+ m_Layer.FWriteGameToBase;
+ end;
+end;
+
+
+procedure TPosBaseOperator.WaitFor;
+begin
+ if (not Assigned(self)) then
+ exit;
+ inherited WaitFor;
+end;
+
+initialization
+ Randomize;
+
+end.
diff --git a/plugins/Chess4Net/PosBaseUnit.pas b/plugins/Chess4Net/PosBaseUnit.pas index e45ea46b0c..60f6cba6c4 100644 --- a/plugins/Chess4Net/PosBaseUnit.pas +++ b/plugins/Chess4Net/PosBaseUnit.pas @@ -1,9 +1,17 @@ +////////////////////////////////////////////////////////////////////////////////
+// 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 PosBaseUnit;
interface
uses
- ChessBoardHeaderUnit, ChessRulesEngine, ChessBoardUnit, Classes;
+ Classes,
+ //
+ ChessRulesEngine;
type
PMoveEst = ^TMoveEst;
@@ -12,31 +20,42 @@ type estimate: LongWord;
end;
- TFieldNode = packed record
- bField: byte;
- bNextNode: byte; // сл. узел
- wNextNode: word;
- bNextValue: byte; // сл. значение данных
- wNextValue: word;
- end;
+ TReestimate = procedure(moveEsts: TList; nRec: integer);
- TMoveNode = packed record
- wMove: word;
- estimate: LongWord;
- bNextValue: byte; // сл. значение данных
- wNextValue: word;
+ TPosBaseStream = class
+ private
+ m_iRecordSize: integer;
+ m_iHeaderSize: integer;
+ m_InnerStream: TStream;
+ constructor Create(const strFileName: string; RecordSize: integer);
+ function FGetSize: integer;
+ public
+ destructor Destroy; override;
+ procedure SeekHeader;
+ procedure SeekRec(lwRecordNumber: LongWord);
+ procedure SeekEnd;
+ procedure Write(const Buffer); overload;
+ procedure Write(const Buffer; Count: integer); overload;
+ procedure Read(var Buffer); overload;
+ procedure Read(var Buffer; Count: integer); overload;
+ property Size: integer read FGetSize;
+ property HeaderSize: integer read m_iHeaderSize write m_iHeaderSize;
end;
- TReestimate = procedure(moveEsts: TList; nRec: integer);
-
TPosBase = class
private
- fPos: file of TFieldNode;
- fMov: file of TMoveNode;
- Reestimate: TReestimate;
+ m_iDBVersion: Integer;
+ fPos: TPosBaseStream;
+ fMov: TPosBaseStream;
+ FReestimate: TReestimate;
+ procedure FCreateStreams(const strPosFileName, strMovFileName: string);
+ procedure FDestroyStreams;
+ procedure FSetDBVersion;
+ function FCheckDBVersion: Boolean;
public
procedure Add(const posMove: TPosMove); // добавление позиции и хода в базу
- function Find(const pos: TChessPosition; moveEsts: TList = nil): boolean;
+ function Find(const pos: TChessPosition): boolean; overload;
+ function Find(const pos: TChessPosition; var moveEsts: TList): boolean; overload;
constructor Create(fileNameNoExt: string; Reestimate: TReestimate = nil);
destructor Destroy; override;
end;
@@ -47,15 +66,46 @@ uses SysUtils;
type
+ TFieldNode = packed object
+ public
+ btField: byte;
+ private
+ m_btNextNode: byte; // сл. узел
+ m_wNextNode: word;
+ m_btNextValue: byte; // сл. значение данных
+ m_wNextValue: word;
+ function FGetNextNode: LongWord;
+ procedure FSetNextNode(lwValue: LongWord);
+ function FGetNextValue: LongWord;
+ procedure FSetNextValue(lwValue: LongWord);
+ public
+ property NextNode: LongWord read FGetNextNode write FSetNextNode;
+ property NextValue: LongWord read FGetNextValue write FSetNextValue;
+ end;
+
+ TMoveNode = packed object
+ public
+ wMove: word;
+ estimate: LongWord;
+ private
+ m_btNextValue: byte; // сл. значение данных
+ m_wNextValue: word;
+ function FGetNextValuePos: LongWord;
+ procedure FSetNextValuePos(lwValue: LongWord);
+ public
+ procedure EmptyNode;
+ property NextValue: LongWord read FGetNextValuePos write FSetNextValuePos;
+ end;
+
TCoord = record
- i,j: integer;
+ i, j: integer;
end;
const
POS_FILE_EXT = 'pos';
MOV_FILE_EXT = 'mov';
- EMPTY_MOVE_NODE: TMoveNode =
- (wMove: 0; estimate: 0; bNextValue: 0; wNextValue: 0);
+
+ DB_VERSION = 1;
FIELD_SEQ: array[1..64] of TCoord = // 13617 kb
((i: 1; j: 1), (i: 1; j: 2), (i: 1; j: 3), (i: 1; j: 4),
@@ -75,33 +125,77 @@ const (i: 5; j: 1), (i: 5; j: 2), (i: 5; j: 3), (i: 5; j: 4),
(i: 5; j: 5), (i: 5; j: 6), (i: 5; j: 7), (i: 5; j: 8));
+////////////////////////////////////////////////////////////////////////////////
+// TPosBase
+
constructor TPosBase.Create(fileNameNoExt: string; Reestimate: TReestimate = nil);
begin
- AssignFile(fPos, fileNameNoExt + '.' + POS_FILE_EXT);
-{$I-}
- Reset(fPos);
-{$I+}
- if IOResult <> 0 then
- Rewrite(fPos);
-
- AssignFile(fMov, fileNameNoExt + '.' + MOV_FILE_EXT);
-{$I-}
- Reset(fMov);
-{$I+}
- try
- if IOResult <> 0 then
- Rewrite(fMov);
- except
- Close(fPos);
- raise;
- end;
- self.Reestimate := Reestimate;
+ inherited Create;
+
+ self.FReestimate := Reestimate;
+
+ FCreateStreams(fileNameNoExt + '.' + POS_FILE_EXT,
+ fileNameNoExt + '.' + MOV_FILE_EXT);
+ FSetDBVersion;
end;
+
destructor TPosBase.Destroy;
begin
- CloseFile(fPos); // TODO: Here occurs an error if client is closed unforced
- CloseFile(fMov);
+ FDestroyStreams;
+ inherited;
+end;
+
+
+procedure TPosBase.FSetDBVersion;
+var
+ btData: byte;
+ wVersion: word;
+begin
+ m_iDBVersion := DB_VERSION; // default version
+
+ if (fPos.Size > 0) then
+ begin
+ fPos.SeekHeader;
+ fPos.Read(btData, SizeOf(btData));
+ if (btData <> $FF) then
+ begin
+ m_iDBVersion := 0;
+ fPos.HeaderSize := 0;
+ exit;
+ end;
+ fPos.Read(wVersion, SizeOf(wVersion));
+ m_iDBVersion := wVersion;
+ end
+ else
+ begin
+ btData := $FF;
+ wVersion := m_iDBVersion;
+ fPos.Write(btData, SizeOf(btData));
+ fPos.Write(wVersion, SizeOf(wVersion));
+ end;
+
+ fPos.HeaderSize := SizeOf(byte) + SizeOf(word);
+end;
+
+
+function TPosBase.FCheckDBVersion: Boolean;
+begin
+ Result := (m_iDBVersion <= DB_VERSION);
+end;
+
+
+procedure TPosBase.FCreateStreams(const strPosFileName, strMovFileName: string);
+begin
+ fPos := TPosBaseStream.Create(strPosFileName, SizeOf(TFieldNode));
+ fMov := TPosBaseStream.Create(strMovFileName, SizeOf(TMoveNode));
+end;
+
+
+procedure TPosBase.FDestroyStreams;
+begin
+ fMov.Free;
+ fPos.Free;
end;
@@ -139,53 +233,52 @@ var begin
// Добавление узлов позиции
if r >= 0 then
- begin
- nr := FileSize(fPos);
- fn.bNextValue := nr and $FF;
- fn.wNextValue := nr shr 8;
- Seek(fPos, r);
- write(fPos, fn);
- Seek(fPos, nr);
- end
+ begin
+ nr := fPos.Size;
+ fn.NextValue := nr;
+ fPos.SeekRec(r);
+ fPos.Write(fn);
+ fPos.SeekRec(nr);
+ end
else
nr := 0;
for l := k to 66 do // 65 - доп. инф, 66 - цвет.
+ begin
+ if l = 66 then
begin
- if l = 66 then
- begin
- fn.bField := ord(posMove.pos.color);
- nr := FileSize(fMov);
- end
- else
- begin
- if l <= 64 then
- fn.bField := ord(posMove.pos.board[FIELD_SEQ[l].i, FIELD_SEQ[l].j])
- else // l = 65
- fn.bField := addInf;
- inc(nr);
- end;
- fn.bNextNode := nr and $FF;
- fn.wNextNode := nr shr 8;
- fn.bNextValue := 0;
- fn.wNextValue := 0;
- write(fPos, fn);
+ fn.btField := ord(posMove.pos.color);
+ nr := fMov.Size;
+ end
+ else
+ begin
+ if l <= 64 then
+ fn.btField := ord(posMove.pos.board[FIELD_SEQ[l].i, FIELD_SEQ[l].j])
+ else // l = 65
+ fn.btField := addInf;
+ inc(nr);
end;
+ fn.NextNode := nr;
+ fn.NextValue := 0;
+ fPos.Write(fn);
+ end;
// формирование записи хода
- mn := EMPTY_MOVE_NODE;
+ mn.EmptyNode;
mn.wMove := EncodeMove(posMove.move);
- if Assigned(Reestimate) then
+
+ if Assigned(FReestimate) then
begin
estList := TList.Create;
try
estList.Add(Pointer(mn.estimate));
- Reestimate(estList, 0);
+ FReestimate(estList, 0);
mn.estimate := LongWord(estList[0]);
finally
estList.Free;
- end;
+ end;
+
end;
- Seek(fMov, FileSize(fMov));
- write(fMov, mn);
+ fMov.SeekEnd;
+ fMov.Write(mn);
end;
var
@@ -195,34 +288,38 @@ var enc_mv: word;
estList: TList;
begin
+ if (not FCheckDBVersion) then
+ exit;
+
addInf := EncodeAddInf(posMove.pos);
- if FileSize(fPos) = 0 then
- begin
- AddPosNodes(1);
- exit;
- end;
+ if (fPos.Size = 0) then
+ begin
+ AddPosNodes(1);
+ exit;
+ end;
r := 0;
for k := 1 to 66 do // 65 - доп. инф, 66 - цвет.
+ begin
+ fPos.SeekRec(r);
+ fPos.Read(fn);
+
+ while ((k <= 64) and (fn.btField <> ord(posMove.pos.board[FIELD_SEQ[k].i, FIELD_SEQ[k].j]))) or
+ ((k = 65) and (fn.btField <> addInf)) or
+ ((k = 66) and (fn.btField <> ord(posMove.pos.color))) do
begin
- Seek(fPos, r);
- read(fPos, fn);
- while ((k <= 64) and (fn.bField <> ord(posMove.pos.board[FIELD_SEQ[k].i, FIELD_SEQ[k].j]))) or
- ((k = 65) and (fn.bField <> addInf)) or
- ((k = 66) and (fn.bField <> ord(posMove.pos.color))) do
- begin
- pr := r;
- r := (fn.wNextValue shl 8) or fn.bNextValue;
- if r = 0 then
- begin
- AddPosNodes(k, pr);
- exit;
- end;
- Seek(fPos, r);
- read(fPos, fn);
- end; { while }
- // значение в цепочке найдено
- r := (fn.wNextNode shl 8) or fn.bNextNode;
- end;
+ pr := r;
+ r := fn.NextValue;
+ if (r = 0) then
+ begin
+ AddPosNodes(k, pr);
+ exit;
+ end;
+ fPos.SeekRec(r);
+ fPos.Read(fn);
+ end; { while }
+ // значение в цепочке найдено
+ r := fn.NextNode;
+ end;
moveCount := 0;
moveSet := -1;
@@ -232,62 +329,72 @@ begin enc_mv := EncodeMove(posMove.move);
repeat
pr := r;
- Seek(fMov, r);
- read(fMov, mn);
+ fMov.SeekRec(r);
+ fMov.Read(mn);
mv := mn.wMove;
if mv = enc_mv then
moveSet := moveCount;
- if Assigned(Reestimate) then
+ if Assigned(FReestimate) then
estList.Add(Pointer(mn.estimate));
inc(moveCount);
- r := (mn.wNextValue shl 8) or mn.bNextValue;
+ r := mn.NextValue;
until r = 0;
if moveSet < 0 then // хода нет в списке, добавляем
begin
// связывание нового узла с текущим узлом
- r := FileSize(fMov);
- mn.bNextValue := r and $FF;
- mn.wNextValue := r shr 8;
- Seek(fMov, pr);
- write(fMov, mn);
+ r := fMov.Size;
+ mn.NextValue := r;
+ fMov.SeekRec(pr);
+ fMov.Write(mn);
+
// Добавление нового узла ходов
- mn := EMPTY_MOVE_NODE;
+ mn.EmptyNode;
mn.wMove := enc_mv;
- Seek(fMov, r);
- write(fMov, mn);
+ fMov.SeekRec(r);
+ fMov.Write(mn);
- if Assigned(Reestimate) then
+ if Assigned(FReestimate) then
estList.Add(Pointer(mn.estimate));
moveSet := moveCount;
end;
- if Assigned(Reestimate) then
+ if Assigned(FReestimate) then
+ begin
+ FReestimate(estList, moveSet);
+ for k := 0 to estList.Count - 1 do
begin
- Reestimate(estList, moveSet);
- for k := 0 to estList.Count - 1 do
- begin
- Seek(fMov, rm);
- read(fMov, mn);
- if mn.estimate <> LongWord(estList[k]) then
- begin
- mn.estimate := LongWord(estList[k]);
- Seek(fMov, rm);
- write(fMov, mn);
- end;
- rm := (mn.wNextValue shl 8) or mn.bNextValue;
- end;
+ fMov.SeekRec(rm);
+ fMov.Read(mn);
+ if (mn.estimate <> LongWord(estList[k])) then
+ begin
+ mn.estimate := LongWord(estList[k]);
+ fMov.SeekRec(rm);
+ fMov.Write(mn);
+ end;
+ rm := mn.NextValue;
end;
+ end;
+
finally
estList.Free;
end;
end;
-function TPosBase.Find(const pos: TChessPosition; moveEsts: TList = nil): boolean;
+function TPosBase.Find(const pos: TChessPosition): boolean;
+var
+ lstDummy: TList;
+begin
+ lstDummy := nil;
+ Result := Find(pos, lstDummy);
+end;
+
+
+function TPosBase.Find(const pos: TChessPosition; var moveEsts: TList): boolean;
function DecodeMove(enc_move: word): TMoveAbs;
begin
@@ -312,49 +419,185 @@ var pme: PMoveEst;
label
here;
-begin
+begin // TPosBase.Find
Result := FALSE;
- for k := 0 to moveEsts.Count - 1 do
- dispose(moveEsts[k]);
- moveEsts.Clear;
- if FileSize(fPos) = 0 then
+
+ if (not FCheckDBVersion) then
+ exit;
+
+ if (Assigned(moveEsts)) then
+ begin
+ for k := 0 to moveEsts.Count - 1 do
+ Dispose(moveEsts[k]);
+ moveEsts.Clear;
+ end;
+
+ if (fPos.Size = 0) then
exit;
r := 0;
for k := 1 to 66 do // 65 - доп. инф, 66 - цвет.
- begin
+ begin
here:
- Seek(fPos, r);
- read(fPos, fn);
- r := (fn.wNextNode shl 8) or fn.bNextNode;
- while ((k <= 64) and (fn.bField <> ord(pos.board[FIELD_SEQ[k].i, FIELD_SEQ[k].j]))) or
- ((k = 65) and (fn.bField <> EncodeAddInf(pos))) or
- ((k = 66) and (fn.bField <> ord(pos.color))) do
- begin
- r := (fn.wNextValue shl 8) or fn.bNextValue;
- if r = 0 then
- exit
- else
- goto here;
- end; { while }
- end; { for }
+ fPos.SeekRec(r);
+ fPos.Read(fn);
+
+ r := fn.NextNode;
+ while ((k <= 64) and (fn.btField <> ord(pos.board[FIELD_SEQ[k].i, FIELD_SEQ[k].j]))) or
+ ((k = 65) and (fn.btField <> EncodeAddInf(pos))) or
+ ((k = 66) and (fn.btField <> ord(pos.color))) do
+ begin
+ r := fn.NextValue;
+ if r = 0 then
+ exit
+ else
+ goto here;
+ end; { while }
+ end; { for }
Result := TRUE;
- if not Assigned(moveEsts) then
+ if (not Assigned(moveEsts)) then
exit;
- // Заполнение списка ходов
+ // Filling the moves list
repeat
- Seek(fMov, r);
- read(fMov, mn);
+ fMov.SeekRec(r);
+ fMov.Read(mn);
new(pme);
pme^.move := DecodeMove(mn.wMove);
pme^.estimate := mn.estimate;
moveEsts.Add(pme);
- r := (mn.wNextValue shl 8) or mn.bNextValue;
- until r = 0;
+ r := mn.NextValue;
+ until (r = 0);
+
+end;
+
+////////////////////////////////////////////////////////////////////////////////
+// TFieldNode
+
+function TFieldNode.FGetNextNode: LongWord;
+begin
+ Result := (m_wNextNode shl 8) or m_btNextNode;
+end;
+
+
+procedure TFieldNode.FSetNextNode(lwValue: LongWord);
+begin
+ m_btNextNode := lwValue and $FF;
+ m_wNextNode := lwValue shr 8;
+end;
+
+
+function TFieldNode.FGetNextValue: LongWord;
+begin
+ Result := (m_wNextValue shl 8) or m_btNextValue;
+end;
+
+
+procedure TFieldNode.FSetNextValue(lwValue: LongWord);
+begin
+ m_btNextValue := lwValue and $FF;
+ m_wNextValue := lwValue shr 8;
+end;
+
+////////////////////////////////////////////////////////////////////////////////
+// TMoveNode
+
+
+function TMoveNode.FGetNextValuePos: LongWord;
+begin
+ Result := (m_wNextValue shl 8) or m_btNextValue;
+end;
+
+
+procedure TMoveNode.FSetNextValuePos(lwValue: LongWord);
+begin
+ m_btNextValue := lwValue and $FF;
+ m_wNextValue := lwValue shr 8;
+end;
+
+
+procedure TMoveNode.EmptyNode;
+begin
+ FillChar(self, SizeOf(self), 0);
+end;
+
+////////////////////////////////////////////////////////////////////////////////
+// TPosBaseStream
+
+constructor TPosBaseStream.Create(const strFileName: string; RecordSize: integer);
+var
+ FileHandle: Integer;
+begin
+ inherited Create;
+
+ m_iRecordSize := RecordSize;
+
+ if (not FileExists(strFileName)) then
+ begin
+ FileHandle := FileCreate(strFileName);
+ FileClose(FileHandle);
+ end;
+
+ m_InnerStream := TFileStream.Create(strFileName, fmOpenReadWrite,
+ fmShareDenyWrite);
+end;
+
+
+destructor TPosBaseStream.Destroy;
+begin
+ m_InnerStream.Free;
+ inherited;
+end;
+
+
+function TPosBaseStream.FGetSize: integer;
+begin
+ Result := (m_InnerStream.Size - m_iHeaderSize) div m_iRecordSize;
+end;
+
+
+procedure TPosBaseStream.SeekHeader;
+begin
+ m_InnerStream.Seek(0, soFromBeginning);
+end;
+
+
+procedure TPosBaseStream.SeekRec(lwRecordNumber: LongWord);
+begin
+ m_InnerStream.Seek(m_iHeaderSize + lwRecordNumber * m_iRecordSize, soFromBeginning);
+end;
+
+
+procedure TPosBaseStream.SeekEnd;
+begin
+ m_InnerStream.Seek(0, soFromEnd);
+end;
+
+
+procedure TPosBaseStream.Write(const Buffer);
+begin
+ m_InnerStream.WriteBuffer(Buffer, m_iRecordSize);
+end;
+
+
+procedure TPosBaseStream.Write(const Buffer; Count: integer);
+begin
+ m_InnerStream.WriteBuffer(Buffer, Count);
+end;
+
+
+procedure TPosBaseStream.Read(var Buffer);
+begin
+ m_InnerStream.ReadBuffer(Buffer, m_iRecordSize);
+end;
+
+
+procedure TPosBaseStream.Read(var Buffer; Count: integer);
+begin
+ m_InnerStream.ReadBuffer(Buffer, Count);
end;
end.
diff --git a/plugins/Chess4Net/PromotionUnit.pas b/plugins/Chess4Net/PromotionUnit.pas index 91abacbad7..10ed8a9218 100644 --- a/plugins/Chess4Net/PromotionUnit.pas +++ b/plugins/Chess4Net/PromotionUnit.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 PromotionUnit;
interface
uses
- Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls,
// Chess4net
ChessRulesEngine, ChessBoardHeaderUnit, BitmapResUnit;
@@ -39,52 +45,88 @@ const // TPromotionForm
procedure TPromotionForm.FormShow(Sender: TObject);
+
+ procedure NCorrectIfOutOfScreen(var iLeft, iTop: integer);
+ var
+ R: TRect;
+ M: TMonitor;
+ frmOwner: TForm;
+ begin
+ if (Assigned(Owner)) then
+ frmOwner := (Owner as TForm)
+ else
+ frmOwner := nil;
+ if (Assigned(frmOwner)) then
+ begin
+ M := Screen.MonitorFromRect(frmOwner.BoundsRect);
+ R := M.WorkareaRect;
+ end
+ else
+ R := Screen.WorkAreaRect;
+
+ if ((iLeft + self.Width) > R.Right) then
+ iLeft := R.Right - self.Width;
+ if (iLeft < R.Left) then
+ iLeft := R.Left;
+ if ((iTop + self.Height) > R.Bottom) then
+ iTop := R.Bottom - self.Height;
+ if (iTop < R.Top) then
+ iTop := R.Top;
+ end;
+
var
k: byte;
-begin
+ iLeft, iTop: integer;
+begin // TPromotionForm.FormShow
if (m_iSquareSize <> m_BitmapRes.SquareSize) then
FLoadFigures;
// Установить окно в пределах курсора
- Left := Mouse.CursorPos.X - m_iSquareSize div 2;
- Top := Mouse.CursorPos.Y - m_iSquareSize div 2;
- if (Left + Width > Screen.Width) then
- Left := Screen.Width - Width;
+ iLeft := Mouse.CursorPos.X - m_iSquareSize div 2;
+ iTop := Mouse.CursorPos.Y - m_iSquareSize div 2;
+
+ NCorrectIfOutOfScreen(iLeft, iTop);
+
+ Left := iLeft;
+ Top := iTop;
with PromFigImage.Canvas do
- begin
- Brush.Color:= Color;
- FillRect(Rect(0,0, Width, PromFigImage.Height));
-
- Brush.Color:= clWhite;
- for k := 0 to 3 do
- FillRect(Rect((m_iSquareSize + INDENT_SIZE) * k, 0,
- (m_iSquareSize + INDENT_SIZE) * k + m_iSquareSize - 1, m_iSquareSize - 1));
-
- case m_fig_color of
- fcWhite:
- begin
- Draw(0, 0, m_bmFigure[WQ]);
- Draw(m_iSquareSize + 2, 0, m_bmFigure[WR]);
- Draw(2 * (m_iSquareSize + INDENT_SIZE), 0, m_bmFigure[WB]);
- Draw(3 * (m_iSquareSize + INDENT_SIZE), 0, m_bmFigure[WN]);
- end;
- fcBlack:
- begin
- Draw(0, 0, m_bmFigure[BQ]);
- Draw(m_iSquareSize + INDENT_SIZE, 0, m_bmFigure[BR]);
- Draw(2 * (m_iSquareSize + INDENT_SIZE), 0, m_bmFigure[BB]);
- Draw(3 * (m_iSquareSize + INDENT_SIZE), 0, m_bmFigure[BN]);
- end;
- end;
+ begin
+ Brush.Color:= Color;
+ FillRect(Rect(0,0, Width, PromFigImage.Height));
+
+ Brush.Color:= clWhite;
+ for k := 0 to 3 do
+ FillRect(Rect((m_iSquareSize + INDENT_SIZE) * k, 0,
+ (m_iSquareSize + INDENT_SIZE) * k + m_iSquareSize - 1, m_iSquareSize - 1));
+
+ case m_fig_color of
+ fcWhite:
+ begin
+ Draw(0, 0, m_bmFigure[WQ]);
+ Draw(m_iSquareSize + 2, 0, m_bmFigure[WR]);
+ Draw(2 * (m_iSquareSize + INDENT_SIZE), 0, m_bmFigure[WB]);
+ Draw(3 * (m_iSquareSize + INDENT_SIZE), 0, m_bmFigure[WN]);
+ end;
+ fcBlack:
+ begin
+ Draw(0, 0, m_bmFigure[BQ]);
+ Draw(m_iSquareSize + INDENT_SIZE, 0, m_bmFigure[BR]);
+ Draw(2 * (m_iSquareSize + INDENT_SIZE), 0, m_bmFigure[BB]);
+ Draw(3 * (m_iSquareSize + INDENT_SIZE), 0, m_bmFigure[BN]);
+ end;
end;
+ end;
end;
function TPromotionForm.ShowPromotion(color: TFigureColor): TFigureName;
begin
+ m_fig := Q;
m_fig_color := color;
+
ShowModal;
+
Result := m_fig;
end;
@@ -93,12 +135,13 @@ procedure TPromotionForm.PromFigImageMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
case X div (m_BitmapRes.SquareSize + 1) of
- 1: m_fig:= R;
- 2: m_fig:= B;
- 3: m_fig:= N;
- else
- m_fig:= Q;
+ 1: m_fig := R;
+ 2: m_fig := B;
+ 3: m_fig := N;
+ else
+ m_fig := Q;
end;
+
Close;
end;
diff --git a/plugins/Chess4Net/Readme.txt b/plugins/Chess4Net/Readme.txt index 4b20e46fb9..a2270d957d 100644 --- a/plugins/Chess4Net/Readme.txt +++ b/plugins/Chess4Net/Readme.txt @@ -1,13 +1,14 @@ Chess4Net
-(c) 2007-2010 No rights reserved
-E-Mail: packpaul@mail.ru
+(c) 2007-2011 No rights reserved
+E-Mail: packpaul@mail.ru, packpaul1@gmail.com
+Skype: packpaul1
URL: http://chess4net.ru
-==============================
+==============================================
Opening
--------
-Chess4Net is a program for playing chess via Internet. It can be used as standalone application (Socket version for Microsoft Windows or Linux) or as plug-in for such instant messengers as Skype, Miranda, QIP Infium, Trillian Pro and &RQ. Two modes of chess game are supported: standart chess and its random counterpart - PP Random Chess. Chess4Net supports sudden death and incremental time controls as well as possibility to give your opponent a time-handicap. If you want to improve your chess skills there is also a support for a training mode. You can also invite other contacts to watch the games you're playing in real-time.
+Chess4Net is a program for playing chess via Internet. It can be used as a standalone application (Socket version for Microsoft Windows or Linux) or as plug-in for such instant messengers as Skype, Miranda, QIP Infium, Trillian Pro and &RQ. Two modes of chess game are supported: standart chess and its random counterpart - PP Random Chess. Chess4Net supports sudden death and incremental time controls as well as possibility to give your opponent a time-handicap. If you want to improve your chess skills there is also a support for a training mode. You can also invite other contacts to watch the games you're playing in real-time.
Middle game
------------
@@ -18,7 +19,11 @@ Socket version: Extract the archive to desired folder on your computer.
Skype plug-in:
- There're two options. You can either install from installation package or download an archive and extract it to a desired folder on your computer.
+ * Windows:
+ There're two options. You can either install from installation package or download an archive and extract it to a desired folder on your computer (Windows version).
+
+ * Linux:
+ Extract downloaded archive to a folder. If you're root then make the user to have full access to the installation folder.
Miranda plug-in:
Extract archive to the Miranda Plugins directory and re/start Miranda.
@@ -43,9 +48,17 @@ Socket version: 4) Click OK and wait until the connection is completed.
Skype:
+ * Windows:
1) Run Chess4Net_Skype.exe. If you don't have Skype running it will start automatically. Click 'Allow access' when dialog 'Chess4Net_Skype.exe wants to use Skype' pops-up.
2) When a window with Skype contacts appears choose a contact you want to play chess with.
3) Wait until connection is completed.
+
+ * Linux
+ 1) You should have Skype running and be logged in to it.
+ 2) In terminal go to the installation folder for example:
+ cd ~/Chess4Net_Skype
+ 3) Run Chess4Net:
+ ./Chess4Net_Skype
Miranda:
1) Right-click the contact you want to play chess with and select 'Chess4Net' from contact pop-up menu.
@@ -76,10 +89,15 @@ User DB can learn from your games in order to give you best choices. You can als Game transmitting mode:
-While you're playing some games you can invite other contacts to gollow up these games in real-time. Therefore you must
-start a new session of Chess4Net for a contact you want the game(s) be transmitted to. A mode selection dialog appears
-asking if game broadcasting has to be started. You must select 'Yes' (if you select 'No' an ordinary game session is created). After that you should select a game for transmition (only if there're several games in progress). After your contact
-connects he/she'll be able to watch the game.
+While you're playing some games you can invite other contacts to follow up these games in real-time. Therefore you must
+
+Miranda:
+ start a new session of Chess4Net for a contact you want the game(s) be transmitted to. A mode selection dialog appears asking if game broadcasting has to be started. You must select 'Yes' (if you select 'No' an ordinary game session is created). After that you should select a game for transmition (only if there're several games in progress).
+
+Skype:
+ select Broadcast... from pop-up menu. A list of contacts appears. Select a contact whom you want to transmit the game played to.
+
+After your contact connects he/she'll be able to watch the game.
Endgame
@@ -113,6 +131,15 @@ PP Change log
-----------
+Chess4Net 2011.1 (Skype)
+[2011-08-06] Localization for German, French, Italian and Estonian
+[2011-08-01] Game resurection after application failure improved
+[2011-07-24] Keeping Skype connection alive feature
+[2011-05-23] Game transmition feature
+[2011-05-30] Incorrect chess clock timing on different locales fix
+[2011-06-01] Stay on top enabled
+
+
Chess4Net 2010.0 (MI)
[2010-05-28] Game retransmition feature added. Dialog handling improved (stay on top, out of screen etc). Majority of crashes fixed. Games numbering if several ones are played.
@@ -120,6 +147,7 @@ Chess4Net 2010.0 (MI) Chess4Net 2010.1 (Skype)
[2010-02-07] Released with Credits reminder.
[2010-03-06] Skype accept help image added.
+[2010-11-13] Linux version released
Chess4net 2009.1 (MI)
diff --git a/plugins/Chess4Net/Readme_RU.txt b/plugins/Chess4Net/Readme_RU.txt Binary files differindex d1430112a1..cd9cf6b5d0 100644 --- a/plugins/Chess4Net/Readme_RU.txt +++ b/plugins/Chess4Net/Readme_RU.txt diff --git a/plugins/Chess4Net/TODO.txt b/plugins/Chess4Net/TODO.txt index eb75fe01c2..b41ea802b9 100644 --- a/plugins/Chess4Net/TODO.txt +++ b/plugins/Chess4Net/TODO.txt @@ -6,6 +6,24 @@ ~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Chess4Net Skype 2011.2
+
+- Редизайн GUI
+- Позиционирование и размер доски
+- Гостевой список
+- Индикатор "чей ход"
+
+Chess4Net Skype 2011.1
+
+- Ретрансляция партий: смена цвета при просмотре партий
+- Версионность/статистика
+- -> Skype API support
+- Поверх всех окон
+
+Chess4Net 2011.1
+
+- Свои методы декодирования времени
+
Chess4Net 2009.1
- AV при выходе из Миранды при не закрытом Ch4N
diff --git a/plugins/Chess4Net/URLVersionQueryUnit.dfm b/plugins/Chess4Net/URLVersionQueryUnit.dfm new file mode 100644 index 0000000000..3fc902a9e3 --- /dev/null +++ b/plugins/Chess4Net/URLVersionQueryUnit.dfm @@ -0,0 +1,7 @@ +object URLVersionQuery: TURLVersionQuery
+ OldCreateOrder = False
+ Left = 562
+ Top = 338
+ Height = 102
+ Width = 215
+end
diff --git a/plugins/Chess4Net/URLVersionQueryUnit.pas b/plugins/Chess4Net/URLVersionQueryUnit.pas new file mode 100644 index 0000000000..24c73a1a94 --- /dev/null +++ b/plugins/Chess4Net/URLVersionQueryUnit.pas @@ -0,0 +1,185 @@ +////////////////////////////////////////////////////////////////////////////////
+// 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 URLVersionQueryUnit;
+
+interface
+
+uses
+ Classes;
+
+type
+ TApplicationID = (aidAnalyzer = 1, aidSkype = 2);
+ TOperatingSystemID = (osidWindows = 1, osidLinux = 2);
+
+ TURLVersionQuery = class;
+
+ TQueryReadyEvent = procedure(Sender: TURLVersionQuery) of object;
+
+ TURLVersionQuery = class(TDataModule)
+ private
+ m_iLastVersion: integer;
+ m_wstrInfo: WideString;
+ FQueryReadyEvent: TQueryReadyEvent;
+ procedure FDoQueryReady;
+ function FQuery(const strURL: string): string;
+ function FGetURL(ApplicationID: TApplicationID; iVersion: integer;
+ OperatingSystemID: TOperatingSystemID): string;
+ procedure FParseResponse(const strResponse: string);
+ public
+ constructor Create; reintroduce;
+ procedure Query(ApplicationID: TApplicationID; iVersion: integer;
+ OperatingSystemID: TOperatingSystemID);
+ property LastVersion: integer read m_iLastVersion;
+ property Info: WideString read m_wstrInfo;
+ property OnQueryReady: TQueryReadyEvent read FQueryReadyEvent write FQueryReadyEvent;
+ end;
+
+implementation
+
+{$R *.dfm}
+
+uses
+ Forms, SysUtils, StrUtils,
+ //
+ XIE;
+
+type
+ TQueryThread = class(TThread)
+ private
+ m_URLVersionQuery: TURLVersionQuery;
+ m_strURL: string;
+ m_strResponse: string;
+ procedure FNotifyOnResponse;
+ protected
+ procedure Execute; override;
+ public
+ constructor Create(AURLVersionQuery: TURLVersionQuery; const strURL: string);
+ end;
+
+////////////////////////////////////////////////////////////////////////////////
+// TURLVersionQuery
+
+constructor TURLVersionQuery.Create;
+begin
+ inherited Create(Application);
+end;
+
+procedure TURLVersionQuery.FDoQueryReady;
+begin
+ if (Assigned(FQueryReadyEvent)) then
+ FQueryReadyEvent(self);
+end;
+
+
+procedure TURLVersionQuery.Query(ApplicationID: TApplicationID; iVersion: integer;
+ OperatingSystemID: TOperatingSystemID);
+begin
+ TQueryThread.Create(self, FGetURL(ApplicationID, iVersion, OperatingSystemID));
+end;
+
+
+function TURLVersionQuery.FQuery(const strURL: string): string;
+begin
+ with TIEWrapper.Create do
+ try
+ Result := OpenRequest(strURL);
+ finally
+ Free;
+ end;
+end;
+
+
+function TURLVersionQuery.FGetURL(ApplicationID: TApplicationID; iVersion: integer;
+ OperatingSystemID: TOperatingSystemID): string;
+begin
+ Result := Format('http://chess4net.ru/stat.php?app=%d&ver=%d&os=%d',
+ [Ord(ApplicationID), iVersion, Ord(OperatingSystemID)]);
+end;
+
+
+procedure TURLVersionQuery.FParseResponse(const strResponse: string);
+
+ procedure NSplit(const str: string; out strlList: TStringList);
+ var
+ iPosPrev, iPosNext: integer;
+ strSub: string;
+ begin
+ strlList := TStringList.Create;
+
+ strSub := '';
+ iPosPrev := 1;
+
+ while (iPosPrev <= Length(str)) do
+ begin
+ iPosNext := iPosPrev;
+
+ iPosNext := PosEx(';', str, iPosNext);
+
+ if (iPosNext = 0) then
+ iPosNext := MaxInt - 1;
+
+ strSub := strSub + Copy(str, iPosPrev, iPosNext - iPosPrev);
+ if ((iPosNext < Length(str)) and (str[iPosNext + 1] = ';')) then
+ begin
+ strSub := strSub + ';';
+ iPosPrev := iPosNext + 2;
+ continue;
+ end;
+
+ strlList.Append(strSub);
+ strSub := '';
+
+ iPosPrev := iPosNext + 1;
+ end;
+
+ end;
+
+var
+ strl: TStringList;
+begin // .FParseResponse
+ NSplit(strResponse, strl);
+ try
+ m_iLastVersion := StrToIntDef(strl.Values['Last version'], 0);
+ m_wstrInfo := strl.Values['Info'];
+ finally
+ strl.Free;
+ end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////
+// TQueryThread
+
+constructor TQueryThread.Create(AURLVersionQuery: TURLVersionQuery; const strURL: string);
+begin
+ m_URLVersionQuery := AURLVersionQuery;
+ m_strURL := strURL;
+
+ inherited Create(TRUE);
+ FreeOnTerminate := TRUE;
+
+ Resume;
+end;
+
+
+procedure TQueryThread.Execute;
+begin
+{$IFNDEF TESTING}
+ m_strResponse := m_URLVersionQuery.FQuery(m_strURL);
+{$ELSE}
+ m_strResponse := 'Last version=201102;Info=Version 2011.2 is available'#10'TEST> You can download it from http://chess4net.ru <TEST';
+{$ENDIF}
+ Synchronize(FNotifyOnResponse);
+end;
+
+
+procedure TQueryThread.FNotifyOnResponse;
+begin
+ m_URLVersionQuery.FParseResponse(m_strResponse);
+ m_URLVersionQuery.FDoQueryReady;
+end;
+
+end.
diff --git a/plugins/Chess4Net/lib/XIE/XIE.pas b/plugins/Chess4Net/lib/XIE/XIE.pas new file mode 100644 index 0000000000..bd2498e738 --- /dev/null +++ b/plugins/Chess4Net/lib/XIE/XIE.pas @@ -0,0 +1,333 @@ +{ =============================================================================
+
+ UnitName : XIe
+ Ver : 1.1
+ Create Date : 09.07.2007
+ Last Edit : 19.01.2011 by Pavel Perminov
+ Author : Dmitry Mirovodin
+ http://www.hcsoft.spb.ru
+ mirovodin@mail.ru
+ support@hcsoft.spb.ru
+
+ ========================================================================== }
+
+unit XIE;
+
+interface
+
+uses
+ Windows, ActiveX, URLMon;
+
+type
+
+ TIEWrapperOnProcess = Procedure (const ProgressProcent: Byte; const StatusID : Cardinal; Const StatusText : String ) of object;
+
+
+ TBindStatusCallBack = Class(TObject, IUnknown, IBindStatusCallback)
+ private
+ fOnProcess : TIEWrapperOnProcess;
+ function QueryInterface(const IID: TGUID; out Obj): HRESULT; stdcall;
+ function _AddRef: Integer; stdcall;
+ function _Release: Integer; stdcall;
+ protected
+ function OnStartBinding(dwReserved: DWORD; pib: IBinding): HResult; stdcall;
+ function GetPriority(out nPriority): HResult; stdcall;
+ function OnLowResource(reserved: DWORD): HResult; stdcall;
+ function OnProgress(ulProgress, ulProgressMax, ulStatusCode: ULONG; szStatusText: LPCWSTR): HResult; stdcall;
+ function OnStopBinding(hresult: HResult; szError: LPCWSTR): HResult; stdcall;
+ function GetBindInfo(out grfBINDF: DWORD; var bindinfo: TBindInfo): HResult; virtual; stdcall;
+ function OnDataAvailable(grfBSCF: DWORD; dwSize: DWORD; formatetc: PFormatEtc; stgmed: PStgMedium): HResult; stdcall;
+ function OnObjectAvailable(const iid: TGUID; punk: IUnknown): HResult; stdcall;
+ public
+ constructor Create();
+ Property OnProcess : TIEWrapperOnProcess Read fOnProcess Write fOnProcess;
+ Class function ProcessStatusIdToString(Const StatusId: Cardinal):String;
+ end;
+
+ TIEWrapper = Class (TObject)
+ protected
+ fBindStatusCallback : TBindStatusCallback;
+ function GetOnProcess : TIEWrapperOnProcess;
+ procedure SetOnProcess( Value : TIEWrapperOnProcess);
+ function CheckRequest(const Request : String): boolean; Virtual;
+ public
+ constructor Create(); virtual;
+ destructor Destroy(); override;
+ function OpenRequest(const Request : String):String;
+ function LoadFile(const Request : String; const FileName: String): boolean;
+ property OnProcess : TIEWrapperOnProcess Read GetOnProcess Write SetOnProcess;
+ end;
+
+
+implementation
+
+uses
+ SysUtils;
+
+{
+const
+ BINDF_ASYNCHRONOUS = $00000001;
+ BINDF_ASYNCSTORAGE = $00000002;
+ BINDF_NOPROGRESSIVERENDERING = $00000004;
+ BINDF_OFFLINEOPERATION = $00000008;
+ BINDF_GETNEWESTVERSION = $00000010;
+ BINDF_NOWRITECACHE = $00000020;
+ BINDF_NEEDFILE = $00000040;
+ BINDF_PULLDATA = $00000080;
+ BINDF_IGNORESECURITYPROBLEM = $00000100;
+ BINDF_RESYNCHRONIZE = $00000200;
+ BINDF_HYPERLINK = $00000400;
+ BINDF_NO_UI = $00000800;
+ BINDF_SILENTOPERATION = $00001000;
+ BINDF_PRAGMA_NO_CACHE = $00002000;
+ BINDF_GETCLASSOBJECT = $00004000;
+ BINDF_RESERVED_1 = $00008000;
+ BINDF_FREE_THREADED = $00010000;
+ BINDF_DIRECT_READ = $00020000;
+ BINDF_FORMS_SUBMIT = $00040000;
+ BINDF_GETFROMCACHE_IF_NET_FAIL= $00080000;
+ BINDF_FROMURLMON = $00100000;
+ BINDF_FWD_BACK = $00200000;
+ BINDF_PREFERDEFAULTHANDLER = $00400000;
+ BINDF_RESERVED_3 = $00800000;
+}
+
+// ========================================================================== //
+
+constructor TBindStatusCallback.Create();
+begin
+ inherited Create;
+end;
+
+// -----------------------------------------------------------------------------
+
+function TBindStatusCallback.QueryInterface(const IID: TGUID; out Obj): HResult;
+begin
+ if GetInterface(IID, Obj) then Result := S_OK
+ else Result := E_NOINTERFACE;
+end;
+
+// -----------------------------------------------------------------------------
+
+function TBindStatusCallback._AddRef: Integer;
+begin
+ Result := -1;
+end;
+
+// -----------------------------------------------------------------------------
+
+function TBindStatusCallback._Release: Integer;
+begin
+ Result := -1;
+end;
+
+// -----------------------------------------------------------------------------
+
+Class function TBindStatusCallback.ProcessStatusIdToString(Const StatusId: Cardinal):String;
+begin
+ case StatusId of
+ BINDSTATUS_FINDINGRESOURCE : result := 'BINDSTATUS_FINDINGRESOURCE';
+ BINDSTATUS_CONNECTING : Result := 'BINDSTATUS_CONNECTING';
+ BINDSTATUS_REDIRECTING : Result := 'BINDSTATUS_REDIRECTING';
+ BINDSTATUS_BEGINDOWNLOADDATA : Result := 'BINDSTATUS_BEGINDOWNLOADDATA';
+ BINDSTATUS_DOWNLOADINGDATA : Result := 'BINDSTATUS_DOWNLOADINGDATA';
+ BINDSTATUS_ENDDOWNLOADDATA : Result := 'BINDSTATUS_ENDDOWNLOADDATA';
+ BINDSTATUS_BEGINDOWNLOADCOMPONENTS : Result := 'BINDSTATUS_BEGINDOWNLOADCOMPONENTS';
+ BINDSTATUS_INSTALLINGCOMPONENTS : Result := 'BINDSTATUS_INSTALLINGCOMPONENTS';
+ BINDSTATUS_ENDDOWNLOADCOMPONENTS : Result := 'BINDSTATUS_ENDDOWNLOADCOMPONENTS';
+ BINDSTATUS_USINGCACHEDCOPY : Result := 'BINDSTATUS_USINGCACHEDCOPY';
+ BINDSTATUS_SENDINGREQUEST : Result := 'BINDSTATUS_SENDINGREQUEST';
+ BINDSTATUS_CLASSIDAVAILABLE : Result := 'BINDSTATUS_CLASSIDAVAILABLE';
+ BINDSTATUS_MIMETYPEAVAILABLE : Result := 'BINDSTATUS_MIMETYPEAVAILABLE';
+ BINDSTATUS_CACHEFILENAMEAVAILABLE : Result := 'BINDSTATUS_CACHEFILENAMEAVAILABLE';
+ BINDSTATUS_BEGINSYNCOPERATION : Result := 'BINDSTATUS_BEGINSYNCOPERATION';
+ BINDSTATUS_ENDSYNCOPERATION : Result := 'BINDSTATUS_ENDSYNCOPERATION';
+ BINDSTATUS_BEGINUPLOADDATA : Result := 'BINDSTATUS_BEGINUPLOADDATA';
+ BINDSTATUS_UPLOADINGDATA : Result:= 'BINDSTATUS_UPLOADINGDATA';
+ BINDSTATUS_ENDUPLOADDATA : Result:= 'BINDSTATUS_ENDUPLOADDATA';
+ BINDSTATUS_PROTOCOLCLASSID : Result := 'BINDSTATUS_PROTOCOLCLASSID';
+ BINDSTATUS_ENCODING : Result:= 'BINDSTATUS_ENCODING';
+ BINDSTATUS_VERIFIEDMIMETYPEAVAILABLE : Result := 'BINDSTATUS_VERIFIEDMIMETYPEAVAILABLE';
+ BINDSTATUS_CLASSINSTALLLOCATION : Result := 'BINDSTATUS_CLASSINSTALLLOCATION';
+ BINDSTATUS_DECODING : Result := 'BINDSTATUS_DECODING';
+ BINDSTATUS_LOADINGMIMEHANDLER : Result := 'BINDSTATUS_LOADINGMIMEHANDLER';
+ BINDSTATUS_CONTENTDISPOSITIONATTACH : Result := 'BINDSTATUS_CONTENTDISPOSITIONATTACH';
+ BINDSTATUS_FILTERREPORTMIMETYPE : Result := 'BINDSTATUS_FILTERREPORTMIMETYPE';
+ BINDSTATUS_CLSIDCANINSTANTIATE : Result := 'BINDSTATUS_CLSIDCANINSTANTIATE';
+ BINDSTATUS_IUNKNOWNAVAILABLE : Result := 'BINDSTATUS_IUNKNOWNAVAILABLE';
+ BINDSTATUS_DIRECTBIND : Result := 'BINDSTATUS_DIRECTBIND';
+ BINDSTATUS_RAWMIMETYPE : Result := 'BINDSTATUS_RAWMIMETYPE';
+ BINDSTATUS_PROXYDETECTING : Result := 'BINDSTATUS_PROXYDETECTING';
+ BINDSTATUS_ACCEPTRANGES : Result := 'BINDSTATUS_ACCEPTRANGES';
+ BINDSTATUS_COOKIE_SENT : Result := 'BINDSTATUS_COOKIE_SENT';
+ BINDSTATUS_COMPACT_POLICY_RECEIVED : Result := 'BINDSTATUS_COMPACT_POLICY_RECEIVED';
+ BINDSTATUS_COOKIE_SUPPRESSED : Result := 'BINDSTATUS_COOKIE_SUPPRESSED';
+ BINDSTATUS_COOKIE_STATE_UNKNOWN : Result := 'BINDSTATUS_COOKIE_STATE_UNKNOWN';
+ BINDSTATUS_COOKIE_STATE_ACCEPT : Result := 'BINDSTATUS_COOKIE_STATE_ACCEPT';
+ BINDSTATUS_COOKIE_STATE_REJECT : Result := 'BINDSTATUS_COOKIE_STATE_REJECT';
+ BINDSTATUS_COOKIE_STATE_PROMPT : Result := 'BINDSTATUS_COOKIE_STATE_PROMPT';
+ BINDSTATUS_COOKIE_STATE_LEASH : Result := 'BINDSTATUS_COOKIE_STATE_LEASH';
+ BINDSTATUS_COOKIE_STATE_DOWNGRADE : Result := 'BINDSTATUS_COOKIE_STATE_DOWNGRADE';
+ BINDSTATUS_POLICY_HREF : Result := 'BINDSTATUS_POLICY_HREF';
+ BINDSTATUS_P3P_HEADER : Result := 'BINDSTATUS_P3P_HEADER';
+ BINDSTATUS_SESSION_COOKIE_RECEIVED : Result := 'BINDSTATUS_SESSION_COOKIE_RECEIVED';
+ BINDSTATUS_PERSISTENT_COOKIE_RECEIVED : Result := 'BINDSTATUS_PERSISTENT_COOKIE_RECEIVED';
+ BINDSTATUS_SESSION_COOKIES_ALLOWED : Result := 'BINDSTATUS_SESSION_COOKIES_ALLOWED';
+ else
+ Result := 'N/A Code : ' + IntToStr(StatusId);
+ end;
+end;
+
+// -----------------------------------------------------------------------------
+
+function TBindStatusCallback.OnStartBinding(dwReserved: DWORD; pib: IBinding): HResult;
+begin
+ Result := E_NOTIMPL;
+end;
+
+// -----------------------------------------------------------------------------
+
+function TBindStatusCallback.GetPriority(out nPriority): HResult;
+begin
+ Result := E_NOTIMPL;
+end;
+
+// -----------------------------------------------------------------------------
+
+function TBindStatusCallback.OnLowResource(reserved: DWORD): HResult;
+begin
+ Result := E_NOTIMPL;
+end;
+
+// -----------------------------------------------------------------------------
+
+function TBindStatusCallback.OnProgress(ulProgress, ulProgressMax, ulStatusCode: ULONG; szStatusText: LPCWSTR): HResult;
+var
+ Proc : Byte;
+begin
+ if Assigned(fOnProcess) then
+ begin
+ if ulStatusCode = BINDSTATUS_ENDDOWNLOADDATA then Proc := 100 else
+ if ulProgressMax = 0 then Proc := 0 else
+ Proc := Trunc( ulProgress * 100 / ulProgressMax);
+
+ fOnProcess(Proc, ulStatusCode, szStatusText);
+ end;
+ Result := E_NOTIMPL;
+end;
+
+// -----------------------------------------------------------------------------
+
+function TBindStatusCallback.OnStopBinding(hresult: HResult; szError: LPCWSTR): HResult;
+begin
+ Result := E_NOTIMPL;
+end;
+
+// -----------------------------------------------------------------------------
+
+function TBindStatusCallback.GetBindInfo(out grfBINDF: DWORD; var bindinfo: TBindInfo): HResult;
+begin
+ Result := E_NOTIMPL;
+// grfBINDF := BINDF_GETNEWESTVERSION;
+// Result :=BINDF_GETNEWESTVERSION;
+end;
+
+// -----------------------------------------------------------------------------
+
+function TBindStatusCallback.OnDataAvailable(grfBSCF: DWORD; dwSize: DWORD; formatetc: PFormatEtc; stgmed: PStgMedium): HResult;
+begin
+ Result := E_NOTIMPL;
+end;
+
+// -----------------------------------------------------------------------------
+
+function TBindStatusCallback.OnObjectAvailable(const iid: TGUID; punk: IUnknown): HResult;
+begin
+ Result := E_NOTIMPL;
+end;
+
+// ========================================================================== //
+
+Constructor TIEWrapper.Create;
+begin
+ fBindStatusCallback := TBindStatusCallback.Create;
+end;
+
+// -----------------------------------------------------------------------------
+
+function TIEWrapper.GetOnProcess : TIEWrapperOnProcess;
+begin
+ Result:=fBindStatusCallback.OnProcess;
+end;
+
+// -----------------------------------------------------------------------------
+
+procedure TIEWrapper.SetOnProcess( Value : TIEWrapperOnProcess);
+begin
+ fBindStatusCallback.OnProcess := Value;
+end;
+
+// -----------------------------------------------------------------------------
+
+function TIEWrapper.CheckRequest(const Request : String): boolean;
+begin
+ result := False;
+ if Length(Request)>0 then Result := True;
+end;
+
+// -----------------------------------------------------------------------------
+
+function TIEWrapper.OpenRequest(const Request : string):String;
+Var
+ Stream : IStream;
+ StreamInfo : STATSTG;
+ BuffSize : Integer;
+ P : Pointer;
+begin
+ Result := '';
+ if not CheckRequest(Request) then Exit;
+ Stream := nil;
+ if URLOpenBlockingStream(nil, PChar(Request), Stream, 0, fBindStatusCallback) = S_OK then
+ Begin
+ ZeroMemory(@StreamInfo, SizeOf(StreamInfo));
+ If Stream.Stat(StreamInfo, 0) = S_OK Then
+ Begin
+ If StreamInfo.cbSize > 0 Then
+ Begin
+ BuffSize := StreamInfo.cbSize;
+ GetMem(P, BuffSize);
+ try
+ ZeroMemory(P, SizeOf(BuffSize));
+ Stream.Read(P, buffsize, Nil);
+ Result := PCHAR(P);
+ finally
+ FreeMem(P);
+ end;
+ End;
+ End;
+ Stream := nil;
+ End;
+end;
+
+// -----------------------------------------------------------------------------
+
+function TIEWrapper.LoadFile(const Request : String; const FileName: String): boolean;
+begin
+ Result := false;
+ if not CheckRequest(Request) then Exit;
+ if URLDownloadToFile(nil, PChar(Request), PCHAR(FileName), 0, fBindStatusCallback) = S_OK then
+ Result := True;
+end;
+
+// -----------------------------------------------------------------------------
+
+destructor TIEWrapper.Destroy();
+begin
+ fBindStatusCallback.Free;
+ fBindStatusCallback := nil;
+ inherited Destroy;
+end;
+
+// ========================================================================== //
+
+end.
|