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

hasan550 · #1 17.12.2011, 01:02

помогите пожалуйста перевести из Паскаля в Дельфи прогу:
Код:

Код:

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.

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

Буду очень признателен) сам ничего не понимаю)

angvelem · #2 17.12.2011, 01:14

Могу перевести только в Дельфи 3-й версии, Подойдёт?

angvelem · #3 17.12.2011, 01:52

Цитата:

Сообщение от angvelem

Могу перевести только в Дельфи 3-й версии, Подойдёт?

Конечно это шутка, а если серьёзно, то:

Код:

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:

Код:

{$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.

hasan550 · #4 17.12.2011, 12:05

спасибо большое))))
а ты не мог бы написать подробнее как её в Делфи набрать - а то я в ней никогда не работал( в окне Form что надо например????

angvelem · #5 17.12.2011, 13:39

Открываешь блокнот или подобный редактор (не Word), копируешь туда по-очереди приведённые тексты и сохраняешь под имненами Pascal.dpr и crt32.pas соответственно. В Дельфи открываешь Pascal.dpr и нажимаешь Ctrl-F9 для компилирования и F9 для запуска.

hasan550 · #6 17.12.2011, 13:49

после того как нажимаю F9 всё равно в паскале выходит( почему так???

angvelem · #7 17.12.2011, 13:55

Pascal - язык программирования.
Delphi - визуальная среда разработки для языка Pascal.

hasan550 · #8 19.12.2011, 16:36

понятно) спасибо большое) а ты не мог бы блок-схему сделать для неё?)

Страдалецъ · #9 19.12.2011, 17:12

Вперед и с песней.
http://draw.labs.autodesk.com/ADDraw/draw.html

hasan550 · #10 19.12.2011, 18:49

это для меня слишком сложно(

Опции темы	Поиск в этой теме
Версия для печати Отправить на Email	Поиск в этой теме: Расширенный поиск
Опции просмотра
Линейный вид Комбинированный вид Древовидный вид

	Сайт	Форум	FAQ	RSS лента	Прочее
	Новости Исходники Компоненты Статьи Добавить исходник Поиск	Правила Поиск Сообщения за сегодня Пользователи Кто на форуме?	Delphi FAQ - 5000 статей DRKB - 4500 статей (ZIP-архив) Справочник функций и процедур Delphi Delphi Programming Guide Indy in Depth. Глубины Indy	Новости сайта Новости форума	Ссылки и Баннеры Donate О сайте Реклама Контакты