Приложение и Листинг программы обработки данных «2009Mmod»

И.1 Проектный файл DLT.dpr

program DLT;

uses

Forms,

Unit1 in 'Unit1.pas' {Form1},

Unit2 in 'Unit2.pas',

Unit3 in 'Dop\Unit3.pas' {AboutBox},

Unit4 in 'Unit4.pas' {Form4};

{$R *.res}

begin

Application.Initialize;

Application.CreateForm(TForm1, Form1);

Application.CreateForm(TAboutBox, AboutBox);

Application.CreateForm(TForm4, Form4);

Application.Run;

end.

И.2 Модуль Unit1.pas

unit Unit1;

interface

uses

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

Dialogs, Menus, CustomizeDlg, ErrorMsgs, AppEvnts, ExtCtrls, StdCtrls, Grids,

ImgList, ToolWin, ComCtrls, ShellApi,Math, TeEngine, Series, TeeProcs,

Chart, Buttons, OleCtrls, Unit3, Unit4;

type

TForm1 = class(TForm)

MainMenu1: TMainMenu;

N3: TMenuItem;

N1: TMenuItem;

N11: TMenuItem;

N12: TMenuItem;

N5: TMenuItem;

N13: TMenuItem;

SaveDialog1: TSaveDialog;

PageControl1: TPageControl;

Tab1: TTabSheet;

GroupBox1: TGroupBox;

List1: TListBox;

Label1: TLabel;

Label2: TLabel;

Label3: TLabel;

Label4: TLabel;

Label5: TLabel;

GroupBox2: TGroupBox;

Label6: TLabel;

Label7: TLabel;

Label8: TLabel;

Label9: TLabel;

Label10: TLabel;

Label11: TLabel;

Label12: TLabel;

Label13: TLabel;

Label14: TLabel;

Label15: TLabel;

Label16: TLabel;

Label17: TLabel;

Chart2: TChart;

OpenDialog1: TOpenDialog;

Label18: TLabel;

RadioButton1: TRadioButton;

RadioButton2: TRadioButton;

RadioButton4: TRadioButton;

N4: TMenuItem;

N6: TMenuItem;

GroupBox3: TGroupBox;

Edit4: TEdit;

Button1: TButton;

Button2: TButton;

Label19: TLabel;

GroupBox4: TGroupBox;

GRmin: TLabeledEdit;

Grmax: TLabeledEdit;

N7: TMenuItem;

Button4: TButton;

Series3: TLineSeries;

Series2: TLineSeries;

List2: TListBox;

Label23: TLabel;

Series5: TPointSeries;

Label24: TLabel;

Label25: TLabel;

Button12: TButton;

Button13: TButton;

Label21: TLabel;

Label22: TLabel;

GroupBox5: TGroupBox;

Wmin: TLabeledEdit;

Wmax: TLabeledEdit;

Series7: TLineSeries;

Series8: TLineSeries;

Label26: TLabel;

Label27: TLabel;

Label28: TLabel;

Label29: TLabel;

Series4: TLineSeries;

GroupBox6: TGroupBox;

TrackBar1: TTrackBar;

GroupBox7: TGroupBox;

GroupBox8: TGroupBox;

procedure N11Click(Sender: TObject);

procedure N4Click(Sender: TObject);

procedure N6Click(Sender: TObject);

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

// procedure Button3Click(Sender: TObject);

procedure RadioButton2Click(Sender: TObject);

procedure Button4Click(Sender: TObject);

procedure RadioButton4Click(Sender: TObject);

procedure List2Click(Sender: TObject);

procedure Button12Click(Sender: TObject);

procedure Button13Click(Sender: TObject);

procedure Button14Click(Sender: TObject);

procedure List2KeyDown(Sender: TObject; var Key: Word;

Shift: TShiftState);

procedure GRminKeyUp(Sender: TObject; var Key: Word;

Shift: TShiftState);

procedure GrmaxKeyUp(Sender: TObject; var Key: Word;

Shift: TShiftState);

procedure WminKeyUp(Sender: TObject; var Key: Word;

Shift: TShiftState);

procedure WmaxKeyUp(Sender: TObject; var Key: Word;

Shift: TShiftState);

procedure N12Click(Sender: TObject);

procedure N13Click(Sender: TObject);

procedure TrackBar1Change(Sender: TObject);

procedure RadioGroup1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

const pi2=2*pi;eps =0.0001;

XG0= 0 ;

YG0 = 20 ;

NKDR= 500 ;

SGY = 500 ;

XG1 = XG0+NKDR ;

YG1 = YG0+SGY ;

maxscale = 20;

maxp = 2000;

// Описание переменных

var

Form1: TForm1;

//Вх данные

LFP,Y0:real;

zmin,lkaz,lt,zt:real;

Nfi,NSmax,delz:integer;

dps,dtt: array [1..maxp] of real;

Se4:byte;//Номер сечения

Aver,aver2,max:real;

z:array [1..100]of real;

C,c2:array [1..round(maxp/4)]of real;

IndGr,IndBar,tmpGr:integer;

ER:real;

psi0, teta0, rsred:real;

rz, au, bu, cu:real;

Npol:integer;

NP, np0, ns0,SC_Z:integer;

stet:integer; Scale:byte;scale2:byte;

Fmax,Nf:integer;

//gadosti

fiy, fi2, v, w:array [1..20] of double;

fi:array [1..100,1..20] of double; c1:array [1..20,1..20] of double;

A, B, E, T2:real;

sn, cs, sinp, cosp, sind, cosd:real;

PSI, XPZS:array [1..maxp] of real; //Отклонения от ср знач

H:array [1..360] of real; //Отклонения рельефа

AP, BP, AT, BT:array [1..round(maxp/4)] of real;

H_W,H_G, V_WAVINESS:real;//Волнистость и гранность

N_G, N_W:integer;

fnt:integer;

hf,Inter,wav:boolean; //Флажки

grminv,grmaxv,wminv,wmaxv:integer;//Границы

implementation

var

F_data,F_rez:text;tmpstr:string;

{$R *.dfm}

//Выделение числа из строки, используется при загрузке

Procedure GetNumber(var s:string; var s2,s3:string);

var

i:byte;

begin

i:=1; s2:='';

while (not(s[i] in ['0'..'9','-'])) do inc(i);

while (s[i] in ['0'..'9','.','-']) and (i<=length(s)) do begin

if s[i]='.' then s[i]:=',';

s2:=s2+s[i];inc(i);

end;

s3:='';

while i<=length(s) do begin

s3:=s3+s[i];inc(i);

end;

end;

//Заполнение листа исходных данных

Procedure RepaintList();

var i:integer;

begin

with Form1 do begin

for i:=0 to nsmax*nfi-1 do

if (i+1) mod nfi <>0 then

List1.Items[i]:=inttostr((i+1) mod nfi)+' '+floattostr(dps[i+1])+' '+floattostr(dtt[i+1])

else

List1.Items[i]:=inttostr(((i+1) div nfi)* nfi)+' '+floattostr(dps[i+1])+' '+floattostr(dtt[i+1])

end;

end;

//Установки перед началом и загрузкой файла

Procedure REst;

begin

form4.Show;

with form1 do begin

Scale:=1;

Scale2:=100;

inter:=false;

Radiobutton1.Enabled:=true;

Radiobutton2.Enabled:=true;

Radiobutton4.Enabled:=true;

GroupBox1.Enabled:=true;

GroupBox2.Enabled:=true;

