0 / 0 / 0
Регистрация: 17.12.2013
Сообщений: 27
1

Перевести текстовый код на Дельфи

24.11.2014, 18:10. Показов 432. Ответов 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
uses crt;
const nmax=20;
      mar:array[1..6] of string=('audi','bmw','ford','nissan','toyota','volvo');
type vladelez=record
              familia:string;
              adress:string;
              avto:string;
              nomer:string;
              vypusk:1900..2000;
              end;
     fail=file of vladelez;
var f:fail;
    a:vladelez;
    cnt:array[1..6] of integer;
    n,i,k,imx:integer;
    mx:1900..2000;
    s:string;
    ch:char;
begin
clrscr;
assign(f,'auto.dat');
rewrite(f);
repeat
write('Количество владельцев от 1 до ',nmax,' n=');
readln(n);
until n in [1..nmax];
writeln('Введите данные о ',n,' владельцах:');
for i:=1 to n do
 begin
  writeln('Владелец ',i);
  with a do
   begin
    write(' Фамилия: ');readln(familia);
    write(' Адрес: ');readln(adress);
    writeln(' Марка автомобиля:');
    writeln('  1-audi 2-bmw 3-ford 4-nissan 5-toyota 6-volvo');
    repeat
    readln(k);
    until k in [1..6];
    avto:=mar[k];
    write(' Номер: ');readln(nomer);
    repeat
    write(' Год выпуска 1900..2000: ');
    readln(s);
    val(s,vypusk,k);
    until(k=0)and(vypusk>=1900)and(vypusk<=2000);
    write(f,a);
   end;
 end;
clrscr;
reset(f);
writeln('Список автовладельцев:':30);
writeln;
writeln('----------------------------------------------------------');
writeln('|    Фамилия    |     Адрес    |  Марка  |  Номер  | Год |');
writeln('----------------------------------------------------------');
while not eof(f) do
 begin
  read(f,a);
  with a do
   begin
    gotoXY(1,whereY);write('| ',familia);
    gotoXY(17,whereY);write('| ',adress);
    gotoXY(32,whereY);write('| ',avto);
    gotoXY(42,whereY);write('| ',nomer);
    gotoXY(52,whereY);write('|',vypusk:5);
    gotoXY(58,whereY);writeln('|');
   end;
 end;
writeln('----------------------------------------------------------');
write('Press Enter...');
readln;
clrscr;
for i:=1 to 6 do
cnt[1]:=0;
seek(f,0);
while not eof(f) do
 begin
  read(f,a);
  for i:=1 to 6 do
  if mar[i]=a.avto then inc(cnt[i]);
 end;
writeln('Количество автомобилей каждой марки:');
for i:=1 to 6 do
writeln(mar[i],'=',cnt[i]);
mx:=2000;
s:='';
for i:=0 to filesize(f)-1 do
 begin
  seek(f,i);
  read(f,a);
  if a.vypusk<mx then
   begin
    mx:=a.vypusk;
    s:=a.familia;
   end;
 end;
writeln('Влоделец самого старого авто ',s);
writeln;
writeln('Поиск владельцев по марке авто');
repeat
write('Марка: ');
readln(s);
k:=0;
seek(f,0);
while not eof(f) do
 begin
  read(f,a);
  if a.avto=s then
   begin
    k:=1;
    writeln(a.familia,'  ',a.nomer);
   end;
 end;
if k=0 then writeln('Такой марки нет');
writeln('Продолжить поиск y/Y');
readln(ch);
until UpCase(ch)<>'Y';
close(f);
end.
__________________
Помощь в написании контрольных, курсовых и дипломных работ, диссертаций здесь
0
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
24.11.2014, 18:10
Ответы с готовыми решениями:

