Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > Разное
Перезагрузить страницу

как перевести программу из Pascal в Delphi

Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 17.12.2011, 01:02
hasan550 hasan550 вне форума
Прохожий
  
Регистрация: 17.12.2011
Сообщения: 5
Репутация: 10
По умолчанию как перевести программу из Pascal в 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
Uses CRT;
Const
maxn = 10;
Type
Data = Real;
Matrix = Array[1..maxn, 1..maxn] of Data;
Vector = Array[1..maxn] of Data;
{ Процедура ввода расширенной матрицы системы }
Procedure ReadSystem(n: Integer; var a: Matrix; var b: Vector);
Var
i, j, r: Integer;
Begin
r := WhereY;
GotoXY(2, r);
Write('A');
For i := 1 to n do begin
GotoXY(i * 6 + 2, r);
Write(i);
GotoXY(1, r + i + 1);
Write(i:2);
end;
GotoXY((n + 1) * 6 + 2, r);
Write('b');
For i := 1 to n do begin
For j := 1 to n do begin
GotoXY(j * 6 + 2, r + i + 1);
Read(a[i, j]);
end;
GotoXY((n + 1) * 6 + 2, r + i + 1);
Read(b[i]);
end;
End;
{ Процедура вывода результатов }
Procedure WriteX(n :Integer; x: Vector);
Var
i: Integer;
Begin
For i := 1 to n do
Writeln('x', i, ' = ', x[i]);
End;
{ Функция, реализующая метод Зейделя }
Function Zeidel(n: Integer; a: Matrix; b: Vector; var x: Vector; e: Data)
:Boolean;
Var
i, j: Integer;
s1, s2, s, v, m: Data;
Begin
Repeat
m := 0;
For i := 1 to n do begin
{ Вычисляем суммы }
s1 := 0;
s2 := 0;
For j := 1 to i - 1 do
s1 := s1 + a[i, j] * x[j];
For j := i to n do
s2 := s2 + a[i, j] * x[j];
{ Вычисляем новое приближение и погрешность }
v := x[i];
x[i] := x[i] - (1 / a[i, i]) * (s1 + s2 - b[i]);
If Abs(v - x[i]) > m then
m := Abs(v - x[i]);
end;
Until m < e;
Zeidel := true;
End;
Var
n, i: Integer;
a: Matrix;
b, x: Vector;
e: Data;
Begin
ClrScr;
Writeln('Программа решения систем линейных уравнений по методу Зейде-ля');
Writeln;
Writeln('Введите порядок матрицы системы (макс. 10)');
Repeat
Write('>');
Read(n);
Until (n > 0) and (n <= maxn);
Writeln;
readln;
Writeln('Введите точность вычислений');
Repeat
Write('>');
Read(e);
Until (e > 0) and (e < 1);
Writeln;
readln;
Writeln('Введите расширенную матрицу системы');
ReadSystem(n, a, b);
Writeln;
readln;
{ Предполагаем начальное приближение равным нулю }
For i := 1 to n do
x[i] := 0;
If Zeidel(n, a, b, x, e) then begin
Writeln('Результат вычислений по методу Зейделя');
WriteX(n, x);
readln;
end
else
Writeln('Метод Зейделя не сходится для данной системы');
Writeln;
readln;
End.

Задание: Решение систем линейных алгебраических уравнений
методом Зейделя

Буду очень признателен) сам ничего не понимаю)
Ответить с цитированием
  #2  
Старый 17.12.2011, 01:14
Аватар для angvelem
angvelem angvelem вне форума
.
  
Регистрация: 18.05.2011
Адрес: Омск
Сообщения: 3,970
Версия Delphi: 3,5,7,10,12,XE2
Репутация: выкл
По умолчанию
Могу перевести только в Дельфи 3-й версии, Подойдёт?
__________________
Je venus de nulle part
55.026263 с.ш., 73.397636 в.д.
Ответить с цитированием
  #3  
Старый 17.12.2011, 01:52
Аватар для angvelem
angvelem angvelem вне форума
.
  