GroupBox3.Enabled:=true;

GroupBox4.Enabled:=true;

GroupBox5.Enabled:=true;

Button13.Enabled:=true;

Button12.Enabled:=true;

Form4.Button14.Enabled:=false;

Form4.series1.Clear;

series2.Clear;

series3.Clear;

series4.Clear;

series5.Clear;

series7.Clear;

series8.Clear;

if nsmax=1 then begin

Groupbox3.Visible:=false;

Radiobutton1.Enabled:=false;

end

else

GroupBox3.Visible:=true;

Button4.Click;

list2.Selected[0]:=true;

end;

end;

//Загрузка

procedure TForm1.N11Click(Sender: TObject);

var FNameTmp,s,sq,s2,s3:string;

i,j:integer;

begin

If not OpenDialog1.Execute then Exit;

FNameTmp:=OpenDialog1.FileName;

AssignFile(F_Data,FNameTmp);

try

Reset(F_Data);

except

MessageDlg(error_load+FNameTmp,mtError,[mbOK],0); {если не загружается выдаем ошибку}

exit;

end;

i:=1;

List1.Clear;

if not SeekEOF(F_Data) then begin

while i<=length(FNameTmp) do begin

if FNameTmp[i] ='\' then j:=i;

inc(i);

end;

tmpstr:= Copy(FNameTmp,j+1,i-j);

Tab1.Caption:='Файл : '+tmpstr;

readln(F_Data,S);GetNumber(s,sq,s2);

lfp:=strtofloat(sq);

Label1.Caption:='Радиус фотоприемника, мм : '+sq;

GetNumber(s2,sq,s2);

y0:=strtofloat(sq);

Label2.Caption:='Смещение осветителя, мм : '+sq;

readln(F_Data,S);GetNumber(s,sq,s2);

zmin:=strtofloat(sq);

Label5.Caption:='Zmin осветителя, мм : '+sq;

GetNumber(s2,sq,s2);

delz:=strtoint(sq);

Label4.Caption:='Шаг осветителя, мкм : '+sq;

readln(F_Data,S);readln(F_Data,S);

GetNumber(s,sq,s2);

nfi:=strtoint(sq);

Label3.Caption:='Количество точек на оборот : '+sq;

GetNumber(s2,sq,s2);

nsmax:=strtoint(sq);

Label19.Caption:='Количество сечений : '+sq;

Edit4.Text:='1';

se4:=1;

j:=1;

i:=0;

aver2:=0;

aver:=0;

while not(EOF(F_Data)) do begin

readln(F_Data,S);

GetNumber(s,sq,s2);

GetNumber(s2,sq,s3);

dps[j]:=strtofloat(sq);

Aver:=aver + dps[j];

GetNumber(s3,sq,s3);

dtt[j]:=strtofloat(sq);

Aver2:=aver2 + (dtt[j]);

inc(j);

end;

aver:=aver/(j-1);

aver2:=aver2/(j-1);

CloseFile(F_Data);

RepaintList;

grminv:=0;

wminv:=0;

FMAX:=round(NFI/4); nF:=round( FMAX/2);

Label27.Caption:='спектров : '+inttostr(fmax);

Label29.Caption:='спектров : '+inttostr(fmax);

grmaxv:=fmax;

Wmaxv:=fmax;

grmax.Text:=inttostr(grmaxv);

wmax.Text:=inttostr(grmaxv);

wav:=false;

rest;

end;

end;

//Сохранение

procedure TForm1.N12Click(Sender: TObject);

var FNameTmp,s:string; i:integer;

begin

if inter then begin

If not SaveDialog1.Execute then Exit;

FNameTmp:=SaveDialog1.FileName;

AssignFile(F_Data,FNameTmp);

if copy(SaveDialog1.FileName,length(SaveDialog1.FileName)-3,4)<>'.rez' then

SaveDialog1.FileName:=SaveDialog1.FileName+'.rez';

if (SaveDialog1.FileName<>FNameTmp)and FileExists(SaveDialog1.FileName) then begin

i:=application.MessageBox('Файл уже существует! Перезаписать?','Сохранение',mb_YesNoCancel+mb_iconexclamation);

case i of

IDNo: begin

Form1.N12Click(Form1);

exit;

end;

IDCancel:exit;

end;

end;

AssignFile(F_rez,SaveDialog1.FileName);

try

Rewrite(F_rez);

except

ShowMessage('Невозможно сохранить файл '+SaveDialog1.FileName);

exit;

end;

writeln(F_rez,'Исходный файл: '+tmpstr);

if nsmax>1 then writeln(F_rez,'Номер сечения: '+inttostr(se4));

if not(wav) then begin

writeln(F_rez,'Границы спектров: '+inttostr(grminv)+ ' '+inttostr(grmaxv));

writeln(F_rez,'Гранность: '+floattostrf(H_g,ffFixed ,10,4) +' ' +inttostr(n_g))

end

else begin

writeln(F_rez,'Границы спектров: '+inttostr(wminv)+ ' '+inttostr(wmaxv));

writeln(F_rez,'Волнистость: '+floattostrf(H_w,ffFixed ,10,4) +' ' +inttostr(n_w))

end;

for i:=1 to 360 do begin

s:=inttostr(i)+' '+floattostrf(h[i],ffFixed ,10,4)+ ' '+floattostrf(psi[i],ffFixed ,10,4)+ ' '+floattostrf(XPZS[i],ffFixed ,10,4);

writeln(F_rez,s);

end;

FNameTmp:=SaveDialog1.FileName;

CloseFile(F_rez);

end;

end;

//ЗАкрашивание границ спектров

Procedure RepaintBar();

var i:integer;

begin

For i:=0 to form4.Series1.Count-1 do

form4.Series1.ValueColor[i]:=clBlue;

if not(wav) then begin

if grminv>0 then for i:=0 to grminv-1 do

form4.Series1.ValueColor[i]:=clRed;

if grmaxv<fmax then for i:=grmaxv to fmax-1 do

form4.Series1.ValueColor[i]:=clRed;

end else begin

if wminv>0 then for i:=0 to wminv-1 do

form4.Series1.ValueColor[i]:=clRed;

if wmaxv<fmax then for i:=wmaxv to fmax-1 do

form4.Series1.ValueColor[i]:=clRed;

end;

end;

//Вывод сведений о программе

procedure TForm1.N4Click(Sender: TObject);

begin

AboutBox:=TAboutBox.Create(Self);

AboutBox.Show;

end;

//Вывод хелпа

procedure TForm1.N6Click(Sender: TObject);

var i:Cardinal;

begin

i:=ShellExecute(handle,nil,'help\help0.html',nil,nil, SW_SHOWNORMAL);

if i=2 then MessageDlg(error_help,mtError,[mbOK],0);

end;

//Функции и процедуры для расчетов

Procedure table (y, l, psi, teta: real; r: real);

begin

A:= r / l; T2:= teta * teta;

sn:= y / r; cs:= sqrt (1.0 - sn*sn);

sinp:= sin (psi); cosp:= cos (psi);

sind:= sinp * cs - cosp * sn;

cosd:= cosp * cs + sinp * sn;

B:= sqrt (1.0 + A*A - 2.0*A*cosd + T2);

E:= sinp - A*sn;

end;

Function Hl_R (y0, L, psi, teta, R:real):real;

var x, d:real;

begin

table (y0, L, psi, teta, R);

d:= cosd - A - B*cs;

