Игра в слова.

[valiaam55]

Игра в слова. В файле на диске содержится словарь. Случайным образом из него выбирается слово и выводится на экран. Игроки поочередно вводят с клавиатуры составленные слова. Программа проверяет, не использованы ли лишние буквы при составлении слова и не было ли оно уже введено одним из игроков ранее. В интерфейсе пользователя должна быть использована кнопка «Сдаюсь» одна на двух игроков.

[XeruH]

Ты вопрос забыл задать! =)

[valiaam55]

Народ, помогите пожалуйста из за этой программы девчонка стоит на отчислении(( Единственная надежда на вас.

XeruH надо программу составить.

[XeruH]

без графического интерфейса и без некоторых проверок, но должен работать (хотя не проверял).

program Game;

const
  DictionaryFileName = 'dictionary.wdc';

var
  f: Text;
  word, playerWord, dir: string;
  allwords, inputedWords: array of string;
  i,c,correctWord, player1words, player2words: Integer;
  gameover: boolean;
  curPlayer: integer;

begin
  randomize;
  GetDir(0,Dir);
  {$I-}
  Assign(f, Dir+'\'+DictionaryFileName);
  Reset(f);
  {$I+}  	{отключить внутреннюю проверку}
  if IOResult <> 0 then
  begin
    Writeln('Файл ', Dir+'\'+DictionaryFileName, ' не найден!. Программа будет закрыта!');
    readln;
    Exit;
  end;
  i:=0;
  while not EOF(f) do
  begin
    readln(f, word);
    if Length(word)>0 then
    begin
      SetLength(allwords, i+1);
      allwords[i]:=word;
      inc(i);
    end;
  end;
  Close(f);

  if i<1 then
  begin
    writeln('Файл ', DictionaryFileName, ' не содержит слов. Программа будет закрыта!');
    readln;
    Exit;
  end;

  c:=0;
  if i=1 then
    c:=1
  else
    c:=random(i);

  word := allwords[c];

  gameover := false;

  writeln('Для выхода напишите слово exit');
  writeln('Слово: ',word);
  curPlayer := 1;
  player1words := 0;
  player2words := 0;
  SetLength(inputedWords, 0);
  while not gameover do
  begin
    correctWord := 0;
    write('Игрок ',curPlayer,' введите ваше слово: ');
    readln(playerWord);

    if playerWord = 'exit' then
    begin
      gameover := true;
      Break;
    end;

    for i:=1 to Length(playerWord) do
      if pos(playerWord[i], word) = 0 then
      begin
        correctWord := 1;
        break;
      end;

    for i:=0 to Length(inputedWords)-1 do
      if inputedWords[i] = playerWord then
      begin
        correctWord := 2;
        break;
      end;

    if correctWord=0 then
    begin
      c:=Length(inputedWords)+1;
      SetLength(inputedWords,c);
      inputedWords[c-1] := playerWord;
      case curPlayer of
        1: begin
             curPlayer := 2;
             inc(player1words);
           end;
        2: begin
             curPlayer := 1;
             inc(player2words);
           end;
      end;
      Continue;
    end else
    begin
      case correctWord of
        1: writeln('Ошибка! Слово содержит символы не встречающие в исходном слове!');
        2: writeln('Ошибка! Данное слово уже использовалось!');
      end;
      Continue;
    end;

  end;

  if player1words > player2words then writeln('Выиграл Игрок 1 у него ', player1words, ' слов против ', player2words, ' слов у Игрока 2');
  if player2words > player1words then writeln('Выиграл Игрок 2 у него ', player2words, ' слов против ', player1words, ' слов у Игрока 1');
  if player1words = player2words then writeln('Ничья у обоих игроков по ', player1words, ' слов');
  writeln('Для выхода нажмите любую клавишу');
  readln;
end.

P$ А если девушка ничего не понимает и учится не на программиста, то лучше пускай заказывает ее за деньги.

[valiaam55]

XeruH, спасибо тебе огромное, я ей передам твои слова, да и надеюсь она сама это поняла.

[XeruH]

Не за что! Но почитать книжки советую. Хотя б для того чтоб понимать что тут делается. А то мало ли, вдруг преподаватель попросит рассказать.

[valiaam55]

надеюсь, что она за эту ночь что нибудь поймет. У нее завтра последний день, когда можно будет сдать.