unit Gauss1Unit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, DBCtrls, dbcgrids, Grids, DBGrids, dblookup;

type
  TGauss1Form = class(TForm)
    Label1: TLabel;
    ExitButton: TButton;
    GroupBox1: TGroupBox;
    Label3: TLabel;
    Label4: TLabel;
    ReInputButton: TButton;
    KeyButton: TButton;
    MatrixMemo: TMemo;
    ResultMemo: TMemo;
    SysHint: TMemo;
    procedure ExitButtonClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure MatrixMemoOnClick(Sender: TObject);
    procedure ReInputButtonClick(Sender: TObject);
    procedure KeyButtonClick(Sender: TObject);
    procedure MatrixMemoOnExit(Sender: TObject);
    procedure StrToMat();
    procedure Translate(str: string;l: integer);
    procedure GaussXY();
    procedure GaussHD();
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Gauss1Form: TGauss1Form;
  Mat: array[1..100,1..100] of double;
  Row,Tier: integer;  //行標、列標
  MatR,MatT: integer; //行，列總數
  ClearMemo: boolean; //是否需要清空
  MyKey: boolean;     //是否可以進行計算
  HDKey: boolean;     //是否能用Gauss消去法求解(方程能否夠進行回代過程)
  hLine: integer;     //操作提示框行標
  ReMsg: string;      //輸出結果提示
  MatMsg0: array[0..10] of string; //操作提示0
  MatMsg1: array[0..10] of string; //操作提示1
  MatMsg2: array[0..10] of string; //操作提示2
  MatMsg3: array[0..10] of string; //操作提示3
  ErrSum: integer;
  error:array[1..20] of string;    //錯誤提示

implementation

{$R *.dfm}

procedure TGauss1Form.ExitButtonClick(Sender: TObject);
begin
  Close;
end;

procedure TGauss1Form.FormCreate(Sender: TObject);
begin
  Row:=1;Tier:=1;
  ClearMemo:=true;
  MyKey:=false;    //輸入未完成，不可計算
  ErrSum:=0;       //錯誤數初始值置0
  Gauss1Form.ResultMemo.ReadOnly:=true;//只讀
  Gauss1Form.SysHint.ReadOnly:=true;
  //版權信息
  MatMsg0[0]:='                                       Gauss消去法解線性方程組   1.05版';
  MatMsg0[1]:='                                   作者：長江大學  計算機科學學院  譚文政';
  MatMsg0[2]:='                                   郵箱：xia0tan2006@126.com';
  MatMsg0[3]:='                                              *  版權沒有  支持傳播  *';
  MatMsg0[4]:='說明：';
  MatMsg0[5]:='    本軟件系我Delphi學習習作，實現了用Gauss消去法解線性方程組，能識別用戶以文本方';
  MatMsg0[6]:='式輸入方程組增廣矩陣，并且能檢測一些常見的輸入錯誤及其位置，方程的解以文本方式輸';
  MatMsg0[7]:='出在結果顯示框。希望用戶盡量按照軟件操作提示操作，盡管我細心的考慮過很多可能出現';
  MatMsg0[8]:='的錯誤，但仍有許多不足的地方，歡迎各位朋友發現并指出，本人非常感激。';
  MatMsg0[9]:='                                                                                             2006年3月  譚文政';
  //操作提示
  MatMsg1[0]:='矩陣格式定義：<矩陣開始符>數字<元素分隔符>數字...<行結束符>...<矩陣結束符>。      ';
  MatMsg1[1]:='   注釋：必須是一個線性方程組的增廣矩陣（即：滿足總列數等于總行數加1），矩陣開始、';
  MatMsg1[2]:='結束符號分別為"["和"]"，元素分隔符可以是","或空格，行結束符只能是";"。請按要求輸入。';
  //輸出結果說明
  MatMsg2[0]:='方程組求解結果以文本方式輸出在結果顯示框（可以復制）';
  MatMsg2[1]:='例如：X1=3.14，X2=-7.3  ...';
  //錯誤提示
  error[1]:='ERROR(1):矩陣缺少開始符號"[".';
  error[2]:='ERROR(2):小數點不能打頭.';
  error[3]:='ERROR(3):同一個數字里面出現多個小數點';
  error[4]:='ERROR(4):負號不能出現在一個數的中間';
  error[5]:='ERROR(5):0不能作數字打頭';
  error[6]:='ERROR(6):多余元素分隔符","';
  error[7]:='ERROR(7):出現非法字符';
  error[8]:='ERROR(8):矩陣行列數錯誤';
  error[9]:='ERROR(9):與上行元素個數不相等';

end;

procedure TGauss1Form.MatrixMemoOnClick(Sender: TObject);
begin
  ErrSum:=0;    //更新矩陣，錯誤總數置0
  Gauss1Form.SysHint.Clear();
  for hLine:=0 to 2 do
  begin
    Gauss1Form.SysHint.Lines.Add(MatMsg1[hLine]);
  end;
  
  if(ClearMemo=True)then //是否需要清空輸入框
  begin
    Gauss1Form.MatrixMemo.Clear();
    Gauss1Form.MatrixMemo.SetFocus();
    ClearMemo:=false;
  end;
