unit VisualBoard;   //30102022

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Menus;

type
  TFormBoard = class(TForm)
    ChessBoard: TImage;//изображение шахматной доски
    Desk: TImage;//изображение клеток шахматного поля
    Piece: TImage;//изображение всех фигур
    SelectBox: TImage;//изображение рамки выбора
    PieceMirror: TImage;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N20: TMenuItem;
    N12: TMenuItem;
    N22: TMenuItem;
    N32: TMenuItem;
    N42: TMenuItem;
    N52: TMenuItem;
    N62: TMenuItem;
    FEN1: TMenuItem;
    procedure FEN1Click(Sender: TObject);
    procedure NClick(Sender: TObject);
    procedure ChessBoardClick(Sender: TObject);
    procedure ChessBoardMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);//перевернутое изображение фигур
    procedure FormCreate(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;
var
  Board: TFormBoard;
  //дата
  ProgrammDate:String = '09.11.2022';
  //измерение времени
  Start, Stop: cardinal;
  Elapsed: cardinal;
  t1,t2,t:UInt64;
  // начальная позиция
  WPieceStart: array [0..5]  of  UInt64 = (1152921504606846976,576460752303423488,9295429630892703744,2594073385365405696,4755801206503243776,71776119061217280);
  BPieceStart: array [0..5]  of  UInt64 = (16,8,129,36,66,65280);
  AllPiece:UInt64 = 0;
  PosStart: String='rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR';
  //PosStart: String='2N1N3/K7/6B1/4kPb1/b2p4/6P1/5P2/7Q';
  //размеры игрового поля доски
  DescHeight:Integer=480;
  DescWidth:Integer=480;
  //смещение игрового поля доски от начала координат
  dX:Integer=24;
  dY:Integer=20;
  //размер клетки игрового поля
  cell:Integer=60;
  Xmouse,Ymouse,NumPos:Integer;
implementation

uses fun, MaskBit;

{$R *.dfm}
procedure ClearDesk ();
var
bmp: tbitmap;
begin
try
 bmp := tbitmap.Create;
 bmp.Height:=DescHeight;
 bmp.Width:=DescWidth;
 bmp.Canvas.CopyRect(rect(0,0,bmp.Width,bmp.Height),Board.Desk.Canvas,rect(0,0,DescWidth,DescHeight));
 Board.ChessBoard.Canvas.CopyMode:=cmSrcCopy;
 Board.ChessBoard.Canvas.Draw(dX, dY, bmp);
finally
 bmp.free;
end;
end;
procedure DrawPiece(Pos,NumP,ColorP: Integer);
var
bmp: tbitmap;
a,b: Integer;
begin
try
 bmp := tbitmap.Create;
 bmp.Height:=cell;
 bmp.Width:=cell;
a:=Pos and 7;
b:=Pos shr 3;
bmp.Canvas.CopyRect(rect(0,0,bmp.Width,bmp.Height),Board.Piece.Canvas,rect(cell*NumP,cell*ColorP,cell*NumP+cell,cell*ColorP+cell));
bmp.TransparentColor:=clYellow;
bmp.Transparent:=true;
Board.ChessBoard.Canvas.Draw(dX+cell*a, dY+cell*b, bmp);
finally
 bmp.free;
end;
end; 

 procedure DrawPieceBoard(APiece:array of  UInt64;ColorPiece: Integer);
var
NumPiece: Integer;
i,j: Integer;
begin
NumPiece:=0;
                          while NumPiece<6 do begin
                                  for i:=63 downto 0 do  begin
                                  j := (APiece[NumPiece] shr i) and 1;
                                       case j  of
                                                 1:begin
                                                   DrawPiece(i,NumPiece,ColorPiece);
                                                  end;
                                       end;
                                   end;
                            NumPiece:=NumPiece+1;
                            end;

end;

 procedure DrawMoveBox(u:UInt64);
var
bmp: tbitmap;
a,b,i,j: Integer;
begin
try
 j:=0;
 bmp := tbitmap.Create;
 bmp.Height:=cell;
 bmp.Width:=cell;
bmp.TransparentColor:=clWhite;
bmp.Transparent:=true;
bmp.Canvas.CopyRect(rect(0,0,bmp.Width,bmp.Height),Board.Piece.Canvas,rect(cell*6,0,cell*7,cell));
                                  for i:=63 downto 0 do  begin
                                  j := (u shr i) and 1;
                                       case j  of
                                                 1:begin
                                                  a:=i and 7;
                                                  b:=i shr 3;
                                                  Board.Canvas.Draw(dX+cell*a, dY+cell*b, bmp);
                                                  end;
                                       end;
                                   end;
finally
  bmp.free;
end;
end;

procedure lightPiece (Pos: Integer);
var
a,b: Integer;
begin
 a:=Pos and 7;
 b:=Pos shr 3;
 Board.SelectBox.Top:=dY+cell*b;
 Board.SelectBox.Left:=dX+cell*a;
 Board.SelectBox.Transparent:=true;
 Board.SelectBox.Visible:=true;
end;

 procedure View();
begin
 Board.SelectBox.Visible:=false;
 ClearDesk ();
 DrawPieceBoard(WPieceStart,0);
 DrawPieceBoard(BPieceStart,1);
end;
 function SelectPiece(): integer;
var
i: Integer;
begin
   result:=-1;
   if (AllPiece and fun.MaskOneBit[NumPos])>0 then  begin
     for i := 4 downto 0 do  begin
         if ((WPieceStart[i] or BPieceStart[i]) and fun.MaskOneBit[NumPos])>0 then  begin
             result:=i;exit;
         end;
     end;
     if (WPieceStart[5] and fun.MaskOneBit[NumPos])>0 then  begin
             result:=5;exit;
     end else begin
             result:=6;exit;
     end;
   end;
end;
procedure TFormBoard.ChessBoardClick(Sender: TObject);
begin
if NumPos>63 then exit;
if NumPos<0 then exit;
View();
end;

procedure TFormBoard.ChessBoardMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
Xmouse:=X+Board.Left;Ymouse:=Y+Board.Top;
NumPos:= ((X-dX) div cell)+8*((Y-dY) div cell);
end;

procedure TFormBoard.FEN1Click(Sender: TObject);
 var pos : string;
begin
 pos:= InputBox('Установить позицию', 'Введите FEN строку', 'rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR');
 if not fun.FenToU64(pos)  then ShowMessage('Ошибка FEN строки');
View();
end;

procedure TFormBoard.FormCreate(Sender: TObject);
begin
//заставляет выполнить все задачи которые накопились в данный момент
Application.ProcessMessages;
if not fun.FenToU64(PosStart) then ShowMessage('Ошибка FEN строки');
Board.Caption := ProgrammDate;
MaskBit.init();
MaskBit.maskLine();
View();
end;

procedure TFormBoard.NClick(Sender: TObject);
begin
 //ShowMessage('Кликнули по '+IntToStr((Sender as TMenuItem).Tag));
 case (Sender as TMenuItem).Tag of
	1 : fun.FenToU64('rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR');
	2 : fun.FenToU64('r3k2r/p1ppqpb1/bn2pnp1/3PN3/1p2P3/2N2Q1p/PPPBBPPP/R3K2R');
	3 : fun.FenToU64('8/2p5/3p4/KP5r/1R3p1k/8/4P1P1/8');
	4 : fun.FenToU64('r3k2r/Pppp1ppp/1b3nbN/nP6/BBP1P3/q4N2/Pp1P2PP/R2Q1RK1');
  5 : fun.FenToU64('rnbq1k1r/pp1Pbppp/2p5/8/2B5/8/PPP1NnPP/RNBQK2R');
	6 : fun.FenToU64('r4rk1/1pp1qppp/p1np1n2/2b1p1B1/2B1P1b1/P1NP1N2/1PP1QPPP/R4RK1');
 end;
View();
end;

end.