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

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

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

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 28.09.2010, 09:06   #1
Kom43l_KoT
Новичок
Джуниор
 
Регистрация: 28.09.2010
Сообщений: 1
Восклицание Пятнашки

Помогите пожалуйста нужно чтобы пользователь в начале или во время игры мог сам задавать размеры поля и кол-во цифр вот код
Код:
type Tfish = TButton; // указываем тип наших фишек
const
    NXM :=InputBox('Изменение размера станд. размер 5',
                  'Укажите размер поля и щелкните на OK.', '');
    if NXM <> ''
    then

  W = 80; // ширина фишки
  D = 10; // растояние между фишками
  L = D + W; // растояние между "х" у фишек
  NXM = 4; // размер поля 4х4
  N = 1; M = 16; // размерность массива фишек
  POLET = 10; POLEL = 10; //начальные позиции поля фишек на форме
  prefix = 'Fishka';

var
  Form1: TForm1;
  btn: array[N..M] of Tfish;
  sorseAr: array[N..M] of boolean;
  zeroX, zeroY: integer;
  XYmatrix: array[1..M, 1..2] of integer;

implementation

{$R *.dfm}

//размер формы

procedure FormSize;
begin
  Form1.Width := (POLEL * 2) + (L * NXM);
  Form1.Height := (L * NXM) + POLET + 50;
end;

procedure TForm1.FormCreate(Sender: TObject);
var i, ty, lx: integer;
begin
  randomize; i := 0;
   // заполняем массив коорденатами на которые будут случайным образом ставиться
   // фишки при начале новой игры
  ty := POLET; lx := POLEL;
  for i := N to M do begin
    XYmatrix[i, 1] := lx;
    XYmatrix[i, 2] := ty;
    lx := lx + L;
    if i mod NXM = 0 then begin
      ty := ty + L;
      lx := POLEL;
    end;
  end;
  FormSize();
end;


procedure TForm1.FormShow(Sender: TObject);
begin
  CreatFishkas();
end;

// пункт меню - "новая игра"

procedure TForm1.N1Click(Sender: TObject);
begin
  KillOldFihkas();
  FormSize();
  CreatFishkas();
end;



function dump(): boolean;
var i: integer;
begin
  i := 0;
  for i := N to M do
    sorseAr[i] := true; ;
end;

// непосредственно алгоритм выборки неповторяющихся значений случайным образом

function choose(): integer;
var i: integer;
begin
  i := 0;
  result := random(M) + 1;
  while sorseAr[result] = false do
    result := random(M) + 1;
  sorseAr[result] := false;
end;

procedure TForm1.CreatFishkas;
// НОВАЯ ИГРА, создание игрового поля
var
  i, ty, lx, ch: integer;
begin
  randomize;
  dump();
 // But.Enabled:=false; BitBtn1.Enabled:=true; BitBtn2.Enabled:=true;
  ty := POLET; lx := POLEL;
  for i := N to M do begin

    btn[i] := Tfish.Create(Self);
    btn[i].Width := W;
    btn[i].Height := W;
    btn[i].Font.Size := 26;
    btn[i].Font.Style := [fsBold];

    ch := choose(); // получаем случайным образом число 1-16, числа не повторяются

    btn[i].Left := XYmatrix[ch, 1]; // получаем коорденату Х
    btn[i].Top := XYmatrix[ch, 2]; // получаем коорденату У
    btn[i].Tag := ch; // в Tag будем держать текущее положение фишки
    btn[i].Name := prefix + inttostr(i);

    if i <> M then begin
      btn[i].Caption := inttostr(i);
      btn[i].OnClick := ButClicked;
    end else begin // это пустая кнопка, без каптион и обработчика OnClick
      btn[i].Caption := '';
      zeroX := btn[i].Left; zeroY := btn[i].Top;
    end;

    btn[i].Parent := Self;

  end;
end;


// определяет позицию на которой стоит фишка в данный момент по ее коорденатам

function TForm1.position(const x, y: integer): integer;
var i: integer;
begin
  i := 0;
  result := -32;
  for i := N to M do begin
    if ((XYmatrix[i, 1] = x) and (XYmatrix[i, 2] = y)) then begin
      result := i; break;
    end;
  end;
end;


// перемешение фишки на новую позицию

procedure TForm1.ButClicked(Sender: TObject);
var X, Y, ps: integer;
begin
  X := Tfish(Sender).left; Y := Tfish(Sender).Top;
  if ((X = zeroX + L) and (Y = zeroY)) or
    ((X = zeroX - L) and (Y = zeroY)) or
    ((X = zeroX) and (Y = zeroY + L)) or
    ((X = zeroX) and (Y = zeroY - L)) then begin

    Tfish(Sender).Left := zeroX;
    Tfish(Sender).Top := zeroY;

    Tfish(FindComponent(prefix + inttostr(M))).left := X;
    Tfish(FindComponent(prefix + inttostr(M))).top := Y;

    ps := position(zeroX, zeroY);
    if ps <> -32 then
      Tfish(Sender).Tag := ps else
      ShowMessage('Ошибка в логике проги. КООРДЕНАТЫ');
    zeroX := X; zeroY := Y;
    victopia(); // проверка - ПОБЕДА или играем дальше
  end;
end;
// проверка - ПОБЕДА или играем дальше...
procedure TForm1.victopia;
var i: integer; b: boolean;
begin
  b := true; i := 0;
  for i := N to M - 1 do
  begin
    if strtoint(Tfish(FindComponent(prefix + inttostr(i))).Caption) <>
      Tfish(FindComponent(prefix + inttostr(i))).Tag then
    begin
      b := false; break;
    end;
  end;
  if b then ShowMessage('Вы побелили');
end;

procedure TForm1.KillOldFihkas;
// уничтожаем кнопки-фишки, нужно перед началом новой игры
var i: integer;
begin
  for i := N to M do
    FreeAndNil(btn[i]);
end;
procedure TForm1.N2Click(Sender: TObject);
begin
  Application.Terminate();
end;
procedure TForm1.N3Click(Sender: TObject);
begin
ShowMessage(' ******* гр. /////01');

end;

end.
Вложения
Тип файла: zip исходник.zip (2.2 Кб, 16 просмотров)

Последний раз редактировалось Kom43l_KoT; 28.09.2010 в 09:09. Причина: Добавлен исходник
Kom43l_KoT вне форума Ответить с цитированием
Ответ


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



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Нужно написать 3 игры в консоли на С++: морской бой, пятнашки и крестики-нолики... lewa2424 Помощь студентам 5 14.04.2010 21:33
Пятнашки решение arccariy Фриланс 2 06.12.2009 21:10
Игра пятнашки... Мамука Общие вопросы .NET 0 03.11.2009 23:25
Делфи. создать автосбор для игры пятнашки? САБИНЭЙШН Помощь студентам 1 28.10.2009 20:56
Delphi игра пятнашки rumf Помощь студентам 14 31.05.2008 00:56