📄 gauss1unit.pas
字号:
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.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -