{$A+,B-,G+,F-,K+,W-} {Standard-Codeerzeugung}
{$P-,T-,V+,X+} {Compiler-Prüfungen}
{ $D+,I+,L+,Q+,R+,S+,Y+} {Debug-Codeerzeugung}
{$D-,I-,L-,Q-,R-,S-,Y-} {Release-Codeerzeugung}
{$N-,E-} {TReal=Real, hier kein Kopro erforderlich}
{$M 8192,8192}
program MotorSt;
{$R MotorSt.res}
{$D Schrittmotor-DDE-Server}
{$C Moveable Preload Discardable}
{$S $8000} {Units automatisch gruppieren, weniger Far-Calls und Fixups}
uses WinProcs,WinTypes,OWindows,ODialogs,Win31,DdeMl,Strings,
mpk3d,smsh,smsp,smsdde,Bereich,StepDlg,Grenzen,LoadSave,MotorSel;
{*********************************}
{Hauptfenster-Dialogobjekt mit DDE}
{*********************************}
type
PMain=^TMain;
TMain=object(TDlgWindow)
Synced: Bool; {Synchronzustand, DDE-abfragbar}
InMove: Bool; {In-Bewegung, DDE-abfragbare Variable}
MStrom: Bool; {Status: Motorspulen bestromt oder stromfrei}
{bzw. Bremse angezogen oder nicht}
InInit: Bool; {DDE-Funktion INIT in Ausführung}
MovReq: Bool; {1 Move-Befehl in Warteschlange (NextPos)}
CurPos: TReal;
NextPos:TReal;
{Dialog-Elemente}
SbGrob: PScrollBar; {Visualisierung der Motorposition}
SbFein: PScrollBar;
LastFocusedEdit: Word; {Zuletzt fokussiertes Editfenster-ID}
{DDE-Variablen}
DdeServ: PMyDDE; {initialisierte Instanz}
PortBasis: Word;
UseBrake: Bool;
{Methoden}
constructor Init(AParent:PWindowsObject; AName:PChar);
destructor Done; virtual;
function GetClassName:PChar; virtual;
procedure SetupWindow; virtual;
function CanClose:Boolean; virtual;
procedure WMInitMenu(var Msg:TMessage); virtual WM_First+WM_InitMenu;
{Menükommandos}
procedure CMEnde(var Msg:TMessage); virtual CM_First+CM_Ende;
procedure CMConnect(var Msg:TMessage); virtual CM_First+CM_Connect;
procedure CMBereich(var Msg:TMessage); virtual CM_First+CM_Bereich;
procedure CMGrenzen(var Msg:TMessage); virtual CM_First+CM_Grenzen;
procedure CMSaveSettings(var Msg:TMessage); virtual CM_First+CM_Save;
procedure CMHilfeIndex(var Msg:TMessage); virtual CM_First+CM_HelpIndex;
procedure CMHilfeDde(var Msg:TMessage); virtual CM_First+CM_HelpDde;
procedure CMAbout(var Msg:TMessage); virtual CM_First+CM_About;
{Dialog-Kommandos}
procedure IDSbGrob(var Msg:TMessage); virtual ID_First+ID_SbGrob;
procedure IDSbFein(var Msg:TMessage); virtual ID_First+ID_SbFein;
procedure IDRefFahrt(var Msg:TMessage); virtual ID_First+ID_RefFahrt;
procedure IDStop(var Msg:TMessage); virtual ID_First+ID_Stop;
procedure IDFree(var Msg:TMessage); virtual ID_First+ID_Free;
procedure IDEditAbs(var Msg:TMessage); virtual ID_First+ID_AbsWert;
procedure IDEditRel(var Msg:TMessage); virtual ID_First+ID_RelWert;
procedure IDGoto(var Msg:TMessage); virtual ID_First+ID_Goto;
procedure IDSetNull(var Msg:TMessage); virtual ID_First+ID_Nullpunkt;
{DDE-Callbacks}
procedure WMConnect(var Msg:TMessage); virtual WM_First+WM_Connect;
procedure WMPoke(var Msg:TMessage); virtual WM_First+WM_Poke;
procedure WMExecute(var Msg:TMessage); virtual WM_First+WM_Execute;
procedure WMRequest(var Msg:TMessage); virtual WM_First+WM_Request;
{VxD-Callback}
procedure WMMovEnd(var Msg:TMessage); virtual WM_First+WM_MovEnd;
{Rufe aus anderen Fenstern}
procedure WMProceed(var Msg:TMessage); virtual WM_First+WM_Proceed;
procedure WMAssign(var Msg:TMessage); virtual WM_First+WM_Assign;
{Interne Funktionen}
procedure SetTextStrings(Z: TReal);
function DoReffahrt:boolean;
function MoveMotorQuiet(nach: TReal):boolean;
function MoveMotor(nach: TReal):boolean;
procedure SetScrollbars(nach: TReal);
procedure EnableButtons;
procedure SetNewAlias;
procedure SetInMove(AValue:Bool);
procedure SetSynced(AValue:Bool);
procedure SetMStrom(AValue:Bool);
function AssignMotor(NewUnit: Byte):boolean;
end;
constructor TMain.Init;
begin
inherited Init(AParent,AName);
SbGrob:=New(PScrollBar,InitResource(@self,ID_SbGrob));
SbFein:=New(PScrollBar,InitResource(@self,ID_SbFein));
InMove:=false;
MovReq:=false;
Synced:=false;
MStrom:=false;
InInit:=false;
UseBrake:=true;
end;
destructor TMain.Done;
begin
Dispose(SbGrob,Done);
Dispose(SbFein,Done);
inherited Done;
end;
function TMain.GetClassName:PChar;
begin
GetClassName:=AppName;
end;
procedure TMain.SetupWindow;
var
NewUnit:Byte;
EC: Integer;
S:TS31;
var
Line: array[byte]of Char;
i: Integer;
begin
inherited SetupWindow;
{Icon setzen}
SetClassWord(HWindow,GCW_hIcon,LoadIcon(hInstance,MakeIntResource(IDC_Main)));
NewUnit:=GetPrivateProfileInt(Section,'UnitUsed',0,Profile);
LoadSettings;
{Das Relais für die Hardwareendschalter-Abschaltung muß ständig eingeschaltet
bleiben. Das wird NICHT vom MPK3D erledigt, da es sich hierbei um eine
Zusatzschaltung dieses Labormeßplatzes handelt}
PortBasis:=$340;
GetPrivateProfileString('386enh','MPK3DPort',
'340',@S[1],sizeof(S)-1,'system.ini');
S[0]:='$';
Val(S,PortBasis,EC);
Port[PortBasis+7]:=0; {Relais und Motor AUS}
AssignMotor(NewUnit); {Bei Versagen ist keiner da}
{DDE weiter initialisieren}
DdeServ:=New(PMyDDE,Init(HWindow));
SetNewAlias; {Alias je nach aktivem Motor setzen}
SbFein^.SetRange(-SBFaktor,SBFaktor); {Fein-Rollbalken-Parameter setzen}
SbGrob^.SetRange(Trunc(LeftBound+0.99),Trunc(RightBound-0.01));
{Grob-Rollbalken-Ränder derart setzen, daß niemals Überläufe auftreten}
SetScrollbars(0.0);
{Rollbalken mittig positionieren}
EnableButtons;
end;
procedure TMain.WMInitMenu(var Msg:TMessage);
{Aufruf vom System vor dem Öffnen des Menüs:
der "Bereich"-Menüpunkt muß ggf. grau dargestellt werden}
var
WEnable:Word;
begin
if Synced then WEnable:=MF_Enabled
else WEnable:=MF_Grayed;
EnableMenuItem(GetMenu(HWindow),CM_Bereich,WEnable or MF_ByCommand);
end;
procedure TMain.CMEnde(var Msg:TMessage);
begin
SendMessage(HWindow,WM_Close,0,0);
end;
procedure TMain.CMBereich(var Msg:TMessage);
{Bereich abfahren: 2 Dialogfenster hintereinander (falls die erste mit OK
beantwortet wurde)}
begin
if Application^.ExecDialog(New(PBereichDlg,
Init(@Self,MakeIntResource(ID_Bereich))))=ID_OK then
Application^.ExecDialog(New(PStepDlg,
Init(@Self,MakeIntResource(ID_StepDlg))));
end;
procedure TMain.CMConnect(var Msg:TMessage);
{Nicht DDE! Hiermit wird ein neuer Motor ausgewählt}
begin
if Application^.ExecDialog(New(PMotorSelDlg,
Init(@Self,MakeIntResource(ID_Connect))))=ID_OK then begin
Versatz:=0.0;
SetScrollbars(0.0); {rücksetzen}
SetTextStrings(0.0); {Text auf Fragezeichen}
SetNewAlias; {für DDE}
EnableButtons;
end;
end;
procedure TMain.CMGrenzen(var Msg:TMessage);
{Neue Grenzen festlegen}
begin
if Application^.ExecDialog(New(PGrenzenDlg,
Init(@Self,MakeIntResource(ID_Grenzen))))=ID_OK then begin
{Wegen der neuen Grenzen müssen die Rollbalken mit neuen Grenzen versorgt
werden. Hierbei genügt der Grob-Rollbalken.}
SbGrob^.SetRange(Trunc(LeftBound+0.99),Trunc(RightBound-0.01));
if UnitUsed<>0 then
VxDsupC(SM_SetGear,UnitUsed,360*Faktor,Round(SchrittPU*256));
end;
end;
procedure TMain.CMSaveSettings(var Msg:TMessage);
{WasserMP.INI schreiben}
begin
if SaveSettings=false then {bei Fehlern meckern!}
Hinweis1(HWindow,ST_BadProfile,Profile);
end;
procedure TMain.CMHilfeIndex(var Msg:TMessage);
begin
WinHelp(HWindow,HelpFileName,HELP_Index,0);
end;
procedure TMain.CMHilfeDde(var Msg:TMessage);
begin
WinHelp(HWindow,HelpFileName,HELP_Context,CM_HelpDde);
end;
procedure TMain.CMAbout(var Msg:TMessage);
begin
Application^.ExecDialog(New(PDialog,Init(@Self,MakeIntResource(ID_About))));
end;
function TMain.CanClose;
{Aufruf beim Beenden von MOTORST: Warnung ausgeben bei aktiver DDE-Verbindung}
begin
CanClose:=false;
if IsDlgButtonChecked(HWindow,ID_DdeVerb)=1 then begin
if HinweisFrage(HWindow,ST_BreakDde,Mem[0:0], {nil via VAR-Parameter}
MB_IconQuestion or MB_OKCancel)<>IDOK then exit;
end;
WinHelp(HWindow,HelpFileName,HELP_Quit,0);
Dispose(DdeServ,Done);
AssignMotor(0); {Abmelden}
CanClose:=true;
end;
procedure TMain.SetNewAlias;
{Neues DDE-Alias-Topic setzen, wird bei jedem Motorwechsel aufgerufen}
const
OldUnit: Byte=0;
S:array[0..6]of Char='MotorX';
begin
if UnitUsed<>OldUnit then begin
if UnitUsed<>0 then begin
S[5]:=Chr(UnitUsed+Ord('W')); {X,Y oder Z setzen}
DdeServ^.SetAlias(S);
end else begin
DdeServ^.SetAlias(nil); {kein Alias!}
end;
OldUnit:=UnitUsed;
end;
end;
procedure TMain.SetInMove(AValue:Bool);
{Gesonderter Schreibzugriff auf DDE-kontrollierte Variable}
begin
if InMove<>AValue then begin
InMove:=AValue;
DdeServ^.Advise(2);
end;
end;
procedure TMain.SetSynced(AValue:Bool);
{Gesonderter Schreibzugriff auf DDE-kontrollierte Variable}
begin
if Synced<>AValue then begin
Synced:=AValue;
DdeServ^.Advise(3);
end;
end;
procedure TMain.SetMStrom(AValue:Bool);
{Gesonderter Schreibzugriff auf DDE-kontrollierte Variable}
begin
if MStrom<>AValue then begin
MStrom:=AValue;
end;
if MStrom=false then SetSynced(false);
end;
{Diese Funktion meldet den Motor an und ggf. den alten Motor ab
Mit 0 wird der Motor nur abgemeldet!
Funktion liefert TRUE, wenn Anmeldung okay
Solcherart Funktionen sind übrigens typisch für SDI-Programme}
function TMain.AssignMotor(NewUnit: Byte):boolean;
begin
AssignMotor:=false;
if (UnitUsed<>0) then begin
SetMStrom(false);
VxDsupC(SM_Stop,UnitUsed,0,0);
VxDsupC(SM_UnAssign,UnitUsed,0,0);
UnitUsed:=0;
end;
if MPK3D_Entry<>nil then begin
if NewUnit<>0 then begin
if VxDsupC(SM_Assign,NewUnit,0,0)=0 then begin
UnitUsed:=NewUnit;
VxDsupC(SM_SetPostMsg,UnitUsed,LongInt(@PostMessage),
MakeLong(HWindow,WM_MovEnd));
VxDsupC(SM_SetGear,UnitUsed,360*Faktor,Round(SchrittPU*256));
if UseDreieck then
VxDsupC(SM_SetHWE,UnitUsed,0,1 shl 17); {Ggf. Dreiecksbetrieb}
AssignMotor:=true;
end;
end else begin
UnitUsed:=0;
AssignMotor:=true; {0 ist immer okay!}
end;
end;
end;
procedure TMain.SetTextStrings(Z: TReal);
{Anzeige in den Editfenstern (absolute sowie relative Position)
auf Z aktualisieren, hierbei erfolgt KEIN DDE-Advise!
Ein Fragezeichen wird angezeigt, wenn die Position ungültig ist}
var
S: TS31;
begin
if Synced then
Real2S(Z,3,S)
else
lStrCpy(S,STQuest);
SetDlgItemText(HWindow,ID_AbsWert,S);
if Synced then
Real2S(Z+Versatz,3,S)
else
lStrCpy(S,STQuest);
SetDlgItemText(HWindow,ID_RelWert,S);
if LastFocusedEdit<>0 then
SendDlgItemMessage(HWindow,LastFocusedEdit,EM_SetSel,0,MakeLong(0,$FFFF));
end;
procedure TMain.IDSbGrob(var Msg:TMessage);
{Beim Bewegen des Thumbs mit der Maus sollen die Anzeige (Editfenster)
mitlaufen; beim Loslassen schließlich soll die Bewegung dahin initiiert
werden. Dasselbe gilt beim Loslassen der Cursortaste
Außerdem wird LastFocusedEdit zurückgesetzt, damit der Knopf "Zur Position"
eine Fehlermeldung auslöst (nun, man könnte ihn auch deaktivieren...)}
var
Z:TReal;
begin
LastFocusedEdit:=0;
Z:=SbGrob^.GetPosition+SbFein^.GetPosition/SBFaktor;
SetTextStrings(Z);
if Msg.wParam=SB_EndScroll then begin
{ MessageBeep(Word(-1));}
if Synced then begin
MoveMotor(Z);
end else begin
Hinweis1(HWindow,ST_NoReffahrt,nil);
end;
end;
end;
procedure TMain.IDSbFein(var Msg:TMessage);
{Tatsächlich genügt es hier, dieselbe Routine wie bei IDSBGROB zu benutzen}
begin
IDSbGrob(Msg);
end;
procedure TMain.IDRefFahrt(var Msg:TMessage);
{...beim Drücken auf den Knopf "Referenzfahrt"}
var
Z: TReal;
begin
if Synced then begin
Z:=10.0;
if RefSpeed>0 then Z:=-Z;
if SchrittPU<0 then Z:=-Z;
Z:=Z+RefPos;
MoveMotor(Z); {10° neben dem Referenzschalter auf der richtigen Seite}
while InMove do ShortYield; {Warten bis Ende}
end else begin
if HinweisFrage(HWindow,1,self,MB_OKCancel)<>IDOK then exit;
end;
SetSynced(false);
if DoReffahrt then begin {Referenzfahrt durchführen}
MoveMotor(0.0); {Rückbewegung in Warteschlange stellen}
end else begin
Hinweis1(HWindow,ST_BadReffahrt,nil);
end;
end;
procedure TMain.IDStop(var Msg:TMessage); {Knopf "Stop"}
begin
MovReq:=false; {Queue leeren}
VxDsupC(SM_Stop,UnitUsed,0,0); {Motor anhalten, das Callback kommt}
end;
procedure TMain.IDFree(var Msg:TMessage); {Knopf "Frei"}
begin
MovReq:=false; {Queue leeren}
if InMove then VxDsupC(SM_Stop,UnitUsed,0,0); {Motor anhalten}
if VxDsupC(SM_Free,UnitUsed,0,0)=0 then begin {Motor freischalten}
SetMStrom(false);
Port[PortBasis+7]:=0;
EnableButtons;
end;
end;
procedure TMain.WMConnect(var Msg:TMessage);
{DDE-Verbindung, wParam enthält Zustand, ob DDE aktiv oder nicht (mehr)}
begin
CheckDlgButton(HWindow,ID_DdeVerb,Msg.wParam);
{Rückgaben von Dialogfenstern sind nur so möglich!}
SetWindowLong(hWindow,DWL_MsgResult,1);
end;
procedure TMain.WMPoke(var Msg:TMessage);
{DDE-Poke auf ein Datenelement (nur CF_Text),
wParam=Nummer (1-basiert), lParam=Stringzeiger}
var
Z:TReal;
begin
Msg.Result:=DDE_fNotProcessed;
case Msg.wParam of
1: if S2Real(PChar(Msg.lParam),Z) then
if InInit then Msg.ResultLo:=DDE_fBusy
else if MoveMotorQuiet(Z-Versatz) then
Msg.ResultLo:=DDE_fAck;
2,3: ; {Kein POKE für Variablen InMove und Synced zulassen!}
end;
SetWindowLong(hWindow,DWL_MsgResult,Msg.Result);
end;
procedure TMain.WMExecute(var Msg:TMessage);
{DDE-Execute (nur CF_Text), lParam=Stringzeiger}
var
Z: TReal;
begin
Msg.Result:=DDE_fNotProcessed;
if (StrLIComp(PChar(Msg.lParam),'Move',4)=0)
and S2Real(@(PChar(Msg.lParam)[4]),Z) then begin
if InInit then Msg.ResultLo:=DDE_fBusy
else if MoveMotorQuiet(Z-Versatz)
then Msg.ResultLo:=DDE_fAck
end else if lStrCmpi(PChar(Msg.lParam),'Sync')=0 then begin
if InInit then Msg.ResultLo:=DDE_fBusy
else if DoReffahrt {Nur Referenzfahrt (sozusagen "still")}
then Msg.ResultLo:=DDE_fAck
end else if lStrCmpi(PChar(Msg.lParam),'Init')=0 then begin
InInit:=true;
Versatz:=0.0; {einzige Möglichkeit, den Versatz zurückzustellen}
IDRefFahrt(Msg); {dasselbe wie beim Drücken der Taste tun}
while InMove or MovReq do ShortYield; {Zurückkehren erst, wenn fertig!}
InInit:=false;
if Synced then
Msg.ResultLo:=DDE_fAck; {OK melden, wenn synchronisiert}
end else if lStrCmpi(PChar(Msg.lParam),'Wait')=0 then begin
while InMove or MovReq do ShortYield;
Msg.ResultLo:=DDE_fAck; {immer OK melden}
end else if lStrCmpi(PChar(Msg.lParam),'Stop')=0 then begin
if VxDsupC(SM_Stop,UnitUsed,0,0)=0
then Msg.ResultLo:=DDE_fAck
end else if lStrCmpi(PChar(Msg.lParam),'Free')=0 then begin
if VxDsupC(SM_Free,UnitUsed,0,0)=0 then begin
SetMStrom(false);
Port[PortBasis+7]:=0;
EnableButtons;
Msg.ResultLo:=DDE_fAck;
end;
end;
SetWindowLong(hWindow,DWL_MsgResult,Msg.Result);
end;
procedure TMain.WMRequest(var Msg:TMessage);
{DDE-Request auf ein Datenelement (nur CF_Text),
wParam=Nummer (1-basiert), lParam=Stringzeiger
Die zur Verfügung gestellte Stringlänge ist hierbei 32 Bytes (TS31)}
begin
Msg.Result:=1;
case Msg.wParam of
1: Real2S(CurPos+Versatz,3,PChar(Msg.lParam));
2: wvsprintf(PChar(Msg.lParam),STDez,InMove);
3: wvsprintf(PChar(Msg.lParam),STDez,Synced);
else Msg.ResultLo:=0;
end;
SetWindowLong(hWindow,DWL_MsgResult,Msg.Result);
end;
{Vom VxD gerufene Bewegungsende-Routine}
procedure TMain.WMMovEnd(var Msg:TMessage);
var
S:TS31;
begin
if MStrom then Port[PortBasis+7]:=3; {Relais EIN}
if UseBrake then Port[PortBasis+7]:=Port[PortBasis+7]and not 1;{Motor AUS}
if Msg.lParam<>INVPOS then begin
SetSynced(true);
CurPos:=Msg.lParam/Faktor; DdeServ^.Advise(1);
SetScrollbars(CurPos);
SetTextStrings(CurPos);
{ wvsprintf(S,'Msg.lParam (Position) = %ld',Msg.lParam);
MessageBox(HWindow,S,'Test WMMovEnd',0);}
end else SetSynced(false);
SetInMove(false);
if MovReq then begin
MoveMotor(NextPos);
MovReq:=false;
end else begin
CheckDlgButton(HWindow,ID_InFahrt,0); {Lämpchen AUS}
EnableButtons; {Ggf. Schalter aktivieren}
end;
if InformDlg<>0 then {Kindfenster informieren}
SendMessage(InformDlg,WM_MovEnd,Msg.wParam,Msg.lParam);
end;
{Vom untergeordneten Dialogfenster gerufene Routine, in wParam
steht ein BOOL, ob eine Initialisierung stattfinden soll}
procedure TMain.WMProceed(var Msg:TMessage);
const
MemPos: TReal=0.0; {Statische Variable, die nur hier gültig ist}
begin
Msg.Result:=0;
MemPos:=MemPos+BereichSchritt;
if Msg.wParam<>0 then {Initialisierung (Fahrt zum Startpunkt)?}
MemPos:=BereichVon; {Ja!}
{Je nach Fahrtrichtung Endebedingung prüfen}
if (BereichSchritt<0) and (MemPos>=BereichBis)
or (BereichSchritt>0) and (MemPos<=BereichBis) then begin
if MoveMotor(MemPos-Versatz) then
Msg.ResultLo:=1; {als auch über "Umweg"}
end;
SetWindowLong(hWindow,DWL_MsgResult,Msg.Result);
end;
{Vom untergeordneten Dialogfenster gerufene Routine zum Neuzuweisen
des Motors, wParamLo enthält die neue Motornummer}
procedure TMain.WMAssign(var Msg:TMessage);
begin
Msg.Result:=LongInt(AssignMotor(Msg.wParamLo));
SetWindowLong(hWindow,DWL_MsgResult,Msg.Result);
end;
procedure TMain.IDEditAbs(var Msg:TMessage);
{Letzte Fokuszuweisung merken für richtige Wirkung des Schalters
"Zur Position", wParam enthält Fenster-ID}
begin
if Msg.lParamHi=EN_SetFocus then LastFocusedEdit:=Msg.wParam;
Msg.Result:=0;
end;
procedure TMain.IDEditRel(var Msg:TMessage);
{Letzte Fokuszuweisung merken für richtige Wirkung des Schalters
"Zur Position"}
begin
if Msg.lParamHi=EN_SetFocus then LastFocusedEdit:=Msg.wParam;
Msg.Result:=0;
end;
procedure TMain.IDGoto;
{Knopf "Zur Position": Je nach zuletzt aktiviertem Dialogelement
* relative Position anfahren oder
* absolute Position anfahren oder
* Fehlermeldung ausgeben}
var
S: TS31;
Z,V: TReal;
begin
if LastFocusedEdit=ID_AbsWert then begin
GetDlgItemText(HWindow,ID_AbsWert,S,sizeof(S));
V:=0.0;
end else if LastFocusedEdit=ID_RelWert then begin
GetDlgItemText(HWindow,ID_RelWert,S,sizeof(S));
V:=Versatz;
end else begin
Hinweis1(HWindow,ST_NoEditFocused,S);
exit;
end;
if S2Real(S,Z) and (UnitUsed<>0) then begin
MoveMotor(Z-V);
end else begin
Hinweis1(HWindow,ST_BadNumber,S);
end;
SetFocus(GetDlgItem(HWindow,LastFocusedEdit));
{Zurückfokussieren, damit der User sieht, welchen Wert er setzte}
{ SendDlgItemMessage(HWindow,LastFocusedEdit,EM_SetSel,0,MakeLong(0,$FFFF));
{und alles markieren, damit gleich ein neuer Wert eingegeben werden kann}
end;
procedure TMain.IDSetNull;
{Knopf "Nullpunkt setzen"}
var
S: TS31;
Z: TReal;
begin
GetDlgItemText(HWindow,ID_AbsWert,S,sizeof(S));
if S2Real(S,Z) then begin
if (-90<=Z) and (Z<=90) then begin
Versatz:=-Z;
SetTextStrings(Z); {logischerweise wird RelPos nun 0}
Ddeserv^.Advise(1); {Neue Relativposition!}
end else begin
Hinweis1(HWindow,ST_BadZeroRange,S);
end;
end else begin
Hinweis1(HWindow,ST_BadNumber,S);
end;
end;
procedure TMain.SetScrollbars(nach: TReal);
{Interne Routine zum Setzen der Rollbalken auf einen bestimmten Punkt,
z.B. bei Bewegungsende}
var
p1,p2:Integer;
begin
p1:=Round(nach); {Gerundeter Wert}
p2:=Round((nach-p1)*SBFaktor);{Verbleibende Differenz}
SbGrob^.SetPosition(p1);
SbFein^.SetPosition(p2);
end;
procedure TMain.EnableButtons;
{Generalroutine, die je nach diversen programmglobalen Flags die Tasten
freischaltet oder sperrt. Lt. Dok. prüft EnableWindow() zuerst den
Momentanzustand eines Fensters.}
var
B: Bool;
begin
B:=Synced;
EnableWindow(GetDlgItem(HWindow,ID_Goto),B);
EnableWindow(GetDlgItem(HWindow,ID_Nullpunkt),B);
B:=InMove;
EnableWindow(GetDlgItem(HWindow,ID_Stop),B);
B:=UnitUsed<>0;
EnableWindow(GetDlgItem(HWindow,ID_Reffahrt),B);
B:=B and MStrom;
EnableWindow(GetDlgItem(HWindow,ID_Free),B);
end;
function TMain.DoReffahrt:boolean;
{Knopf "Referenzfahrt"}
begin
DoReffahrt:=false;
if MStrom then Port[PortBasis+7]:=3; {Motor EIN}
SetMStrom(true);
Port[PortBasis+7]:=1; {Relais AUS}
if NOMOTOR and (VxDsupC(SM_Sync,UnitUsed,INVPOS,0)=0)
or not NoMotor and VxDsupR(SM_Sync,RefPos,RefSpeed) then begin
CheckDlgButton(HWindow,ID_InFahrt,1); {Lämpchen EIN}
SetInMove(true);
EnableButtons;
DoReffahrt:=true;
end;
end;
function TMain.MoveMotorQuiet(nach: TReal):boolean;
{Motor auf neue Position setzen ohne Messagebox bei Fehler (für DDE)}
begin
if InMove then begin {Gerade beschäftigt?}
NextPos:=nach; {Anforderung in Warte"schlange" stellen}
MovReq:=true;
MoveMotorQuiet:=true; {und "okay" melden}
end else begin
VxDsupR(SM_SetBounds,LeftBound,RightBound);
VxDsupR(SM_SetSA,MoveSpeed,MoveAccel);
Port[PortBasis+7]:=3; {Motor EIN}
Port[PortBasis+7]:=1; {Relais AUS}
if VxDsupR(SM_MoveAbs,Nach,0.0) then begin
CheckDlgButton(HWindow,ID_InFahrt,1); {Lämpchen EIN}
SetInMove(true);
EnableButtons;
MoveMotorQuiet:=true;
end else begin
MoveMotorQuiet:=false;
end;
end;
end;
function TMain.MoveMotor(nach: TReal):boolean;
{Motor auf neue Position setzen, mit Messagebox bei Fehler}
var
S: TS31;
{ L: LongInt;}
begin
{ L:=Round(nach*Faktor);
wvsprintf(S,'Der Move-Befehl geht zu %ld',L);
MessageBox(HWindow,S,'Motor-Start',0);}
if MoveMotorQuiet(nach) then begin
MoveMotor:=true;
end else begin
Real2S(Nach,3,S);
Hinweis1(HWindow,ST_BadMove,S);
MoveMotor:=false;
end;
end;
{*******************}
{Applikations-Objekt}
{*******************}
type
PApp=^TApp;
TApp=object(TApplication)
procedure InitMainWindow; virtual; {sonst wäre es nur ein leeres Fenster}
end;
procedure TApp.InitMainWindow;
begin
inherited InitMainWindow;
MainWindow:=New(PMain,Init(nil,MakeIntResource(100)));
end;
var
App:TApp;
begin
if lStrCmpi(CmdLine,'/debug')=0 then NoMotor:=true;
App.Init(AppName);
App.Run;
App.Done;
end.
| Detected encoding: OEM (CP437) | 1
|
|
|