|
|
|
|
#17
17.03.2012, 00:16
|
|||
|
|||
попробывал ваш код, норм запустилось, продолжил работу и опять наткнулся на эту же ошибку.
Код:
unit Diagnoz;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Label1: TLabel;
Edit1: TEdit;
Button1: TButton;
Label2: TLabel;
Label3: TLabel;
Edit2: TEdit;
Label5: TLabel;
Edit3: TEdit;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
Label9: TLabel;
Label10: TLabel;
Label11: TLabel;
Label12: TLabel;
Label13: TLabel;
Edit4: TEdit;
Edit5: TEdit;
Edit6: TEdit;
Edit7: TEdit;
Edit8: TEdit;
Edit9: TEdit;
Edit10: TEdit;
Edit11: TEdit;
Edit12: TEdit;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
type
MASK = array[1..8192] of real;
MASKCP = array[1..8192] of real; {X, Y}
MASKD = array [1..500] of string;
mas3 = array[1..50] of real;
mascpptr = ^maskcp;
var
S, I, JJ, J, K, MM, MP, M : integer;
AX, A, F: MASK;
MPP, TEXT : string;
DataFile : file;
AAS : mas3;
xx : byte;
X, Y: mascpptr;
KM, DF : real;
SS : MASKD;
KD : longint;
WOB, TPPR, L, FD, ND, TIP: integer;
myfile : textfile;
const jjk = 2; FMAX = 11025/2; N = 12;
Procedure SUMGARM(var AX : mask; KN1, KV1 : integer; SYG: real);
var S : real;
begin
S := 0;
for i := KN1 to KV1 do
begin
S := S + sqr(AX[i]);
end;
SYG := sqrt(S);
end;
Procedure MAXGARM(var P : mask; KNN, KVV : integer; MAXGG : integer);
var
MAXG, MK, MAX : real;
IM: integer;
begin
MK :=P[KNN];
IM := KNN;
MAXG := FMAX * (KM / 2) / K * IM;
for i := KNN to KVV do
begin
if P[i] > MK then
begin
MK := P[i];
IM := I;
MAXG := FMAX * (KM / 2) / K * IM;
end;
end;
MAXGG := round(MAXG / F[1]);
end;
procedure TForm1.Button1Click(Sender: TObject);
var SO, NOM : string;
ANED : real;
data,datai : array [1..3] of integer;
Asr : array [1..10] of integer;
K : integer;
begin
SO := Edit1.Text;
WOB := StrToInt(Edit2.Text);
TPPR := StrToInt(Edit3.Text);
ANED := StrToFloat(Edit4.Text);
L := StrToInt(Edit5.Text);
FD := StrToInt(Edit6.Text);
ND := StrToInt(Edit7.Text);
TIP := StrToInt(Edit9.Text);
Asr[1] := StrToInt(Edit10.Text);
data[1] := StrToInt(Edit8.Text);
data[2] := StrToInt(Edit11.Text);
data[3] := StrToInt(Edit12.Text);
Label2.Caption := 'Объект диагностирования: ' + SO + #13 +
'Число оборотов в минуту: ' + IntToStr(WOB) + #13 +
'Наработка до ремонта составляет: ' + IntToStr(TPPR) + ' дней ' + #13 +
'Предельно допустимый уровень вибраций: ' + FloatToStr(ANED) + ' мм/с' + #13 +
'Количество диагностируемых дефектов: ' + IntToStr(L) + #13 +
'Частота диагностирования: ' + IntToStr(FD) + ' Гц' + #13 +
'Количество датчиков: ' + IntToStr(ND) + #13 +
'Дата проведения исходных измерений: ' + IntToStr(data[1]) + '.' + IntToStr(data[2]) +
'.' + IntToStr(data[3]) + #13 +
'Количество замеров: ' + IntToStr(TIP) + #13 +
'Суммарный уровень по датчику (мм/с): ' + IntToStr(Asr[1]);
end;
procedure TForm1.Button2Click(Sender: TObject);
var
F : File;
I, J : Integer;
XX : Byte;
begin
mpp := '1';
ss[kd] := '1w';
{$I-}
AssignFile(F, ss[kd] + mpp + '.wav');
Reset(F, 1);
if IOResult = 0 then
begin
Seek(F, 50);
for I := 1 to jjk do
for J := 1 to 4096 do
begin
BlockRead(F, XX, 1);
X[J] := XX;
end;
CloseFile(F);
end;
{$I+}
end;
end.Последний раз редактировалось deniks, 17.03.2012 в 00:37. |
|
#18
17.03.2012, 00:19
|
|||
|
|||
|
вот еще код выложу программы на паскаль, которую переделываю
Код:
{ Diagnostika nasosa }
{$N+}
uses crt,graph,bmp_plus,Windos;
const jjk=2;{L=5;}n=12;pkr=100;fmax=11025/2; {alf1=0.5;}
type mascp=array[1..{2048}4096] of single ;
mask=array[0..{1024}2048] of single ;
mascpptr=^mascp;
mas=array[1..20,0..30] of single;
mast=array[0..30] of single;
masL=array[1..10] of single;
mas3=array[0..10] of single;
masd=array [1..3] of integer;
masf=array [1..10] of text;
maskd=array [0..10] of string;
maskdd=array [1..10] of single;
masust=array [1..4] of single;
var ans,no,yes, ch: char; xx: byte; datafile : file of byte; frr,fr,fp, fpi: text;s,mpp,fname,ds:string;
kdj1,kdj,kj,kj1, kd, nd, ig, tip, jj, mp, kn,kv, cnt,m:integer; data,datai: masd;
sabb, sgarm, ss: maskd;Fs, Asr :maskdd;ficx: masf; AAs:mas3;
alfa,xxk, betdd,prd, MinTr,{Mintrem,} Minn11,MinTrl1,al :maskdd;
const Au : masust = (0.25,0.41,0.63,1);
var dt,a,f,xk:mask;
x,y:mascpptr;
ygg, yss, yg,Fg:mas;
Ft,skrat, Ygpr: masL;
Tx,as,asi : mast;
StTr,Tr,Tr1,n1,Tr2,n2,alfs,bets,alff,bet,Votn,Votn1,alffa,alf,Fdd,Tremm, n11, nn,TTTr,Trl1: masL;
ftk,fm,fv,d,kftk,kfn,kfv,dtk,dv,dn,z,df,km,Wob,Asned,lx,ly,
Sa,Tcrj,Trj,AprS,STrl1,bt,yys,ysa,fd,Tppr, sygg,kper,Pikfak,Ass,Ys,Fdv,Fk,mx,skx, wob1,maxx,sx,sy,
Aaotn,Apr,Ao,MaxFdd,MaxFs,Mints,Mintls,MinTrr: single;
kjj, ttr, mm, nm, i,j,k,L: integer;
func,sd,sd1:string;
Gd,Gm,Xc,Xb,Yc,Yb:integer;
ii, dlinaOsiX,dlinaOsiY:integer;
Procedure Sumgarm(var Ax : mask; kn1,kv1 :integer; var SYg: single);
var s: single; i : integer;
Begin
s:=0;
for i:=kn1 to kv1 do
begin
s:=S+sqr(ax[i]);
{ sy:=Sy+ay[i];}
end;
SYg:=sqrt(s);
End;
Procedure Maxgarm(var P:mask; knn,kvv: integer; var maxgg:integer);
var maxg,mk,max:single;im :integer;
begin
mk:=P[knn];
im:=knn;
maxg:=fmax*(km/2)/k*im;
For i:=knn to kvv do
begin
if p[i]>mk then
begin
mk:=p[i];
Max:=mk;
im:=i;
Maxg:=fmax*(km/2)/k*im;
end; end;
maxgg:=round(maxg/f[1]);
end;
Procedure Podshipnik(var wob2 : single; var aF: masL; var awob: single);
var Am,maxf:single; im:integer;
Function Max(var p: mask):single;
var mk:single; knn,kvv :integer;
begin
knn:=round(0.9*wob2/60/f[1]);
kvv:=round(1.1*wob2/60/f[1]);
mk:=P[knn];
im:=knn;
maxf:=fmax*(km/2)/k*im;
For i:=knn to kvv do
begin
if p[i]>mk then
begin
mk:=p[i];
Max:=mk;
im:=i;
Maxf:=fmax*(km/2)/k*im;
end; end;
end;
begin
Am:=Max(a);
awob:=maxf*60;
For i:=1 to L do
aF[i]:=maxf*skrat[i];
end;
Procedure BuildP(var AA,tt:mask; Ft: masL; wob11,w :single; fname: string);
var Fg: masL; fgr, amin,fmin,Amax,Fmaxx : single; a1,t1: mas3;kf,k1: integer;
Function Max(var p: mask):single;
var mk:single;
begin
mk:=P[1];
For i:=2 to k do
if p[i]>mk then mk:=p[i];
Max:=mk;
end;
Function Min(var pp: mask): single;
var mmk:single;
begin
mmk:=PP[1];
For i:=2 to k do
if pp[i] < mmk then mmk:=pp[i];
Min:=mmk;
end;
begin
if w=2 then
begin
Amin:=Min(aa);
if Amin <= 0 then
begin
for i:=1 to k do
aa[i]:=aa[i]+abs(Amin);
end
else begin
for i:=1 to k do
aa[i]:=aa[i];
end;
Fmaxx:=tt[k];
Amax := Max(aa);
end;
if w=1 then begin
Fmaxx:=1.05*fd;
Amax := Max(aa);
end ;
Gd:=Detect;
InitGraph(Gd,Gm,'C:\PASCAL\BGI');
if GraphResult <> grok then
halt(1);
SetBkColor(15);
Xc:=100;
Xb:=(GetMaxX div 2);
Yc:=420;Yb:=50;
dlinaOsiX:=500;
dlinaOsiY:=400;
ly:=dlinaOsiY/(1.1*Amax);
lx:=dlinaOsiX/Fmaxx*0.9;
SetColor(8);
Line(Xc,Yc,Xc+dlinaOsiX,Yc);
Line(Xc,Yc,Xc,Yc-dlinaOsiY);
OutTextXY(xc-20,yc-dlinaOsiY-10,'A ');
if w=2 then
OutTextXY(xc+dlinaOsiX-10,yc-14,'T,c')
else
OutTextXY(xc+dlinaOsiX-40,yc-14,'f,ѓж');
for i:=0 to 10 do
begin
t1[i]:=(Fmaxx )/10*(i);
Line(Xc+round(t1[i]*lx),Yc-2,
Xc+round(t1[i]*lx),Yc+2);
if (w=2) then
str(t1[i]:2:2,sd)
else
str(t1[i]:2:0,sd);
OutTextXY(Xc+round(t1[i]*lx),Yc+6,sd);
end;
for i:=0 to 10 do
begin
a1[i]:=Amax/10*i;
Line(Xc-2,Yc-round(a1[i]*ly),
Xc+2,Yc-round(a1[i]*ly));
str(a1[i]:2:3,sd1);
OutTextXY(Xc-46,Yc-round(a1[i]*ly),sd1);
end;
if w <> 2 then
begin
SetColor(red);
fmin:=0;
for j:=1 to L do
begin
kn:=round(0.9*Ft[j]/f[1]);
kv:=round(1.1*Ft[j]/f[1]);
Maxgarm(A,kn,kv,ig);
Fg[j]:=f[ig];
if (Fg[j]-fmin) > 0 then
begin
Line(Xc+round((Fg[j]-fmin)*lx),Yc,Xc+round((Fg[j]-fmin)*lx),Yc-dlinaOsiY);
OutTextXY(xc-25+round((Fg[j]-fmin)*lx),yc-dlinaOsiY-round(10*0.1*j), sabb[j]);
SetColor(blue);
str(Fg[j]:3:0,sd);
OutTextXY(Xc+round((Fg[j]-fmin)*lx)-15,Yc+17,sd);
end; end;end;
SetColor(8);
if w=2 then
k1:=k;
if (w=1) or (w=3) then
k1:=round(fd*1.05/f[1]);
MoveTo(Xc + round(tt[1]*lx),Yc-round(aa[1]*ly));
for i:=2 to k1 do
begin
SetColor(Green);
LineTo(Xc + round(tt[i]*lx),Yc-round(aa[i]*ly));
end;
{ save_bmp(1,1,640,480,fname,4); }
ReadKey;
CloseGraph;
End;
procedure Spektr(var AX, AY; Dim: Word; D: Integer);
var
x: array [1..4096] of Single absolute AX;
y: array [1..4096] of Single absolute AY;
I, J, N, L, K, LE, LE1,IP, NV2, NM1: Integer;
Arg, U1, U2, U3, C, S, T1, T2, T3, T4: Single;
begin
N := 1 shl Dim;
if D = -1 then FillChar(Y, N*SizeOf(Single), 0);
for L := 1 to Dim do
begin
LE := 1 shl (Dim+1-L);
LE1 := LE div 2;
U1 := 1;
U2 := 0;
Arg := Pi/LE1;
C := Cos(Arg);
S := D*Sin(Arg);
for J := 1 to LE1 do
begin
I := J;
while I <= N do
begin
IP := I + LE1;
T1 := X[i] + X[IP];
T2 := Y[i] + Y[IP];
T3 := X[i] - X[IP];
T4 := Y[i] - Y[IP];
X[IP] := T3*U1 - T4*U2;
Y[IP] := T4*U1 + T3*U2;
X[i] := T1;
Y[i] := T2;
I := I + LE;
end;
U3 := U1*C - U2*S;
U2 := U2*C + U1*S;
U1 := U3;
end;
end;
NV2 := N div 2;
NM1 := N-1;
J := 1;
for I := 1 to NM1 do
begin
if I < J then
begin
T1 := X[J];
T2 := Y[J];
X[J] := X[i];
Y[J] := Y[i];
X[i] := T1;
Y[i] := T2;
end;
K := NV2;
while K < J do
begin
J := J - K;
K := K div 2;
end;
J := J + K
end;
if D = 1 then Exit;
for I:=1 to N do
begin
X[i] := X[i] / N*2;
Y[i] := Y[i] / N*2;
end;
X[1] := 0;
end;
|
|
#19
17.03.2012, 00:20
|
|||
|
|||
|
Код:
Procedure DiagnozDef (var tr2: masL; var Fd:masL; var trl1,Votn: masL);
var fd1 : array [1..4] of real;
jd,md : integer; tcr1:single;
Begin
Writeln('');
Writeln(' Harakteristika defektov ');
Writeln(' mashinu');
Writeln ;
writeln(' na ',data[1]:2,'.',data[2]:2,'.',data[3]:4,'Ј.');
Writeln;
Writeln(fr,'') ;
Writeln(fr,' Harakteristika defektov mashinu');
writeln(fr,' na ',data[1]:2,'.',data[2]:2,'.',data[3]:4,'Ј.');
Writeln(FR,'');
for i:= 1 to 4 do
Fd1[i]:=0.5*Au[i]+0.5*Au[i];
for j:=1 to L+1 do
begin
Writeln(' ',sgarm[j],':');
Writeln(fr,' ',sgarm[j],':');
if (Fd[j] >= 0) and (Fd[j] < Fd1[1]) then
Writeln('-defekt otsutstvuet, ')
else
begin
Write('-stepen razvitiya defekta* - ');
if (Fd[j] >= Fd1[1]) and (Fd[j] < Fd1[2]) then
Writeln('nige srednei, ');
if (Fd[j] >= Fd1[2]) and (Fd[j] < Fd1[3]) then
Writeln('srednyaa, ');
if (Fd[j] >= Fd1[3]) and (Fd[j] < Fd1[4]) then
Writeln('vuwe srednei, ');
if (Fd[j] >= Fd1[4]) {or (tttr[j]=tx[m]/1.1)} then
Writeln('nedopust, ');
if (fd[j] < Fd1[4]) and (m > 2) then
begin
writeln('-stepen povregdennosti -', (1-exp(-tx[m]/tr2[j]))*100:5:2,' %');
Write('-skorost razvitiya defekta -');
if (Votn[j] > 0) and (Votn[j] < Fd1[2]{*1.56}) then
Writeln(' medlennaya, ');
if (Votn[j] >= Fd1[2]{*1.56}) and (Votn[j] < Fd1[3]{*1.56}) then
Writeln(' umerennaya, ');
if (Votn[j] >= Fd1[3]{*1.56}) and (Votn[j] < Fd1[4]{*1.56}) then
Writeln(' bustraya, ');
if (Votn[j] >= Fd1[4]{*1.56}) then
Writeln(' predelnaya, ');
end; end;
if m > 2 then
begin
IF tR2[j]>2*tppr then
Tr2[j]:=2*Tppr
else
Tr2[j]:=Tr2[j];
Trl1[j]:=tx[m]*(1-exp(-tx[m]/tr2[j]))+Tr2[j]*exp(-tx[m]/tr2[j]);
if trl1[j]>=tr2[j] then
trl1[j]:=0.95*tr2[j]
else
trl1[j]:=trl1[j];
if Fd[j] >= Fd1[4] then
begin
writeln('-stepen povregdennosti -100 %');
writeln('-narabotka uzla mawunu do ostanovki na remont iz-za');
writeln(' razvitiya defekta sostavlyaet: 0, sut.' );
writeln('');
end;
if Fd[j] < Fd1[4] then
begin
writeln('-narabotka uzla mawunu do ostanovki na remont iz-z');
writeln(' razvitiya defekta sostavlyaet: ',(trl1[j]-tx[m]):5:1,' - ',(Tr2[j]-tx[m]):5:1,' cгв.,' );
end; end;
{ else}
writeln('');
Readkey;
if (Fd[j] >= 0) and (Fd[j] < Fd1[1]) then
Writeln(fr,'-defekt otsutstvuet, ')
else
begin
Write(fr,'-stepen razvitiya defekta -');
if (Fd[j] >= Fd1[1]) and (Fd[j] < Fd1[2]) then
Writeln(fr,' nige srednei, ');
if (Fd[j] >= Fd1[2]) and (Fd[j] < Fd1[3]) then
Writeln(fr,' srednyaa, ');
if (Fd[j] >= Fd1[3]) and (Fd[j] < Fd1[4]) then
Writeln(fr,' vuwe srednei, ');
if (Fd[j] >= Fd1[4]) or (tr2[j]=tx[m]/1.05) then
Writeln(fr,' predelnaya, ');
if (fd[j] < Fd1[4]) and (m > 2) then begin
writeln(fr,'-stepen povregdennosti - ', (1- exp(-tx[m]/tr2[j]))*100:5:2,' %');
Write(fr,'-skorost razvitiya defekta - ');
if (Votn[j] > 0) and (Votn[j] < Fd1[2]) then
Writeln(fr,' medlennaya, ');
if (Votn[j] >= Fd1[2]) and (Votn[j] < Fd1[3]) then
Writeln(fr,'umerennaya, ');
if (Votn[j] >= Fd1[3]) and (Votn[j] < Fd1[4]) then
Writeln(fr,'bustr, ');
if (Votn[j] >= Fd1[4]) then
Writeln(fr,'predelnaya, ');
end; end;
if m > 2 then
begin
writeln(fr,'Fd=',Fd[j]:5:5);
if Fd[j] >= Fd1[4] then
begin
writeln(fr,'-stepen povregdennosti -100 %');
writeln(fr,'-narabotka mawunudo ostanovki na remont iz-za');
writeln(fr,' razvitiya defekta sostavlyaet: 0, sut.' );
end;
if Fd[j] < Fd1[4] then
begin
writeln(fr,'-narabotka mawunu do ostanovki na remont');
writeln(fr,' iz-za razvitiya defekta: ',(trl1[j]-tx[m]):5:1,' - ',(Tr2[j]-tx[m]):5:1,' cгв.,' );
end;
writeln(fr,'');
end;
writeln(fr,'');
end;
END;
|
|
#20
17.03.2012, 00:20
|
|||
|
|||
|
Код:
Procedure DiagnozPoint(var Fssd,Tcrj1,Trj1 :single; var txx:mast; kj,kjj: integer); { OЇаҐ¤Ґ«Ґ*. ¤Ё Ј*®§ ¬ и. ў в®зЄҐ}
var fd1 : array [2..4] of real;
Begin
for i:= 2 to 4 do
Fd1[i]:=0.5*Au[i]+0.5*(0.5*Au[i]+0.5*Au[i]);
Writeln ;
Write(' DIAGNOS MAWUNU ');
Writeln ;
writeln(' na ',data[1]:2,'.',data[2]:2,'.',data[3]:4,'g.');
Writeln;
if (Fssd >= 0) and (Fssd < Fd1[2]) then
Writeln('Mawuna v ispravnom sostoyanii ');
if (Fssd >= Fd1[2]) and (Fssd < Fd1[3]) then
Writeln('MAwuna v rabotosposobnom sostoyanii. ');
if (Fssd >= Fd1[3]) and (Fssd < Fd1[4]) then
begin
Writeln('Mawune trebuetsya remont. ');
Writeln(' ЏаЁзЁ* : - ',sgarm[kj]);
end;
if (Fssd >= Fd1[4]) then
begin
Writeln('Mawuna podlegut remontu. ');
Writeln(' Pri4ina : - ',sgarm[kj]);
end;
if m > 2 then
begin
IF tRj1>= 2*tppr then
begin
Trj1:=2*Tppr;
Tcrj1:=txx[m]*(1-exp(-txx[m]/trj1))+Trj1*exp(-txx[m]/trj1);
end;
{else}
IF tRj1 < 2*tppr then
begin
Tcrj1:=Tcrj1;
Trj1:=Trj1;
end;
if (Fssd >= Fd1[4]) then
begin
writeln('-* а Ў®вЄ 㧫 ¬ иЁ*л ¤® ®бв *®ўЄЁ * ६®*в ');
writeln(' б®бв ў«пҐв: 0 , cгв.' );
end;
if (Fssd < Fd1[4]) then
begin
if {(Fssd < Fd1[3]) or }(kj=kjj) then begin
writeln('-* а Ў®вЄ ¬ иЁ*л ¤® ६®*в ');
writeln('б®бв ў«пҐв:',(Tcrj1-tXx[m]):5:1,' - ',(Trj1-tXx[m]):5:1,' cгв.' );
end;
if (kj<>kjj) and (Fssd >= Fd1[3]) then
begin
writeln('Ё§-§ ЇаҐўлиҐ*Ёп ЇаҐ¤Ґ«м*® ¤®ЇгбвЁ¬®Ј® га®ў*п');
writeln('Ј ମ*ЁЄЁ, ॠЈЁаго饩 * ¤ **л© ¤ҐдҐЄв.');
writeln('ђҐбгаб ®Ја *ЁзЁў Ґв ¤ҐдҐЄв: ',sgarm[kjj],',');
writeln('Ё§-§ Ї®ўлиҐ**®© бЄ®а®бвЁ ҐЈ® а §ўЁвЁп.');
writeln('‚ १г«мв ⥠нв®Ј® * а Ў®вЄ ¬ иЁ*л ¤® ६®*в ');
writeln('б®бв ў«пҐв:',(Tcrj1-tXx[m]):5:1,' - ',(Trj1-tXx[m]):5:1,' cгв.' );
end;
if (kj<>kjj) and (Fssd < Fd1[3]) then
begin
writeln('-* а Ў®вЄ ¬ иЁ*л ¤® ६®*в ');
writeln('б®бв ў«пҐв:',(Tcrj1-tXx[m]):5:1,' - ',(Trj1-tXx[m]):5:1,' cгв.' );
end; end;end;
readkey;
Writeln(fr,'') ;
Write(fr,' „?ЂѓЌЋ‡ ЊЂ˜?Ќ› ');
Writeln(fr,'') ;
writeln(fr,' * ' ,data[1]:2,'.',data[2]:2,'.',data[3]:4,'Ј.');
Writeln(fr,'');
if (Fssd >= 0) and (Fssd < Fd1[2]) then
Writeln(fr,'Њ иЁ* ў ЁбЇа ў*®¬ б®бв®п*ЁЁ. ');
if (Fssd >= Fd1[2]) and (Fssd < Fd1[3]) then
Writeln(fr,'Њ иЁ* ў а Ў®в®бЇ®б®Ў*®¬ б®бв®п*ЁЁ. ');
if (Fssd >= Fd1[3]) and (Fssd < Fd1[4]) then
begin
Writeln(fr,'Њ иЁ*Ґ вॡгҐвбп ®б¬®ва. ');
Writeln(fr,' ЏаЁзЁ* : - ',sgarm[kj]);
end;
if (Fssd >= Fd1[4]) then
begin
Writeln(fr,'Њ иЁ* Ї®¤«Ґ¦Ёв ६®*вг. ');
Writeln(fr,' ЏаЁзЁ* : - ',sgarm[kj]);
end;
if m > 2 then
begin
writeln(fr,'Fss=',Fssd:5:5);
if (Fssd >= Fd1[4]) then
begin
writeln(fr,'-* а Ў®вЄ ¬ иЁ*л ¤® ६®*в ');
writeln(fr,'б®бв ў«пҐв: 0, cгв.' );
end;
if (Fssd < Fd1[4]) then
begin
if (kj=kjj){ and (Fssd < Fd1[3])}then begin
writeln(fr,'-* а Ў®вЄ ¬ иЁ*л ¤® ६®*в ');
writeln(fr,'б®бв ў«пҐв:',(Tcrj1-tXx[m]):5:1,' - ',(Trj1-tXx[m]):5:1,' cгв.' );
end;
if (kj<>kjj) and (Fssd >= Fd1[3]) then
begin
writeln(fr,'Ё§-§ ЇаҐўлиҐ*Ёп ЇаҐ¤Ґ«м*® ¤®ЇгбвЁ¬®Ј® га®ў*п');
writeln(fr,'Ј ମ*ЁЄЁ, ॠЈЁаго饩 * ¤ **л© ¤ҐдҐЄв.');
writeln(fr,'ђҐбгаб ®Ја *ЁзЁў Ґв ¤ҐдҐЄв: ',sgarm[kjj],',');
writeln(fr,'Ё§-§ Ї®ўлиҐ**®© бЄ®а®бвЁ ҐЈ® а §ўЁвЁп.');
writeln(fr,'‚ १г«мв ⥠нв®Ј® * а Ў®вЄ ¬ иЁ*л ¤® ६®*в ');
writeln(fr,'б®бв ў«пҐв:',(Tcrj1-tXx[m]):5:1,' - ',(Trj1-tXx[m]):5:1,' cгв.' );
end;
if (kj<>kjj) and (Fssd < Fd1[3]) then
begin
writeln(fr,'-* а Ў®вЄ ¬ иЁ*л ¤® ६®*в ');
writeln(fr,'б®бв ў«пҐв:',(Tcrj1-tXx[m]):5:1,' - ',(Trj1-tXx[m]):5:1,' cгв.' );
end; end;
End;
readkey;
END;
Procedure Diagnostika(var Ygpr:masL{; var MinTr,MinTrl1 : maskdd; Var Maxfdd:single; s: string});
begin
if m > 2 then
begin
for j:=1 to L+1 do
begin
Str(j,ds);
fname:=s+'4'+ds+'.bmp';
Ao:=yg[j,1];
Apr:=Ygpr[j];
Aaotn:=abs((yg[j,m]-ao)/(apr-ao));
Votn[j]:=(Tppr-tx[1])/(Tr2[j]-tx[1])*tx[j]/Tr2[j];
Fdd[j]:=0.5*Aaotn + 0.5*Votn[j];
Trl1[j]:=tx[m]*(1-exp(-tx[m]/Tr2[j]))+tr2[j]*exp(-tx[m]/Tr2[j]);
writeln('T⥪=',tx[m]:5:2,'');
writeln('TЇ®«*=',Trl1[j]:5:1,'...',Tr2[j]:5:1,' cyt');
writeln('Toct=',Tr2[j]-tx[m]:5:1,' cyt');
writeln('j=',j:5,'');
writeln('Yg=',Yg[j,m]:5:5,'');
writeln('bet=',bet[j]:5:5,'');
readkey;
writeln('Fd[',j,']=',Fdd[j]:5:4,' ');
readkey;
end;
end
else
begin
for j:=1 to L+1 do
begin
Fdd[j]:=Yg[j,m]/Ygpr[j];
end;
End;
{DiagnozDef(Tr2,Fdd,Trl1,Votn);}
{‘⥯Ґ*м а §ўЁвЁп ¤ҐдҐЄв }
if m > 2 then
Begin
bt:=Fdd[1];
kj:=1;
for jj:=2 to L+1 do
begin
if bt < Fdd[jj] then
begin
bt:=Fdd[jj];
kj:=jj;
{ MaxFdd:=Fdd[kj];}
end;
end;
MaxFdd:=Fdd[kj];
{ MinTr[kd]:=Tr2[kj]; {гЎа вм kd}
{MinTrl1[kd]:=Trl1[kj]; {гЎа вм kd}
{ if MaxFdd >= Au[4] then
FS[kd]:= MaxFdd
else }
FS[kd]:=0.3*As[m]/Asned+0.7*MaxFdd;
bt:=Tr2[1];
kjj:=1;
for jj:=2 to L+1 do
begin
if bt > Tr2[jj] then
begin
bt:=Tr2[jj];
kjj:=jj;
{ Mintr[kd]:=Tr2[kjj];
MinTrl1[kd]:=Trl1[kjj];}
end;
end;
{if Mintr[kd]>=Tr2[kj] then begin}
Mintr[kd]:=Tr2[kjj];
MinTrl1[kd]:=Trl1[kjj];
{kjj:=kj;
end;} end
else
begin
Fs[kd]:=As[m]/Asned; {гЎа вм kd}
MinTrl1[kd]:=1;
MinTr[kd]:=1;
end;
DiagnozPoint(Fs[kd],MinTrl1[kd],MinTr[kd],tx,kj,kjj); { „Ё Ј*®§ ў в®зЄҐ Є®*ва®«п.}
DiagnozDef(Tr2,Fdd,Trl1,Votn);
End;
|
|
#21
17.03.2012, 00:22
|
|||
|
|||
|
Код:
BEGIN
ClrScr;
New(x); New(y);
write('Obiekt inspekzuu - ');
{read(s);}
s:='2';
writeln('Elsi diagnostirovanie ishodnoe, vvedite 1,tekuwee - 2 ! ');
readln(tip);
case tip of
1: begin
Assign( fpi,s+'.dat');
ReWrite(fpi);
writeln('4islo oborotov (n) v minutu ob/min: ');
{readln(wob);}
wob:={1480}3000;
writeln(fpi,wob);
writeln('Narabotka do remonta: ');
{readln(Tppr);}
Tppr:=365;
writeln(fpi,Tppr);
writeln('‚ўҐ¤ЁвҐ ЇаҐ¤Ґ«м*® ¤®ЇгбвЁ¬л© га®ўҐ*м ўЁЎа*жЁЁ: ');
{readln(Asned);}
Asned:=11.2;
writeln(fpi,Asned);
writeln('‚ўҐ¤ЁвҐ Є®«ЁзҐбвў® Є®*ва®«Ёа㥬ле ¤ҐдҐЄв®ў: ');
{readln(L);}
L:=6;
writeln(fpi,L);
for j:=1 to 1 {L} do
begin
{writeln('‚ўҐ¤ЁвҐ **§ў**ЁҐ ¤ҐдҐЄв* N : ',j:4,'');
{readln(sgarm[j]);}
sgarm[1]:='„ЁбЎ*«**б а®в®а*';
writeln(fpi,sgarm[1]);
{writeln('‚ўҐ¤ЁвҐ Єа*в*®бвм Ј*ମ*ЁЄЁ, аҐ*ЈЁаго饩 ** нв®в ¤ҐдҐЄв : ');
{readln(skrat[j]);}
skrat[1]:=1;
writeln(fpi,skrat[j]);
{writeln(' Ё ҐҐ *ЎЎа*ўЁ*вгаг : ');}
readln(sabb[1]);
sabb[1]:='¤';
writeln(fpi,sabb[1]);
sgarm[2]:='ђ*бжҐ*ва®ўЄ* а®в®а* б ЇаЁў®¤®¬';
writeln(fpi,sgarm[2]);
skrat[2]:=2;
writeln(fpi,skrat[2]);
sabb[2]:='а';
writeln(fpi,sabb[2]);
sgarm[3]:='?§*®б **аг¦*®© ®Ў®©¬л Ї®¤иЁЇ*ЁЄ* Є*зҐ*Ёп';
writeln(fpi,sgarm[3]);
skrat[3]:=3;
writeln(fpi,skrat[3]);
sabb[3]:='Ё.*.' ;
writeln(fpi,sabb[3]);
sgarm[4]:='?§*®б ў*гваҐ**Ґ© ®Ў®©¬л Ї®¤иЁЇ*ЁЄ* Є*зҐ*Ёп';
writeln(fpi,sgarm[4]);
skrat[4]:=5;
writeln(fpi,skrat[4]);
sabb[4]:='Ё.ў.';
writeln(fpi,sabb[4]);
sgarm[5]:='?§*®б «®Ї*в®Є а*Ў®зҐЈ® Є®«Ґб*';
writeln(fpi,sgarm[5]);
skrat[5]:=7;
writeln(fpi,skrat[5]);
sabb[5]:='Ё.«.';
writeln(fpi,sabb[5]);
sgarm[6]:='?§*®б ¬гдвл б楯«Ґ*Ёп б ЇаЁў®¤®¬';
writeln(fpi,sgarm[6]);
skrat[6]:=4;
writeln(fpi,skrat[6]);
sabb[6]:='Ё.¬.';
writeln(fpi,sabb[6]);
{sgarm[7]:='ЌҐЁ§ўҐбв*л©';
writeln(fpi,sgarm[7]);
skrat[7]:=18;
writeln(fpi,skrat[7]);
sabb[7]:='*.';
writeln(fpi,sabb[7]);}
end;
sgarm[L+1]:='"Џа®зЁҐ" ¤ҐдҐЄвл';
writeln(fpi,sgarm[L+1]);
writeln('‚ўҐ¤ЁвҐ ¬*ЄбЁ¬*«м*го з*бв®вг ¤Ё*Ј*®бвЁа®ў**Ёп (ў ѓж): ');
{readln(fd);}
fd:=530;
writeln(fpi,fd);
writeln('‚ўҐ¤ЁвҐ Є®«ЁзҐбвў® ¤*взЁЄ®ў: ');
{readln(nd);}
nd:=1;
writeln(fpi,nd);
writeln('‚ўҐ¤ЁвҐ ®Ў®§**зҐ*Ёп ¤*взЁЄ®ў: ');
for jj:=1 to nd do
begin
{readln(ss[jj])};
ss[jj]:='1w';
writeln(fpi,ss[jj]);
Assign( fp,ss[jj]+'.dat');
ReWrite(fp);
end;
m:=1;
mp:=1;
writeln(fpi, mp);
writeln(fpi, m);
writeln('‚ўҐ¤ЁвҐ ¤Ґ*м ¬Ґбпж Ё Ј®¤ Їа®ўҐ¤Ґ*Ёп Ёб室*ле Ё§¬ҐаҐ*Ё© (10 11 2004) ');
for i:=1 to 3 do
readln(data[i]);
writeln('‚ўҐ¤ЁвҐ ¤Ґ*м, ¬Ґбпж Ё Ј®¤ ўЄ«озҐ*Ёп ¬*иЁ*л ў а*Ў®вг (10 11 2004), ');
writeln('Ґб«Ё ¤*в* б®ўЇ*¤*Ґв б Ёб室*л¬Ё Ё§¬ҐаҐ*Ёп¬Ё, в® Ї®ўв®аЁвҐ ¤*вг (10 11 2004) ');
for i:=1 to 3 do
begin
readln(datai[i]);
writeln(fpi,datai[i]);
end;
end;
2: begin
Assign( fpi,s+'.dat');
Reset(fpi);
readln(fpi,wob);
readln(fpi,Tppr);
readln(fpi,Asned);
readln(fpi,L);
for j:=1 to L do
begin
readln(fpi,sgarm[j]);
readln(fpi,skrat[j]);
readln(fpi,sabb[j]);
end;
readln(fpi,sgarm[L+1]);
readln(fpi,fd);
readln(fpi,nd);
for i := 1 to nd do
readln(fpi,ss[i]);
Readln(fpi, mp);
Readln(fpi, m);
m:=m+1;
mp:=mp+1;
Readln(fpi,datai[1]);
Readln(fpi,datai[2]);
Readln(fpi,datai[3]);
writeln('Vvedite den mesyaz i god provedeniya izmereniy (10 11 2004) ');
for i:=1 to 3 do
readln(data[i]);
end;
end;
writeln('tip=',tip:5,'');
writeln(mp:5,' -®ЎйҐҐ Є®«ЁзҐбвў® §*¬Ґа®ў.');
writeln(m:5,' -®Ја**ЁзҐ**®Ґ Є®«ЁзҐбвў® §*¬Ґа®ў.');
writeln('nd=',nd:5,'');
readkey;
for kd:=1 to nd do
begin
Assign( fp,ss[kd]+'.dat');
reset(fp);
writeln('‚ўҐ¤ЁвҐ б㬬*а*л© га®ўҐ*м ўЁЎа*жЁЁ ў ¬¬/б,§*ॣЁбваЁа®ў***л©');
write ('Ї® ¤*взЁЄг ',ss[kd],' ');
readln(Asr[kd]);
if m=1 then
begin
tx[m]:=0;
As[m]:=0;
for j:= 1 to L+1 do
Yg[j,m]:=0;
end
else
begin
for cnt := 1 to m-1 do
begin
Readln(fp, tx[cnt]);
Readln(fp, As[cnt]);
for j:= 1 to L+1 do
Readln(fp, Yg[j,cnt]);
for j:= 1 to L do
Readln(fp,Fg[j,i]);
end;
end;
str(mp,mpp);
tx[m]:=(data[1]-datai[1])+(data[2]-datai[2])*30.5+(data[3]-datai[3])*365;
if tx[m]>=Tppr then
begin
writeln ('‚*Ё¬**ЁҐ ! ’ҐЄгй*п **а*Ў®вЄ* ',tx[m],5:1,' ЇаҐўлбЁ«* **а*Ў®вЄг ¤® ЏЏђ');
writeln ('“ўҐ«ЁзЁвм **а*Ў®вЄг ¤® ЏЏђ ? …б«Ё ¤*, в® ўўҐ¤ЁвҐ 1, *Ґв - 2');
readln (ttr);
if ttr=1 then
{begin
writeln ('‚ўҐ¤ЁвҐ *®ўго **а*Ў®вЄг ¤® ЏЏђ, ЇаҐ¦*пп а*ў*п«*бм - ', Tppr:5:1,'');
readln (Tppr);
end;
if ttr=2 then halt(1); }
end;
Assign(DataFile,ss[kd]+mpp+ '.wav');
Reset(DataFile);
seek(DataFile, 50);
AAs[0]:=0;
for i:=1 to k do
A[i]:=0;
for jj:=1 to jjk do
begin
for i := 1 to 4096 do
begin
Read(DataFile, Xx);
X^[i]:=xx/1;
end;
mm:=round(exp(n*ln(2)));
k:=round(mm/2);
df:=Round(wob/60*mm/(2*fmax));
km:=wob/60*mm/(fmax*df);
f[1]:=fmax*(km/2)/k;
for I:=1 to k do
begin
Xk[i]:=x^[i];
dt[i]:=1/(km*fmax)*i;
end;
{22 Str(jj,ds);
fname:=s+'1'+ds+'.bmp';
BuildP(xk,dt,Ygpr,wob1,2,fname); }
for i:=1 to mm do
y^[i]:=0;
Spektr(x^,y^,N, -1);
Sx:=0;
Sy:=0;
f[1]:=fmax*(km/2)/k;
for i:=1 to k do
begin
A[i]:=(A[i]*(jj-1)+sqrt(sqr(x^[i])+sqr(y^[i])))/jj;
Sx:=Sx+(x^[i])/round(fd/f[1]);
Sy:=Sy+(y^[i])/round(fd/f[1]);
end;
AAs[jj]:=(AAs[jj-1]*(jj-1)+sqrt(sqr(Sx)+sqr(Sy))*round(fd/f[1]))/jj;
for i := 1 to k do
f[i]:=fmax*(km/2)/k*i;
end;{Ї® jj}
Close(DataFile);
Asi[m]:=AAs[jjk];
As[m]:=Asr[kd];
{Sa:=0;
for i := 1 to round(fd/f[1]) do
begin
Sa:=Sa+sqr(A[i]);
end; }
Sa:=Asi[m]{sqrt(sa)};
writeln('Sa=',Sa:5:3,' summa po A[i] do korektirovki ');
writeln('Asi=',aSi[m]:5:3,'summa po sx+sy ');
writeln('mm', mm); writeln('k', k); writeln('df', df);
readkey;
{ for i := 1 to round(fd/f[1]) do
begin
A[i]:=A[i]*As[m]/Sa;
f[i]:=fmax*(km/2)/k*i;
end;
Sa:=0;
for i := 1 to round(fd/f[1]) do
sA:=sa+sqr(A[i]);
Sa:=sqrt(sa);
writeln('Sa=',Sa:5:3,' б㬬* Ї® A[i] Ї®б«Ґ Є®а४вЁа®ўЄЁ ! ');
writeln('As=',aS[m]:5:3,' Ё§¬ҐаҐ**®Ґ §**зҐ*ЁҐ ');
readkey;}
writeln('Posle osredneniya ! ');
Podshipnik(wob,Ft,wob1);
for j:=1 to L do
begin
kn:=round(0.98*Ft[j]/f[1]);
kv:=round(1.05*Ft[j]/f[1]);
Maxgarm(A,kn,kv,ig);
Fg[j,m]:=ig*f[1];
kn:=round(ig-3);
kv:=round(ig+3);
Sumgarm(A,kn,kv,SYgg);
Yg[j,m]:=SYgg;
end;
Ys:=0;
for i:=1 to L do
Ys:=Ys+sqr(Yg[i,m]);
Sa:=sqr(Sa);
if Sa<Ys then Sa:=1.05*Ys
else Sa:=Sa;
Yg[L+1,m]:=sqrt(Sa-Ys);
for i:=1 to L+1 do
Yg[i,m]:=Yg[i,m]*As[m]/sqrt(Sa);
for i:=1 to k do
A[i]:=A[i]*As[m]/sqrt(Sa);
yYs:=0;
for i:=1 to L+1 do
begin
yYs:=yYs+sqr(Yg[i,m]);
end;
yys:=sqrt(yYs);
writeln('YS=',yyS:5:5, ' - Ygбг¬. Ї®б«Ґ Є®а४вЁа®ўЄЁ ( б гзҐв®¬ Їа®зЁе)');
writeln('As=',aS[m]:5:5, ' - As[m] -Ё§¬ҐаҐ**®Ґ §**зҐ*ЁҐ ');
readkey;
writeln('t=',tx[m]:5:5, ' -**а*Ў®вЄ* ');
writeln('fob=',wob1/60:5:5, '-®Ў®а®вл !!! ');
writeln('As=',as[m]:5:5, ' -бг¬. га®ўҐ*м.');
for j:=1 to L+1 do
writeln('Ag=',Yg[j,m]:5:5,' - ', sgarm[j] );
for j:=1 to L do
writeln('Fg=',fg[j,m]:5:1,' - ', Sgarm[j],' , ѓж' );
readkey;
fname:=s+'cp.bmp';
BuildP( A,f,Ft,wob1,1,fname);
for i:=1 to L+1 do
Ygpr[i]:=Asned/As[1]*Yg[i,1];
writeln('Asned=',asned:5:5, ' -Їа. га®ўҐ*м.');
for j:=1 to L+1 do
writeln('AgЇа=',Ygpr[j]:5:4,' - ', sgarm[j] );
readkey;
for i := 1 to m do
Yss[1,i]:=As[i];
str (mp,mpp);
Assign( fr,mpp+s+ss[kd]+'pril.prn');
rewrite(fr);
Diagnostika(Ygpr{, {MinTrem,MinTr,MinTrl1,MaxFdd,s});
close(fr);
if m=13 then
begin
As[1]:=As[1];
As[2]:=As[3];
As[3]:=As[5];
As[4]:=As[7];
As[5]:=As[9];
As[6]:=As[11];
As[7]:=As[m];
tx[1]:=tx[1];
tx[2]:=tx[3];
tx[3]:=tx[5];
tx[4]:=tx[7];
tx[5]:=tx[9];
tx[6]:=tx[11];
tx[7]:=tx[m];
for j:= 1 to L+1 do
begin
Yg[j,1]:=Yg[j,1];
Yg[j,2]:=Yg[j,3];
Yg[j,3]:=Yg[j,5];
Yg[j,4]:=Yg[j,7];
Yg[j,5]:=Yg[j,9];
Yg[j,6]:=Yg[j,11];
Yg[j,7]:=Yg[j,m];
end;
m:=7;
end;
rewrite(fp);
for i := 1 to m do
begin
writeln(fp,tx[i]);
writeln(fp,as[i]);
for j:= 1 to L+1 do
writeln(fp,Yg[j,i]);
for j:= 1 to L do
writeln(fp,Fg[j,i]);
writeln(fp,'');
end;
close(fp);
{str (mp,mpp);
Assign( fr,mpp+s+ss[kd]+'pril.prn');
rewrite(fr);
Diagnostika(Ygpr);
close(fr); }
End;{Ї® зЁб«г ¤*взЁЄ®ў}
rewrite(fpi);
writeln(fpi,wob);
writeln(fpi,Tppr);
writeln(fpi,Asned);
writeln(fpi,L);
for j:=1 to L do
begin
writeln(fpi,sgarm[j]);
writeln(fpi,skrat[j]);
writeln(fpi,sabb[j]);
end;
writeln(fpi,sgarm[L+1]);
writeln(fpi,fd);
writeln(fpi,nd);
for i := 1 to nd do
writeln(fpi,ss[i]);
writeln(fpi,mp);
writeln(fpi,m);
for i := 1 to 3 do
writeln(fpi,datai[i]);
for i := 1 to 3 do
writeln(fpi,data[i]);
close(fpi);
Dispose(x); dispose(y);
END. |
|
#22
17.03.2012, 00:24
|
|||
|
|||
|
я совсем не програмист.. пытаюсь разобратся. но не получается чето(((
Дело в том что считывается не 1н .wav, а несколько. но даже для 1го не хочет хммм всунул ваш код для кнопки, но все-равно ошибка, мб в самой программе дело, попробую поискать... (файлы все на месте) решилось увеличением массива для X Последний раз редактировалось deniks, 17.03.2012 в 01:11. |
|
#24
19.03.2012, 23:36
|
|||
|
|||
|
время очень поджимает, могу только выложить, без коментариев, некогда их писать.
По пути реализации столкнулся еще с 1й проблемой. Есть массив A[i] который используется в процедуре MAXGARM, но почему-то он не хочет с ним работать. (значение IG должно быть не 0 ). Код:
unit Diagnoz;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
type
MASK = array[1..4096] of real; {X, Y}
MASKCP = array[1..4096] of real;
MASKD = array [1..500] of string;
MAS3 = array[0..50] of real;
MASKDD = array[0..50] of real;
MAS = array[0..20,0..30] of real;
MASK1 = array[0..4096] of integer;
var
S, I, JJ, J, K, MM, MP, M, KNN, KVV, IM, IG, KN, KV, NEIZ : integer;
AX, ASR, XK, F, DT, A : MASK;
SKRAT, FT : MASKCP;
MPP, TEXT : string;
DataFile : file;
AAS, ASI : MAS3;
xx : byte;
X, Y : MASK;
KM, DF, MK, MAXF, SX, SY, KD1, SA, WOB1, WOB, SYGG, YS, YYS, AM : real;
SS : MASKD;
KD : longint;
TPPR, L, FD, ND, TIP: integer;
myfile : textfile;
AS1 : maskdd;
YGG, YSS, YG, FG : MAS;
const jjk = 2; FMAX = 11025/2; N = 12;
Procedure SUMGARM(var AX : mask; KN1, KV1 : integer; SYGG: real);
var S : real;
begin
S := 0;
for i := KN1 to KV1 do
begin
S := S + sqr(AX[i]);
end;
SYGG := sqrt(S);
end;
{Procedure MAXGARM(var P : MASK1; KNN, KVV : integer; var MAXGG : integer);
var
MAXG, MK, MAX : real;
IM: integer;
begin
MK :=P[KNN];
IM := KNN;
MAXG := FMAX*(KM/2)/K*IM;
for i := KNN to KVV do
begin
if P[i] > MK then
begin
MK := P[i];
IM := I;
MAXG := FMAX*(KM/2)/K*IM;
end;
end;
MAXGG := round(MAXG/F[1]);
end; }
Procedure Maxgarm(var P:mask; knn,kvv: integer; var maxgg:integer);
var maxg,mk,max:single;im :integer;
begin
mk:=P[knn];
im:=knn;
maxg:=fmax*(km/2)/k*im;
For i:=knn to kvv do
begin
if p[i]>mk then
begin
mk:=p[i];
Max:=mk;
im:=i;
Maxg:=fmax*(km/2)/k*im;
end; end;
maxgg:=round(maxg/f[1]);
end;
procedure PODSHIPNIK(WOB2 : real; AF : MASKCP; AWOB : real);
Function MAX(P : mask) : real;
begin
KNN := round(0.9 * WOB2 / 60 / F[1]);
KVV := round(1.1 * WOB2 / 60 / F[1]);
MK := P[KNN];
IM := KNN;
MAXF := FMAX * (KM / 2) / K * IM;
for I := KNN to KVV do
begin
if P[i] > MK then
begin
MK := P[i];
MAX := MK;
IM := I;
MAXF := fmax * (KM / 2) / K * IM;
end;
end;
end;
var AM, MAXF : real; IM : integer;
begin
AM := MAX(A);
AWOB := MAXF * 60;
for I := 1 to L do
AF[i] := MAXF * SKRAT[i];
end;
procedure Spektr(var AX, AY; Dim: Word; D: Integer);
var
x: array [1..16384] of real absolute AX;
y: array [1..16384] of real absolute AY;
I, J, N, L, K, LE, LE1,IP, NV2, NM1: Integer;
Arg, U1, U2, U3, C, S, T1, T2, T3, T4: real;
begin
N := 1 shl Dim;
if D = -1 then FillChar(Y, N*SizeOf(real), 0);
for L := 1 to Dim do
begin
LE := 1 shl (Dim+1-L);
LE1 := LE div 2;
U1 := 1;
U2 := 0;
Arg := Pi/LE1;
C := Cos(Arg);
S := D*Sin(Arg);
for J := 1 to LE1 do
begin
I := J;
while I <= N do
begin
IP := I + LE1;
T1 := X[i] + X[IP];
T2 := Y[i] + Y[IP];
T3 := X[i] - X[IP];
T4 := Y[i] - Y[IP];
X[IP] := T3*U1 - T4*U2;
Y[IP] := T4*U1 + T3*U2;
X[i] := T1;
Y[i] := T2;
I := I + LE;
end;
U3 := U1*C - U2*S;
U2 := U2*C + U1*S;
U1 := U3;
end;
end;
NV2 := N div 2;
NM1 := N-1;
J := 1;
for I := 1 to NM1 do
begin
if I < J then
begin
T1 := X[J];
T2 := Y[J];
X[J] := X[i];
Y[J] := Y[i];
X[i] := T1;
Y[i] := T2;
end;
K := NV2;
while K < J do
begin
J := J - K;
K := K div 2;
end;
J := J + K
end;
if D = 1 then Exit;
for I:=1 to N do
begin
X[i] := X[i] / N*2;
Y[i] := Y[i] / N*2;
end;
X[1] := 0;
end;
procedure TForm1.Button1Click(Sender: TObject);
var SO, NOM : string;
ANED : real;
data,datai : array [1..3] of integer;
Asr : array [1..10] of integer;
K : integer;
begin
SO := Edit1.Text;
WOB := StrToInt(Edit2.Text);
TPPR := StrToInt(Edit3.Text);
ANED := StrToFloat(Edit4.Text);
L := StrToInt(Edit5.Text);
FD := StrToInt(Edit6.Text);
ND := StrToInt(Edit7.Text);
TIP := StrToInt(Edit9.Text);
Asr[1] := StrToInt(Edit10.Text);
data[1] := StrToInt(Edit8.Text);
data[2] := StrToInt(Edit11.Text);
data[3] := StrToInt(Edit12.Text);
Label2.Caption := 'Îáúåêò äèàãíîñòèðîâàíèÿ: ' + SO + #13 +
'×èñëî îáîðîòîâ â ìèíóòó: ' + FloatToStr(WOB) + #13 +
'Íàðàáîòêà äî ðåìîíòà ñîñòàâëÿåò: ' + IntToStr(TPPR) + ' äíåé ' + #13 +
'Ïðåäåëüíî äîïóñòèìûé óðîâåíü âèáðàöèé: ' + FloatToStr(ANED) + ' ìì/ñ' + #13 +
'Êîëè÷åñòâî äèàãíîñòèðóåìûõ äåôåêòîâ: ' + IntToStr(L) + #13 +
'×àñòîòà äèàãíîñòèðîâàíèÿ: ' + IntToStr(FD) + ' Ãö' + #13 +
'Êîëè÷åñòâî äàò÷èêîâ: ' + IntToStr(ND) + #13 +
'Äàòà ïðîâåäåíèÿ èñõîäíûõ èçìåðåíèé: ' + IntToStr(data[1]) + '.' + IntToStr(data[2]) +
'.' + IntToStr(data[3]) + #13 +
'Êîëè÷åñòâî çàìåðîâ: ' + IntToStr(TIP) + #13 +
'Ñóììàðíûé óðîâåíü ïî äàò÷èêó (ìì/ñ): ' + IntToStr(Asr[1]);
end;
procedure TForm1.Button2Click(Sender: TObject);
var
DataFile : file;
I, J : Integer;
XX : Byte;
begin
mpp := '1';
ss[kd] := '1w';
AssignFile(DataFile, ss[kd] + mpp + '.wav');
Reset(DataFile, 1);
Seek(DataFile, 50);
AAS[0] := 0;
for I:=1 to K do
begin
A[i] := 0;
end;
for JJ := 1 to jjk do
begin
for J := 1 to 4096 do
begin
BlockRead(DataFile, XX, 1);
X[J] := XX;
end;
MM := round(exp(n*ln(2)));
K := round(mm/2);
DF := round(wob/60*mm/(2*fmax));
KM := wob/60*mm/(fmax*df);
F[1]:=fmax*(km/2)/k;
for I:=1 to K do
begin
XK[i] := X[i];
DT[i] := 1/(KM*FMAX)*I;
end;
for I := 1 to MM do
y[i] := 0;
SPEKTR(X,Y,N, -1);
SX := 0;
SY := 0;
F[1] := FMAX*(KM/2)/K;
for I := 1 to K do
begin
A[i]:=(A[i]*(jj-1)+sqrt(sqr(x[i])+sqr(y[i])))/jj;
SX := SX+(X[i])/round(FD/F[1]);
SY := SY+(Y[i])/round(FD/F[1]);
end;
AAS[jj]:=(AAS[JJ-1]*(JJ-1)+sqrt(sqr(SX)+sqr(SY))*round(FD/F[1]))/JJ;
for I := 1 to K do
F[i] := FMAX*(KM/2)/K;;
end;
CloseFile(DataFile);
ASI[M] := AAS[JJK];
AS1[M] := ASR[KD];
SA := ASI[M];
Label13.Caption := 'MM: ' + IntToStr(MM) + #13 +
'K: ' + IntToStr(K) + #13 +
'DF: ' + FloatToStr(DF) + #13 + 'KM: ' + FloatToStr(KM) + #13 +
'F[1]: ' + FloatToStr(F[1]) + #13 +
'SA = ' + FloatToStr(SA) + #13 +
'ASI[M]= ' + FloatToStr(ASI[M]) + #13 +
'SX: ' + FloatToStr(SX);
PODSHIPNIK(WOB,FT,WOB1);
for j:=1 to L do
begin
kn:=round(0.98*Ft[j]/f[1]);
kv:=round(1.05*Ft[j]/f[1]);
Maxgarm(A,kn,kv,ig);
FG[J,M] := IG * F[1];
KN := round(IG - 3);
KV := round (IG + 3);
SUMGARM(A, KN, KV, SYGG);
YG[j,m] := SYGG;
end;
YS := 0;
for I := 1 to L do
YS := YS + sqr(YG[i,m]);
SA := sqr(SA);
if SA < YS then
SA := 1.05 * YS
else
SA := SA;
YG[L + 1, M] := SQRT(SA - YS);
for I := 1 to L + 1 do
YG[I,M] := YG[I,M] * AS1[M] / sqrt (SA);
for I := 1 to k do
A[i] := A[i] * AS1[M] / sqrt(SA);
YYS := 0;
for J := 1 to L+1 do
begin
YYS := YYS + sqr(YG[J,M]);
end;
YYS := sqrt(YYS);
Label4.Caption := 'KN : ' + IntToStr(KN) + #13 + 'KV: ' + IntToStr(KV) +
#13 + 'F1 := ' + FloatToStr(F[1]) + #13 +
'IG: ' + IntToStr(IG);
{posle korektirovki}
{
Label4.Caption := 'SA = ' + FloatToStr(SA) + #13 +
'YYS= ' + FloatToStr(YYS) + #13 + FloatToStr(YG[1,1]);
}
end;
end. |
|
#25
19.03.2012, 23:56
|
||||
|
||||
|
Может я чего то не понимаю, но зачем делать так:
Код:
procedure Maxgarm(var P:mask; knn,kvv: integer; var maxgg:integer);
var
maxg,mk,max:single;im :integer;
begin
mk:=P[knn];
im:=knn;
maxg:=fmax*(km/2)/k*im;
For i:=knn to kvv do
begin
if p[i]>mk then
begin
mk:=p[i];
Max:=mk;
im:=i;
Maxg:=fmax*(km/2)/k*im;
end;
end;
maxgg:=round(maxg/f[1]);
end;Код:
function Maxgarm(knn, kvv: integer) : Integer;
var
maxg,mk,max:single;im :integer;
begin
Result := 0;
mk:=A[knn];
im:=knn;
maxg:=fmax*(km/2)/k*im;
For i:=knn to kvv do
begin
if A[i]>mk then
begin
mk:=p[i];
Max:=mk;
im:=i;
Maxg:=fmax*(km/2)/k*im;
end;
end;
Result := round(maxg/f[1]);
end;
...
IG := Maxgarm(kn,kv); |
| Этот пользователь сказал Спасибо angvelem за это полезное сообщение: | ||
deniks (20.03.2012)
| ||
|
#27
20.03.2012, 21:07
|
|||
|
|||
|
в паскале получается IG = 79 а у меня IG=2 .. ищу ошибку дальше(
нашел что не хочет считать wob1 в процедуре PODSHIPNIK, вроде бы все значения присутствуют... странно.. попробую переделать эту процедуру Последний раз редактировалось deniks, 20.03.2012 в 22:24. |
|
#28
20.03.2012, 23:56
|
|||
|
|||
|
вот переделал, значения уже показывает нормальные, что уже радует, но вопрос, правильно ли я сделал с Result и массивом?
Код:
Function PODSHIPNIK1(WOB : real) : real;
var MAXF : real; IM : integer;
begin
Result := 0;
knn:=round(0.9*wob/60/f[1]);
kvv:=round(1.1*wob/60/f[1]);
MK :=A[KNN];
IM := KNN;
maxf:=fmax*(km/2)/k*im;
for I := KNN to KVV do
begin
if A[i] > MK then
begin
IM := I;
maxf:=fmax*(km/2)/k*im;
WOB1 := MAXF * 60;
end;
end;
{ AM := MAX(A); }
WOB1 := MAXF * 60;
for I := 1 to L do
begin
FT[i] := MAXF * SKRAT[i];
Result := FT[i];
end;
end;
...
for i:=1 to L do
FT[i] := podshipnik1(wob); |
|
#29
21.03.2012, 00:08
|
||||
|
||||
|
У тебя получается масло-масляное. Функция возвращает значение FT[i], и принимается туда же:
Код:
Function PODSHIPNIK1(WOB : real) : real; ... Result := FT[i]; ... FT[i] := podshipnik1(wob); Смысла тогда делать функцию нет, по сути это процедура. Измени на: Код:
function PODSHIPNIK1(WOB : Single) : Single;
var
MAXF : Single;
IM : Integer;
begin
Result := 0;
knn := Round(0.9 * wob / 60 / f[1]);
kvv := Round(1.1 * wob / 60 / f[1]);
MK := A[KNN];
IM := KNN;
maxf := fmax * (km / 2) / k * im;
for I := KNN to KVV do
begin
if A[i] > MK then
begin
IM := I;
maxf := fmax * (km / 2) / k * im;
WOB1 := MAXF * 60;
end;
end;
{ AM := MAX(A); }
WOB1 := MAXF * 60;
for I := 1 to L do
Result := MAXF * SKRAT[i];
end;
...
for i:=1 to L do
FT[i] := podshipnik1(wob);Код:
for I := 1 to L do
Result := MAXF * SKRAT[i]; |
Линейный вид
