Добавил:
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
Скачиваний:
14
Добавлен:
20.06.2014
Размер:
4.04 Кб
Скачать
unit Unit2;
{решение системы уравнений методом Гаусса}
interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Grids, Menus, ShellApi,ExtCtrls;

type
TForm2 = class(TForm)
StringGrid1: TStringGrid;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
Label9: TLabel;
Label10: TLabel;
MainMenu1: TMainMenu;
vty1: TMenuItem;
N1: TMenuItem;
N2: TMenuItem;
Label11: TLabel;
cghfdrf1: TMenuItem;
Bevel1: TBevel;
Bevel2: TBevel;
Label12: TLabel;
Bevel3: TBevel;
Bevel4: TBevel;
Bevel5: TBevel;

procedure N1Click(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
procedure cghfdrf1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form2: TForm2;

implementation

{$R *.dfm}

{задание цвета столбца для StringGrid1}
procedure TForm2.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
const
clPaleGreen = TColor($CCFFCC);
begin
StringGrid1.canvas.brush.Color := clPaleGreen;
if (ACol = 4) then
begin
StringGrid1.Canvas.FillRect(Rect);
StringGrid1.Canvas.TextOut(Rect.Left, Rect.Top, StringGrid1.Cells[ACol, ARow]);
end;
end;

{ввод данных для решения тестового примера}
procedure TForm2.N1Click(Sender: TObject);
begin
stringgrid1.cells[0,0]:=floattostr(7);
stringgrid1.cells[0,1]:=floattostr(2);
stringgrid1.cells[0,2]:=floattostr(-2);
stringgrid1.cells[0,3]:=floattostr(-3);
stringgrid1.cells[1,0]:=floattostr(3);
stringgrid1.cells[1,1]:=floattostr(5);
stringgrid1.cells[1,2]:=floattostr(4);
stringgrid1.cells[1,3]:=floattostr(-2);
stringgrid1.cells[2,0]:=floattostr(2);
stringgrid1.cells[2,1]:=floattostr(1);
stringgrid1.cells[2,2]:=floattostr(-6);
stringgrid1.cells[2,3]:=floattostr(-5);
stringgrid1.cells[3,0]:=floattostr(5);
stringgrid1.cells[3,1]:=floattostr(-2);
stringgrid1.cells[3,2]:=floattostr(8);
stringgrid1.cells[3,3]:=floattostr(10);
stringgrid1.cells[4,0]:=floattostr(19);
stringgrid1.cells[4,1]:=floattostr(13);
stringgrid1.cells[4,2]:=floattostr(-32);
stringgrid1.cells[4,3]:=floattostr(-38);
end;

{реализация метода Гаусса}
procedure TForm2.N2Click(Sender: TObject);
var i,j,n,l,k,m:integer;
a:array [1..100,1..100] of real;
x:array [1..100] of real;
c,s,w,min:real;
{ввод данных}
begin
with StringGrid1 do
n:=rowcount;
for i:=1 to n do
for j:=1 to n +1 do
a[i,j]:= strtofloat(stringgrid1.cells[j-1,i-1]);
{прямой ход}
for i:=1 to n-1 do
begin {поиск ненулевого элемента}
if a[i,i]=0 then
begin
for m:= i+1 to n do
if a[m,i]<>0 then
break;
if a[m,i]=0 then showmessage('система не имеет решения');
for j:=i to n+1 do
begin
w:=a[i,j];
a[i,j]:=a[m,j];
a[m,j]:=w;
end;
end;
{поиск закончен}
c:=a[i,i];
a[i,i]:=1;

for l:=i+1 to n+1 do
begin
a[i,l]:=a[i,l]/c;
for k:=i+1 to n do
a[k,l]:=a[k,l]-a[i,l]*a[k,i];
end;
end;
if a[n,n]=0 then showmessage('система не имеет решения')

{обратный ход}
else
begin
x[n]:=a[n,n+1]/a[n,n];
k:=n-1;
repeat
s:=0;
for j:=k+1 to n do
s:=s+a[k,j]*x[j];
x[k]:=a[k,n+1]-s;
k:=k-1; until k=0;
{вывод корней системы}
label3.Caption:= floattostrf(x[1],fffixed,7,5);
label4.Caption:= floattostrf(x[2],fffixed,7,5);
label5.Caption:= floattostrf(x[3],fffixed,7,5);
label6.Caption:= floattostrf(x[4],fffixed,7,5);
end;
{поиск наименьшего значения корня}
min:=x[1];
for i:=1 to n do
if x[i]<min then min:=x[i];
label12.Caption:=floattostrf(min,fffixed,7,5);
end;
procedure TForm2.cghfdrf1Click(Sender: TObject);
{вызов справки}
begin
ShellExecute(Handle, nil, 'справка.html', nil, nil, SW_RESTORE);
end;

end.
Соседние файлы в папке Курсовая работа (Delphi) - КИ МГОУ
  • #
    20.06.20143.22 Кб15Unit1.dfm
  • #
    20.06.20141.18 Кб14Unit1.pas
  • #
    20.06.20148.65 Кб15Unit2.dcu
  • #
    20.06.201451 б14Unit2.ddp
  • #
    20.06.20145.56 Кб15Unit2.dfm
  • #
    20.06.20144.04 Кб14Unit2.pas
  • #
    20.06.20146.61 Кб14Unit3.dcu
  • #
    20.06.201451 б14Unit3.ddp
  • #
    20.06.20145.39 Кб14Unit3.dfm
  • #
    20.06.20142.02 Кб14Unit3.pas
  • #
    20.06.20143.71 Кб14Unit4.dcu