Форум программистов, компьютерный форум, киберфорум
PascalABC.NET
Войти
Регистрация
Восстановить пароль
Блоги Сообщество Поиск Заказать работу  
 
Рейтинг 4.83/6: Рейтинг темы: голосов - 6, средняя оценка - 4.83
0 / 0 / 0
Регистрация: 16.05.2016
Сообщений: 31

Нужно переделать программу,написанную на Turbo Pascal в ту,чтобы работала на Pascal ABC.NET пожалуйста

23.11.2016, 13:28. Показов 1266. Ответов 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
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
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
program lab2;
 
uses
  Crt;
 
const
  Nmax = 15; { MAX element mnozestva A }
 
type
  T = Char; { Tip element mnozestva A }
  TPair = Record
    a, b: T;
  end;
  TSet = Array[1..Nmax] of T;
  TMatrix = Array[1..Nmax, 1..Nmax] of Byte;
 
procedure Sort(var A: TSet; const N: Integer);{ Sortirovka viborom po niubivaniy }
var
  i, j, k: Integer;
  tmp: T;
begin
  for i := 1 to N - 1 do begin
    k := i;
    for j := i + 1 to N do
      if A[j] < A[k] then k := j;
    tmp := A[i];
    A[i] := A[k];
    A[k] := tmp;
  end;
end;
 
function Search(const x: T; const A: TSet; const N: Integer): Integer;
{ Vozvrashenie index elementa x v A, esli elementa net to -1}
var
  i: Integer;
begin
  for i := 1 to N do
    if x = A[i] then begin
      Search := i;
      Exit;
    end;
  Search := -1;
end;
 
function Reflex(const M: TMatrix; const N: Integer): Boolean;{ proverka na reflexsivnost }
var
  i: Integer;
begin
  Reflex := False;
  for i := 1 to N do
    if M[i, i] = 0 then Exit;
  Reflex := True;
end;
 
function Symmetry(const M: TMatrix; const N: Integer): Boolean;{ proverka na semitrichnost }
var
  i, j: Integer;
begin
  Symmetry := False;
  for i := 1 to N - 1 do
    for j := i + 1 to N do
      if M[i, j] <> M[j, i] then Exit;
  Symmetry := True;
end;
 
function Antisymmetry(const M: TMatrix; const N: Integer): Boolean;{ proverka na antisimitrichnost }
var
  i, j: Integer;
begin
  Antisymmetry := False;
  for i := 1 to N do
    for j := 1 to N do
      if (i <> j) and (M[i, j] * M[j, i] <> 0) then Exit;
  Antisymmetry := True;
end;
 
function Transit(const M: TMatrix; const N: Integer): Boolean;
{ proverka na tranzivnost}
var
  i, j, k: Integer;
  S: TMatrix;
begin
  Transit := False;
  for i := 1 to N do
    for j := 1 to N do begin
      S[i, j] := 0;
      for k := 1 to N do
        S[i, j] := S[i, j] or M[i, k] and M[k, j];
    end;
  for i := 1 to N do
    for j := 1 to N do
       if M[i, j] < S[i, j] then Exit;
  Transit := True;
end;
 
procedure Keys; 
{ Vivod klavish }
begin
  ClrScr;
  WriteLn('Viberite deistvie');
  WriteLn;
  WriteLn('1 - spisok elementov mnozestva A');
  WriteLn('2 - spisok par binarnogo otnoshenia');
  WriteLn('3 - matrica binarnogo otnoseniya');
  WriteLn('4 - svoistva binarnogo otnosheniya');
  WriteLn('5 - izmenit 1 paru binarnogo otnosheniya');
  WriteLn('6 - udalit 1 paru binarnogo otnosheniya ');
  WriteLn('7 - dobavit paru binarnogo otnosheniya');
  WriteLn('0 - Ochistit konsol');
  WriteLn('Esc - Zavershit');
  WriteLn
end;
 
var
  i, j, N, k, z: Integer;
  x, y: T;  
  A: TSet;  
  M: TMatrix;
  P: Array[1..Nmax] of TPair;
  F: Boolean;
  v: Char;
