Форум программистов, компьютерный форум, киберфорум
Наши страницы

Free Pascal

Войти
Регистрация
Восстановить пароль
 
DmitryStrs
0 / 0 / 0
Регистрация: 23.03.2017
Сообщений: 4
#1

Написать программу игры в кости - Free Pascal

23.03.2017, 23:34. Просмотров 331. Ответов 4

Написать программу игры в кости по следующим правилам: играющий (их число не больше 4) называет (вводит в ЭВМ) целое число А от 1 до 6. Затем генерируются 3 случайных числа от 1 до 6 (т.е. бросаются кости) если среди 3х сгенерированных чисел число А встретилось 1 раз - игрок получает 5 очков, если 2 раза - 10 очков, 3 раза - 15 очков, не встретилось ни разу - 0 очков. Кости кидаются по очереди каждым из участников. Победитель тот, кто набрал больше всех очков.
0
Лучшие ответы (1)
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
23.03.2017, 23:34
Я подобрал для вас темы с готовыми решениями и ответами на вопрос Написать программу игры в кости (Free Pascal):

Написать исходник игры Быки и Коровы - Free Pascal
Условия вроде такие: комп загадывает число (4 знака), а человек пытается отгадать. Но человек предлагает свой вариант числа, а комп...

Составить блок-схему и программу вычисления значения функции + написать программу - Pascal
Прошу решить в качестве проверки. Нужно сдать в понедельник. Буду очень благодарен! Заранее СПАСИБО!!! Номера: 7, 8, 17 (а)

Составить блок-схему алгоритма и программу для задачи игры в карты - Pascal
Колода из 36 карт от 6 до туза хорошо перемешана. Картам от Вольта до туза присвоено число очков от 11 до 14. Игрок берет из колоды 3...

Логическая функция(кости домино) - Pascal
1.Написать логическую функцию которая проверяет: Равна ли правая цифра кости левой цифре следующей кости. 2.И еще проблема с задачей: ...

Возможно ли разделить кости домино на 2 комплекта (сумма всех чисел на костях должна быть равной)? - Pascal
нужна программа, которая проверяет, возможно ли разделить 34 кости домино, включая все варианты костей от нуль - нуль до шесть - шесть, на...

Написать программу - Pascal
На отрезке методом перебора с шагом 0,05 определить максимум функции S(t)= при k=0,5.

4
Hitoku
Модератор
1687 / 1286 / 671
Регистрация: 28.10.2016
Сообщений: 4,197
Завершенные тесты: 4
24.03.2017, 00:36 #2
Лучший ответ Сообщение было отмечено автором темы, экспертом или модератором как ответ
Вроде этого?
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
var
a,i,k,j,r,win:integer;
t:array [1..4] of integer;
begin
  randomize;
  repeat
    write('Количество участников (1-4): '); readln(k);
  until k<=4;
  for i:=1 to k do begin
    repeat
      writeln(i,' игрок введите число (1-6): '); readln(a);
    until a<=6;
    t[i]:=0;
    for j:=1 to 3 do begin
      r:=random(6)+1;
      if r=a then t[i]:=t[i]+5;
      write(r,' ');
    end;
    writeln;
  end;
  win:=t[1];
  for i:=2 to k do
    if t[i]>win then win:=t[i];
  if win>0 then
    for i:=1 to k do //на случай, если несколько победивших
      if t[i]=win then writeln(i,' игрок победил')
    else writeln('Победителя нет');
end.
1
DmitryStrs
0 / 0 / 0
Регистрация: 23.03.2017
Сообщений: 4
24.03.2017, 01:03  [ТС] #3
Спасибо!
0
Joy
Эксперт Pascal/Delphi
2112 / 1152 / 872
Регистрация: 29.08.2014
Сообщений: 4,211
24.03.2017, 11:07 #4
немного графики:
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
{$mode Delphi} 
uses Graph,wincrt, SysUtils;
procedure Kub(i,x0,y0,xs,ys,r:integer;redraw:boolean;l:integer=0;m:integer=0;rec:integer=0);
procedure point(x,y,r:integer;k:integer=0);
var
  color:word;
begin
  if k=1 then  color:=Black else color:=darkGray;
  SetColor(color);
  setfillstyle(SolidFill,color);
  circle(x,y,r);
  floodfill(x,y,color);
  SetColor(White);
  Circle(x-r div 2,y-r div 2,r div 5);
  setfillstyle(SolidFill,white);
  if r div 5>1 then floodfill(x-r div 2,y-r div 2,white);
