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
| unit Unit1;
{$mode objfpc} {$H+}
interface
uses
windows, Messages, Classes, SysUtils, FileUtil, LResources, Forms, Controls,
GrapHics, Dialogs;
const
ADCTimes:array[0..4]
of DWORD=(5000,10000,20000,50000,100000);
strADCTime:array[0..4]
of string=('500 mc','1 c', '2 c', '3 c', ' 10 c');
ResolutionADC=10;
ww=1000; hh=660;
type
TOscillograph=class(TForm)
SAveDialog:TSaveDialog;
procedure FormCreate(Sender: TObject);
procedure FormKeyDown(sender:TObject; var Key: Word;
Shift:TShiftstate);
procedure FormPaint(Sender:TObject);
Public
hCom: THandle;
BmGrid: TBitMap;
ADCTime: DWORD;
Reset: Boolean;
Pause: Boolean;
Data: array[0..1000-1] of integer;
procedure CreateGrid();
procedure RedrawInfo();
procedure SAveData();
Function ReadADC(): Integer;
procedure _Run();
end;
var
Oscillograph:TOscillograph;
implementation
procedure TOscillograph.FormCreate(Sender:TObject);
var DCB: TDCB;
begin
ADCTime:=10000; Pause:= FALSE;
hCom:= INVALID_HANDLE_VALUE; CreateGrid;
hCom:=CreateFile('\\.COM1',GENERIC_READ or
GENERIC_write, 0, nil, OPEN_EXISTING, 0, 0);
if hCom = INVALID_HANDLE_VALUE then begin
ShowMessage('ошибка открытия порта COM1');
//ExitProcess(1);
end;
end;
procedure TOscillograph.CreateGrid();
var x0, y0, x, y, l: integer;
begin
bmGrid:= TBitMap.Create;
bmGrid.Width:= ww; bmGrid.Height:=hh;
with bmGrid.Canvas do begin
Brush.Color:= clBlack; Pen.Color:= clGray;
FillRect(Rect(0, 0, bmGrid.width, bmGrid.Height));
x := 0; y := 0; x0 := ww div 2; y0 := hh div 2;
// рисование вертикальных линий
while x < ww div 2 do begin
if x mod 100 = 0 then l := hh div 2 else l := 5;
MoveTo(x0 + x, y0 - l); LineTo (x0 + x, y0 + l);
MoveTo(x0 - x, y0 - l); LineTo (x0 - x, y0 + l);
inc (x, 10);
end;
//рисование горизонтальных линий
while y < ww div 2 do begin
if y mod 100 = 0 then l := hh div 2 else l := 5;
MoveTo(x0 - l, y0 - y); LineTo (x0 + l, y0 - y);
MoveTo(x0 - l, y0 + y); LineTo (x0 + l, y0 + y);
inc (y, 10);
end;
end;
end;
//--------обработчик события "клавиша нажата"--------
procedure TOscillograph.FormKeyDown (Sender: TObject;
var Key: Word; Shift: TShiftState);
var index: byte;
begin
for index := 0 to 4 do
if ADCTime = ADCTimes[index] then break;
case Key of
VK_ESCAPE: begin Close; bmGrid.Free; end;
VK_F2: if index > 0 then ADCTime := ADCTimes[index - 1];
VK_F3: if index < 4 then ADCTime := ADCTimes[index + 1];
VK_F7: if SaveDialog.Execute then SaveData;
VK_RETURN:_Run;
VK_SPACE : Pause := not Pause;
end;
Reset := Key in [VK_F2..VK_F3];
RedrawInfo;
end;
//-----обработчик события "Перерисовка формы"----------
procedure TOscillograph.FormPaint (Sender: TObject);
begin
RedrawInfo;
//-----вывод координатной сетки на экран-------
if Assigned(bmGrid) then BitBlt (Canvas.Handle, 10, 10,
ww, hh, bmGrid.Canvas.Handle, 0, 0, SRCCOPY);
end;
//-----------вывод информационной строки-------------------
procedure TOscillograph.RedrawInfo();
var
x0, y0,i: integer;
strSyncrType: string;
p: TPoint;
begin
x0 := 10; y0 := 10+hh+10;
for i := 0 to 4 do if ADCTime = ADCTimes[i] then break;
with Canvas do begin
FillRect(Rect(x0, y0, x0 + ww, y0 + hh));
p := PenPos; // сохранение позиции пера
Pen.Color := clBlack; Pen.Width := 1;
MoveTo(x0, y0 + 45); LineTo(x0, y0); LineTo(x0 + 750, y0);
Font.Size := 12;
TextOut (x0 + 10, y0 + 05,
Format('Время на деление: %s', [strADCTime [i]]));
TextOut(x0 + 10, y0 + 25,
Format('Напряжение на деление: %s', ['0,5 B']));
if Pause then TextOut(x0+900, y0+25, '<ПАУЗА>');
//восстановление параметров пера
PenPos := p; Pen.Color := clYellow; Pen.Width := 2;
end;
end;
//-------сохранение экспериментальных отсчетов в файл-------
procedure TOscillograph.SaveData();
var
i : integer;
ff : textfile;
begin
AssignFile(ff, SaveDialog.FileName);
ReWrite(ff);
WriteLn(ff, ADCTime);
for i := 1 to 1000 do begin
WriteLn(ff, Round(Data[i-1]))
end;
CloseFile(ff);
end;
//------------функция опроса АЦП---------------------
function TOscillograph.ReadADC(): Integer;
var
i : byte;
CommStatus: DWORD;
begin
if hCom = INVALID_HANDLE_VALUE then Exit;
result := 0;
// для начала преобразования необходимо установить на #SC 0B
EscapeCommFunction(hCom, CLRDTR);
//тактовые импульсы формируются при помощи линии RTS
EscapeCommFunction(hCom, CLRRTS); // RTS = 0
for i := ResolutionADC - 1 downto 0 do begin
EscapeCommFunction(hCom, SETRTS); // RTS=1
//считывание состояния входных линий
GetCommModemStatus(hCom, CommStatus);
//формирование результата
if (CommStatus and MS_CTS_ON) <> 0 then
result := result + (1 shl i);
EscapeCommFunction(hCom, CLRRTS); // RTS = 0
end;
// в конце преобразовапния устанавливаем на #SC +5B
EscapeCommFunction(hCom, SETDTR);
if ResolutionADC = 10 then result := 256 - (result div 2);
if ResolutionADC = 8 then result := 256 - (result * 2)
end;
//--------рабочий цикл программы-------------------
procedure TOscillograph._Run();
var
Freq, Counter, NextCounter: Int64;
i, x0, y0, x, y, Period: Integer;
begin
x0 :=10; y0 := 10+ hh div 2;
QueryPerformanceFrequency(Freq);
QueryPerformanceCounter(Counter); NextCounter := Counter;
while not Application.Terminated do with Canvas do begin
Reset := FALSE;
// Period - время между отсчетами
Period := Round(ADCTime*Freq/1e+6);
Pen.Color := clYellow; Pen.Width := 2;
if ADCTime > 1000 then begin
//вывод координатной сетки на экран
if Assigned(bmGrid) then BitBlt(Canvas.Handle, 10, 10,
ww, hh, bmGrid.Canvas.Handle, 0, 0, SRCCOPY);
//очистка массива
for i := 0 to 1000 - 1 do Data[i] := 0;
for i := 0 to 1000 - 1 do begin
// организация задержки до получения следующего отсчета
repeat
QueryPerformanceCounter(Counter);
until Counter >= NextCounter;
NextCounter := NextCounter + Period;
Data[i] := ReadADC;
x := x0 + i; y := Round(y0 - Data[i]*1.25);
if x < 10 then x := 10; if x > 1010 then x := 1010;
if i = 0 then MoveTo(x, y) else LineTO(x, y);
Application.ProcessMessages;
if Application.Terminated or Reset then Break;
// ожидание пока установлена пауза
while Pause do Application.ProcessMessages;
end;
end;
end;
end;
initialization
{$I unit1.lrs}
end. |
(
