Символы Опции

[gyrosa]

Помогите пожалуйста решить задачку!!! Только прошли тему, а въехать не получается, но на неделе надо сдать! очень прошу, буду благодарна


В символьной матрице MT(K,L), K≤10, L≤18 в каждой строке определить наибольшую длину небуквенной серии (в строке может быть несколько небуквенных серий). Вывести исходную матрицу и рядом с каждой строкой – полученные значения длин серий. Преобразовать матрицу так, чтобы ее строки располагались в порядке возрастания длин небуквенных серий. Дополнительных матриц не использовать. Вывести преобразованную матрицу. Небуквенная серия – последовательность небуквенных символов, ограниченная буквенными символами или началом (концом) строки.

[klem4]

uses crt;

const
  N = 10;
  M = 18;

type
  TSymbMatrix = array [1..N, 1..M] of Char;

procedure Create(var mx: TSymbMatrix);
var
  i, j: Byte;
begin
  randomize;
  for i := 1 to n do
   for j := 1 to m do
    mx[i, j] := chr(48 + random(75));
end;

function GetMaxSeqLen(const mx: TSymbMatrix; const row: Byte): Byte;
var
  len, max_len, i: Byte;
begin
  max_len := 0;

  i := 1;

  while (i <= m) do begin
    while (i <= m) and (upcase(mx[row, i]) in ['A'..'Z']) do
      inc(i);
    if i <= m then begin
      len := 0;
      while (i <= m) and not (upcase(mx[row, i]) in ['A'..'Z']) do begin
         inc(i);
         inc(len);
      end;
      if len > max_len then
        max_len := len;
    end;
  end;

  GetMaxSeqLen := max_len;
end;

procedure Print(const mx: TSymbMatrix);
var
  i, j: Byte;
begin
  writeln;
  for i := 1 to n do begin
    writeln;
    for j := 1 to m do begin
      if upcase(mx[i, j]) in ['A'..'Z'] then TextColor(White) else TextColor(LightRed);
      write(mx[i, j]:2);
    end;
    TextColor(Green); write(GetMaxSeqLen(mx, i):4);
  end;
end;

procedure SwapRows(var mx: TSymbMatrix; const row_a, row_b: Byte);
var
  i: Byte;
  temp: Char;
begin
  for i := 1 to m do begin
    temp := mx[row_a, i];
    mx[row_a, i] := mx[row_b, i];
    mx[row_b, i] := temp;
  end;
end;

procedure Sort(var mx: TSymbMatrix);
var
  i, j: Byte;
begin
  for i := n downto 2 do
   for j := 1 to i - 1 do
    if not(GetMaxSeqLen(mx, j) <= GetMaxSeqLen(mx, j + 1)) then
     SwapRows(mx, j, j + 1);
end;

var
  sMx: TSymbMatrix;
begin
  clrscr;

  Create(sMx);
  Print(sMx);

  Sort(sMx);
  Print(sMx);

  readln;
end.

Сообщение отредактировано: klem4 - 29.11.2007 0:30

[gyrosa]

Огромное спасибо!!! но маленький ворос, у меня не пашет модуль crt..его надо создать или измениить прогу?

[Ozzя]

Что значит "не пашет"?
Если "error 200", то см. в FAQ.

[Lapp]

у меня не пашет модуль crt..его надо создать или измениить прогу?

Создать его будет непросто...
Если убрать (закомментировать) все вызовы TextColor (их там типа три штуки) и ClrScr, то можно убрать CRT вообще. Правда, такого блистательного вида (которым всегда отличаются проги klem4 ) уже не будет, увы..