end;
begin
  if redraw then begin
    MoveTo(xs+x0,ys+y0 div 2);
    LineTo(xs+x0 div 2,ys+y0);
    LineTo(xs+x0,ys+y0+y0 div 2);
    LineTo(xs+x0+x0 div 2,ys+y0);
    LineTo(xs+x0,ys+y0 div 2);
    MoveTo(xs+x0 div 2,ys+y0);
    LineTo(xs+x0 div 2,ys+2*y0);
    LineTo(xs+x0,ys+2*y0+y0 div 2);
    LineTo(xs+x0+x0 div 2,ys+2*y0);
    LineTo(xs+x0+x0 div 2,ys+y0);
    Line(xs+x0, ys+y0+y0 div 2,xs+x0,ys+2*y0+y0 div 2);
    setfillstyle(SolidFill,White);
    FloodFill(xs+x0,ys+y0,getcolor);
    setfillstyle(SolidFill,LightGray);
    FloodFill(xs+x0+x0 div 2-r,ys+y0+r,getcolor);
    FloodFill(xs+x0-x0 div 2+r,ys+y0+r,getcolor)
  end;
   case i of
    1:begin point(xs+x0,ys+y0,r,1);
        case random(4)+rec of
          0:kub(0,x0,y0,xs,ys,r,false,5,4);
          1:kub(0,x0,y0,xs,ys,r,false,4,3);
          2:kub(0,x0,y0,xs,ys,r,false,3,2);
          3:kub(0,x0,y0,xs,ys,r,false,2,5);
        end;
      end;
    2:begin point(xs+x0 div 2+6*r,ys+y0,r,1); point(xs+x0+x0 div 2-6*r,ys+y0,r,1);
        case random(4)+rec of
          0:kub(0,x0,y0,xs,ys,r,false,5,1);
          1:kub(0,x0,y0,xs,ys,r,false,1,3);
          2:kub(0,x0,y0,xs,ys,r,false,3,6);
          3:kub(0,x0,y0,xs,ys,r,false,6,5);
        end;
      end;
    3:begin kub(2,x0,y0,xs,ys,r,false,0,0,10);kub(1,x0,y0,xs,ys,r,false,0,0,10);
        case random(4)+rec of
          0:kub(0,x0,y0,xs,ys,r,false,4,6);
          1:kub(0,x0,y0,xs,ys,r,false,6,2);
          2:kub(0,x0,y0,xs,ys,r,false,2,1);
          3:kub(0,x0,y0,xs,ys,r,false,1,4);
        end;  
      end;
    4:begin kub(2,x0,y0,xs,ys,r,false,0,0,10);point(xs+x0,ys+y0+y0 div 2-r*3,r,1);point(xs+x0,ys+y0-y0 div 2+r*3,r,1);
        case random(4)+rec of
          0:kub(0,x0,y0,xs,ys,r,false,5,6);
          1:kub(0,x0,y0,xs,ys,r,false,6,3);
          2:kub(0,x0,y0,xs,ys,r,false,3,1);
          3:kub(0,x0,y0,xs,ys,r,false,1,5);
        end;  
      end;
    5:begin kub(1,x0,y0,xs,ys,r,false,0,0,10);kub(4,x0,y0,xs,ys,r,false,0,0,10);
        case random(4)+rec of
          0:kub(0,x0,y0,xs,ys,r,false,2,6);
          1:kub(0,x0,y0,xs,ys,r,false,6,4);
          2:kub(0,x0,y0,xs,ys,r,false,4,1);
          3:kub(0,x0,y0,xs,ys,r,false,1,2);
        end;
      end;
    6:begin
       kub(4,x0,y0,xs,ys,r,false,0,0,10);
       point(xs+(x0 div 2+6*r+x0) div 2, ys+(2*y0+y0 div 2-r*3) div 2,r,1);
       point(xs+(x0 div 2-6*r+2*x0) div 2, ys+(2*y0-y0 div 2+r*3) div 2,r,1);
        case random(4)+rec of
          0:kub(0,x0,y0,xs,ys,r,false,2,3);
          1:kub(0,x0,y0,xs,ys,r,false,3,4);
          2:kub(0,x0,y0,xs,ys,r,false,4,5);
          3:kub(0,x0,y0,xs,ys,r,false,5,2);
        end;  
    end;
  end;
  case l of
    1:point(xs+(2*x0-x0 div 2) div 2,ys+(3*y0+y0 div 2) div 2,r);
    2:begin point(xs+x0-x0 div 2+2*r,ys+y0+3*r,r);point(xs+x0-2*r,ys+2*y0+y0 div 2-3*r,r);end;
    3:begin kub(0,x0,y0,xs,ys,r,false,1);kub(0,x0,y0,xs,ys,r,false,2);end;
    4:begin kub(0,x0,y0,xs,ys,r,false,2);point(xs+x0-2*r,ys+y0+y0 div 2+2*r,r);point(xs+x0-x0 div 2+2*r,ys+2*y0-2*r,r);end;
    5:begin kub(0,x0,y0,xs,ys,r,false,1);kub(0,x0,y0,xs,ys,r,false,4);end;
    6:begin kub(0,x0,y0,xs,ys,r,false,4);point(xs+(2*x0-x0 div 2) div 2,ys+(2*y0+y0 div 2+5*r) div 2,r);point(xs+(2*x0-x0 div 2) div 2,ys+(4*y0+y0 div 2-5*r) div 2,r);end;
  end;
  case m of 
    1:point(xs+(2*x0+x0 div 2) div 2,ys+(3*y0+y0 div 2) div 2,r);
    2:begin point(xs+x0+x0 div 2-2*r,ys+y0+3*r,r);point(xs+x0+2*r,ys+2*y0+y0 div 2-3*r,r);end;
    3:begin kub(0,x0,y0,xs,ys,r,false,0,1);kub(0,x0,y0,xs,ys,r,false,0,2);end;
    4:begin kub(0,x0,y0,xs,ys,r,false,0,2);point(xs+x0+2*r,ys+y0+y0 div 2+2*r,r);point(xs+x0+x0 div 2-2*r,ys+2*y0-2*r,r);end;
    5:begin kub(0,x0,y0,xs,ys,r,false,0,1);kub(0,x0,y0,xs,ys,r,false,0,4);end;
    6:begin kub(0,x0,y0,xs,ys,r,false,0,4);point(xs+(2*x0+x0 div 2) div 2,ys+(2*y0+y0 div 2+5*r) div 2,r);point(xs+(2*x0+x0 div 2) div 2,ys+(4*y0+y0 div 2-5*r) div 2,r);end;
  end;
