### Bookstore

 Computer Math and Games in Pascal (preview) Lazarus Handbook

### Author Topic: Drawing a chessboard  (Read 1207 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) ...

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 ...