Examples Delphi

  1. Home
  2. Delphi
  3. Examples
  4. Solve Of Pegged Game
Title: Solve Of Pegged Game
Question: abstract
Answer:
Did you try to play pegged game?
It is difficult game to solve, but if you promise your friend that you'll solve it what would you do?
I think you'll do like me, write a program to solve this puzzle, I have spent about 3 hours to solve it,
if you want to get the code then take it else don't promise your friend :)
******************************************
Form code
******************************************
unit Unit1;
interface
uses
Windows, Messages, SysUtils, StdCtrls, Classes,
Controls, Graphics, Forms, Dialogs, ExtCtrls;
type
TForm1 = class(TForm)
StartBtn: TButton;
List1: TListBox;
text1: TEdit;
text2: TEdit;
text3: TEdit;
ClearAllBtn: TButton;
SetAllBtn: TButton;
Panel1: TPanel;
CheckBox3: TCheckBox;
CheckBox4: TCheckBox;
CheckBox5: TCheckBox;
CheckBox10: TCheckBox;
CheckBox11: TCheckBox;
CheckBox12: TCheckBox;
CheckBox15: TCheckBox;
CheckBox16: TCheckBox;
CheckBox17: TCheckBox;
CheckBox18: TCheckBox;
CheckBox19: TCheckBox;
CheckBox20: TCheckBox;
CheckBox21: TCheckBox;
CheckBox22: TCheckBox;
CheckBox23: TCheckBox;
CheckBox24: TCheckBox;
CheckBox25: TCheckBox;
CheckBox26: TCheckBox;
CheckBox27: TCheckBox;
CheckBox28: TCheckBox;
CheckBox29: TCheckBox;
CheckBox30: TCheckBox;
CheckBox31: TCheckBox;
CheckBox32: TCheckBox;
CheckBox33: TCheckBox;
CheckBox34: TCheckBox;
CheckBox35: TCheckBox;
CheckBox38: TCheckBox;
CheckBox39: TCheckBox;
CheckBox40: TCheckBox;
CheckBox45: TCheckBox;
CheckBox46: TCheckBox;
CheckBox47: TCheckBox;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
Label9: TLabel;
Label10: TLabel;
Label11: TLabel;
Label12: TLabel;
Label13: TLabel;
Label14: TLabel;
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
Label15: TLabel;
Label16: TLabel;
Label17: TLabel;
Label18: TLabel;
MoveNoEdit: TEdit;
Label19: TLabel;
procedure StartBtnClick(Sender: TObject);
procedure ClearAllBtnClick(Sender: TObject);
procedure SetAllBtnClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure List1Click(Sender: TObject);
private
{ Private declarations }
function GetCheck( index:integer):Boolean;
procedure SetCheck( index:integer; value:boolean);
public
{ Public declarations }
property Check1[index:integer]:Boolean read GetCheck write SetCheck;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
// Firas Nizam 2001
Const
wdth = 7;
wdth2 = wdth * 2;
SlotsCount = wdth * wdth;
ValidBalls = slotsCount - 4 * 4;
var
FoundResult : Boolean;
CountTries : Longint;
MaxResultFrames:integer;
results : array[0..SlotsCount-1,0..SlotsCount - 1] of Boolean;
ValidNdx:array[0..SlotsCount-1] of Boolean;
Balls:array[0..ValidBalls - 1] of Integer;
BallPresent:array[0..SlotsCount - 1] of Boolean;
function TForm1.GetCheck( index:integer):Boolean;
begin
GetCheck:= TCheckBox(FindComponent( 'CheckBox'+IntToStr(index+1))).Checked;
end;
procedure TForm1.SetCheck( index:integer; value:boolean);
begin
TCheckBox(FindComponent( 'CheckBox'+IntToStr(index+1))).Checked:= value;
end;
Function GetX(index : Integer) : Integer;
begin
GetX := index Mod wdth
End;
Function GetY(index : Integer) : Integer;
begin
GetY := index div wdth
End;
Function GetPosName(index : Integer) : String;
begin
GetPosName := Chr(ord('A') + GetY(index)) + Chr(ord('0') + GetX(index))
End;
Function CheckValidBallPos(index : Integer) : Boolean;
begin
CheckValidBallPos := False;
If (index = 0) And (index begin
If (GetX(index) = 2) And (GetX(index) or (GetY(index) = 2) And(GetY(index) CheckValidBallPos := True;
end
End;
procedure AddSolvedMove(index1 : Integer; index2 : Integer);
begin
Form1.List1.Items.Insert( 0, GetPosName(index1) + '-' + GetPosName(index2));
End;
procedure MakeMove( StartPos, RemovingBallPos, EndPos : Integer);
begin
BallPresent[StartPos] := False;
BallPresent[EndPos] := True;
BallPresent[RemovingBallPos] := False;
End;
procedure UndoMove( StartPos, RemovingBallPos, EndPos : Integer);
begin
BallPresent[StartPos] := True;
BallPresent[EndPos] := False;
BallPresent[RemovingBallPos] := True;
End;
Function GetAvaliables(MoveNum : Integer) : Boolean; forward;
procedure TestBallMovement( var CountMoves : Integer; MoveNum : Integer; StartPos, RemovingBallPos, EndPos : Integer);
begin
If Not ValidNdx[EndPos] Then Exit;
If Not BallPresent[RemovingBallPos] Then Exit ;
If BallPresent[EndPos] Then Exit;
If FoundResult Then Exit;
MakeMove( StartPos, RemovingBallPos, EndPos);
If GetAvaliables( MoveNum + 1) Then AddSolvedMove( StartPos, EndPos);
UndoMove( StartPos, RemovingBallPos, EndPos);
CountMoves := CountMoves + 1;
End;
Function GetAvaliables( MoveNum : Integer) : Boolean;
var
n : Integer;
ii : Integer;
CountMoves : Integer;
x : Integer;
y : Integer;
RemainingBallsCount: Integer;
begin
CountMoves := 0;
For ii := 0 To ValidBalls - 1 do
begin
n := Balls[ii];
If BallPresent[n] Then
begin
x := GetX(n);
y := GetY(n);
If x + 2 If x - 2 = 0 Then TestBallMovement( CountMoves, MoveNum, n, n - 1, n - 2);
If y + 2 If y - 2 = 0 Then TestBallMovement( CountMoves, MoveNum, n, n - wdth, n - wdth2);
End;
end;
If CountMoves = 0 Then // cannot move
begin
RemainingBallsCount := 0;
For ii := 0 To ValidBalls - 1 do
begin
n := Balls[ii];
If BallPresent[n] Then RemainingBallsCount := RemainingBallsCount + 1;
end;
If RemainingBallsCount = 1 Then
begin
FoundResult := True;
// MessageDlg( 'Found it!!!!', mtInformation, [mbok],0);
//' allocation memory for result
// ReDim results(0 To MoveNum, 0 To SlotsCount - 1)
MaxResultFrames:= MoveNum;
End;
Form1.Text1.Text := IntToStr( MoveNum);
Form1.Text1.Refresh;
Form1.Text2.Text := IntToStr( RemainingBallsCount);
Form1.Text2.Refresh;
CountTries := CountTries + 1;
Form1.Text3.Text := IntToStr( CountTries);
Form1.Text3.Refresh;
If RemainingBallsCount begin
For ii := 0 To ValidBalls - 1 do
begin
n := Balls[ii];
Form1.Check1[n] := BallPresent[n];
end;
End;
End;
If FoundResult Then
begin
// store the results
For ii := 0 To ValidBalls - 1 do
begin
n := Balls[ii];
results[ MoveNum, n] := BallPresent[n];
Form1.Check1[n] := BallPresent[n];
end;
End;
GetAvaliables := FoundResult
End;
procedure ShowFrame( FrameNum : Integer);
var
n : Integer;
ii : Integer;
begin
For ii := 0 To ValidBalls - 1 do
begin
n := Balls[ii];
Form1.Check1[n] := results[ FrameNum, n]
end;
End;
procedure TForm1.StartBtnClick(Sender: TObject);
var
n : Integer;
ii : Integer;
StartTime, EndTime: TTime;
begin
StartTime:= now;
List1.Clear;
FoundResult := False;
For ii := 0 To ValidBalls - 1 do
begin
n := Balls[ii];
BallPresent[n]:= form1.Check1[n];
end;
if GetAvaliables( 0) then
Form1.List1.Items.Insert( 0, 'Beginning');
EndTime:= now;
Edit1.Text := TimeToStr( StartTime);
Edit2.Text := TimeToStr( EndTime);
Edit3.Text := FloatToStr( Round( (EndTime-StartTime)*24*60*60*100 )/100);
end;
procedure TForm1.ClearAllBtnClick(Sender: TObject);
var
n : Integer;
ii : Integer;
begin
For ii := 0 To ValidBalls - 1 do
begin
n := Balls[ii];
form1.Check1[n] := false;
end;
end;
procedure TForm1.SetAllBtnClick(Sender: TObject);
var
n : Integer;
ii : Integer;
begin
For ii := 0 To ValidBalls - 1 do
begin
n := Balls[ii];
Form1.Check1[n] := true;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
n : Integer;
idx : Integer;
begin
idx := 0;
For n := 0 To SlotsCount - 1 do
ValidNdx[n] := CheckValidBallPos(n);
For n := 0 To SlotsCount - 1 do
If ValidNdx[n] Then
begin
Balls[idx] := n;
idx := idx + 1;
End;
end;
procedure TForm1.List1Click(Sender: TObject);
begin
ShowFrame( List1.ItemIndex);
MoveNoEdit.Text:= IntToStr( List1.ItemIndex);
end;
end.
*************************************************
Form components
*************************************************
object Form1: TForm1
Left = 215
Top = 124
Width = 326
Height = 314
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object Label15: TLabel
Left = 160
Top = 19
Width = 48
Height = 13
Caption = 'Start Time'
end
object Label16: TLabel
Left = 160
Top = 43
Width = 45
Height = 13
Caption = 'End Time'
end
object Label17: TLabel
Left = 160
Top = 67
Width = 51
Height = 13
Caption = 'Time (Sec)'
end
object Label18: TLabel
Left = 144
Top = 104
Width = 86
Height = 13
Caption = 'Results of solving:'
end
object Label19: TLabel
Left = 185
Top = 259
Width = 47
Height = 13
Caption = 'Move No.'
end
object StartBtn: TButton
Left = 72
Top = 168
Width = 57
Height = 17
Caption = 'Start'
TabOrder = 0
OnClick = StartBtnClick
end
object List1: TListBox
Left = 144
Top = 120
Width = 169
Height = 129
ItemHeight = 13
TabOrder = 1
OnClick = List1Click
end
object text1: TEdit
Left = 48
Top = 192
Width = 81
Height = 21
TabOrder = 2
end
object text2: TEdit
Left = 48
Top = 216
Width = 81
Height = 21
TabOrder = 3
end
object text3: TEdit
Left = 48
Top = 240
Width = 81
Height = 21
TabOrder = 4
end
object ClearAllBtn: TButton
Left = 0
Top = 144
Width = 57
Height = 17
Caption = 'Clear All'
TabOrder = 5
OnClick = ClearAllBtnClick
end
object SetAllBtn: TButton
Left = 72
Top = 144
Width = 57
Height = 17
Caption = 'Set All'
TabOrder = 6
OnClick = SetAllBtnClick
end
object Panel1: TPanel
Left = 0
Top = 0
Width = 129
Height = 137
Caption = 'Panel1'
TabOrder = 7
object Label1: TLabel
Left = 16
Top = 1
Width = 6
Height = 13
Caption = '0'
end
object Label2: TLabel
Left = 32
Top = 1
Width = 6
Height = 13
Caption = '1'
end
object Label3: TLabel
Left = 48
Top = 1
Width = 6
Height = 13
Caption = '2'
end
object Label4: TLabel
Left = 64
Top = 1
Width = 6
Height = 13
Caption = '3'
end
object Label5: TLabel
Left = 80
Top = 1
Width = 6
Height = 13
Caption = '4'
end
object Label6: TLabel
Left = 96
Top = 1
Width = 6
Height = 13
Caption = '5'
end
object Label7: TLabel
Left = 112
Top = 1
Width = 6
Height = 13
Caption = '6'
end
object Label8: TLabel
Left = 3
Top = 14
Width = 7
Height = 13
Caption = 'A'
end
object Label9: TLabel
Left = 3
Top = 30
Width = 7
Height = 13
Caption = 'B'
end
object Label10: TLabel
Left = 3
Top = 46
Width = 7
Height = 13
Caption = 'C'
end
object Label11: TLabel
Left = 3
Top = 62
Width = 8
Height = 13
Caption = 'D'
end
object Label12: TLabel
Left = 3
Top = 78
Width = 7
Height = 13
Caption = 'E'
end
object Label13: TLabel
Left = 3
Top = 94
Width = 6
Height = 13
Caption = 'F'
end
object Label14: TLabel
Left = 3
Top = 110
Width = 8
Height = 13
Caption = 'G'
end
object CheckBox3: TCheckBox
Left = 45
Top = 14
Width = 17
Height = 17
Caption = 'CheckBox1'
Checked = True
State = cbChecked
TabOrder = 0
end
object CheckBox4: TCheckBox
Left = 61
Top = 14
Width = 17
Height = 17
Caption = 'CheckBox1'
Checked = True
State = cbChecked
TabOrder = 1
end
object CheckBox5: TCheckBox
Left = 77
Top = 14
Width = 17
Height = 17
Caption = 'CheckBox1'
Checked = True
State = cbChecked
TabOrder = 2
end
object CheckBox10: TCheckBox
Left = 45
Top = 30
Width = 17
Height = 17
Caption = 'CheckBox1'
Checked = True
State = cbChecked
TabOrder = 3
end
object CheckBox11: TCheckBox
Left = 61
Top = 30
Width = 17
Height = 17
Caption = 'CheckBox1'
Checked = True
State = cbChecked
TabOrder = 4
end
object CheckBox12: TCheckBox
Left = 77
Top = 30
Width = 17
Height = 17
Caption = 'CheckBox1'
Checked = True
State = cbChecked
TabOrder = 5
end
object CheckBox15: TCheckBox
Left = 13
Top = 46
Width = 17
Height = 17
Caption = 'CheckBox1'
Checked = True
State = cbChecked
TabOrder = 6
end
object CheckBox16: TCheckBox
Left = 29
Top = 46
Width = 17
Height = 17
Caption = 'CheckBox1'
Checked = True
State = cbChecked
TabOrder = 7
end
object CheckBox17: TCheckBox
Left = 45
Top = 46
Width = 17
Height = 17
Caption = 'CheckBox1'
Checked = True
State = cbChecked
TabOrder = 8
end
object CheckBox18: TCheckBox
Left = 61
Top = 46
Width = 17
Height = 17
Caption = 'CheckBox1'
Checked = True
State = cbChecked
TabOrder = 9
end
object CheckBox19: TCheckBox
Left = 77
Top = 46
Width = 17
Height = 17
Caption = 'CheckBox1'
Checked = True
State = cbChecked
TabOrder = 10
end
object CheckBox20: TCheckBox
Left = 93
Top = 46
Width = 17
Height = 17
Caption = 'CheckBox1'
Checked = True
State = cbChecked
TabOrder = 11
end
object CheckBox21: TCheckBox
Left = 109
Top = 46
Width = 17
Height = 17
Caption = 'CheckBox1'
Checked = True
State = cbChecked
TabOrder = 12
end
object CheckBox22: TCheckBox
Left = 13
Top = 62
Width = 17
Height = 17
Caption = 'CheckBox1'
Checked = True
State = cbChecked
TabOrder = 13
end
object CheckBox23: TCheckBox
Left = 29
Top = 62
Width = 17
Height = 17
Caption = 'CheckBox1'
Checked = True
State = cbChecked
TabOrder = 14
end
object CheckBox24: TCheckBox
Left = 45
Top = 62
Width = 17
Height = 17
Caption = 'CheckBox1'
Checked = True
State = cbChecked
TabOrder = 15
end
object CheckBox25: TCheckBox
Left = 61
Top = 62
Width = 17
Height = 17
Caption = 'CheckBox1'
TabOrder = 16
end
object CheckBox26: TCheckBox
Left = 77
Top = 62
Width = 17
Height = 17
Caption = 'CheckBox1'
Checked = True
State = cbChecked
TabOrder = 17
end
object CheckBox27: TCheckBox
Left = 93
Top = 62
Width = 17
Height = 17
Caption = 'CheckBox1'
Checked = True
State = cbChecked
TabOrder = 18
end
object CheckBox28: TCheckBox
Left = 109
Top = 62
Width = 17
Height = 17
Caption = 'CheckBox1'
Checked = True
State = cbChecked
TabOrder = 19
end
object CheckBox29: TCheckBox
Left = 13
Top = 78
Width = 17
Height = 17
Caption = 'CheckBox1'
Checked = True
State = cbChecked
TabOrder = 20
end
object CheckBox30: TCheckBox
Left = 29
Top = 78
Width = 17
Height = 17
Caption = 'CheckBox1'
Checked = True
State = cbChecked
TabOrder = 21
end
object CheckBox31: TCheckBox
Left = 45
Top = 78
Width = 17
Height = 17
Caption = 'CheckBox1'
Checked = True
State = cbChecked
TabOrder = 22
end
object CheckBox32: TCheckBox
Left = 61
Top = 78
Width = 17
Height = 17
Caption = 'CheckBox1'
Checked = True
State = cbChecked
TabOrder = 23
end
object CheckBox33: TCheckBox
Left = 77
Top = 78
Width = 17
Height = 17
Caption = 'CheckBox1'
Checked = True
State = cbChecked
TabOrder = 24
end
object CheckBox34: TCheckBox
Left = 93
Top = 78
Width = 17
Height = 17
Caption = 'CheckBox1'
Checked = True
State = cbChecked
TabOrder = 25
end
object CheckBox35: TCheckBox
Left = 109
Top = 78
Width = 17
Height = 17
Caption = 'CheckBox1'
Checked = True
State = cbChecked
TabOrder = 26
end
object CheckBox38: TCheckBox
Left = 45
Top = 94
Width = 17
Height = 17
Caption = 'CheckBox1'
Checked = True
State = cbChecked
TabOrder = 27
end
object CheckBox39: TCheckBox
Left = 61
Top = 94
Width = 17
Height = 17
Caption = 'CheckBox1'
Checked = True
State = cbChecked
TabOrder = 28
end
object CheckBox40: TCheckBox
Left = 77
Top = 94
Width = 17
Height = 17
Caption = 'CheckBox1'
Checked = True
State = cbChecked
TabOrder = 29
end
object CheckBox45: TCheckBox
Left = 45
Top = 110
Width = 17
Height = 17
Caption = 'CheckBox1'
Checked = True
State = cbChecked
TabOrder = 30
end
object CheckBox46: TCheckBox
Left = 61
Top = 110
Width = 17
Height = 17
Caption = 'CheckBox1'
Checked = True
State = cbChecked
TabOrder = 31
end
object CheckBox47: TCheckBox
Left = 77
Top = 110
Width = 17
Height = 17
Caption = 'CheckBox1'
Checked = True
State = cbChecked
TabOrder = 32
end
end
object Edit1: TEdit
Left = 224
Top = 16
Width = 89
Height = 21
TabOrder = 8
end
object Edit2: TEdit
Left = 224
Top = 40
Width = 89
Height = 21
TabOrder = 9
end
object Edit3: TEdit
Left = 224
Top = 64
Width = 89
Height = 21
TabOrder = 10
end
object MoveNoEdit: TEdit
Left = 240
Top = 256
Width = 73
Height = 21
TabOrder = 11
end
end