PROGRAM RS232Monitor;
uses CRT,VGA;
CONST CR = #13;
LF = #10;
KOMMA = #44;
(****************************************************)
ComNr:Byte = 2;
BaudRate:LongInt = 19200;
ParityStrg:STRING[4] = 'no'; (* no, odd, even *)
StopBits:Byte = 1;
DataBits:Byte = 8;
(****************************************************)
Type PunkteFeld = Array[1..16383] of Single;
Messdat = Array[1..8180,1..2] of Single;
VAR Parity,COMInitDaten: Byte;
DatenFile: TEXT;
OK,ModemStatusPortNr: Word;
Daten: ARRAY[0..25] OF Char;
Punkte: ^PunkteFeld;
Werte: ^Messdat;
AnzPunkte: Integer;
Filename : String;
xmax,xmin: single;
messnr:integer;
cha:char;
maxx,maxy,minx,miny:single;
zahl:string;
SamplParam:Byte;
counter:integer;
(***************************************************************************)
procedure readfilexy(tfile:string);
var f:text;
t:integer;
maxwert:integer;
begin
assign(f,tfile);
reset(f);
t:=1;
while not eof(f) do begin;
read(f,werte^[t,1],werte^[t,2]);
inc(t,1);
end;
maxwert:=t-1;
close(f);
end;
procedure extremwerte(minw,maxw:integer);
var t:integer;
begin
maxx:=-3.4e38;maxy:=-3.4e38;minx:=3.4e38;miny:=3.4e38;
for t:=minw to maxw do begin
if (werte^[t,1]>maxx) then maxx:=werte^[t,1];
if (werte^[t,1]<minx) then minx:=werte^[t,1];
if (werte^[t,2]>maxy) then maxy:=werte^[t,2];
if (werte^[t,2]<miny) then miny:=werte^[t,2];
end;
end;
procedure plotme(x1,y1,x2,y2:integer;bcol,acol,pcol:byte;wert1,wert2:integer);
{ zeichnet Messdaten in Bereich x1,y1-x2,y2, bcol:
Hintergrundfarbe
acol: Achsenfarbe, Pcol: Zeichenfarbe
wert1,wert2:wertebereich von array werte der
angezeigt werden soll }
var xval,yval,t:integer;
begin;
x1:=round(x1/8)*8; { durch 8 teilbar, f201r textdarstellung}
y1:=round(y1/8)*8+8;
x2:=round(x2/8)*8;
y2:=round(y2/8)*8;
if (x2<(x1+64)) then x2:=x1+64;
if (y2<(y1+104)) then y2:=y1+104;
box(x1,y1,x2,y2,bcol);
line(x1,y1,x2,y1,acol);
line(x1,y2,x2,y2,acol);
line(x1,y1,x1,y2,acol);
line(x2,y1,x2,y2,acol);
line(x1+29,y1+24,x1+29,y2-24,acol);
line(x1+29,y2-24,x2-9,y2-24,acol);
extremwerte(wert1,wert2);
xval:=round((((werte^[wert1,1]-minx)/(maxx-minx))*((x2-10)-(x1+30)))+x1+30);
yval:=y2-25-round(((werte^[wert1,2]-miny)/(maxy-miny))*((y2-25)-(y1+25)));
plot(xval,yval,pcol);if ((wert2-wert1)<=20) then circle(xval,yval,3,pcol);
for t:=wert1+1 to wert2 do begin
xval:=round((((werte^[t,1]-minx)/(maxx-minx))*((x2-10)-(x1+30)))+x1+30);
yval:=y2-25-round(((werte^[t,2]-miny)/(maxy-miny))*((y2-25)-(y1+25)));
if ((wert2-wert1)<=20) then circle(xval,yval,3,pcol);
drawto(xval,yval,pcol);
end;
end;
procedure messzeiger;
begin
graphics($12);
text8;
new(werte);
readfilexy(Filename+zahl+'.dat');
plotme(0,0,630,470,0,7,7,1,AnzPunkte);
dispose(Werte);
cha:=readkey;
textmode;
end;
FUNCTION COMPortAddress(ComNr:Byte):Word;
BEGIN
COMPortAddress:=MemW[$40:2*ComNr-2]; (* AUS BIOS DATENSEGMENT *)
END; (* COMPortAddress
*)
PROCEDURE COMInit(Port,Params:Word);
inline(
$58/
{ POP AX ; Parameter Params
-> AX }
$5A/
{ POP DX ; Portnummer
-> DX }
$B4/$00/
{ MOV AH,0 ; Funktionscode: Initialisierung
}
$CD/$14);
{ INT 14H ; BIOS-Aufruf }
PROCEDURE COMInitialize(InitDaten:Word);
VAR Buf:Word;
BEGIN (* COMInitialize
*)
ModemStatusPortNr:=COMPortAddress(ComNr)+6;
COMInit(Pred(ComNr),InitDaten);
IF BaudRate>9600
THEN BEGIN
Buf:=PortW[ModemStatusPortNr-3];
Buf:=Buf OR $80;
PortW[ModemStatusPortNr-3]:=Buf;
PortW[ModemStatusPortNr-6]:=115200 DIV BaudRate;
Buf:=PortW[ModemStatusPortNr-3];
Buf:=Buf AND $7F;
PortW[ModemStatusPortNr-3]:=Buf;
END;
END; (* COMInitialize
*)
FUNCTION GetBaudRateCOMValue:Word;
BEGIN
CASE BaudRate OF
150:GetBaudRateCOMValue:=32;
300:GetBaudRateCOMValue:=64;
600:GetBaudRateCOMValue:=96;
1200:GetBaudRateCOMValue:=128;
2400:GetBaudRateCOMValue:=160;
4800:GetBaudRateCOMValue:=192;
9600:GetBaudRateCOMValue:=224;
ELSE GetBaudRateCOMValue:=224;
(* hoehere Baudraten
muessen direkt in COMInitialize behandelt werden *
END; (* CASE *)
END; (* GetBaudRateCOMValue
*)
PROCEDURE RS232Daten;
VAR TempCOMInitDatenByte:Byte;
BEGIN (* RS232Daten *)
TempCOMInitDatenByte:=GetBaudRateCOMValue;
IF ParityStrg = 'no' THEN
Parity := 2
ELSE IF ParityStrg = 'odd' THEN
Parity := 1
ELSE IF ParityStrg = 'even' THEN
Parity := 3;
TempCOMInitDatenByte := TempCOMInitDatenByte+(Parity SHL 3);
TempCOMInitDatenByte := TempCOMInitDatenByte+(Pred(StopBits) SHL
TempCOMInitDatenByte := TempCOMInitDatenByte+DataBits-5;
(* MINUS 5 STATT MINUS 7, DA BIT 1 IMMER 1 *)
COMInitDaten := TempCOMInitDatenByte;
END; (* RS232Daten *)
PROCEDURE COMOutchar(Port:Word;Ch:Char);
INLINE(
$58/
{ POP AX ; auszugebendes Zeichen
-> AX (AL) }
$5A/
{ POP DX ; Portnummer -> DX }
$B4/$01/
{ MOV AH,1 ; Funktionscode: Output }
$CD/$14);
{ INT 14H ; BIOS-Aufruf }
PROCEDURE WriteCOMCommand(Strg:STRING);
VAR i: Byte;
BEGIN
FOR i := 1 TO Length(Strg) DO
COMOutChar(Pred(ComNr),Strg[i]);
END; (* WriteCOMCommand
*)
FUNCTION COMInChar(Port:Word):Char;
INLINE(
$5A/
{ POP DX ; Portnummer -> DX }
$B4/$02/
{ MOV AH,2 ; Funktionscode: Input }
$CD/$14);
{ INT 14H ; BIOS-Aufruf }
FUNCTION ReadCOMChar:Char;
BEGIN
ReadCOMChar:=COMInChar(Pred(ComNr));
END; (* ReadCOMChar *)
FUNCTION HohlWert: Single;
VAR i, Code: Integer;
wert : String[25];
Ch: Char;
Ergebnis: Single;
BEGIN
wert := '';
i := 0;
REPEAT
Ch := ReadCOMChar;
UNTIL Ch IN ['-','.','0'..'9'];
Daten[0] := Ch;
REPEAT
inc(i);
wert := wert + Daten[i-1];
Daten[i] := ReadCOMChar;
UNTIL (Daten[i]=CR) OR (Daten[i]=KOMMA);
Val(wert,Ergebnis,Code);
HohlWert := Ergebnis;
END;(*HohlWert*)
FUNCTION TimeBase:Single; {ermittelt Zeitbasis aus dem
Sampling-Parameter}
VAR i: Integer;
{fuer den SR810 Lock-In}
Tb: Single;
BEGIN
Tb := 32;
FOR i := 0 TO SamplParam DO
Tb := Tb/2;
TimeBase := Tb;
END; {Timebase}
PROCEDURE SchreibInFile;
{schreibt das Heap-Punktefeld in
VAR i: Integer;
BEGIN
str(messnr,zahl);
Assign(DatenFile,FileName+zahl+'.dat');
Rewrite(DatenFile);
FOR i := 1 TO AnzPunkte DO
BEGIN
WriteLn(DatenFile,(i-1)*TimeBase,' ',Punkte^
END;
writeln(Datenfile,(Anzpunkte*Timebase+10*TimeBase),'
',xmax);
writeln(Datenfile,(Anzpunkte*Timebase+11*TimeBase),'
',xmin);
Close(DatenFile);
END; {SchreibInFile}
PROCEDURE LiesAusPuffer;
Var z : Integer;
StrZahl: string[6];
HW: Single;
BEGIN
new(Punkte);
{Array wird auf Heap angelegt}
xmax:=-1e30;xmin:=1e30;
FOR z := 0 TO AnzPunkte-1 DO {jetzt wird der Puffer ausgelese
BEGIN;
Str(z, StrZahl);
WriteCOMCommand('TRCA ? 1,'+StrZahl+',1'+LF);
HW := HohlWert;
if HW>xmax then xmax:=HW;
if HW<xmin then xmin:=HW;
{Writeln(z);
Writeln('outp ',HW);
Writeln('***********');}
Punkte^[z+1] := HW;
END; {FOR}
SchreibInFile;
dispose(Punkte);
{Array auf Heap
END; {LiesAusPuffer}
Procedure Eieruhr;
begin
case counter of
1..4 : write(#8,#8,#8,'</>');
5..8 : write(#8,#8,#8,'<->');
9..12 : write(#8,#8,#8,'<\>');
13..16 : write(#8,#8,#8,'<|>');
end;
counter:=counter+1;
if counter=17 then counter:=1;
end;
PROCEDURE InitLockInBuff;
VAR C : Char;
StrZahl : string[6];
hi,lo : integer;
BEGIN
WriteCOMCommand('REST'+LF);
{Reset Datenpuffer}
Str(SamplParam,StrZahl);
{konvertiert Integer in St
WriteCOMCommand('SRAT '+StrZahl+LF); {Samplingrate einstellen}
Write('Start (Taste druecken)');
C := readkey;
{Start Auslesen Aux1}
writeln(' warten auf
Trigger......... ');
WriteCOMCommand('OAUX?
1'+LF); {AUX1 anfordern}
hi:=round(HohlWert);
{Wert von AUX1}
counter:=1;
REPEAT
eieruhr;
lo := hi;
WriteCOMCommand('OAUX? 1'+LF);{AUX1 anfordern}
hi := round(HohlWert); {Wert
von AUX1}
{bis die Spannung auf hoeheren Wert springt (TTL von Wavetek)}
UNTIL hi > lo;
WriteCOMCommand('STRT'+LF);
{Lesen in Puffer starten}
write('los .. ');
WriteCOMCommand('OAUX?
1'+LF); {AUX1 anfordern}
hi := round(HohlWert);
{Wert von AUX1}
REPEAT
eieruhr;
lo := hi;
WriteCOMCommand('OAUX? 1'+LF);{AUX1 anfordern}
hi := round(HohlWert); {Wert
von AUX1}
{writeln(hi);}
{bis die Spannung auf niedrigen Wert springt (TTL von Wavetek)}
UNTIL hi > lo;
write('stop
');
WriteCOMCommand('PAUS'+LF); {Stop Messung in Puffer}
WriteCOMCommand('SPTS ?'+LF); {Anzahl gelesene Datenpunkte anfor
AnzPunkte := Round(HohlWert); {soviele Punkte stehen im Puffer}
writeln;
{C := readkey;
}
LiesAusPuffer;
END; {InitLockInBuff}
(****************************************************************************)
BEGIN { Main }
ClrScr;
Writeln(' ****************
Winzigweich 98 *************** ');
Writeln;
Write('Filename (maximal 6 Buchstaben, keine
Endung): ') ;
Readln(Filename);
Write('SamplingRate (7=8Hz; 8=16Hz; 9=32Hz .....)?');
readln(SamplParam);
Rs232Daten;
COMInitialize(COMInitDaten);
messnr:=1;
repeat
Writeln('Messung Nr.: ',messnr);
InitLockInBuff; {Liest erst in Puffer
und dann in String (hoehere Samplera
messzeiger;
Writeln(AnzPunkte, ' datenpunkte');
writeln('DatenFile ',Filename+zahl+'.dat angelegt');
Writeln('Maximum der Daten: ',xmax,' Minimum
: ',xmin);
writeln('Noch eine Messung? (j/n) ');
cha:=readkey;
writeln('************************************************************');
writeln;
messnr:=messnr+1;
until (cha='n') or (cha='N');
END. { Main }