Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Lazarus, Free Pascal, CodeTyphon
Регистрация

Восстановить пароль

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 21.05.2014, 22:03   #1
Ляйсан9517
Пользователь
 
Регистрация: 30.03.2014
Сообщений: 31
По умолчанию помогите перевести код Pascal в код Lazarus

только у меня m и n вводятся с клавиатуры в edit
Код:
program Project1;
 
const m=6;
      n=7;
type mtr=array[1..m,1..2*n] of integer;
procedure Vyvod(a:mtr;x,y:byte);
var i,j:byte;
begin
 
for i:=1 to x do
 begin
  for j:=1 to y do
  write(a[i,j]:4);
  writeln;
 end;
writeln;
end;
var b,b1:mtr;
    i1,m1,n1,i,j,k:byte;
    mx,a:integer;
    f:boolean;
begin
 
randomize;
for i:=1 to m do
for j:=1 to n do
b[i,j]:=8+random(20);
writeln('Исходная матрица:');
Vyvod(b,m,n);
b1:=b;
for i:=1 to m do
 begin
  mx:=b1[i,1];
  for j:=1 to n do
  if b1[i,j]>mx then mx:=b1[i,j];
  for j:=1 to n do
  if b1[i,j]=mx then b1[i,j]:=0;
 end;
writeln('Замена максимальных элементов строк на 0:');
Vyvod(b1,m,n);
write('Нажмите Enter');
readln;
 
b1:=b;
n1:=n;
mx:=b1[1,1];
for i:=1 to m do
for j:=1 to n1 do
if b1[i,j]>mx then mx:=b1[i,j];
j:=1;
while j<=n1 do
 begin
  f:=false;
  i:=1;
  while(i<=m)and not f do
  if b1[i,j]=mx then f:=true
  else i:=i+1;
  if f then
   begin
    n1:=n1+1;
    if j=n1-1 then
     begin
      for i:=1 to m do
      b1[i,n1]:=0;
     end
    else
     begin
      for k:=n1 downto j+2 do
      for i:=1 to m do
      b1[i,k]:=b1[i,k-1];
      for i:=1 to m do
      b1[i,j+1]:=0;
     end;
    j:=j+2;
    end
   else j:=j+1;
 end;
writeln('Исходная матрица:');
Vyvod(b,m,n);
writeln('Максимальный элемент=',mx);
writeln('Вставка столбцов из нолей после столбцов с максимальным:');
Vyvod(b1,m,n1);
write('Нажмите Enter');
readln;
 
writeln('Исходная матрица:');
Vyvod(b,m,n);
for i:=1 to m do
 begin
  a:=b[i,1];
  b[i,1]:=b[i,n-1];
  b[i,n-1]:=a;
 end;
writeln('Обмен 1 и предпоследнего столбцов:');
Vyvod(b,m,n);
write('Программа завершена, нажмите Enter');
readln
end.
заранее большое спасибоо

Последний раз редактировалось Stilet; 22.05.2014 в 11:14.
Ляйсан9517 вне форума Ответить с цитированием
Старый 22.05.2014, 08:31   #2
ZX Spectrum-128
Участник клуба
 
Регистрация: 05.11.2013
Сообщений: 1,601
По умолчанию

То есть, вам нужно получить графическое приложение из консольного. Вывод матрицы организуйте в stringgrid. Или в несколько, чтобы показать отличие преобразованной матрицы от исходной.
ZX Spectrum-128 вне форума Ответить с цитированием
Старый 22.05.2014, 13:28   #3
Ляйсан9517
Пользователь
 
Регистрация: 30.03.2014
Сообщений: 31
По умолчанию

да именно так
Ляйсан9517 вне форума Ответить с цитированием
Старый 22.05.2014, 13:34   #4
ZX Spectrum-128
Участник клуба
 
Регистрация: 05.11.2013
Сообщений: 1,601
По умолчанию

Так вы вроде как сами вполне можете реализовать данное действие. Во всяком случае, в предыдущих постах вам достаточно было подсказки. Остальное вы делали сами.
ZX Spectrum-128 вне форума Ответить с цитированием
Старый 22.05.2014, 13:44   #5
Ляйсан9517
Пользователь
 
Регистрация: 30.03.2014
Сообщений: 31
По умолчанию

Ну вот смотрите я составила программу на сам массив
Код:
procedure TForm1.Button1Click(Sender: TObject);
begin
randomize;
n:=StrToInt(Edit1.Text);
m:=StrToInt(Edit2.Text);
for i:=1 to n do     //Заполняем массив A
for j:=1 to m do
begin
a[i,j]:=random(100);
stringgrid1.Cells[i-1,j-1]:=inttostr(a[i,j]);
end;
end;
там не могу разобраться где идет процесс замены на 0

Код:
b1:=b;
for i:=1 to m do
 begin
  mx:=b1[i,1];
  for j:=1 to n do
  if b1[i,j]>mx then mx:=b1[i,j];
  for j:=1 to n do
  if b1[i,j]=mx then b1[i,j]:=0;
 end;
