Текущий архив: 2009.08.16;
Скачать: CL | DM;

Вниз

Портирование кода программы на Turbo Pascal в Delphi   Найти похожие ветки 

← →
MIOW   (2008-05-30 20:57) [0]

Программа для работы с методом Крамера для решения линейных уравнений на Turbo Pascal.

program p;
uses crt;
{ Описание типов - матрицы и вектора }
type
 matr=array [1..10,1..10] of real;
 vec=array [1..10] of real;
var
 mt:matr;      { Исходная матрица - левая часть системы }
 m2:matr;      { Матрица для вычисления промежуточных определителей }
 v:vec;        { Вектор - правая часть системы }
 r:vec;        { Вектор решения }
 nm:integer;   { Число переменных }
 n,m:integer;  { Счетчики }
 d:real;       { Определитель матрицы }

{ Рекуррентная функция вычисления опеределителя матрицы }
function opr(mt:matr;nm:integer):real;
var
 n,m,d:integer;{ Счетчики }
 s:real;       { Определитель }
 m2:matr;      { Матрица для вычислений }
begin
{ Если матрица 2х2 - прямой расчет }
 if nm=2 then begin
   s:=mt[1,1]*mt[2,2]-mt[1,2]*mt[2,1];
 end else begin
{ Иначе - вычисление по правилу:
  Определитель равен сумме частных определителей по строке (столбцу),
  полученных вычеркиванием строки и столбца, и умноженных на элемент
  на их пересечении и на минус единицу в степени (номер столбца+номер
  строки). }
   s:=0;
{ Перебор всех элементов последнего столбца }
   for d:=1 to nm do begin
{ Получение матрицы без последнего столбца и с вычеркнутой строкой }
     m2:=mt;
     for n:=d to nm do
       for m:=1 to nm-1 do m2[m,n]:=m2[m,n+1];
{ Прибавление (вычитание) к сумме }
     if (d mod 2 =nm mod 2) then s:=s+mt[nm,d]*opr(m2,nm-1)
       else s:=s-mt[nm,d]*opr(m2,nm-1);
   end;
 end;
{ Результат }
 opr:=s;
end;
{ Функция ввода матрицы }
function input(var mt:matr):integer;
var
 x,y:integer;  { Координаты курсора }
 nm:integer;   { Количество переменных }
 c:char;       { Символ с клавиатуры }
 n,m:integer;  { Счетчики }
 pr:real;      { Дополнительная переменная }
