忆海拾贝——让你看一个早期的DELPHI小程序（忆海拾贝什么意思）-桂林市农业科学研究中心

拟合平滑回归分析

忆海拾贝——让你看一个早期的DELPHI小程序（忆海拾贝什么意思）

程序模块图

忆海拾贝——让你看一个早期的DELPHI小程序（忆海拾贝什么意思）

设计模块图

由于程序中的注释做得全面，方便了解程序模块的意义。

unit U_MultiLineRegress;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, ComCtrls, ExtCtrls, Menus, jpeg, Grids,U_RollFont,

StrUtils,Math, DB, ADODB, Buttons, ToolWin, IniFiles,U_parsor, ComOBJ,

ExcelXP, Printers, Registry, shellapi;

type

TF_MultiLineRegress = class(TForm)

StatusBar1: TStatusBar;

Panel1: TPanel;

Image1: TImage;

Panel2: TPanel;

Panel3: TPanel;

Label100: TLabel;

ProgressBar1: TProgressBar;

OpenDialog1: TOpenDialog;

ADOTable1: TADOTable;

Panel4: TPanel;

ToolBar1: TToolBar;

SpeedButton1: TSpeedButton;

SpeedButton2: TSpeedButton;

SpeedButton3: TSpeedButton;

SpeedButton4: TSpeedButton;

SpeedButton5: TSpeedButton;

SpeedButton6: TSpeedButton;

Panel5: TPanel;

GroupBox1: TGroupBox;

Button1: TButton;

StringGrid1: TStringGrid;

Button2: TButton;

GroupBox2: TGroupBox;

Memo1: TMemo;

Button4: TButton;

Button5: TButton;

Button6: TButton;

SaveDialog1: TSaveDialog;

Label1: TLabel;

Label2: TLabel;

PrintDialog1: TPrintDialog;

Panel6: TPanel;

Label4: TLabel;

Label5: TLabel;

Label6: TLabel;

Edit1: TEdit;

Edit2: TEdit;

Panel7: TPanel;

Label7: TLabel;

Button7: TButton;

Button8: TButton;

Button3: TButton;

Timer1: TTimer;

Bevel1: TBevel;

Label3: TLabel;

Label8: TLabel;

Image2: TImage;

Bevel2: TBevel;

procedure Label7Click(Sender: TObject);

procedure Timer1Timer(Sender: TObject);

procedure Button3Click(Sender: TObject);

procedure Button7Click(Sender: TObject);

procedure Button8Click(Sender: TObject);

procedure SpeedButton5Click(Sender: TObject);

procedure SpeedButton4Click(Sender: TObject);

procedure Button6Click(Sender: TObject);

procedure Button5Click(Sender: TObject);

procedure Button4Click(Sender: TObject);

procedure FormClose(Sender: TObject; var Action: TCloseAction);

procedure SpeedButton2Click(Sender: TObject);

procedure SpeedButton1Click(Sender: TObject);

procedure SpeedButton6Click(Sender: TObject);