Регистрация: 18.05.2011
Адрес: Омск
Сообщения: 3,970
Версия Delphi: 3,5,7,10,12,XE2
Репутация: выкл
По умолчанию
Цитата:
Сообщение от angvelem
Могу перевести только в Дельфи 3-й версии, Подойдёт?
Конечно это шутка, а если серьёзно, то:
Код:
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
program Pascal;
 
{$APPTYPE CONSOLE}
 
uses
  Windows, crt32;
  
const
  maxn      = 10;
 
type
  Data      = Single;
  Matrix    = array[1..maxn, 1..maxn] of Data;
  Vector    = array[1..maxn] of Data;
 
// Процедура ввода расширенной матрицы системы
procedure ReadSystem(n : Integer; var a : Matrix; var b : Vector);
var
  I, J, R : Integer;
begin
  r := WhereY;
  GotoXY(2, r);
  Write('A');
 
  for I := 1 to n do
  begin
    GotoXY(I * 6 + 2, R);
    Write(I);
    GotoXY(1, R + I + 1);
    Write(I:2);
  end;
 
  GotoXY((n + 1) * 6 + 2, R);
  Write('b');
 
  for I := 1 to n do
  begin
    for J := 1 to n do
    begin
      GotoXY(J * 6 + 2, R + I + 1);
      Read(a[I, J]);
    end;
    GotoXY((n + 1) * 6 + 2, R + I + 1);
    Read(b[i]);
  end;
end;
 
// Процедура вывода результатов
procedure WriteX(n : Integer; x : Vector);
var
  I : Integer;
begin
  for I := 1 to n do
    WriteLn('x', I, ' = ', x[i]);
end;
 
// Функция, реализующая метод Зейделя
function Zeidel(n : Integer; a : Matrix; b : Vector; var x : Vector; e : Data) : Boolean;
var
  I, J    : Integer;
  s1, s2,
  v, m    : Data;
begin
  repeat
    m := 0;
    for I := 1 to n do
    begin
      // Вычисляем суммы
      s1 := 0;
      s2 := 0;
 
      for J := 1 to I - 1 do
        s1 := s1 + a[I, J] * x[J];
 
      for J := I to n do
        s2 := s2 + a[I, J] * x[J];
 
      // Вычисляем новое приближение и погрешность
      v := x[i];
      x[i] := x[i] - (1 / a[I, I]) * (s1 + s2 - b[i]);
      if Abs(v - x[i]) > m then
        m := Abs(v - x[i]);
    end;
  until m < e;
 
  Result := True;
end;
 
var
  N, I : Integer;
  a    : Matrix;
  b, x : Vector;
  e    : Data;
begin
  ClrScr;
  WriteLn('Программа решения систем линейных уравнений по методу Зейде-ля');
  WriteLn;
  WriteLn('Введите порядок матрицы системы (макс. 10)');
 
  repeat
    Write('>');
    Read(N);
  until (N > 0) and (N <= maxn);
 
  WriteLn;
  ReadLn;
  WriteLn('Введите точность вычислений');
   
  repeat
    Write('>');
    Read(e);
  until (e > 0) and (e < 1);
 
  WriteLn;
  ReadLn;
  WriteLn('Введите расширенную матрицу системы');
  ReadSystem(n, a, b);
  WriteLn;
  ReadLn;
 
  // Предполагаем начальное приближение равным нулю
  for I := 1 to n do
    x[i] := 0;
 
  if Zeidel(n, a, b, x, e) then
  begin
    WriteLn('Результат вычислений по методу Зейделя');
    WriteX(n, x);
    ReadLn;
  end
  else
    WriteLn('Метод Зейделя не сходится для данной системы');
   
  WriteLn;
  ReadLn;
end.
также потребуется юнит crt32:
Код:
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
{$APPTYPE CONSOLE}
 
unit crt32;
 
interface
 
uses
  Windows, Messages;
 
