1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
| unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, StrUtils, TeEngine, Series, ExtCtrls, TeeProcs, Chart, Math,
ComCtrls, StdCtrls;
type
Arr = array[1..20200] of Double; //Мой формат массива на 20000 точек с запасом
type
TForm1 = class(TForm)
MainMenu1: TMainMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
N5: TMenuItem;
N7: TMenuItem;
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
Chart1: TChart;
Series1: TLineSeries;
N8: TMenuItem;
N9: TMenuItem;
N10: TMenuItem;
N11: TMenuItem;
N12: TMenuItem;
N13: TMenuItem;
N14: TMenuItem;
N15: TMenuItem;
Series2: TLineSeries;
N6: TMenuItem;
N16: TMenuItem;
J1: TMenuItem;
N17: TMenuItem;
N18: TMenuItem;
N19: TMenuItem;
N21: TMenuItem;
Memo1: TMemo;
procedure N2Click(Sender: TObject);
procedure N9Click(Sender: TObject);
procedure N7Click(Sender: TObject);
procedure N11Click(Sender: TObject);
procedure N5Click(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure N16Click(Sender: TObject);
procedure N17Click(Sender: TObject);
procedure N21Click(Sender: TObject);
private
{ Private declarations }
procedure NewXY(Sender: TObject); //Расчет АЧХ и график исходного сигнала
public
{ Public declarations }
Spe1, //Действительная составляющая спектра
Spe2, //Мнимая составляющая спектра
Spe, //Абсолютное значение спектар
Amp, //Входной сигнал
FAmp, //Фильтрованный сигнал
FSP //Коэффициенты Фильтра Баттерворта на всех частотах
: Arr;
nAm, //Количество точек входного (фильтрованного) сигнала
nSP, //Количество точек спектра (АЧХ), кратное двум
nDoT, //Количество нажатий на меню "Добавить точек"
Limit //Фиксирует факт включения конвертора формата файла
: Integer;
SagT, //Шаг по времени для АВЗ (амплитудно-временной зависимости)
SagF, //Шаг по частоте для АЧХ (амплитудно-частотной характеристики)
GGG //постоянная составляющая АЧХ
: Double;
//Процедура Быстрого Дискретного Преобразования Фурье:
procedure BPF(FFT // FFT=1 (FFT=2) - прямое (обратное) преобразование Фурье
:Integer;
Var // Var позволяет не копировать массив, а использовать по месту расположения
FY, // массив для АВЗ (При FFT=2 заменяет на фильтрованный)
SP1, // |
SP2, // |- массив для АЧХ (При FFT=1 заменяет на новые значения)
SP // |
:Arr);
end;
var
Form1: TForm1;
implementation
uses Unit2;
{$R *.dfm}
// Быстрое Дискретное Преобразование Фурье:
procedure TForm1.BPF(FFT:Integer; Var FY,SP1,SP2,SP:Arr);
var i,j,k,n,n1,n2,n3,n4:Word;
u,v,z,c,s,p,q,r,t,w,Pi:Single;
YR,YM: Arr;
begin
Pi:=3.1415926;
//Формирование временного массива:
if FFT=1 then //для прямого преобразование Фурье:
begin
for i:=1 to nAm do
begin
YR[i]:=FY[i];
YM[i]:=0;
end;
end else begin //для обратного преобразование Фурье:
for i:=1 to nSp do
begin
YR[i]:=SP1[i];
YM[i]:=SP2[i];
end;
end;
if FFT=1 then
begin //Постоянная составляющая АЧХ
GGG:=0;
for i:=1 to nAm do GGG:=GGG+FY[i];
GGG:=GGG/nAm;
end;
//Проверка на соответствие степени двойки:
n:=1; k:=2;
while k<nAm do
begin
n:=n+1;
k:=Trunc(Power(2,n));
end;
if FFT=1 then
begin // Дополнение нулями:
for i:=nAm+1 to k do
begin
YR[i]:=0;
YM[i]:=0;
end;
nSp:=k;
end;
//ДПФ
for k:=1 to n do
begin
u:=1; v:=0;
n1:=Trunc(Power(2,n-k+1));
n2:=Trunc(n1/2);
z:=Pi/n2;
c:=cos(z);
s:=sin(z);
if FFT=1 then s:=-s;
for j:=1 to n2 do
begin
i:=j;
While not(i>nSp) do
begin
n3:=i+n2;
n4:=i;
p:=YR[n4]+YR[n3];
r:=YR[n4]-YR[n3];
q:=YM[n4]+YM[n3];
t:=YM[n4]-YM[n3];
YR[n3]:=r*u-t*v;
YM[n3]:=t*u+r*v;
YR[n4]:=p;
YM[n4]:=q;
i:=i+n1;
end;
w:=u*c-v*s;
v:=v*c+u*s;
u:=w;
end;
end;
j:=1;
for i:=1 to nSp-1 do
begin
if i<j then
begin
p:=YR[j];
q:=YM[j];
YR[j]:=YR[i];
YM[j]:=YM[i];
YR[i]:=p;
YM[i]:=q;
end;
k:=Trunc(nSp/2);
while k<j do
begin
j:=j-k;
k:=Trunc(k/2);
end;
j:=j+k;
end;
FY[1]:=YR[1]/nSp;
SP1[1]:=GGG; SP2[1]:=0; SP[1]:=GGG;
if FFT=1 then begin
for i:=2 to nSp do
begin
SP1[i]:=YR[i]*2;
SP2[i]:=YM[i]*2;
SP[i]:=Sqrt(SP1[i]*SP1[i]+SP2[i]*SP2[i]);
end;
end else begin
for i:=1 to nSp do FY[i]:=YR[i]/nSp+GGG;
end;
end;
procedure TForm1.N2Click(Sender: TObject);
var t: Double; S: string; k1,k2: Integer;
Tf: Textfile; ts: tstringlist;
begin //Открыть файл
With OpenDialog1 do
begin
// InitialDir:=GetCurrentDir(); //выбор той же директории (папки), где находится файл *.exe
Title := 'Открыть файл с амплитудно-временной зависимостью';
Filter := 'DB files (*.csv)|*.csv|All files (*.*)|*.*';
FilterIndex := 1; //выбран первый тип файлов
if Execute then
begin
Form1.Caption:='Файл - '+ExtractFileName(FileName);
Ts := Tstringlist.create;
Assignfile(tf, FileName); Reset(tf);
nAm:=0; t:=0; Limit:=0; //Конвертор не включался
while not eof(tf) do
begin
Readln(tf,S);
if(nAm=0)then
if((S[1]<'0')or(S[1]>'9'))or((S[1]='-')and((S[2]<'0')or(S[2]>'9')))then
begin
MessageDlg('Обнаружен заголовок:'+#13+S,mtInformation,[mbOk],0);
Readln(tf,S);
end;
//Не знаю, какой формат входного файла, поэтому конвертирую заранее
DecimalSeparator:='.'; //Разделитель целой и дробной части числа
if Pos(';',S)>0 then
begin
Limit:=1; //Начали конвертацию
k1:=Pos(';',S);
While k1>0 do begin S[k1]:='*'; k1:=Pos(';',S); end;
k2:=Pos(',',S);
While k2>0 do begin S[k2]:='.'; k2:=Pos(',',S); end;
k1:=Pos('*',S);
While k1>0 do begin S[k1]:=','; k1:=Pos('*',S); end;
S[k1]:=',';
end;
//Разделим строку на части:
Ts.CommaText:=S;
if nAm<1 then t:=StrToFloat(Ts.Strings[0]);
SagT:=(SagT+StrToFloat(Ts.Strings[0])-t)/2;
nAm:=nAm+1;
Amp[nAm]:=StrToFloat(Ts.Strings[1]);
t:=StrToFloat(Ts.Strings[0]);
end;
closefile(tf);
ts.free;
nDoT:=1; //Сколько раз применили "Добавить точки"
N17.Enabled:=true; //Добавить точек
N3.Enabled:=true; //Сохранить
N21.Enabled:=true; //дБ
N7 .Enabled:=true; // Фильтр
N10.Enabled:=true; // Исходный АВЗ
N12.Enabled:=false; // Фильтрованный АВЗ
N15.Enabled:=false; // Исходный + Фильтрованный
N11.Enabled:=true; // АЧХ
N9 .Enabled:=true; // Вид-Точки
N11Click(N10); //График исходной АВЗ
NewXY(Sender); //расчет АЧХ
end;
end;
end;
procedure TForm1.NewXY(Sender: TObject);
Var i,j,k,n: Integer; S: String;
begin
nSp:=nAm;
for i:=1 to nAm do
begin //Обнуляем массивы
Spe1[i]:=0; Spe2[i]:=0;
Spe[i]:=0; FAmp[i]:=Amp[i];
end;
//АЧХ исходного АВЗ:
BPF(1,Amp,Spe1,Spe2,Spe); //Прямое преобразование Фурье
SagF:=1/nSp/SagT; //Выбор шага по частоте
//Предварительный выбор частоты фильтра:
S:=FloatToStr(SagF*nSp/3.14/nDoT/2);
i:=0; j:=Length(S); k:=0;
While(k<1)and(i<j) do
begin
i:=i+1;
if(k<1)then begin
if(not(S[i]='0'))and(not(S[i]='.'))then k:=k+1;
end else if(not(S[i]='.'))then k:=k+1;
end;
n:=Pos('.',S); S:=LeftStr(S,i); j:=Length(S);
For k:=2 to n-j do S:=S+'0';
OKRightDlg.Edit1.Text:=S;
end;
procedure TForm1.N7Click(Sender: TObject);
Var i: Integer; Spt1,Spt2: Arr;
begin // Выбор фильтра Баттерворта
if OKRightDlg.ShowModal=1 then
begin
for i:=1 to nSp do
begin
Spt1[i]:=Spe1[i]*FSP[i];
Spt2[i]:=Spe2[i]*FSP[i];
end;
BPF(2,FAmp,Spt1,Spt2,Spe); //Обратное преобразование Фурье
N11Click(N15); // Показать Фильтрованный+Исходный
N12.Enabled:=true; // Фильтрованный АВЗ
N15.Enabled:=true; // Исходный+Фильтрованный
end;
end;
procedure TForm1.N5Click(Sender: TObject);
Var Flag: Boolean; i,n,k1,k2: Integer; SPX: Double;
ts: tstringlist; Tf: Textfile; S: String;
begin //Сохранить АЧХ
With SaveDialog1 do
begin
Filter := 'CSV files (*.csv)|*.csv|All files (*.*)|*.*';
if Sender=N5 then Title := 'Сохраним в файл Амплитудно-Частотную Характеристику'
else Title := 'Сохраним в файл Амлитудно-Временную Зависимость';
if Sender=N5 then FileName:='ACH' else FileName:='AWZ';
if Execute then
begin
Flag:=false;
if not(RightStr(FileName,4)='.csv') then FileName:=FileName+'.csv';
if (FileExists(FileName))then Flag:=true;
if(Flag)and(MessageDlg('Заменить Файл?'+#13 +
FileName,mtConfirmation,[mbYes,mbNo],0)=mrYes)then Flag:=false;
if not Flag then
begin
Ts := Tstringlist.create;
Assignfile(tf,FileName); Rewrite(tf);
SPX:=1/SagT/nSp;
//Заголовок
if Sender=N5 then begin
Ts.Append('Частота'); Ts.Append('АЧХ');
Ts.Append('Реальн.'); Ts.Append('Мним.');
n:=nSp;
end else begin
Ts.Append('Время'); Ts.Append('Исходный');
Ts.Append('Время'); Ts.Append('Фильтрованный');
n:=nAm;
end;
Writeln(tf,Ts.CommaText);
TS.Clear;
//Сохраняем:
For i:=2 to n do
begin
if Sender=N5 then
begin
Ts.Append(FloatToStr(i*SPX));
Ts.Append(FloatToStr(Spe[i]));
Ts.Append(FloatToStr(Spe1[i]));
Ts.Append(FloatToStr(Spe2[i]));
end else begin
Ts.Append(FloatToStr(i*SPX));
Ts.Append(FloatToStr(Amp[i]));
Ts.Append(FloatToStr(i*SPX));
Ts.Append(FloatToStr(FAmp[i]));
end;
S:=Ts.CommaText;
if Limit=1 then
begin //Переводим формат файла обратно (согласно исходному)
k1:=Pos(',',S);
While k1>0 do begin S[k1]:='*'; k1:=Pos(',',S); end;
k2:=Pos('.',S);
While k2>0 do begin S[k2]:=','; k2:=Pos('.',S); end;
k1:=Pos('*',S);
While k1>0 do begin S[k1]:=';'; k1:=Pos('*',S); end;
end;
Writeln(tf,S);
TS.Clear;
end;
closefile(tf);
ts.free;
end;
end;
end;
end;
procedure TForm1.FormActivate(Sender: TObject);
begin
N3 .Enabled:=false; // Файл-Сохранить
N7 .Enabled:=false; // Обработка-Фильтр
N17.Enabled:=false; // Обработка-Добавить
N10.Enabled:=false; // Вид-Исходный АВЗ
N12.Enabled:=false; // Вид-Фильтрованный АВЗ
N15.Enabled:=false; // Вид-Исходный+Фильтрованный
N11.Enabled:=false; // Вид-АЧХ
N9 .Enabled:=false; // Вид-Точки
N21.Enabled:=false; // Вид-дБ
Memo1.Align:=alClient;
end;
procedure TForm1.N16Click(Sender: TObject);
begin
MessageDlg('http://motosnz.narod.ru/'+#13+'Герман Канунников'+#13+
'Снежинск', mtInformation,[mbOk],0);
end;
procedure TForm1.N17Click(Sender: TObject);
Var i,k: Integer; y: Arr;
begin // Добавить точек в исходный сигнал
k:=0; nDoT:=nDoT+1;
for i:=1 to nAm-1 do
begin
y[k+1]:=Amp[i];
y[k+2]:=(Amp[i]+Amp[i+1])/2;
k:=k+2;
end;
nAm:=nAm*2; SagT:=SagT/2;
for i:=1 to nAm do Amp[i]:=y[i];
N11Click(N10); //График исходной АВЗ
NewXY(Sender); //расчет АЧХ
end;
procedure TForm1.N11Click(Sender: TObject);
Var i,k: Integer; SPX: Double;
begin
N10.Checked:=false; // Вид->Исходный АВЗ
N12.Checked:=false; // Вид->Фильтрованный АВЗ
N15.Checked:=false; // Вид->Исходный + Фильтрованный
N11.Checked:=false; // Вид->АЧХ
With(Sender as TMenuItem)do
begin
Checked:=true;
Chart1.Series[0].Clear; Chart1.Series[1].Clear;
if Name='N10' then For i:=1 to nAm do Series1.AddXY((i-1)*SagT,Amp[i],'',clGreen);
if Name='N12' then For i:=1 to nAm do Series2.AddXY((i-1)*SagT,FAmp[i],'',clBlue);
if Name='N15' then For i:=1 to nAm do
begin
Series1.AddXY((i-1)*SagT,Amp[i],'',clGreen);
Series2.AddXY((i-1)*SagT,FAmp[i],'',clBlue);
end;
if Name='N11' then
begin
SPX:=1/SagT/nSp; k:=Trunc(nSp/2);
if not N21.Checked then For i:=2 to k do Chart1.Series[0].AddXY((i-1)*SPX,Spe[i],'',clBlue);
if N21.Checked then For i:=2 to k do Chart1.Series[0].AddXY((i-1)*SPX,20*Log10(Spe[i]),'',clBlue);
end;
end;
end;
procedure TForm1.N9Click(Sender: TObject);
begin //Точки на графике
N9.Checked:=not N9.Checked;
Series1.Pointer.Visible:=not Series1.Pointer.Visible;
Series2.Pointer.Visible:=not Series2.Pointer.Visible;
end;
procedure TForm1.N21Click(Sender: TObject);
begin //дБ на АЧХ
N21.Checked:=not N21.Checked;
N11Click(N11);
end;
end. |