Технический форум
Вернуться   Технический форум > Программирование > Форум программистов > Delphi, Kylix and Pascal


Ответ
 
Опции темы Опции просмотра
Старый 06.06.2008, 16:11   #1 (permalink)
KatT
Member
 
Регистрация: 06.06.2008
Сообщений: 28
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
По умолчанию

Надо портировать код уже готовой программы из Free Pascal в Delphi.
Таким образом, чтобы старая программа выводилась внутри формы (а-ля консоль), но входные данные должны вводиться в отдельном текстовом поле (внутри той же формы). Пример кода программы на Free 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.
KatT вне форума   Ответить с цитированием

Старый 06.06.2008, 16:11
Helpmaster
Member
 
Аватар для Helpmaster
 
Регистрация: 08.03.2016
Сообщений: 0

Похожие темы могут значительно упростить решение вашего вопроса

Поле чудес
Делфи. Цвет кнопки в форме
Иконка на форме входа

Старый 06.06.2008, 17:10   #2 (permalink)
bubuka
Member
 
Аватар для bubuka
 
Регистрация: 23.01.2008
Сообщений: 1,110
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 141
По умолчанию

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

вы же сами и написали ответ ?
bubuka вне форума   Ответить с цитированием
Старый 06.06.2008, 22:19   #3 (permalink)
KatT
Member
 
Регистрация: 06.06.2008
Сообщений: 28
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
По умолчанию

Цитата:
Сообщение от KatT
но входные данные должны вводиться в отдельном текстовом поле (внутри той же формы)
Так что Console Application использовать не удастся. Также надо использовать цвета(в Паскале - textcolor и textbackground), что тоже в Console Application не поддерживается.
KatT вне форума   Ответить с цитированием
Старый 20.12.2009, 22:37   #4 (permalink)
Дьяконов Алексей
Member
 
Аватар для Дьяконов Алексей
 
Регистрация: 20.12.2009
Сообщений: 172
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 1
Unhappy проблемы с Корзиной!!!

Помогите!
Такая история: Открываю Корзину с рабочего стола - она пустая. Закрыл. А на ярлыке корзина заполнена. Через контекстное меню пытаюсь Очистить корзину, высвечивается запрос- "Вы хотите удалить папку WINDOWS (!!!) ?"
Что это? Как это понимать? Что с этим делать?
Заранее спасибо.
Дьяконов Алексей вне форума   Ответить с цитированием
Старый 20.12.2009, 22:45   #5 (permalink)
Гризлик
Мимо проходил
 
Аватар для Гризлик
 
Регистрация: 06.04.2008
Сообщений: 13,130
Сказал(а) спасибо: 21
Поблагодарили 18 раз(а) в 5 сообщениях
Репутация: 15356
По умолчанию

Дьяконов Алексей, Возможно вирус. Сделайте как тут написано и выложите логи http://pchelpforum.ru/f26/t6442/
Гризлик вне форума   Ответить с цитированием
Ads

Яндекс

Member
 
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070
Старый 20.12.2009, 22:48   #6 (permalink)
rkol
Member
 
Регистрация: 22.01.2007
Сообщений: 2,860
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 686
По умолчанию

Цитата с Гугл :такое бывает когда ссылка на файл, который в корзине, на самом деле относится не на тот файл, который удалили, а на папку Windows. Поэтому и предупреждение такое появляется: вы действительно хотите удалить windows?, имеется ввиду папка Windows. А так как в системе стоит защита от стирания папки Windows, то и ничего плохого и не происходит. У меня такое как-то было, когда я случайно выделил папку Windows и дернул мышкой, и данная папка переместилась в корзину. А когда решил было очистить корзину, то получил в ответ выше написанный вопрос.
rkol вне форума   Ответить с цитированием
Ads

Яндекс

Member
 
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070
Ответ


Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Выкл.
HTML код Выкл.
Trackbacks are Вкл.
Pingbacks are Вкл.
Refbacks are Выкл.




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

Powered by vBulletin® Version 6.2.5.
Copyright ©2000 - 2014, Jelsoft Enterprises Ltd.