{$ifdef win32}
const
  Black           = 0;
  Blue            = 1;
  Green           = 2;
  Cyan            = 3;
  Red             = 4;
  Magenta         = 5;
  Brown           = 6;
  LightGray       = 7;
  DarkGray        = 8;
  LightBlue       = 9;
  LightGreen      = 10;
  LightCyan       = 11;
  LightRed        = 12;
  LightMagenta    = 13;
  Yellow          = 14;
  White           = 15;
 
  function WhereX: integer;
  function WhereY: integer;
  procedure ClrEol;
  procedure ClrScr;
  procedure InsLine;
  Procedure DelLine;
  Procedure GotoXY(const x,y:integer);
  procedure HighVideo;
  procedure LowVideo;
  procedure NormVideo;
  procedure TextBackground(const Color:word);
  procedure TextColor(const Color:word);
  procedure TextAttribut(const Color,Background:word);
  procedure Delay(const ms:integer);
  function KeyPressed:boolean;
  function ReadKey:Char;
  Procedure Sound;
  Procedure NoSound;
  procedure FlushInputBuffer;
  function Pipe:boolean;
 
var
  HConsoleInput:tHandle;
  HConsoleOutput:thandle;
  HConsoleError:Thandle;
  WindMin:tcoord;
  WindMax:tcoord;
  ViewMax:tcoord;
  TextAttr : Word;
  LastMode : Word;
  SoundFrequenz :Integer;
  SoundDuration : Integer;
 
{$endif win32}
 
implementation
 
{$ifdef win32}
uses
  sysutils;
 
var
  StartAttr:word;
  OldCP:integer;
  CrtPipe : Boolean;
  German : boolean;
 
procedure ClrEol;
var
  tC      : tCoord;
  Len, Nw : DWORD;
  Cbi     : TConsoleScreenBufferInfo;