procedure SpeedButton3Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure Button1Click(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure FormResize(Sender: TObject);

Type TCoordiateRecord=record //定义二维坐标记录类型

xscreen:integer; //在屏幕上画的屏幕坐标点

zscreen:integer;

end;

Type matrx2=Array of Array of Double; //定义二维数组类matrx2

private

X_num,Y_num,Z_num,X_0,Z_0:integer;//单位坐标像素值,坐标原点在屏幕位置像素值

y_Axis:Boolean; //T为画Y轴,即Y轴上的标刻方向全向上,F为画其它轴,标刻方向另取

k:integer;//实验值序号

drawK:Boolean; //表示曲线是否画出

RunNum:smallint; //运行次数,未注册用户只有用20次

err_num:smallint; //输入密码次数

NoRegistry:Boolean; //没有注册开关

LoginCode:shortstring; //注册码

MachineCode0,MachineCode1:string; //机器码

{ Private declarations }

//自定义星期函数

Function f_get_week:shortString;

Procedure ReadWriteIniFile;//读写初始文件

procedure OpenChildForm(FormClass:TFormClass;var Fm;AOwner:TComponent);

procedure CoordInitValue;//计算坐标初始值

function WorldToScreen(var xworld,yworld,zworld:Double):TCoordiateRecord;//世界坐标转为屏幕坐标函数

procedure DrawLine(var x1world,y1world,z1world,x2world,y2world,z2world:Double);//画线段过程

procedure ArrowHead(var x1world,y1world,z1world,x2world,y2world,z2world:Double);//画箭头过程

procedure Scale(var x1world,y1world,z1world,//画刻度及标尺过程

x2world,y2world,z2world:Double;a,b:smallint);//a,b是线段画刻度的起始值

procedure WriteCoordinateName(var xworld,yworld,zworld:Double;

Ax,Ay:smallint;char:shortstring);//写坐标轴标识字过程

procedure BackGroundColor; //画背景颜色

procedure Draw2DCoordinate; //画二维坐标

procedure Draw3DCoordinate; //画三维坐标

procedure DrawMultiCurve(Expre:string;CurveColor:TColor);//画多项式表达式曲线

procedure DrawFoldLine(StrGrd:TStringGrid;Col:integer;Color:TColor);//画五点三次平滑数据点的折线

procedure DrawDataCross(StrGrd:TStringGrid);//将StrGrd中的数据用' '号画出来

procedure InputTextDocm(StringGrid:TStringGrid);

function ChEnCharLen(Str:string):integer;

procedure InputExcelDocm(ADOTable:TADOTable;

ExcelSheet:shortstring;StringGrid:TStringGrid);

procedure InputAccessDocm(ADOTable:TADOTable;

AccessSheet:shortstring;StringGrid:TStringGrid);//录入ACCESS表记录

procedure InputSQLDocm(ADOTable:TADOTable;

SQLSheet:shortstring;StringGrid:TStringGrid);//录入SQLServer表记录

procedure DrawCrossLine(var xworld,yworld,zworld:Double;Color:TColor);//把实验数据点画为‘ ‘号

procedure PrintConic;//打印显示曲线过程

procedure PrintMemoData(Memo:TMemo);//打印分析结果过程

Procedure LoginInitialize;//注册初始值

Procedure ReadRegistry;//读注册表过程

Procedure WriteRegistry;//写注册表过程

function Serial(Num:DWORD):string;//加密函数

procedure LeastQudricCurveJoin(N,P:integer); //最小二乘曲线拟合

procedure LeastQudricFaceJoin(N,M,P,Q:integer); //最小二乘曲面拟合

procedure CheBySheV(N,P:integer); //切比雪夫曲线拟合

procedure Remez(N:integer;A,B:Double); //最佳一致逼近

procedure FiveThreeSmooth(StrGrd:TStringGrid;ColRead,ColWrite:integer);//五点三次平滑

procedure OneLineRegress(StrGrd:TStringGrid); //一元线性回归分析

procedure MulLineRegress(StrGrd:TStringGrid); //多元线性回归

procedure StepRegress(StrGrd:TStringGrid;F1,F2,E:Double);//逐步回归

procedure StrGrdDeleteRow(StrGrd:TStringGrid); //在StringGrid表格中删除行

procedure StrGrdInsertRow(StrGrd:TStringGrid); //在StringGrid表格中插入行

procedure StrGrdToText( //StringGrid保存为文本

StrGrd:TStringGrid; //转换成文本的StringGrid表格

DocmName:Shortstring); //转换成文本的表头标题名

procedure StrGrdToExcel( //StringGrid转换成Excel表显示

StrGrd:TStringGrid; //转换成Excel的StringGrid表格

DocmName:Shortstring); //转换成Excel表的标题名

public //TTowArray

CoordX_min,CoordX_max:Double;//X坐标范围

CoordY_min,CoordY_max:Double;//Y坐标范围

CoordZ_min,CoordZ_max:Double;//Z坐标范围

DrawX_min,DrawX_max:Double; //X绘图范围

DrawY_min,DrawY_max:Double; //Y绘图范围

DrawZ_min,DrawZ_max:Double; //Z绘图范围

DrawX_step,DrawY_step:integer; //X,Y方向网格宽

CoordXY_Angle:Double; //坐标XY夹角

Width1,Width2,Width3:Smallint; //坐标曲线线宽

Color1,Color2,Color3,Color4:TColor;//背景坐标曲线数据颜色

Variable_Num:shortint;//多元线性方程的变量个数,2变量(二维坐标),3变量(三维坐标)

Record_Num:integer; //实验记录条数

AnalysSel:shortstring;//拟合平滑回归选择:a最小二乘曲线拟合,b最小二乘曲面拟合

//c切比雪夫曲线拟合,d最佳一致逼近平滑,e一元线性回归,

//f二或多元线性回归,g逐步回归,h五点三次平滑

DataPoint_X,DataPoint_Y:integer;//实验数据点个数

Degree_X,Degree_Y:integer; //拟合多项式中X,Y最高次幂数 1；

Area_X,Area_Y:Double; //最佳一致逼近函数取值区间

Precision:Double; //最佳一致逼近中多项式与函数的精度

B_DrawFunc,B_DrawMult:Boolean;//画模拟函数和拟合多项式图

func:string; //参考模拟函数

X_Average,Y_Average:Boolean; //分析中为防溢出取X,Y变量平均值

SheetName:String; //一次性调入数据文件的数据表名

Test_F1,Test_F2:Double; //选入或剔除因子显著性检验值F1,F2

B_AnalysSel:Boolean; //分析选择开关,只有使用了"分析选择"才能运行"执行操作"

AnalyseSelect_k:Boolean; //表示AnalyseSelect子窗口是否打开

{ Public declarations }

procedure StrGrdChang(StrGrd:TStringGrid);//StringGrid列变

procedure InputFileData;//文件调入数据子过程

end;

var

F_MultiLineRegress: TF_MultiLineRegress;

implementation

uses U_AnalyseSelect,U_CoordSet,U_FileDataInput, CPUID;

var TRollThread:TRollFontThread;//创建滚动字符线程一个新线和TRollThread

{$R *.dfm}

//坐标设置

procedure TF_MultiLineRegress.SpeedButton1Click(Sender: TObject);

begin

OpenChildForm(TF_CoordSet,F_coordSet,self);

end;

//分析选择按钮

procedure TF_MultiLineRegress.SpeedButton2Click(Sender: TObject);

begin

OpenChildForm(TF_AnalyseSelect,F_AnalyseSelect,self);

end;

//执行操作按钮

procedure TF_MultiLineRegress.SpeedButton3Click(Sender:TObject);

var N,M,P,Q,Col:integer;

i,j,w:integer;

E,X,Y:Double;

XX,YY:Array of Double;

begin

if B_AnalysSel=False then

begin

if Application.MessageBox('您还没有选择您所需要分析的内容！'

#13 '是否需要打开“分析选择”窗口？','系统提示',

MB_IconInformation MB_YesNo)=mrYes then

begin

B_AnalysSel:=False;

SpeedButton2.Click;

end;

Exit;

end;

B_AnalysSel:=False; //分析选择开关,只有使用了"分析选择"才能运行"执行操作"

drawK:=True; //表示已经绘图

Image1.Picture:=nil; //清空画面,便于再画

BackGroundColor; //画背景颜色

if AnalysSel='a' then //1最小二乘曲线拟合

begin

Draw2DCoordinate; //画二维坐标

//最小二乘曲线拟合子过程赋值

N:=DataPoint_X; //多项式X实验数据个数

P:=Degree_X 1; //X项最高次数幂，即线性多项式项数

StringGrid1.RowCount:=N 1;

E:=0;

for i:=1 to N do

begin

StringGrid1.Cells[0,i]:=inttostr(i);

X:=0.1*(i-1);

StringGrid1.Cells[1,i]:=floattostr(X);

Y:=X-exp(-X);

StringGrid1.Cells[2,i]:=floattostr(Y);

DrawCrossLine(X,E,Y,Color4);//把实验数据点画为‘ ‘号

end;

//调用最小二乘曲线拟合子过程

LeastQudricCurveJoin(N,P);

end else if AnalysSel='b' then //2最小二乘曲面拟合

begin

Draw3DCoordinate; //画三维坐标

//最小二乘曲面拟合子过程赋值

N:=DataPoint_X; //多项式X实验数据个数

M:=DataPoint_Y; //多项式Y实验数据个数

P:=Degree_X 1; //多项式X项最高次数幂

Q:=Degree_Y 1; //多项式Y项最高次数幂

SetLength(XX,N);SetLength(YY,M);

StringGrid1.RowCount:=N*M 1;

for i:=1 to N do

begin

XX[i]:=0.2*(i-1);

StringGrid1.Cells[1,i]:=floattostr(XX[i]);

end;

for i:=1 to M do

begin

YY[i]:=0.1*(i-1);

StringGrid1.Cells[2,i]:=floattostr(YY[i]);

end;

w:=0;

for i:=1 to N do

begin

for j:=1 to M do

begin

w:=w 1;

StringGrid1.Cells[0,w]:=inttostr(w);

StringGrid1.Cells[3,w]:=floattostr(exp(XX[i]*XX[i]-YY[j]*YY[j]));

end;

//调用最小二乘曲面拟合子过程

LeastQudricFaceJoin(N,M,P,Q);

end else if AnalysSel='c' then //3切比雪夫曲线拟合

begin

Draw2DCoordinate; //画二维坐标

//切比雪夫子过程赋值

N:=DataPoint_X; //多项式X实验数据个数

P:=Degree_X 1; //多项式项数,最高次数幂为P-1

//取拟合数据到表

StringGrid1.RowCount:=N 1;

E:=0;

for i:=1 to N do

begin

StringGrid1.Cells[0,i]:=inttostr(i);

X:=-6 0.6*(i-1);

StringGrid1.Cells[1,i]:=floattostr(X);

Y:=arctan(X);

StringGrid1.Cells[2,i]:=floattostr(Y);

DrawCrossLine(X,E,Y,Color4);//把实验数据点画为‘ ‘号

end;

//切比雪夫曲线拟合

CheBySheV(N,P);

end else if AnalysSel='d' then //4最佳一致逼近米兹方法

begin

Draw2DCoordinate; //画二维坐标

X:=Area_X; //函数取值左区间

Y:=Area_Y; //函数取值右区间

N:=Degree_X 1; //逼近多项式最大幂指数

Remez(N,X,Y); //调用最佳一致逼近米兹方法

end else if AnalysSel='e' then //5一元线性回归

begin

Draw2DCoordinate; //画二维坐标

DrawDataCross(StringGrid1);//将StrGrd中的数据用' '号画出来

OneLineRegress(StringGrid1);//调用一元线性回归

end else if AnalysSel='f' then //6多元线性回归

begin

Draw3DCoordinate; //画三维坐标

DrawDataCross(StringGrid1);//将StrGrd中的数据用' '号画出来

MulLineRegress(StringGrid1); //调用多元线性回归

end else if AnalysSel='g' then //7逐步回归（三维以上）

begin

Draw3DCoordinate; //画三维坐标

DrawDataCross(StringGrid1);//将StrGrd中的数据用' '号画出来

StepRegress(StringGrid1,Test_F1,Test_F2,Precision);//调用逐步回归

end else if AnalysSel='h' then //8五点三次平滑分析

begin

Draw2DCoordinate; //画二维坐标

//调用五点三次平滑分析

P:=1;

Q:=2;

FiveThreeSmooth(StringGrid1,P,Q);

Col:=P; //画实验数据折线

DrawFoldLine(StringGrid1,Col,Color4);

Col:=Q; //画平滑数据折线

DrawFoldLine(StringGrid1,Col,Color3);

Memo1.Lines.Append('五点三次平滑分析结果：');

Memo1.Lines.Append('绿色折线是实验数据折线！');

Memo1.Lines.Append('红色折线是平滑数据折线！');

end;

//1最小二乘曲线拟合 DT1,DT2,DT3输出参数，分别是拟合多项式与数据点偏差的平方和、绝对值和、绝对值最大值

procedure TF_MultiLineRegress.LeastQudricCurveJoin(N,P:integer);

var i,j,v:integer;//N拟合数据个数,M拟合多项式项数

X,Y,A,B,S,T:Array of Double; //8字节浮点变量

Z,D1,R,C,D2,G,Q,DT,DT1,DT2,DT3:Double;

Xd,Exd,flag,Expr,strtemp:string;//最后写多项式表达式时的临时变量

begin

//为动态数据开辟内存

SetLength(X,N 1);

SetLength(Y,N 1);

SetLength(A,P 1);

SetLength(B,N 1);

SetLength(S,N 1);

SetLength(T,N 1);

//从表上取拟合数据到变量

for i:=1 to N do

begin

X[i]:=strtofloat(StringGrid1.Cells[1,i]);

Y[i]:=strtofloat(StringGrid1.Cells[2,i]);

end;

//开始拟合

Q:=0;

Z:=0;

if X_Average=True then for i:=1 to N do Z:=Z X[i];//防溢出取自变量平均值Z

Z:=Z/N;

B[1]:=1;

D1:=N;

R:=0;

C:=0;

for i:=1 to N do

begin

R:=R X[i]-Z;

C:=C Y[i];

end;

C:=C/D1;

R:=R/D1;

A[1]:=C*B[1];

if P>1 then

begin

T[2]:=1;

T[1]:=-R;

D2:=0;

C:=0;

G:=0;

for i:=1 to N do

begin

Q:=X[i]-Z-R;

D2:=D2 Q*Q;

C:=Y[i]*Q C;

G:=(X[i]-Z)*Q*Q G;

end;

C:=C/D2;

R:=G/D2;

Q:=D2/D1;

D1:=D2;

A[2]:=C*T[2];

A[1]:=C*T[1] A[1];

end;

for j:=3 to P do

begin

S[j]:=T[j-1];

S[j-1]:=-R*T[j-1] T[j-2];

if j>=4 then

begin

v:=j-2;

while v>=2 do

begin

S[v]:=-R*T[v] T[v-1]-Q*B[v];

v:=v-1;

end;

S[1]:=-R*T[1]-Q*B[1];

D2:=0;

C:=0;

G:=0;

for i:=1 to N do

begin

Q:=S[j]; //j

v:=j-1;

while v>=1 do

begin

Q:=Q*(X[i]-Z) S[v];

v:=v-1;

end;

D2:=D2 Q*Q;

C:=Y[i]*Q C;

G:=(X[i]-Z)*Q*Q G;

end;

C:=C/D2;

R:=G/D2;

Q:=D2/D1;

D1:=D2;

A[j]:=C*S[j];

T[j]:=S[j];

v:=j-1;

while v>=1 do

begin

A[v]:=C*S[v] A[v];

B[v]:=T[v];

T[v]:=S[v];

v:=v-1;

end;

DT1:=0;

DT2:=0;

DT3:=0;

for i:=1 to N do

begin

Q:=A[P];

v:=P-1;

while v>=1 do

begin

Q:=Q*(X[i]-Z) A[v];

v:=v-1;

end;

DT:=Q-Y[i];

if abs(DT)>DT3 then DT3:=abs(DT);

DT1:=DT1 DT*DT;

DT2:=DT2 abs(DT);

end;

//绘拟合后的多项式表达式

Expr:=floattostr(A[1]);

Xd:='';

for i:=2 to P do

begin

if A[i]>0 then

begin

flag:=' ';

//不取平均值，取平均值的不同表达式

if X_Average=False then Xd:=Xd '*x' else Xd:=Xd '*(x-' floattostr(Z) ')';

Exd:=floattostr(A[i]) Xd;

Expr:=Expr flag Exd;

end else if A[i]<0 then

begin

flag:='';

if X_Average=False then Xd:=Xd '*x' else Xd:=Xd '*(x-' floattostr(Z) ')';

//Xd:=Xd '*x';

Exd:=floattostr(A[i]) Xd;

Expr:=Expr flag Exd;

end;

//显示拟合后的结果

Memo1.Lines.Append('最小二乘曲线拟合');

Memo1.Lines.Append('标准多项式：P(x)=A[1] A[2](x-x0) A[3](x-x0)^2 … A[M 1](x-x0)^M');

Memo1.Lines.Append('其中平均值：x0=(x1 x2 … xN)/N=' floattostr(Z));

Memo1.Lines.Append('拟合多项式表达式如下：');

Memo1.Lines.Append('F(x)=' Expr ';');

for i:=1 to P do

begin //Memo中字符串之间不能夹插变量,变量之间不能夹插字符串输出,用strtemp变通

strtemp:=inttostr(i) ']：' floattostr(A[i]);

Memo1.Lines.Append('多项式系数A[' strtemp);

end;

Memo1.Lines.Append('多项式与数据点偏差平方和：' floattostr(DT1));

Memo1.Lines.Append('多项式与数据点偏差绝对值和：' floattostr(DT2));

Memo1.Lines.Append('多项式与数据点偏差绝对值最大值：' floattostr(DT3));

Memo1.Lines.Append('拟合函数式：f(x)=' func);

//将Expr表达式绘出曲线并与函数f(x)曲线比较

if B_DrawFunc=True then DrawMultiCurve(func,Color4);//画函数曲线

if B_DrawMult=True then DrawMultiCurve(Expr,Color3);//画多项式表达式曲线

end;

//2最小二乘曲面拟合

procedure TF_MultiLineRegress.LeastQudricFaceJoin(N,M,P,Q:integer);

var X,Y,APX,APY,BX,BY,T,T1,T2:Array of Double;//定义一维动态数组

A,U,V,Z:Array of Array of Double; //定义二维动态数组

XX,YY,D1,D2,G,G1,G2,X1,X2,Y1,DD,DT:Double;

DT1,DT2,DT3:Double;

i,j,w,f,h:integer;

flag:shortstring;//多项式系数A的加减号

//最后写多项式表达式时的临时变量

Xd,Yd,EXd,Expry,Exprx,Exprxy,Expr,strtemp:string;

begin

//给动态数组内存空间

SetLength(X,N 1); SetLength(Y,M 1); //给一维动态数组分配内存,从0开始

SetLength(APX,M); SetLength(APY,M);

SetLength(BX,M); SetLength(BY,M);

SetLength(T,M); SetLength(T1,M);

SetLength(T2,M);

SetLength(Z,N 1,M 1); SetLength(A,P 1,Q 1);//给二维动态数组分配内存,从0开始

SetLength(U,M,M); SetLength(V,M,M 1);

//将实验数据给变量

for i:=1 to N do X[i]:=strtofloat(StringGrid1.Cells[1,i]);

for i:=1 to M do Y[i]:=strtofloat(StringGrid1.Cells[2,i]);

w:=0;

for i:=1 to N do

begin

for j:=1 to M do

begin

w:=w 1;

Z[i,j]:=strtofloat(StringGrid1.Cells[3,w]); //给二维数组Z元素赋值

end;

//执行最小二乘曲面拟合

G:=1;

XX:=0;

if X_Average=True then for i:=1 to N do XX:=XX X[i];//为防溢出求X变量平均值

XX:=XX/N;

yy:=0;

if Y_Average=True then for i:=1 to M do YY:=YY Y[i];//为防溢出求Y变量平均值

YY:=YY/M;

D1:=N;

APX[1]:=0;

for i:=1 to N do APX[1]:=APX[1] X[i]-XX;

APX[1]:=APX[1]/D1;

for j:=1 to M do

begin

V[1,j]:=0;

for i:=1 to N do V[1,j]:=V[1,j] Z[i,j];

V[1,j]:=V[1,j]/D1;

end;

if P>1 then

begin

D2:=0;

APX[2]:=0;

for i:=1 to N do

begin

G:=X[i]-XX-APX[1];

D2:=D2 G*G;

APX[2]:=APX[2] (X[i]-XX)*G*G;

end;

APX[2]:=APX[2]/D2;

BX[2]:=D2/D1;

for j:=1 to M do

begin

V[2,j]:=0;

for i:=1 to N do

begin

G:=X[i]-XX-APX[1];

V[2,j]:=V[2,j] Z[i,j]*G;

end;

V[2,j]:=V[2,j]/D2;

end;

D1:=D2;

end;

for w:=3 to P do

begin

D2:=0;

APX[w]:=0;

for j:=1 to M do V[w,j]:=0;

for i:=1 to N do

begin

G1:=1;

G2:=X[i]-XX-APX[1];

for j:=3 to w do

begin

G:=(X[i]-XX-APX[j-1])*G2-BX[j-1]*G1;

G1:=G2;

G2:=G;

end;

D2:=D2 G*G;

APX[w]:=APX[w] (X[i]-XX)*G*G;

for j:=1 to M do V[w,j]:=V[w,j] Z[i,j]*G;

end;

for j:=1 to M do V[w,j]:=V[w,j]/D2;

APX[w]:=APX[w]/D2;

BX[w]:=D2/D1;

D1:=D2;

end;

D1:=M;

APY[1]:=0;

for i:=1 to M do APY[1]:=APY[1] Y[i]-YY;

APY[1]:=APY[1]/D1;

for j:=1 to P do

begin

U[j,1]:=0;

for i:=1 to M do U[j,1]:=U[j,1] V[j,i];

U[j,1]:=U[j,1]/D1;

end;

if Q>1 then

begin

D2:=0;

APY[2]:=0;

for i:=1 to M do

begin

G:=Y[i]-YY-APY[1];

D2:=D2 G*G;

APY[2]:=APY[2] (Y[I]-YY)*G*G;

end;

APY[2]:=APY[2]/D2;

BY[2]:=D2/D1;

for j:=1 to P do

begin

U[j,2]:=0;

for i:=1 to M do

begin

G:=Y[i]-YY-APY[1];

U[j,2]:=U[j,2] V[j,i]*G;

end;

U[j,2]:=U[j,2]/D2;

end;

D1:=D2;

end;

for w:=3 to Q do

begin

D2:=0;

APY[w]:=0;

for j:=1 to P do U[j,w]:=0;

for i:=1 to M do

begin

G1:=1;

G2:=Y[i]-YY-APY[1];

for j:=3 to w do

begin

G:=(Y[i]-YY-APY[j-1])*G2-BY[j-1]*G1;

G1:=G2;

G2:=G;

end;

D2:=D2 G*G;

APY[w]:=APY[w] (Y[i]-YY)*G*G;

for j:=1 to P do U[j,w]:=u[j,w] v[j,i]*G;

end;

for j:=1 to P do U[j,w]:=U[j,w]/D2;

APY[w]:=APY[w]/D2;

BY[w]:=D2/D1;

D1:=D2;

end;

V[1,1]:=1;

V[2,1]:=-APY[1];

V[2,2]:=1;

for i:=1 to P do for j:=1 to Q do A[i,j]:=0;

for i:=3 to Q do

begin

V[i,i]:=V[i-1,i-1];

V[i,i-1]:=-APY[i-1]*V[i-1,i-1] V[i-1,i-2];

if i>=4 then

begin

w:=i-2;

while w>=2 do

begin

V[i,w]:=-APY[i-1]*V[i-1,w] V[i-1,w-1]-BY[i-1]*V[i-2,w];

w:=w-1;

end;

V[i,1]:=-APY[i-1]*V[i-1,1]-BY[i-1]*V[i-2,1];

end;

for i:=1 to P do

begin

if i=1 then

begin

T[1]:=1;

T1[1]:=1;

end else if i=2 then

begin

T[1]:=-APX[1];

T[2]:=1;

T2[1]:=T[1];

T2[2]:=T[2];

end else

begin

T[i]:=T2[i-1];

T[i-1]:=-APX[i-1]*T2[i-1] T2[i-2];

if i>=4 then

begin

w:=i-2;

while w>=2 do

begin

T[w]:=-APX[i-1]*T2[w] T2[w-1]-BX[i-1]*T1[w];

w:=w-1;

end;

T[1]:=-APX[i-1]*T2[1]-BX[i-1]*T1[1];

T2[i]:=T[i];

w:=i-1;

while w>=1 do

begin

T1[w]:=T2[w];

T2[w]:=T[w];

w:=w-1;

end;

for j:=1 to Q do

begin

w:=i;

while w>=1 do

begin

f:=j;

while f>=1 do

begin

A[w,f]:=A[w,f] U[i,j]*T[w]*V[j,f];

f:=f-1;

end;

w:=w-1;

end;

DT1:=0;

DT2:=0;

DT3:=0;

for i:=1 to N do

begin

X1:=X[i]-XX;

for j:=1 to M do

begin

Y1:=Y[j]-YY;

X2:=1;

DD:=0;

for w:=1 to P do

begin

G:=A[w,Q];

h:=Q-1;

while h>=1 do

begin

G:=G*Y1 A[w,h];

h:=h-1;

end;

G:=G*X2;

DD:=DD G;

X2:=X2*X1;

end;

DT:=DD-Z[i,j];

if (abs(DT)>DT3) then DT3:=abs(DT);

DT1:=DT1 DT*DT;

DT2:=DT2 abs(DT);

end;

//绘拟合后的多项式表达式(这里的P,Q都已加1)

//求多项式的A[1,2]y A[1,3]y^2 .. A[1,Q]y^(Q-1)部分Expry

Xd:='';

Expry:='';

for j := 2 to Q do

begin

if A[1,j]>0 then

begin

flag:=' ';

//取平均值的不同表达式

if X_Average=False then Xd:=Xd '*y' else Xd:=Xd '*(y-' floattostr(YY) ')';

//Xd:=Xd '*y';

Exd:=floattostr(A[1,j]) Xd;

Expry:=Expry flag Exd;

end else if A[1,j]<0 then

begin

flag:='';

if X_Average=False then Xd:=Xd '*y' else Xd:=Xd '*(y-' floattostr(YY) ')';

//Xd:=Xd '*y';

Exd:=floattostr(A[1,j]) Xd;

Expry:=Expry flag Exd;

end;

//求多项的A[2,1]x A[3,1]x^2 .. A[p,1]x^(p-1)部分Exprx

Xd:='';

Exprx:='';

for i:=2 to P do

begin

if A[i,1]>0 then

begin

flag:=' ';

//取平均值的不同表达式

if X_Average=False then Xd:=Xd '*x' else Xd:=Xd '*(x-' floattostr(XX) ')';

//Xd:=Xd '*x';

Exd:=floattostr(A[i,1]) Xd;

Exprx:=Exprx flag Exd;

end else if A[i,1]<0 then

begin

flag:='';

if X_Average=False then Xd:=Xd '*x' else Xd:=Xd '*(x-' floattostr(XX) ')';

//Xd:=Xd '*x';

Exd:=floattostr(A[i,1]) Xd;

Exprx:=Exprx flag Exd;

end;

//求多项式的A[2,2]x*y A[2,3]x*y^2 .. A[2,Q]x*y^(Q-1) A[3,2]x^2*y A[3,3]x^2*y^2 .. A[3,Q]x^2*y^(Q-1) ..

Xd:='';

Exprxy:='';

for i:=2 to P do

begin

//取平均值的不同表达式

if X_Average=False then Xd:=Xd '*x' else Xd:=Xd '*(x-' floattostr(XX) ')';

//Xd:=Xd '*x';

Yd:='';

for j:=2 to Q do

begin

if A[i,j]>0 then

begin

flag:=' ';

//取平均值的不同表达式

if j=2 then

begin

if X_Average=False then Yd:=Yd Xd '*y' else Yd:=Yd Xd '*(x-' floattostr(YY) ')';

end else

begin

if X_Average=False then Yd:=Yd '*y' else Yd:=Yd '*(x-' floattostr(YY) ')';

end;

//if j=2 then Yd:=Yd Xd '*y' else Yd:=Yd '*y';

Exd:=floattostr(A[i,j]) Yd;

Exprxy:=Exprxy flag Exd;

end else if A[i,j]<0 then

begin

flag:='';

//取平均值的不同表达式

if j=2 then

begin

if X_Average=False then Yd:=Yd Xd '*y' else Yd:=Yd Xd '*(x-' floattostr(YY) ')';

end else

begin

if X_Average=False then Yd:=Yd '*y' else Yd:=Yd '*(x-' floattostr(YY) ')';

end;

//if j=2 then Yd:=Yd Xd '*y' else Yd:=Yd '*y';

Exd:=floattostr(A[i,j]) Yd;

Exprxy:=Exprxy flag Exd;

end;

Expr:=floattostr(A[1,1]) Expry Exprx Exprxy;//拟合后的曲面多项式

//显示拟合后的结果

Memo1.Lines.Append('最小二乘曲面拟合');

Memo1.Lines.Append('标准曲面多项式');

Memo1.Lines.Append('P(x,y):=A(1,1) A(1,2)(x-x0) .. A(2,1)(y-y0) A(2,2)(x-x0)*(y-y0) A(2,3)(x-x0)*(y-y0)^2 … A(Q 1,P 1)(x-x0)^Q*(y-y0)^P');

Memo1.Lines.Append('其中X平均值：x0=(x1 x2 … xN)/N=' floattostr(XX));

Memo1.Lines.Append('其中Y平均值：y0=(y1 y2 … yM)/M=' floattostr(YY));

Memo1.Lines.Append('拟合多项式表达式如下：');

Memo1.Lines.Append('F(x)=' Expr ';');

for i:=1 to P do

begin //Memo中字符串之间不能夹插变量,变量之间不能夹插字符串输出,用strtemp变通

for j:=1 to Q do

begin

strtemp:=inttostr(i) ',' inttostr(j) ']：' floattostr(A[i,j]);

Memo1.Lines.Append('拟合多项式系数A[' strtemp);

end;

Memo1.Lines.Append('多项式总项数：' floattostr(P*Q));

Memo1.Lines.Append('多项式与数据点偏差平方和：' floattostr(DT1));

Memo1.Lines.Append('多项式与数据点偏差绝对值和：' floattostr(DT2));

Memo1.Lines.Append('多项式与数据点偏差绝对值最大值：' floattostr(DT3));

Memo1.Lines.Append('拟合函数式：f(x)=' func);

if B_DrawFunc=True then DrawMultiCurve(func,Color4);//画函数曲线

if B_DrawMult=True then DrawMultiCurve(Expr,Color3);//画多项式表达式曲线

end;

//3切比雪夫曲线拟合,N实验数据个数,P多项式最高次幂数(项数为P 1)

procedure TF_MultiLineRegress.CheBySheV(N,P:integer);

var i,j,v,II:integer;//N拟合数据个数,M拟合多项式项数

X,Y,A,IX,H:Array of Double; //8字节浮点变量

HA,HH,Y1,Y2,H1,H2,D,HM,IM,L:Double;

Xd,Exd,flag,Expr,strtemp:string;//最后写多项式表达式时的临时变量

Label L10,L20,L30;

begin

SetLength(X,N 1);

SetLength(Y,N 1);

SetLength(A,P 1);

SetLength(IX,4*P);

SetLength(H,4*P);

//从表中取拟合数据到变量

for i:=1 to N do

begin

X[i]:=strtofloat(StringGrid1.Cells[1,i]);

Y[i]:=strtofloat(StringGrid1.Cells[2,i]);

end;

//切比雪夫拟合

HA:=0;

IX[1]:=1;

IX[P 1]:=N;

L:=(N-1)/P;

j:=Round(L);

for i:=2 to P do

begin

IX[i]:=j 1;

j:=j Round(L);

end;

L10:

HH:=1;

for i:=1 to P 1 do

begin

A[i]:=Y[Round(IX[i])];

H[i]:=-HH;

HH:=-HH;

end;

for j:=1 to P do

begin

II:=P 1;

Y2:=A[II];

H2:=H[II];

for i:=j to P do

begin

D:=X[Round(IX[II])]-X[Round(IX[P 1-i])];

Y1:=A[P-i j];

H1:=H[P-i j];

A[II]:=(Y2-Y1)/D;

H[II]:=(H2-H1)/D;

II:=P-i j;

Y2:=Y1;

H2:=H1;

end;

HH:=-A[P 1]/H[P 1];

for i:=1 to P 1 do A[i]:=A[i] H[i]*HH;

for j:=1 to P-1 do

begin

II:=P-j;

D:=X[Round(IX[II])];

Y2:=A[II];

for v:=P 1-j to P do

begin

Y1:=A[V];

A[II]:=Y2-D*Y1;

Y2:=Y1;

II:=v;

end;

HM:=abs(HH);

if HM<=HA then

begin

A[P 1]:=-HM;

goto L30;

end;

A[P 1]:=HM;

HA:=HM;

IM:=IX[1];

H1:=HH;

j:=1;

for i:=1 to N do

begin

if i=IX[j] then

begin

if j<P 1 then j:=j 1;

end else

begin

H2:=A[P 1];

v:=P-1;

while v>=1 do

begin

H2:=H2*X[i] A[v];

v:=v-1;

end;

H2:=H2-Y[i];

if abs(H2)>HM then

begin

HM:=abs(H2);

H1:=H2;

IM:=i

end;

if IM=IX[1] then goto L30;

i:=1;

L20:

if IM>=IX[i] then

begin

i:=i 1;

if i<=P 1 then goto L20;

end;

if i>P 1 then i:=P 1;

if i=Round((i/2)*2) then H2:=HH else H2:=-HH;

if H1*H2>=0 then

begin

IX[i]:=P;

goto L10;

end;

if IM<IX[1] then

begin

j:=P;

while j>=1 do

begin

IX[j 1]:=IX[j];

j:=j-1;

end;

IX[1]:=IM;

goto L10;

end;

if IM>IX[P 1] then

begin

for j:=2 to P 1 do IX[j-1]:=IX[j];

IX[P 1]:=IM;

goto L10;

end;

IX[i-1]:=IM;

goto L10;

L30:

//绘拟合后的多项式表达式

Expr:=floattostr(A[1]);

Xd:='';

for i:=2 to P do

begin

if A[i]>0 then

begin

flag:=' ';

Xd:=Xd '*x';

Exd:=floattostr(A[i]) Xd;

Expr:=Expr flag Exd;

end else if A[i]<0 then

begin

flag:='';

Xd:=Xd '*x';

Exd:=floattostr(A[i]) Xd;

Expr:=Expr flag Exd;

end;

//显示多项式信息

Memo1.Lines.Append('切比雪夫曲线拟合');

Memo1.Lines.Append('标准曲面多项式');

Memo1.Lines.Append('多项式：P(x)=A[1] A[2]x A[3]x^2 … A[N]x^P …');

Memo1.Lines.Append('拟合多项式表达式如下：');

Memo1.Lines.Append('F(x)=' Expr);

for i:=1 to P do

begin //Memo中字符串之间不能夹插变量,变量之间不能夹插字符串输出,用strtemp变通

strtemp:=inttostr(i) ']：' floattostr(A[i]);

Memo1.Lines.Append('拟合多项式系数A[' strtemp);

end;

Memo1.Lines.Append('拟合多项式与数据点最大偏差Hmax：' floattostr(A[P 1]));

Memo1.Lines.Append('拟合函数式：f(x)=arctg(x)');

//将Expr表达式绘出曲线并与函数f(x)曲线比较

if B_DrawFunc=True then DrawMultiCurve(func,Color4);//画函数曲线

if B_DrawMult=True then DrawMultiCurve(Expr,Color3);//画多项式表达式曲线

end;

//4最佳一致逼近,N是多项式项数,A,B是取值区间,Precision是精度

procedure TF_MultiLineRegress.Remez(N:integer;A,B:Double);

var P:Array of Double;

X1,G:Array[1..20]of Double;

H,U,D,XX,X0,S,T,YY:Double;

i,j,v:integer;

Expression:TExpress;//函数表达式类

x:Double;//函数自变量

Xd,Exd,flag,Expr,strtemp:string;//最后写多项式表达式时的临时变量

Label L10,L20,L30,L40;

begin

Expression:=TExpress.Create(self);//创建字符串转换成表达式类

Expression.Expression:=func;//将字符串给表达式类

SetLength(P,N 1);

D:=1E 35;

for v:=0 to N do //求区间[A,B]上取N次切比雪夫多项式的交错点组

begin

T:=cos((N-v)*pi/N);

X1[v 1]:=(B A (B-A)*T)/2;

end;

L40:

U:=1;

for i:=1 to N 1 do

begin

x:=X1[i];

P[i]:=Expression.TheFunction(x,0,0);

G[i]:=-U;

U:=-U;

end;

for j:=1 to N do

begin

v:=N 1;

S:=P[v];

XX:=G[v];

for i:=j to N do

begin

T:=P[N-i j];

X0:=G[N-i j];

P[v]:=(S-T)/(X1[v]-X1[N 1-i]);

G[v]:=(XX-X0)/(X1[v]-X1[N 1-i]);

v:=N-i j;

S:=T;

XX:=X0;

end;

U:=-P[N 1]/G[N 1];

for i:=1 to N 1 do P[i]:=P[i] G[i]*U;

for j:=1 to N-1 do

begin

v:=N-j;

H:=X1[v];

S:=P[v];

for i:=N 1-j to N do

begin

T:=P[i];

P[v]:=S-H*T;

S:=T;

v:=i;

end;

P[N 1]:=abs(U);

U:=P[N 1];

if abs(U-D)<=Precision then goto L10;

D:=U;

H:=0.1*(B-A)/N;

XX:=A;

X0:=A;

L20:

if X0<=B then

begin

x:=X0;

S:=Expression.TheFunction(x,0,0);

T:=P[N];

i:=N-1;

while i>=1 do

begin

T:=T*X0 P[i];

i:=i-1;

end;

S:=abs(S-T);

if S>U then

begin

U:=S;

XX:=X0;

end;

X0:=X0 H;

goto L20;

end;

x:=XX;

S:=Expression.TheFunction(x,0,0);

T:=P[N];

i:=N-1;

while i>=1 do

begin

T:=T*XX P[i];

i:=i-1;

end;

YY:=S-T;

i:=1;

j:=N 1;

L30:

if j-i=1 then

begin

v:=Round((i j)/2);

if XX<X1[v] then j:=v else i:=v;

goto L30;

end;

if XX<X1[1] then

begin

x:=X1[1];

S:=Expression.TheFunction(x,0,0);

T:=P[N];

v:=N-1;

while v>=1 do

begin

T:=T*X1[1] P[v];

v:=v-1;

end;

S:=S-T;

if S*YY>0 then

begin

X1[1]:=XX;

end else

begin

v:=N;

while v>=1 do

begin

X1[v 1]:=X1[v];

v:=v-1;

end;

X1[1]:=XX;

end;

end else if XX>X1[N 1] then

begin

x:=X1[N 1];

S:=Expression.TheFunction(x,0,0);

T:=P[N];

v:=N-1;

while v>=1 do

begin

T:=T*X1[N 1] P[v];

v:=v-1;

end;

S:=S-T;

if S*YY>0 then

begin

X1[N 1]:=XX

end else

begin

for v:=1 to N do X1[v]:=X1[v 1];

X1[N 1]:=XX;

end;

end else

begin

x:=X1[i];

S:=Expression.TheFunction(x,0,0);

T:=P[N];

v:=N-1;

while v>=1 do

begin

T:=T*X1[i] P[v];

v:=v-1;

end;

S:=S-T;

if S*YY>0 then X1[i]:=XX else X1[j]:=XX;

end;

goto L40;

Exit;

L10:

//绘拟合后的多项式表达式

Expr:=floattostr(P[1]);

Xd:='';

for i:=2 to N do

begin

if P[i]>0 then

begin

flag:=' ';

Xd:=Xd '*x';

Exd:=floattostr(P[i]) Xd;

Expr:=Expr flag Exd;

end else if P[i]<0 then

begin

flag:='';

Xd:=Xd '*x';

Exd:=floattostr(P[i]) Xd;

Expr:=Expr flag Exd;

end;

//显示多项式信息

Memo1.Lines.Append('最佳一致逼近米兹方法');

Memo1.Lines.Append('逼近标准多项式：P(x)=A[1] A[2]x A[3]x^2 … A[N]x^P …；');

Memo1.Lines.Append('逼近参考函数（绿色曲线）：f(x)=' func);

Memo1.Lines.Append('逼近多项式（红色曲线）如下所示：P(x)=' Expr);

for i:=1 to N do

begin

strtemp:=inttostr(i) ']=' floattostr(P[i]);

Memo1.Lines.Append('逼近多项式系数A[' strtemp); //Memo中不能在字符串中间夹变量输出

end;

Memo1.Lines.Append('多项式与函数偏差：' floattostr(P[N 1]));

//将Expr表达式绘出曲线并与函数f(x)曲线比较

if B_DrawFunc=True then DrawMultiCurve(func,Color4);//画函数曲线

if B_DrawMult=True then DrawMultiCurve(Expr,Color3);//画多项式表达式曲线

end;

//5一元线性回归分析

procedure TF_MultiLineRegress.OneLineRegress(StrGrd:TStringGrid);

var X,Y:Array of Double;

N,i:integer;

A,B,Q,S,P,UMAX,UMIN,U:Double;

XX,YY,DX,DXY:Double;

Expr:string;

begin

N:=StrGrd.RowCount-1;

SetLength(X,N 1);

SetLength(Y,N 1);

for i:=1 to N do

begin

X[i]:=strtofloat(StrGrd.Cells[1,i]);

Y[i]:=strtofloat(StrGrd.Cells[2,i]);

end;

//求平均值

XX:=0;YY:=0;

for i:=1 to N do

begin

XX:=XX X[i];

YY:=YY Y[i];

end;

XX:=XX/N;YY:=YY/N; //X,Y的平均值

DX:=0;DXY:=0;

for i:=1 to N do

begin

Q:=X[i]-XX;

DX:=DX Q*Q;

DXY:=DXY Q*(Y[i]-YY)

end;

A:=DXY/DX;

B:=YY-A*XX;

Q:=0;U:=0;P:=0;UMAX:=0;UMIN:=1E 30;

for i:=1 to N do

begin

S:=A*X[i] B;

Q:=Q (Y[i]-S)*(Y[i]-S);

P:=P (S-YY)*(S-YY);

DX:=abs(Y[i]-S);

if DX>UMAX then UMAX:=DX;

if DX<UMIN then UMIN:=DX;

U:=U DX/N;

end;

S:=sqrt(Q/N);

if B>0 then

Expr:=floattostr(A) '*x' ' ' floattostr(B)

else if B<0 then

Expr:=floattostr(A) '*x' floattostr(B);

//显示多项式信息

Memo1.Lines.Append('一元线性回归分析');

Memo1.Lines.Append('一元线性标准方式：y(x)=Ax B');

Memo1.Lines.Append('y(x)=' Expr ';');

Memo1.Lines.Append('线性方式的偏差平方和：' floattostr(Q));

Memo1.Lines.Append('线性方式平均标准偏差：' floattostr(S));

Memo1.Lines.Append('线性方式的回归平方和：' floattostr(P));

Memo1.Lines.Append('线性方式的最大偏差值：' floattostr(UMAX));

Memo1.Lines.Append('线性方式的最小偏差值：' floattostr(UMIN));

Memo1.Lines.Append('线性方式的平均偏差值：' floattostr(U));

//将Expr表达式绘出曲线并与函数f(x)曲线比较

if B_DrawMult=True then DrawMultiCurve(Expr,Color3);//画多项式表达式曲线

end;

//6多元线性回归

procedure TF_MultiLineRegress.MulLineRegress(StrGrd:TStringGrid);

var X,B:Array of Array of Double;

Y,A,V:Array of Double;

Q,S,R,U,YY,DYY,P,PP:Double;

N,M,i,j,t:integer;

flage,Expr,str1,str2,strtemp:string;

Label L10;

begin

M:=StrGrd.ColCount-2; //自变量个数,减去序号和因变量列

N:=StrGrd.RowCount-1; //实验数据组的组数

SetLength(X,M,N); //存放自变量M*N个观测值

SetLength(B,M 1,M 1);

SetLength(Y,N); //存放因变量N个观测值

SetLength(A,M 1); //存放M 1个回归系统数a1,a2..

SetLength(V,M); //M个自变量的偏相关系数

if M=2 then flage:='二' else if M=3 then flage:='三'

else if M=4 then flage:='四' else if M>=5 then flage:='多';

//给测试数据变量组,Y[i],X[j,i]赋值

for i:=0 to N-1 do Y[i]:=strtofloat(StrGrd.Cells[1,i 1]);

for j:=0 to M-1 do

for i:= 0 to N-1 do

X[j,i]:=strtofloat(StrGrd.Cells[j 2,i 1]);

B[0,0]:=N;

for j:=1 to M do

begin

B[0,j]:=0;

for i:=0 to N-1 do B[0,j]:=B[0,j] X[j-1,i];

B[j,0]:=B[0,j];

end;

for i:=1 to M do

begin

for j:=i to M do

begin

B[i,j]:=0;

for t:=0 to N-1 do B[i,j]:=B[i,j] X[i-1,t]*X[j-1,t];

B[j,i]:=B[i,j];

end;

A[0]:=0;

for i:=0 to N-1 do A[0]:=A[0] Y[i];

for i:=1 to M do

begin

A[i]:=0;

for j:=0 to N-1 do A[i]:=A[i] X[i-1,j]*Y[j];

end;

//乔里斯基分解求对称正定方程组

if B[0,0]=0 then goto L10;

B[0,0]:=sqrt(B[0,0]);

for j:=1 to M do B[0,j]:=B[0,j]/B[0,0];

for i:=1 to M do

begin

for j:=1 to i do B[i,i]:=B[i,i]-B[j-1,i]*B[j-1,i];

if B[i,i]=0 then goto L10;

B[i,i]:=sqrt(B[i,i]);

if i<>M then

begin

for j:=i 1 to M do

begin

for t:=1 to i do B[i,j]:=B[i,j]-B[t-1,i]*B[t-1,j];

B[i,j]:=B[i,j]/B[i,i];

end;

A[0]:=A[0]/B[0,0];

for i:=1 to M do

begin

for t:=1 to i do A[i]:=A[i]-B[t-1,i]*A[t-1];

A[i]:=A[i]/B[i,i];

end;

A[M]:=A[M]/B[M,M];

t:=M;

while t>=1 do

begin

for i:=t to M do A[t-1]:=A[t-1]-B[t-1,i]*A[i];

A[t-1]:=A[t-1]/B[t-1,t-1];

t:=t-1;

end;

L10:

//乔里斯基分解求结束

YY:=0;

for i:=0 to N-1 do YY:=YY Y[i]/N;

Q:=0;

DYY:=0;

U:=0;

for i:=0 to N-1 do

begin

P:=A[0];

for j:=0 to M-1 do P:=P A[j 1]*X[j,i];

Q:=Q (Y[i]-P)*(Y[i]-P);

DYY:=DYY (Y[i]-YY)*(Y[i]-YY);

U:=U (YY-P)*(YY-P);

end;

S:=sqrt(Q/N);

R:=sqrt(1-Q/DYY);

for j:=0 to M-1 do

begin

P:=0;

for i:=0 to N-1 do

begin

PP:=A[0];

for t:=0 to M-1 do if t=j then PP:=PP A[t 1]*X[t,i];

P:=P (Y[i]-PP)*(Y[i]-PP);

end;

V[j]:=sqrt(1-Q/P);

end;

//显示多元线性方程信息

Expr:=floattostr(A[0]);

for i:=0 to M-1 do

begin

if A[i 1]>0 then

Expr:=Expr ' ' floattostr(A[i 1]) '*x' inttostr(i 1)

else if A[i 1]<0 then

Expr:=Expr floattostr(A[i 1]) '*x' inttostr(i 1);

end;

Expr:=Expr ';';

Memo1.Lines.Append(flage '元线性回归分析');

Memo1.Lines.Append(flage '元线性标准方程：y(x1,x2..xM)=A1 A2*x1 A3*x2 .. A(M 1)*xM');

Memo1.Lines.Append('Y=' Expr);

Memo1.Lines.Append(flage '元线性方程各系数值如下所示：');

for i:=0 to M do

begin

strtemp:=floattostr(i 1) ')=' floattostr(A[i]);

Memo1.Lines.Append('A(' strtemp); //Memo字符串中间不能夹插变量

end;

Memo1.Lines.Append('方程的偏差平方和Q：' floattostr(Q));

Memo1.Lines.Append('方程平均标准偏差S：' floattostr(S));

Memo1.Lines.Append('方程的复相关系数R：' floattostr(R));

Memo1.Lines.Append('方程偏差系数如下所示：');

for i:=0 to M-1 do

begin

strtemp:=floattostr(i 1) ')=' floattostr(V[i]);

Memo1.Lines.Append('V(' strtemp);

end;

Memo1.Lines.Append('方程的回归平方和U：' floattostr(U));

Memo1.Lines.Append(flage '元线性回归后的分析信息如下：');

if R>0.9 then Memo1.Lines.Append('线性回归效果很好！')

else if R<0.8 then Memo1.Lines.Append('线性回归效果不理想！');

for i:=0 to M-1 do

begin

if V[i]>0.9 then Memo1.Lines.Append('自变量X' inttostr(i 1) '对Y的作用较强，不可剔除！');

end;

//将Expr表达式绘出曲线并与函数f(x)曲线比较

if(B_DrawMult=True)and(AnalysSel='f')then

begin

if A[1]>0 then str1:=' ' else if A[1]<0 then str1:='';

if A[2]>0 then str2:=' ' else if A[2]<0 then str2:='';

if(A[1]=0)or(A[2]=0)then

begin

Expr:=floattostr(A[0]) str1 floattostr(A[1]) '*x' str2 floattostr(A[2]) '*y';

DrawMultiCurve(Expr,Color3);//画多项式表达式曲线

end;

//7逐步回归(针对多元线性回归)

procedure TF_MultiLineRegress.StepRegress(StrGrd:TStringGrid;F1,F2,E:Double);

var N,M :integer;//自变量个数,观测点数

//F1是欲选入因子时显著性检验F-分布值,F2是欲剔除因子时显著性检验F-分布值,E是防止系数相关阵退化的判据

L,i,j,t:integer;

X:Array of Array of Double;//M个观测点上的数据组,前N个为自变量用,最后一个是因变量用

R:Array of Array of Double;//存放最终规格化的系数相关阵

XX:Array of Double;//前N个存放自变量因子的算术平均值

B:Array of Double;//前N个存放各因子的回归系数b1,b2..

V:Array of Double;//前N个存放各因子的偏回归平方和,最后一个存放残差平方和Q

S:Array of Double;//前N个存放各因子回归系数的标准偏差,最后一个存放估计标准偏差

YE:Array of Double;

YR:Array of Double;

C,F,Z,Q:Double;

FMI,FMX,PHI,VMI,VMX,SD:Double;

IMI,IMX:integer;

Label L10,L20;

begin

//置输入值

N:=StrGrd.ColCount-1; //变量个数,减去序号列

M:=StrGrd.RowCount-1; //实验数据组的组数(观测点数),减去标题行

//为动态数组设置内存空间

SetLength(X,M,N);

SetLength(R,M,N);

SetLength(XX,N);

SetLength(B,N);

SetLength(V,N);

SetLength(S,N);

SetLength(YE,M);

SetLength(YR,M);

//自变量赋值

for i:=0 to M-1 do //观测数据组数(记录数)

begin

for j:=0 to N-2 do//自变量个数(字段数)

begin

X[j,i]:=strtofloat(StrGrd.Cells[j 2,i 1]);

end;

//因变量赋值

for i:=0 to M-1 do //观测数据组数

X[N-1,i]:=strtofloat(StrGrd.Cells[1,i 1]);

//开始执行回归

for j:=0 to N-1 do

begin

Z:=0;

for i:=0 to M-1 do Z:=Z X[i,j]/M;

XX[j]:=Z; //求变量平均值

end;

for i:=0 to N-1 do

begin

for j:=0 to i do

begin

Z:=0;

for t:=0 to M-1 do Z:=Z (X[t,i]-XX[i])*(X[t,j]-XX[j]);

R[i,j]:=Z; //还系数相关值

end;

C:=0;F:=0;Q:=0;

for i:=0 to N-1 do YE[i]:=sqrt(R[i,i]);

for i:=0 to N-1 do

begin

for j:=0 to i do

begin

R[i,j]:=R[i,j]/(YE[i]*YE[j]);

R[j,i]:=R[i,j];

end;

PHI:=M-1;

SD:=YE[N-1]/sqrt(M-1);

L10:

VMI:=1E 35;

VMX:=0;

IMI:=0;

IMX:=0;

for i:=0 to N-1 do

begin

V[i]:=0;

B[i]:=0;

S[i]:=0;

end;

i:=0;

L20:

i:=i 1;

if R[i,i]>=E then

begin

V[i]:=R[i,N-1]*R[N-1,i]/R[i,i];

if V[i]>=0 then

begin

if V[i]>VMX then

begin

VMX:=V[i];

IMX:=i;

end;

end else

begin

B[i]:=R[i,N-1]*YE[N-1]/YE[i];

S[i]:=sqrt(R[i,i])*SD/YE[i];

if abs(V[i])<VMI then

begin

VMI:=abs(V[i]);

IMI:=i;

end;

if i<>N-2 then goto L20;

if PHI<>N-3 then

begin

Z:=0;

for i:=0 to N-2 do Z:=Z B[i]*XX[i];

B[N-1]:=XX[N-1]-Z;

S[N-1]:=SD;

V[N-1]:=Q;

end else

begin

B[N-1]:=XX[N-1];

S[N-1]:=SD;

end;

FMI:=VMI*PHI/R[N-1,N-1];

FMX:=(PHI-1)*VMX/(R[N-1,N-1]-VMX);

if(FMI<F2)or(FMX>=F1)then

begin

if FMI<F2 then

begin

PHI:=PHI 1;

L:=IMI;

end else

begin

PHI:=PHI-1;

L:=IMX;

end;

for i:=0 to N-1 do

begin

if i<>L then

begin

for j:=0 to N-1 do

begin

if j<>L then R[i,j]:=R[i,j]-(R[L,j]/R[L,L])*R[i,L];

end;

for j:=0 to N-1 do

begin

if j<>L then R[L,j]:=R[L,j]/R[L,L];

end;

for i:=0 to N-1 do

begin

if I<>L then R[i,L]:=-R[i,L]/R[L,L];

end;

R[L,L]:=1/R[L,L];

Q:=R[N-1,N-1]*YE[N-1]*YE[N-1];

SD:=sqrt(R[N-1,N-1]/PHI)*YE[N-1];

C:=sqrt(1-R[N-1,N-1]);

F:=(PHI*(1-R[N-1,N-1]))/((M-PHI-1)*R[N-1,N-1]);

goto L10;

end;

for i:=0 to M-1 do

begin

Z:=0;

for j:=0 to N-2 do Z:=Z B[j]*X[i,j];

YE[i]:=B[N-1] Z;

YR[i]:=X[i,N-1]-YE[i];

end;

//显示多项式信息

Memo1.Lines.Append('逐步回归分析');

Memo1.Lines.Append('逐步回归多元线性估计标准方程式如下：');

Memo1.Lines.Append('y=B0 B1x1 B2x2 .. BNxN;');

Memo1.Lines.Append('回归系数：B0=' floattostr(B[N-1]) ';');

for i:=0 to N-2 do

Memo1.Lines.Append('回归系数：B' inttostr(i 1) '=' floattostr(B[i]) ';');

Memo1.Lines.Append('因变量算术平均值：Y =' floattostr(XX[N-1]) ';');

for i:=0 to N-2 do //N变量个数,M记录条数

Memo1.Lines.Append('自变量算术平均值：X' inttostr(i 1) '=' floattostr(XX[i]) ';');

Memo1.Lines.Append('回归残存平方和：Q=' floattostr(V[N-1]) ';');

for i:=0 to N-2 do

Memo1.Lines.Append('偏回归平方和：V[' inttostr(i 1) ']=' floattostr(V[i]) ';');

Memo1.Lines.Append('估计标准偏差：S[0]=' floattostr(S[N-1]) ';');

for i:=0 to N-2 do

Memo1.Lines.Append('回归系数标准偏差：S[' inttostr(i 1) ']=' floattostr(S[i]) ';');

Memo1.Lines.Append('复相关系数：C=' floattostr(C) ';');

Memo1.Lines.Append('F-检测值：' floattostr(F) ';');

for i:=0 to M-1 do

Memo1.Lines.Append('因变量条件期望估计值：YE[' inttostr(i 1) ']=' floattostr(YE[i]) ';');

for i:=0 to M-1 do

Memo1.Lines.Append('因变量观测值的残差：YR[' inttostr(i 1) ']=' floattostr(YR[i]) ';');

for i:=0 to N-1 do

begin

for j:=0 to N-1 do

begin

Memo1.Lines.Append('系统相关阵：R[' inttostr(i 1) ',' inttostr(j 1) ']=' floattostr(R[i,j]) ';');

end;

Memo1.Lines.Append('运算完毕！');

end;

//8五点三次平滑 (只能用动态数组类设置数组)

procedure TF_MultiLineRegress.FiveThreeSmooth(StrGrd:TStringGrid;ColRead,ColWrite:integer);

var N,i:integer;//Y放实验数据,YY放平滑数据

Y,YY:Array of Double;

begin

N:=StrGrd.RowCount-1;

SetLength(Y,N 1);

SetLength(YY,N 1);

for i:=1 to N do Y[i]:=strtofloat(StrGrd.Cells[ColRead,i]);

if N<5 then for i:=1 to N do YY[i]:=Y[i];

YY[1]:=(69*Y[1] 4*Y[2]-6*Y[3] 4*Y[4]-Y[5])/70;

YY[2]:=(2*Y[1] 27*Y[2] 12*Y[3]-8*Y[4] 2*Y[5])/35;

for i:=3 to N-2 do YY[i]:=(-3*Y[i-2] 12*Y[i-1] 17*Y[i] 12*Y[i 1]-3*Y[i 2])/35;

YY[N-1]:=(2*Y[N-4]-8*Y[N-3] 12*Y[N-2] 27*Y[N-1]-2*Y[N])/35;

YY[N]:=(-Y[N-4] 4*Y[N-3]-6*Y[N-2] 4*Y[N-1] 69*Y[N])/70;

StrGrd.ColCount:=StrGrd.ColCount 1;

for i:=1 to StrGrd.ColCount-1 do StrGrd.ColWidths[i]:=

(StrGrd.Width-StrGrd.ColWidths[0])div (StrGrd.ColCount-1)-8;

StrGrd.Cells[ColRead,0]:='实验数据';

StrGrd.Cells[ColWrite,0]:='平滑数据';

for i:=1 to N do StrGrd.Cells[ColWrite,i]:=floattostr(YY[i]);

end;

//画五点三次平滑数据点的折线

procedure TF_MultiLineRegress.DrawFoldLine(StrGrd:TStringGrid;Col:integer;Color:TColor);

var x1world,y1world,z1world,x2world,y2world,z2world:Double;

Y:Array of Double;

XN_min,N,i:integer; //XX是这些数据两两之间的X轴平均距离

XX:Double;

begin

Image1.Canvas.Pen.Width:=Width3;//数据线宽度

Image1.Canvas.Pen.Color:=Color;//曲线颜色(这里是折线颜色)

Image1.Canvas.Pen.Style:=PSSolid;//坐标为实线

N:=StrGrd.RowCount-1;

SetLength(Y,N 1);

for i:=1 to N do Y[i]:=strtofloat(StrGrd.Cells[Col,i]);

//画" "字

XX:=(DrawX_max-DrawX_min)/(N-1);

x1world:=0;x2world:=0;y1world:=0;y2world:=0;z1world:=0;z2world:=0;

XN_min:=Trunc(abs(DrawX_min)/XX);//负X轴的XX个数

for i:= 0 to N-2 do

begin

x1world:=-(XN_min-i)*XX;

x2world:=-(XN_min-i-1)*XX;

z1world:=Y[i 1];

z2world:=Y[i 2];

DrawCrossLine(x1world,y1world,z1world,Color);//画' '字

DrawLine(x1world,y1world,z1world,x2world,y2world,z2world);//画折线

end;

DrawCrossLine(x2world,y2world,z2world,Color);//画' '字

end;

//输出结果按钮

procedure TF_MultiLineRegress.SpeedButton4Click(Sender: TObject);

var mr:integer;

begin

mr:=Application.MessageBox('您真的想打印相关结果吗？' #13

'' #13

'注意：按“是”打印显示曲线，' #13

' 按“否”打印分析结果，' #13

' 按“取消”放弃打印！','输出结果说明',

$30 $3); //MB_IconInformation MB_YesNoCancel

if mr=mrYes then

PrintConic //打印曲线

else if mr=mrNo then

PrintMemoData(Memo1)//打印结果

else if mr=mrCancel then //放弃保存

Exit;

end;

//注册帮助按钮

procedure TF_MultiLineRegress.SpeedButton5Click(Sender: TObject);

begin

Panel6.Visible:=True; //通过注册窗口显示帮助

Edit1.Text:=MachineCode0; //调用CPUID号

Label7.Caption:=

' 您觉得这个小软件对您有用吗？您觉' #13

'得这个小软件的功能适合您的需要吗？您' #13

'想拥有这个小软件的完全使用权吗？敬请' #13

'您注册吧！' #13

' 注册很简单，只需要获得注册码，并' #13

'将注册码输入到这个系统中，您就获得了' #13

'这个《拟合平滑回归分析》的注册权，您' #13

'就能享受这个系统的所有功能！' #13

' 想要得到注册码，您只需要将窗口中' #13

'显示的机器码字符，电子邮件给作者，您' #13

'就可以获得作者邮寄给您的该软件的有效' #13

'注册码，同时还能享受作者定期给系统的' #13

'免费升级服务，享受作者无偿的技术支持' #13

'。前提当然只有一个，在邮寄机器码时不' #13

'要忘记给作者寄上壹佰元人民币厚礼。作' #13

'者将真诚地感谢您对正版软件的支持！' #13

' 得到注册码后，直接将注册码输入到' #13

'下面的“ 输入注册码 ” 窗口中，然后点下' #13

'面的“注册”按钮，系统显示“注册成功”后' #13

'，您就可以完全使用该系统了。' #13

' 作者的通信地址如下：' #13

' 地址：湖南省岳阳移动通信分公司' #13

' 姓名：张长青' #13

' 邮编：414000' #13

' 电话：13707309869' #13

' Email：13707309869@139.com';

Timer1.Enabled:=True; //激活窗口显示

Button7.SetFocus;

end;

//打印显示曲线过程

procedure TF_MultiLineRegress.PrintConic;

var Rect:TRect;

begin

if drawK=True then

begin

Rect.Left:=20*Trunc(GetDeviceCaps(Printer.Handle,LOGPIXELSX)/96);

Rect.Top:=20*Trunc(GetDeviceCaps(Printer.Handle,LOGPIXELSX)/96);

try

if PrintDialog1.Execute then //打印对话框是否打开

begin

with Printer do

begin

begindoc; //创建打印文档

Printer.Canvas.StretchDraw(Rect,Image1.Picture.Graphic);

enddoc; //送往打印机

end;

ShowMessage('已完成显示曲线打印！');

end else begin

ShowMessage('图形没有打印！');

end;

except

ShowMessage('该图形文件不能打印！');

end;

end else begin

ShowMessage('没有图形文件可以打印！');

end;

//打印分析结果过程

procedure TF_MultiLineRegress.PrintMemoData(Memo:TMemo);

var i:integer; //须在Uses中加入Printers函数

PrintText:System.Text;

begin

if Memo.Text<>'' then

begin

try

if PrintDialog1.Execute then //打印对话框是否打开

begin

AssignPrn(PrintText); //将打印文件PrintText与打印机关联

ReWrite(PrintText); //调节器用ReWrite函数作为输出打开分配的文件

with Printer do

begin

//begindoc; //创建打印文档

Canvas.Font.Size:=16; //赋与打印对象Canves的字体属性

Canvas.Font.Style:=[fsBold];

Canvas.Font.Name:='华文仿宋';

Canvas.Font.Color:=clDefault;

for i := 0 to Memo1.Lines.Count – 1 do

WriteLn(PrintText,Memo1.Lines.Strings[i]);//所存储在Memo2中的抽奖名单写到打印对象上

//enddoc; //送往打印机

System.Close(PrintText); //关闭打印文件

end;

ShowMessage('已完成显示结果打印！');

end else begin

ShowMessage('数据结果没有打印！');

end;

except

ShowMessage('该数据结果不能打印！');

end;

end else begin

ShowMessage('没有数据结果可以打印！');

end;

//锁定表格

procedure TF_MultiLineRegress.Button1Click(Sender: TObject);

begin

if Button1.Caption='锁定表格只读' then

begin

Button1.Caption:='解锁表格可写';

Label1.Caption:='注意：目前表格不可写！';

StringGrid1.Options:=StringGrid1.Options-[goEditing];//StringGrid1表格单元只读

end else if Button1.Caption='解锁表格可写' then

begin

Button1.Caption:='锁定表格只读';

Label1.Caption:='注意：目前表格可写！';

StringGrid1.Options:=StringGrid1.Options [goEditing];//StringGrid1表格单元可写

end;

//文件调入数据按钮

procedure TF_MultiLineRegress.Button2Click(Sender: TObject);

begin

OpenChildForm(TF_FileDataInput,F_FileDataInput,self);

end;

//注册帮助按钮–程序使用帮助

procedure TF_MultiLineRegress.Button3Click(Sender: TObject);

var helpname:string; //帮助文件的完全路径

begin

helpname:=ExtractFilePath(paramstr(0)) 'helpchm.chm';//指出帮助文件完全路径

if not FileExists(helpname) then //若初始化文件不存在，则重建该文件

ShowMessage('帮助文件不存在，系统不能打开！')

else

ShellExecute(Handle,'open',PChar(helpname),nil,nil,SW_SHOW);

Timer1.Enabled:=False;

Panel6.Visible:=False;

end;

//删除StringGrid中的数据按扭

procedure TF_MultiLineRegress.Button4Click(Sender: TObject);

var str1,str2:string;

begin

str1:='您真的想删除第' inttostr(StringGrid1.Row) '条记录吗？';

str2:='系统提示';

if Application.MessageBox(PAnsiChar(str1),PAnsiChar(str2),

MB_IconInformation MB_YesNo)=mrYes then

StrGrdDeleteRow(StringGrid1);

end;

//插入StringGrid中的数据按扭

procedure TF_MultiLineRegress.Button5Click(Sender: TObject);

var str1,str2:string;

begin

str1:='您真的想在第' inttostr(StringGrid1.Row) '行处插入记录吗？';

str2:='系统提示';

if Application.MessageBox(PAnsiChar(str1),PAnsiChar(str2),

MB_IconInformation MB_YesNo)=mrYes then

StrGrdInsertRow(StringGrid1);

end;

//保存StringGrid中的数据按扭

procedure TF_MultiLineRegress.Button6Click(Sender: TObject);

var mr:integer;

begin

if StringGrid1.Cells[1,1]<>'' then

begin

mr:=Application.MessageBox('您真的想保存该数据吗？' #13

'' #13

'说明：按“是”保存为文本，' #13

' 按“否”保存为EXCEL，' #13

' 按“取消”放弃保存！','系统提示',

MB_IconInformation MB_YesNoCancel);

if mr=mrYes then //保存为文本

begin

StrGrdToText(StringGrid1,'实验数据资料');

ShowMessage('已完成文本数据保存！');

end else if mr=mrNo then //StringGrid转换成Excel表显示

begin

StrGrdToExcel(StringGrid1,'实验数据资料');

end else if mr=mrCancel then //放弃保存

begin

Exit;

end;

end else

begin

ShowMessage('表格中没有数据，不需要保存！');

end;

//注册帮助按钮–注册

procedure TF_MultiLineRegress.Button7Click(Sender: TObject);

var Reg:TRegistry;

KeyName:string;

begin

if NoRegistry=False then

begin

ShowMessage('系统已注册，谢谢您！');

end else if Edit2.Text='' then

begin

ShowMessage('注册码不能为空，请重新输入！');

Edit2.SetFocus;

Exit;

end else

begin

LoginCode:=Edit2.Text; //将用户写的加密注册码给变量

if LoginCode=MachineCode1 then //判断加密注册码与登录时的机器加密码

begin

Reg:=TRegistry.Create; //创建注册表实例

Reg.RootKey:=HKEY_LOCAL_MACHINE; //建立根键

KeyName:='SoftWareP_MultiLineRegress'; //指定主键

if Reg.OpenKey(KeyName,False) then //打开关键词目录,若关键名不存在则创建

Reg.WriteString('LoginCode',LoginCode);//将用户注册码写入注册表

NoRegistry:=False; //打开注册开关

Reg.CloseKey; //关闭注册表各键

Reg.Free; //释放注册表内存

F_MultiLineRegress.Caption:='【拟合平滑回归分析】 ——注册版，谢谢您对正版软件的支持！';

ShowMessage('注册成功，谢谢您的支持！');

end else begin

ShowMessage('注册码不对，请重新输入');

if err_num>2 then

begin

NoRegistry:=True; //没有注册

ShowMessage('注册超过三次，注册不成功，退出！');

end else begin

Edit2.Text:='';

Edit2.SetFocus;

err_num:=err_num 1;

end;

Timer1.Enabled:=False;

Panel6.Visible:=False;

end;

//注册帮助按钮–退出

procedure TF_MultiLineRegress.Button8Click(Sender: TObject);

begin

Timer1.Enabled:=False;

Panel6.Visible:=False;

end;

//在StringGrid表格中删除行

procedure TF_MultiLineRegress.StrGrdDeleteRow(StrGrd:TStringGrid);

var i,j:integer;

begin

if StrGrd.Row>0then //StrGrd.Row是当前所指的行数

begin

with StrGrd do

begin

for i:=StrGrd.Row to RowCount-1 do

for j:=0 to ColCount-1 do cells[j,i]:=cells[j,i 1];

for j:=0 to ColCount-1 do cells[j,RowCount]:='';

RowCount:=RowCount-1;

end;

//在删除处重新排序号

for i:=StrGrd.Row to StrGrd.RowCount-1 do

StrGrd.Cells[0,i]:=inttostr(i);

end else

begin

ShowMessage('没有选择要删除行的位置！');

end;

//在StringGrid表格中插入行

procedure TF_MultiLineRegress.StrGrdInsertRow(StrGrd:TStringGrid);

var i,j:integer;

begin

if StrGrd.Row>0then //StrGrd.Row是当前所指的行数

begin

with StrGrd do

begin

RowCount:=RowCount 1;

for i:=RowCount-1 downto StrGrd.Row do

for j:=1 to ColCount do cells[j,i]:=cells[j,i-1];

for j:=1 to ColCount do cells[j,StrGrd.Row]:='';

end;

//在插入处增加序号

for i:=StrGrd.Row to StrGrd.RowCount-1 do

StrGrd.Cells[0,i]:=inttostr(i);

end else

begin

ShowMessage('没有选择要插入行的位置！');

end;

//StringGrid保存为文本

procedure TF_MultiLineRegress.StrGrdToText( //StringGrid保存为文本

StrGrd:TStringGrid; //转换成文本的StringGrid表格

DocmName:Shortstring); //转换成文本的表头标题名

var i,j:integer;

Str:string;

StrList:TStringList;

begin

SaveDialog1.Filter:='文本文件(*.txt)|*.txt'; //过滤文件类型

SaveDialog1.Title:='保存扫描资料结果！'; //窗口标题

SaveDialog1.DefaultExt:='.txt'; //保存文件默认扩展名

SaveDialog1.FileName:='实验数据资料'; //保存文件默认文件名

StrList:=TStringList.Create;

if SaveDialog1.Execute then

begin

for i:=0 to StrGrd.RowCount-1 do

begin

for j:=0 to StrGrd.ColCount-2 do

begin

Str:=Str StrGrd.Cells[j,i] ' '

end;

Str:=Str StrGrd.Cells[StrGrd.ColCount-1,i];

StrList.Append(Str);

Str:='';

end;

StrList.SaveToFile(SaveDialog1.FileName);

end;

StrList.Destroy;

end;

//注册窗口中的上下滚动广告

procedure TF_MultiLineRegress.Timer1Timer(Sender: TObject);

begin

Label7.Width:=220;

Label7.Top:=Label7.Top-1;

Label7.Left:=4;

if (Label7.Top<-Label7.Height 1) then

Label7.Top:=Panel7.Height-1;

end;

//StringGrid转换成Excel表显示(保存为EXCEL)

procedure TF_MultiLineRegress.StrGrdToExcel( //StringGrid转换成Excel表显示

StrGrd:TStringGrid; //转换成Excel的StringGrid表格

DocmName:Shortstring); //转换成Excel表的标题名

var i,j,k:integer;

ExcelApp,Range:Variant;

strCol,strRange_min,strRange_max:ShortString; //列，行数表示字母

const xlWBatWorkSheet=-4167;

begin

if StrGrd.Cells[1,1]='' then

begin

MessageBox(64,'表格没有数据转换！','警告信息框',MB_OK MB_ICONWARNING);

Exit;

end;

try

k:=0;

ProgressBar1.Min:=0;

ProgressBar1.Max:=StrGrd.ColCount*StrGrd.RowCount;

ProgressBar1.Position:=0;

ExcelApp:=CreateOLEObject('Excel.Application');//需要ComObj单元创建Excel对象)

ExcelApp.Caption:=DocmName;//更改Excel标题栏

ExcelApp.WorkBooks.Add(xlWBatWorkSheet);//添加新工作簿单工作表

for i := 0 to StrGrd.ColCount – 1 do

begin

for j := 0 to StrGrd.RowCount – 1 do

begin

ExcelApp.Goto('R' IntToStr(j 1) 'C' IntToStr(i 1));//Excel的表格是从1开始编号

ExcelApp.ActiveCell.FormulaR1C1:=StrGrd.Cells[i,j];//将StringGrid各单元字符串给EXCEL各单元

k:=k 1;

ProgressBar1.Position:=k;

end;

if StrGrd.ColCount=1 then strCol:='A'

else if StrGrd.ColCount=2 then strCol:='B'

else if StrGrd.ColCount=3 then strCol:='C'

else if StrGrd.ColCount=4 then strCol:='D'

else if StrGrd.ColCount=5 then strCol:='E'

else if StrGrd.ColCount=6 then strCol:='F'

else if StrGrd.ColCount=7 then strCol:='G'

else if StrGrd.ColCount=8 then strCol:='H'

else if StrGrd.ColCount=9 then strCol:='I'

else if StrGrd.ColCount=10 then strCol:='J'

else if StrGrd.ColCount=11 then strCol:='K'

else if StrGrd.ColCount=12 then strCol:='L'

else if StrGrd.ColCount=13 then strCol:='M'

else if StrGrd.ColCount=14 then strCol:='N'

else if StrGrd.ColCount=15 then strCol:='O'

else if StrGrd.ColCount=16 then strCol:='P'

else if StrGrd.ColCount=17 then strCol:='Q'

else if StrGrd.ColCount=18 then strCol:='R'

else if StrGrd.ColCount=19 then strCol:='S'

else if StrGrd.ColCount=20 then strCol:='T'

else if StrGrd.ColCount=21 then strCol:='U'

else if StrGrd.ColCount=22 then strCol:='V'

else if StrGrd.ColCount=23 then strCol:='W'

else if StrGrd.ColCount=24 then strCol:='X'

else if StrGrd.ColCount=25 then strCol:='Y'

else if StrGrd.ColCount=26 then strCol:='Z';

//设置不同记录行字体属性：

strRange_min:='A' '1';

strRange_max:=strCol '1';

Range:=ExcelApp.ActiveSheet.Range[strRange_min ':' strRange_max];

Range.HorizontalAlignment:=xlCenter; // 文本水平居中方式(需要ExcelXP单元)

Range.Font.Color:=clRed; //字体颜色

Range.Font.name:='幼园'; //字体

Range.Font.Italic:=True; //斜体

Range.Interior.ColorIndex:=39; //填充颜色为淡紫色

//设置格式

ExcelApp.ActiveSheet.PageSetup.CenterHeader:=DocmName '的EXCEL表';//页眉

ExcelApp.ActiveSheet.PageSetup.CenterFooter:='第&P页';//页脚

ExcelApp.ActiveSheet.PageSetup.HeaderMargin:=1/0.035;//页眉到顶端边距1cm

ExcelApp.ActiveSheet.PageSetup.HeaderMargin:=1/0.035;//页脚到底端边距1cm

ExcelApp.ActiveSheet.PageSetup.TopMargin :=2/0.035;//顶边距2cm

ExcelApp.ActiveSheet.PageSetup.BottomMargin:=2/0.035;//底边距2cm

ExcelApp.ActiveSheet.PageSetup.LeftMargin:=1;//设置左页边距

ExcelApp.ActiveSheet.PageSetup.RightMargin:=1;//设置右页边距

ExcelApp.ActiveSheet.PageSetup.CenterHorizontally:=1/0.035;//页面水平居中

ExcelApp.ActiveSheet.PageSetup.CenterVertically:=1/0.035;//页面垂直居中

ExcelApp.ActiveSheet.PageSetup.Zoom:=100;//设置显示比例

ExcelApp.ActiveSheet.PageSetup.PaperSize:=xlPaperA4;//设置打印纸张(需要ExcelXP单元)

ExcelApp.ActiveSheet.PageSetup.PrintGridLines:=True;//打印单元格网线

Application.BringToFront; //程序前置

Cursor:=crSQLWait;

ShowMessage('数据库到Excel的数据传输完毕!');

ExcelApp.Visible:=True;//显示当前窗口

except

Application.MessageBox('因故不能打开Excel表！',PChar(Application.Title),MB_ICONERROR);

end;

finally

Cursor:=crDefault;

end;

//文件调入数据子过程

procedure TF_MultiLineRegress.InputFileData;

var ExaName:shortstring; //调入文档扩展名

i:integer;

begin

OpenDialog1.Title:='请输入文本、EXCEL、ACCESS,SQL文件数据';

OpenDialog1.Filter:='TEXT,EXCEL,ACCESS,SQL(*.txt;*.xls;*.mdb;*.mdf)|*.txt;*.xls;*.mdb;*.mdf|';

if OpenDialog1.Execute then

begin

ExaName:=extractfileext(OpenDialog1.FileName);//取文件名扩展名

if (ExaName='.txt')or(ExaName='.TXT') then //文本表格

begin

StatusBar1.Panels[1].Text:='『调入文本表格数据』';

InputTextDocm(StringGrid1);

end else if (ExaName='.xls')or(ExaName='.XLS') then //EXECL表格

begin

InputExcelDocm(ADOTable1,SheetName,StringGrid1);

end else if (ExaName='.mdb')or(ExaName='.MDB') then //ACCESS表格

begin

StatusBar1.Panels[1].Text:='『调入ACCESS表数据』';

InputAccessDocm(ADOTable1,SheetName,StringGrid1);

end else if (ExaName='.mdf')or(ExaName='.MDF') then //SQL表格

begin

StatusBar1.Panels[1].Text:='『调入SQL表数据』';

InputSQLDocm(ADOTable1,SheetName,StringGrid1);

end;

for i:=1 to StringGrid1.RowCount-1 do

StringGrid1.Cells[0,i]:=inttostr(i);

Record_Num:=StringGrid1.RowCount-1;

StrGrdChang(StringGrid1); //StringGrid列变

end;

F_FileDataInput.Close; //关闭F_FileDataInput窗口

end;

//录入文本过程（将文本文件TXT转换成STRINGGRID数据表模式）

procedure TF_MultiLineRegress.InputTextDocm(StringGrid:TStringGrid);

var TxtSL:TStringlist;

i,j,k,u,w:integer;//i是记录数，j是字段数

TmpStr:string;//临时字符串记录变量

begin

TxtSL:=TStringlist.Create; //创建字符串列表类TxtSL

TxtSL.LoadFromFile(OpenDialog1.FileName); //将所选择文本数据表调入字符串列表类TxtSL

if TxtSL.Count>0 then //若字符串列表中有记录存在

begin

//为求表格列数和进程条最大值

w:=0;TmpStr:=TxtSL.Strings[0];

for j:=1 to ChEnCharLen(TmpStr) 1 do //每行字符串最后都有回车和换行两个字符

begin //ChEnCharLen该函数将中西文字符数分别计算

if(MidStr(TmpStr,j,1)=' ')or(j=ChEnCharLen(TmpStr) 1)then//测试j处字符是Tab或记录结束

begin

w:=w 1; //累加测试文本数据表的列数

end;

StringGrid.ColCount:=w 1; //求总表格列数

StringGrid.RowCount:=TxtSL.Count 1;

//下面进行字段字符串的切分

for i:=0 to TxtSL.Count-1 do

begin

TmpStr:=TxtSL.Strings[i];

k:=0;u:=1;w:=1; //Length(TmpStr)该函数只将字符按本文方式计算

for j:=1 to ChEnCharLen(TmpStr) 1 do //每行字符串最后都有回车和换行两个字符

begin //ChEnCharLen该函数将中西文字符数分别计算

if(MidStr(TmpStr,j,1)=' ')or(j=ChEnCharLen(TmpStr) 1)then//测试j处字符是Tab或记录结束

begin

StringGrid.Cells[w,i 1]:=MidStr(TmpStr,u,k);//U取字符开始位置,k取字符个数

w:=w 1;

u:=j 1;

k:=0;

end else

begin

k:=k 1;

end;

//将StrGrd中的数据用' '号画出来

procedure TF_MultiLineRegress.DrawDataCross(StrGrd:TStringGrid);

var i:integer;

x,y,z:Double; //画号临时变量

begin

if Variable_Num=2 then

begin

for i:=1 to StrGrd.RowCount-1 do

begin

StrGrd.Cells[0,i]:=inttostr(i); //对StringGrid中写序号

x:=strtofloatdef(StrGrd.Cells[1,i],0);

y:=0;

z:=strtofloatdef(StrGrd.Cells[2,i],0);

DrawCrossLine(x,y,z,Color4);//把实验数据点画为‘ ‘号

end;

end else if Variable_Num=3 then

begin

for i:=1 to StrGrd.RowCount-1 do

begin

StrGrd.Cells[0,i]:=inttostr(i); //对StringGrid中写序号

x:=strtofloatdef(StrGrd.Cells[1,i],0);

y:=strtofloatdef(StrGrd.Cells[2,i],0);

z:=strtofloatdef(StrGrd.Cells[3,i],0);

DrawCrossLine(x,y,z,Color4);//把实验数据点画为‘ ‘号

end;

//录入EXCEL表记录

procedure TF_MultiLineRegress.InputExcelDocm(ADOTable:TADOTable;

ExcelSheet:shortstring;StringGrid:TStringGrid);

var ACol,ARow:integer; //表格中的行,列

begin

ADOTable.ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;Data Source=' OpenDialog1.FileName ';Extended Properties=Excel 8.0;Persist Security Info=False';

ADOTable.TableDirect:=True; //直接打开工作表,不作认证

ADOTable.TableName:=ExcelSheet; //打开EXCEL指定工作表ExcelSheet

ADOTable.Active:=True; //激活ADO表连接引擎

StringGrid.ColCount:=ADOTable.FieldCount 1;//列记录数,另加一列序号

StringGrid.RowCount:=ADOTable.RecordCount 1; //行记录数

ADOTable.First; //将表的指针指向记录第一

for ARow:=1 to ADOTable.RecordCount 1 do //记录数(行RecordCount)

begin

for ACol:=0 to ADOTable.FieldCount-1 do //字段数(列FieldCount)

StringGrid.Cells[ACol 1,ARow]:=ADOTable.Fields[ACol].AsString;

ADOTable.Next;

StringGrid.Cells[0,ARow]:=inttostr(ARow);

end;

ADOTable.Active:=False; //关闭ADO表连接引擎

end;

//录入ACCESS表记录

procedure TF_MultiLineRegress.InputAccessDocm(ADOTable:TADOTable;

AccessSheet:shortstring;StringGrid:TStringGrid);//录入ACCESS表记录

var ACol,ARow:integer; //表格中的行,列

begin

ADOTable.ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;Data Source=' OpenDialog1.FileName ';Persist Security Info=False';

ADOTable.TableDirect:=True; //直接打开工作表,不作认证

ADOTable.TableName:=AccessSheet; //打开Access工作表

ADOTable.Active:=True; //激活ADO表连接引擎

StringGrid.ColCount:=ADOTable.FieldCount 1;//在StringGrid控件上画字段数(列)表格

StringGrid.RowCount:=ADOTable.RecordCount 1; //记录数(行)

for ARow := 1 to ADOTable.RecordCount 1 do //记录数(行RecordCount)

begin

for ACol := 0 to ADOTable.FieldCount-1 do //字段数(列FieldCount)

StringGrid.Cells[ACol,ARow]:=ADOTable.Fields[ACol].AsString;

ADOTable.Next;

end;

ADOTable.Active:=False; //关闭ADO表连接引擎

end;

//录入SQLServer表记录

procedure TF_MultiLineRegress.InputSQLDocm(ADOTable:TADOTable;

SQLSheet:shortstring;StringGrid:TStringGrid);//录入SQLServer表记录

var ACol,ARow:integer; //表格中的行,列

begin

ADOTable.ConnectionString:='Provider=SQLOLEDB.1;Data Source=' OpenDialog1.FileName ';Persist Security Info=False';

ADOTable.TableDirect:=True; //直接打开工作表,不作认证

ADOTable.TableName:=SQLSheet; //打开Access工作表

ADOTable.Active:=True; //激活ADO表连接引擎

StringGrid.ColCount:=ADOTable.FieldCount 1;//在StringGrid控件上画字段数(列)表格

StringGrid.RowCount:=ADOTable.RecordCount 1; //记录数(行)

for ARow := 1 to ADOTable.RecordCount 1 do //记录数(行RecordCount)

begin

for ACol := 0 to ADOTable.FieldCount-1 do //字段数(列FieldCount)

StringGrid.Cells[ACol,ARow]:=ADOTable.Fields[ACol].AsString;

ADOTable.Next;

end;

ADOTable.Active:=False; //关闭ADO表连接引擎

end;

//中西字符长度变换函数

function TF_MultiLineRegress.ChEnCharLen(Str:string):integer;

var i,iEnglish,iChinese:integer;

begin

iEnglish:=0;

iChinese:=0;

for i:=1 to Length(Str) do

begin

if ORD(Str[i])<=126 then //ASCII码126以前都是本文码

Inc(iEnglish)

else if ORD(Str[i])>127 then //ASCII码127后面都为汉字编码

Inc(iChinese);

end;

Result:=iEnglish iChinese div 2; //汉字字符为双字节

end;

//StringGrid列变

procedure TF_MultiLineRegress.StrGrdChang(strGrd:TStringGrid);

var i,a:integer;

begin

StrGrd.Cells[0,0]:='序号';

StrGrd.ColWidths[0]:=30;

a:=26*Record_Num 2; //总记录条的高度

if Variable_Num=2 then //二个变量是二维坐标

begin

StrGrd.ColCount:=3;

if a<StrGrd.Height then

StrGrd.ColWidths[1]:=(StrGrd.Width-StrGrd.ColWidths[0])div 2-3

else

StrGrd.ColWidths[1]:=(StrGrd.Width-StrGrd.ColWidths[0])div 2-12;

StrGrd.ColWidths[2]:=StrGrd.ColWidths[1];

StrGrd.Cells[1,0]:='实验变量X';

StrGrd.Cells[2,0]:='实验变量Y';

end else if Variable_Num=3 then //三个变量是三维坐标

begin

StrGrd.ColCount:=4;

if a<StrGrd.Height then

StrGrd.ColWidths[1]:=(StrGrd.Width-StrGrd.ColWidths[0])div 3-2

else

StrGrd.ColWidths[1]:=(StrGrd.Width-StrGrd.ColWidths[0])div 3-8;

StrGrd.ColWidths[2]:=StrGrd.ColWidths[1];

StrGrd.ColWidths[3]:=StrGrd.ColWidths[1];

StrGrd.Cells[1,0]:='实验变量X';

StrGrd.Cells[2,0]:='实验变量Y';

StrGrd.Cells[3,0]:='实验变量Z';

end else if Variable_Num=4 then //四个自变量

begin

StrGrd.ColCount:=5;

if a<StrGrd.Height then

StrGrd.ColWidths[1]:=(StrGrd.Width-StrGrd.ColWidths[0])div 4-2

else

StrGrd.ColWidths[1]:=(StrGrd.Width-StrGrd.ColWidths[0])div 4-6;

StrGrd.ColWidths[2]:=StrGrd.ColWidths[1];

StrGrd.ColWidths[3]:=StrGrd.ColWidths[1];

StrGrd.ColWidths[4]:=StrGrd.ColWidths[1];

StrGrd.Cells[1,0]:='变量Y';

StrGrd.Cells[2,0]:='变量X1';

StrGrd.Cells[3,0]:='变量X2';

StrGrd.Cells[4,0]:='变量X3';

end else //五个以上变量不画图

begin

StrGrd.ColCount:=Variable_Num 1;

StrGrd.ColWidths[1]:=(StrGrd.Width-StrGrd.ColWidths[0])div 4-6;

StrGrd.Cells[1,0]:='变量Y';

for i:=2 to Variable_Num do

begin

StrGrd.ColWidths[i]:=StrGrd.ColWidths[1];

StrGrd.Cells[i,0]:='变量X' inttostr(i-1);

end;

//只能打开一个同子窗口自定义过程

procedure TF_MultiLineRegress.OpenChildForm(FormClass:TFormClass;var Fm;AOwner:TComponent);

var i:integer;

Child:TForm;

begin

for i := 0 to Screen.FormCount – 1 do

begin

if Screen.Forms[i].ClassType=FormClass then

begin

Child:=Screen.Forms[i];

if Child.WindowState=wsMinimized then

ShowWindow(Child.Handle,SW_SHOWNORMAL)

else

ShowWindow(Child.Handle,SW_SHOWNA);

if (not Child.Visible) then Child.Visible:=True;

Child.BringToFront;

Child.SetFocus;

TForm(Fm):=Child;

Exit;

end;

Child:=TForm(FormClass.NewInstance);

TForm(Fm):=Child;

Child.Create(AOwner);

end;

//系统初始化

procedure TF_MultiLineRegress.FormCreate(Sender: TObject);

var year,month,day:word;

begin

//LoginInitialize; //注册初始值(打开便激活注册)

DoubleBuffered:=True; //获取双倍缓存

TRollThread:=TRollFontThread.Create(True);//创建滚动线程

TRollThread.Resume; //唤醒该线程继续执行

ReadWriteIniFile; //读初始文件

B_AnalysSel:=False; //分析选择开关,只有使用了"分析选择"才能运行"执行操作"

AnalyseSelect_k:=False; //AnalyseSelect子窗口没有打开

k:=0;

drawK:=False; //表示曲线没有画

RunNum:=0; //未注册的运行次数

StatusBar1.Panels[1].Text:='『最小二乘曲线拟合』';

//显示年月日周

Decodedate(now,year,month,day);

StatusBar1.Panels[2].Text:=' ' inttostr(year) '年'

inttostr(month) '月' inttostr(day) '日' ' ' f_get_week;

end;

//自定义星期函数

Function TF_MultiLineRegress.f_get_week:shortString;

var days:array[1..7] of ShortString; //字符型天数一维静态数组

begin

days[1]:='星期日';

days[2]:='星期一';

days[3]:='星期二';

days[4]:='星期三';

days[5]:='星期四';

days[6]:='星期五';

days[7]:='星期六';

result:=days[DayOfWeek(now)]; //周日期函数DayOfWeek(now)返回值1~7,星期天为1

end;

//注册初始值(取机器码后两组数与19581129345异或,再取从右至左11位字符作为第一次机器密码)

Procedure TF_MultiLineRegress.LoginInitialize;

begin

MachineCode0:=RightStr(inttostr((GetCPUID[3] GetCPUID[4])xor 19581129345),11);

MachineCode1:=Serial(strtoint64(MachineCode0)); //第二次加密码

//比较注册表中注册码与机器码是否相同,确定合法用户

ReadRegistry; //调'读注册表'过程

if LoginCode=MachineCode1 then //注册用户

begin

NoRegistry:=False; //打开注册开关

F_MultiLineRegress.Caption:='【拟合平滑回归分析】 ——注册版，谢谢您对正版软件的支持！';

Timer1.Enabled:=True;

end else

begin

NoRegistry:=True; //没有注册

ShowMessage(' 试用版，使用次数有限。谢谢您使用该软件！');

F_MultiLineRegress.Caption:='【拟合平滑回归分析】 ——试用版，使用次数不能超过20次，谢谢！';

if RunNum>19 then

begin

SpeedButton3.Enabled:=False; //执行操作按钮失效

ShowMessage('您使用该软件超过了20次，' #13 #10 '敬请注册。谢谢您的支持！');

end else

begin

RunNum:=RunNum 1;

WriteRegistry;//写注册表过程

F_MultiLineRegress.Caption:='【拟合平滑回归分析】 ——试用版，这是您第' inttostr(RunNum) '次使用！';

end;

//读注册表过程

Procedure TF_MultiLineRegress.ReadRegistry;

var MyRegistry:TRegistry;

begin

MyRegistry:=TRegistry.Create; //创建注册表实例

MyRegistry.RootKey:=HKEY_LOCAL_MACHINE; //指定注册表根键路由

if MyRegistry.OpenKey('SoftWareP_MultiLineRegress',True)then//注册根键有则打开,无则创建

begin

if MyRegistry.ValueExists('LoginCode') then //若根值存在

LoginCode:=MyRegistry.ReadString('LoginCode'); //取注册号码

if MyRegistry.ValueExists('RunNumber') then //若根值中运行次数存在

RunNum:=strtoint(MyRegistry.ReadString('RunNumber')); //取运行次数

end;

MyRegistry.CloseKey; //关闭注册表主要路由

MyRegistry.Free; //释放注册表实例

end;

//写注册表过程

Procedure TF_MultiLineRegress.WriteRegistry;

var MyRegistry:TRegistry;

begin

MyRegistry:=TRegistry.Create; //创建注册表实例

MyRegistry.RootKey:=HKEY_LOCAL_MACHINE; //指定注册表根键路由

if MyRegistry.OpenKey('SoftWareP_MultiLineRegress',True)then

begin //打开关键词目录,若关键名不存在则创建

MyRegistry.WriteString('RunNumber',inttostr(RunNum));//将用户注册码写入注册表

end;

MyRegistry.CloseKey; //关闭注册表主要路由

MyRegistry.Free; //释放注册表实例

end;

//加密函数

function TF_MultiLineRegress.Serial(Num:DWORD):string;

var sNum:string;

inChar:array[1..4]of char;

begin

sNum:=inttostr(Num xor 1310231986); //对双字符异或转为数字型

inChar[1]:=char(((integer(sNum[1]) integer(sNum[2]))mod 5) integer('a'));

inChar[2]:=char(((integer(sNum[3]) integer(sNum[4]))mod 5) integer('a'));

inChar[3]:=char(((integer(sNum[5]) integer(sNum[6]))mod 5) integer('a'));

inChar[4]:=char(((integer(sNum[7]) integer(sNum[8]) integer(sNum[9]))mod 5) integer('a'));

insert(inChar[1],sNum,1);

insert(inChar[4],sNum,3);

insert(inChar[2],sNum,5);

insert(inChar[3],sNum,9);

Result:=sNum;

end;

//读写初始文件

Procedure TF_MultiLineRegress.ReadWriteIniFile;

var filename:shortstring;

MyIniFile:TIniFile;

i:integer;

begin

filename:=ExtractFilePath(paramstr(0)) 'config.ini';

MyIniFile:=TIniFile.Create(filename);

if FileExists(filename) then //若初始文件存在,读初始值

begin

Variable_Num:=strtoint(MyIniFile.Readstring('VariableNum','Variable_Num',filename));//选择坐标类型

Record_Num:=strtoint(MyIniFile.Readstring('RecordNum','Record_Num',filename));//记录条数

CoordX_min:=strtofloat(MyIniFile.Readstring('CoordXmin','CoordX_min',filename));//X坐标最小值

CoordX_max:=strtofloat(MyIniFile.Readstring('CoordXmax','CoordX_max',filename));//X坐标最大值

CoordY_min:=strtofloat(MyIniFile.Readstring('CoordYmin','CoordY_min',filename));//Y坐标最小值

CoordY_max:=strtofloat(MyIniFile.Readstring('CoordYmax','CoordY_max',filename));//Y坐标最大值

CoordZ_min:=strtofloat(MyIniFile.Readstring('CoordZmin','CoordZ_min',filename));//Z坐标最小值

CoordZ_max:=strtofloat(MyIniFile.Readstring('CoordZmax','CoordZ_max',filename));//Z坐标最大值

DrawX_min:=strtofloat(MyIniFile.Readstring('DrawXmin','DrawX_min',filename));//X绘图最小值

DrawX_max:=strtofloat(MyIniFile.Readstring('DrawXmax','DrawX_max',filename));//X绘图最大值

DrawY_min:=strtofloat(MyIniFile.Readstring('DrawYmin','DrawY_min',filename));//Y绘图最小值

DrawY_max:=strtofloat(MyIniFile.Readstring('DrawYmax','DrawY_max',filename));//Y绘图最大值

DrawZ_min:=strtofloat(MyIniFile.Readstring('DrawZmin','DrawZ_min',filename));//Z绘图最小值

DrawZ_max:=strtofloat(MyIniFile.Readstring('DrawZmax','DrawZ_max',filename));//Z绘图最大值

Width1:=strtoint(MyIniFile.Readstring('CoordWidth','Coord_width',filename));//坐标线宽

Width2:=strtoint(MyIniFile.Readstring('CurveWidth','Curve_width',filename));//曲线线宽

Width3:=strtoint(MyIniFile.Readstring('DataWidth','Data_width',filename));//曲线线宽

DrawX_step:=strtoint(MyIniFile.Readstring('DrawXstep','DrawX_step',filename));//X方向网格宽

DrawY_step:=strtoint(MyIniFile.Readstring('DrawYstep','DrawY_step',filename));//Y方向网格宽

CoordXY_Angle:=strtofloat(MyIniFile.Readstring('CoordXYAngle','CoordXY_Angle',filename));//XY夹角

Color1:=strtoint(MyIniFile.Readstring('BockGroundColor','BockGround_color',filename));//背景颜色

Color2:=strtoint(MyIniFile.Readstring('CoordinateColor','Coordinate_color',filename));//坐标颜色

Color3:=strtoint(MyIniFile.Readstring('CurveColor','Curve_color',filename));//曲线颜色

Color4:=strtoint(MyIniFile.Readstring('DataColor','Data_color',filename));//数据颜色

end else //若初始文件不在,先给初值,再写入初始文件

begin

Variable_Num:=2;

Record_Num:=1;

CoordX_min:=-8;

CoordX_max:=8;

CoordY_min:=-8;

CoordY_max:=8;

CoordZ_min:=-8;

CoordZ_max:=8;

DrawX_min:=-6;

DrawX_max:=6;

DrawY_min:=-6;

DrawY_max:=6;

DrawZ_min:=-6;

DrawZ_max:=6;

Width1:=1;

Width2:=1;

Width3:=1;

DrawX_step:=1;

DrawY_step:=1;

CoordXY_Angle:=45; //三维坐标中XY坐标夹角

Color1:=clYellow;

Color2:=clBlue;

Color3:=clRed;

Color4:=clGreen;

MyIniFile.Writeinteger('VariableNum','Variable_Num',Variable_Num);

MyIniFile.Writeinteger('RecordNum','Record_Num',Record_Num);

MyIniFile.WriteFloat('CoordXmin','CoordX_min',CoordX_min);

MyIniFile.WriteFloat('CoordXmax','CoordX_max',CoordX_max);

MyIniFile.WriteFloat('CoordYmin','CoordY_min',CoordY_min);

MyIniFile.WriteFloat('CoordYmax','CoordY_max',CoordY_max);

MyIniFile.WriteFloat('CoordZmin','CoordZ_min',CoordZ_min);

MyIniFile.WriteFloat('CoordZmax','CoordZ_max',CoordZ_max);

MyIniFile.WriteFloat('DrawXmin','DrawX_min',DrawX_min);

MyIniFile.WriteFloat('DrawXmax','DrawX_max',DrawX_max);

MyIniFile.WriteFloat('DrawYmin','DrawY_min',DrawY_min);

MyIniFile.WriteFloat('DrawYmax','DrawY_max',DrawY_max);

MyIniFile.WriteFloat('DrawZmin','DrawZ_min',DrawZ_min);

MyIniFile.WriteFloat('DrawZmax','DrawZ_max',DrawZ_max);

MyIniFile.WriteInteger('CoordWidth','Coord_width',Width1);

MyIniFile.WriteInteger('CurveWidth','Curve_width',Width2);

MyIniFile.WriteInteger('DataWidth','Data_width',Width3);

MyIniFile.WriteInteger('DrawXstep','DrawX_step',DrawX_step);

MyIniFile.WriteInteger('DrawYstep','DrawY_step',DrawY_step);

MyIniFile.WriteFloat('CoordXYAngle','CoordXY_Angle',CoordXY_Angle);

MyIniFile.WriteInteger('BockGroundColor','BockGround_color',Color1);

MyIniFile.WriteInteger('CoordinateColor','Coordinate_color',Color2);

MyIniFile.WriteInteger('CurveColor','Curve_color',Color3);

MyIniFile.WriteInteger('DataColor','Data_color',Color4);

end;

StringGrid1.RowCount:=Record_Num 1;

for i:=1 to Record_Num do StringGrid1.Cells[0,i]:=inttostr(i);

Label2.Caption:='[' inttostr(Variable_Num) '个变量]';

MyIniFile.Free;

end;

//计算坐标初始值

procedure TF_MultiLineRegress.CoordInitValue;

begin

//以下是建立坐标系统的基本参数

//下面-2是使绘图实际宽高小一点,不要顶格绘制, 1是增加一个世界坐标宽高度,便于坐标箭头显示

X_num:=Trunc((Image1.Width)/(Abs(CoordX_max-CoordX_min) 1));//X轴单位坐标宽刻度像素数

Z_num:=Trunc((Image1.Height)/(Abs(CoordZ_max-CoordZ_min) 1));//Z轴单位坐标高刻度像素数

Y_num:=Trunc(sqrt(X_num*X_num Z_num*Z_num)*cos(CoordXY_Angle*pi/180)/sqrt(2));//Y轴单位坐标高刻度像素数

X_0:=Trunc(X_num*Abs(CoordX_min-0.5)); //世界坐标原点在屏幕右移2的像素数 2

Z_0:=Trunc(Image1.Height-Z_num*Abs(CoordZ_min-0.5)); //世界坐标原点在屏幕上移2的像素数-2

end;

//世界坐标转为屏幕坐标函数

function TF_MultiLineRegress.WorldToScreen(var xworld,yworld,zworld:Double):TCoordiateRecord;

begin

CoordInitValue;//调用坐标基本初始值原点X_0及单位坐标像素数X_num

//注意：下面yworld前面的符号决定了正Y轴方向！

WorldToScreen.xscreen:=Round(X_0 xworld*X_num-yworld*Y_num*cos(CoordXY_Angle*pi/180));

WorldToScreen.zscreen:=Round(Z_0-zworld*Z_num yworld*Y_num*sin(CoordXY_Angle*pi/180));

end;

//画线段过程

procedure TF_MultiLineRegress.DrawLine(var x1world,y1world,z1world,x2world,y2world,z2world:Double);

var x1screen,z1screen,x2screen,z2screen:integer; //在屏幕上画的屏幕坐标点

begin

x1screen:=WorldToScreen(x1world,y1world,z1world).xscreen;

z1screen:=WorldToScreen(x1world,y1world,z1world).zscreen;

x2screen:=WorldToScreen(x2world,y2world,z2world).xscreen;

z2screen:=WorldToScreen(x2world,y2world,z2world).zscreen;

Image1.Canvas.MoveTo(x1screen,z1screen);

Image1.Canvas.LineTo(x2screen,z2screen);

end;

//把实验数据点画为‘ ‘号

procedure TF_MultiLineRegress.DrawCrossLine(var xworld,yworld,zworld:Double;Color:TColor);

var x1world,y1world,z1world,x2world,y2world,z2world:Double;

begin

Image1.Canvas.Pen.Width:=Width3;//数据线宽度

Image1.Canvas.Pen.Color:=Color;//数据颜色

Image1.Canvas.Pen.Style:=PSSolid;//坐标为实线

if Variable_Num=2 then yworld:=0; //若为二维平面坐标系

x1world:=xworld-(CoordX_max-CoordX_min)/120;

x2world:=xworld (CoordX_max-CoordX_min)/120;

if Variable_Num=3 then //若为三维立体坐标系

begin

y1world:=yworld-(CoordY_max-CoordY_min)/120;

y2world:=yworld (CoordY_max-CoordY_min)/120;

end;

z1world:=zworld-(CoordZ_max-CoordZ_min)/120;

z2world:=zworld (CoordZ_max-CoordZ_min)/120;

DrawLine(x1world,yworld,zworld,x2world,yworld,zworld); //画X轴

if Variable_Num=3 then DrawLine(xworld,y1world,zworld,xworld,y2world,zworld); //画Y轴

DrawLine(xworld,yworld,z1world,xworld,yworld,z2world); //画X轴

end;

//画箭头过程

procedure TF_MultiLineRegress.ArrowHead(var x1world,y1world,z1world,x2world,y2world,z2world:Double);

var x1screen,z1screen,x2screen,z2screen,x3screen,z3screen:integer;//在屏幕上画的屏幕坐标点

Axscreen,Azscreen:integer; //矢量屏幕坐标差

α,AAscreen:Double; //矢量的屏幕模值与X屏幕坐标的夹角

begin

x1screen:=WorldToScreen(x1world,y1world,z1world).xscreen;

z1screen:=WorldToScreen(x1world,y1world,z1world).zscreen;

x2screen:=WorldToScreen(x2world,y2world,z2world).xscreen;

z2screen:=WorldToScreen(x2world,y2world,z2world).zscreen;

Axscreen:=x2screen-x1screen;

Azscreen:=z2screen-z1screen;

AAscreen:=sqrt(Axscreen*Axscreen Azscreen*Azscreen);

α:=0;

if((Axscreen>0)and(Azscreen>0))or((Axscreen<0)and(Azscreen>0))then //一二象限

begin

α:=arccos(Axscreen/AAscreen);

end else if((Axscreen<0)and(Azscreen<0))or((Axscreen>0)and(Azscreen<0))then//三四象限

begin

α:=2*pi-arccos(Axscreen/AAscreen);

end else if(Axscreen=0)and(Azscreen>0)then

begin

α:=pi/2;

end else if(Axscreen=0)and(Azscreen<0)then

begin

α:=pi*3/2;

end else if(Axscreen>0)and(Azscreen=0)then

begin

α:=0;

end else if(Axscreen<0)and(Azscreen=0)then

begin

α:=pi;

end;

//画上边斜线

x3screen:=Round(x2screen-15*cos(α 15*pi/180));

z3screen:=Round(z2screen-15*sin(α 15*pi/180));

Image1.Canvas.MoveTo(x2screen,z2screen);

Image1.Canvas.LineTo(x3screen,z3screen);

//画下边斜线

x3screen:=Round(x2screen-15*cos(α-15*pi/180));

z3screen:=Round(z2screen-15*sin(α-15*pi/180));

Image1.Canvas.MoveTo(x2screen,z2screen);

Image1.Canvas.LineTo(x3screen,z3screen);

end;

//画刻度及标尺过程

procedure TF_MultiLineRegress.Scale(var x1world,y1world,z1world,

x2world,y2world,z2world:Double;a,b:smallint);//a,b是线段画刻度的起始值

var Axworld,Ayworld,Azworld,AAworld:Double;

x1screen,z1screen,x2screen,z2screen,x3screen,z3screen:integer;//在屏幕上画的屏幕坐标点

Axscreen,Azscreen,num:integer; //矢量屏幕坐标差,Anum单位矢量像素数

α,AAscreen:Double; //矢量的屏幕模值与X屏幕坐标的夹角

i:smallint;

begin

Axworld:=x2world-x1world;

Ayworld:=y2world-y1world;

Azworld:=z2world-z1world;

AAworld:=sqrt(Axworld*Axworld Ayworld*Ayworld Azworld*Azworld);

x1screen:=WorldToScreen(x1world,y1world,z1world).xscreen;

z1screen:=WorldToScreen(x1world,y1world,z1world).zscreen;

x2screen:=WorldToScreen(x2world,y2world,z2world).xscreen;

z2screen:=WorldToScreen(x2world,y2world,z2world).zscreen;

Axscreen:=x2screen-x1screen;

Azscreen:=z2screen-z1screen;

AAscreen:=sqrt(Axscreen*Axscreen Azscreen*Azscreen);

num:=Trunc(AAscreen/AAworld); //单位矢量像素数

α:=0;

if((Axscreen>0)and(Azscreen>0))or((Axscreen<0)and(Azscreen>0))then //一二象限

begin

α:=2*pi-arccos(Axscreen/AAscreen);

end else if((Axscreen<0)and(Azscreen<0))or((Axscreen>0)and(Azscreen<0))then//三四象限

begin

α:=pi arccos(Axscreen/AAscreen);

end else if((Axscreen=0)and(Azscreen>0))or((Axscreen=0)and(Azscreen<0))then //Y轴

begin

α:=pi/2;

end else if((Axscreen>0)and(Azscreen=0))or((Axscreen<0)and(Azscreen=0))then //X轴

begin

α:=0;

end;

for i := a to b do //画刻度

begin

x2screen:=Round(x1screen i*num*cos(α));

z2screen:=Round(z1screen-i*num*sin(α));

if y_Axis=True then //若画Y轴,该变量仅用于此

begin

x3screen:=x2screen; //所有Y轴方向刻度都向上

z3screen:=Round(z2screen-15*sin(α pi));

end else begin

x3screen:=Round(x2screen-10*cos(α pi/2));

z3screen:=Round(z2screen-10*sin(α pi/2));

end;

Image1.Canvas.MoveTo(x2screen,z2screen);

Image1.Canvas.LineTo(x3screen,z3screen);

//在刻度下写坐标值

if(Axscreen>0)and(Azscreen=0)then //X正轴

begin

Image1.Canvas.TextOut(x2screen-2,z2screen 1,inttostr(i));

end else if(Axscreen<0)and(Azscreen=0)then //X负轴

begin

Image1.Canvas.TextOut(x2screen-6,z2screen 1,inttostr(i));

end else if(Axscreen=0)and(Azscreen<0)then //Z正轴

begin

Image1.Canvas.TextOut(x2screen-13,z2screen-6,inttostr(i));

end else if(Axscreen=0)and(Azscreen>0)then //Z负轴

begin

Image1.Canvas.TextOut(x2screen-18,z2screen-6,inttostr(i));

end else begin //Y正负轴

Image1.Canvas.TextOut(x2screen 2,z2screen 2,inttostr(i));

end;

//窗口变化

procedure TF_MultiLineRegress.FormResize(Sender: TObject);

begin

Panel1.Height:=F_MultiLineRegress.Height-53;

Panel1.Width:=Panel1.Height;

Image1.Height:=Panel1.Height-10;

Image1.Width:=Image1.Height;

Image1.Top:=5;

Image1.Left:=5;

Panel2.Width:=StatusBar1.Width-Panel1.Width;

Panel2.Height:=Panel1.Height;

Label100.Left:=2;

ProgressBar1.Left:=2;

SpeedButton1.Width:=Round(ToolBar1.Width/6);

SpeedButton2.Width:=SpeedButton1.Width;

SpeedButton3.Width:=SpeedButton1.Width;

SpeedButton4.Width:=SpeedButton1.Width;

SpeedButton5.Width:=SpeedButton1.Width;

SpeedButton6.Width:=ToolBar1.Width-SpeedButton1.Width*5;

GroupBox1.Width:=Panel5.Width-10;

GroupBox1.Top:=15;

GroupBox1.Left:=5;

GroupBox1.Height:=(Panel5.Height-35)div 2;

Button2.Top:=15;

Button1.Top:=Button2.Top;

Button2.Left:=GroupBox1.Width-Button2.Width-10;

Button1.Left:=Button2.Left-Button1.Width;

Button6.Top:=GroupBox1.Height-Button6.Height-7;

Button5.Top:=Button6.Top;

Button4.Top:=Button6.Top;

Button6.Left:=GroupBox1.Width-Button6.Width-10;

Button5.Left:=Button6.Left-Button5.Width;

Button4.Left:=Button5.Left-Button4.Width;

StringGrid1.Width:=GroupBox1.Width-20;

StringGrid1.Height:=GroupBox1.Height-Button2.Height-Button6.Height-30;

StringGrid1.Top:=Button2.Top Button2.Height 4;

StringGrid1.Left:=10;

Label2.Top:=Button6.Top 5;

StrGrdChang(StringGrid1); //StringGrid列变

GroupBox2.Width:=GroupBox1.Width;

GroupBox2.Top:=GroupBox1.Height 25;

GroupBox2.Left:=5;

GroupBox2.Height:=GroupBox1.Height;

Memo1.Width:=GroupBox2.Width-10;

Memo1.Height:=GroupBox2.Height-20;

Memo1.Top:=15;

Memo1.Left:=5;

Panel3.Width:=Panel2.Width-2;

ProgressBar1.Width:=Panel3.Width-10;

ProgressBar1.Left:=1;

//注册帮助栏显示位置

Panel6.Top:=(Panel1.Height-Panel6.Height)div 2;

Panel6.Left:=(Panel1.Width-Panel6.Width)div 2;

end;

//退出系统

procedure TF_MultiLineRegress.SpeedButton6Click(Sender: TObject);

begin

Close;

end;

//释放内存

procedure TF_MultiLineRegress.FormClose(Sender: TObject;

var Action: TCloseAction);

begin

Action:=cafree;

end;

//写坐标轴标识字过程

procedure TF_MultiLineRegress.WriteCoordinateName(var xworld,yworld,zworld:Double;

Ax,Ay:smallint;char:shortstring);

var xscreen,zscreen:integer; //Ax,Ay是字的像素位移值,char是要写的字

begin

xscreen:=WorldToScreen(xworld,yworld,zworld).xscreen;

zscreen:=WorldToScreen(xworld,yworld,zworld).zscreen;

Image1.Canvas.TextOut(xscreen Ax,zscreen Ay,char);

end;

//画背景颜色

procedure TF_MultiLineRegress.BackGroundColor;

begin

Image1.Canvas.Brush.Color:=Color1; //背景.给画布刷子颜色

Image1.Canvas.Pen.Color:=Color1; //背景.给画布画笔颜色

//背景.确认画布大小,才能给背景画颜色

Image1.Canvas.Rectangle(0,0,Image1.Width,Image1.Height);

end;

//画三维坐标

procedure TF_MultiLineRegress.Draw3DCoordinate;

var x1world,y1world,z1world,x2world,y2world,z2world:Double;

a,b:smallint;//写坐标名时,字符的微调XY距离

begin

Image1.Canvas.Pen.Width:=Width1;//坐标线宽度

Image1.Canvas.Pen.Color:=Color2;//坐标线颜色

Image1.Canvas.Pen.Style:=PSSolid;//坐标为实线

DrawLine(x1world,y1world,z1world,x2world,y2world,z2world);//初始激活

x1world:=0;y1world:=0;z1world:=0;//世界坐标原点

Image1.Cursor:=crdefault; //若是立体坐标,则使用默认鼠标图形

x2world:=CoordX_max 0.5;y2world:=0;z2world:=0;a:=1;b:=Trunc(CoordX_max);

DrawLine(x1world,y1world,z1world,x2world,y2world,z2world);//正X轴

ArrowHead(x1world,y1world,z1world,x2world,y2world,z2world); //X正轴箭头

Scale(x1world,y1world,z1world,x2world,y2world,z2world,a,b); //刻度

WriteCoordinateName(x2world,y2world,z2world,-28,13,'X坐标');//写X坐标名

WriteCoordinateName(x1world,y1world,z1world,2,1,'0'); //写坐标原点

x2world:=0;y2world:=CoordY_max 0.5;z2world:=0;a:=1;b:=Trunc(CoordY_max);y_Axis:=True;

DrawLine(x1world,y1world,z1world,x2world,y2world,z2world);//正Y轴

ArrowHead(x1world,y1world,z1world,x2world,y2world,z2world); //Y正轴箭头

Scale(x1world,y1world,z1world,x2world,y2world,z2world,a,b); //刻度

WriteCoordinateName(x2world,y2world,z2world,6, 1,'Y坐标'); //写Y坐标名

y_Axis:=False;

x2world:=0;y2world:=0;z2world:=CoordZ_max 0.5;a:=1;b:=Trunc(CoordZ_max);

DrawLine(x1world,y1world,z1world,x2world,y2world,z2world);//正Z轴

ArrowHead(x1world,y1world,z1world,x2world,y2world,z2world); //Z正轴箭头

Scale(x1world,y1world,z1world,x2world,y2world,z2world,a,b); //刻度

WriteCoordinateName(x2world,y2world,z2world,-35,3,'Z坐标'); //写Z坐标名

x2world:=CoordX_min-0.5;y2world:=0;z2world:=0;a:=Trunc(CoordX_min);b:=-1;

DrawLine(x1world,y1world,z1world,x2world,y2world,z2world);//负X轴

Scale(x1world,y1world,z1world,x2world,y2world,z2world,a,b); //刻度

x2world:=0;y2world:=CoordY_min-0.5;z2world:=0;a:=Trunc(CoordY_min);b:=-1;y_Axis:=True;

DrawLine(x1world,y1world,z1world,x2world,y2world,z2world);//负Y轴

Scale(x1world,y1world,z1world,x2world,y2world,z2world,a,b); //刻度

y_Axis:=False;

x2world:=0;y2world:=0;z2world:=CoordZ_min-0.5;a:=Trunc(CoordZ_min);b:=-1;

DrawLine(x1world,y1world,z1world,x2world,y2world,z2world);//负Z轴

Scale(x1world,y1world,z1world,x2world,y2world,z2world,a,b); //刻度

end;

//画二维坐标

procedure TF_MultiLineRegress.Draw2DCoordinate;