Форум программистов, компьютерный форум, киберфорум
VBA
Войти
Регистрация
Восстановить пароль
 
Рейтинг 5.00/6: Рейтинг темы: голосов - 6, средняя оценка - 5.00
0 / 0 / 0
Регистрация: 09.04.2015
Сообщений: 7
1

Нужно перевести код программы с Pascal (игра в карты)

09.04.2015, 05:09. Показов 1123. Ответов 3
Метки нет (Все метки)

Код программы на Pascal:

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
uses crt;
const kol:array[1..36] of string[3]=
('6п','7п','8п','9п','10п','Bп','Дп','Кп','Тп',
 '6т','7т','8т','9т','10т','Bт','Дт','Кт','Тт',
 '6б','7б','8б','9б','10б','Bб','Дб','Кб','Тб',
 '6ч','7ч','8ч','9ч','10ч','Bч','Дч','Кч','Тч');
var igr:array[1..6,1..6] of string[3];
    n,i,j,k:byte;
    m:set of byte;
    c:char;
begin
clrscr;
randomize;
repeat
write('Количество игроков от 2 до 6 n=');
readln(n);
until n in [2..6];
m:=[];
for i:=1 to n do
for j:=1 to 6 do
 begin
  repeat
   k:=1+random(36);
  until not(k in m);
  m:=m+[k];
  igr[i,j]:=kol[k];
 end;
if n=6 then c:=igr[n,6][length(igr[n,6])]
else
 begin
  k:=random(4);
  case k of
  0:c:='п';
  1:c:='т';
  2:c:='б';
  3:c:='ч';
  end;
 end;
writeln('Раздача карт');
for i:=1 to n do
 begin
  write('Игрок ',i);
  for j:=1 to 6 do
  write(igr[i,j]:4);
  writeln
 end;
write('Козыри ');
case c of
'п':write('пики');
'т':write('трефы');
'б':write('буби');
'ч':write('червы');
end;
readln
end.
Нужно перевести на VBA.
0
Лучшие ответы (1)
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
09.04.2015, 05:09
Ответы с готовыми решениями:

Нужно перевести код из Turbo Pascal в Pascal ABC.NET
Доброго времени суток. На форуме находил похожие темы, но к сожалению так и не смог разобраться....

Нужно перевести код с Pascal ABC на Turbo Pascal - рисование работающей мельницы
Вот код, он должен рисовать работающею мельницу. uses graphABC,crt; type point=record ...

Нужно перевести код из Turbo Pascal в Pascal ABC
Program n5; { Задача. Описать функцию less(f) от непустого файла f ...

Нужно перевести программы из Pascal в C
1. Дано трехзначное число. В этом числе зачеркнуть первую цифру справа и приписать его слева....

__________________
3
466 / 123 / 61
Регистрация: 04.03.2015
Сообщений: 325
09.04.2015, 19:16 2
Лучший ответ Сообщение было отмечено Hacker135 как решение

Решение

Цитата Сообщение от Hacker135 Посмотреть сообщение
Нужно перевести на VBA
Visual Basic
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
Option Base 1
 
Sub karti()
    Dim kol()
    kol = Array("6п", "7п", "8п", "9п", "10п", "Вп", "Дп", "Кп", "Тп", _
    "6т", "7т", "8т", "9т", "10т", "Вт", "Дт", "Кт", "Тт", _
    "6б", "7б", "8б", "9б", "10б", "Вб", "Дб", "Кб", "Тб", _
    "6ч", "7ч", "8ч", "9ч", "10ч", "Вч", "Дч", "Кч", "Тч")
 
    Dim igr(1 To 6, 1 To 6) As String
    Dim n As Byte, i As Byte, j As Byte, k As Byte
    Dim m As String
    Dim c As String * 1
    Randomize
    Do
        n = InputBox("Количество игроков от 2 до 6 n=")
    Loop Until n Like "[2-6]"
    m = ""
    For i = 1 To n
        For j = 1 To 6
            Do
                k = CByte(Rnd * 35 + 1)
            Loop Until InStr(m, CStr(k)) = 0
            m = m & " " & k
            igr(i, j) = kol(k)
        Next j
    Next i
    If n = 6 Then
        c = Right(igr(n, 6), 1)
      Else
        k = CByte(Rnd * 4)
        Select Case k
            Case 0: c = "п"
            Case 1: c = "т"
            Case 2: c = "б"
            Case 3: c = "ч"
        End Select
    End If
    m = ""
    For i = 1 To n
        m = m & "Игрок " & i
        For j = 1 To 6
            m = m & " " & igr(i, j)
        Next j
        m = m & vbCrLf
    Next i
    m = m & "Козыри "
    Select Case c
        Case "п": m = m & "пики"
        Case "т": m = m & "трефы"
        Case "б": m = m & "буби"
        Case "ч": m = m & "червы"
        Case Else: m = m & c
    End Select
    MsgBox ("Раздача карт " & vbCrLf & m)
End Sub
Постарался максимально приблизится к оригинальному коду.
1
0 / 0 / 0
Регистрация: 09.04.2015
Сообщений: 7
09.04.2015, 20:52  [ТС] 3
Большое спасибо за то, что выручили! Код просто идеален!
0
466 / 123 / 61
Регистрация: 04.03.2015
Сообщений: 325
09.04.2015, 23:32 4
Думаю стоит вот этот момент изменить
Pascal
1
2
3
repeat
   k:=1+random(36);
until not(k in m);
Когда у вас 6 игроков, то ждать рандома последних карт колоды можно очень долго. И вообще не дождаться можно.
0
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
09.04.2015, 23:32

Заказываю контрольные, курсовые, дипломные работы и диссертации здесь.

Нужно перевести код с Pascal
Program SINUS; Const MaxIter = 500; Var x, eps, y, c, xn, xk, dx : real; ...

Нужно перевести код, Pascal на С++
Pascal на С++ begin writeln('kolichestvo'); readln(m); writeln('elementi'); for i := 1 to...

Нужно перевести код из с++ в pascal
#include <iostream> #include <ctime> #include <cmath> using std::cout; using std::cin;...

Перевести код программы с pascal
Перевести на С++ uses crt; var n,i,s,c:integer; begin clrscr; readln(n); s:=0; ...


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

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

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