|  | 
 
 | 
| 
 | |||||||
| Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны | 
|  | 
|  | Опции темы | Поиск в этой теме | Опции просмотра | 
|  | 
| 
			 
			#1  
			
			
			
			
		 | ||||
| 
 | ||||
|  Рисуем матрицу в Pascal - [Need optimization] Здравствуйте. Вот, в универе практикуем на паскале пока самые основы основ. К сожалению, еще до поступления я научился програмировать самомтоятельно, но через ж., за это препод меня гордо охрестил быдлокодером. Вот моя самая быдло-кодерская функция с дз, она рисует матрицу с выравниванием по самому длинному элементу. Вот пример работы функции: http://www.dropmocks.com/mNOe6 Кратко о номенклатуре: Код: type float = extended; TMatrix = array of array of float; MathCols и MathRows - возвращают кол-во столбцов и строк соответсвтвенно. Код:      procedure DrawMatrix     ( m : TMatrix; const Cap : string = '');
       var
           i,
           j,
           p : Integer;
           n : array of Integer;
         max : float;
    begin
        SetLength ( n, MathCols ( m ) );
        for j := 0 to pred ( MathCols ( m ) ) do begin
           max := m[0][j];
           n[j] := LengthNum( m[0][j] );
          for i := 0 to pred ( MathRows ( m ) ) do begin
            if ( m[i][j] > max ) then begin
                 max := m[i][j];
                n[j] := LengthNum ( m[i][j] );
            end;
          end;
        end;
        p := ( MathRows ( m ) div 2 );
        for i := 0 to pred ( MathRows(m) ) do begin
            if ( i = p ) then write ( cap , '|' )
            else begin
                PrintLength ( '', Length ( cap ) );
                write ( '|' );
            end;
            for j := 0 to pred ( MathCols(m) ) do begin
              write ( ' ' );
              Printlength ( FloatToStr( m[i][j] ), n[j] );
              write ( ' ' );
            end;
            write ( '|' );
            Writeln;
        end;
        writeln;
    end;Как стало заметно, своими кривыми руками для того что бы написать эту функция я написал еще две вспомогательные   Код:     function  LengthNum      ( n : float ) : Integer;
    begin
         Result := Length ( FloatToStr ( n ) );
    end;
    procedure PrintLength    ( inp : string; n : integer );
    begin
          while ( Length ( inp )  < n ) do inp := ' ' + inp;
          write ( inp );
    end; | 
| 
			 
			#2  
			
			
			
			
		 | ||||
| 
 | ||||
|   Мужики, так что там? Всё так печально, что даже никто не смотрит?  | 
| 
			 
			#3  
			
			
			
			
		 | ||||
| 
 | ||||
|   Я вижу, что это у тебя не паскаль, а консольная делфи программа. Потому на тебе для делфи: Код: program Project3;
{$APPTYPE CONSOLE}
uses
  SysUtils;
const
  size = 6;
var
  a: array[0..size - 1, 0..size - 1] of Extended;
  i, j, n: integer;
  m: Extended;
  mask_start, mask_mid, mask_end: string;
begin
  // Генерю матрицу для тестов
  Randomize;
  m := 0.0;
  for I := Low(a) to High(a) do
    for J := Low(a[i]) to High(a[i]) do
    begin
      a[i, j] := Random($FFFF);
      if a[i, j] > m then
        m := a[i, j];
    end;
  // Собственно весь вывод
  n := Length(FloatToStr(m));
  mask_start := Format('| %%0%d.0f', [n]);
  mask_mid := Format(' %%0%d.0f', [n]);
  mask_end := Format(' %%0%d.0f |', [n]);
  for i := Low(a) to High(a) do
  begin
    j := 0;
    Write(Format(mask_start, [a[i, j]]));
    inc(j);
    while j < high(a[i]) do
    begin
      Write(Format(mask_mid, [a[i, j]]));
      inc(j);
    end;
    Writeln(Format(mask_end, [a[i, j]]));
  end;
  Writeln('Ready');
  Readln;
end. |