Turbo Vision! Опции

[BDS]

Кто знает Turbo Vision? ???

Задача: Нахождение ранга матрицы.
Сама задача решена в смысле реализован численный метод, интерфес на TV тоже есть, но не полностью. Нехватает сохранения в фаил и загрузка из него.
Если кто-нибудь знает как сделать, скажите!

Еще нужно к проге подобрать физическую задачу. Как я понял, это должна быть какая-то задача, приводящаяся к системе из X уравнений с X неизвестными, т.к. с помощью ранга матрицы мы узнаем, имеет ли эта система решения.

Добавлено (14.12.03 7:18):
Прогу могу выслать или выложить сюда исходный текст. :-/

[AlaRic]

Выкладывай исходный текст(только заключи в код)!

[SKVOZNJAK]

Можешь посмотреть на мои издевательства над TV. Там есть готовый интерфейс, можно добавлять/заменять куски кода. http://stiratel7.narod.ru/1/susnjak.zip

Добавлено (14.12.03 15:16):
А вот и пример использования такой системы
http://stiratel7.narod.ru/1/sahmatbo.zip

[BDS]

Вот исходный текст (основные меню и сам метод). :D

... (Показать/Скрыть)

{программа дла нахождения ранга матрицы}
{3-й Семестр.Факультет:Кибернетики,Кафедра:АТМ.Преподаватель:Петров Р.А.}

Program MatrRang;

uses Drivers, Objects, Views, Menus, App, MsgBox, Dialogs,
     Dos, Editors, Validate;

{----------------------------------------------------------------------------}
const
  cmDefine         = 100; {Задание матрицы}
  cmComputate      = 101; {Вычисление решений}
  cmChangeDir      = 260; {Смена директории}
  cmFindInSizeWin  = 200;
  cmFindInValueWin = 201;
  cmFindOutWin     = 202;
  cmInSizeCancel   = 230;
  cmInSizeNext     = 231;
  cmInValueBack    = 300;
  cmInValueCancel  = 301;
  cmOutWinOk       = 302;
  cmAbout          = 270; {О программе}
  cmExit=280;
  MaxNi=9;  { Максимальное кол-во строк      }
  MaxNj=9;  { Максимальное кол-во столбцов   }
  MaxNij=9;  { Число равное максимальному значению из MaxNi и MaxNj}

{----------------------------------------------------------------------------}
type
  PInSize = ^TInSize;
  TInSize = record
    iSize: string[2];
    jSize: string[2];
  end;

  PInValue = ^TInValue;
  TInValue = record
    Value: string[11];
  end;

  PInSizeWin = ^TInSizeWin;
  TInSizeWin = object (TDialog)
    constructor Init;
    procedure HandleEvent (var Event: TEvent); virtual;
  end;

  PInValueWin = ^TInValueWin;
  TInValueWin = object (TDialog)
    constructor Init;
    procedure HandleEvent (var Event: TEvent); virtual;
  end;

  POutWin = ^TOutWin;
  TOutWin = object (TDialog)
    constructor Init;
    procedure HandleEvent (var Event: TEvent); virtual;
    procedure Draw; virtual;
  end;

  PRangApp = ^TRangApp;
  TRangApp = object (TApplication)
    InSizeWin: PInSizeWin;
    InValueWin: PInValueWin;
    OutWin: POutWin;
    procedure HandleEvent(var Event: TEvent); virtual;
    procedure InitMenuBar; virtual;
    procedure InitStatusLine; virtual;
    procedure About; virtual;
    procedure OpenInSizeWin; virtual;
    procedure OpenInValueWin; virtual;
    procedure OpenOutWin; virtual;
    procedure Computate; virtual;
  end;

  BaseType=Real;
  ArrayType1=array [1..maxni, 1..maxnj] of PInputLine;
  ArrayType2=array [1..maxni, 1..maxnj] of BaseType;
{----------------------------------------------------------------------------}
var
  InSize: TInSize; {Окно ввода размерности}
  InValue: TInValue; {Окно ввода значений}
  Field: ArrayType1; {массив строк ввода}
  Value: ArrayType2; {массив значений}
  iSize: Byte; {размерность матрицы}
  jSize: Byte; {размерность матрицы}
  X: integer; {массив решений системы}

{----------------------------------------------------------------------------}
Function Opr(Const A:ArrayType2; K:Word):BaseType;

Function S1(S:Word):Integer;
  begin
    if (S mod 2) = 0 then
      S1:=-1
    else
      S1:=1;
  end;

Var I,J:Word;       { Для создания циклов   }
    E,Q:Word;       { Рабочие переменные    }
    B:ArrayType2;    { Рабочий массив        }
    Sum:BaseType;   { Значение определителя }
begin
    if K=2 then
      Opr:=A[1,1]*A[2,2]-A[1,2]*A[2,1]
    else begin
      Sum:=0;
        For E:=1 to K do begin
            For I:=2 to K do begin
              Q:=1;
                For J:=1 to K do
                    if (J<>E) then begin
                      B[I-1,Q]:=A[I,J];
                      Inc(Q);
                    end;
            end;
         Sum:=Sum+S1(E)*A[1,E]*Opr(B,K-1);
        end;
      Opr:=Sum;
    end;