end;

procedure TGauss1Form.ReInputButtonClick(Sender: TObject);
begin
  ErrSum:=0;          //重新輸入矩陣，錯誤總數置0
  if(ClearMemo=false)then
  begin
    Gauss1Form.MatrixMemo.Lines.Text:='在此輸入增廣矩陣';
    ClearMemo:=true;  //表示需要清空輸入框
  end;
  Gauss1Form.SysHint.Clear();
  for hLine:=0 to 9 do
  begin
    Gauss1Form.SysHint.Lines.Add(MatMsg0[hLine]);
  end;
  hLine:=0;
  Gauss1Form.ResultMemo.Text:='結果顯示框';
end;

procedure TGauss1Form.KeyButtonClick(Sender: TObject);
var
  k: integer;
begin
  if(Gauss1Form.MatrixMemo.Lines.Strings[0]='在此輸入增廣矩陣')then
  begin
    ShowMessage('請輸入矩陣再進行求解');
    exit;
  end;
  if(MyKey=true)then
  begin
    MyKey:=false;  //正在計算中，不可計算
    GaussXY();     //消元過程
    if(HDKey=true)then
    begin
      GaussHD();   //回代過程
    end else
    begin
      Gauss1Form.ResultMemo.Text:='該方程組不能用Gauss消去法求解';
      exit;
    end;
  end else
  begin
    Gauss1Form.SysHint.Lines.Add('不可計算,請先更正矩陣錯誤');
    exit;          //MyKey=false,不可計算
  end;
  Gauss1Form.ResultMemo.Clear();
  Gauss1Form.ResultMemo.Text:='方程組求解結果:';
  for k:=1 to MatR do
  begin
    Gauss1Form.ResultMemo.Lines.Add('   X'+IntToStr(k)+'='+FloatToStr(Mat[k][MatT]));
  end;
  Gauss1Form.SysHint.Lines.Add('方程組求解結果已輸出在結果顯示框');
end;

procedure TGauss1Form.MatrixMemoOnExit(Sender: TObject);
begin
//輸入完成且無錯誤，設置MyKey:=true，即可以進入求解
  ErrSum:=0;          //編譯前將總錯誤數置0
  StrToMat();
  if(ErrSum=0)then
  begin
    MyKey:=true;      //MyKey=true 可以進行計算
  end else
  begin
    Gauss1Form.ResultMemo.Text:='矩陣有錯誤，請更正或重新輸入';
  end;
end;

procedure TGauss1Form.StrToMat();
var
  lStr: string;
  l: integer;       //MatrixMemo文本行標
begin
  lStr:='';l:=0;MatR:=0;MatT:=0;
  Gauss1Form.SysHint.Text:='正在讀取矩陣...';
  lStr:=Gauss1Form.MatrixMemo.Lines.Strings[l];
  while (lStr<>'') do
  begin
    Translate(lStr,l);
    l:=l+1;
    lStr:=Gauss1Form.MatrixMemo.Lines.Strings[l];
  end;
  if((MatR=0)or(MatT=0)or((MatT-MatR)<>1))then
  begin
    Gauss1Form.SysHint.Lines.Add('    '+error[8]);
    ErrSum:=ErrSum+1;
  end;
  Gauss1Form.SysHint.Lines.Add('矩陣共 '+IntToStr(ErrSum)+'錯誤');
end;

procedure TGauss1Form.Translate(str: string;l: integer);
var
  ErrHint: string; //錯誤提示字符串
  nStr: string;    //臨時存放數字字符串
  Point: boolean;
  i: integer;