end;
 
procedure TextXY(s:string;color,x,y:word);
begin
  setcolor(color);
  moveto(x,y*textheight('W'));
  outtext(s);
end;
 
var
  x0,y0,xs,ys,r,i,j,k,l:integer;
  gd,gm:smallint;
  t:array[1..4] of integer;
  begin
    gd:=detect;
    gm:=0;
    initgraph(gd,gm,'');
    randomize;
    x0:=300;y0:=150;r:=15;xs:=getmaxx div 2;ys:=getmaxy div 2;
    setfillstyle(1,green);
    FloodFill(150,150, 2);
    setcolor(darkgray);
    kub(Random(6)+1,x0,y0,xs,ys,r,true);
    SettextStyle(SansSerifFont, HorizDir,3);
    TextXY('Enter number of players[1..4]:',Yellow,1,1);
    repeat i:=ord(readkey)-48; until (i>0) and (i<5);
    setcolor(LightRed);
    outtext(chr(i+48));
    x0:=100;y0:=50;r:=5;
    for i:=1 to i do begin
      TextXY('Player:'+chr(i+48)+' you bet(1..6):',Yellow,1,i*6);
    repeat k:=ord(readkey)-48;  until (k>0) and (k<7);
      outtext(chr(k+48));
      ys:=getY;xs:=1;
    for j:=1 to 3 do begin
      l:=random(6)+1;
      if l=k then setcolor(LightBlue) else setcolor(LightRed);
      inc(t[i],5*ord(l=k));
      kub(l,x0,y0,xs+x0*j+10*j,ys,r,true);
    end;
      textxy('Score:'+inttostr(t[i]),Magenta,getx+x0,i*6);
    end;
    repeat until readkey=#27;
end.
1
bormant
Модератор
Эксперт Pascal/DelphiЭксперт NIX
3749 / 2446 / 1306
Регистрация: 22.11.2013
Сообщений: 6,788
24.03.2017, 17:49 #5
Joy,
а если бы структура программы (разбиение на подпрограммы) была выбрана правильно, то замена отображения, например, на псевдографику, скажем на такую:
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
function YachtR(n, r: Word): String;
const
  y: array [1..6] of Byte = (8,34,42,99,107,119);
  c: array [Boolean] of Char = ' o';
var s: String[9];
begin
  n:=y[n];
  case r of
  0,4: s:='+-------+';
  1:   s:='| '+c[n and $1<>0]+'   '+c[n and $2<>0]+' |';
  2:   s:='| '+c[n and $4<>0]+' '+c[n and $8<>0]+' '+c[n and $10<>0]+' |';
  3:   s:='| '+c[n and $20<>0]+'   '+c[n and $40<>0]+' |';
  else s:='';
  end;
  YachtR:=s;
end;
var i, j: Integer;
begin
  for i:=0 to 4 do begin
    for j:=1 to 6 do Write(' ',YachtR(j,i)); WriteLn;
  end;
end.
Код
 +-------+ +-------+ +-------+ +-------+ +-------+ +-------+
 |       | |     o | |     o | | o   o | | o   o | | o   o |
 |   o   | |       | |   o   | |       | |   o   | | o   o |
 |       | | o     | | o     | | o   o | | o   o | | o   o |
 +-------+ +-------+ +-------+ +-------+ +-------+ +-------+
не составляла бы труда
2
24.03.2017, 17:49
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
24.03.2017, 17:49
Привет! Вот еще темы с ответами:

Написать программу - Pascal
Дано действительное число х.Вычислить: (x-1)(x-3)(x-7)...(x-63) и всё делить на (x-2)(x-4)(x-8)...(x-64)

Написать программу - Pascal
Извиняюсь, если ошибся темой. Помогите пожалуйста написать, если вам не сложно. С клавиатуры ввести символы. Посчитать количество...

Написать программу - Pascal
Если целое число А делится нацело на число В, то вывести на экран частное от деления, в противном случае вывести на экран сообщение &quot;А на В...

Написать программу - Pascal
Учусь писать на Pascal.


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
5
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2018, vBulletin Solutions, Inc.
Рейтинг@Mail.ru