end;
{----------------------------------------------------------------------------}
Function GetRang(Ni,Nj:Integer; A:ArrayType2):Integer;
Type
  Variant=(Process,Ok,Stop);     { Тип текущего процесса }
Var
  T1,T2:ArrayType2;               { Временные массивы     }
  I,J{Q,}:Word;                  { Для создания циклов   }
  K:Word;                        { Размер квадратной матрицы для расчета опр.}
  Pi,Pj:Array[0..MaxNij] of Byte;{ Для создания всех возможных перестановок
                                   строк и столбцов. Элемент 0 служит для
                                   предотвращения переполнения. }
  WhatInPi:Array[1..MaxNi] of Boolean; { Служат для построения перестановок }
  WhatInPj:Array[1..MaxNj] of Boolean; {/ строк и столбцов                   }
  F,F2:Variant;                  { Флаги }
  Opred,Temp:BaseType;           { Временные переменные }

Const
  Flag:Boolean = False;
  Rang:Integer = 0;
begin
  K:=1;
    For I:=1 to Ni-1 do
      Pi[I]:=I;
  Pi[Ni]:=Ni-1;

    While NOT Flag do begin
      {Подготовка массивов перестановок}
        For I:=1 to Nj-1 do
          Pj[I]:=I;
      Pj[Nj]:=Nj-1;

      {Построим все комбинации по строкам}
      F:=Process;
        While F=Process do begin
          I:=Ni;
          Inc(Pi[I]);
            While (I<>0) AND (Pi[I]>Ni) do begin
                  {Получение следующих комбинац.}
              Pi[I]:=1;
              Dec(I);
              Inc(Pi[I]);
            end;
            if (I=0) then begin
              F:=STOP;
              Flag:=TRUE;
            end else begin
              {Проверка повторений элементов в комбинации}
                For I:=1 to Ni do
                  WhatInPi[I]:=False;
                I:=1;
                  While (I<=Ni) AND (NOT WhatInPi[Pi[I]]) do begin
                    WhatInPi[Pi[I]]:=TRUE;
                    Inc(I);
                  end;
                  if I>Ni then F:=Ok;
            end;
        end;

      {Построим все комбинации по столбцам}
      F2:=Process;
        While (F2<>Stop) AND (NOT Flag) do begin
          F2:=Process;
            While F2=Process do begin
              I:=Nj;
              Inc(Pj[I]);
                While (I<>0) AND (Pj[I]>Nj) do begin
                  Pj[I]:=1;
                  Dec(I);
                  Inc(Pj[I]);
                end;
                if I=0 then
                  F2:=Stop
                else begin
                    For I:=1 to Nj do
                      WhatInPj[I]:=FALSE;
                    I:=1;
                      While (I<=Nj) AND (NOT WhatInPj[Pj[I]]) do begin
                        WhatInPj[Pj[I]]:=TRUE;
                        Inc(I);
                      end;
                      if I>Nj then F2:=Ok;
                end;
            end;

            if F2=Ok then begin
              {Составление матрицы}
                For I:=1 to Ni do
                    For J:=1 to Nj do
                      T1[I][J]:=A[Pi[I],J];
                For I:=1 to K do
                    For J:=1 to K do
                      T2[I][J]:=T1[I,Pj[J]];

              {Считаем определитель}
                if K>1 then
                  Opred:=Opr(T2,K)
                else
                  Opred:=T2[1][1];

                if Opred<>0 then F2:=STOP;

            end;
        end;

        if (Opred<>0) AND (NOT FLAG) then begin
          Rang:=K;
          Inc(K);

            For I:=1 to Ni-1 do
              Pi[I]:=I;
          Pi[Ni]:=Ni-1;

        end;
      Flag:=(K>Ni) OR (K>Nj) OR Flag;
    end;

    GetRang:=Rang;
end;

{----------------------------------------------------------------------------}
procedure TRangApp.OpenInSizeWin; {открытие окна ввода размерности}
begin
  InSizeWin := New (PInSizeWin, Init);
  InsertWindow (InSizeWin);
end;

{----------------------------------------------------------------------------}
procedure TRangApp.OpenInValueWin; {открытие окна ввода значений}
begin
  InValueWin := New (PInValueWin, Init);
  InsertWindow (InValueWin);
end;

{----------------------------------------------------------------------------}
procedure TRangApp.OpenOutWin; {открытие окна результатов}
begin
  OutWin := New (POutWin, Init);
  InsertWindow (OutWin);
end;

{----------------------------------------------------------------------------}
constructor TInSizeWin.Init; {Инициализация окна ввода размерности}
var
  R: TRect;
  Field: array[1..2] of PInputLine;