begin
  i:=1; ErrHint:=''; nStr:=''; Point:=false;
  if(l=0)then
  begin
    if((str='')or(str='在此輸入增廣矩陣'))then
    begin
      ErrSum:=ErrSum+1;
      ShowMessage('請輸入矩陣再進行求解');
    end
    else if(str[1]<>'[')then
    begin
      ErrSum:=ErrSum+1;
      ErrHint:='    第'+IntToStr(l)+'行  '+error[1];
      Gauss1Form.SysHint.Lines.Add(ErrHint);
    end else
    begin
      i:=i+1;
    end;
  end;

  while(str[i]<>'')do
  begin
    if((str[i]>='0')and(str[i]<='9')or(str[i]='.')or(str[i]='-'))then
    begin
      if(str[i]='.')then
      begin
        if(nStr='')then
        begin
          ErrSum:=ErrSum+1;
          ErrHint:='    第'+IntToStr(l)+'行  '+error[2];
          Gauss1Form.SysHint.Lines.Add(ErrHint);
        end
        else if(Point=true)then //Point確定該數是否已經是小數
        begin
          ErrSum:=ErrSum+1;
          ErrHint:='    第'+IntToStr(l)+'行  '+error[3];
          Gauss1Form.SysHint.Lines.Add(ErrHint);
        end else
        begin
          nStr:=nStr+str[i];
          Point:=true;      //將該數設為小數
        end;
      end
      else if((str[i]='-')and(nStr<>''))then
      begin
        ErrSum:=ErrSum+1;
        ErrHint:='    第'+IntToStr(l)+'行  '+error[4];
        Gauss1Form.SysHint.Lines.Add(ErrHint);
      end
      else if(nStr='0')then//如果第一個字符為"0"，不能跟除"."外的任何字符
      begin
        ErrSum:=ErrSum+1;
        ErrHint:='    第'+IntToStr(l)+'行  '+error[5];
        Gauss1Form.SysHint.Lines.Add(ErrHint);
      end else
      begin
        nStr:=nStr+str[i];
      end;
    end
    else if((str[i]=' ')or(str[i]=','))then //連續的空格可以忽略
    begin
      if(nStr<>'')then
      begin
        //ShowMessage('行:'+IntToStr(Row)+'列:'+IntToStr(Tier)+'值:'+nStr);
        Mat[Row][Tier]:=StrToFloat(nStr);
        nStr:=''; Point:=false;
        Tier:=Tier+1;
      end
      else if(str[i]=',')then   //空格后面不能有','分隔符
      begin
        ErrSum:=ErrSum+1;
        ErrHint:='    第'+IntToStr(l)+'行  '+error[6];
        Gauss1Form.SysHint.Lines.Add(ErrHint);
      end;
    end
    else if(str[i]=';')then  //如果同時出現多個";"呢？如果";"打頭呢？
    begin
      //ShowMessage('行:'+IntToStr(Row)+'列:'+IntToStr(Tier)+'值:'+nStr);
      if(nStr<>'')then
      begin
        Mat[Row][Tier]:=StrToFloat(nStr);
        nStr:=''; Point:=false;
        Tier:=Tier+1;
      end;
      Row:=Row+1; //行加1
      if((MatT<>0)and(Tier<>MatT))then
      begin
        ErrSum:=ErrSum+1;
        ErrHint:='    第'+IntToStr(l)+'行  '+error[9];
        Gauss1Form.SysHint.Lines.Add(ErrHint);
      end;
      MatT:=Tier;
      Tier:=1;    //換到下一行的開始
    end
    else if(str[i]=']')then  //如果"]"出現在中間呢？
    begin
      //ShowMessage('行:'+IntToStr(Row)+'列:'+IntToStr(Tier)+'值:'+nStr);
      if(nStr<>'')then
      begin
        Mat[Row][Tier]:=StrToFloat(nStr);
        nStr:=''; Point:=false;
        Tier:=Tier+1;
      end;
      if((MatT<>0)and(Tier<>MatT))then
      begin
        ErrSum:=ErrSum+1;
        ErrHint:='    第'+IntToStr(l)+'行  '+error[9];
        Gauss1Form.SysHint.Lines.Add(ErrHint);
      end;
      MatR:=Row;MatT:=Tier-1;
      //ShowMessage(' 行數：'+IntToStr(MatR)+' 列數：'+IntToStr(MatT));
      Row:=1;Tier:=1;
      exit;
    end else
    begin
      ErrSum:=ErrSum+1;
      ErrHint:='    第'+IntToStr(l)+'行  '+error[7];
      Gauss1Form.SysHint.Lines.Add(ErrHint);
    end;
    i:=i+1;
  end;
end;

procedure TGauss1Form.GaussXY();
var
  k,i,j:integer;
begin
  //Gauss消去法消元過程
  for k:=1 to MatR-1 do
  begin
    for i:=k+1 to MatR do
    begin
      for j:=k+1 to MatT do
      begin
        if(Mat[k][k]=0)then
        begin
          HDKey:=false;//不能用Gauss消去法求解
          exit;
        end;
        Mat[i][j]:=Mat[i][j]-(Mat[i][k]/Mat[k][k])*Mat[k][j];
      end;
    end;
  end;
  HDKey:=true;//能用Gauss消去法求解
end;

procedure TGauss1Form.GaussHD();
var
  k,j: integer;
  SumM: double;
begin
  SumM:=0;
  Gauss1Form.SysHint.Lines.Add('總行數：'+IntToStr(MatR)+'  總列數：'+IntToStr(MatT));
  Mat[MatR][MatT]:=Mat[MatR][MatT]/Mat[MatR][MatT-1];
  //ShowMessage(FloatToStr(Mat[MatR][MatT]));
  for k:=MatR-1 to 1 do
  begin
    for j:=k+1 to MatR do
    begin
      SumM:=SumM+Mat[k][j]*Mat[j][MatT];
      //ShowMessage(FloatToStr(SumM));
    end;
    Mat[k][MatT]:=(Mat[k][MatT]-SumM)/Mat[k][k];
    //ShowMessage(FloatToStr(Mat[k][MatT]));
    SumM:=0;
  end;
end;

end.