begin
  ClrScr;
  WriteLn('Vvedite mnozestvo A -#cherez probel#-');
  N := 0;
  while not SeekEoLn do begin
    Inc(N);
    Read(A[N]);
  end;
  Sort(A, N);
  F := False;
  i := 1;
  while i < N do begin
    if A[i] = A[i + 1] then begin
      F := True;
      Dec(N);
      for j := i to N do
        A[j] := A[j + 1];
    end
    else
      Inc(i);
  end;
  if F then WriteLn('Povtoryayshiesa element udalen');
  for i := 1 to Nmax do
    for j := 1 to Nmax do
       M[i, j] := 0;
  WriteLn;
  WriteLn('Vvedite spisok par. Kazduy paru cherez probel, element par Probel');
  WriteLn(' Zavershenie vmesto vvoda par, vedite  Enter.');
  Reset(Input);
  k := 0;
  while not SeekEoLn do begin
    Read(x);
    if SeekEoLn then Reset(Input);
    ReadLn(y);
    if (Search(x, A, N) = -1) or (Search(y, A, N) = -1) then begin
       WriteLn('Element dolzen iz mnozestva A, eta para propushena');
       Continue;
    end;
    F := False;
    for i := 1 to k do
      if (P[i].a = x) and (P[i].b = y) then begin
         WriteLn('Para povtoryaetsa, Propusheno');
         F := True;
         Break;
      end;
    if F then Continue;
    M[Search(x, A, N), Search(y, A, N)] := 1;
    Inc(k);
    P[k].a := x;
    P[k].b := y;
  end;
  Keys;
  repeat
    v := ReadKey;
    case v of
    '1':
      begin
        WriteLn('Element mnozestva A:');
        for i := 1 to N do
          Write(A[i], ' ');
        WriteLn;
      end;
    '2':
      begin
        WriteLn('Spisok par binarnogo otnosheniya:');
        for i := 1 to k do
          WriteLn(i, '. (', P[i].a, ', ', P[i].b, ')');
      end;
    '3':
      begin
        WriteLn('Matrica binarnogo otnosheniya:');
        Write('    ');
        for i := 1 to N do
          Write(A[i]:3, ' ');
        WriteLn;
        for i := 1 to N do
        begin
          Write(A[i]:3, ' ');
          for j := 1 to N do
            Write(M[i, j]:3, ' ');
          WriteLn;
        end;
      end;
    '4':
      begin
        WriteLn('Videnoe othoshenie');
        if Symmetry(M, N)     then  WriteLn('Simmetrichno')     else WriteLn('ne Simmetrichno ');
        if Antisymmetry(M, N) then  WriteLn('Antisimmetrichno') else WriteLn('ne antisimetrichno');
        if Reflex(M, N)       then  WriteLn('reflixsivno')     else WriteLn('ne reflexsivno');
        if Transit(M, N)      then  WriteLn('trazivno®')     else WriteLn('ne tranzivno');
      end;
    '5':
      begin
        WriteLn('Nomer par kotoruy izmenit');
        {$I-}
        ReadLn(z);
        {$I+}
        while IOResult <> 0 do begin
          WriteLn('Neverno, zanovo');
          {$I-}
          ReadLn(z);
          {$I+}
        end;
        if (z > k) or (z < 1) then
          WriteLn('Par net')
        else begin
          WriteLn('Vvedite novoe znachenie par cherez probel`');
          Reset(Input);
          Read(x);
          if SeekEoLn then Reset(Input);
          ReadLn(y);
          if (Search(x, A, N) = -1) or (Search(y, A, N) = -1) then
            WriteLn('Znachenie dolzn bit iz mnozestva A')
          else begin
            F := False;
            for i := 1 to k do
              if (P[i].a = x) and (P[i].b = y) then begin
                WriteLn('eta para uze bila');
                F := True;
                Break;
              end;
            if not F then begin
              M[Search(P[z].a, A, N), Search(P[z].b, A, N)] := 0;
              P[z].a := x;
              P[z].b := y;
              M[Search(x, A, N), Search(y, A, N)] := 1;
              WriteLn('Izmeneno');
            end;
          end;
        end;
      end;
    '6':
      begin
        WriteLn('Nomer par udaleniya');
        {$I-}
        ReadLn(z);
        {$I+}
        while IOResult <> 0 do begin
          WriteLn('Vvedwno neverno, Zanovo');
          {$I-}
          ReadLn(z);
          {$I+}
        end;
        if (z > k) or (z < 1) then
          WriteLn('ЌҐв в Є®© Ї ал')
        else begin
          M[Search(P[z].a, A, N), Search(P[z].b, A, N)] := 0; { “¤ «пҐ¬ Ї аг Ё§ ¬ ваЁжл }
          Dec(k);
          for i := z to k do  { Udalenie par iz spiska P }
            P[i] := P[i + 1];
          WriteLn('Udaleno');
        end;
      end;
    '7':
      begin
        WriteLn('Vvedite paru elementa cherez probel');
        Reset(Input);
        Read(x);
        if SeekEoLn then Reset(Input);
        ReadLn(y);
        if (Search(x, A, N) = -1) or (Search(y, A, N) = -1) then
          WriteLn('Znachenie dolzno bit iz mnozestva A, ne dobavleno')
        else begin
          F := False;
          for i := 1 to k do
            if (P[i].a = x) and (P[i].b = y) then begin
              WriteLn('Eta para uze est');
              F := True;
              Break;
            end;
          if not F then begin
            Inc(k);
            P[k].a := x;
            P[k].b := y;;
            M[Search(P[k].a, A, N), Search(P[k].b, A, N)] := 1;
          end;
        end;
        if not F then WriteLn('Dobavleno');
      end;
      '0': Keys;
    end;
  until v = #27;
