Правила форума
не подскажите как можно получить такую же цепочку домино, только с помощью строк а не массива!?
program domino;
uses Graph;
const
MassLen = 7;
type
tMass = array[1..2, 1..MassLen] of byte;
var
grDriver: Integer;
grMode: Integer;
ErrCode: Integer;
i,j: Integer;
Mass, Sort, StartChain, SortMass: tMass;
inputres, chain_form: boolean;
function IsInChain(Chain:tMass; len,num_elem:Integer):boolean;
var
i:Integer;
res: boolean;
begin
res:=false;
for i:=1 to len do
if Chain[1,i] = num_elem
then res:=true;
IsInChain:=res;
end;
procedure MakeChain(Chain:tMass; len:Integer);
var
i,j:Integer;
begin
if (not chain_form)
then
begin
if (len = 0)
then begin
for i:=1 to MassLen do
begin
Chain[1,1]:=i;
Chain[2,1]:=1;
MakeChain(Chain, len+1);
end;
end
else
if (len = MassLen)
then begin
chain_form:=true;
for i:=1 to MassLen do
begin
Sort[1,i]:=Chain[1,i];
Sort[2,i]:=Chain[2,i];
end;
end
else
begin
for i:=1 to MassLen do
if (not IsInChain(Chain,len,i))
then begin
if (Mass[Chain[2,1],Chain[1,1]] = Mass[1,i])
then begin
for j:=len downto 1 do
begin
Chain[1,j+1]:=Chain[1,j];
Chain[2,j+1]:=Chain[2,j];
end;
Chain[1,1]:=i;
Chain[2,1]:=2;
MakeChain(Chain,len+1);
end
else
if (Mass[Chain[2,1],Chain[1,1]] = Mass[2,i])
then begin
for j:=len downto 1 do
begin
Chain[1,j+1]:=Chain[1,j];
Chain[2,j+1]:=Chain[2,j];
end;
Chain[1,1]:=i;
Chain[2,1]:=1;
MakeChain(Chain,len+1);
end;
if (Mass[3-Chain[2,len],Chain[1,len]] = Mass[1,i])
then begin
Chain[1,len+1]:=i;
Chain[2,len+1]:=1;
MakeChain(Chain,len+1);
end
else
if (Mass[3-Chain[2,len],Chain[1,len]] = Mass[2,i])
then begin
Chain[1,len+1]:=i;
Chain[2,len+1]:=2;
MakeChain(Chain,len+1);
end;
end;
end;
end;
end;
function CheckDomino(num:Integer):boolean;
var
res: boolean;
i: Integer;
begin
res:=false;
for i:=1 to num-1 do
if (((Mass[1,i] = Mass[1,num]) and (Mass[2,i] = Mass[2,num]))
or ((Mass[1,i] = Mass[2,num]) and (Mass[2,i] = Mass[1,num])))
then res:=true;
CheckDomino:=res;
end;
procedure DrawDomino(x,y:Integer;i:Integer);
begin
Rectangle(x,y,x+40,y+20);
MoveTO(x+20,y);
LineTO(x+20,y+20);
case SortMass[1,i] of
1:Circle(x+10,y+10,2);
2:begin
Circle(x+6,y+6,2);
Circle(x+14,y+14,2);
end;
3:begin
Circle(x+6,y+6,2);
Circle(x+10,y+10,2);
Circle(x+14,y+14,2);
end;
4:begin
Circle(x+6,y+6,2);
Circle(x+6,y+14,2);
Circle(x+14,y+6,2);
Circle(x+14,y+14,2);
end;
5:begin
Circle(x+6,y+6,2);
Circle(x+6,y+14,2);
Circle(x+10,y+10,2);
Circle(x+14,y+6,2);
Circle(x+14,y+14,2);
end;
6:begin
Circle(x+6,y+6,2);
Circle(x+6,y+10,2);
Circle(x+6,y+14,2);
Circle(x+14,y+6,2);
Circle(x+14,y+10,2);
Circle(x+14,y+14,2);
end;
end;
case SortMass[2,i] of
1:Circle(x+10+20,y+10,2);
2:begin
Circle(x+6+20,y+6,2);
Circle(x+14+20,y+14,2);
end;
3:begin
Circle(x+6+20,y+6,2);
Circle(x+10+20,y+10,2);
Circle(x+14+20,y+14,2);
end;
4:begin
Circle(x+6+20,y+6,2);
Circle(x+6+20,y+14,2);
Circle(x+14+20,y+6,2);
Circle(x+14+20,y+14,2);
end;
5:begin
Circle(x+6+20,y+6,2);
Circle(x+6+20,y+14,2);
Circle(x+10+20,y+10,2);
Circle(x+14+20,y+6,2);
Circle(x+14+20,y+14,2);
end;
6:begin
Circle(x+6+20,y+6,2);
Circle(x+6+20,y+10,2);
Circle(x+6+20,y+14,2);
Circle(x+14+20,y+6,2);
Circle(x+14+20,y+10,2);
Circle(x+14+20,y+14,2);
end;
end;
end;
begin
WriteLn('Vvedite znacheniya 7 par domino');
i:=1;
while i <= MassLen do
begin
inputres:=true;
while inputres do
begin
ReadLn(Mass[1,i]);
if (Mass[1,i] <= 6) and (Mass[1,i] >= 0)
then inputres:=false
else WriteLn('Chislo dolgno bit menche 7 i bolshe ili ravno 0');
end;
inputres:=true;
while inputres do
begin
ReadLn(Mass[2,i]);
if (Mass[2,i] <= 6) and (Mass[2,i] >= 0)
then inputres:=false
else WriteLn('Chislo dolgno bit menche 7 i bolshe ili ravno 0');
end;
if (CheckDomino(i))
then WriteLn('Takoe domino uge est')
else i:=i+1;
end;
MakeChain(StartChain,0);
if (chain_form)
then
for i:=1 to MassLen do
begin
if (Sort[2,i] = 1)
then begin
SortMass[1,i]:=Mass[1,Sort[1,i]];
SortMass[2,i]:=Mass[2,Sort[1,i]];
end
else begin
SortMass[2,i]:=Mass[1,Sort[1,i]];
SortMass[1,i]:=Mass[2,Sort[1,i]];
end;
end;
grDriver:=Vga;
grMode:=VgaHi;
InitGraph(grDriver,grMode,'d:\dvd2\borlpasc\bgi');
ErrCode := GraphResult;
if ErrCode = grOk then
begin { Do graphics }
OutTextXY(20, 20, 'Dlya vihoda nagmite Enter');
if (chain_form)
then for i:=1 to MassLen do
DrawDomino(40+45*i,40,i)
else
OutTextXY(20, 40, 'Chepochku sformirovat ne udalos');
ReadLn;
CloseGraph;
end
else
Writeln('Graphics error:', GraphErrorMsg(ErrCode));
end.