x:= d * E + T2 * sn;

Hl_R:=x;

end;

//Вычисление среднего радиуса

Function sr_radius (y0, L, psi_gr, teta_gr:real):real;

var

r1, r2, rs, y1, y2, ys, err, psi, teta, rad:real;

begin

rad:= PI2/360.0;

psi:= rad * psi_gr;

teta:= tan (rad * teta_gr);

r1:= y0; r2:= L; rs:= (r1 + r2)/2.0;

err:=abs (r2 - r1);

while (err > eps) do begin

y1:= Hl_R (y0, L, psi, teta, r1);

y2:= Hl_R (y0, L, psi, teta, r2);

ys:= Hl_R (y0, L, psi, teta, rs);

if ((y1*ys) < 0.0 ) then r2:= rs;

if ((ys*y2) < 0.0 ) then r1:= rs;

rs:= (r1 + r2)/2.0;

err:= abs (r2 - r1);

end;

sr_radius:=rs;

end;

Function dR_dz (y0, L, psi_gr, teta_gr, R0:real):real;

var x, d, f, psi, teta, rad:real;

begin

rad:= PI2/360.0;

psi:= rad * psi_gr; teta:= tan (rad * teta_gr);

table (y0, L, psi, teta, R0);

d:= B - cosp + A*cs;

f:= sind + B*sn;

x:= -teta * d / (f * E + cs * T2);

dR_dz:=x;

end;

Function dH_dl ( y0, L, psi_gr, teta_gr, R0, H:real): real;

var x, d, f, psi, teta, rad:real;

begin

rad:= PI2/360.0;

psi:= rad * psi_gr; teta:= tan (rad * teta_gr);

A:= R0/L; T2:= teta * teta;

sn:= y0/R0; cs:= sqrt (1.0 - sn*sn);

sinp:= sin (psi); cosp:= cos (psi);

sind:= sinp * cs - cosp * sn;

cosd:= cosp * cs + sinp * sn;

B:= sqrt (1.0 + A*A - 2.0*A*cosd + T2);

E:= sinp - A*sn;

d:= cosd - A - B * cs;

f:= sind + B * sn;

x:= (d * E + sn * T2) / (f * E + cs * T2);

dH_dl:=x;

end;

Function dH_dz (y0, L, psi_gr, teta_gr, R0, Rz, H:real):real;

var x, d, f, psi, teta, rad:real;

begin

rad:= PI2/360.0;

psi:= rad * psi_gr; teta:= tan (rad * teta_gr);

table (y0, L, psi, teta,R0+H);

d:= B - cosp + A*cs;

f:= sind + B*sn;

x:= -teta * d / (f * E + T2 * cs) - Rz;

dH_dz:=x;

end;

//коэф-ты для диф ур-я

Function coef_A (y0, L, psi_gr, teta_gr, R0:real):real;

var f, f1, f2, dx:real;

begin

dx:= 0.0001;

f1:= dH_dl (y0, L, psi_gr, teta_gr, R0-dx, 0.0);

f2:= dH_dl (y0, L, psi_gr, teta_gr, R0+dx, 0.0);

f:= R0*(f2 - f1)/(dx+dx);

coef_A:=f;

end;

Function coef_B (y0, L, psi_gr, teta_gr, R0:real):real;

var f, f1, f2, dx:real;

begin

dx:= 0.0001;

f1:= dH_dl (y0, L, psi_gr-dx, teta_gr, R0, 0.0);

f2:= dH_dl (y0, L, psi_gr+dx, teta_gr, R0, 0.0);

f:= R0*(f2 - f1)/((dx+dx)*PI2/360.0);

coef_B:=f;

end;

Function coef_C (y0, L, psi_gr, teta_gr, R0:real):real;

var f, f1, f2, dx:real;

begin

dx:= 0.0001;

f1:= dH_dl (y0, L, psi_gr, teta_gr-dx, R0, 0.0);

f2:= dH_dl (y0, L, psi_gr, teta_gr+dx, R0, 0.0);

f:= R0 * (f2 - f1)/((dx+dx)*PI2/360.0);

coef_C:=f;

end;

Function coefft (N:integer; y:array of real; k:integer;var a:real; var b:real):real;

var i:integer;

t, x, ak, bk:real;

begin

ak:= 0; bk:= 0;

t:= PI2*k/N;

for i:= 0 to N-1 do begin

x:= t * i;

ak:=ak + y[i]*cos (x);

bk:=bk + y[i]*sin (x);

end;

ak:= ak * 2.0/n;

bk:= bk * 2.0/n;

x:= sqrt (ak*ak + bk*bk);

a:=ak; b:=bk;

coefft:=x;

end;

//Вычисления для отклонений

Procedure pol_fft (N:integer;var H:array of real; M1,M2:integer; a:array of real; b:array of real);

var i, k:integer;

dx, t, x:real;

begin

dx:= PI2/N;

for i:=0 to N-1 do begin

x:= dx * i;

H[i]:=0;

for k:= M1 to M2-1 do begin

t:= (k+1) * x;

H[i]:=H[i] + a[k]*cos(t) + b[k]*sin(t);

end;

end;

end;

//Спектры

Function vol_fft (M:integer;var a:array of real; var b:array of real;AU:real;var c:array of real):real;

var

k:integer;

dk, ak, bk, s:real;

begin

for k:= 0 to m-1 do begin

dk:= (k+1);

s:= 1.0/(AU*AU + dk*dk); ak:= a[k]; bk:= b[k];

b[k]:= s * (dk*ak - AU*bk);

a[k]:= - s * (AU*ak + dk*bk);

c[k]:=sqrt(a[k]*a[k]+b[k]*b[k]);

end;

s:=0.0001;

for k:= 0 to m-1 do

if (c[k] > s) then s:= c[k];

for k:= 0 to m-1 do c[k]:=c[k]/s;

vol_fft:=s;

end;

Procedure Interpol (ns:integer; mf:integer);

var i,j, m1, m2:integer;

ck:real;

begin

m1:= NFI * ns; PSI0:= 0; TETA0:=0;

for i:=1 to NFI do begin

m2:= m1 + i;

PSI[i]:= dps[m2]; PSI0:=PSI0 + PSI[i];

XPZS[i]:= dtt[m2]; TETA0:=TETA0 + XPZS[i];

end;

ck:=NFI;

PSI0:=PSI0/ck; TETA0:=TETA0/ck;

for i:= 1 to NFI do begin

PSI[i]:=PSI[i] - PSI0; XPZS[i]:=XPZS[i] - TETA0;

end;

RSRED:= sr_radius (Y0, LFP, PSI0, TETA0);

RZ:= dR_dz (1000.0*Y0,1000.0* LFP, PSI0, TETA0, 1000.0*RSRED);

AU:= coef_A (1000.0*Y0,1000.0*LFP, PSI0, TETA0, 1000.0*RSRED);

BU:= coef_B (1000.0*Y0, 1000.0*LFP, PSI0, TETA0, 1000.0*RSRED);

CU:= coef_C (1000.0*Y0,1000.0* LFP, PSI0, TETA0, 1000.0*RSRED);

end;

Procedure interpol_dat();

var ck:real;

i,j:longint;

begin

i:=0;

for j:= 1 to NFI do

PSI[j]:=(BU*PSI[j] + CU*XPZS[j])*6.28/360.0;

for j:= 1 to fmax do

ck:= coefft (NFI, PSI, j, AP[j], BP[j]);

