gauss.pas

线性方程组 线性方程组 线性方程组高斯消去法求解

unit gauss;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Spin, Grids, ToolWin, ComCtrls, Menus;

type
  TMyData = record
    N:byte;
    a:array[1..11,1..10] of real;
  end;
  TMainGauss = class(TForm)
    sg: TStringGrid;
    sd: TSaveDialog;
    od: TOpenDialog;
    se: TSpinEdit;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    O1: TMenuItem;
    S1: TMenuItem;
    C1: TMenuItem;
    O2: TMenuItem;
    H1: TMenuItem;
    A1: TMenuItem;
    open: TButton;
    save: TButton;
    eliminate: TButton;
    backSubstitute: TButton;
    E1: TMenuItem;
    B1: TMenuItem;
    StatusBar: TStatusBar;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    iteration: TButton;
    procedure seChange(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure saveClick(Sender: TObject);
    procedure openClick(Sender: TObject);
    procedure C1Click(Sender: TObject);
    procedure eliminateClick(Sender: TObject);
    procedure backSubstituteClick(Sender: TObject);
    procedure A1Click(Sender: TObject);
    procedure sgSetEditText(Sender: TObject; ACol, ARow: Integer;
      const Value: String);
    procedure iterationClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  MainGauss: TMainGauss;
  MyData: TMyData;
  F: file of TMyData;
  Pathname: String;
  x:array[1..10] of real;

implementation


{$R *.dfm}

procedure TMainGauss.seChange(Sender: TObject);
var
  i:byte;
begin
  sg.ColCount:=se.Value+2;
  sg.RowCount:=se.Value+1;
  if se.Value>=5 then
  begin
    sg.Height:=sg.RowCount*21+4;
    sg.Width:=sg.ColCount*51-17;
    maingauss.Height:=255+(sg.RowCount-6)*22;
    maingauss.Width:=365+(sg.ColCount-7)*51;
  end;
  for i:=1 to se.Value do
    begin
      sg.Cells[i,0]:='*X['+floattostr(i)+']';
      sg.Cells[0,i]:=FloatToStr(i);
    end;
  sg.Cells[sg.ColCount-1,0]:='b[i]';
end;

procedure TMainGauss.FormCreate(Sender: TObject);
var
  i:byte;
begin
  for i:=1 to se.Value do
    begin
      sg.Cells[i,0]:='*X['+floattostr(i)+']';
      sg.Cells[0,i]:=FloatToStr(i);
    end;
  sg.Cells[3,0]:='b[i]';
  statusbar.Panels[0].Text:='◇导入或者保存数据之后方可以点击消元和回代！◇';
  E1.Enabled:=false;
  B1.Enabled:=false;
  Pathname:=ExtractFilePath(application.ExeName);
end;

procedure TMainGauss.saveClick(Sender: TObject);
begin
  sd.InitialDir:=pathname;
  if sd.Execute then
  begin
    if sd.FilterIndex=1 then
    if pos('.dat',sd.FileName)=0 then
      sd.FileName:=sd.FileName+'.dat';
    assignfile(F,sd.FileName);
    rewrite(f);
    write(f,MyData);
    maingauss.Caption:='Gauss Linear Equations - '+sd.FileName;
    closefile(f);
  end;
end;

procedure TMainGauss.openClick(Sender: TObject);
var
  i,j:byte;
begin
  od.InitialDir:=pathname;
  if od.Execute then
  begin
    assignfile(f,od.FileName);
    reset(f);
    read(f,MyData);
    closefile(f);
    maingauss.Caption:='Gauss Linear Equations - '+od.FileName;
    with MyData do
    begin
      se.Value:=N;
      for i:=1 to sg.RowCount-1 do
        for j:=1 to sg.ColCount-1 do
          sg.cells[j,i]:=FloatToStr(a[j,i]);
      eliminate.Enabled:=true;
    end;
  end;
end;

procedure TMainGauss.C1Click(Sender: TObject);
begin
  close;
end;


procedure TMainGauss.eliminateClick(Sender: TObject);
var
  i,j,k,MainCol:byte;
  istrue:boolean;
  temp:real;
begin
  sg.Options:=sg.Options-[goEditing];
  with MyData do
  begin
    for j:=1 to N do
    begin
      MainCol:=j;
      for i:=j+1 to N do
        if (abs(a[j,i])>abs(a[j,MainCol])) then
          MainCol:=i;
      if MainCol<>j then
      begin
        for k:=1 to N+1 do
        begin
          temp:=a[k,MainCol];
          a[k,MainCol]:=a[k,j];
          sg.Cells[k,MainCol]:=FloatToStr(a[k,MainCol]);
          a[k,j]:=temp;
          sg.Cells[k,j]:=FloatToStr(a[k,j]);
        end;
        ShowMessage('将第'+FloatToStr(MainCol)+'行和第'+FloatToStr(j)+'行互换！');
      end;
       //列主元素的选取;

      if a[j,j]=0 then
      begin
        showmessage('这是一个非齐次线性方程组，有无数组解或者无解！');
        istrue:=false;
        break;
      end
      else temp:=a[j,j];
      for i:=1 to N+1 do
        a[i,j]:=a[i,j]/temp;
      //消去第 j 列元时将第 j 行的对角线上系数打成 1；


      for i:=j+1 to N do
        begin
          temp:=a[j,i];
          for k:=1 to N+1 do
            a[k,i]:=a[k,i]-a[k,j]*temp;
        end;
      //将第 j 列 j 行以下的元素打成 0；

      for i:=1 to sg.RowCount-1 do
        for k:=1 to sg.ColCount-1 do
          sg.cells[k,i]:=FloatToStr(a[k,i]);
      showmessage('这是第'+FloatToStr(j)+'次消元！');
    end;
    sg.Options:=sg.Options+[goEditing];
    if istrue then
    begin
      backsubstitute.Enabled:=true;
      B1.Enabled:=true;
    end;
  end;
end;

procedure TMainGauss.backSubstituteClick(Sender: TObject);
var
  sigema:real;
  i,j:byte;
  solution:string;
begin
  with MyData do
  begin
    for i:=1 to N do
      x[i]:=0;
    x[N]:=a[N+1,N];
    for i:=N-1 downto 1 do
    begin
      sigema:=0;
      for j:=N downto i do
        sigema:=sigema+x[j]*a[j,i];
      x[i]:=a[N+1,i]-sigema;
    end;
    //将 x[i] 的值回代到上一个方程中去；

    for i:=1 to N do
      solution:=solution+'X['+FloatToStr(i)+']='+FloatToStrF(X[i],ffFixed,4,4)+'    '+#13#10;
    MessageDlg(solution,mtInformation,[mbOk],0);
    backsubstitute.Enabled:=false;
    B1.Enabled:=false;
  end;
end;

procedure TMainGauss.A1Click(Sender: TObject);
begin
  showmessage('Copyright 2006 Hu Chao Studio. protected by the USA！'#10#10'Mailto: [e-mail] register for an open-coded version！');
end;

procedure TMainGauss.sgSetEditText(Sender: TObject; ACol, ARow: Integer;
  const Value: String);
var
  i,j,counter:byte;
begin
  counter:=0;
  for i:=1 to se.Value+1 do
    for j:=1 to se.Value do
      if sg.Cells[i,j]<>'' then
        counter:=counter+1
      else if sg.Cells[i,j]='' then      //实现对方程组系数修改的所见即所得，直接能消元计算；
      begin
        counter:=counter-1;
        eliminate.Enabled:=false;
      end;
  if counter = se.Value*se.Value+se.Value then
    eliminate.Enabled:=true;

  with MyData do
  begin
    N:=se.Value;
    if (sg.Cells[ACol,ARow]<>'') and (sg.Cells[ACol,ARow]<>'-') then      //数据实时采集；
      a[ACol,ARow]:=StrToFloat(sg.Cells[ACol,ARow]);
  end;
end;

procedure TMainGauss.iterationClick(Sender: TObject);
var
  i,j,k,MainCol:byte;
  temp,sigema,counter:real;
  solution: string;
begin
  with MyData do
  {for j:=1 to N do
  begin
    for i:=j+1 to N do
      if (a[j,i]>a[j,MainCol]) then
        MainCol:=i;
    if MainCol<>j then
    begin
      for k:=1 to N+1 do              //列主元素的选取;
      begin
        temp:=a[k,MainCol];
        a[k,MainCol]:=a[k,j];
        sg.Cells[k,MainCol]:=FloatToStr(a[k,MainCol]);
        a[k,j]:=temp;
        sg.Cells[k,j]:=FloatToStr(a[k,j]);
      end;
      ShowMessage('将第'+FloatToStr(MainCol)+'行和第'+FloatToStr(j)+'行互换！');
      if j = N then}
      begin
        for i:=1 to N do
          x[i]:=0;
        counter:=0;
        repeat
        for i:=1 to N do
        begin
          sigema:=0;
          for j:=1 to N do
            sigema:=sigema+x[j]*a[j,i];
          sigema:=sigema-x[i]*a[i,i];
          x[i]:=0.5*(a[N+1,i]-sigema)/a[i,i];
        end;
        counter:=counter+1;
        until counter = 100;
        for i:=1 to N do
          solution:=solution+'X['+FloatToStr(i)+']='+FloatToStrF(X[i],ffGeneral,4,6)+'    '+#13#10;
        MessageDlg(solution,mtInformation,[mbOk],0);
      end;
      
      //else continue;
   // end;
       
  //end;
end;

end.