program signalausgabe;
uses crt,dos,printer,graph;
type names = array[1..15] of string[50];
fentype = record obx,oby,unx,uny,z :integer;
p :pointer;
namen :names;
nralt :integer; end;
masstype = record x,y : real; end;
xeinheiten = (Freq,Zeit,Adr);
yeinheiten = (Volt,Proz,Pix);
einheitentype = record x : xeinheiten;
y : yeinheiten; end;
schnittstelle = (LPT1,LPT2,LPT3,LPT4);
const v1 : array[1..5] of pointtype = ((x:0;y:0),(x:639;y:0),
(x:639;y:12),(x:0;y:12),(x:0;y:0));
v2 : array[1..4] of pointtype = ((x:0;y:424),(x:639;y:424),
(x:639;y:439),(x:0;y:439));
max {von feld} =4095;
var xeinh : array[0..2] of string[3];
yeinh : array[0..2] of string[3];
mass : masstype;
quarz,maxfeld : longint;
drucker : schnittstelle;
impulse : array[0..max] of byte;
i,k,nralt : integer;
gd,gm : integer;
x,y,taste : word;
fen : byte;
fe : array[1..5] of fentype;
abbr : boolean;
fname : string;
path : pathstr;
einh : einheitentype;
s : string[120];
perzahl : integer;
impanf,impend : real;
a : char;
IO : boolean;
{$I set16.inc}
function break:boolean;
begin
break:=(mem[0:0471] and $80 )=$80;
end;
procedure breakreset;
begin
mem[0:0471]:=mem[0:0471] and $7f;
end;
procedure positionsanzeige;
var regs :registers;
t1,t0 :string[10];
begin
setviewport(539,339,639,349,true); {Anzeige der momentanen}
regs.ax:=3; {Mausposition}
intr($33,regs);
str(regs.cx,t0);
str(regs.dx,t1);
clearviewport;
setcolor(15);
outtextxy (1,2,t0);
outtextxy (41,2,t1);
setviewport(0,0,639,349,true);
end;
procedure statuszeile;
function space(ende:integer):string;
var i : integer;
s : string;
begin
s:='';
for i:=1 to ende do s:=s+' ';
space:=s;
end;
begin
setcolor(9);
bar(0,339,500,349);
setcolor(2);
if length(path)<25 then s:=path+space(25-length(path)) else s:=space(25);
outtextxy(0,341,s+' X-Einheit: '+xeinh[ord(einh.x)]+' Y-Einheit: '+yeinh[ord(einh.y)]);
setviewport(0,0,639,349,true);
positionsanzeige;
end;
procedure botten(var bot,xpos,ypos:word);
var regs : registers;
a : char;
begin
regs.ax:=3;
intr($33,regs);
xpos:=regs.cx;
ypos:=regs.dx;
bot:=regs.bx;
while regs.bx<>0 do begin
regs.ax:=3;
intr($33,regs)
end;
if break then bot:=2;
if bot=2 then abbr:=true;
end;
procedure maus(da:boolean);
var regs :registers;
begin
if da then regs.ax:=1 {Mauscurser sichtbar }
else regs.ax:=2; {unsichtbar machen}
intr($33,regs);
end;
procedure mouse;
var regs :registers;
m :boolean;
const seite = 0;
begin
m:=false;
regs.ax:=0; {Maus initialisieren}
intr($33,regs);
if regs.ax=65535 then m:=true
else outtextxy(0,2,'keine Maus vorhanden...');
if m then begin
regs.ax:=4; {Mausposition festlegen}
regs.cx:=10;
regs.dx:=10;
intr($33,regs);
regs.ax:=8; {y-Begrenzung}
regs.cx:=0;
regs.dx:=347;
intr($33,regs);
regs.ax:=7; {x-Begrenzung}
regs.cx:=0;
regs.dx:=637;
intr($33,regs);
regs.ax:=29; {Maus auf momentaner Seite}
regs.bx:=seite;
intr($33,regs);
end;
end;
procedure setwindow (x1,y1: integer; namen: string);
var feld : array[1..20] of string[1];
anf : integer;
size : word;
D : pointer;
begin
inc(fen);
maus(false);
k:=0; anf:=1; fe[fen].unx:=0;
for i:=1 to length(namen)+1 do
if ( (namen[i]=',') or (i=length(namen)+1) ) then begin
inc(k);
fe[fen].namen[k] := copy(namen,anf,i-anf);
feld[k] := namen[anf];
if (fe[fen].unx < (i-anf)) then fe[fen].unx:= (i-anf);
anf:=i+1;
end;
with fe[fen] do begin
obx:= x1; oby:= y1;
unx:= unx*8+16+obx;
uny:= k*10+14+oby;
z := k;
Size := ImageSize(obx,oby,unx,uny);
GetMem(p, Size);
GetImage(obx,oby,unx,uny,p^);
setviewport(obx,oby,unx,uny,true);
clearviewport;
setviewport(0,0,639,349,true);
setcolor(15);
bar(obx,oby,unx,uny);
setcolor(1);
rectangle(obx+3,oby+4,unx-3,uny-4);
for i:=1 to k do
outtextxy(obx+8,i*10+oby-2, fe[fen].namen[i]);
nralt:=1;
size:= imagesize(obx+5,oby-4+nralt*10,unx-5,oby+6+nralt*10);
getmem ( D, size);
getimage(obx+5,oby-4+nralt*10,unx-5,oby+6+nralt*10,D^);
putimage(obx+5,oby-4+nralt*10,D^,notput);
freemem( D, size);
maus(true);
end;
end;
function abfrage : byte;
var hilf : byte;
nr : integer;
size : word;
D : pointer;
a : char;
anf : boolean;
begin
hilf:=0;
taste:=0;
with fe[fen] do begin
repeat
botten(taste,x,y);
if (x<unx) and (x>obx) then begin
nr:=(y-oby+4) div 10;
if nr>z then nr:=z;
if nr<1 then nr:=1;
if taste=1 then hilf:=nr;
if nralt<>nr then begin
maus(false);
size:= imagesize(obx+5,oby-4+nr*10,unx-5,oby+6+nr*10);
getmem ( D, size);
getimage(obx+5,oby-4+nr*10,unx-5,oby+6+nr*10,D^);
putimage(obx+5,oby-4+nr*10,D^,notput);
getimage(obx+5,oby-4+nralt*10,unx-5,oby+6+nralt*10,D^);
putimage(obx+5,oby-4+nralt*10,D^,notput);
freemem( D, size);
nralt:=nr;
maus(true);
end;
if keypressed and not abbr then begin
a:=readkey;
for i:=1 to z do
if namen[i,1]=a then hilf:=i;
end;
end;
if break then abbr:=true;
until (hilf>0) or abbr;
end;
abfrage:=hilf;
end;
procedure delwindow ;
var size : word;
D : pointer;
begin
if fen<>0 then begin
maus(false);
with fe[fen] do begin
setviewport(obx,oby,unx,uny,true);
Clearviewport;
setviewport(0,0,639,349,true);
Size := ImageSize(obx,oby,unx,uny);
putImage(obx,oby,p^, NormalPut);
freemem(p,size);
end;
dec(fen);
maus(true);
end;
end;
procedure zahleingabe(ox,oy:integer;maxwert:real;var gueltig:boolean;var zahl:real);
var i : integer;
st : string[10];
c : array [0..100] of char;
code : word;
begin
i:=0; gueltig:=false;
st:='';
repeat
repeat
botten(x,y,taste)
until keypressed or abbr;
if not abbr then begin
inc(i);
c[i]:= readkey;
if (c[i]=chr(13)) or (i=8) then begin
val(st,zahl,code);
gueltig:=true;
if ((code<>0) or (zahl>maxwert) or (zahl<0)) then begin
gueltig:=false;
st:='';
maus(false);
setviewport(ox+8,oy,ox+64,oy+8,true);
clearviewport;
outtextxy(0,0,'falsch');
delay(2000);
clearviewport;
setviewport(0,0,639,349,true);
maus(true);
i:=0;
end; { of if ((code..}
end else begin
st:=st+c[i];
outtextxy(ox+i*8,oy,c[i]);
end;
end;
until gueltig or abbr;;
end;
procedure bild;
begin
repeat delwindow until fen=0;
maus(false);
setviewport(0,11,639,338,true);
clearviewport;
setviewport(0,0,639,349,true);
setlinestyle(dottedln,0,normwidth);
setcolor(3);
for i:=1 to 26 do line(10,296-i*10,630,296-i*10);
for i:=1 to 10 do line(10+i*64,35,10+i*64,305);
setcolor(7);
for i:=1 to 5 do line(10,296-i*50,630,296-i*50);
setcolor(14);
line(266,30,266,310); line(522,30,522,310);
setlinestyle(solidln ,0,normwidth);
line(10,296,630,296);
maus(true);
end;
procedure bemaszung;
type zif = string[8];
var st : zif;
hilf : real;
komma : byte;
function wandeln( zahl:real; stellen:integer ): zif;
var help : integer;
st1 : string[3];
st2 : string[5];
begin
str( trunc(zahl) , st2 );
case stellen of 0 : st1:='';
1 : begin
str( trunc(10*(abs(zahl)-abs(int(zahl)))),st1);
st1:= '.'+st1;
end;
2 : begin
str( trunc(100*(abs(zahl)-abs(int(zahl)))),st1);
st1:= '.'+st1;
end;
end;
wandeln:=st2+st1; { of case }
end;
begin
maus(false);
setviewport(0,41,30,299,true);
clearviewport;
setviewport(0,0,639,349,true);
with einh do begin
case y of Volt: st:=wandeln(5.0,1);
Proz: st:=wandeln(98.0,1);
Pix : str(250,st); end;
outtextxy(0,41,st);
case y of Volt: st:=wandeln(4.7,1);
Proz: st:=wandeln(78.4,1);
Pix : str(200,st); end;
outtextxy(0,91,st);
case y of Volt: st:=wandeln(4.4,1);
Proz: st:=wandeln(58.8,1);
Pix : str(150,st); end;
outtextxy(0,141,st);
case y of Volt: st:=wandeln(4.1,1);
Proz: st:=wandeln(39.2,1);
Pix : str(100,st); end;
outtextxy(0,191,st);
case y of Volt: st:=wandeln(3.8,1);
Proz: st:=wandeln(19.6,1);
Pix : str(50,st); end;
outtextxy(0,241,st);
case y of Volt: st:=wandeln(3.5,1);
Proz: str(0,st);
Pix : str(0,st); end;
outtextxy(0,291,st);
end;
setviewport(7,297,639,306,true);
clearviewport;
setviewport(0,0,639,349,true);
with einh do begin
case x of Adr : impend:= (maxfeld+1)/perzahl;
Zeit : impend:= (maxfeld+1)/quarz / perzahl;
Freq : impend:= 1000.0*perzahl*quarz/(maxfeld+1); end;
case x of Freq : begin komma:=0; impend:=round(impend) end;
Adr : komma:=0;
Zeit : komma:=2; end;
st:=wandeln ( impend , komma );
outtextxy(512,298,st);
if x=Freq then st:=''
else begin
hilf:=impanf-(impend-impanf)/4;
st:=wandeln(hilf,komma); end;
outtextxy(192,298,st);
if x=Freq then hilf:=impend*4
else hilf:=impanf+(impend-impanf)/4;
st:=wandeln(hilf,komma);
outtextxy(320,298,st);
if x=Freq then hilf:=impend*2
else hilf:=impanf+(impend-impanf)/2;
st:=wandeln(hilf,komma);
outtextxy(384,298,st);
if x=Freq then st:=''
else begin
hilf:=impend-(impend-impanf)/4;
st:=wandeln(hilf,komma); end;
outtextxy(448,298,st);
if x=Freq then st:=''
else st:=wandeln(impanf,komma);
outtextxy(256,298,st);
end;
maus(true);
end;
procedure darstellen;
var perlaenge : integer;
help : real;
begin
k:=0;
maus(false);
perlaenge := trunc((maxfeld+1)/perzahl);
for i:=0 to perlaenge-1 do begin
if perlaenge>255 then begin
putpixel(10 + round(256.0*i/perlaenge),296-impulse[maxfeld+1-perlaenge+i],10);
if perzahl=1 then
putpixel(522+ round(256.0*i/perlaenge),296-impulse[i],10)
else
putpixel(522+ round(256.0*i/perlaenge),296-impulse[perlaenge+i],10);
putpixel(266+ round(256.0*i/perlaenge),296-impulse[i],15);
end else begin
setcolor(10);
help:= 256 / perlaenge;
line(round(10+i*help),296-impulse[maxfeld+1-perlaenge+i],round(10+help*(i+1)),296-impulse[maxfeld+1-perlaenge+i]);
if perzahl=1 then
line(round(522+i*help),296-impulse[i],round(522+help*(i+1)),296-impulse[i])
else
line(round(522+i*help),296-impulse[perlaenge+i],round(522+help*(i+1)),296-impulse[perlaenge+i]);
if i > 0 then begin
line(round( 10+i*help), 296-impulse[maxfeld-perlaenge+i],round(10+i*help),296-impulse[maxfeld+1-perlaenge+i]);
line(round(522+i*help), 296-impulse[perlaenge+i-1],round(522+i*help),296-impulse[perlaenge+i]);
setcolor(15);
line(round(266+i*help),296-impulse[i-1],round(266+i*help),296-impulse[i]);
end;
setcolor(15);
line(round(266+i*help),296-impulse[i],round(266+help*(i+1)),296-impulse[i]);
end;
end;
maus(true);
end;
procedure files;
var nr :byte;
procedure dir (var path:pathstr;var fname:string);
var i : integer;
erstlauf :boolean;
f :file;
DirInfo : SearchRec;
back : char;
sizeinv, sizep : word;
p ,inv : pointer;
attr : word;
anz, ox, oy, ux, uy, ze,
sp, spalt, zealt : integer;
begin
sizep:=imagesize(50,100,590,250);
getmem(p,sizep);
maus(false);
getimage(50,100,590,250,p^);
maus(true);
repeat
setcolor(15);
maus(false);
bar(50,100,590,250);
setcolor(1);
rectangle(52,106,588,248);
setcolor(15);
bar(200,100,210+length(path)*8,108);
setcolor(1);
outtextxy(205,102,path);
anz:=0;
attr:=$3f; DirInfo.Name:='*.*';
FindFirst(path+fname, attr, DirInfo);
while (DosError = 0) and (anz<36) do begin
if dirinfo.attr=16 then
if (dirinfo.name='.') or (dirinfo.name='..')
then back:=' ' else back:='\'
else back:=' ';
outtextxy(70+(anz mod 4)*130,120+(anz div 4)*15,dirinfo.name+back);
FindNext( DirInfo);
inc(anz);
end;
maus(true);
spalt:=1; zealt:=1;
ox:=69+spalt*130; oy:=118+zealt*15;
ux:=71+spalt*130+98; uy:=120+zealt*15+8;
sizeinv:=imagesize(ox,oy,ux,uy);
getmem(inv,sizeinv);
spalt:=-1; zealt:=-1;
erstlauf:=true;
repeat;
botten(taste,x,y);
if x<70 then x:=70; if y<120 then y:=120;
sp:=(x-70) div 130; ze:=(y-120) div 15;
if sp>3 then sp:=3; if ze>8 then ze:=8;
if ze*4+sp+1>anz then begin
sp:=(anz-1) mod 4;
ze:=(anz-1) div 4;
end;
if (sp<>spalt) or (ze<>zealt) then begin
spalt:=sp; zealt:=ze;
maus(false);
if not(erstlauf) then begin
getimage(ox,oy,ux,uy,inv^);
putimage(ox,oy,inv^,notput);
end else erstlauf:=false;
ox:=69+sp*130; oy:=118+ze*15;
ux:=71+sp*130+98; uy:=120+ze*15+8;
getimage(ox,oy,ux,uy,inv^);
putimage(ox,oy,inv^,notput);
maus(true);
end;
until taste<>0;
freemem(inv,sizeinv);
if taste=1 then begin
anz:=0;
attr:=$3f;
FindFirst(path+fname, attr, DirInfo);
while (DosError = 0) and (anz<sp+4*ze) do begin
FindNext( DirInfo);
inc(anz);
end;
if dirinfo.name='..' then begin
taste:=0;
i:=length (path)-1;
repeat
dec(i);
until (path[i]='\') or (i<0);
delete (path,i,length(path)-i);
end;
if (dirinfo.attr=$10) and (dirinfo.name='.') then
taste:=2;
with dirinfo do
if (attr=$10) and (name<>'.') and (name<>'..') then
path:=path+name+'\';
if fname<>'*.*' then begin
fname:=dirinfo.name;
taste:=2;
end;
end;
until taste=2;
maus(false);
putimage(50,100,p^,normalput);
maus(true);
freemem(p,sizep);
end;
procedure laden;
procedure signal;
var nr,temp : byte;
f : file of byte;
i : integer;
begin
fname:='*.sig';
dir(path,fname);
delwindow;
if length(fname)>3 then
if copy(fname,length(fname)-2,3)='SIG' then begin
assign(f,path+fname);
reset(f);
for i:=0 to maxfeld do begin
read(f,temp);
impulse[i]:=temp;
end;
end;
end;
procedure samples;
type ptype=array[1..65535] of Byte;
var
p : pointer;
p1, p2 : ^ptype;
i : integer;
menge1, menge2, p1ofs, p2ofs, p1seg, p2seg : word;
druckerport : word;
frequenz : real;
procedure speichermangel;
begin
restorecrtmode;
writeln('nicht genügend Speicher frei!');
halt(0);
end;
procedure einlesen(path:pathstr;fname:string);
var f : file;
begin
assign(f,path+fname);
{$I-} reset(f,256) {$I+};
if IOResult<>0 then begin
Restorecrtmode;
writeln('datei nicht gefunden!');
halt(0);
end;
blockread(f,p1^,255,menge1);
if menge1=255 then
blockread(f,p2^,255,menge2);
close(f);
end;
procedure Auslesen(p: pointer; menge:word);
var pofs, pseg : word;
druckerport : word;
begin
pofs:=ofs(p^); pseg:=seg(p^);
druckerport:=memw[0:($408+ord(drucker)*2)];
asm
push ax
PUSH DX
PUSH bx
PUSH es
push si
MOV DX,druckerport
MOV es,pseg
MOV bx,pofs
mov si,0000
@schl1: IN al,$42
@schl2: mov ah,al
in al,$42
cmp ah,al
jnc @schl2
cmp ah,$08
jnc @schl2
MOV al,es:[bx]+si
out dx,al
inc si
cmp si,menge
jnz @schl1
pop si
POP es
POP bx
POP DX
pop ax
end;
end;
begin
druckerport:=memw[0:($408+ord(drucker)*2)];
port[druckerport+2]:=port[druckerport+2] or $05;
fname:='*.dig';
dir(path,fname);
mark(p);
if maxavail<65536 then speichermangel;
new(p1);
if maxavail<65536 then speichermangel;
new(p2);
Einlesen(path,fname);
s:='Welche Abspielfrequenz soll genutzt werden? ';
s:=s+', kHz';
setwindow(100,100,s);
zahleingabe(170,120,30000,IO,frequenz);
if IO then begin
port[$61]:=(port[$61] and $fc) or $01; {timer-gate freigeben}
port[$43]:=$96; {timer als frequenzteiler}
if frequenz<6 then frequenz:=6;
i:=trunc(1700/frequenz);
if i>255 then i:=255;
port[$42]:=lo(i); {teilerfaktor}
repeat
Auslesen(p1,(menge1)*256);
if menge1=255 then auslesen(p2,(menge2)*256);
until keypressed;
end;
delwindow;
release(p);
end;
procedure daten;
var nr,hilf : byte;
f : file of single;
i,datlaenge,ver : integer;
temp,min,max,freq : single;
begin
fname:='*.dat';
dir(path,fname);
delwindow;
{$I+}
if length(fname)>3 then
if copy(fname,length(fname)-2,3)='DAT' then begin
assign(f,path+fname);
reset(f);
min:=0;
max:=0;
read(f,temp); datlaenge:=trunc(temp);
read(f,freq);
read(f,temp);
read(f,temp);
for i:=0 to datlaenge-1 do begin
read(f,temp);
if temp>max then max:=temp;
if temp<min then min:=temp;
end;
close(f);
reset(f);
for i:=0 to 3 do read(f,temp);
if freq<quarz then ver:=(maxfeld+1) div 2;
for i:=0 to datlaenge-1 do begin
read(f,temp);
hilf:=trunc((temp-min)/(max-min)*255);
if freq<Quarz then begin
impulse[i+ver]:=hilf;
impulse[i]:=hilf;
end else begin
impulse[i*2+1]:=hilf;
impulse[i*2]:=hilf;
end;
end;
close(f);
{$I+}
end;
if IOResult<>0 then begin
setwindow(100,100,'Fehler beim Lesen der dat-Datei');
delay(3000);
delwindow;
end;
end;
begin
setwindow(50,30,'*.sig,*.dig,*.dat ');
nr:= abfrage;
case nr of 1: signal;
2: samples;
3: daten; end; {of case}
delwindow;
bild;
darstellen;
bemaszung;
end;
procedure speichern;
var i : integer;
a : char;
temp : byte;
f : file of byte;
begin
setwindow(50,30,'Name der Signalform, max. 8 Buchstaben :, ');
i:=1;
fname:='';
repeat
repeat
botten(x,y,taste);
until keypressed or abbr;
if not abbr then begin
a:=readkey;
if a<>chr(13) then begin
outtextxy(70+i*8,60,a);
inc (i);
fname:=fname+a;
end else begin
i:=9;
fname:=fname+'.sig';
end; {of if a<>..}
end; {of if not abbr..}
until (i=9) or abbr;
if not abbr then begin
assign(f,path+fname);
{$I-}
reset(f);
close(f);
{$I+}
if IOResult=0 then begin
setwindow(100,100,'File existiert schon,Schreiben wird abgebrochen !');
delay(4000);
delwindow;
end else begin
{$I-}
rewrite (f);
{$I+}
if IOResult=3 then begin
setwindow(100,100,'Path existiert nicht !,Bitte mit <Dir> einen neuen einstellen.');
delay(4000);
delwindow;
end else
for i:=0 to maxfeld do begin
temp:=impulse[i];
write(f,temp);
end;
end;
end;
delwindow;
end;
procedure direktory;
begin
fname:='*.*';
dir(path,fname);
statuszeile;
end;
procedure neu;
begin
for i:=0 to maxfeld do
impulse[i]:=0;
delwindow;
bild;
bemaszung;
end;
begin
setwindow (20,11,'laden,speichern ,dir,neu,quit');
nr:=abfrage;
if not abbr then begin
case nr of 1: laden;
2: speichern;
3: direktory;
4: neu;
5: halt;
end; {of case}
positionsanzeige;
end; {of if abbr..}
delwindow;
end;
procedure skalierung;
var nr :byte;
begin
fen:=0;
S:='Frequenz,Zeitdauer,Adresse,-------------,Volt,Prozent,Pixel';
setwindow (120,11,S);
nr:=abfrage;
if not abbr then
with einh do
case nr of 1: x:=Freq;
2: x:=Zeit;
3: x:=Adr;
5: y:=Volt;
6: y:=Proz;
7: y:=Pix;
end;
if not abbr then begin
statuszeile;
bemaszung;
end;
delwindow;
end;
procedure edit;
var nr : byte;
ox,oy : integer;
hilf,perlaenge : real;
procedure intervallaenge;
var str : string[4];
begin
S:='Intervallänge ';
if einh.x<>Adr then S:=S+'in '+xeinh[ord(einh.x)];
S:=S+' eingeben :';
S:=S+' ';
setwindow(250,100,S);
setcolor(15);
zahleingabe(500,108,8000,IO,mass.x);
if IO then begin
case einh.x of
Freq: begin
perzahl := trunc( mass.x/1000*(maxfeld+1)/quarz);
impend := perzahl / (maxfeld+1)*quarz;
end;
Zeit: begin
mass.x:= mass.x * quarz;
impend:= trunc(mass.x)/quarz;
perzahl:= trunc((maxfeld+1)/quarz / impend );
end;
Adr: begin
perzahl:=trunc((maxfeld+1)/mass.x);
impend :=mass.x;
end;
end; { of case }
if perzahl<1 then perzahl:=1;
if perzahl>maxfeld then perzahl:=maxfeld;
perlaenge:=(maxfeld+1)/perzahl;
end; {of if IO..}
end;
procedure amplitude;
begin
S:='Amplitude in '+yeinh[ord(einh.y)]+' eingeben : ';
setwindow(250,150,S);
setcolor(15);
zahleingabe(460,158,255,IO,mass.y);
if IO then begin
case einh.y of Volt: mass.y := mass.y*255/1.5;
Proz: mass.y := mass.y*255/200;
end;
if mass.y>127 then mass.y:=127;
end;
end;
procedure intervall;
var intl,lauf,anz : integer;
maxy : real;
int : array[0..127] of byte;
i : integer;
begin
abbr:=false;
delwindow;
delwindow;
lauf:= 0;
bild;
statuszeile;
outtextxy(10,310,'Eingabe der Werte');
case einh.y of Volt : maxy:= 5.0;
Proz : maxy:= 100;
Pix : maxy:= 255;
end; { of case }
for i:=0 to round(perlaenge-1) do begin
zahleingabe(200+lauf*48,310,maxy,IO,hilf);
if IO then begin
case einh.y of Volt : if hilf<3.5 then hilf:= 3.5;
Proz,Pix : if hilf<0 then hilf:= 0;
end;
case einh.y of Volt : hilf := (hilf-3.5)*255/1.5;
Proz : hilf := hilf*255/100;
end;
impulse[i]:= round(hilf);
setcolor(15);
if perlaenge>255 then begin
putpixel(266+ round(256.0*i/perlaenge),296-impulse[i],15);
end else begin
hilf:= 256 / perlaenge;
if i > 0 then begin
line(round(266+i*hilf),296-impulse[i-1],round(266+i*hilf),296-impulse[i]);
end;
line(round(266+i*hilf),296-impulse[i],round(266+hilf*(i+1)),296-impulse[i]);
end;
if lauf<7 then inc(lauf)
else begin
lauf:=0;
maus(false);
setviewport(200,300,639,338,true);
clearviewport;
setviewport(0,0,639,349,true);
maus(true);
end;
end else i:=round(perlaenge-1);
end;
maus(false);
setviewport(0,300,639,349,true);
clearviewport;
setviewport(0,0,639,349,true);
maus(true);
if IO then
for k:=0 to perzahl-1 do
for i:=0 to trunc(perlaenge-1) do impulse[k*trunc(perlaenge)+i]:=impulse[i];
end;
procedure sinus;
begin
for i:=0 to maxfeld do
impulse [i] := trunc(sin(i*2*pi/perlaenge)* mass.y +128 );
end;
procedure rechteck;
var perlaenge : real;
begin
perlaenge:=(maxfeld+1)/perzahl;
for i:=0 to maxfeld do begin
hilf:=i/perlaenge;
hilf:=(hilf-trunc(hilf))*perlaenge;
if hilf<((perlaenge-1)/2) then impulse[i]:=trunc(128+mass.y)
else impulse[i]:=trunc(128-mass.y);
end;
end;
procedure dreieck;
begin
for i:=0 to maxfeld do begin
hilf:=i/perlaenge;
if (hilf-trunc(hilf))<0.5 then
impulse [i] := trunc(128+(hilf-trunc(hilf))*mass.y*2)
else
impulse [i] := trunc(128-(hilf-trunc(hilf)-1)*mass.y*2);
end;
end;
procedure saegezahn;
begin
for i:=0 to maxfeld do begin
hilf:=i/perlaenge;
impulse [i] := trunc((hilf-trunc(hilf))*mass.y+128);
end;
end;
procedure verschieben;
begin
end;
begin
S:='Einzelpunkte ,Sinus,Rechteck,Dreieck,Saegezahn,Verschieben ';
setwindow (270,11,S);
nr:=abfrage;
if not abbr then intervallaenge;
if not abbr then
if (nr<>1) and (nr<>6) then amplitude;
if not abbr then
case nr of 1: intervall;
2: sinus;
3: rechteck;
4: dreieck;
5: saegezahn;
6: verschieben;
end; {of case}
bild;
darstellen;
statuszeile;
bemaszung;
positionsanzeige;
end;
procedure ausgabe;
var druckerport : word;
regs : registers;
begin
setwindow (100,100,'Die Daten werden an das Modul übergeben!, Bitte warten.');
druckerport:=memw[0:($408+ord(drucker)*2)];
if druckerport=0 then begin
setwindow (100,130,'Printerkarte nicht im BIOS-Eingetragen!');
delay(2000);
delwindow;
abbr:=true;
end;
if not abbr then begin
regs.ah:=01;
regs.dx:=ord(drucker);
intr($17,regs);
if (regs.ah and $08)<>$0 then begin
abbr:=true;
end;
end;
if not abbr then begin
port[druckerport+2]:=port[druckerport+2] or $04;
for i:=0 to maxfeld do begin
port[druckerport]:=impulse[i];
delay(1);
port[druckerport+2]:=port[druckerport+2] or 01;
delay(1);
port[druckerport+2]:=port[druckerport+2] and $fe;
delay(1);
end;
port[druckerport+2]:=port[druckerport+2] and $fb;
end;
delwindow;
end;
procedure config_file_lesen;
var f : text;
temp : string;
begin
assign(f,'gen.cfg');
{$I-} reset(f) {$I+};
if ioresult<>0 then begin
writeln('gen.cfg nicht gefunden!');
halt(0);
end;
readln(f,path);
readln(f,temp);
if pos(temp,'Freq')>0 then einh.x:=Freq else
if pos(temp,'Zeit')>0 then einh.x:=Zeit else
if pos(temp,'Adr')<0 then einh.x:=Adr;
readln(f,temp);
if pos(temp,'Volt')>0 then einh.y:=Volt else
if pos(temp,'Proz')>0 then einh.y:=Proz else
if pos(temp,'Pix')<0 then einh.y:=Pix;
readln(f,quarz);
readln(f,maxfeld);
readln(f,temp);
if pos(temp,'LPT1')>0 then drucker:=LPT1 else
if pos(temp,'LPT2')>0 then drucker:=LPT2 else
if pos(temp,'LPT3')>0 then drucker:=LPT3 else
if pos(temp,'LPT4')>0 then drucker:=LPT4;
close(f);
end;
begin {Hauptprogramm}
Clrscr;
config_file_lesen;
gd:=9;gm:=1; {Graph initialisieren}
initgraph(gd,gm,'');
if GraphResult <> grOk then begin
writeln('Grafiktreiber nicht gefunden !');
Halt(0);
end;
farbe; {ordnen der ersten 16}
{Eintraege in der Palette}
mouse;
xeinh[0]:='kHz'; yeinh[0]:='V';
xeinh[1]:='µs '; yeinh[1]:='%';
xeinh[2]:='Adr'; yeinh[2]:='Pix';
setcolor(9);
bar(0,0,639,10);
setcolor(2);
outtextxy(0,2,' Datei Skalierung Edit Ausgabe');
setviewport(0,0,639,349,true);
maus(true);
fen:=0;
impanf:= 0;
impend:= 250;
perzahl:= 1;
statuszeile;
repeat
botten(taste,x,y);
if taste = 1 then begin
k:= x div 130;
if y<12 then begin
abbr:=false;
breakreset;
case k of 0: files;
1: skalierung;
2: edit;
3: ausgabe;
end; {of case}
end;
end; {of if}
positionsanzeige ;
while keypressed do a:=readkey;
until false=true;
closegraph;
end.
| Detected encoding: OEM (CP437) | 1
|
|
|