program gen2;
{Windows-Version h#s 03/03}
{$D Funktionsgenerator}
{$C MOVEABLE PRELOAD PERMANENT} {gleiche Attribute wie Unit SYSTEM}
{$R gen2}
{$M $3000,$1000}
{$N+}
uses WinProcs,WinTypes,Win31,CommDlg,DDEML,MMSystem,
WUtils,Win311,ToolStat,QSort;
type
Axeinheit=(Freq,Zeit,Adr);
Ayeinheit=(Volt,Proz,Pix);
TEinheit=record
x: Axeinheit;
y: Ayeinheit;
end;
type
TReal=Single;
const
AppNam: array[0..4] of Char='GEN2';
HelpFileName: array[0..8] of Char='GEN2.HLP';
MAXPERI=2048; {Anzahl Perioden, ergibt 2 Stützstellen pro Periode, 4MHz}
nSamples=4096; {Anzahl der Samples, 4K}
quarz: TReal=8E6; {Samplerate, kann geändert werden}
TPTick =nSamples div 4;{Skalenteil im 2½-Perioden-Modus}
TPLeft =-nSamples; {X-Koordinate links im 2½-Perioden-Modus}
TPRight=(nSamples-1600)*nSamples div 1600; {dito rechts}
WM_TakeCoord=WM_User+10;
const
xeinh: array[Axeinheit] of PChar=('kHz','╡s','Sa');
yeinh: array[Ayeinheit] of PChar=('V','%','lsb');
var
OutRect: TRect;
sDecimal: array[0..1] of Char; {Dezimalpunkt aus WIN.INI}
Kreuz: TPoint; {Fadenkreuz-Koordinaten}
KBHand: HWnd;
TwoPeriods: Bool; {Umschalter X-Achse = ganz oder 2½ Perioden}
xperiods: Integer; {Signal-Perioden in den 4096 Samples}
LPT: Integer;
sample: array[0..4095] of byte;
fname: TS255;
einh: Teinheit;
procedure statuszeile; {Statuszeile zeichnen}
var s: TS31;
begin
SendMessageP(Status,SB_SetText,0,GetFileNamePtr(fname));
wvsprintf(s,'X-Einheit: %s',xeinh[einh.x]);
SendMessageP(Status,SB_SetText,2,@s);
wvsprintf(s,'Y-Einheit: %s',yeinh[einh.y]);
SendMessageP(Status,SB_SetText,3,@s);
end;
function S2Real(S:PChar; var Z:TReal): Boolean;
var
ec: Integer;
ZZ: TReal;
sp:PChar;
begin
sp:=lstrchr(s,',');
if sp<>nil then sp^:='.';
Val(S,ZZ,ec);
if ec=0 then Z:=ZZ;
S2Real:=ec=0;
end;
procedure Real2S(Z:TReal; nk:Integer; s:PChar);
type
PS31=^TS31;
begin
Str(Z:nk:nk,PS31(s)^);
s:=lstrchr(s,'.');
if s<>nil then s^:=sDecimal[0];
end;
function Pix2Volt(i:Integer):TReal;
begin Pix2Volt:=3.5+i*1.5/250 end;
function Pix2Proz(i:Integer):TReal;
begin Pix2Proz:=i*100/255 end;
function Adr2Zeit(i:Integer):TReal;
begin Adr2Zeit:=i*1E6/quarz end;
function Adr2Freq(i:Integer):TReal;
begin
if i=0
then Adr2Freq:=0
else Adr2Freq:=quarz*1E-3/i
end;
procedure y2s(i:Integer; s:PChar);
begin
case einh.y of
Volt: Real2S(Pix2Volt(i),2,s);
Proz: Real2S(Pix2Proz(i),1,s);
Pix: wvsprintf(s,'%d',i);
end;
end;
procedure x2s(i:Integer; s:PChar);
begin
case einh.x of
Adr: wvsprintf(s,'%d',i);
Zeit: Real2S(Adr2Zeit(i),2,s);
Freq: Real2S(Adr2Freq(i),2,s);
end;
end;
function KreuzInside:Boolean;
{Testet, ob die Variable <Kreuz> darstellbare Koordinaten hat}
begin
KreuzInside:=(Word(Kreuz.y)<=255) and (
TwoPeriods and (Kreuz.x>=TPLeft div xperiods)
and (Kreuz.x<TPRight div xperiods)
or not TwoPeriods and (Word(Kreuz.x)<nSamples));
end;
procedure positionsanzeige;
{Anzeige der momentanen Mausposition}
var
s: TS63;
s1,s2:TS31;
vsrec: array[0..3] of PChar;
begin
if KreuzInside then begin
vsrec[0]:=s1; x2s(Kreuz.x,s1);
vsrec[1]:=xeinh[einh.x];
vsrec[2]:=s2; y2s(Kreuz.y,s2);
vsrec[3]:=yeinh[einh.y];
wvsprintf(s,'X=%s %s, Y=%s %s',vsrec);
end else s[0]:=#0;
SendMessageP(Status,SB_SetText,4,@s);
end;
procedure Line(dc:HDC; x1,y1,x2,y2:Integer);
begin
MoveTo(dc,x1,y1);
LineTo(dc,x2,y2);
end;
procedure OutText(dc:HDC; x,y:Integer; s:PChar);
begin
TextOut(dc,x,y,s,lstrlen(s));
end;
procedure SetMapping(dc:HDC);
{Setzt einen Mapping-Modus für die direkte Adressierung von Sample-Daten}
begin
SetMapMode(dc,MM_Anisotropic);
SetWindowOrg(dc,0,0);
SetWindowExt(dc,nSamples-1,255);
SetViewportOrg(dc,OutRect.left,OutRect.bottom);
SetViewportExt(dc,OutRect.right-OutRect.left,OutRect.top-OutRect.bottom);
end;
procedure SetMapping2(dc:HDC);
var
x:Integer; {Viewport-Ausdehnung für 4096 Samples}
begin
if TwoPeriods then begin
SetMapMode(dc,MM_Anisotropic);
SetWindowOrg(dc,0,0);
SetWindowExt(dc,nSamples,255);
x:=MulDiv(OutRect.right-OutRect.left,1600,nSamples);
SetViewportOrg(dc,OutRect.left+x,OutRect.bottom);
SetViewportExt(dc,x,OutRect.top-OutRect.bottom);
end else SetMapping(dc);
end;
procedure SetMapping3(dc:HDC);
var
x:Integer; {Viewport-Ausdehnung für 4096 Samples}
begin
if TwoPeriods then begin
SetMapMode(dc,MM_Anisotropic);
SetWindowOrg(dc,0,0);
SetWindowExt(dc,nSamples div xperiods,255);
x:=MulDiv(OutRect.right-OutRect.left,1600,nSamples);
SetViewportOrg(dc,OutRect.left+x,OutRect.bottom);
SetViewportExt(dc,x,OutRect.top-OutRect.bottom);
end else SetMapping(dc);
end;
procedure bild(dc:HDC);
{Hintergrund-Raster}
var
pen,open:HPen;
i: Integer;
begin
SaveDC(dc);
SetMapping(dc);
pen:=CreatePen(PS_Dot,0,$808080);
open:=SelectObject(dc,pen);
SetBkMode(dc,Transparent);
i:=0; repeat
Line(dc,0,i,nSamples-1,i); {waagerecht in logischen Zehnerschritten}
Inc(i,10);
until i>255;
i:=0; repeat
Line(dc,i,0,i,255); {senkrecht in logischen 400er}
Inc(i,400);
until i>nSamples;
SelectObject(dc,open);
DeleteObject(pen);
pen:=CreatePen(PS_Dot,0,$C0C0C0);
open:=SelectObject(dc,pen);
i:=0; repeat
Line(dc,0,i,nSamples-1,i); {waagerecht in 50er Schritt}
Inc(i,50);
until i>255;
SelectObject(dc,open);
DeleteObject(pen);
pen:=CreatePen(PS_Dot,0,$FFFFFF);
open:=SelectObject(dc,pen);
Line(dc,4*400,0,4*400,255); {senkrecht, "Periodenanfang"}
Line(dc,8*400,0,8*400,255); {senkrecht, "Periodenende"}
SelectObject(dc,open);
DeleteObject(pen);
pen:=CreatePen(PS_Solid,0,$FFFFFF);
open:=SelectObject(dc,pen);
Line(dc,0,0,nSamples-1,0); {waagerecht, unten}
SelectObject(dc,open);
DeleteObject(pen);
RestoreDC(dc,-1);
end;
procedure bemaszung(dc:HDC);
var
st: TS31;
font,ofont:HFont;
l,r:Integer;
i,j:Integer;
begin
font:=CreateFont(8,0,0,0,0,0,0,0,0,0,0,0,0,'Helv');
SaveDC(dc);
ofont:=SelectObject(dc,font);
SetTextColor(dc,$FFFFFF);
SetBkMode(dc,Transparent);
SetMapping2(dc);
l:=0; r:=nSamples;
if TwoPeriods then begin
l:=TPLeft; r:=TPRight;
end;
SetTextAlign(dc,TA_Right or TA_BaseLine);
i:=0; repeat
y2s(i,st);
OutText(dc,l,i,st);
Inc(i,50);
until i>255;
SetTextAlign(dc,TA_Right or TA_Bottom);
OutText(dc,l,256,yeinh[einh.y]);
SetTextAlign(dc,TA_Center or TA_Top);
i:=l; repeat
j:=i; if TwoPeriods then j:=MulDiv(i,1,xperiods);
x2s(j,st);
OutText(dc,i,0,st);
Inc(i,IfThenElse(TwoPeriods,TPTick,400));
until i>r;
SetTextAlign(dc,TA_Left or TA_Top);
OutText(dc,r,0,xeinh[einh.x]);
RestoreDC(dc,-1);
SelectObject(dc,ofont);
DeleteObject(font);
end;
procedure darstellen(dc:HDC);
var
pen:HPen;
poly,p: PPoint;
R: TRect;
i: Integer;
begin
if TwoPeriods then begin
poly:=Ptr(GlobalAlloc(GMEM_Fixed,nSamples*3*sizeof(TPoint)),0);
if poly=nil then exit;
p:=poly;
i:=TPLeft div xperiods;
repeat
p^.x:=i;
p^.y:=sample[(i+nSamples) mod nSamples]; {i kann bei 1 oder 2 Perioden überlaufen}
Inc(p);
Inc(i);
until i>=TPRight div xperiods;
end else begin
poly:=Ptr(GlobalAlloc(GMEM_Fixed,nSamples*sizeof(TPoint)),0);
if poly=nil then exit;
p:=poly;
i:=0;
repeat
p^.x:=i;
p^.y:=sample[i];
Inc(p);
Inc(i);
until i>=nSamples;
end;
pen:=CreatePen(PS_Solid,0,$00FFFF); {gelb}
SaveDC(dc);
SelectObject(dc,pen);
SetMapping3(dc);
PolyLine(dc,poly^,(PChar(p)-PChar(poly))div sizeof(TPoint));
RestoreDC(dc,-1);
DeleteObject(pen);
GlobalFree(PtrRec(poly).sel);
end;
procedure Fadenkreuz(dc:HDC);
{Zeichnet Fadenkreuz per XorPut in Client-Bereich}
var
pen:HPen;
begin
if not KreuzInside then exit;
pen:=CreatePen(PS_Solid,0,$000080);
SaveDC(dc);
SetMapping3(dc);
SetROP2(dc,R2_XorPen);
SelectObject(dc,pen);
if TwoPeriods then begin
Line(dc,TPLeft div xperiods,Kreuz.y,TPRight div xperiods,Kreuz.y);
Line(dc,Kreuz.x,0,Kreuz.x,255);
end else begin
Line(dc,0,Kreuz.y,nSamples-1,Kreuz.y);
Line(dc,Kreuz.x,0,Kreuz.x,255);
end;
RestoreDC(dc,-1);
DeleteObject(pen);
end;
procedure ausgabe;
var druckerport : word;
begin
druckerport:=memw[$40:6+LPT*2];
if druckerport<$100 then begin
MBox1(MainWnd,3,MB_OK,PChar(MakeLong(LPT,druckerport)));
exit;
end;
asm mov dx,[druckerport]
inc dx; inc dx
in al,dx; and al,1Ah {Die oberen 3 Bits auf Null!}
out dx,al {/Init Low, /Strobe High}
or al,4; out dx,al {/Init (SubD Pin ??) High}
dec dx; dec dx
mov si,offset sample
mov cx,nSamples
cld
@@l: outsb
inc dx; inc dx
or al,1; out dx,al {/Strobe (SubD Pin 1) Low}
and al,not 1; out dx,al {/Strobe (SubD Pin 1) High}
dec dx; dec dx
loop @@l
inc dx; inc dx
and al,not 4; out dx,al {/Init (SubD Pin ??) Low}
end;
end;
procedure FillCombo(Wnd:HWnd; S:PChar);
{Abschluss von S mit Doppel-Null}
var
id: Word;
begin
if PtrRec(S).sel=0 then begin
id:=LongRec(S).lo;
S:=StackAlloc(256);
LoadString(Seg(HInstance),id,S,256);
end;
while S^<>#0 do begin
SendMessageP(Wnd,CB_AddString,0,S);
Inc(S,lstrlen(S)+1);
end;
end;
function GetEditReal(Wnd:HWnd; ID:Word; var Z:TReal):Boolean;
var
S:TS31;
begin
GetDlgItemText(Wnd,ID,S,sizeof(s));
GetEditReal:=S2Real(S,Z);
end;
type
TKurve=record
typ: Integer; {Sinus, Dreieck, Rechteck}
xperi: Integer; {Perioden im 4096-Samples-Intervall (immer ganz)}
xphase: Integer; {Phasenverschiebung in Samples (auch: Arb-X)}
yamp: Integer; {Amplitude in lsb (auch: Arb-Y)}
yofs: Integer; {Verschiebung in lsb}
tv: Integer; {Tastverhältnis in Prozent (0..100)}
oper: Integer; {Setzen, addieren, multiplizieren}
end;
const
Kurve: TKurve=(
typ:0;
xperi:1;
xphase:0;
yamp:100;
yofs:0;
tv:50;
oper:0);
procedure operation(i:Integer; zz:TReal);
{Verarbeitet Kurve.oper und Kurve.yofs, Offset VOR der Multiplikation!}
var
z: Integer;
begin
z:=Round(zz)+Kurve.yofs;
case Kurve.oper of
0: z:=z+128;
1: z:=z+sample[i];
2: z:=MulDiv(z,(sample[i]-128),128)+128;
end;
sample[i]:=Limit(z,0,255);
end;
type
AWhat=(all,left,bottom,signal);
procedure Redraw(what:AWhat);
var
R:TRect;
begin
CalcClientRect(R);
case what of
left: R.right:=OutRect.left;
bottom: R.top:=OutRect.bottom;
signal: SetRect(R,
OutRect.left,OutRect.top,OutRect.right+1,OutRect.bottom+1);
end;
InvalidateRect(MainWnd,@R,true);
Statuszeile;
end;
procedure xperi2s(s:PChar);
var Z:TReal;
begin
case einh.x of
Freq: Z:=1E-3*Quarz/nSamples*Kurve.xperi; {kHz}
Zeit: Z:= 1E6/Quarz*nSamples/Kurve.xperi; {µs}
Adr: Z:=nSamples/Kurve.xperi; {Samples (auch krumm!)}
end;
Real2S(Z,2,s);
end;
function s2xperi(s:PChar):Boolean;
var
z: TReal;
begin
s2xperi:=false;
if not s2Real(s,z) or (z<=0) then begin
MessageBeep(MB_IconExclamation);
exit;
end;
case einh.x of
Freq: z:=z*1E3/Quarz*nSamples;
Zeit: z:=1E6/Quarz*nSamples/z;
Adr: z:=nSamples/z;
end;
if z>MAXPERI then begin
MessageBeep(MB_IconExclamation);
exit;
end;
s2xperi:=true;
Kurve.xperi:=Round(z);
end;
procedure rel_y2s(i:Integer; s:PChar);
begin
case einh.y of
Volt: Real2S(i*1.5/250,2,s);
Proz: Real2S(i*100/255,1,s);
Pix: wvsprintf(s,'%d',i);
end;
end;
function rel_s2y(s:PChar; var i:Integer):Boolean;
var
z: TReal;
begin
rel_s2y:=false;
if not s2Real(s,z) then begin
MessageBeep(MB_IconExclamation);
exit;
end;
case einh.y of
Volt: z:=z/1.5*250;
Proz: z:=z/100*255;
end;
if abs(z)>255 then begin
MessageBeep(MB_IconExclamation);
exit;
end;
rel_s2y:=true;
i:=Round(z);
end;
function sinus(x,tv:TReal):TReal; far;
{liefert 0..1..-1..0 für 0<=x<1}
begin
sinus:=sin(x*2*pi); {ohne Tastverhältnis}
end;
function dreieck(x,tv:TReal):TReal; far;
{liefert -1..1..-1 für 0<=x<1 und 0<=tv<=1}
begin
if x<tv then dreieck:=2*x/tv-1 else begin
x:=1-x; tv:=1-tv;
if x<tv then dreieck:=2*x/tv-1 else dreieck:=1;
end;
end;
function rechteck(x,tv:TReal):TReal; far;
{liefert 1..-1 für 0<=x<1 und 0<=tv<=1}
begin
if x<tv then rechteck:=1 else rechteck:=-1;
end;
const
GenFunc: array[0..2] of function(x,tv:TReal):TReal=(
sinus,dreieck,rechteck);
procedure setxperiods;
var
dc:HDC;
begin
if (Kurve.oper=0) and (xperiods<>Kurve.xperi) then begin
dc:=GetDC(MainWnd);
Fadenkreuz(dc);
xperiods:=Kurve.xperi; {beim Setzen globales <xperiods> mitführen}
if TwoPeriods then Redraw(bottom);
Fadenkreuz(dc);
ReleaseDC(MainWnd,dc);
end;
end;
const
WM_UpDown=WM_User+22;
var
EditProc: TFarProc;
NotifyLock:Boolean;
GenDlg: HWnd;
function EditHook(Wnd:HWnd; Msg,wParam:Word; lParam:LongInt):LongInt; export;
var
i: Integer;
begin
i:=Msg2VScroll(Msg,wParam,10);
if i<>0 then begin
SendMessageWW(GetParent(Wnd),WM_UpDown,GetDlgCtrlID(Wnd),Word(i),Wnd);
EditHook:=0;
end else EditHook:=CallWindowProc(EditProc,Wnd,Msg,wParam,lParam);
end;
function GenDlgProc(Wnd:HWnd; Msg,wParam:Word; lParam:LongInt):Bool;
export;
label op;
var
lPar: LongRec absolute lParam;
w: HWnd;
Z: TReal;
i,j: Integer;
a,b: Integer;
s: TS31;
begin
GenDlgProc:=false;
case Msg of
WM_Activate: KBHand:=IfThenElseW(Bool(wParam),Wnd,0);
WM_InitDialog: begin
NotifyLock:=true;
w:=GetDlgItem(Wnd,101);
FillCombo(w,MakeIntResource(7));
SendMessage(w,CB_SetCurSel,Kurve.typ,0);
SendMessageWW(Wnd,WM_Command,101,CBN_SelChange,w);
w:=GetDlgItem(Wnd,22); {Frequenz/Periodendauer}
FillCombo(w,MakeIntResource(8));
SendMessage(w,CB_SetCurSel,Word(einh.x),0);
SendMessageWW(Wnd,WM_Command,22,CBN_SelChange,w);
w:=GetDlgItem(Wnd,23);
FillCombo(w,MakeIntResource(9));
SendMessage(w,CB_SetCurSel,Word(einh.y),0);
SendMessageWW(Wnd,WM_Command,23,CBN_SelChange,w);
xperi2s(s); SetDlgItemText(Wnd,102,s);
rel_y2s(Kurve.yamp,s); SetDlgItemText(Wnd,103,s);
rel_y2s(Kurve.yofs,s); SetDlgItemText(Wnd,104,s);
Real2S(Kurve.tv/100,2,s); SetDlgItemText(Wnd,105,s);
for i:=102 to 105
do LongInt(EditProc):=SetWindowLong(GetDlgItem(Wnd,i),GWL_WndProc,LongInt(@EditHook));
NotifyLock:=false;
GenDlgProc:=true;
end;
WM_Command: case wParam of
2: begin EndDialog(Wnd,wParam); GenDlg:=0; end;
4: SetDlgItemInt(Wnd,104,0,true); {Taste "0"}
1: begin Kurve.oper:=0; goto op; end; {setzen}
5: begin Kurve.oper:=1; goto op; end; {addieren}
6: begin Kurve.oper:=2; {multiplizieren}
op: Z:=Kurve.xperi/nSamples;
for i:=0 to nSamples-1
do operation(i,GenFunc[Kurve.typ](Frac(i*Z),Kurve.tv/100)*Kurve.yamp);
setxperiods;
Redraw(signal);
ausgabe;
end;
7: SetActiveWindow(MainWnd); {Fokus zurück}
9: WinHelp(Wnd,HelpFileName,HELP_Context,231);
22: if lPar.hi=CBN_SelChange then begin
einh.x:=Axeinheit(SendMessage(lPar.lo,CB_GetCurSel,0,0));
ShowDlgItem(Wnd,12,Integer(einh.x=Freq)); {"Frequenz"}
ShowDlgItem(Wnd,112,Integer(einh.x<>Freq)); {"Periodendauer"}
xperi2s(s); SetDlgItemText(Wnd,102,s);
if not NotifyLock then Redraw(bottom); {Skale nachzeichnen}
end;
23: if lPar.hi=CBN_SelChange then begin
einh.y:=Ayeinheit(SendMessage(lPar.lo,CB_GetCurSel,0,0));
rel_y2s(Kurve.yamp,s); SetDlgItemText(Wnd,103,s);
rel_y2s(Kurve.yofs,s); SetDlgItemText(Wnd,104,s);
if not NotifyLock then Redraw(left); {Skale nachzeichnen}
end;
101: if lPar.hi=CBN_SelChange then begin
Kurve.typ:=SendMessage(lPar.lo,CB_GetCurSel,0,0);
EnableDlgItem(Wnd,14,Bool(Kurve.typ));
EnableDlgItem(Wnd,105,Bool(Kurve.typ));
end;
102: case lPar.hi of
EN_Change: if not NotifyLock then begin
GetWindowText(lPar.lo,s,sizeof(s));
s2xperi(s);
end;
end;
103: case lPar.hi of
EN_Change: if not NotifyLock then begin
GetWindowText(lPar.lo,s,sizeof(s));
rel_s2y(s,Kurve.yamp); {stets nachführen!}
end;
end;
104: case lPar.hi of
EN_Change: if not NotifyLock then begin
GetWindowText(lPar.lo,s,sizeof(s));
rel_s2y(s,Kurve.yofs); {stets nachführen!}
end;
end;
105: case lPar.hi of
EN_Change: if not NotifyLock then begin
GetWindowText(lPar.lo,s,sizeof(s));
if S2Real(S,Z) and (0<=Z) and (Z<=1) then Kurve.tv:=Round(Z*100)
else MessageBeep(MB_IconExclamation);
end;
end;
end;
WM_UpDown: case wParam of
102: begin
{ lPar.hi:=lPar.hi*(1+(Kurve.xperi shr 4)); {dynamisch größere Schritte?}
if einh.x<>Freq then Integer(lPar.hi):=-Integer(lPar.hi);
Kurve.xperi:=Limit(Kurve.xperi+Integer(lPar.hi),1,MAXPERI);
NotifyLock:=true;
xperi2s(s); SetWindowText(lPar.lo,s);
NotifyLock:=false;
end;
103: begin
Kurve.yamp:=Limit(Kurve.yamp+Integer(lPar.hi),0,255);
NotifyLock:=true;
rel_y2s(Kurve.yamp,s); SetWindowText(lPar.lo,s);
NotifyLock:=false;
end;
104: begin
Kurve.yofs:=Limit(Kurve.yofs+Integer(lPar.hi),0,255);
NotifyLock:=true;
rel_y2s(Kurve.yofs,s); SetWindowText(lPar.lo,s);
NotifyLock:=false;
end;
105: begin
Kurve.tv:=Limit(Kurve.tv+Integer(lPar.hi),0,100);
Real2S(Kurve.tv/100,2,s);
NotifyLock:=true;
SetWindowText(lPar.lo,s);
NotifyLock:=false;
end;
end;
end;
end;
procedure SetKreuz(x,y:Integer);
var
dc:HDC;
begin
dc:=GetDC(MainWnd);
Fadenkreuz(dc);
Kreuz.x:=x;
Kreuz.y:=y;
Fadenkreuz(dc);
ReleaseDC(MainWnd,dc);
positionsanzeige;
end;
var
ArbData: array[0..50] of TPoint; {Arbitrary Data}
ArbCount: Integer;
{Die Daten liegen als Punkte mit X=0..4095 (unabhängig von der gewählten
Frequenz) und Y=0..255 vor. Die Unabhängigkeit der X-Werte von der
Frequenz ermöglicht die nachträgliche Frequenz-Änderung, ohne die
Arb-Daten umrechnen zu müssen.}
procedure ArbStatus;
var
s: TS31;
begin
wvsprintf(s,'Arb: %d',ArbCount);
if ArbCount=0 then s[0]:=#0;
SendMessageP(Status,SB_SetText,1,@s);
end;
function NearArb(A:TPoint):Boolean;
var
P:TPoint;
begin
NearArb:=true;
P.x:=Kurve.xphase*Kurve.xperi;
P.y:=Kurve.yamp;
if P.x=A.x then exit; {bei X-Gleichheit unabhängig von Y}
if (abs(P.x-A.x)<10) and (abs(P.y-A.y)<2) then exit;
NearArb:=false;
end;
function FindArb:Integer;
var i: Integer;
begin
for i:=0 to ArbCount-1
do if NearArb(ArbData[i]) then begin
FindArb:=i; exit;
end;
FindArb:=ArbCount;
end;
procedure GetArbPointRect(i:Integer; var R:TRect);
var P: TPoint;
begin
with ArbData[i] do begin
P.x:=iitrafo(x,TPLeft,TPRight,OutRect.left,OutRect.right);
P.y:=iitrafo(y,0,255,OutRect.bottom,OutRect.top);
SetRect(R,P.x-3,P.y-3,P.x+4,P.y+4);
end;
end;
procedure RedrawArbPoint(i:Integer);
var R: TRect;
begin
GetArbPointRect(i,R);
InvalidateRect(MainWnd,@R,true);
end;
procedure AddArb;
var
i: Integer;
begin
i:=FindArb;
if i>HIGH(ArbData) then MessageBeep(0)
else begin
if i<ArbCount then RedrawArbPoint(i);
with ArbData[i] do begin
x:=Kurve.xphase*Kurve.xperi;
y:=Kurve.yamp;
end;
if i=ArbCount then Inc(Arbcount); {kann auch HIGH(ArbData)+1 werden}
ArbStatus;
RedrawArbPoint(i);
end;
end;
procedure DelArb;
var
i: Integer;
begin
i:=FindArb;
if i=ArbCount then exit;
RedrawArbPoint(i);
for i:=i to ArbCount-2 do ArbData[i]:=ArbData[i+1];
if ArbCount>0 then Dec(ArbCount);
ArbStatus;
end;
procedure DelAllArb;
var
i: Integer;
begin
for i:=0 to ArbCount-1 do RedrawArbPoint(i);
ArbCount:=0;
ArbStatus;
end;
function CompareArb(p1,p2:PChar):Boolean; far;
begin
CompareArb:=TPoint(p2).x<TPoint(p1).x;
end;
function GenerateArb(x:Integer):Integer;
{verbindet die Arbitrary-Punkte mit Geraden: berechnet Zwischenwerte}
label found_interval;
var
i: Integer;
LP,RP:PPoint; {Linker und rechter Punkt einer Verbindungsgeraden}
HP:TPoint; {Hilfspunkt um die Litfaßsäule herum}
begin
case ArbCount of
0: GenerateArb:=0;
1: GenerateArb:=ArbData[0].y;
else begin
HP:=ArbData[ArbCount-1]; Dec(HP.x,nSamples);
LP:=@HP; {Linker Hilfspunkt}
for i:=0 to ArbCount-1 do begin
RP:=@ArbData[i]; {Rechte Seite des Intervalls}
if (LP^.x<=x) and (x<RP^.x) then goto found_interval;
LP:=RP; {wird neue linke Seite}
end;
HP:=ArbData[0]; Inc(HP.x,nSamples);
RP:=@HP; {Rechter Hilfspunkt}
found_interval:
GenerateArb:=iitrafo(x,LP^.x,RP^.x,LP^.y,RP^.y);
end;
end;
end;
procedure xphase2s(s:PChar);
begin
case einh.x of
Freq: Real2S(Kurve.xphase*(100/nSamples*Kurve.xperi),2,s); {Prozent}
Zeit: Real2S(Kurve.xphase/quarz*1E6,2,s); {µs}
Adr: wvsprintf(s,'%d',Kurve.xphase); {Samples}
end;
end;
function s2xphase(s:PChar):Boolean;
var
z: TReal;
begin
s2xphase:=false;
if not S2Real(s,z) then exit;
if z<0 then exit;
case einh.x of
Freq: z:=z*(nSamples/100/Kurve.xperi);
Zeit: z:=z*quarz*1E-6;
end;
Kurve.xphase:=Min(Round(z),nSamples div Kurve.xperi);
s2xphase:=true;
end;
var
ArbDlg: HWnd;
function ArbDlgProc(Wnd:HWnd; Msg,wParam:Word; lParam:LongInt):Bool;
export;
var
lPar: LongRec absolute lParam;
w: HWnd;
Z: TReal;
i,j: Integer;
a,b: Integer;
s: TS31;
begin
ArbDlgProc:=false;
case Msg of
WM_Activate: KBHand:=IfThenElseW(Bool(wParam),Wnd,0);
WM_InitDialog: begin
Kurve.oper:=0;
if not TwoPeriods then SendMessage(MainWnd,WM_Command,228,0);
setxperiods;
NotifyLock:=true;
w:=GetDlgItem(Wnd,21); {Frequenz/Periodendauer}
FillCombo(w,MakeIntResource(8));
SendMessage(w,CB_SetCurSel,Word(einh.x),0);
SendMessageWW(Wnd,WM_Command,21,CBN_SelChange,w);
w:=GetDlgItem(Wnd,23); {Y-Werte}
FillCombo(w,MakeIntResource(9));
SendMessage(w,CB_SetCurSel,Word(einh.y),0);
SendMessageWW(Wnd,WM_Command,23,CBN_SelChange,w);
xperi2s(s); SetDlgItemText(Wnd,101,s);
for i:=101 to 103
do LongInt(EditProc):=SetWindowLong(GetDlgItem(Wnd,i),
GWL_WndProc,LongInt(@EditHook));
NotifyLock:=false;
ArbDlgProc:=true;
end;
WM_Command: case wParam of
2: begin EndDialog(Wnd,wParam); ArbDlg:=0; end; {"Ende"}
1: AddArb; {"+"}
3: DelArb; {"-"}
4: DelAllArb;
5: begin {"Zeichnen & Ausgeben}
setxperiods;
fqsort(PPChar(@ArbData),ArbCount,CompareArb);
for i:=0 to nSamples-1
do sample[i]:=GenerateArb(
HiWord(LongDivR(LongMul(i,Kurve.xperi),nSamples)));
Redraw(signal);
ausgabe;
end;
9: WinHelp(Wnd,HelpFileName,HELP_Context,232);
21: if lPar.hi=CBN_SelChange then begin
einh.x:=Axeinheit(SendMessage(lPar.lo,CB_GetCurSel,0,0));
if einh.x<>Freq then SendMessageP(lPar.lo,CB_GetLbText,Word(einh.x),@s)
else lstrcpy(s,'%');
SetDlgItemText(Wnd,22,s);
ShowDlgItem(Wnd,11,Integer(einh.x=Freq)); {"Frequenz"}
ShowDlgItem(Wnd,111,Integer(einh.x<>Freq)); {"Periodendauer"}
xperi2s(s); SetDlgItemText(Wnd,101,s);
xphase2s(s); SetDlgItemText(Wnd,102,s);
if not NotifyLock then Redraw(bottom); {Skale nachzeichnen}
end;
23: if lPar.hi=CBN_SelChange then begin
einh.y:=Ayeinheit(SendMessage(lPar.lo,CB_GetCurSel,0,0));
rel_y2s(Kurve.yamp,s); SetDlgItemText(Wnd,103,s);
if not NotifyLock then Redraw(left); {Skale nachzeichnen}
end;
101: case lPar.hi of
EN_Change: if not NotifyLock then begin
GetWindowText(lPar.lo,s,sizeof(s));
s2xperi(s);
setxperiods;
end;
end;
102: case lPar.hi of
EN_Change: if not NotifyLock then begin
GetWindowText(lPar.lo,s,sizeof(s));
s2xphase(s);
SetKreuz(Kurve.xphase,Kreuz.y);
end;
end;
103: case lPar.hi of
EN_Change: if not NotifyLock then begin
GetWindowText(lPar.lo,s,sizeof(s));
rel_s2y(s,Kurve.yamp); {stets nachführen!}
SetKreuz(Kreuz.x,Kurve.yamp);
end;
end;
end;
WM_TakeCoord: begin {im Hauptfenster Koordinate angeklickt}
NotifyLock:=true;
Kurve.xphase:=Kreuz.x;
Kurve.yamp:=Kreuz.y;
xphase2s(s); SetDlgItemText(Wnd,102,s);
rel_y2s(Kurve.yamp,s); SetDlgItemText(Wnd,103,s);
NotifyLock:=false;
if wParam<>0 then SendMessage(Wnd,WM_Command,wParam,0);
end;
WM_UpDown: case wParam of
101: begin
if einh.x<>Freq then Integer(lPar.hi):=-Integer(lPar.hi);
Kurve.xperi:=Limit(salr(Kurve.xperi,Integer(lPar.hi)),1,MAXPERI);
NotifyLock:=true;
xperi2s(s); SetWindowText(lPar.lo,s);
setxperiods;
NotifyLock:=false;
end;
102: begin
Kurve.xphase:=Limit(Kurve.xphase+Integer(lPar.hi),0,
(nSamples div Kurve.xperi)-1);
NotifyLock:=true;
xphase2s(s); SetWindowText(lPar.lo,s);
SetKreuz(Kurve.xphase,Kreuz.y);
NotifyLock:=false;
end;
103: begin
Kurve.yamp:=Limit(Kurve.yamp+Integer(lPar.hi),0,255);
NotifyLock:=true;
rel_y2s(Kurve.yamp,s); SetWindowText(lPar.lo,s);
SetKreuz(Kreuz.x,Kurve.yamp);
NotifyLock:=false;
end;
end;
end;
end;
function LptDlgProc(Wnd:HWnd; Msg,wParam:Word; lParam:LongInt):Bool;
export;
var
lPar: LongRec absolute lParam;
w: HWnd;
vsrec: record
i: Integer;
x: Word;
end;
i,j,k: Integer;
s,t: TS31;
begin
LptDlgProc:=false;
case Msg of
WM_InitDialog: begin
w:=GetDlgItem(Wnd,101);
LoadString(Seg(HInstance),10,t,sizeof(t));
j:=MemW[$40:$10] shr 14; {Anzahl LPTs}
for vsrec.i:=1 to j do begin
vsrec.x:=MemW[$40:6+(vsrec.i shl 1)];
wvsprintf(s,t,vsrec);
k:=SendMessageP(w,CB_AddString,0,@s);
if vsrec.i=LPT then SendMessage(w,CB_SetCurSel,k,0);
end;
LptDlgProc:=true;
end;
WM_Command: case wParam of
1: begin
w:=GetDlgItem(Wnd,101);
k:=SendMessage(w,CB_GetCurSel,0,0);
if k>=0 then begin
LPT:=k+1;
wvsprintf(s,'%d',LPT);
WritePrivateProfileString(AppNam,'LPT',s,StdProfile);
EndDialog(Wnd,wParam);
end else MessageBeep(MB_IconExclamation);
end;
2: EndDialog(Wnd,wParam); {"Abbruch"}
9: WinHelp(Wnd,HelpFileName,HELP_Context,241);
end;
end;
end;
function OszDlgProc(Wnd:HWnd; Msg,wParam:Word; lParam:LongInt):Bool;
export;
var
lPar: LongRec absolute lParam;
w: HWnd;
z: TReal;
s: TS31;
begin
OszDlgProc:=false;
case Msg of
WM_InitDialog: begin
w:=GetDlgItem(Wnd,101);
Real2S(quarz/1E6,3,s);
SetWindowText(w,s);
Real2S(8,3,s); {je nach Systemsteuerung mit Punkt oder Komma}
SendMessageP(w,CB_AddString,0,@s);
if quarz=8E6 then SendMessage(w,CB_SetCurSel,0,0);
OszDlgProc:=true;
end;
WM_Command: case wParam of
1: begin
GetDlgItemText(Wnd,101,s,sizeof(s));
if S2Real(s,z) and (1E-3<=z) and (z<=40) then begin
WritePrivateProfileString(AppNam,'quarz',s,StdProfile);
quarz:=z*1E6; {erlaubt: 1kHz .. 40 MHz}
Redraw(bottom);
EndDialog(Wnd,wParam);
end else begin
MBox1(Wnd,11,MB_IconExclamation or MB_Sound,s);
SetEditFocus(GetDlgItem(Wnd,101));
end;
end;
2: EndDialog(Wnd,wParam); {"Abbruch"}
9: WinHelp(Wnd,HelpFileName,HELP_Context,242);
end;
end;
end;
function WriteWAV:boolean;
label exi;
var
fh: THMMIO;
ck: array[0..1] of TMMCkInfo;
wf: TPCMWaveFormat;
begin
WriteWAV:=false;
fh:=mmioOpen(fname,nil,MMIO_Create or MMIO_Exclusive or MMIO_AllocBuf);
if fh=0 then exit;
FillChar(ck,sizeof(ck),0);
ck[0].fccType:=$45564157; {"WAVE"}
if mmioCreateChunk(fh,@ck[0],MMIO_CreateRIFF)<>0 then goto exi;
with wf,wf do begin
wFormatTag:=WAVE_FORMAT_PCM;
nChannels:=1;
nSamplesPerSec:=Round(quarz);
nAvgBytesPerSec:=Round(quarz);
nBlockAlign:=1;
wBitsPerSample:=8;
end;
ck[1].ckid:=$20746D66; {"fmt "}
ck[1].cksize:=sizeof(TPCMWaveFormat);
if mmioCreateChunk(fh,@ck[1],0)<>0 then goto exi;
if mmioWrite(fh,PChar(@wf),sizeof(wf))<>sizeof(wf) then goto exi;
if mmioAscend(fh,@ck[1],0)<>0 then goto exi;
ck[1].ckid:=$61746164; {"data"}
ck[1].cksize:=sizeof(sample);
if mmioCreateChunk(fh,@ck[1],0)<>0 then goto exi;
if mmioWrite(fh,PChar(@sample),sizeof(sample))<>sizeof(sample) then goto exi;
if mmioAscend(fh,@ck[1],0)<>0 then goto exi;
if mmioAscend(fh,@ck[0],0)<>0 then goto exi;
if mmioClose(fh,0)=0 then WriteWAV:=true;
exit;
exi:
mmioClose(fh,0);
end;
function ReadWAV:boolean;
label exi;
var
fh: THMMIO;
ck: array[0..1] of TMMCkInfo;
wf: TPCMWaveFormat;
begin
ReadWAV:=false;
fh:=mmioOpen(fname,nil,MMIO_Read or MMIO_DenyWrite or MMIO_AllocBuf);
if fh=0 then exit;
{ ck1.fccType:=$45564157; "WAVE" - laut MMSYSTEM.HLP Vergleich nachher!}
if mmioDescend(fh,@ck[0],nil,MMIO_FindRIFF)<>0 then goto exi;
if ck[0].fccType<>$45564157 then goto exi; {"WAVE"}
ck[1].ckid:=$20746D66; {"fmt "}
if mmioDescend(fh,@ck[1],@ck[0],MMIO_FindChunk)<>0 then goto exi;
if ck[1].cksize<sizeof(TPCMWaveFormat) then goto exi;
mmioRead(fh,PChar(@wf),sizeof(wf));
with wf,wf do begin
if wFormatTag<>WAVE_FORMAT_PCM then goto exi;
if nChannels<>1 then goto exi;
if nBlockAlign<>1 then goto exi;
if wBitsPerSample<>8 then goto exi;
end;
mmioAscend(fh,@ck[1],0);
ck[1].ckid:=$61746164; {"data"}
if mmioDescend(fh,@ck[1],@ck[0],MMIO_FindChunk)<>0 then goto exi;
mmioRead(fh,PChar(@sample),MinW(sizeof(sample),ck[1].cksize));
{ mmioAscend(fh,@ck[1],0);
mmioAscend(fh,@ck[0],0);}
ReadWAV:=true;
exi:
mmioClose(fh,0);
end;
procedure laden;
var
ofn: TOpenFileName;
sName: TS255;
sFilter: TS127;
begin
InitStruct(ofn,sizeof(ofn));
ofn.hwndOwner:=MainWnd;
ofn.lpstrFilter:=sFilter;
LoadString(Seg(HInstance),4,sFilter,sizeof(sFilter));
lstrcpy(sName,GetFileNamePtr(fName));
ofn.lpstrFile:=sName;
ofn.nMaxFile:=sizeof(sName);
ofn.Flags:=OFN_FileMustExist or OFN_HideReadOnly or OFN_LongNames;
if not GetOpenFileName(ofn) then exit;
lstrcpy(fname,sName);
if not ReadWav then MBox0(MainWnd,5,MB_OK);
if xperiods<>1 then begin
xperiods:=1;
Redraw(bottom);
end;
Redraw(signal);
ausgabe;
end;
procedure speichern;
var
ofn: TOpenFileName;
sName: TS255;
sFilter: TS127;
begin
InitStruct(ofn,sizeof(ofn));
ofn.hwndOwner:=MainWnd;
ofn.lpstrFilter:=sFilter;
LoadString(Seg(HInstance),4,sFilter,sizeof(sFilter));
lstrcpy(sName,GetFileNamePtr(fName));
ofn.lpstrFile:=sName;
ofn.nMaxFile:=sizeof(sName);
ofn.Flags:=OFN_PathMustExist or OFN_HideReadOnly or OFN_LongNames;
if not GetSaveFileName(ofn) then exit;
lstrcpy(fname,sName);
if not WriteWav then MBox0(MainWnd,6,MB_OK);
end;
procedure config_file_lesen;
var
z: TReal;
ec:Integer;
s: TS31;
begin
GetPrivateProfileString(AppNam,'LastDir',fname,'',sizeof(fname),StdProfile);
einh.x:=Axeinheit(GetPrivateProfileInt(AppNam,'xeinh',0,StdProfile));
einh.y:=Ayeinheit(GetPrivateProfileInt(AppNam,'yeinh',0,StdProfile));
if GetPrivateProfileString(AppNam,'Quarz','',s,sizeof(s),StdProfile)<>0
then begin
Val(s,z,ec);
if ec=0 then quarz:=z*1E6;
end;
LPT:=GetPrivateProfileInt(AppNam,'LPT',1,StdProfile);
xperiods:=GetPrivateProfileInt(AppNam,'xperiods',1,StdProfile);
end;
procedure SaveConfig;
var
s: TS31;
begin
Str(Integer(einh.x),s);
WritePrivateProfileString(AppNam,'xeinh',s,StdProfile);
Str(Integer(einh.y),s);
WritePrivateProfileString(AppNam,'yeinh',s,StdProfile);
end;
procedure ArbPoints(dc:HDC);
{zeichnet Arb-Punkte ins Hauptfenster}
var
pen:HPen;
R: TRect;
i: Integer;
begin
pen:=CreatePen(PS_Solid,2,$FF0000); {weißer Kreis mit blauem Rand}
SaveDC(dc);
SelectObject(dc,pen);
for i:=0 to ArbCount-1 do begin
GetArbPointRect(i,R);
Ellipse(dc,R.left,R.top,R.right,R.bottom);
end;
RestoreDC(dc,-1);
DeleteObject(pen);
end;
function TP_x1(x:Integer):Integer;
{Wandelt Client-Koordinate in Sample-Schritte um}
begin
TP_x1:=MulDiv(MulDiv(x-OutRect.left,
TPRight-TPLeft,OutRect.right-OutRect.left)+TPLeft,
1,xperiods);
end;
procedure CalcKreuz(var pt:TPoint);
{Wandelt übergebene Client-Koordinaten in Sample-Koordinaten um}
begin
if TwoPeriods then pt.x:=TP_x1(pt.x)
{MulDiv(*xperiods-TPLeft,nSamples,TPRight-TPLeft);}
else pt.x:=MulDiv(pt.x-OutRect.left,nSamples-1,OutRect.right-OutRect.left);
pt.y:=MulDiv(pt.y-OutRect.bottom,255,OutRect.top-OutRect.bottom);
end;
function MainWndProc(Wnd:HWnd; Msg,wParam:Word; lParam:LongInt):LongInt;
export;
const {Feldbreiten der Statuszeile}
widths: array[0..4] of Integer=(150,200,300,400,-1);
var
lPar: LongRec absolute lParam;
lParPt: TPoint absolute lParam;
PS: TPaintStruct;
m: HMenu;
i: Integer;
pt: TPoint absolute PS;
CallDef:Boolean;
begin
MainWndProc:=HandleToolStat(Wnd,Msg,wParam,lParam);
CallDef:=false;
case Msg of
WM_Create: begin
config_file_lesen;
SendMessage(Wnd,WM_WinIniChange,0,0);
ToggleStatus(0); {immer Statuszeile!}
SendMessageP(Status,SB_SetParts,HIGH(widths)+1,@widths);
statuszeile;
end;
WM_WinIniChange: begin
GetProfileString('intl','sDecimal','.',sDecimal,sizeof(sDecimal));
end;
WM_Size: begin
CalcClientRect(OutRect);
InflateRect(OutRect,-20,-20);
GetCursorPos(pt);
ScreenToClient(Wnd,pt);
CalcKreuz(pt);
Kreuz:=pt;
end;
WM_InitMenu: begin
m:=GetMenu(Wnd);
for i:=221 to 223
do CheckMenuItem(m,i,Bool2MenuCheck(einh.x=Axeinheit(i-221)));
for i:=224 to 226
do CheckMenuItem(m,i,Bool2MenuCheck(einh.y=Ayeinheit(i-224)));
CheckMenuItem(m,227,Bool2MenuCheck(not TwoPeriods));
CheckMenuItem(m,228,Bool2MenuCheck(TwoPeriods));
end;
WM_Command: case wParam of
211: laden;
212: speichern;
219: SendMessage(Wnd,WM_Close,0,0);
221: begin einh.x:=Freq; Redraw(bottom); end;
222: begin einh.x:=Zeit; Redraw(bottom); end;
223: begin einh.x:=Adr; Redraw(bottom); end;
224: begin einh.y:=Volt; Redraw(left); end;
225: begin einh.y:=Proz; Redraw(left); end;
226: begin einh.y:=Pix; Redraw(left); end;
227: begin TwoPeriods:=false; Redraw(all); end;
228: begin TwoPeriods:=true; Redraw(all); end;
231: if GenDlg<>0 then SetActiveWindow(GenDlg) {Kurve generieren}
else begin
if ArbDlg<>0 then SendMessage(ArbDlg,WM_Command,2,0);{Nicht gleichzeitig}
ArbCount:=0; ArbStatus;
GenDlg:=CreateDialog(Seg(HInstance),MakeIntResource(wParam),Wnd,
@GenDlgProc);
end;
232: if ArbDlg<>0 then SetActiveWindow(ArbDlg)
else begin
if GenDlg<>0 then SendMessage(GenDlg,WM_Command,2,0);{Nicht gleichzeitig}
ArbDlg:=CreateDialog(Seg(HInstance),MakeIntResource(wParam),Wnd,
@ArbDlgProc);
end;
241: DialogBox(Seg(HInstance),MakeIntResource(wParam),Wnd,@LptDlgProc);
242: DialogBox(Seg(HInstance),MakeIntResource(wParam),Wnd,@OszDlgProc);
291: WinHelp(Wnd,HelpFileName,HELP_Contents,0);
299: MBox0(Wnd,12,MB_IconInformation); {"Über"}
end;
WM_Paint: begin
BeginPaint(Wnd,PS);
if not PS.fErase
then FillRect(PS.hdc,PS.rcPaint,GetStockObject(Black_Brush));
Bild(PS.hdc);
Bemaszung(PS.hdc);
darstellen(PS.hdc);
if (ArbDlg<>0) and TwoPeriods then ArbPoints(PS.hdc);
Fadenkreuz(PS.hdc);
EndPaint(Wnd,PS);
end;
WM_MouseMove: begin
CalcKreuz(lParPt);
SetKreuz(lParPt.x,lParPt.y);
positionsanzeige;
end;
WM_LButtonDown: begin
if ArbDlg<>0 then SendMessage(ArbDlg,WM_TakeCoord,1,0);
end;
WM_RButtonDown: begin
if ArbDlg<>0 then SendMessage(ArbDlg,WM_TakeCoord,0,0);
end;
WM_EndSession: if wParam<>0 then SaveConfig;
WM_Close: begin
WinHelp(Wnd,HelpFileName,HELP_Quit,0);
SaveConfig;
CallDef:=true;
end;
WM_Destroy: PostQuitMessage(0);
else CallDef:=true;
end;
if CallDef then MainWndProc:=DefWindowProc(Wnd,Msg,wParam,lParam);
end;
const
wc:TWndClass=(
style: CS_HRedraw or CS_VRedraw or CS_DblClks;
lpfnWndProc: @MainWndProc;
cbClsExtra: 0;
cbWndExtra: 0;
hInstance: Seg(HInstance);
hIcon: 0;
hCursor: 0;
hbrBackground: 0;
lpszMenuName: MakeIntResource(100);
lpszClassName: AppNam
);
var
Msg:TMsg;
begin
if HPrevInst<>0 then begin
MainWnd:=MemW[HPrevInst:Ofs(MainWnd)];
ShowWindow(MainWnd,SW_Show);
SetActiveWindow(MainWnd);
exit;
end else begin
wc.hIcon:=LoadIcon(Seg(HInstance),MakeIntResource(100));
wc.hCursor:=LoadCursor(0,IDC_Arrow);
wc.hbrBackground:=GetStockObject(Black_Brush);
RegisterClass(wc);
end;
AccTable:=LoadAccelerators(Seg(HInstance),MakeIntResource(100));
StdProfile:='GEN2.INI';
StdMBoxTitle:='Funktionsgenerator';
CreateWindow(AppNam,'Funktionsgenerator Marke Bitterling',WS_OverlappedWindow,
CW_UseDefault,CW_UseDefault,CW_UseDefault,CW_UseDefault,
0,0,Seg(HInstance),nil);
ShowWindow(MainWnd,CmdShow);
while GetMessage(Msg,0,0,0) do begin
if (KBHand<>0) and IsDialogMessage(KBHand,Msg) then continue;
if TranslateAccelerator(MainWnd,AccTable,Msg)<>0 then continue;
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end.
| Detected encoding: OEM (CP437) | 1
|
|
|