ck:= vol_fft (fmax, AP, BP, AU, C);

end;

//Определение гранности

Function hgr (n:integer; y:array of real):real;

var i:integer;min,max,s:real;

begin

min:= 1e6; max:=-1e6;

for i:=0 to n do begin

if (y[i] > max) then max:= y[i];

if (y[i] < min) then min:= y[i];

end;

s:= max - min;

hgr:=s;

end;

Function ngr (n:integer; y:array of real):integer;

var i,k,s:integer;

begin

s:=0;

if y[0]>0 then

for i:=0 to n-2 do

if (y[i]>0) and (y[i+1]<0) then

inc (s);

if y[0]<0 then

for i:=0 to n-2 do

if (y[i]<0) and (y[i+1]>0) then

inc (s);

ngr:=s;

end;

//Определение волнистости

Function hw (n:integer; y:array of real):real;

var i:integer;min,max,s:real;

begin

min:= 1e6; max:=-1e6;

for i:= 0 to n do

begin

if (y[i] > max) then max:= y[i];

if (y[i] < min) then min:= y[i];

end;

s:= max - min;

hw:=s;

end;

Function nw (n:integer; y:array of real):integer;

var i,k,s:integer;

begin

s:=0;

if y[0]>0 then

for i:=0 to n-2 do

if (y[i]>0) and (y[i+1]<0) then

inc (s);

if y[0]<0 then

for i:=0 to n-2 do

if (y[i]<0) and (y[i+1]>0) then

inc (s);

nw:=s;

end;

Procedure Grannost(n:integer;var y:array of real;

var h_greal; var n_g:integer);

begin

pol_fft (360, H, grminv, grmaxv, AP, BP);

h_g:= hgr (n, y);

n_g:= ngr(n,y);

end;

Procedure waviness2 (n:integer;var y:array of real;

var h_w:real; var n_w:integer);

begin

pol_fft (360, H, wminv, wmaxv, AP, BP);

h_w:= hw (n,y);

n_w:= nw (n,y);

end;

//рисование кружков и крестика

Procedure pict_vol2(r:integer);

var

i:integer;

begin

with form1 do begin

form1.Series2.Clear;

form1.Series3.Clear;

Chart2.Width:=677;

Series3.SeriesColor:=clblack;

Series2.SeriesColor:=clblack;

series7.AddXY(-r*1.6,0);

series7.AddXY(r*1.6,0);

series8.AddXY(0,-r*1.6);

series8.AddXY(0,r*1.6);

Series2.XValues.Order:=loNone;

for i:= 0 to 360 do begin

form1.Series2.AddXY(r * cos(i*pi2/360),r * sin(i*pi2/360),'')

end;

// form1.Series3.AddXY(r * cos(180*pi2/360),r * sin(180*pi2/360),'');

end;

end;

//Рисование микрорельефа scale1,2 - масштабы

Procedure pict_vol(n:integer;H:array of real);

var

i, xs, ys:integer;

r1, ix, iy:real;

begin

with form1 do begin

Series4.Clear;

xs:= round((XG0 + XG1)/2); ys:= round((YG0 + YG1)/2);

pict_vol2(scale2);

Series4.XValues.Order:=loNone;

for i:= 0 to 359 do begin

r1:= scale2+ H[i]*scale;

if r1> scale2*1.5 then r1:=scale2*1.5;

if r1< scale2/2 then r1:=scale2/2;

ix:=r1 * cos(i*pi2/360); iy:=r1 * sin(i*pi2/360);

form1.Series4.AddXY(ix,-iy);

end;

r1:= scale2+ H[0]*scale;

if r1> scale2*2 then r1:=scale2*2;

if r1< scale2/2 then r1:=scale2/2;

ix:=r1 * cos(0); iy:=r1 * sin(0);

form1.Series4.AddXY(ix,-iy);

Chart2.MaxYValue(Chart2.LeftAxis);

Chart2.LeftAxis.Minimum:=-(scale2*1.6);//Chart2.MinYValue(Chart2.LeftAxis)-10;

Chart2.LeftAxis.Maximum:=scale2*1.6; //Chart2.MaxYValue(Chart2.LeftAxis)+10;

Chart2.MaxYValue(Chart2.BottomAxis);

Chart2.BottomAxis.Minimum:=-(scale2*1.6);//Chart2.MinXValue(Chart2.LeftAxis)-10;

Chart2.BottomAxis.Maximum:=(scale2*1.6); //Chart2.MaxXValue(Chart2.LeftAxis)+10;

end;

end;

//Рисование спектров

Procedure Show_spectr();

var i:integer;MFM:integer;

begin

form4.Series1.Clear;

//Form1.Series1.

if form1.radiobutton2.Checked then

for i:= 1 to fmax do

Form4.Series1.Addbar(0.015+abs(2*scale*c[i]), '' , clBlue )

else

if form4.Button14.Caption='Teta' then

for i:= 1 to fmax do Form4.Series1.Add(0.015+2*scale*c[i], Inttostr(i) , clBlue )

else

for i:= 1 to fmax do Form4.Series1.Add(0.015+2*scale*c2[i], Inttostr(i) , clBlue );

form4.Chart1.LeftAxis.Maximum:=1.1;

form4.Chart1.LeftAxis.Minimum:=-0.01;

end;

//Вывод отклонений в зависимости от режима

Procedure RepaintList2(h:array of real);

var i:integer;

begin

with Form1 do begin

if (radiobutton2.Checked) then begin

for i:=0 to 359 do

List2.Items[i]:=inttostr(i)+' '+floattostrf(h[i],ffFixed ,10,4);

List2.Items[360]:=inttostr(360)+' '+floattostrf(h[0],ffFixed ,10,4);

end else

if radiobutton4.Checked then begin

for i:=1 to 360 do

List2.Items[i-1]:=inttostr(i-1)+' '+floattostrf(psi[i],ffFixed ,10,4)+' '+floattostrf(XPZS[i],ffFixed ,10,4);

List2.Items[360]:=inttostr(360)+' '+floattostrf(psi[1],ffFixed ,10,4)+' '+floattostrf(XPZS[1],ffFixed ,10,4);

end;

end;

end;

//Вычисление радиуса окружности в зависимости от отклонений

Procedure Calc_rad;

var i:integer;

begin

max:=0;

for i:=1 to 360 do if abs(H[i])>max then max:= abs(H[i]);

if max>10 then scale2:=100 else

if max>5 then scale2:=50 else

if max>1 then scale2:=20 else

if max>0.5 then scale2:=10 else

if max>0.1 then scale2:=2;

end;

//Если произошли изменения в режиме профилей

Procedure Izm;

begin

with form1 do begin

FMAX:=round(nfi/4);

Chart2.LeftAxis.LabelsFont.Color:=clbtnface;

Chart2.BottomAxis.LabelsFont.Color:=clbtnface;

Chart2.LeftAxis.Title.Caption:='';

Chart2.BottomAxis.Title.Caption:='';

interpol(se4-1, FMAX);

interpol_dat;

Show_spectr();

repaintbar;

if not(wav) then grannost (360, H, H_G, N_G) else

waviness2 (360, H, H_W, N_W);

if not(inter) then begin

Calc_rad;

inter:=true;

end;

pict_vol (360, H);

RepaintList2(H);

Label6.Caption:='R0 = '+floattostrf(rsred,ffFixed ,10,4);

Label7.Caption:=' RZ = '+floattostrf(rz,ffFixed ,10,4);

