Добавил:
Upload Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
otchet_VMA.doc
Скачиваний:
16
Добавлен:
25.03.2015
Размер:
1.32 Mб
Скачать

Код программы

Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, ComCtrls, StdCtrls, Buttons, Grids;

type

Tzsi = class(TForm)

dButton1: TButton;

BitBtn1: TBitBtn;

dButton4: TButton;

dLabel1: TLabel;

dLabel2: TLabel;

dEdit1: TEdit;

dUpDown1: TUpDown;

dLabel3: TLabel;

dStringGrid1: TStringGrid;

dLabel4: TLabel;

dStringGrid2: TStringGrid;

dPageControl1: TPageControl;

TabSheet1: TTabSheet;

TabSheet2: TTabSheet;

TabSheet3: TTabSheet;

dStringGrid3: TStringGrid;

dStringGrid4: TStringGrid;

TabSheet4: TTabSheet;

Label1: TLabel;

Label2: TLabel;

StringGrid1: TStringGrid;

Button1: TButton;

procedure dButton1Click(Sender: TObject);

procedure FormMouseUp(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure dStringGrid1KeyPress(Sender: TObject; var Key: Char);

procedure dStringGrid2KeyPress(Sender: TObject; var Key: Char);

procedure dButton4Click(Sender: TObject);

procedure dPageControl1Change(Sender: TObject);

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

type

mass1 = array of array of real;

mass2 = array of real;

var

zsi: Tzsi;

procedure recording_vector(dstringgrid : TStringGrid);

procedure recording_matrica1(dstringgrid : TStringGrid);

procedure change(step:integer);

procedure forth(step:integer);

procedure back();

procedure GauseChoise();

procedure Gause();

procedure obr();

implementation

var

vector,X : mass2;

Q : mass1;

{$R *.dfm}

procedure recording_vector(dstringgrid : TStringGrid);

var

i:integer;

begin

setlength(vector,dstringgrid.rowCount+2);

for i:= 0 to dstringgrid.rowCount-2 do

vector[i] := strtofloat(dstringgrid.Cells[1,i+1]);

End;

procedure recording_matrica1(dstringgrid : TStringGrid);

var

i,j:integer;

begin

setlength(Q,dstringgrid.rowCount+2,dstringgrid.colCount+2);

for i:= 0 to dstringgrid.colCount-2 do

begin

for j:= 0 to dstringgrid.rowCount-2 do

Q [i,j]:= strtofloat(dstringgrid.Cells[j+1,i+1]);

end;

End;

procedure Float(var Key: Char);

var

allow:string;

i:integer;

ok:boolean;

begin

allow:=',1234567890-'+#8;

ok:=false;

for i:=1 to length(allow)do

if key=allow[i]then ok:=true;

if not ok then key:=#0;

end;

procedure Tzsi.dButton1Click(Sender: TObject);

begin

dlabel1.Visible := true;

dlabel2.Visible := true;

dedit1.Visible := true;

dupdown1.Visible := true;

End;

procedure Tzsi.FormMouseUp(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

if button = mbleft then

begin

dlabel3.Visible := true;

dlabel4.Visible := true;

dstringgrid1.ColCount := dupdown1.Position + 1;

dstringgrid1.RowCount := dupdown1.Position + 1;

dstringgrid2.RowCount := dupdown1.Position + 1;

dstringgrid1.Visible := true;

dstringgrid2.Visible := true;

dstringgrid1.SetFocus;

end;

end;

procedure Tzsi.dStringGrid1KeyPress(Sender: TObject; var Key: Char);

begin

float(key);

end;

procedure Tzsi.dStringGrid2KeyPress(Sender: TObject; var Key: Char);

begin

float(key);

end;

Function Opred(F: Mass1; N:integer):real;

var

k,i,m,j:integer;

d,r,h:real;

begin

d:=1;

n:=zsi.dupdown1.Position;

for i:= 0 to n-1 do

begin

for j:= 0 to n-1 do

F [i,j]:= strtofloat(zsi.dstringgrid1.Cells[j+1,i+1]);

end;

for k:=0 to n-1 do

begin

for j:=k+1 to n-1 do

begin

if F[k,k]<>0 then h:=F[j,k]/F[k,k];

for i:=k to n-1 do F[j,i]:=F[j,i]-F[k,i]*h;

end;

end;

for i:=0 to n-1 do

for j:=0 to n-1 do if i=j then d:=d*F[i,j];

Opred:=D;

End;

procedure Tzsi.dButton4Click(Sender: TObject);

begin

dpagecontrol1.Visible := true;

recording_matrica1(dstringgrid1);

recording_vector(dstringgrid2);

End;

procedure change(step:integer);

var

p,pp,n:integer;

pmax, dop: double;

begin

n:=zsi.dupdown1.Position;

pp:=step;

pmax:=Q[step,step];

for p:=(step+1) to n do ,

if (Q[p,step]>pmax) then

begin

pmax:=Q[p,step];

pp:=p;

end;

for p:=step to n do

begin

dop:=Q[step,p];

Q[step,p]:=Q[pp,p];

Q[pp,p]:=dop;

end;

dop:=vector[step];

vector[step]:=vector[pp];

vector[pp]:=dop;

end;

procedure forth(step:integer);

var

p,l,n:integer;

mm: double;

begin

n:=zsi.dUpDown1.Position;

for p:=(step+1) to n do

begin

mm:=Q[p,step]/Q[step,step];

vector[p]:=vector[p]-mm*vector[step];

for l:=step to n do

Q[p,l]:=Q[p,l]-mm*Q[step,l];

end;

end;

procedure back();

var

p,l,n :integer;

sum: double;

begin

n:=zsi.dUpDown1.Position;

for p:=n-1 downto 0 do

begin

l:=p;

sum:=0;

while (l<n) do

begin

sum:=sum+Q[p,l+1]*x[l+1];

l:=l+1;

end;

x[p]:=(vector[p]-sum)/Q[p,p];

zsi.dStringGrid4.Cells[0,p+1]:='x'+intToStr(p+1)+'=';

zsi.dStringGrid4.Cells[1,p+1]:=FloatToStrF(X[p],ffGeneral,4,3);

end;

end;

procedure GauseChoise();

var

k,i,j,n:integer;

sum: double;

text: string;

begin

recording_matrica1(zsi.dstringgrid1);

recording_vector(zsi.dstringgrid2);

n:=zsi.dUpDown1.Position;

for k:=0 to (n-1) do

begin

change(k);

forth(k);

end;

back();

end;

procedure Gause();

var

k,i,m,n,j:integer;

h,r:real;

begin

recording_matrica1(zsi.dstringgrid1);

recording_vector(zsi.dstringgrid2);

n:=zsi.dupdown1.Position;

setlength(X,n);

for i:=0 to n-1 do

begin

h:=Q[i,i];

for j:=i to n-1 do if h<>0 then Q[i,j]:=Q[i,j]/h;

if h<>0 then vector[i]:=vector[i]/h;

for k:=i+1 to n-1 do

begin

r:=Q[k,i];

for j:=i to n-1 do Q[k,j]:=Q[k,j]-Q[i,j]*r;

vector[k]:=vector[k]-r*vector[i]

end;

end;

X[n-1]:=vector[n-1]/q[n-1,n-1];

for i:=n-1 downto 0 do

begin

h:=vector[i];

for j:=i+1 to n do h:=h-X[j]*Q[i,j];

X[i]:=h/Q[i,i];

end;

for i:=0 to n-1 do

begin

zsi.dStringGrid3.Cells[0,i+1]:='x'+intToStr(i+1)+'=';

zsi.dStringGrid3.Cells[1,i+1]:=FloatToStr(X[i]);

end;

end;

procedure obr();

var

k,i,m,n,j:integer;

h,r:real;

begin

n:=zsi.dupdown1.Position;

recording_matrica1(zsi.dstringgrid1);

For i:=0 To N-1 Do

For j:=N To 2*N-1 Do

If (j-i=N) Then Q[i, j]:=1

Else Q[i, j]:=0;

for i:=0 to n-1 do

begin

h:=Q[i,i];

for j:=i to 2*n-1 do if h<> 0 then Q[i,j]:=Q[i,j]/h;

for k:=i+1 to n-1 do

begin

r:=Q[k,i];

for j:=i to 2*n-1 do Q[k,j]:=Q[k,j]-Q[i,j]*r;

end;

end;

//Обратный ход

for i:=n-1 downto 0 do

begin

for j:=i-1 downto 0 do

begin

h:=q[j,i];

for k:=j+1 to 2*n-1 do q[j,k]:=q[j,k]-q[i,k]*h;

end;

end;

for i:=0 to n-1 do

for j:=0 to 2*n-1 do zsi.stringGrid1.Cells[j+1,i+1]:=FloatToStr(Q[i,j]);

end;

procedure Tzsi.dPageControl1Change(Sender: TObject);

begin

if zsi.dPageControl1.ActivePage = tabsheet2

then GauseChoise();

if zsi.dPageControl1.ActivePage = tabsheet1

then Gause();

if zsi.dPageControl1.ActivePage = tabsheet3

then obr();

if zsi.dPageControl1.ActivePage = tabsheet4

then

begin

recording_matrica1(zsi.dstringgrid1);

zsi.Label2.Caption:=floattostr(opred(Q,zsi.dstringgrid1.RowCount-2));

end;

end;

procedure Tzsi.Button1Click(Sender: TObject);

begin

zsi.dStringGrid1.cells[1,1]:='4,25';

zsi.dStringGrid1.cells[1,2]:='1,48';

zsi.dStringGrid1.cells[1,3]:='0,73';

zsi.dStringGrid1.cells[2,1]:='-1,48';

zsi.dStringGrid1.cells[2,2]:='1,73';

zsi.dStringGrid1.cells[2,3]:='-1,85';

zsi.dStringGrid1.cells[3,1]:='0,73';

zsi.dStringGrid1.cells[3,2]:='-1,85';

zsi.dStringGrid1.cells[3,3]:='1,93';

zsi.dStringGrid2.cells[1,1]:='1,44';

zsi.dStringGrid2.cells[1,2]:='2,73';

zsi.dStringGrid2.cells[1,3]:='-0,64';

end;

end.

Соседние файлы в предмете [НЕСОРТИРОВАННОЕ]