Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 20.04.2018, 15:38   #1
Trefal
Новичок
Джуниор
 
Регистрация: 20.04.2018
Сообщений: 5
По умолчанию Магический квадрат

Добрый день, можете ли помочь?Нужно что бы после конца игры можно было вернуться к начальному меню,а также само меню(примерно такое

Код:
uses 
GraphABC, ABCButtons;
 
var
  a, b, c: buttonabc;
 
procedure game;
begin
  clearwindow; 
  writeln('Игра'); 
end;
 
procedure tutorial;
begin
  clearwindow; end;
 
 
 
begin
  setwindowwidth(800); 
  setwindowheight(450); 
  b := new ButtonABC(250, 100, 200, 50, 'Игра', clAzure); 
  c := new ButtonABC(250, 200, 200, 50, 'Как играть', clAzure); 
  a := new ButtonABC(250, 300, 200, 50, 'Выход из игры', clAzure); 
  b.OnClick := game; 
  c.OnClick := tutorial;
  a.OnClick := closewindow; 
  
end.

Последний раз редактировалось Trefal; 20.04.2018 в 16:59.
Trefal вне форума Ответить с цитированием
Старый 20.04.2018, 16:09   #2
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию

начните с того, что код проверки возьмите тут - http://programmersforum.ru/showthread.php?t=318915

какой у Вас Pascal ABC ?
Serge_Bliznykov вне форума Ответить с цитированием
Старый 20.04.2018, 16:15   #3
Trefal
Новичок
Джуниор
 
Регистрация: 20.04.2018
Сообщений: 5
По умолчанию

Цитата:
Сообщение от Serge_Bliznykov Посмотреть сообщение
начните с того, что код проверки возьмите тут - http://programmersforum.ru/showthread.php?t=318915

какой у Вас Pascal ABC ?
PascalABC.net
Зачем мне код для проверки?
Тут уже работает все,я же написал что нужно меню,ограничение и после победы возвращение в это самое меню
Trefal вне форума Ответить с цитированием
Старый 20.04.2018, 16:48   #4
Trefal
Новичок
Джуниор
 
Регистрация: 20.04.2018
Сообщений: 5
По умолчанию

Так,ограничение сделал
Trefal вне форума Ответить с цитированием
Старый 20.04.2018, 16:48   #5
Trefal
Новичок
Джуниор
 
Регистрация: 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.

Последний раз редактировалось Trefal; 20.04.2018 в 16:52.
Trefal вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Магический квадрат ПрИуЭт Общие вопросы C/C++ 0 04.01.2012 13:47
Магический квадрат VIK_aka_TOR Помощь студентам 1 15.04.2011 23:53
C++ Магический квадрат Alexey23 Помощь студентам 1 09.12.2010 23:58
Магический квадрат sigmanen Общие вопросы C/C++ 1 12.11.2010 22:40
Магический квадрат Гаджи Помощь студентам 5 24.10.2009 09:46