Label8.Caption:='RS = '+floattostrf(psi0,ffFixed ,10,4);

Label9.Caption:=' TT = '+floattostrf(teta0,ffFixed ,10,4);

Label11.Caption:='A = '+floattostrf(au,ffFixed ,10,4);

Label12.Caption:='C = '+floattostrf(cu,ffFixed ,10,4);

Label13.Caption:=' B = '+floattostrf(bu,ffFixed ,10,4);

Form1.Label14.Caption:='Гранность, мкм : '+floattostrf(H_g,ffFixed ,10,4);

Form1.Label15.Caption:='Число граней : '+inttostr(n_g);

Form1.Label16.Caption:='Волнистость , мкм : '+floattostrf(H_w,ffFixed ,10,4);

Form1.Label17.Caption:='Число волн : '+inttostr(n_w);

end;

end;

//Переключение в режим сигналов

procedure TForm1.RadioButton2Click(Sender: TObject);

begin

if radioButton2.Checked then begin

Series5.Clear;

label22.Visible:=false;

Label24.Visible:=false;

Label25.Visible:=false;

Form1.Label14.visible:=true;

Form1.Label15.visible:=true;

Form1.Label16.visible:=true;

Form1.Label17.visible:=true;

Form4.Button14.Enabled:=false;

groupbox4.Enabled:=true;

groupbox5.Enabled:=true;

STET:= 0;

fnt:=0;

hf:=false;

FMAX:=round(nfi/4);

nf:= round(nfi/8);

izm;

end;

end;

//Выбор мышкой отклонений на листе

procedure TForm1.List2Click(Sender: TObject);

var i:integer;r:real;

begin

series5.Clear; i:=List2.ItemIndex;

if radiobutton4.Checked then begin

series5.AddXY(i+1,scale*psi[i+1],'');

series5.AddXY(i+1,scale*XPZS[i+1],'');

end else begin

if i=360 then r:= scale2+ H[1]*scale

else

r:= scale2+ H[i+1]*scale;

if r>scale2*1.5 then r:=scale2*1.5;

if r<scale2/2 then r:=scale2/2;

series5.AddXY((r)* cos(I*pi2/360),-(r)* sin(I*pi2/360),'');

end;

end;

//расчеты длясигналов

Procedure interpol_sign(m:integer);

var i,j:integer;

ck,cmax,cmax2,ck1:real;

begin

cmax:=0;

cmax2:=0;

for j:=0 to m do begin

ck:= coefft (NFI, PSI, j, AP[j], BP[j]);

ck1:= coefft (NFI, XPZS, j, AT[j], BT[j]);

C[j]:=ck1;

C2[j]:=ck;

if (C2[j] > cmax) then cmax2:= C2[j];

if (C[j] > cmax) then cmax:= C[j];

end;

for i:= 0 to m do C[i]:=C[i] / cmax;

for i:= 0 to m do C2[i]:=C2[i] / cmax2;

end;

//Установки

Procedure Signals();

var i:integer;

begin

with Form1 do begin

Label24.Visible:=true;

Label25.Visible:=true;

Series2.Clear;

Series3.Clear;

Series4.Clear;

end;

end;

//Вывод графиков сигналов

Procedure Show_sign();

var i,y0,m1,m2,tmp:integer;

ym:real;

begin

with form1 do begin

Series5.Clear;

signals;

if not(wav) then begin

pol_fft (360, PSI, grminv, grmaxv, AP, BP);

pol_fft (360, XPZS, grminv, grmaxv, AT, BT);

end

else begin

pol_fft (360, PSI, wminv, wmaxv, AP, BP);

pol_fft (360, XPZS, wminv, wmaxv, AT, BT);

end;

Series3.SeriesColor:=clBlue;

Series2.SeriesColor:=clRed;

for i:= 1 to 360 do begin

Series2.AddXY(i,scale*PSI[i]);

Series3.AddXY(i,scale*XPZS[i]);

end;

Chart2.MaxYValue(Chart2.LeftAxis);

Chart2.LeftAxis.Minimum:=-3;

Chart2.LeftAxis.Maximum:=3;

Chart2.MaxYValue(Chart2.BottomAxis);

Chart2.BottomAxis.Minimum:=Chart2.MinxValue(Chart2.BottomAxis);

Chart2.BottomAxis.Maximum:=Chart2.MaxxValue(Chart2.BottomAxis);

Chart2.AllowZoom:=true;

end;

end;

//Изменения в сигналах

Procedure Izm2;

begin

with form1 do begin

FMAX:=round(nfi/4);

Chart2.AxisVisible:=true;

series7.Clear;

series8.Clear;

interpol(se4-1, FMAX);

interpol_sign(fmax);

Show_spectr();

interpol(se4-1, FMAX);

repaintbar;

Show_sign;

repaintlist2(h);

Chart2.LeftAxis.LabelsFont.Color:=clWindowtext;

Chart2.BottomAxis.LabelsFont.Color:=clWindowtext;

Chart2.LeftAxis.Title.Caption:='Отклонения';

Chart2.BottomAxis.Title.Caption:='Градусы по окружности';

Label6.Caption:='R0 = '+floattostrf(rsred,ffFixed ,10,4);

Label7.Caption:=' RZ = '+floattostrf(rz,ffFixed ,10,4);

Label8.Caption:='RS = '+floattostrf(psi0,ffFixed ,10,4);

Label9.Caption:=' TT = '+floattostrf(teta0,ffFixed ,10,4);

Label11.Caption:='A = '+floattostrf(au,ffFixed ,10,4);

Label12.Caption:='C = '+floattostrf(cu,ffFixed ,10,4);

Label13.Caption:=' B = '+floattostrf(bu,ffFixed ,10,4);

Form1.Label14.Caption:='Гранность, мкм : '+floattostrf(H_g,ffFixed ,10,4);

Form1.Label15.Caption:='Число граней : '+inttostr(n_g);

Form1.Label16.Caption:='Волнистость , мкм : '+floattostrf(H_w,ffFixed ,10,4);

Form1.Label17.Caption:='Число волн : '+inttostr(n_w);

end;

end;

//Процедуры управления

procedure TForm1.TrackBar1Change(Sender: TObject);

begin

scale := TrackBar1.Position;

if radiobutton2.Checked then

pict_vol (360, H)

else Show_sign;

show_spectr;

repaintbar;

list2click(Sender);

end;

//+масштаб

procedure TForm1.Button12Click(Sender: TObject);

begin

if scale<maxscale then begin

inc(scale);

if radiobutton2.Checked then

pict_vol (360, H)

else Show_sign;

show_spectr;

repaintbar;

list2click(Sender);

end;

end;

//-масштаб

procedure TForm1.Button13Click(Sender: TObject);

begin

if scale>=2 then begin

dec(scale);

if radiobutton2.Checked then

pict_vol (360, H)

else Show_sign;

show_spectr;

repaintbar;

list2click(Sender);

end;

end;

//выбор режима Сигналов

procedure TForm1.RadioButton4Click(Sender: TObject);

begin

if radiobutton4.Checked then begin

Form4.Button14.Enabled:=true;

label22.Visible:=true;

groupbox4.Enabled :=false;

groupbox5.Enabled:=false;

STET:= 2;

fnt:=0;

hf:=false;

nf:= round(nfi/8);

izm2;

end;

end;

procedure TForm1.RadioGroup1Click(Sender: TObject);

begin

end;

