Recent

Author Topic: Drawing a chessboard  (Read 1206 times)

RAW

  • Hero Member
  • *****
  • Posts: 867
Re: Drawing a chessboard
« Reply #15 on: May 31, 2020, 08:16:35 pm »
The easiest way I can think of ...  :)

Code: Pascal  [Select][+][-]
  1. unit Unit1;
  2. {$mode objfpc}{$H+}
  3. interface
  4. uses
  5.   Classes,SysUtils,Forms,Controls,Graphics,Dialogs;
  6. type
  7.   TBoardRec = Record
  8.    R:TRect;
  9.   End;
  10. type
  11.   TForm1 = class(TForm)
  12.    procedure FormCreate    (Sender:TObject);
  13.    procedure FormPaint     (Sender:TObject);
  14.    procedure FormMouseMove (Sender:TObject;Shift:TShiftState;X,Y:Integer);
  15.    procedure FormMouseDown (Sender:TObject;Button:TMouseButton;
  16.                             Shift:TShiftState; X, Y: Integer);
  17.    procedure GetDayRect    (iX,iY:Integer;Out iCX,iCY:Integer);
  18.   private
  19.    arrBoard: Array[1..8,1..8] Of TBoardRec;rBoard:TRect;iCell,iMX,iMY:Integer;
  20.   end;
  21. var
  22.   Form1: TForm1;
  23. implementation
  24. {$R *.lfm}
  25.  
  26. procedure TForm1.FormPaint(Sender:TObject);
  27. var
  28.  iy,ix,iCount,iSpaceX,iSpaceY:Integer;booColor:Boolean;
  29. begin
  30.   booColor:= True;
  31.   iSpaceX:= -iCell;
  32.   iSpaceY:= 0;
  33.   iCount:= 0;
  34.   // Drawing
  35.   For iy:= 1 To 8
  36.   Do
  37.    For ix:= 1 To 8
  38.    Do
  39.     Begin
  40.      Inc(iCount);
  41.       If iCount = 9
  42.       Then
  43.        Begin
  44.         iCount:= 1;
  45.         Inc(iSpaceY,iCell);
  46.         iSpaceX:= -iCell;
  47.         booColor:= Not booColor;
  48.        End;
  49.      Inc(iSpaceX,iCell);
  50.      // Set Color
  51.      If booColor
  52.      Then Canvas.Brush.Color:= clWhite
  53.      Else Canvas.Brush.Color:= clBlack;
  54.      // Fill RectArray
  55.      arrBoard[iy,ix].R:= Rect(ClientRect.Left+iSpaceX,
  56.       ClientRect.Top+iSpaceY,ClientRect.Left+iSpaceX+iCell,
  57.       ClientRect.Top+iSpaceY+iCell);
  58.      // Draw Cell
  59.      Canvas.FillRect(arrBoard[iy,ix].R);
  60.      booColor:= Not booColor;
  61.     End;
  62. end;
  63.  
  64. Function InsideRect(R:TRect;X,Y:Integer):Boolean;
  65. Begin
  66.   Result:= False;
  67.   If (X >= R.Left) And (Y <= R.Bottom) And (X <= R.Right) And (Y >= R.Top)
  68.   Then Result:= True;
  69. End;
  70.  
  71. procedure TForm1.FormMouseMove(Sender:TObject;Shift:TShiftState;X,Y:Integer);
  72. begin
  73.   // If You Need X,Y In OnPaint
  74.   iMX:= X;iMY:= Y;
  75.   Invalidate;
  76. end;
  77.  
  78. Procedure TForm1.GetDayRect(iX,iY:Integer;Out iCX,iCY:Integer);
  79. Var
  80.  d:Double;
  81. Begin
  82.   d:= (iY-rBoard.Top)/iCell;
  83.   iCY:= Trunc(d);
  84.   If Frac(d) <> 0 Then Inc(iCY);
  85.   If iCY > 8 Then iCY:= 8;
  86.   If iCY < 1 Then iCY:= 1;
  87.   d:= (iX-rBoard.Left)/iCell;
  88.   iCX:= Trunc(d);
  89.   If Frac(d) <> 0 Then Inc(iCX);
  90.   If iCX > 8 Then iCX:= 8;
  91.   If iCX < 1 Then iCX:= 1;
  92. End;
  93.  
  94. procedure TForm1.FormMouseDown
  95. (Sender:TObject;Button:TMouseButton;Shift:TShiftState;X,Y:Integer);
  96. var
  97.  iCX,iCY:Integer;
  98. begin
  99.   If InsideRect(rBoard,X,Y)
  100.   Then
  101.    Begin
  102.     GetDayRect(X,Y,iCX,iCY);
  103.     Caption:= 'Array Cell (iy, ix): '+IntToStr(iCY)+' '+IntToStr(iCX);
  104.    End;
  105. end;
  106.  
  107. procedure TForm1.FormCreate(Sender:TObject);
  108. begin
  109.   iCell:= 50;
  110.   rBoard:= Rect(0,0,400,400);
  111.   Caption:= 'Click Any Cell ...';
  112. end;
  113.  
  114. end.
