Кто знает Turbo Vision? ???
Задача: Нахождение ранга матрицы.
Сама задача решена в смысле реализован численный метод, интерфес на TV тоже есть, но не полностью. Нехватает сохранения в фаил и загрузка из него.
Если кто-нибудь знает как сделать, скажите!
Еще нужно к проге подобрать физическую задачу. Как я понял, это должна быть какая-то задача, приводящаяся к системе из X уравнений с X неизвестными, т.к. с помощью ранга матрицы мы узнаем, имеет ли эта система решения.
Добавлено (14.12.03 7:18):
Прогу могу выслать или выложить сюда исходный текст. :-/
Полная версия: Turbo Vision!
BDS
13.12.2003 17:07
AlaRic
14.12.2003 12:31
Выкладывай исходный текст(только заключи в код)!
SKVOZNJAK
14.12.2003 16:12
Можешь посмотреть на мои издевательства над TV. Там есть готовый интерфейс, можно добавлять/заменять куски кода. http://stiratel7.narod.ru/1/susnjak.zip
Добавлено (14.12.03 15:16):
А вот и пример использования такой системы
http://stiratel7.narod.ru/1/sahmatbo.zip
Добавлено (14.12.03 15:16):
А вот и пример использования такой системы
http://stiratel7.narod.ru/1/sahmatbo.zip
BDS
15.12.2003 8:33
Вот исходный текст (основные меню и сам метод). :D
Добавлено (15.12.03 17:34):
Ну где же все?
Взгляните на прогу ПЛЗ!!! ;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
16.12.2003 12:18
Высшая математика - это как-то не мой стиль ;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
16.12.2003 13:15
Если не против,то на сайт залью!
SKVOZNJAK
16.12.2003 13:26
Цитата
Если не против,то на сайт залью!
Заливай! И Сушняк тоже - может у кого сушняк :D
BDS
16.12.2003 17:01
Кстати если интересно, то могу прислать, чтобы на сайт выложили несколько исходников по другим численным методам :D. Просто из группы собрал, укого, что есть. Так что если нужно, только скажите. А то можно и раздел даже открыть, посвящ. TV. Как идея? ???
;D
{----------------------}
И кстати спасибо SKVOZNJAK'у за помощь! :)
;D
{----------------------}
И кстати спасибо SKVOZNJAK'у за помощь! :)
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.