begin
  GetConsoleScreenBufferInfo(HConsoleOutput,cbi);
  len := cbi.dwsize.x-cbi.dwcursorposition.x;
  tc.x := cbi.dwcursorposition.x;
  tc.y := cbi.dwcursorposition.y;
  FillConsoleOutputAttribute(HConsoleOutput,textattr,len,tc,nw);
  FillConsoleOutputCharacter(HConsoleOutput,#32,len,tc,nw);
end;
 
procedure ClrScr;
var tc :tcoord;
  nw: DWORD;
  cbi : TConsoleScreenBufferInfo;
begin
  getConsoleScreenBufferInfo(HConsoleOutput,cbi);
  tc.x := 0;
  tc.y := 0;
  FillConsoleOutputAttribute(HConsoleOutput,textattr,cbi.dwsize.x*cbi.dwsize.y,tc,nw);
  FillConsoleOutputCharacter(HConsoleOutput,#32,cbi.dwsize.x*cbi.dwsize.y,tc,nw);
  setConsoleCursorPosition(hconsoleoutput,tc);
end;
 
Function WhereX: integer;
var cbi : TConsoleScreenBufferInfo;
begin
  getConsoleScreenBufferInfo(HConsoleOutput,cbi);
  result := tcoord(cbi.dwCursorPosition).x+1
end;
 
Function WhereY: integer;
var cbi : TConsoleScreenBufferInfo;
begin
  getConsoleScreenBufferInfo(HConsoleOutput,cbi);
  result := tcoord(cbi.dwCursorPosition).y+1
end;
 
Procedure GotoXY(const x,y:integer);
var coord :tcoord;
begin
  coord.x := x-1;
  coord.y := y-1;
  setConsoleCursorPosition(hconsoleoutput,coord);
end;
 
procedure InsLine;
var
 cbi : TConsoleScreenBufferInfo;
 ssr:tsmallrect;
 coord :tcoord;
 ci :tcharinfo;
 nw:DWORD;
begin
  getConsoleScreenBufferInfo(HConsoleOutput,cbi);
  coord := cbi.dwCursorPosition;
  ssr.left := 0;
  ssr.top := coord.y;
  ssr.right := cbi.srwindow.right;
  ssr.bottom := cbi.srwindow.bottom;
  ci.asciichar := #32;
  ci.attributes := cbi.wattributes;
  coord.x := 0;
  coord.y := coord.y+1;
  ScrollConsoleScreenBuffer(HconsoleOutput,ssr,nil,coord,ci);
  coord.y := coord.y-1;
  FillConsoleOutputAttribute(HConsoleOutput,textattr,cbi.dwsize.x*cbi.dwsize.y,coord,nw);
end;
 
procedure DelLine;
var
 cbi : TConsoleScreenBufferInfo;
 ssr:tsmallrect;
 coord :tcoord;
 ci :tcharinfo;
 nw:DWORD;
begin
  getConsoleScreenBufferInfo(HConsoleOutput,cbi);
  coord := cbi.dwCursorPosition;
  ssr.left := 0;
  ssr.top := coord.y+1;
  ssr.right := cbi.srwindow.right;
  ssr.bottom := cbi.srwindow.bottom;
  ci.asciichar := #32;
  ci.attributes := cbi.wattributes;
  coord.x := 0;
  coord.y := coord.y;
  ScrollConsoleScreenBuffer(HconsoleOutput,ssr,nil,coord,ci);
  FillConsoleOutputAttribute(HConsoleOutput,textattr,cbi.dwsize.x*cbi.dwsize.y,coord,nw);
end;
 
procedure TextBackground(const Color:word);
begin
  LastMode := TextAttr;
  textattr := (color shl 4) or (textattr and $f);
  SetConsoleTextAttribute(hconsoleoutput,textattr);
end;
 
procedure TextColor(const Color:word);
begin
  LastMode := TextAttr;
  textattr := (color and $f) or (textattr and $f0);
  SetConsoleTextAttribute(hconsoleoutput,textattr);
end;
 
procedure TextAttribut(const Color,Background:word);
begin
  LastMode := TextAttr;
  textattr := (color and $f) or (Background shl 4);
  SetConsoleTextAttribute(hconsoleoutput,textattr);
end;
 
procedure HighVideo;
begin
  LastMode := TextAttr;
  textattr := textattr or $8;
  SetConsoleTextAttribute(hconsoleoutput,textattr);
end;
 
procedure LowVideo;
begin
  LastMode := TextAttr;
  textattr := textattr and $f7;
  SetConsoleTextAttribute(hconsoleoutput,textattr);
end;
 
procedure NormVideo;
begin
  LastMode := TextAttr;
  textattr := startAttr;
  SetConsoleTextAttribute(hconsoleoutput,textattr);
end;
 
procedure FlushInputBuffer;
begin
  FlushConsoleInputBuffer(hconsoleinput)
end;
 
function keypressed:boolean;
var NumberOfEvents:DWORD;
begin
  GetNumberOfConsoleInputEvents(hconsoleinput,NumberOfEvents);
  result := NumberOfEvents > 0;
end;
 
function ReadKey: Char;
var
  NumRead:       DWORD;
  InputRec:      TInputRecord;
begin
  while not ReadConsoleInput(HConsoleInput,
                             InputRec,
                             1,
                             NumRead) or
           (InputRec.EventType <> KEY_EVENT) do;
  Result := InputRec.Event.KeyEvent.AsciiChar
end;
 
procedure delay(const ms:integer);
begin
  sleep(ms);
end;
 
Procedure Sound;
begin
  windows.beep(SoundFrequenz,soundduration);
end;
 
Procedure NoSound;
begin
  windows.beep(soundfrequenz,0);
end;
 
function Pipe:boolean;
begin
  result := crtpipe;
end;
 
procedure init;
var
  cbi : TConsoleScreenBufferInfo;
  tc  : tcoord;
begin
  SetActiveWindow(0);
  HConsoleInput  := GetStdHandle(STD_InPUT_HANDLE);
  HConsoleOutput := GetStdHandle(STD_OUTPUT_HANDLE);
  HConsoleError  := GetStdHandle(STD_Error_HANDLE);
 
  if getConsoleScreenBufferInfo(HConsoleOutput, cbi) then
  begin
    TextAttr  := cbi.wAttributes;
    StartAttr := cbi.wAttributes;
    lastmode  := cbi.wAttributes;
    tc.x      := cbi.srwindow.left+1;
    tc.y      := cbi.srwindow.top+1;
    windmin   := tc;
    ViewMax   := cbi.dwsize;
    tc.x      := cbi.srwindow.right+1;
    tc.y      := cbi.srwindow.bottom+1;
    windmax   := tc;
    crtpipe   := false;
  end
  else
    crtpipe := true;
 
  SoundFrequenz := 1000;
  SoundDuration := -1;
  oldCp := GetConsoleoutputCP;
  SetConsoleoutputCP(1251);
  german := $07 = (LoWord(GetUserDefaultLangID) and $3ff);
end;
 
initialization
  init;
 
finalization
  SetConsoleoutputCP(oldcp);
{$endif win32}
 
end.
__________________
Je venus de nulle part
55.026263 с.ш., 73.397636 в.д.
Ответить с цитированием
  #4  
Старый 17.12.2011, 12:05
hasan550 hasan550 вне форума
Прохожий
  
Регистрация: 17.12.2011
Сообщения: 5
Репутация: 10
По умолчанию
спасибо большое))))
а ты не мог бы написать подробнее как её в Делфи набрать - а то я в ней никогда не работал( в окне Form что надо например????
Ответить с цитированием
  #5  
Старый 17.12.2011, 13:39
Аватар для angvelem
angvelem angvelem вне форума
.
  
Регистрация: 18.05.2011
Адрес: Омск
Сообщения: 3,970
Версия Delphi: 3,5,7,10,12,XE2
Репутация: выкл
По умолчанию
Открываешь блокнот или подобный редактор (не Word), копируешь туда по-очереди приведённые тексты и сохраняешь под имненами Pascal.dpr и crt32.pas соответственно. В Дельфи открываешь Pascal.dpr и нажимаешь Ctrl-F9 для компилирования и F9 для запуска.
__________________
Je venus de nulle part
55.026263 с.ш., 73.397636 в.д.
Ответить с цитированием
  #6  
Старый 17.12.2011, 13:49
hasan550 hasan550 вне форума
Прохожий
  
Регистрация: 17.12.2011
Сообщения: 5
Репутация: 10
По умолчанию
после того как нажимаю F9 всё равно в паскале выходит( почему так???
Ответить с цитированием
  #7  
Старый 17.12.2011, 13:55
Аватар для angvelem
angvelem angvelem вне форума
.
  
Регистрация: 18.05.2011
Адрес: Омск
Сообщения: 3,970
Версия Delphi: 3,5,7,10,12,XE2
Репутация: выкл
По умолчанию
Pascal - язык программирования.
Delphi - визуальная среда разработки для языка Pascal.
__________________
Je venus de nulle part
55.026263 с.ш., 73.397636 в.д.
Ответить с цитированием
  #8  
Старый 19.12.2011, 16:36
hasan550 hasan550 вне форума
Прохожий
  
Регистрация: 17.12.2011
Сообщения: 5
Репутация: 10
По умолчанию
понятно) спасибо большое) а ты не мог бы блок-схему сделать для неё?)
Ответить с цитированием
  #9  
Старый 19.12.2011, 17:12
Аватар для Страдалецъ
Страдалецъ Страдалецъ вне форума
Гуру
  
Регистрация: 09.03.2009
Адрес: На курорте, из окна вижу теплое Баренцево море. Бррр.
Сообщения: 4,723
Репутация: 52347
По умолчанию
Вперед и с песней.
http://draw.labs.autodesk.com/ADDraw/draw.html
__________________
Жизнь такова какова она есть и больше никакова.
Помогаю за спасибо.
Ответить с цитированием
  #10  
Старый 19.12.2011, 18:49
hasan550 hasan550 вне форума
Прохожий
  
Регистрация: 17.12.2011
Сообщения: 5
Репутация: 10
По умолчанию
это для меня слишком сложно(
Ответить с цитированием
Ответ

« Предыдущая тема | Следующая тема »

Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра
Линейный вид Линейный вид

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения
BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 08:48.

Обратная связь - Главная страница сайта Delphi Sources - Вверх

 

Сайт

Форум

FAQ

Соглашения

Прочее
 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2025