//Переключение между сечениями

//+сеч

procedure TForm1.Button1Click(Sender: TObject);

begin

if se4<nsmax then inc(se4);

Edit4.Text:=inttostr(se4);

if radiobutton4.Checked then

izm2

else izm;

end;

//-сеч

procedure TForm1.Button2Click(Sender: TObject);

begin

if se4>1 then dec(se4);

Edit4.Text:=inttostr(se4);

if radiobutton4.Checked then

izm2

else izm;

end;

//для отладки используетяс, пользователю недоступна:)

procedure TForm1.Button4Click(Sender: TObject);

begin

if radiobutton2.checked then

izm

else

//izm;

izm2;

end;

//Переключение между пси и тета для спектров

procedure TForm1.Button14Click(Sender: TObject);

begin

if form4.Button14.Caption='Teta' then begin

form4.Button14.Caption:='Psi';

Show_spectr;

end

else begin

form4.Button14.Caption:='Teta';

Show_spectr;

end;

end;

// Бег по списку отклонений

procedure TForm1.List2KeyDown(Sender: TObject; var Key: Word;

Shift: TShiftState);

var i:integer;r:real;

begin

series5.Clear; i:=List2.ItemIndex+1;

i:=List2.ItemIndex+1;

if radiobutton4.Checked then begin

series5.AddXY(i,scale*psi[i],'');

series5.AddXY(i,scale*XPZS[i],''); // series4.YValue[]

end else begin

if i=360 then r:= scale2+ H[1]*scale

else

r:= scale2+ H[i]*scale;

if r>scale2*1.5 then r:=scale2*1.5;

if r<scale2/2 then r:=scale2/2;

series5.AddXY((r)* cos(I*pi2/360),-(r)* sin(I*pi2/360),'');

// series5.AddXY(series4.XValue[i],series4.YValue[i],'');

end;

if (list2.ItemIndex = list2.Count-1) and (ord(key) =40) then List2.Selected[0]:=true;

if (list2.ItemIndex = 0) and (ord(key) =38) then List2.Selected[list2.Count-1]:=true;

end;

//Процедуры ввода границ

procedure TForm1.GRminKeyUp(Sender: TObject; var Key: Word;

Shift: TShiftState);

begin

// Edit1.Text:=inttostr(ord(key));

if ord(key) = 13 then begin wav:=false;button4.Click;end;

if not(ord(key) in [46,8,48..57,96..105]) then

grmin.Text:=inttostr(grminv)

else begin

if (grmin.Text<>'') then

if (strtoint(grmin.Text)<grmaxv) then begin

grminv:=strtoint(grmin.Text);

grmin.Text:=inttostr(grminv);

wav:=false;

end

else begin

grminv:=grmaxv-1;

grmin.Text:=inttostr(grminv);

wav:=false;

end;

end;

repaintbar;

end;

procedure TForm1.GrmaxKeyUp(Sender: TObject; var Key: Word;

Shift: TShiftState);

begin

//Edit1.Text:=inttostr(ord(key));

if ord(key) = 13 then begin wav:=false;button4.Click;end;

if not(ord(key) in [46,8,48..57,96..105]) then

grmax.Text:=inttostr(grmaxv)

else begin

if (grmax.Text<>'') then

if (strtoint(grmax.Text)<=fmax) and (strtoint(grmax.Text)>grminv) then begin

grmaxv:=strtoint(grmax.Text);

grmax.Text:=inttostr(grmaxv);

wav:=false;

end

else begin

grmaxv:=fmax;

grmax.Text:=inttostr(grmaxv);

wav:=false;

end;

end;

repaintbar;

end;

procedure TForm1.WminKeyUp(Sender: TObject; var Key: Word;

Shift: TShiftState);

begin

//Edit1.Text:=inttostr(ord(key));

if ord(key) = 13 then begin wav:=true;button4.Click;end;

if not(ord(key) in [46,8,48..57,96..105]) then

wmin.Text:=inttostr(wminv)

else begin

if (wmin.Text<>'') then

if (strtoint(wmin.Text)<wmaxv) then begin

wminv:=strtoint(wmin.Text);

wmin.Text:=inttostr(wminv);

wav:=true;

end

else begin

wminv:=wmaxv-1;

wmin.Text:=inttostr(wminv);

wav:=true;

end;

end;

repaintbar;

end;

procedure TForm1.WmaxKeyUp(Sender: TObject; var Key: Word;

Shift: TShiftState);

begin

// Edit1.Text:=inttostr(ord(key));

if ord(key) = 13 then begin wav:=true;button4.Click;end;

if not(ord(key) in [46,8,48..57,96..105]) then

wmax.Text:=inttostr(wmaxv)

else begin

if (wmax.Text<>'') then

if (strtoint(wmax.Text)<=fmax) and (strtoint(wmax.Text)>wminv) then begin

wmaxv:=strtoint(wmax.Text);

wmax.Text:=inttostr(wmaxv);

wav:=true;

end

else begin

wmaxv:=fmax;

wmax.Text:=inttostr(wmaxv);

wav:=true;

end;

end;

repaintbar;

end;

//Восстановление среднего профиля

//Profil