begin
 textcolor(15);
 textbackground(0);
 x:=1;y:=1;nm:=2;{ Изначально - курсор на первом элементе, 2 переменных }
{ Заполнение матрицы нулями }
 for n:=1 to 10 do for m:=1 to 10 do mt[n,m]:=0;
 repeat
{ Вывод матрицы с выделением выбранного элемента }
   clrscr;
   for n:=1 to nm do
     for m:=1 to nm do begin
       if (n=x)and(m=y) then textbackground(1) else textbackground(0);
       gotoxy(n*8,m);
       writeln(mt[n,m]:7:3);
   end;
   textbackground(0);
   gotoxy(1,24);
   write(" +,- - изменение размера на Numpad"e, Стрелки - выбор,",
         " ENTER - ввод данных на обработку, ESC - завершение");
{ Считывание символа с клавиатуры }
   c:=readkey;
   if c=#0 then c:=readkey;
   case c of
{ Обработка нажатия на стрелки }
     #72:if y>1 then y:=y-1;
     #80:if y<nm then y:=y+1;
     #75:if x>1 then x:=x-1;
     #77:if x<nm then x:=x+1;
{ Нажатие ENTER - ввод данных }
     #13:begin
       gotoxy(x*8,y);
       write("         ");
       gotoxy(x*8,y);
       readln(mt[x,y]);
     end;
{ Нажатие / - ввод делителя }
     "/":begin
       gotoxy(x*8,y);
       write("/        ");
       gotoxy(x*8+1,y);
       readln(pr);
       mt[x,y]:=mt[x,y]/pr;
{ Перемещение курсора к следующему элементу }
       x:=x+1;
       if (x>nm) then begin
         x:=1;
         if (y<nm) then y:=y+1;
       end;
     end;
     "+":if nm<10 then nm:=nm+1;
     "-":if nm>2 then nm:=nm-1;
   end;
{ Выход по ESC }
 until (c=#27);
 input:=nm;
end;
{ Основная программа }
begin
{ Ввод матрицы }
 nm:=input(mt);
{ Вычисление определителя }
 d:=opr(mt,nm);
 writeln;
 if (d<>0) then begin
{ Если определитель не равен нулю - ввод вектора }
   writeln(" Введите вектор: ");
   for n:=1 to nm do read(v[n]);
{ Расчет по методу Крамера }
   for n:=1 to nm do begin
     m2:=mt;
     for m:=1 to nm do m2[n,m]:=v[m];
     r[n]:=opr(m2,nm)/d;
   end;
{ Вывод результата }
   clrscr;
   writeln(" Система: ");
   for n:=1 to nm do begin
     for m:=1 to nm-1 do write(mt[m,n]:6:2,"*X",m:1,"+");
     writeln(mt[nm,n]:6:2,"*X",nm:1,"=",v[n]:6:2);
   end;
   writeln;
   writeln(" Решение: ");
   for n:=1 to nm do writeln("X",n:1," = ",r[n]:10:6);
 end else writeln(" Решения не существует! ");
 writeln;
 writeln(" Нажмите ESC... ");
 repeat until readkey=#27;
end.


В программе для Turbo Pascal выбранный элемент выделяется цветом (textcolor, textbackground).
В Delphi  Console Application не воспринимает цвета. Можно ли как-то добавить цвета, или выделить элемент по-другому?
Delphi не понимает команду goto и есть другие проблемы...
Помогите, пожалуйста...

---

← →
Сергей М. ©   (2008-05-30 21:00) [1]

> Delphi не понимает команду goto


В приведенном коде нет никаких "команд", тем более goto

---

← →
Palladin ©   (2008-05-30 21:02) [2]

идешь в гугл набираешь "консольные приложения delphi"
нажимаешь "найти"
в результатах поиска находишь необходимую информацию для эмуляции модуля crt

---

← →
Сергей М. ©   (2008-05-30 21:02) [3]

> В Delphi  Console Application не воспринимает цвета


Можно подумать, что тебя кто-то силком заставляет портировать исх.текст именно в текст консольного приложения Win32 .

---

← →
MIOW   (2008-05-30 21:22) [4]

Извините. Не goto, а gotoxy.

Про модуль crt я знаю.


> Можно подумать, что тебя кто-то силком заставляет портировать
> исх.текст именно в текст консольного приложения Win32


А можно поподробней? Я, как уже ясно, полный нуб в прогаммировании, особенно Delphi. Если не в Console Application, то куда портировать код?

---

← →
nimble_   (2008-05-30 21:28) [5]

> Если не в Console Application, то куда портировать код?
КАК не в консоль? Кха-кха. Выкинь ты это раскрашивание и оставь простой код

> Я, как уже ясно, полный нуб в прогаммировании,
Вешайся лучше сам. Пока не запинали.

> особенно Delphi
Без комментариев. Только вопрос: это ты ЛАБу делаешь?

---

← →
MIOW   (2008-05-30 21:36) [6]

> Выкинь ты это раскрашивание и оставь простой код
>

Я бы с удовольствием, но этом раскрашивании все закручено.


> Вешайся лучше сам. Пока не запинали.

Уже стою на табуретке.


> Только вопрос: это ты ЛАБу делаешь?


:-) Курсовую. Надо завтра сдавать...

---

← →
nimble_   (2008-05-30 21:52) [7]

> Курсовую
> Уже стою на табуретке.
Удачи :) Просто легче дождаться конца света, чем того момента. когда тебе здесь кто-нить чо-нить просто так решит. БЕСПАЛТНО ;)

---

← →
Сергей М. ©   (2008-05-30 21:53) [8]

> Курсовую. Надо завтра сдавать


Шопена тебе уже заказали. Нахаляву. За это не волнуйся)

---

← →
Сергей М. ©   (2008-05-30 21:55) [9]

> Уже стою на табуретке.


Военкомат спасет)

---

← →
MIOW   (2008-05-30 21:58) [10]

Надеюсь успеть раньше. Не забудьте уронить слезу на могиле.

---

← →
Сергей М. ©   (2008-05-30 22:01) [11]

> Не забудьте уронить слезу на могиле


Тебе, болезный, на форум безутешных вдов бы надо)

---

← →
Сергей М. ©   (2008-05-30 22:08) [12]

> Если не в Console Application, то куда портировать код?


Теперь уже не важно, можно и в дыру.
Ты ж все равно на табуретке, все намылено, халявный шопен заказан и похоронная команда во главе с деканом и военкомом стоит за дверью)

---

← →
Palladin ©   (2008-05-30 22:18) [13]

моя путь подсказаль... мой совесть чистый...

---

Страницы: 1 вся ветка

Текущий архив: 2009.08.16;
Скачать: CL | DM;

Наверх

Память: 0.51 MB
Время: 0.014 c