Новичок
Джуниор
Регистрация: 20.04.2018
Сообщений: 5
|
Меню
Как сделать меню с кнопками(кликабельными),типа играть,правила,выход
и запихнуть туда этот код
Код:
program qwerty;
uses graphABC;
var
b: array[,] of integer;
N, m, dx, dy, xK, yK: integer;
ReadKey: boolean := false;
str: string;
function checkXY: boolean;
var
s: integer := 0;
i: integer;
begin
for i := 0 to N - 1 do
begin
if b[i, i] = 0 then
begin
checkXY := s < m;
Exit;
end;
s := s + b[i, i];
end;
if s = m then
begin
s := 0;
for i := 0 to N - 1 do
begin
if b[i, N - i - 1] = 0 then
begin
checkXY := s < m;
Exit;
end;
s := s + b[i, N - i - 1];
end;
end;
checkXY := s = m;
end;
function checkX(x: integer): boolean;
var
s: integer := 0;
i: integer;
begin
for i := 0 to N - 1 do
begin
if b[i, x] = 0 then
begin
checkX := s < m;
Exit;
end;
s := s + b[i, x];
end;
checkX := s = m;
end;
function checkY(y: integer): boolean;
var
s: integer := 0;
i: integer;
begin
for i := 0 to N - 1 do
begin
if b[y, i] = 0 then
begin
checkY := s < m;
Exit;
end;
s := s + b[y, i];
end;
checkY := s = m;
end;
function checkB(c: array of integer): boolean;
var
i, x, y, sz, k: integer;
yes: boolean := false;
z: array of integer;
begin
for i := 0 to N * N - 1 do
begin
x := i mod N;
y := i div N;
yes := b[y, x] = 0;
if yes then break;
end;
if not yes then
begin
checkB := true;
Exit;
end;
sz := Length(c);
z := Copy(c);
for i := 0 to sz - 1 do
begin
b[y, x] := c[i];
yes := checkX(x) and checkY(y) and checkXY;
if yes then
if sz > 1 then
begin
for k := i to sz - 2 do
c[k] := c[k + 1];
SetLength(c, sz - 1);
yes := checkB(c);
c := Copy(z);
end;
b[y, x] := 0;
if yes then
begin
checkB := true;
Exit;
end;
end;
checkB := false;
end;
procedure KeyDown(key: integer);
var
i, k, s0, s1: integer;
begin
if key = VK_Escape then CloseWindow;
if ReadKey then
if key <> 13 then
begin
if key = 8 then
begin
if Length(str) > 0 then
str := LeftStr(str, Length(str) - 1);
end
else
if Length(str) < 4 then
str += Char(key);
FillRectangle(500, 5, 700, 30);
TextOut(500, 5, Format('Число:{0}', str));
end
else
begin
ReadKey := false;
try
b[yK, xK] := StrToInt(str);
except
b[yK, xK] := 0;
end;
FillRectangle(500, 5, 700, 30);
FillRectangle(xK * dx, dy + yK * dx, xK * dx + dx, dy + yK * dx + dx);
Rectangle(xK * dx, dy + yK * dx, xK * dx + dx + 1, dy + yK * dx + dx + 1);
TextOut(xK * dx + 5, dy + yK * dx + 5, IntToStr(b[yK, xK]));
s0 := 0;
s1 := 0;
for i := 0 to N - 1 do
begin
s0 += b[i, i];
s1 += b[i, N - i - 1];
end;
if(s0 = m) and (s1 = m) then
for i := 0 to N - 1 do
begin
s0 := 0;
s1 := 0;
for k := 0 to N - 1 do
begin
s0 += b[k, i];
s1 += b[i, k];
end;
if(s0 <> m) or (s1 <> m) then break;
end;
if(s0 = m) and (s1 = m) then
TextOut(400, 5, 'Все верно.Вы победили!')
end;
end;
procedure MouseDown(xm, ym, mb: integer);
begin
if not ReadKey then;
if(xm < N * dx) and (ym > dy) and (ym < dy + N * dx) then
begin
xK := xm div dx;
yK := (ym - dy) div dx;
str := IntToStr(b[yK, xK]);
ReadKey := true;
TextOut(500, 5, Format('Число:{0}', str));
end;
end;
var
width, height: integer;
i, nN: integer;
a, c: array of integer;
l, k, x, y, z: integer;
yes: boolean;
begin
Write('Размер квадрата N>2 и 15<N(Конец при неправильных данных):');
ReadLn(N);
WriteLn(N);
if n > 15 then exit;
write('Количество заранее заполненных чисел:');
ReadLn(nN);
if nN > N * N then nN := N * N;
WriteLn(nN);
width := 670;
height := 705;
SetWindowSize(width, height);
SetWindowTop(0);
dx := Round((width - 3) / N);
dy := 35;
for i := 0 to N do
begin
Line(i * dx, dy, i * dx, dy + dx * N);
Line(0, dy + i * dx, dx * N, dy + i * dx);
end;
SetLength(a, N * N);
SetLength(b, N, N);
for i := 1 to N * N do
begin
a[i - 1] := i;
b[(i - 1) div N, (i - 1) mod N] := 0;
end;
m := (N * (N * N + 1)) div 2;
Randomize;
SetFontSize(15);
for i := 1 to nN do
begin
k := Random(Length(a));
z := a[k];
l := Length(a) - 1;
for k := k to l - 1 do
a[k] := a[k + 1];
SetLength(a, l);
repeat
repeat
l := Random(N * N);
x := l mod N;
y := l div N;
until b[y, x] = 0;
b[y, x] := z;
c := Copy(a);
yes := (N > 4) or (checkB(c));
if not yes then
b[y, x] := 0
else
begin
SetFontColor(clRed);
TextOut(x * dx + 5, dy + y * dx + 5, Format('{0}', z));
end;
until yes;
end;
SetFontColor(clBlack);
OnKeyDown := KeyDown;
OnMouseDown := MouseDown;
end.
|