main.~pas

数值分析 Gauss消元法Delphi源程序

unit main;

interface

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

type
  Tmainfrm = class(TForm)
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    Edit1: TEdit;
    BitBtn1: TBitBtn;
    shu: TStringGrid;
    BitBtn2: TBitBtn;
    StaticText1: TStaticText;
    StaticText2: TStaticText;
    Image1: TImage;
    Gauss1: TMenuItem;
    M1: TMenuItem;
    procedure N2Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure Gauss1Click(Sender: TObject);
    procedure M1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    a:array[1..100,1..100] of real;
    x:array[1..100] of real;
  end;

var
  mainfrm: Tmainfrm;

implementation

{$R *.dfm}
uses help;

procedure Tmainfrm.N2Click(Sender: TObject);
begin
 application.Terminate;
end;

procedure Tmainfrm.N4Click(Sender: TObject);
begin
  helpfrm.Memo1.BringToFront;
  helpfrm.Show;
end;

procedure Tmainfrm.Edit1KeyPress(Sender: TObject; var Key: Char);
var
 b:boolean;
begin
 b:=((key<#48) or (key>#57)) and (key<>#8);
 if b then
  key:=#0;
end;

procedure Tmainfrm.BitBtn1Click(Sender: TObject);
var
 i,j,n:integer;
begin
 if length(edit1.Text)=0 then
 begin
  messagedlg('错误，请输入方阵的阶数!',mterror,[mbOK],0);
  edit1.SetFocus;
  end
  else
  begin
   n:=strtoint(edit1.Text);
   shu.RowCount:=n+1;
   shu.ColCount:=n+2;
   for i:=1 to n do
    for j:=1 to n+1 do
     shu.Cells[j,i]:='';
   shu.Visible:=true;
   statictext2.Visible:=true;
   bitbtn2.Visible:=true;
   edit1.ReadOnly:=true;
  end;
end;

procedure Tmainfrm.BitBtn2Click(Sender: TObject);
var
 n,i,j,k,flag:integer;
 t,s:real;
 p:string;
begin
 n:=strtoint(edit1.Text);
 flag:=1;

 for i:=1 to n do
  for j:=1 to n+1 do
   if length(shu.Cells[j,i])=0 then
   begin
    flag:=0;
    break;
   end;

 if flag=1 then
  for i:=1 to n do
   for j:=1 to n+1 do
    a[i,j]:=strtofloat(shu.Cells[j,i])
 else
 begin
  messagedlg('错误，增广矩阵输入不全!',mterror,[mbOK],0);
  shu.SetFocus;
 end;
 
 for k:=1 to n-1 do
 begin
    for i:=k+1 to n do
    begin
      if abs(a[i][k])>abs(a[k][k]) then
      begin
        for j:=k to n+1 do
        begin
          t:=a[k][j];
          a[k][j]:=a[i][j];
          a[i][j]:=t;
        end;
      end;
    end;

    if abs(a[k,k])<1e-6 then
    begin
      messagedlg('对不起，Gauss消元法不能忍受，在'+inttostr(k)+'步退出!',mtinformation,[mbOk],0);
      application.Terminate;
    end
    else
    begin
      for i:=k+1 to n do
      begin
        a[i][k]:=a[i][k]/a[k][k];
        for j:=k+1 to n+1 do
          a[i][j]:=a[i][j]-a[k][j]*a[i][k];
      end;
    end;
 end;

 if abs(a[n][n])<1e-6 then
 begin
    messagedlg('对不起，Gauss消元法在回代过程的第一步退出。a['+inttostr(n)+']['+inttostr(n)+']<1e-6',mtinformation,[mbOk],0);
    application.Terminate;
 end
 else
 begin
    x[n]:=a[n][n+1]/a[n][n];
    for i:=n-1 downto 1 do
    begin
      s:=0;
      for j:=i+1 to n do
        s:=s+a[i][j]*x[j];
        x[i]:=(a[i][n+1]-s)/a[i][i];
    end;
    for i:=1 to n do
      p:=p+'x['+inttostr(i)+']='+floattostr(x[i])+chr(13);
 end;
 messagedlg('通过求解，方程组的解为:'+chr(13)+chr(13)+p,mtinformation,[mbOk],0);
 edit1.ReadOnly:=false;
end;
procedure Tmainfrm.Gauss1Click(Sender: TObject);
begin
 helpfrm.Label1.Caption:='Gauss简介:';
 helpfrm.Memo3.BringToFront;
 helpfrm.Show;
end;

procedure Tmainfrm.M1Click(Sender: TObject);
begin
 helpfrm.Label1.Caption:='作者简介:';
 helpfrm.Memo2.BringToFront;
 helpfrm.Show;
end;

end.