begin
  R.Assign (0, 0, 46, 9);
  inherited Init (R, 'Введите размерность матрицы');
  Options := Options or ofCentered;
  R.Assign (35, 2, 42, 3);
  Field[1] := New (PInputLine, Init (R, 2));
  Field[1]^.SetValidator (New (PRangeValidator, Init (1, maxni)));
  Field[1]^.Options := Field[1]^.Options or ofValidate;
  Insert (Field[1]);
  R.Assign (35, 4, 42, 5);
  Field[2] := New (PInputLine, Init (R, 2));
  Field[2]^.SetValidator (New (PRangeValidator, Init (1, maxnj)));
  Field[2]^.Options := Field[2]^.Options or ofValidate;
  Insert (Field[2]);
  R.Assign (3, 2, 34, 3);
  Insert (New (PLabel, Init (R, '~Ч~исло строк матрицы (1-9):',Field[1])));
  R.Assign (3, 4, 34, 5);
  Insert (New (PLabel, Init (R, '~Ч~исло столбцов матрицы (1-9):',Field[2])));
  R.Assign (9, 6, 21, 8);
  Insert (New (PButton, Init (R, '~О~тмена', cmInSizeCancel, bfNormal)));
  R.Assign (24, 6, 36, 8);
  Insert (New (PButton, Init (R, '~Д~алее >>', cmInSizeNext, bfDefault)));
  SelectNext(false);
end;

{----------------------------------------------------------------------------}
procedure TInSizeWin.HandleEvent (var Event: TEvent);
begin
  inherited HandleEvent (Event);
  if (Event.What = evBroadcast) and (Event.Command = cmFindInSizeWin) then
    ClearEvent (Event);
end;

{----------------------------------------------------------------------------}
constructor TInValueWin.Init; {Инициализация окна ввода матрицы}
var
  R: TRect;
  i, j, k: byte;
  Button1, Button2, Button3: byte;
  cx: byte;
begin
  if jSize>iSize then k:=jSize else k:=iSize;
  if k < 6 then
    begin
      cx := 43;
      Button1 := 3;
      Button2 := 15;
      Button3 := 26;
    end
  else
    begin
      cx := 3 + k*7;
      Button1 := k*4 - 20;
      Button2 := Button1 + 12;
      Button3 := Button2 + 11;
    end;
  R.Assign (0, 0, cx, 5 + k * 2);
  inherited Init (R, 'Значения матрицы');
  Options := Options or ofCentered;
  for i := 1 to iSize do
    for j := 1 to jSize do
      begin
        if k < 6
          then cx := 14 - (k - 2)*4 + (k - 4) + (j - 1)*7
          else cx := (j - 1)*7;
        R.Assign (2 + cx, 2 + (i - 1)*2, 8 + cx, 3 + (i - 1)*2);
        Field[j,i] := New (PInputLine, Init (R, 10));
        Field[j,i]^.SetValidator (New (PRangeValidator, Init (-1000,1000)));
        Insert (Field[j,i]);
      end;
  R.Assign (Button1, 2 + k * 2, Button1 + 11, 4 + k * 2);
  Insert (New (PButton, Init (R, '<<~Н~азад', cmInValueBack, bfNormal)));
  R.Assign (Button2, 2 + k * 2, Button2 + 10, 4 + k * 2);
  Insert (New (PButton, Init (R, '~О~тмена', cmInValueCancel, bfNormal)));
  R.Assign (Button3, 2 + k * 2, Button3 + 13, 4 + k * 2);
  Insert (New (PButton, Init (R, '~В~ычислить', cmComputate, bfDefault)));
  SelectNext(false);
end;

{----------------------------------------------------------------------------}
procedure TInValueWin.HandleEvent (var Event: TEvent);
begin
  inherited HandleEvent (Event);
  if (Event.What = evBroadcast) and (Event.Command = cmFindInValueWin) then
    ClearEvent (Event);
end;

{----------------------------------------------------------------------------}
constructor TOutWin.Init; {Инициализация окна результатов}
var
  R: TRect;
begin
  R.Assign (0, 0, 40, 7);
  inherited Init (R, 'Результат');
  Options := Options or ofCentered;
  Palette := dpCyanDialog;
  R.Assign (15, 4, 25, 6);
  Insert(New(PButton, Init(R, '~O~K', cmOutWinOk, bfDefault)));
  SelectNext(true);
end;

{----------------------------------------------------------------------------}
procedure TOutWin.HandleEvent (var Event: TEvent);
begin
  inherited HandleEvent (Event);
  if (Event.What = evBroadcast) and (Event.Command = cmFindOutWin) then
    ClearEvent (Event);
end;

{----------------------------------------------------------------------------}
procedure TOutWin.Draw; {Рисование окна результатов}
var
  value: string;
  i: byte;
begin
  inherited Draw;
  str(X,value);
  WriteStr(12,2,'Ранг матрицы = '+value,7);
end;

{----------------------------------------------------------------------------}
procedure TRangApp.Computate; {Нахождение коэффициентов матрицы}
begin
  X:=GetRang(iSize,jSize,Value);
end;

{----------------------------------------------------------------------------}
procedure TRangApp.HandleEvent(var Event: TEvent); {Обработчик событий}
var
  R: TRect;
  Code: integer;
  i, j: byte;