Windows 7 Pro (x64 Sp1) And Windows XP Pro (x86 Sp3) - LAZARUS 2.0.8 FPC 3.0.4 - TRUNK 2.1.0 FPC 3.3.1
// This is polarity (hell) and hell is reigned by lies, nothing but lies. Be careful what you believe ...
// There are 10 types of people in this world, those who understand mind control and ...

RAW

  • Hero Member
  • *****
  • Posts: 867
Re: Drawing a chessboard
« Reply #16 on: June 01, 2020, 01:47:28 am »
This is an example with an additional bitmap (DoubleBuffering) ...
- added Chess Notation ...  :)

Code: Pascal  [Select][+][-]
  1. UNIT Unit1;
  2. {$mode objfpc}{$H+}
  3. INTERFACE
  4. USES
  5.  Classes,SysUtils,Forms,Controls,Graphics;
  6. TYPE
  7.  TBoardRec = Record
  8.   R:TRect;
  9.  End;
  10. TYPE
  11.  TForm1 = class(TForm)
  12.   Procedure FormCreate    (Sender:TObject);
  13.   Procedure FormPaint     (Sender:TObject);
  14.   Procedure FormMouseMove (Sender:TObject;Shift:TShiftState;X,Y:Integer);
  15.   Procedure FormMouseDown (Sender:TObject;Button:TMouseButton;
  16.                            Shift:TShiftState;X,Y:Integer);
  17.   Procedure FormClose     (Sender:TObject;Var CloseAction:TCloseAction);
  18.   Procedure GetRect       (iX,iY:Integer;Out iCX,iCY:Integer);
  19.  PRIVATE
  20.   arrBoard: Array[1..8,1..8] Of TBoardRec;
  21.   rBoard:TRect;iCell,iMX,iMY:Integer;BMP:TBitmap; // DoubleBuffering ...
  22.  End;
  23. VAR
  24.  Form1: TForm1;
  25. IMPLEMENTATION
  26. {$R *.lfm}
  27.  
  28. Procedure TForm1.FormPaint(Sender:TObject);
  29. Var
  30.  iy,ix,iCount,iSpaceX,iSpaceY:Integer;booColor:Boolean;
  31. Begin
  32.   booColor:= True;
  33.   iSpaceX:= -iCell;
  34.   iSpaceY:= 0;
  35.   iCount:= 0;
  36.   For iy:= 1 To 8
  37.   Do
  38.    For ix:= 1 To 8
  39.    Do
  40.     Begin
  41.      Inc(iCount);
  42.       If iCount = 9
  43.       Then
  44.        Begin
  45.         iCount:= 1;
  46.         Inc(iSpaceY,iCell);
  47.         iSpaceX:= -iCell;
  48.         booColor:= Not booColor;
  49.        End;
  50.      Inc(iSpaceX,iCell);
  51.      // Set Color
  52.      If booColor
  53.      Then BMP.Canvas.Brush.Color:= clWhite
  54.      Else BMP.Canvas.Brush.Color:= clBlack;
  55.      // Fill RectArray
  56.      arrBoard[iy,ix].R:= Rect(ClientRect.Left+iSpaceX,
  57.       ClientRect.Top+iSpaceY,ClientRect.Left+iSpaceX+iCell,
  58.       ClientRect.Top+iSpaceY+iCell);
  59.      // Draw Cell
  60.      BMP.Canvas.FillRect(arrBoard[iy,ix].R);
  61.      booColor:= Not booColor;
  62.     End;
  63.   // Draw BMP Buffer On Form Canvas
  64.   Canvas.Draw(0,0,BMP);
  65. End;
  66.  
  67. Function InsideRect(R:TRect;X,Y:Integer):Boolean;
  68. Begin
  69.   Result:= False;
  70.   If (X >= R.Left) And (Y <= R.Bottom) And (X <= R.Right) And (Y >= R.Top)
  71.   Then Result:= True;
  72. End;
  73.  
  74. Procedure TForm1.FormMouseMove(Sender:TObject;Shift:TShiftState;X,Y:Integer);
  75. Begin
  76.   // If You Need X,Y In OnPaint
  77.   iMX:= X;iMY:= Y;
  78.   Invalidate;
  79. End;
  80.  
  81. Procedure TForm1.GetRect(iX,iY:Integer;Out iCX,iCY:Integer);
  82. Var
  83.  d:Double;
  84. Begin
  85.   d:= (iY-rBoard.Top)/iCell;
  86.   iCY:= Trunc(d);
  87.   If Frac(d) <> 0 Then Inc(iCY);
  88.   If iCY > 8 Then iCY:= 8;
  89.   If iCY < 1 Then iCY:= 1;
  90.   d:= (iX-rBoard.Left)/iCell;
  91.   iCX:= Trunc(d);
  92.   If Frac(d) <> 0 Then Inc(iCX);
  93.   If iCX > 8 Then iCX:= 8;
  94.   If iCX < 1 Then iCX:= 1;
  95. End;
  96.  
  97. Procedure TForm1.FormMouseDown
  98. (Sender:TObject;Button:TMouseButton;Shift:TShiftState;X,Y:Integer);
  99. Var
  100.  iCX,iCY:Integer;
  101.  arrAH: Array[1..8] Of String = ('a','b','c','d','e','f','g','h');
  102. Begin
  103.   If InsideRect(rBoard,X,Y)
  104.   Then
  105.    Begin
  106.     GetRect(X,Y,iCX,iCY);
  107.     Caption:= 'Array Cell (iy, ix): '+IntToStr(iCY)+' , '+IntToStr(iCX)+
  108.      '  Chess Notation: '+arrAH[iCX]+IntToStr(((8-iCY)+1));
  109.    End;
  110. End;
  111.  
  112. Procedure TForm1.FormCreate(Sender:TObject);
  113. Begin
  114.   iCell:= 50;
  115.   rBoard:= Rect(ClientRect.Left,ClientRect.Top,
  116.    ClientRect.Left+400,ClientRect.Top+400);
  117.   Caption:= 'Click on a cell ...';
  118.   BMP:= TBitmap.Create;
  119.   BMP.SetSize(400,400);
  120. End;
  121.  
  122. Procedure TForm1.FormClose(Sender:TObject;Var CloseAction:TCloseAction);
  123. Begin
  124.   BMP.Free;
  125. End;
  126.  
  127. END.
Windows 7 Pro (x64 Sp1) And Windows XP Pro (x86 Sp3) - LAZARUS 2.0.8 FPC 3.0.4 - TRUNK 2.1.0 FPC 3.3.1
// This is polarity (hell) and hell is reigned by lies, nothing but lies. Be careful what you believe ...
// There are 10 types of people in this world, those who understand mind control and ...

 

TinyPortal © 2005-2018