end.
0
Programming
Эксперт
39485 / 9562 / 3019
Регистрация: 12.04.2006
Сообщений: 41,671
Блог
23.11.2016, 13:28
Ответы с готовыми решениями:

Нужно переделать программу,написанную на Turbo Pascal в ту,чтобы работала на Pascal ABC.NET пожалуйста
program lab3; uses Crt; const Output_File_Name = 'output.txt'; { ima faila dlya vivoda perestanovok } Nmax = 12; {...

Можно как-то переделать код из Turbo Pascal чтобы он работал в pascal abc.net?
Сделайте пожалуйста, я просто не вникаю uses Graph, Crt; var grDriver: integer; grMode: integer; ErrCode: integer; ...

Нужно перевести программу с Turbo Pascal в Pascal ABC.NET
Вот есть программный код , но он для турбо паскаля, помогите перевести его в АБС.NET Program graphics; uses graph; var...

2
Супер-модератор
Эксперт Pascal/DelphiАвтор FAQ
 Аватар для volvo
33190 / 21486 / 8233
Регистрация: 22.10.2011
Сообщений: 36,869
Записей в блоге: 12
23.11.2016, 13:32
Задание озвучь. Никому это на фиг не нужно, разбираться без задания в коде, если его больше 300 строк.
0
0 / 0 / 0
Регистрация: 16.05.2016
Сообщений: 31
23.11.2016, 13:43  [ТС]
Дано конечное множество A. Требуется сгенерировать все возможные перестановки его элементов в лексикографическом порядке (по материалам главы 1, п. 1.3.6, и главы 2, п. 2.2.1). Требования к заданию множества – в нем не должно быть повторяющихся элементов, кроме того, удобнее использовать или только буквы, или только цифры.
Программа должна сначала упорядочить все элементы заданного множества по возрастанию (это первый – минимальный – набор), затем – посредством МИНИМАЛЬНО ВОЗМОЖНЫХ ПЕРЕСТАНОВОК! – сгенерировать последовательно возрастающие (лексикографически) наборы, вплоть до последнего, в котором все элементы упорядочены по убыванию.
Следует оценивать количество возможных перестановок и в случае, если они не поместятся на экран, выполнять их вывод в файл с выдачей на экран соответствующей информации для пользователя и выполнять поэкранный вывод с ожиданием нажатия клавиши.
Дополнительно: Предоставить пользователю возможность выбора другого варианта работы программы, в котором за исходную точку упорядочивания наборов выбирается не минимальный набор, а набор в таком порядке, как он задан пользователем.
Возможный алгоритм решения (Пример: множество А={1, 2, 3, 4, 5, 6}, |A| = n):
Предположим, что уже построено m наборов. Тогда для получения m+1-го набора:
1. Выполняется проверка последнего (m-го) набора на наличие в его конце некоторого количества символов, упорядоченных по убыванию – пусть это символы ak+1…an.
 3 5 2 6 4 1 – k=3, символы с 4-го по 6-й упорядочены по убыванию.
2. Если такое k найдено, то поменять местами k-й элемент и наименьший элемент из ak+1…an, больший этого ak.
В нашем примере это 2 и 4:  3 5 4 6 2 1 (это промежуточный набор).
3. После шага 2 упорядочить элементы с k+1-го до последнего по возрастанию. Получен очередной набор  выдать его на печать.
 3 5 4 1 2 6.
4. Если на шаге 1 ответ отрицательный, то поменять местами 2 последних элемента и выдать на печать полученный набор. В частности, после шага 3 это неизбежное действие, т.к. все последние элементы были размещены по возрастанию  целесообразно после выполнения ш.3 задавать признак его выполнения, который будет анализироваться (и сбрасываться) на шаге 1. После шага 3 было  3 5 4 1 2 6  выдать  3 5 4 1 6 2 .
Если был набор  3 5 2 6 1 4  выдать  3 5 2 6 4 1 .
5. Если полученный набор не последний (упорядоченный по убыванию), то возврат на шаг 1. В противном случае конец работы.



КОД РАБОТАЕТ ВЕРНО ТОЛЬКО В ПАСКАЛЬ ТУРБО а мне нужно в абс.нет
0
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
inter-admin
Эксперт
29715 / 6470 / 2152
Регистрация: 06.03.2009
Сообщений: 28,500
Блог
23.11.2016, 13:43
Помогаю со студенческими работами здесь

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

Переделайте, пожалуйста, программу из Turbo pascal в ABC pascal
Помогите, пожалуйста, перевести из PASCAL TURBO в PASCAL ABC Program ProgInt; Uses Crt, Graph; Var Punkt : Byte; Knopka :...

Turbo Pascal, Pascal ABC, Free Pascal, PascalABC.NET - в чем разница?
Всем привет, решил изучать Паскаль, но на форуме увидел 4 его версии - Turbo Pascal, Pascal ABC, Free Pascal, PascalABC.NET и не понял, в...

Различия трансляторов Pascal ABC.Net и Turbo/Borland Pascal
Пожалуйста, объясните различия между компиляторами Pascal ABC.Net и Turbo/Borland Pascal

Перевод программы с Turbo Pascal на Pascal ABC.NET
написала программу в паскаль турбо на рабочем компьютере. перенесла в паскаль авсNet так как дома стоит эта версия /перестала работать что...


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

Или воспользуйтесь поиском по форуму:
3
Ответ Создать тему
Новые блоги и статьи
PhpStorm 2025.3: WSL Terminal всегда стартует в ~
and_y87 14.12.2025
PhpStorm 2025. 3: WSL Terminal всегда стартует в ~ (home), игнорируя директорию проекта Симптом: После обновления до PhpStorm 2025. 3 встроенный терминал WSL открывается в домашней директории. . .
Access
VikBal 11.12.2025
Помогите пожалуйста !! Как объединить 2 одинаковые БД Access с разными данными.
Новый ноутбук
volvo 07.12.2025
Всем привет. По скидке в "черную пятницу" взял себе новый ноутбук Lenovo ThinkBook 16 G7 на Амазоне: Ryzen 5 7533HS 64 Gb DDR5 1Tb NVMe 16" Full HD Display Win11 Pro
Музыка, написанная Искусственным Интеллектом
volvo 04.12.2025
Всем привет. Некоторое время назад меня заинтересовало, что уже умеет ИИ в плане написания музыки для песен, и, собственно, исполнения этих самых песен. Стихов у нас много, уже вышли 4 книги, еще 3. . .
От async/await к виртуальным потокам в Python
IndentationError 23.11.2025
Армин Ронахер поставил под сомнение async/ await. Создатель Flask заявляет: цветные функции - провал, виртуальные потоки - решение. Не threading-динозавры, а новое поколение лёгких потоков. Откат?. . .
Поиск "дружественных имён" СОМ портов
Argus19 22.11.2025
Поиск "дружественных имён" СОМ портов На странице: https:/ / norseev. ru/ 2018/ 01/ 04/ comportlist_windows/ нашёл схожую тему. Там приведён код на С++, который показывает только имена СОМ портов, типа,. . .
Сколько Государство потратило денег на меня, обеспечивая инсулином.
Programma_Boinc 20.11.2025
Сколько Государство потратило денег на меня, обеспечивая инсулином. Вот решила сделать интересный приблизительный подсчет, сколько государство потратило на меня денег на покупку инсулинов. . . .
Ломающие изменения в C#.NStar Alpha
Etyuhibosecyu 20.11.2025
Уже можно не только тестировать, но и пользоваться C#. NStar - писать оконные приложения, содержащие надписи, кнопки, текстовые поля и даже изображения, например, моя игра "Три в ряд" написана на этом. . .
Мысли в слух
kumehtar 18.11.2025
Кстати, совсем недавно имел разговор на тему медитаций с людьми. И обнаружил, что они вообще не понимают что такое медитация и зачем она нужна. Самые базовые вещи. Для них это - когда просто люди. . .
Создание Single Page Application на фреймах
krapotkin 16.11.2025
Статья исключительно для начинающих. Подходы оригинальностью не блещут. В век Веб все очень привыкли к дизайну Single-Page-Application . Быстренько разберем подход "на фреймах". Мы делаем одну. . .
КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2025, CyberForum.ru