begin
  inherited HandleEvent(Event);
  if Event.What = evCommand then
  begin
    case Event.Command of
      cmDefine:
        begin
          if Message (Desktop, evBroadcast, cmFindOutWin, nil) <> nil
            then OutWin^.Done;
          if Message (Desktop, evBroadcast, cmFindInValueWin, nil) <> nil
            then InValueWin^.Done;
          if Message (Desktop, evBroadcast, cmFindInSizeWin, nil) = nil
            then OpenInSizeWin;
        end;
      cmComputate:
        begin
          if  InValueWin^.Valid (cmClose) then
          begin
            for i := 1 to iSize do
              for j := 1 to jSize do
                begin
                  Field[j,i]^.GetData (InValue);
                  Val (InValue.Value, Value[j,i], Code);
                end;
            InValueWin^.Done;
            Computate;
            OpenOutWin;
          end;
        end;
      cmInSizeCancel: InSizeWin^.Done;
      cmInSizeNext:
        begin
          if InSizeWin^.Valid (cmClose) then
            begin
              InSizeWin^.GetData (InSize);
              Val(InSize.iSize, iSize, Code);
              Val(InSize.jSize, jSize, Code);
              InSizeWin^.Done;
              OpenInValueWin;
            end;
        end;
      cmInValueBack:
        begin
          InValueWin^.Done;
          OpenInSizeWin;
          Str (iSize, InSize.iSize);
          Str (jSize, InSize.jSize);
          InSizeWin^.SetData (InSize);
        end;
      cmInValueCancel: InValueWin^.Done;
      cmOutWinOk: OutWin^.Done;
      cmAbout: About;
    end;
    ClearEvent(Event);
  end;
end;

{----------------------------------------------------------------------------}
procedure TRangApp.About;
var
  D: PDialog;
  Control: PView;
  R: TRect;