Перевести код из С++ в Дельфи
помогите перевести код плиз!из с++ в код делфи! using namespace std; int main() { const...

Перевести код на Дельфи
Кто может перенести это в Delphi??? type // конфета TCandy = record Name: string; //...

Перевести код из Паскаля в Дельфи
помогите перекинуть код из паскаля в делфи uses crt; const nmax=20; mar:array of...

Перевести код с Паскаля на Дельфи
ПОМОГИТЕ ПОЖАЛУЙСТА ПЕРЕВЕСТИ НА ДЕЛФИ var A,B,n:word; begin write('A= '); readln (A); B:=A;...

1
Эксперт Pascal/Delphi
6799 / 4560 / 4815
Регистрация: 05.06.2014
Сообщений: 22,438
25.11.2014, 09:45 2
Delphi
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
program Project1;
 
{$APPTYPE CONSOLE}
 
uses
  windows,
  crt;
 
const
  nmax=20;
  mar:array[1..6] of string=('audi','bmw','ford','nissan','toyota','volvo');
type
  vladelez=record
              familia:string[60];
              adress:string[60];
              avto:string[60];
              nomer:string[60];
              vypusk:1900..2000;
              end;
var
  f:file of vladelez;
  a:vladelez;
    cnt:array[1..6] of integer;
    n,i,k,imx:integer;
    mx:1900..2000;
    s:string;
    ch:char;
begin
SetConsoleCP(1251);
SetConsoleOutputCP(1251);
 
clrscr;
assign(f,'auto.dat');
rewrite(f);
repeat
write('Количество владельцев от 1 до ',nmax,' n=');
readln(n);
until n in [1..nmax];
writeln('Введите данные о ',n,' владельцах:');
for i:=1 to n do
 begin
  writeln('Владелец ',i);
  with a do
   begin
    write(' Фамилия: ');readln(familia);
    write(' Адрес: ');readln(adress);
    writeln(' Марка автомобиля:');
    writeln('  1-audi 2-bmw 3-ford 4-nissan 5-toyota 6-volvo');
    repeat
    readln(k);
    until k in [1..6];
    avto:=mar[k];
    write(' Номер: ');readln(nomer);
    repeat
    write(' Год выпуска 1900..2000: ');
    readln(s);
    val(s,vypusk,k);
    until(k=0)and(vypusk>=1900)and(vypusk<=2000);
    write(f,a);
   end;
 end;
clrscr;
reset(f);
writeln('Список автовладельцев:':30);
writeln;
writeln('----------------------------------------------------------');
writeln('|    Фамилия    |     Адрес    |  Марка  |  Номер  | Год |');
writeln('----------------------------------------------------------');
while not eof(f) do
 begin
  read(f,a);
  with a do
   begin
    gotoXY(1,whereY);write('| ',familia);
    gotoXY(17,whereY);write('| ',adress);
    gotoXY(32,whereY);write('| ',avto);
    gotoXY(42,whereY);write('| ',nomer);
    gotoXY(52,whereY);write('|',vypusk:5);
    gotoXY(58,whereY);writeln('|');
   end;
 end;
writeln('----------------------------------------------------------');
write('Press Enter...');
readln;
clrscr;
for i:=1 to 6 do
cnt[1]:=0;
seek(f,0);
while not eof(f) do
 begin
  read(f,a);
  for i:=1 to 6 do
  if mar[i]=a.avto then inc(cnt[i]);
 end;
writeln('Количество автомобилей каждой марки:');
for i:=1 to 6 do
writeln(mar[i],'=',cnt[i]);
mx:=2000;
s:='';
for i:=0 to filesize(f)-1 do
 begin
  seek(f,i);
  read(f,a);
  if a.vypusk<mx then
   begin
    mx:=a.vypusk;
    s:=a.familia;
   end;
 end;
writeln('Влоделец самого старого авто ',s);
writeln;
writeln('Поиск владельцев по марке авто');
repeat
write('Марка: ');
readln(s);
k:=0;
seek(f,0);
while not eof(f) do
 begin
  read(f,a);
  if a.avto=s then
   begin
    k:=1;
    writeln(a.familia,'  ',a.nomer);
   end;
 end;
if k=0 then writeln('Такой марки нет');
writeln('Продолжить поиск y/Y');
readln(ch);
until UpCase(ch)<>'Y';
close(f);
end.
Модуль

Delphi
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
unit CRT;
 
// written by Michael Uskoff, Apr 2001, St.Petersburg, RUSSIA
 
 
 
interface
 
 
 
procedure ClrScr;
 
procedure SetAttr(attr: word);
 
function GetAttr: word;
 
procedure GotoXY(aX, aY: integer); // zero-based coords
 
function WhereX: integer;
 
function WhereY: integer;
 
 
 
implementation
 
 
 
uses
  Windows;
 
 
 
 
var
 
UpperLeft: TCoord = (X: 0; Y: 0);
 
hCon: integer;
 
 
 
procedure GotoXY(aX, aY: integer);
 
var aCoord: TCoord;
 
begin
 
aCoord.x := aX;
 
aCoord.y := aY;
 
SetConsoleCursorPosition(hCon, aCoord);
 
end;
 
 
 
procedure SetAttr(attr: word);
 
begin
 
SetConsoleTextAttribute(hCon, attr);
 
end;
 
 
 
function WhereX: integer;
 
var ScrBufInfo: TConsoleScreenBufferInfo;
 
begin
 
GetConsoleScreenBufferInfo(hCon, ScrBufInfo);
 
Result := ScrBufInfo.dwCursorPosition.x;
 
end;
 
 
 
function WhereY: integer;
 
var ScrBufInfo: TConsoleScreenBufferInfo;
 
begin
 
GetConsoleScreenBufferInfo(hCon, ScrBufInfo);
 
Result := ScrBufInfo.dwCursorPosition.y;
 
end;
 
 
 
function GetAttr: word;
 
var ScrBufInfo: TConsoleScreenBufferInfo;
 
begin
 
GetConsoleScreenBufferInfo(hCon, ScrBufInfo);
 
Result := ScrBufInfo.wAttributes;
 
end;
 
 
 
procedure ClrScr;
 
var
  fill: dword;
 
ScrBufInfo: TConsoleScreenBufferInfo;
 
begin
 
GetConsoleScreenBufferInfo(hCon, ScrBufInfo);
 
fill := ScrBufInfo.dwSize.x * ScrBufInfo.dwSize.y;
 
FillConsoleOutputCharacter(hCon, ' ', fill, UpperLeft, fill);
 
FillConsoleOutputAttribute(hCon, ScrBufInfo.wAttributes, fill, UpperLeft, fill);
 
GotoXY(0, 0);
 
end;
 
 
 
initialization
 
hCon := GetStdHandle(STD_OUTPUT_HANDLE);
 
end.
1
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
25.11.2014, 09:45
Помогаю со студенческими работами здесь

Перевести код с Паскаля на Дельфи
здравствуйте решил задачу на паскаль.потребовалось ее сделать в делфи. о делфи знаю не много.если у...

Перевести текстовый бинарный код в исполняемый
Как с помощью JS можно перевести текстовый бинарный код 3c 68 74 6d 6c 20 78 6d 6c 6e 73 3a 6f 3d...

Онлайн текстовый учебник дельфи
со мной случисась беда и положили в больницу... скукотень нереальная... мне бы учебник дельфи да...

Перевести с Дельфи на Паскаль
program Project1; //Возвращает заглавную версию буквы для кодовой страницы CP866. function...


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

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

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2022, CyberForum.ru