{Function tcheb(var mm,n:integer; var x,y,c:array of double):double;

Var

i,j,n1,m1,mk,mk1,m,k1,k,l:integer;

sx,sy,ym,del,s2:double;

begin

m:=mm + 1;

n1:=n+1; m1:=m+1;

sx:=0; sy:=0;

for i:=1 to n1-1 do begin

sx:=sx+x[i]; sy:=sy+y[i];

end;

sx:=sx/n; sy:=sy/n;

for i:= 1 to n1-1 do fi[i][1]:= 1;

fiy[1]:= sy*n; fi2[1]:=n;

for i:= 1 to n1-1 do fi[i][2]:= x[i] - sx;

fiy[2]:=0; fi2[2]:=0;

for i:= 1 to n1-1 do begin

fiy[2]:= fiy[2]+fi[i][2]*y[i];

fi2[2]:= fi2[2]+fi[i][2]*fi[i][2];

end;

c[1]:=sy; c[2]:=fiy[2]/fi2[2];

if m <= 2 then begin

s2:=0;

for i:= 1 to n1-1 do begin

ym:=c[1]+c[2]*(x[i] - sx);

del:= (y[i] - ym);

s2:=s2 + del*del;

end;

s2:=s2 / (dn - dm);

c[0]:= c[1]; c[1]:= c[2];

tcheb:=s2;

end;

for i:=3 to m1-1 do begin

for j:= 1 to i-1 do begin

v[j]:=0; w[j]:=0;

for k:= 1 to n1-1 do begin

sx:= power (x[k], i-1);

v[j]:=v[j] + fi[k][j]* sx;

w[j]:=w[j] + fi[k][j]*fi[k][j];

end;

end;

for k:= 1 to n1-1 do begin

fi[k][i]:=0;

for j:=1 to i do

fi[k][i]:=fi[k][i] + v[j]/w[j]*fi[k][j];

sx:= power (x[k], i-1);

fi[k][i]:= sx-fi[k][i];

end;

end;

for i:=3 to m1-1 do begin

fiy[i]:=0; fi2[i]:=0;

for k:= 1 to n1 do begin

fiy[i]:=fiy[i] + fi[k][i]*y[k];

fi2[i]:=fi2[i] + fi[k][i]*fi[k][i]; end;

end;

for i:= 3 to m1-1 do c[i]:= fiy[i]/fi2[i];

for i:= 1 to m1-1 do c1[1][i]:= c[i];

for k:= 1 to m-1 do begin

mk:= m - k; mk1:= m - k + 1;

for i:= 1 to mk do begin

v[i]:=0; w[i]:=0;

for l:= 1 to n1-1 do begin

sx:= power (x[l], mk);

v[i]:=v[i] + fi[l][i]*sx;

w[i]:=w[i] + fi[l][i]*fi[l][i];

end;

k1:= k + 1;

c1[k1][i]:=c1[k][i] - c1[k][mk1]*v[i]/w[i];

end;

end;

for i:= 1 to m1-1 do

c[i-1]:= c1[m-i+1][i];

s2:=0;

for i:= 1 to n1-1 do begin

sx:= poly (x[i],c);

del:= y[i] - sx;

s2:=s2 + del*del;

end;

s2:=s2 /(dn - dm);

s2:= sqrt (s2);

tcheb:=s2;

end;

Function Polynom(pow:integer):double;

var i,j,m1,m2:integer;

dz, zsr, di, err:double;

begin

zsr:=0; dz:= 0.001*dELZ;

for i:= 0 to NSMAX do begin

Z[i+1]:= ZMIN + di*dz;

zsr:=zsr + Z[i+1];

end;

zsr:=zsr/NSMAX;

for i:= 1 to NSMAX+1 do Z[i]:=Z[i] - zsr;

dz:=NFI;

for i:= 0 to NSMAX do begin

PSI0:=0.0; TETA0:= 0.0;

m1:= i*NFI;

for j:= 0 to NFI do begin

m2:= m1+j;

PSI02:=PSI02 + dps[m2]; TETA02:=TETA02 + dtt[m2];

end;

PSI02:=PSI02 / dz; TETA02:=TETA02 / dz;

R[i+1]:= sr_radius(Y0, LFP, PSI02, TETA02);

if (i=0) then R[0]:= R[1];

zsr:= R[i+1];

R[i+1]:= dR_dz (Y0, LFP, PSI0, TETA0, zsr);

end;

err:=tcheb (pow, NSMAX,Z,R,H);

C[0]:=R[0];

for i:= 0 to pow+1 do begin di:=i+1;

C[i+1]:= H[i]/di;

end;

Polynom:=err;

end;

Procedure show_pol();

begin

if (NPOL > 7) then np:= 8;

{ Form1.Edit5.Text:=floattostr(npol);

Form1.Edit6.Text:=floattostr(er);

Form1.Edit7.Text:=floattostr(c[1]);

Form1.Edit8.Text:=floattostr(c[2]);

Form1.Edit9.Text:=floattostr(c[3]);

Form1.Edit10.Text:=floattostr(c[4]);

end;

procedure TForm1.Button3Click(Sender: TObject);

var lt,lkal:double;

begin

STET:= 0;

npol:=1;

SC_Z:=100;

lt:=NSMAX;

//LKAL:=2.0*Z[NSMAX];

if (NSMAX < 3) then halt;

ER:=Polynom(NPOL);

// pict_rad (NPOL, SC_Z);

show_pol ();

NP:=round(SC_Z/2); ZT:=0; np0:= NP;

{ while (1) {

lt = (double)SC_Z;

RSRED = H[NP]; LT = 2.0*Z[NSMAX]/lt;

lin_R (); show_prof ();

}

//end;

procedure TForm1.N13Click(Sender: TObject);

begin

form1.Close;

end;

end.

И.3 Молуль Unit2.pas

unit Unit2;

interface

uses

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

Dialogs, Menus, CustomizeDlg, ErrorMsgs, AppEvnts, ExtCtrls, StdCtrls, Grids,

ImgList, ToolWin, ComCtrls, ShellApi,Math, TeEngine, Series, TeeProcs,

Chart, Buttons;

implementation

const pi2=2*pi;eps =0.0001;

XG0= 0 ;

YG0 = 20 ;

NKDR= 380 ;

SGY = 360 ;

XG1 = XG0+NKDR ;

YG1 = YG0+SGY ;

{Прототипы функций из проги}

var

//Чебыш

fiy, fi2, v, w:array [1..20] of double;

fi:array [1..100,1..20] of double; c1:array [1..20,1..20] of double;

//Sold

A, B, E, T2:double;

sn, cs, sinp, cosp, sind, cosd:double;

//waviness

H_W,H_G, V_WAVINESS:double;

N_G, N_W:integer;

//Global chars

//int dat[NKDR+2], null[NKDR+2], buf[NKDR+2];

PSI, XPZS:array [1..2001] of double;

snn, csn,H:array [1..360] of double;

AP, BP, AT, BT:array [1..150] of double;

//

MFMAX2, mfmax, MF2, mf:integer;

HVOL2, hvol:double;

ZT2, zt, LKAL:double;

//voln i gran (kol-vo, value)

Y0:double;

buf:array [1..NKDr+2] of integer;

//Апроксимация полиномами чебышева

Function tcheb(var mm,n:integer; var x,y,c:array of double):double;

Var

i,j,n1,m1,mk,mk1,m,k1,k,l:integer;

sx,sy,dn,dm,ym,del,s2:double;

begin

m:=mm + 1;

dn:=n; dm:=m;

n1:=n+1; m1:=m+1;

sx:=0; sy:=0;

for i:=1 to n1 do begin

sx:=sx+x[i]; sy:=sy+y[i];

end;

sx:=sx/dn; sy:=sy/dn;

for i:= 1 to n1 do fi[i][1]:= 1;

fiy[1]:= sy*dn; fi2[1]:=dn;

for i:= 1 to n1 do fi[i][2]:= x[i] - sx;

fiy[2]:=0; fi2[2]:=0;

for i:= 1 to n1 do begin

fiy[2]:= fiy[2]+fi[i][2]*y[i];

fi2[2]:= fi2[2]+fi[i][2]*fi[i][2];

end;

c[1]:=sy; c[2]:=fiy[2]/fi2[2];

if m <= 2 then begin

s2:=0;

for i:= 1 to n1 do begin

ym:=c[1]+c[2]*(x[i] - sx);

del:= (y[i] - ym);

s2:=s2 + del*del;

end;

s2:=s2 / (dn - dm);

c[0]:= c[1]; c[1]:= c[2];

tcheb:=s2;

end;

for i:=3 to m1 do begin

for j:= 1 to i do begin

v[j]:=0; w[j]:=0;

for k:= 1 to n1 do begin

sx:= power (x[k], i-1);

v[j]:=v[j] + fi[k][j]* sx;

w[j]:=w[j] + fi[k][j]*fi[k][j];

end;

end;

for k:= 1 to n1 do begin

fi[k][i]:=0;

for j:=1 to i do

fi[k][i]:=fi[k][i] + v[j]/w[j]*fi[k][j];

sx:= power (x[k], i-1);

fi[k][i]:= sx-fi[k][i];

end;

end;

for i:=3 to m1 do begin

fiy[i]:=0; fi2[i]:=0;

for k:= 1 to n1 do begin

fiy[i]:=fiy[i] + fi[k][i]*y[k];

fi2[i]:=fi2[i] + fi[k][i]*fi[k][i]; end;

end;

for i:= 3 to m1 do c[i]:= fiy[i]/fi2[i];

for i:= 1to m1 do c1[1][i]:= c[i];

for k:= 1 to m do begin

mk:= m - k; mk1:= m - k + 1;

for i:= 1 to mk+1 do begin

v[i]:=0; w[i]:=0;

for l:= 1 to n1 do begin

sx:= power (x[l], mk);

v[i]:=v[i] + fi[l][i]*sx;

w[i]:=w[i] + fi[l][i]*fi[l][i];

end;

k1:= k + 1;

c1[k1][i]:=c1[k][i] - c1[k][mk1]*v[i]/w[i];

end;

end;

for i:= 1 to m1 do

c[i-1]:= c1[m-i+1][i];

s2:=0;

for i:= 1 to n1 do begin

sx:= poly (x[i],c);

del:= y[i] - sx;

s2:=s2 + del*del;

end;

s2:=s2 /(dn - dm);

s2:= sqrt (s2);

tcheb:=s2;

end;

//* коэф. Фурье для волнистости */

//Началось...........

{Function Polynom(pow:integer):double;

var i,j,m1,m2:integer;

dz, zsr, di, err:double;

begin

zsr:=0; dz:= 0.001*dELZ;

for i:= 0 to NSMAX do begin

Z[i+1]:= ZMIN + di*dz;

zsr:=zsr + Z[i+1];

end;

zsr:=zsr/NSMAX;

for i:= 1 to NSMAX+1 do Z[i]:=Z[i] - zsr;

dz:=NFI;

for i:= 0 to NSMAX do begin

PSI0:=0.0; TETA0:= 0.0;

m1:= i*NFI;

for j:= 0 to NFI do begin

m2:= m1+j;

PSI02:=PSI02 + dps[m2]; TETA02:=TETA02 + dtt[m2];

end;

PSI02:=PSI02 / dz; TETA02:=TETA02 / dz;

R[i+1]:= sr_radius(Y0, LFP, PSI02, TETA02);

if (i=0) then R[0]:= R[1];

zsr:= R[i+1];

R[i+1]:= dR_dz (Y0, LFP, PSI0, TETA0, zsr);

end;

err:=tcheb (pow, NSMAX,Z,R,H);

C[0]:=R[0];

for i:= 0 to pow+1 do begin di:=i+1;

C[i+1]:= H[i]/di;

end;

Polynom:=err;

end;

Function radius (pow:integer; z:real):real;

var i:integer;

y:real;

begin

y:= 0;

for i:=0 to pow+1 do

y:=y + C[i] * power (z, i);

radius:=y;

end;

Procedure pict_rad (pow,nz:integer);

var dz, zi, di, scal:real;

i, j, r1, r2, y,xs, ys, n0:integer;

begin

xs:= round((XG0 + XG1)/2);

ys:= round((YG0 + YG1)/2); n0:=round( nz/2);

//r1:= 0.001*DELZ; r2:=NSMAX;

// LKAL:= ZMIN+Z[NSMAX];

// dz:= (Z[NSMAX] - Z[1])/nz;

//scal:=SC_R; zi:= Z[1];

for i:= 1 to nz+1 do begin ;

// zi:= Z[1] + di * dz;

H[i]:= radius(pow+1, zi);

end;

for i:= 0 to nz do begin

zi:= H[i] - C[1];

buf[i]:= 80 + round(zi*scal);

if (buf[i] < 15) then buf[i]:= 15;

if (buf[i] > 170) then buf[i]:= 170;

end;

//field (); setcolor (COL_GR1);

for i:= 1 to nz do begin

y:= round(ys + n0 - i);

r1:= xs - buf[i]; r2:= xs - buf[i+1];

form1.Image1.Canvas.MoveTo(r1, y);

form1.Image1.Canvas.LineTo(r2, y-1);

r1:= xs + buf[i]; r2:= xs + buf[i];

form1.Image1.Canvas.MoveTo(r1, y);

form1.Image1.Canvas.LineTo(r2, y-1);

end;

r1:= xs - buf[1]; r2:= xs + buf[1];

form1.Image1.Canvas.MoveTo(r1, ys+n0);

form1.Image1.Canvas.LineTo(r2, ys+n0);

r1:= xs - buf[nz-1]; r2:= xs + buf[nz-1];

form1.Image1.Canvas.MoveTo( r1, ys-n0+1);

form1.Image1.Canvas.LineTo(r2, ys-n0+1);

{setcolor (COL_MN);

gprintf (xs, ys-n0-6, "%7.3lf мм", Z[NSMAX]);

gprintf (xs, ys+n0+8, "%7.3lf мм",Z[1]);

gprintf (xs+70, YG0+10,"Z0 = %7.3lf", LKAL);

gprintf (xs-10, YG0+10, "Z");

gprintf (XG1-10, ys-8, "R");}

//end;}

{Конец прототипов}

end.

И.4 Модуль Unit3.pas

Примечание – модуль Unit3.pasнаходится в папке «DOP».

unit Unit3;

interface

uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,

Buttons, ExtCtrls, jpeg;

type

TAboutBox = class(TForm)

Panel1: TPanel;

Comments: TLabel;

OKButton: TButton;

Label3: TLabel;

Label4: TLabel;

procedure OKButtonClick(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

AboutBox: TAboutBox;

implementation

{$R *.dfm}

procedure TAboutBox.OKButtonClick(Sender: TObject);

begin

close();

end;

end.

И.5 МодульUnit4.pas

unit Unit4;

interface

uses

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

Dialogs, TeEngine, Series, ExtCtrls, TeeProcs, Chart, StdCtrls, ComCtrls;

type

TForm4 = class(TForm)

Chart1: TChart;

Series1: TBarSeries;

Button14: TButton;

TrackBar1: TTrackBar;

procedure Button14Click(Sender: TObject);

procedure TrackBar1Change(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form4: TForm4;

implementation

uses Unit1;

{$R *.dfm}

procedure TForm4.Button14Click(Sender: TObject);

begin

Form1.Button14Click(Sender);

end;

procedure TForm4.TrackBar1Change(Sender: TObject);

begin

Form1.TrackBar1.Position := TrackBar1.Position;

Form1.TrackBar1Change(Sender);

end;

end.

И.6 МодульErrorMsgs.pas

unit ErrorMsgs;

interface

const error_load = 'Невозможно открыть файл ';

error_help = 'Файл справки не найден!';

implementation

end.

И.7 Замечания относительно копирайта

В современном мире очень важно продвижение товара на рынок. Есть авторитетное мнение, что затраты на эти мероприятия зачастую превышают стоимость самой продукции. Особенно это относится к новым, высокотехнологичным, постиндустриальным областям рынка.

Разработчику АС и ПО важно подтвердить свои права на интеллектуальную собственность. Хорошую возможность для этого дают современные технологии программирования, для которых характерны развитые технологически приемы. Это и дистрибутивы для инсталляции, и ограничения функциональных возможностей ПО (так называемое «ShareWare», и сведения о копирайте, вставленные в исполняемый код программы.

Мы остановимся на последнем.

В приведенной программе присутствуют сведения о копирайте. Их можно найти в файле «Unit3.dfm» в папке «Dop», той папки, где находится сама исполняемая программа «DLT.exe», исходные коды и несколько файлов с входными данными ‑ для контроля и презентации («2009Mmod»). Его можно прочитать обычным блокнотом. Кириллические символы в нем представлены в виде универсальных символьных двухбайтных кодов, что создает некоторые сложности при перекодировании. Очевидно, среда «Delphi7» дает пользователю удобные возможности работы с этим файлом. В этом несложно разобраться самостоятельно.

Удачи вам!