writeln('Замена максимальных элементов строк на 0:');
Vyvod(b1,m,n);
write('Нажмите Enter');
readln;
это процесс поиска максимального значение и замены на 0

Последний раз редактировалось Stilet; 22.05.2014 в 14:43.
Ляйсан9517 вне форума Ответить с цитированием
Старый 22.05.2014, 14:49   #6
Stilet
Белик Виталий :)
Старожил
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Сообщений: 57,097
По умолчанию

Код:
unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls;

const m=6;
      n=7;

type mtr=array[1..m,1..2*n] of integer;

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { private declarations }
    procedure Vyvod(a:mtr;x,y:byte);
  public
    { public declarations }
  end;
var b,b1:mtr;
    i1,m1,n1,i,j,k:byte;
    mx,a:integer;
    f:boolean;
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
begin
  Memo1.Lines.Clear;

 randomize;
 for i:=1 to m do
 for j:=1 to n do
  b[i,j]:=8+random(20);

 Vyvod(b,m,n);
 b1:=b;
 for i:=1 to m do
  begin
   mx:=b1[i,1];
   for j:=1 to n do
   if b1[i,j]>mx then mx:=b1[i,j];
   for j:=1 to n do
   if b1[i,j]=mx then b1[i,j]:=0;
  end;
 Memo1.Lines.Append('Замена максимальных элементов строк на 0:');
 Vyvod(b1,m,n);

 b1:=b;
 n1:=n;
 mx:=b1[1,1];
 for i:=1 to m do
 for j:=1 to n1 do
 if b1[i,j]>mx then mx:=b1[i,j];
 j:=1;
 while j<=n1 do
  begin
   f:=false;
   i:=1;
   while(i<=m)and not f do
   if b1[i,j]=mx then f:=true
   else i:=i+1;
   if f then
    begin
     n1:=n1+1;
     if j=n1-1 then
      begin
       for i:=1 to m do
       b1[i,n1]:=0;
      end
     else
      begin
       for k:=n1 downto j+2 do
       for i:=1 to m do
       b1[i,k]:=b1[i,k-1];
       for i:=1 to m do
       b1[i,j+1]:=0;
      end;
     j:=j+2;
     end
    else j:=j+1;
  end;
 Memo1.Lines.Append('Исходная матрица:');
 Vyvod(b,m,n);
 Memo1.Lines.Append(format('Максимальный элемент=%d',[mx]));
 Memo1.Lines.Append('Вставка столбцов из нолей после столбцов с максимальным:');
 Vyvod(b1,m,n1);


 Memo1.Lines.Append('Исходная матрица:');
 Vyvod(b,m,n);
 for i:=1 to m do
  begin
   a:=b[i,1];
   b[i,1]:=b[i,n-1];
   b[i,n-1]:=a;
  end;
 Memo1.Lines.Append('Обмен 1 и предпоследнего столбцов:');
 Vyvod(b,m,n);
 Memo1.Lines.Append('Программа завершена, нажмите Enter');
end;

procedure TForm1.Vyvod(a: mtr; x, y: byte);
var i,j:byte; s:string;
begin
with Memo1.Lines do
for i:=1 to x do
 begin
  for j:=1 to y do
  s:=s+format('%4d',[a[i,j]]);
  Append(s); s:='';
 end;
end;

end.
Годится?
I'm learning to live...
Stilet вне форума Ответить с цитированием
Старый 22.05.2014, 15:03   #7
ZX Spectrum-128
Участник клуба
 
Регистрация: 05.11.2013
Сообщений: 1,601
По умолчанию

Конечно, годится. А я вот что-то поленился
Уж землячке то надо было помочь
ZX Spectrum-128 вне форума Ответить с цитированием
Старый 22.05.2014, 15:26   #8
Stilet
Белик Виталий :)
Старожил
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Сообщений: 57,097
По умолчанию

Землячке
I'm learning to live...
Stilet вне форума Ответить с цитированием
Старый 22.05.2014, 15:45   #9
ZX Spectrum-128
Участник клуба
 
Регистрация: 05.11.2013
Сообщений: 1,601
По умолчанию

Ляйсан - женское имя.
ZX Spectrum-128 вне форума Ответить с цитированием
Старый 22.05.2014, 16:09   #10
Stilet
Белик Виталий :)
Старожил
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Сообщений: 57,097
По умолчанию

Я в курсе. И кстати красивое имя.
Я просто обратил внимание на Адрес: Бетельгейзе под твоей авой
I'm learning to live...
Stilet вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Перевести код из Pascal в C++ Lodbrock Помощь студентам 4 21.05.2014 13:08
помогите перевести код с VB в код Lazarus Ляйсан9517 Lazarus, Free Pascal, CodeTyphon 2 22.04.2014 19:31
Надо перевести код с Паскаля в код Lazarus Ляйсан9517 Помощь студентам 7 06.04.2014 22:44
Перевести код с C++ в Pascal BloodyBlade Помощь студентам 7 20.05.2012 20:24
Перевести код с Pascal на C++ Aaaaaa111 Помощь студентам 1 22.02.2012 14:28