Форум программистов, компьютерный форум, киберфорум
Наши страницы
Delphi для начинающих
Войти
Регистрация
Восстановить пароль
 
Zeus619
0 / 0 / 0
Регистрация: 23.05.2016
Сообщений: 18
1

Переделать под с Паскаля в Делфи

25.05.2016, 10:35. Просмотров 109. Ответов 1
Метки нет (Все метки)

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
{$DEFINE DEBUG}
program p0524;
 
{$APPTYPE CONSOLE}
 
uses
  SysUtils;
 
const
  W = 4;  // количество символов для отображения элементов (значений) массива
 
procedure PrintArray(a :array of Integer);
var
  i :Integer;
begin
  for i := Low(a) to High(a) do
    Write(Format('%*d', [W, a[i]]));
  { end for }
  Writeln;
end;
 
procedure qSort(var aVal: array of Integer; min, max: Integer);
var
  i, j, vmd, tmp: Integer;
begin
  vmd := aVal[max - ((max - min) div 2)];
  i := min;
  j := max;
  while i < j do begin
    while aVal[i] > vmd do
      Inc(i);
    { end while }
    while aVal[j] < vmd do
      Dec(j);
    { end while }
    if i <= j then begin
      tmp := aVal[i];
      aVal[i] := aVal[j];
      aVal[j] := tmp;
      inc(i);
      Dec(j);
    end; { end if }
  end; { end while }
 
  if min < j then qSort(aVal, min, j);
  { end if }
  if i < max then qSort(aVal, i, max);
  { end if }
end;
 
function GetMaxItem(a :array of Integer) :Integer;
// номер максимального элемента массива - считаем с нуля!!!
var
  i, m :Integer;
begin
  Result := Low(a);
  m := a[Low(a)];
  for i := Low(a) + 1 to High(a) do
    if Result < a[i] then
      Result := a[i];
    { end if }
  { end for }
end;
 
function GetProduct(a :array of Integer; var p :Int64) :Boolean;
// произведение элементов массива, расположенных между первым и вторым нулевыми элементами
// результат - true, если в массива есть два нулевых элемента, во всех остальных случаях - False
// Значение произведения этих чисел в переменной [var p: Int64]
var
  i, m :Integer;
  iB, iE :Integer;
 
  function GetIndex(a :array of Integer; p :Integer) :Integer;
  // получить индекс элемента массива равного нулю, начиная считать с элемента с номером [p]
  var
    i :Integer;
  begin
    Result := 0;
    for i := p to High(a) do
      if a[i] = 0 then begin
        Result := i;
        Break;
      end; { end if }
    { end for }
  end;
begin
  Result := False;
  iB := GetIndex(a, Low(a));  // от начала массива
  if iB = 0 then  // в массиве нет элементов равных нулю
    Exit;
  { end if }
 
  iE := GetIndex(a,  Succ(iB)); // от следующего за первым нулевым элементом
  if iE = 0 then  // в массиве нет второго элемента равного нулю
    Exit;
  { end if }
 
  p := 1;
  for i := Succ(iB) to Pred(iE) do
    p := p * a[i];
  { end for }
 
  Result := True;
end;
 
var
  i, n :Integer;
  a :array of Integer;
  t :array of Integer;
  p :Int64;
 
begin
  {$IFDEF DEBUG}
  n := 30;
  {$ELSE}
  Readln(n);
  {$ENDIF}
 
  // начальное заполнение массива псевдослучайными числами
  Randomize;
  SetLength(a, n);
  for i := Low(a) to High(a) do
    a[i] := Random(20);
  { end for }
  PrintArray(a);
 
  Writeln(Format('Максимальный элемент массива - %*d', [W, GetMaxItem(a)]));
 
  if GetProduct(a, p) then
    Writeln(Format('Произведение элементов массива, расположенных между первым и вторым нулевыми элементами - %*d', [18, p]))
  else
    Writeln('В массиве нет двух элементов равных нулю');
  { end if }
 
  { в первой половине размещались элементы, которые были в нечетных позициях,
    отсортированные в порядке убывания, а во второй половине - что стояли в четных позициях. }
  // отберем во временный массив нечетные элементы рабочего массива [a]
  SetLength(t, ((Length(a) + 1) div 2));
  n := Low(t);
  for i := Low(a) to High(a) do
    if Odd(Succ(i)) then begin  // отсчет элементов в Delphi с нуля, но прибавим единицу для естественного порядка элементов
      t[n] := a[i];
      inc(n);
    end; { end if }
  { end for }
 
  // отсортируем временных массив
  qSort(t, Low(t), High(t));
 
  // переместим четные элементы массива во вторую половину
  n := High(a);
  for i := High(a) downto Low(a) do
    if not Odd(Succ(i)) then begin
      a[n] := a[i];
      Dec(n);
    end; { end if }
  { end for }
 
  // и заполним первую отсортированными значениями из временного массива
  for i := Low(t) to High(t) do
    a[i] := t[i];
  { end for }
 
  PrintArray(a);
  Readln;
 
end.
0
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
25.05.2016, 10:35
Ответы с готовыми решениями:

Нужно код из Паскаля, переделать под Делфи
Помогите, нужно код Паскаля сделать под Делфи 7. Это метод Гаусса, если что. program abc; var...

Из Паскаля в делфи переделать
Помогите переделать код из паскаля в делфи, очень надо. в скайп kanysh9901

Переделать из Паскаля в Делфи
Program Kursovaia_rabota_zadanie_3; uses crt; type mas=array of integer; var a,b:mas;...

Переделать программу с Паскаля в Делфи
Программа меняет элементы матрицы(a), которые больше 5 на a-2 и отрицательные на их модуль....

Переделать программу из паскаля в делфи
{ генерация перестановок } uses crt; const n = 4; { количество элементов в перестановке} var...

1
qwertehok
2300 / 2204 / 602
Регистрация: 29.08.2013
Сообщений: 14,727
25.05.2016, 10:42 2
readln\writeln убираете и почти рабочий код будет

вместо вывода на экран (и ввода с экрана) переделываете под нужные компоненты
0
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
25.05.2016, 10:42

Переделать код с паскаля на делфи
Прошу помощи, нужно переделать код с Паскаля на Делфи. Задания: 1. Дан массив целых чисел из n...

Переделать код турбо паскаля в делфи
uses crt; var a,b,x:array of integer; mn:array of real; n,m,k,i,j:integer; ...

Как в этой задачи из паскаля переделать в делфи и заменить write и readln
как в этой задачи из паскаля переделать в делфи и заменить write и readln Дан массив размера N,...


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

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

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