Курсовая работа (Delphi) - КИ МГОУ / Unit2

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.