begin
  R.Assign(0, 0, 45, 13);
  D := New(PDialog, Init(R, 'О программе'));
  with D^ do
  begin
    Palette := dpGrayDialog;
    Options := Options or ofCentered;
    R.Grow(-1, -1);
    Dec(R.B.Y, 3);
    Insert(New(PStaticText, Init(R,
      #13+
      #3'Определение ранга матрицы.'#13+
      #13+
      #13+
      #3'Курсовая работа студента группы 220121'#13+
      #3'Буробина Дмитрия Сергеевича'#13+
      #13+
      #3'Тульский Государственный Университет 2003')));
    R.Assign(17, 10, 27, 12);
    Insert(New(PButton, Init(R, '~O~K', cmOk, bfDefault)));
  end;
  if ValidView(D) <> nil then
  begin
    Desktop^.ExecView(D);
    Dispose(D, Done);
  end;
end;

{----------------------------------------------------------------------------}
procedure TRangApp.InitMenuBar; {Инициализация меню}
var
  R: TRect;
begin
  GetExtent®;
  R.B.Y := R.A.Y + 1;
  MenuBar := New(PMenuBar, Init(R, NewMenu(
    NewSubMenu('~Р~абота', hcNoContext, NewMenu(
      NewItem('~В~вод данных', 'F4', kbF4, cmDefine, hcNoContext,
      NewItem('~В~ыход', 'Alt-X', kbNoKey, cmExit, hcNoContext,
    nil))),
    NewSubMenu('~П~омощь', hcNoContext, NewMenu(
      NewItem('~О~ программе...', '', kbNoKey, cmAbout, hcNoContext,
    nil)),
  nil)))));
end;

{----------------------------------------------------------------------------}
procedure TRangApp.InitStatusLine; {Инициализация строки статуса}
var
  R: TRect;
begin
  GetExtent®;
  R.A.Y := R.B.Y - 1;
  New(StatusLine, Init(R,
    NewStatusDef(0, $FFFF,
      NewStatusKey('~Alt-X~ Выход', kbAltX, cmQuit,
      NewStatusKey('~F1~ Помощь', kbF1, cmAbout,
      NewStatusKey('~F4~ Работа', kbF4, cmDefine,
      NewStatusKey('~F10~ Меню', kbF10, cmMenu,
    nil)))),
  nil)));
end;

{----------------------------------------------------------------------------}
var
  RangApp: TRangApp;

begin
  RangApp.Init;
  RangApp.Run;
  RangApp.Done;
end.

Добавлено (15.12.03 17:34):
Ну где же все?
Взгляните на прогу ПЛЗ!!! ;D

[SKVOZNJAK]

Высшая математика - это как-то не мой стиль ;D Так что тонкую настройку и состыковку данных с буфером выполняй сам ;) А так, вроде работает

... (Показать/Скрыть)

{программа дла нахождения ранга матрицы}
{3-й Семестр.Факультет:Кибернетики,Кафедра:АТМ.Преподаватель:Петров Р.А.}
{$M 65500, 0, 655360}
Program MatrRang;
uses Drivers, Objects, Views, Menus, App, MsgBox, Dialogs,
                  Dos, Editors, Validate, Crt;
{---------------------------------------------------------------------- -----}
const
      cmDefine    = 100; {Задание матрицы}
 
cmComputate = 101; {Вычисление решений}
cmChangeDir = 260; {Смена директории}
cmFindInSizeWin  = 200;
cmFindInValueWin = 201;
 
cmFindOutWin     = 202;
cmInSizeCancel   = 230;
cmInSizeNext     = 231;
cmInValueBack    = 300;
cmInValueCancel  = 301;
cmOutWinOk  = 302; 
cmAbout     = 270; {О программе}
cmExitt=1003{280};
cmTahni=1000; {Инициализация, в натуре, нового файла с именем BUFERR.BIN}
cmKahli=1001; {открытие уже существующего файла} cmTahni2=1002;{сохранение}
      cmTahni3=1004;{загрузка}
      MaxNi=9;  { Максимальное кол-во строк }
 
      MaxNj=9;  { Максимальное кол-во столбцов   }
MaxNij=9; { Число равное максимальному значению из MaxNi и
MaxNj}
{---------------------------------------------------------------------- -----}
type
      PInSize = ^TInSize;
 
TInSize = record
iSize: string[2];
jSize: string[2];
      end;
PInValue = ^TInValue; TInValue = record 
Value: string[11];
      end;
 
PInSizeWin = ^TInSizeWin; TInSizeWin = object (TDialog) 
constructor Init;
 
      procedure HandleEvent (var Event: TEvent); virtual; end;
      PInValueWin = ^TInValueWin;
      TInValueWin = object (TDialog)
            constructor Init;
      procedure HandleEvent (var Event: TEvent); virtual; end;
      POutWin = ^TOutWin;
 
TOutWin = object (TDialog)
constructor Init;
 
procedure HandleEvent (var Event: TEvent); virtual; procedure Draw; virtual;
      end;
      PRangApp = ^TRangApp;
      TRangApp = object (TApplication)
 
                  InSizeWin: PInSizeWin;
                  InValueWin: PInValueWin;
                  OutWin: POutWin;
procedure HandleEvent(var Event: TEvent); virtual;
procedure InitMenuBar; virtual;
 
procedure InitStatusLine; virtual;
procedure About; virtual;
procedure OpenInSizeWin; virtual;
procedure OpenInValueWin; virtual;
procedure OpenOutWin; virtual;
procedure Computate; virtual;
      end;
      BaseType=Real;
ArrayType1=array [1..maxni, 1..maxnj] of PInputLine;
ArrayType2=array [1..maxni, 1..maxnj] of BaseType;
{---------------------------------------------------------------------- -----}
var
      InSize: TInSize; {Окно ввода размерности}
 
InValue: TInValue; {Окно ввода значений}
Field: ArrayType1; {массив строк ввода}
Value: ArrayType2; {массив значений}
iSize: Byte; {размерность матрицы}
jSize: Byte; {размерность матрицы}
 
      X: integer; {массив решений системы}
      QQ3: Array[1..30000] of Byte; {БУФЕР ФАЙЛА ПОДКАЧКИ}
      Q7: File;
      Q3: Byte; {флаг открытия файла}
{---------------------------------------------------------------------- -----}
Function Opr(Const A:ArrayType2; K:Word):BaseType;
Function S1(S:Word):Integer;
      begin
                  if (S mod 2) = 0 then
 S1:=-1
                  else
 S1:=1;
      end;
Var I,J:Word;  { Для создания циклов   }
 
E,Q:Word;  { Рабочие переменные    }
B:ArrayType2;    { Рабочий массив   }
Sum:BaseType;   { Значение определителя }
begin
                  if K=2 then
 Opr:=A[1,1]*A[2,2]-A[1,2]*A[2,1]
                  else begin
 Sum:=0;
            For E:=1 to K do begin
 
For I:=2 to K do begin
                  Q:=1;
      For J:=1 to K do 
if (J<>E) then begin B[I-1,Q]:=A[I,J];
                                    Inc(Q);
                        end;
end; Sum:=Sum+S1(E)*A[1,E]*Opr(B,K-1);
 
            end;
 Opr:=Sum;
                  end;
end;
{---------------------------------------------------------------------- -----}
Function GetRang(Ni,Nj:Integer; A:ArrayType2):Integer;
Type
Variant=(Process,Ok,Stop);     { Тип текущего процесса }
Var
      T1,T2:ArrayType2;     { Временные массивы     }
 
      I,J{Q,}:Word;   { Для создания циклов   }
K:Word;    { Размер квадратной матрицы для расчета опр.}
Pi,Pj:Array[0..MaxNij] of Byte;{ Для создания всех возможных
перестановок
строк и столбцов. Элемент 0 служит для
                              предотвращения переполнения. }
WhatInPi:Array[1..MaxNi] of Boolean; { Служат для построения
перестановок }
WhatInPj:Array[1..MaxNj] of Boolean; {/ строк и столбцов    }
      F,F2:Variant;   { Флаги }
      Opred,Temp:BaseType;      { Временные переменные }
Const
      Flag:Boolean = False;
 
      Rang:Integer = 0;
begin
      K:=1;
                  For I:=1 to Ni-1 do
 Pi[I]:=I;
      Pi[Ni]:=Ni-1;
                  While NOT Flag do begin
 {Подготовка массивов перестановок}
            For I:=1 to Nj-1 do
                        Pj[I]:=I;
 Pj[Nj]:=Nj-1;
 {Построим все комбинации по строкам}
 F:=Process;
            While F=Process do begin
                        I:=Ni;
                        Inc(Pi[I]);
      While (I<>0) AND (Pi[I]>Ni) do begin
            {Получение следующих комбинац.}
                  Pi[I]:=1;
                  Dec(I);
                  Inc(Pi[I]);
      end;
      if (I=0) then begin
                  F:=STOP;
                  Flag:=TRUE;
      end else begin
{Проверка повторений элементов в комбинации}
                              For I:=1 to Ni do
            WhatInPi[I]:=False;
                              I:=1;
While (I<=Ni) AND (NOT WhatInPi[Pi[I]]) do begin
  WhatInPi[Pi[I]]:=TRUE;
                        Inc(I);
            end;
            if I>Ni then F:=Ok;
      end;
            end;
 {Построим все комбинации по столбцам}
 
 F2:=Process;
While (F2<>Stop) AND (NOT Flag) do begin F2:=Process;
      While F2=Process do begin
                  I:=Nj;
                  Inc(Pj[I]);
                  While (I<>0) AND (Pj[I]>Nj) do begin Pj[I]:=1;
            Dec(I);
            Inc(Pj[I]);
                              end;
                              if I=0 then
            F2:=Stop
                              else begin
                        For I:=1 to Nj do
 
                                    WhatInPj[I]:=FALSE;
                        I:=1;
While (I<=Nj) AND (NOT WhatInPj[Pj[I]]) do begin
  WhatInPj[Pj[I]]:=TRUE;
                  Inc(I);
                                    end;
                                    if I>Nj then F2:=Ok;
                              end;
      end;
      if F2=Ok then begin
                  {Составление матрицы}
                              For I:=1 to Ni do
 
For J:=1 to Nj do
      T1[I][J]:=A[Pi[I],J]; For I:=1 to K do
 
For J:=1 to K do T2[I][J]:=T1[I,Pj[J]];
{Считаем определитель}
                  if K>1 then Opred:=Opr(T2,K)
                              else
            Opred:=T2[1][1];
                              if Opred<>0 then F2:=STOP;
      end;
            end;
 
            if (Opred<>0) AND (NOT FLAG) then begin
                        Rang:=K;
                        Inc(K);
      For I:=1 to Ni-1 do
                  Pi[I]:=I;
                        Pi[Ni]:=Ni-1;
            end;
 Flag:=(K>Ni) OR (K>Nj) OR Flag;
                  end;
                  GetRang:=Rang;
end;
{---------------------------------------------------------------------- -----}
procedure TRangApp.OpenInSizeWin; {открытие окна ввода размерности}
begin
      InSizeWin := New (PInSizeWin, Init);
      InsertWindow (InSizeWin);
end;
{---------------------------------------------------------------------- -----}
procedure TRangApp.OpenInValueWin;
{открытие окна ввода значений}
begin
      InValueWin := New (PInValueWin, Init);
      InsertWindow (InValueWin);
end;
{---------------------------------------------------------------------- -----}
procedure TRangApp.OpenOutWin;
{открытие окна результатов}
begin
      OutWin := New (POutWin, Init);
      InsertWindow (OutWin);
end;
{---------------------------------------------------------------------- -----}
constructor TInSizeWin.Init;
{Инициализация окна ввода размерности}
var
      R: TRect;
      Field: array[1..2] of PInputLine;
begin
      R.Assign (0, 0, 46, 9);
      inherited Init (R, 'Введите размерность матрицы');
      Options := Options or ofCentered;
      R.Assign (35, 2, 42, 3);
Field[1] := New (PInputLine, Init (R, 2));
Field[1]^.SetValidator (New (PRangeValidator, Init (1, maxni)));
      Field[1]^.Options := Field[1]^.Options or ofValidate;
      Insert (Field[1]);
      R.Assign (35, 4, 42, 5);
Field[2] := New (PInputLine, Init (R, 2));
Field[2]^.SetValidator (New (PRangeValidator, Init (1,maxnj)));
      Field[2]^.Options := Field[2]^.Options or ofValidate;
      Insert (Field[2]);
      R.Assign (3, 2, 34, 3);
 
Insert (New (PLabel, Init (R, '~Ч~исло строк матрицы (1-9):',Field[1])));
      R.Assign (3, 4, 34, 5);
Insert (New (PLabel, Init (R, '~Ч~исло столбцов матрицы (1-9):',Field[2])));
      R.Assign (9, 6, 21, 8);
      Insert (New (PButton, Init (R, '~О~тмена', cmInSizeCancel,
bfNormal)));
      R.Assign (24, 6, 36, 8);
      Insert (New (PButton, Init (R, '~Д~алее >>', cmInSizeNext,
bfDefault)));
      SelectNext(false);
end;
{---------------------------------------------------------------
-------- -----}
procedure TInSizeWin.HandleEvent (var Event: TEvent);
begin
      inherited HandleEvent (Event);
      if (Event.What = evBroadcast) and (Event.Command =
cmFindInSizeWin) then
            ClearEvent (Event);
end;
 
{---------------------------------------------------------------------- -----}
constructor TInValueWin.Init;
{Инициализация окна ввода матрицы}
var
      R: TRect;
      i, j, k: byte;
      Button1, Button2, Button3: byte;
      cx: byte;
begin
      if jSize>iSize then k:=jSize else k:=iSize;
      if k < 6 then
                  begin
 cx := 43;
 
Button1 := 3;
 Button2 := 15;
 Button3 := 26; end
      else
begin
 cx := 3 + k*7;
 
 Button1 := k*4 - 20;
 Button2 := Button1 + 12;
 Button3 := Button2 + 11; end;
 
      R.Assign (0, 0, cx, 5 + k * 2);
      inherited Init (R, 'Значения матрицы');
      Options := Options or ofCentered;
      for i := 1 to iSize do
                  for j := 1 to jSize do
 begin
            if k < 6
                        then cx := 14 - (k - 2)*4 + (k - 4) + (j - 1)*7
                        else cx := (j - 1)*7;
R.Assign (2 + cx, 2 + (i - 1)*2, 8 + cx, 3 + (i - 1)*2);
Field[j,i] := New (PInputLine, Init (R, 10));
Field[j,i]^.SetValidator (New (PRangeValidator, Init (-1000,1000)));
            Insert (Field[j,i]);
 end;
      R.Assign (Button1, 2 + k * 2, Button1 + 11, 4 + k * 2);
Insert (New (PButton, Init (R, '<<~Н~азад', cmInValueBack, bfNormal)));
      R.Assign (Button2, 2 + k * 2, Button2 + 10, 4 + k * 2);
Insert (New (PButton, Init (R, '~О~тмена', cmInValueCancel, bfNormal)));
      R.Assign (Button3, 2 + k * 2, Button3 + 13, 4 + k * 2);
Insert (New (PButton, Init (R, '~В~ычислить', cmComputate, bfDefault)));
      SelectNext(false);
end;
{---------------------------------------------------------------------- -----}
procedure TInValueWin.HandleEvent (var Event: TEvent);
begin
  inherited HandleEvent (Event);
  if (Event.What = evBroadcast) and
     (Event.Command = cmFindInValueWin) then
  ClearEvent (Event);
end;
{---------------------------------------------------------------------- -----}
constructor TOutWin.Init;
{Инициализация окна результатов}
var
      R: TRect;
begin
  R.Assign (0, 0, 40, 7);
  inherited Init (R, 'Результат');
  Options := Options or ofCentered;
  Palette := dpCyanDialog;
 
  R.Assign (15, 4, 25, 6);
  Insert(New(PButton, Init(R, '~O~K', cmOutWinOk, bfDefault)));
  SelectNext(true);
end;
{---------------------------------------------------------------------- -----}
procedure TOutWin.HandleEvent (var Event: TEvent);
begin
      inherited HandleEvent (Event);
      if (Event.What = evBroadcast) and 
         (Event.Command = cmFindOutWin) then
            ClearEvent (Event);
end;
{---------------------------------------------------------------------- -----}
procedure TOutWin.Draw;
{Рисование окна результатов}
var
      value: string;
      i: byte;
begin
      inherited Draw;
      str(X,value);
      WriteStr(12,2,'Ранг матрицы = '+value,7);
end;
{---------------------------------------------------------------------- -----}
procedure TRangApp.Computate;
{Нахождение коэффициентов матрицы}
begin
      X:=GetRang(iSize,jSize,Value);
end;
{---------------------------------------------------------------------- -----}
procedure TRangApp.HandleEvent(var Event: TEvent);
{Обработчик событий}
var
      R: TRect;
      Code: integer;
      i, j: byte;
begin
      inherited HandleEvent(Event);
      if Event.What = evCommand then
      begin
            case Event.Command of
 cmExitt: begin
                  if Q3=1 then CLOSE(Q7);
                  ENDMODAL(CMQUIT);
                  end;
 cmTahni: begin
SOUND(220); DELAY(100); NOSOUND;
ASSIGN(Q7,'buferr.bin'); {СОЗДАНИЕ ФАЙЛА} REWRITE(Q7,1);
SEEK(Q7,29999);
BLOCKWRITE(Q7,Q3,1); {ЗАПИСЬ В НЕГО МУСОРА С ДИСКА}
Q3:=1;
                  SOUND(100); DELAY(100); NOSOUND;
                  end;
 cmKahli: begin
                                    ASSIGN(Q7,'buferr.bin');
                                    RESET(Q7,1);
                                    Q3:=1;
                                    end;
 cmTahni2:begin   {ЗАПИСЬ}
                                    SOUND(200); DELAY(150); NOSOUND;
                                    If Q3=1 THEN BEGIN
                                          SEEK(Q7,0);
                                          BLOCKWRITE(Q7,QQ3,30000);
                                          END;
                                    end;    {ЧТЕНИЕ}
 cmTahni3:begin
                                    SOUND(400); DELAY(150); NOSOUND;
                                    If Q3=1 THEN BEGIN
                                          SEEK(Q7,0);
                                          BLOCKREAD(Q7,QQ3,30000);
                                          END;
                                    end;
 cmDefine:
            begin
if Message (Desktop, evBroadcast, cmFindOutWin, nil) <> nil then
  OutWin^.Done;
if Message (Desktop, evBroadcast, cmFindInValueWin, nil) <> nil then
  InValueWin^.Done;
if Message (Desktop, evBroadcast, cmFindInSizeWin, nil) = nil
  then OpenInSizeWin;
            end;
 cmComputate:
            begin
                        if  InValueWin^.Valid (cmClose) then
                        begin
      for i := 1 to iSize do
                  for j := 1 to jSize do
                              begin
            Field[j,i]^.GetData (InValue);
            Val (InValue.Value, Value[j,i], Code);
                              end;
      InValueWin^.Done;
      Computate;
      OpenOutWin;
                        end;
            end;
 cmInSizeCancel: InSizeWin^.Done;
 cmInSizeNext:
            begin
                        if InSizeWin^.Valid (cmClose) then
      begin
                  InSizeWin^.GetData (InSize);
                  Val(InSize.iSize, iSize, Code);
 
Val(InSize.jSize, jSize, Code); InSizeWin^.Done; OpenInValueWin;
      end;
            end;
 cmInValueBack:
            begin
InValueWin^.Done; OpenInSizeWin;
                        Str (iSize, InSize.iSize);
Str (jSize, InSize.jSize);
            InSizeWin^.SetData (InSize); end;
cmInValueCancel: InValueWin^.Done;
 cmOutWinOk: OutWin^.Done;
 
 cmAbout: About;
            end;
            ClearEvent(Event);
      end;
end;
{---------------------------------------------------------------------- -----}
procedure TRangApp.About;
var
      D: PDialog;
      Control: PView;
      R: TRect;
begin
      R.Assign(0, 0, 45, 13);
      D := New(PDialog, Init(R, 'О программе'));
      with D^ do
      begin
            Palette := dpGrayDialog;
            Options := Options or ofCentered;
            R.Grow(-1, -1);
            Dec(R.B.Y, 3);
            Insert(New(PStaticText, Init(R,
 #13+
 #3'Определение ранга матрицы.'#13+
 #13+
 #13+
 #3'Курсовая работа студента группы 220121'#13+
 #3'Буробина Дмитрия Сергеевича'#13+
 #13+
 #3'Тульский Государственный Университет 2003')));
            R.Assign(17, 10, 27, 12);
Insert(New(PButton, Init(R, '~O~K', cmOk, bfDefault)));
      end;
      if ValidView(D) <> nil then
      begin
            Desktop^.ExecView(D);
            Dispose(D, Done);
      end;
end;
{---------------------------------------------------------------------- -----}
procedure TRangApp.InitMenuBar; {Инициализация меню}
var
      R: TRect;
begin
      GetExtent®;
      R.B.Y := R.A.Y + 1;
MenuBar :=
  New(PMenuBar, 
    Init(R, NewMenu( NewSubMenu('~Р~абота', hcNoContext, NewMenu(
NewItem('~С~оздание файла подкачки', 'F3', kbF3, cmTahni, hcNoContext,
NewItem('~О~ткрытие СУЩЕСТВУЮЩЕГО файла подкачки', 'F2', kbF2,
cmKahli, hcNoContext,
 NewItem('~В~вод данных', 'F4', kbF4, cmDefine, hcNoContext,
 NewItem('~С~охранение результатов', 'F5', kbF5, cmTahni2, hcNoContext,
 NewItem('~З~агрузка результатов', 'F6', kbF6, cmTahni3, hcNoContext,
 NewItem('~В~ыход', 'Alt-X', kbNoKey, cmExitt, hcNoContext,
            nil))))))),
            NewSubMenu('~П~омощь', hcNoContext, NewMenu(
 NewItem('~О~ программе...', '', kbNoKey, cmAbout, hcNoContext,
            nil)),
      nil)))));
end;
{---------------------------------------------------------------
-------- -----}
 
procedure TRangApp.InitStatusLine; {Инициализация строки статуса}
var
      R: TRect;
begin
      GetExtent®;
      R.A.Y := R.B.Y - 1;
 
      New(StatusLine, Init(R,
            NewStatusDef(0, $FFFF,
{ТАК ОНО ПОЛУЧШЕ БУДЕТ : ) }
NewStatusKey('~Alt-X~ Выход', kbAltX, cmExitt,
 NewStatusKey('~F1~ Помощь', kbF1, cmAbout,
 
NewStatusKey('~F4~ Работа', kbF4, cmDefine,
 NewStatusKey('~F10~ Меню', kbF10, cmMenu, nil)))),
      nil)));
end;
 
{---------------------------------------------------------------------- -----}
var
      RangApp: TRangApp;
begin
      RangApp.Init;
      RangApp.Run;
      RangApp.Done;
end.

[AlaRic]

Если не против,то на сайт залью!

[SKVOZNJAK]

Если не против,то на сайт залью!

Заливай! И Сушняк тоже - может у кого сушняк :D

[BDS]

Кстати если интересно, то могу прислать, чтобы на сайт выложили несколько исходников по другим численным методам :D. Просто из группы собрал, укого, что есть. Так что если нужно, только скажите. А то можно и раздел даже открыть, посвящ. TV.  Как идея? ???

;D

{----------------------}
И кстати спасибо SKVOZNJAK'у за помощь!  :)