{$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+} {TReal=Single, Windows liefert Kopro-Emulator}
{$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}
{Hausaufgaben:
* INI neben EXE oder im Windows-Vrz.
* Kein Reftaster bedeutet: Referenzfahrt setzt SYNC (keine weitere Aktion)
* Kein Endtaster bedeutet: Keine softwaremäßige Endprüfung
* Sync=0: immer Relativbewegung, Sync=1: immer Absolutbewegung
* über DDE: mit Sync=0 keine (Absolut-)Bewegung möglich
* Referenzfahrt ignoriert anfangs gedrückte Endtaster; währenddessen
gedrückte Endtaster (außer =Reftaster) bewirken STOP und Fehlermeldung
* Anfahren der Endtaster (genauer: Überfahren mit mehr als 256
Mikroschritten) bewirkt STOP und Fehlermeldung
* Reftaster AND Endtaster <>0 bedeutet: Keine Abfrage vor Reffahrt!
(denn dann kann der Motor niemals "außerhalb" sein)
* Standard-Verhalten: STOP=Motoren bestromt, SYNC behalten;
FREI=Motoren stromlos, SYNC:=0
* Schalter "FREI bei Bewegungsende" bewirkt: Spulenstrom wird bei
regulärem Bewegungsende abgeschaltet. Button "FREI" beläßt SYNC,
falls Motor nicht INMOVE
* Angabe ON-Byte: Spulenstrom-Abschaltung erfolgt über diese Portadresse
anstelle oder zusätzlich zur Spulenstrom-Reduktion
* Angabe BREMS-Byte: Bei regulärem Bewegungsende wird Bremse angezogen
und Spulenstrom abgeschaltet (ggf. via ON-Byte)
}
uses WinProcs,WinTypes,Objects,OWindows,ODialogs,Win31,DdeMl,Strings,
umstep,smsh,smsp,smsdde,Dialogs,LoadSave,windos;
{*********************************}
{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;
{DDE-Variablen}
DdeServ: PMyDDE; {initialisierte Instanz}
ScrollMultiplier: TReal; {Faktor für Rollbalken-Zugriff}
EdPrecis: Integer; {Nachkommastellen beim Editfenster}
Versatz: TReal;
{Methoden}
function GetClassName:PChar; virtual;
procedure GetWindowClass(var AWndClass:TWndClass); virtual;
procedure SetupWindow; virtual;
function CanClose:Boolean; virtual;
procedure WMInitMenu(var Msg:TMessage); virtual WM_First+WM_InitMenu;
{Menükommandos}
procedure CMMSel(var Msg:TMessage); virtual CM_First+CM_MSel;
procedure CMEnde(var Msg:TMessage); virtual CM_First+CM_Ende;
procedure CMBereich(var Msg:TMessage); virtual CM_First+CM_Bereich;
procedure CMSetup(var Msg:TMessage); virtual CM_First+CM_Setup;
procedure CMSave0(var Msg:TMessage); virtual CM_First+CM_Save0;
procedure CMPassword(var Msg:TMessage); virtual CM_First+CM_Password;
procedure CMAutoSave(var Msg:TMessage); virtual CM_First+CM_AutoSave;
procedure CMSaveNow(var Msg:TMessage); virtual CM_First+CM_SaveNow;
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 IDSetNull(var Msg:TMessage); virtual ID_First+ID_Nullpunkt;
procedure IDGoto(var Msg:TMessage); virtual ID_First+ID_Goto;
procedure IDRefFahrt(var Msg:TMessage); virtual ID_First+ID_RefFahrt;
procedure IDSbGrob(var Msg:TMessage); virtual ID_First+ID_SbGrob;
procedure IDSbFein(var Msg:TMessage); virtual ID_First+ID_SbFein;
procedure IDStop(var Msg:TMessage); virtual ID_First+ID_Stop;
procedure IDFree(var Msg:TMessage); virtual ID_First+ID_Free;
{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 SetScrollRanges;
procedure SetInMove(AValue:Bool);
procedure SetSynced(AValue:Bool);
procedure SetMStrom(AValue:Bool);
function AssignMotor(NewConfig: PChar):boolean;
procedure SaveWindowPos;
end;
{************** Gedeih und Verderb ***************}
function TMain.GetClassName:PChar;
begin
GetClassName:=AppName;
end;
procedure TMain.GetWindowClass(var AWndClass:TWndClass);
begin
inherited GetWindowClass(AWndClass);
AWndClass.hIcon:=LoadIcon(hInstance,MakeIntResource(IDC_Main));
end;
procedure TMain.SetupWindow;
var
EC: Integer;
S: TS31;
S2: TS255;
SysMenu: HMenu;
SP: PChar;
R: TRect;
I: Integer;
begin
SbGrob:=New(PScrollBar,InitResource(@self,ID_SbGrob));
SbFein:=New(PScrollBar,InitResource(@self,ID_SbFein));
InMove:=false;
MovReq:=false;
Synced:=false;
MStrom:=false;
InInit:=false;
EdPrecis:=3;
Versatz:=0.0;
inherited SetupWindow;
if (LongRec(UMSTEP_Entry).Hi=0)
and (Hinweis1(HWindow,ST_AskInstallVxD,nil)=IDYes) then begin
GetModuleFileName(Seg(HInstance),S2,sizeof(S2));
lstrcpy(GetFileNamePtr(S2),VxDName);
if (AddRemoveVxD(S2,VxDName)=0)
and (Hinweis1(HWindow,ST_RestartWindows,nil)=IDOK)
then ExitWindows(EW_RestartWindows,0);
end;
LongRec(AMotor.CallbackUser).Lo:=HWindow;
LongRec(AMotor.CallbackUser).Hi:=WM_MovEnd;
SysMenu:=GetSystemMenu(HWindow,false);
DeleteMenu(SysMenu,SC_Zoom,MF_ByCommand);
DeleteMenu(SysMenu,SC_Size,MF_ByCommand);
DdeServ:=New(PMyDDE,Init(HWindow));
{DDE weiter initialisieren}
SetScrollRanges;
{Grob-Rollbalken-Ränder derart setzen, daß niemals Überläufe auftreten}
SetScrollbars(0.0); {Rollbalken mittig positionieren}
for I:=1 to GetArgCount do begin
GetArgStr(S,I,sizeof(S));
if lstrcmpi(S,'/debug')=0 then NoMotor:=true
else if LongRec(CurrentConfig).Hi=0 then AssignMotor(S)
else begin
GetModuleFileName(Seg(HInstance),S2,sizeof(S2));
lstrcat(S2,' ');
lstrcat(S2,S);
WinExec(S2,CmdShow);
end;
end;
if (LongRec(CurrentConfig).Hi=0)
and (GetPrivateProfileString(Generic,'DefaultMotor','',
S,sizeof(S),Profile)<>0)
then AssignMotor(S);
AutoSave:=GetPrivateProfileInt(Generic,'AutoSave',0,Profile)<>0;
if AutoSave
then CheckMenuItem(GetMenu(HWindow),CM_AutoSave,MF_ByCommand or MF_Checked);
if GetPrivateProfileString(Generic,'Password','',
Password,sizeof(Password),Profile)=0
then Authorized:=true;
SP:=CurrentConfig; if LongRec(SP).Hi=0 then SP:=Generic;
GetWindowRect(HWindow,R);
Dec(R.right,R.left); Dec(R.bottom,R.top);
R.left:=Integer(GetPrivateProfileInt(SP,'Window.Left',R.left,Profile));
R.top:=Integer(GetPrivateProfileInt(SP,'Window.Top',R.top,Profile));
MoveWindow(HWindow,R.left,R.top,R.right,R.bottom,false);
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 Hinweis(HWindow,ST_BreakDde,CurrentConfig)<>IDOK then exit;
end;
if AutoSave then SaveWindowPos;
WinHelp(HWindow,HelpFileName,HELP_Quit,0);
Dispose(DdeServ,Done);
AssignMotor(nil); {Abmelden}
Dispose(SbGrob,Done);
Dispose(SbFein,Done);
CanClose:=true;
end;
{*********** Menükommandos **************}
procedure TMain.CMMSel(var Msg:TMessage);
begin
if Application^.ExecDialog(New(PMSelDlg,
Init(@Self,MakeIntResource(CM_MSel))))=ID_OK then begin
end;
end;
procedure TMain.CMEnde(var Msg:TMessage);
begin
CloseWindow;
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.CMSetup(var Msg:TMessage);
{Neue Motor-Ports, Betriebsweise und Grenzen festlegen. Bei "OK" Motor-
steuerung reinitialisieren (Synced:=false u.ä.) und bei gesetztem AutoSave
speichern}
begin
if Application^.ExecDialog(New(PSetupDlg,
Init(@Self,MakeIntResource(CM_Setup))))=ID_OK then begin
{ Versatz:=0.0;}
SetScrollRanges;
SetMotorStruc;
SMSetMotor(false,AMotor);
SetDlgItemText(HWindow,ID_Einheit,MotorR.UnitName);
end;
end;
procedure TMain.CMSave0;
{Menüpunkt "Nullpunkt speichern"}
begin
MotorR.Refpoint:=MotorR.Refpoint+Versatz;
if (LongRec(CurrentConfig).Hi<>0) and CheckPassword(HWindow)
then SaveSet(CurrentConfig); {Naja, speichern wir halt alles!}
end;
procedure TMain.CMPassword(var Msg:TMessage);
{Paßwort setzen/ändern. Das neue Paßwort wird unabhängig von AutoSave
sofort gespeichert}
begin
if ChangePassword(HWindow)
then WritePrivateProfileString(Generic,'Password',Password,Profile);
end;
procedure TMain.CMAutoSave(var Msg:TMessage);
{"Automatisch speichern" umschalten (Menü-Häkchen). Der neue Zustand
wird sofort gespeichert}
var
S: array[0..1] of Char;
MC: Word absolute S;
begin
AutoSave:=not AutoSave;
MC:=MF_ByCommand or MF_UnChecked;
if AutoSave then MC:=MF_ByCommand or MF_Checked;
CheckMenuItem(GetMenu(HWindow),CM_AutoSave,MC);
MC:=Ord('0'); if AutoSave then Inc(MC);
WritePrivateProfileString(Generic,'AutoSave',S,Profile);
end;
procedure TMain.CMSaveNow(var Msg:TMessage);
begin
if (LongRec(CurrentConfig).Hi<>0)
and CheckPassword(HWindow) then SaveSet(CurrentConfig);
SaveWindowPos;
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,100);
end;
procedure TMain.CMAbout(var Msg:TMessage);
begin
Application^.ExecDialog(New(PDialog,Init(@Self,MakeIntResource(ID_About))));
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);
if Versatz<>0.0 then WEnable:=MF_Enabled
else WEnable:=MF_Grayed;
EnableMenuItem(GetMenu(HWindow),CM_Save0,WEnable or MF_ByCommand);
end;
procedure TMain.SaveWindowPos;
var
SP: PChar;
S: TS31;
R: TRect;
begin
SP:=CurrentConfig; if LongRec(SP).Hi=0 then SP:=Generic;
GetWindowRect(HWindow,R);
wvsprintf(S,'%d',R.left);
WritePrivateProfileString(SP,'Window.Left',S,Profile);
wvsprintf(S,'%d',R.top);
WritePrivateProfileString(SP,'Window.Top',S,Profile);
end;
procedure TMain.SetInMove(AValue:Bool);
{Gesonderter Schreibzugriff auf DDE-kontrollierte Variable}
begin
if InMove<>AValue then begin
InMove:=AValue;
CheckDlgButton(HWindow,ID_InFahrt,Word(AValue)); {Lämpchen EIN oder AUS}
EnableWindow(GetItemHandle(ID_Stop),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;
EnableWindow(GetItemHandle(ID_Nullpunkt),AValue);
AVAlue:=AValue or (AMotor.CFlags and MC_SyncRequired =0);
EnableWindow(GetItemHandle(ID_Goto),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;
EnableWindow(GetItemHandle(ID_Free),AValue);
end;
if AValue=false then SetSynced(false);
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,EdPrecis,S)
else
lStrCpy(S,'?');
SetDlgItemText(HWindow,ID_EdPos,S);
SendDlgItemMsg(ID_EdPos,EM_SetSel,0,$FFFF0000);
end;
{************ Reaktionen auf Dialogelemente ************}
procedure TMain.IDSetNull;
{Knopf "Nullpunkt setzen"}
var
S: TS31;
Z: TReal;
begin
GetDlgItemText(HWindow,ID_EdPos,S,sizeof(S));
if S2Real(S,Z) then begin
Versatz:=Versatz+Z;
Z:=0.0;
SetTextStrings(Z); {logischerweise wird RelPos nun 0}
Ddeserv^.Advise(1); {Neue Relativposition!}
end else begin
Hinweis1(HWindow,ST_BadNumber,S);
end;
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: TReal;
begin
GetDlgItemText(HWindow,ID_EdPos,S,sizeof(S));
if S2Real(S,Z) and (AMotor.Handle<>0) then begin
MoveMotor(Z);
end else begin
Hinweis1(HWindow,ST_BadNumber,S);
end;
SetFocus(GetItemHandle(ID_EdPos));
{Zurückfokussieren, damit der User sieht, welchen Wert er setzte}
SendDlgItemMsg(ID_EdPos,EM_SetSel,0,$FFFF0000);
{und alles markieren, damit gleich ein neuer Wert eingegeben werden kann}
end;
procedure TMain.IDRefFahrt(var Msg:TMessage);
{...beim Drücken auf den Knopf "Referenzfahrt"}
var
Z: TReal;
begin
if InMove then exit; {nicht rekursiv!}
if WordRec(AMotor.RefW).Lo=0 then exit; {keine Referenzfahrt möglich}
if Synced then begin
Z:=Abs(MotorR.FastRefOfs);
if MotorR.RefSpeed>0 then Z:=-Z;
Z:=Z+MotorR.RefPoint-Versatz;
MoveMotor(Z);
{einige Grad neben den Referenzschalter auf die richtige Seite fahren}
while InMove do ShortYield; {Warten bis Ende}
end else begin
if (WordRec(AMotor.EndW).Lo and WordRec(AMotor.RefW).Lo =0)
{Hinweisfenster unnötig, wenn einer der Endtaster = Referenztaster}
and (Hinweis(HWindow,ST_StartReffahrt,CurrentConfig)<>IDOK)
then exit; {User will nicht}
end;
SetSynced(false);
if DoReffahrt then begin {Referenzfahrt durchführen}
MoveMotor(0.0); {Rückbewegung in Warteschlange stellen}
end else begin
Hinweis(HWindow,ST_BadReffahrt,CurrentConfig);
end;
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}
var
Z:TReal;
begin
Z:=(SbGrob^.GetPosition+SbFein^.GetPosition/100)/ScrollMultiplier-Versatz;
SetTextStrings(Z);
if Msg.wParam=SB_EndScroll then begin
if not Synced and (AMotor.CFlags and MC_SyncRequired <>0)
then Hinweis1(HWindow,ST_NoReffahrt,nil)
else MoveMotor(Z);
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.IDStop(var Msg:TMessage); {Knopf "Stop"}
begin
MovReq:=false; {Queue leeren}
SMStop(AMotor.Handle); {Motor anhalten, ggf. kommt das Callback}
end;
procedure TMain.IDFree(var Msg:TMessage); {Knopf "Frei"}
begin
MovReq:=false; {Queue leeren}
SMFree(AMotor.Handle); {Motor anhalten und freigeben}
SetSynced(false);
end;
{Diese Funktion meldet den Motor an und ggf. den alten Motor ab
Mit NIL wird der Motor nur abgemeldet!
Funktion liefert TRUE, wenn Anmeldung okay
Solcherart Funktionen sind wohl typisch für SDI-Programme!?}
function TMain.AssignMotor(NewConfig:PChar):boolean;
label l1;
var
S,S1: TS31;
Force:Boolean;
begin
AssignMotor:=false;
if (AMotor.Handle<>0) then begin
SetMStrom(false);
SMStop(AMotor.Handle);
SMRemoveMotor(AMotor.Handle);
AMotor.Handle:=0; {Motor abmelden}
end;
StrDispose(CurrentConfig); CurrentConfig:=nil;
if NewConfig<>nil then begin
LoadSet(NewConfig);
Force:=false;
while SMSetMotor(Force,AMotor)<>0 do begin
case Hinweis(HWindow,ST_NoMotor,NewConfig) of
ID_Retry: ;
ID_Ignore: Force:=true;
ID_Abort: goto l1;
end;
end;
CurrentConfig:=StrNew(NewConfig);
l1:
end;
LoadString(Seg(HInstance),ST_NewTitle,S,sizeof(S));
wvsprintf(S1,S,CurrentConfig);
SetWindowText(HWindow,S1);
SetDlgItemText(HWindow,ID_Einheit,MotorR.UnitName);
Versatz:=0.0;
SetScrollRanges;
SetScrollbars(0.0); {rücksetzen}
SetTextStrings(0.0); {Text auf Fragezeichen (?)}
DdeServ^.SetAlias(CurrentConfig);
EnableWindow(GetItemHandle(ID_Reffahrt),LongRec(CurrentConfig).Hi<>0);
end;
{*********** DDE-Funktionen ****************}
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) 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)
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
Versatz:=0.0;
InInit:=true;
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),'Stop')=0 then begin
if SMStop(AMotor.Handle)=0
then Msg.ResultLo:=DDE_fAck
end else if lStrCmpi(PChar(Msg.lParam),'Free')=0 then begin
if SMFree(AMotor.Handle)=0 then begin
SetMStrom(false);
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,EdPrecis,PChar(Msg.lParam));
2: wvsprintf(PChar(Msg.lParam),'%d',InMove);
3: wvsprintf(PChar(Msg.lParam),'%d',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 Msg.wParamHi and MF_Synced <>0 then begin
SetSynced(true);
CurPos:=Msg.lParam/256/MotorR.StepsPerUnit-Versatz; DdeServ^.Advise(1);
SetScrollbars(CurPos);
SetTextStrings(CurPos);
end else SetSynced(false);
SetInMove(false);
if MovReq then begin
MoveMotor(NextPos);
MovReq:=false;
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;
with Range do begin
MemPos:=MemPos+Step;
if Msg.wParam<>0 then {Initialisierung (Fahrt zum Startpunkt)?}
MemPos:=From; {Ja!}
{Je nach Fahrtrichtung Endebedingung prüfen}
if (Step<0) and (MemPos>=ToPos)
or (Step>0) and (MemPos<=ToPos) then begin
if MoveMotor(MemPos) then
Msg.ResultLo:=1; {als auch über "Umweg"}
end;
end;
SetWindowLong(hWindow,DWL_MsgResult,Msg.Result);
end;
{Vom untergeordneten Dialogfenster gerufene Routine zum Neuzuweisen
des Motors, lParam enthält die neue Motor-Sektion}
procedure TMain.WMAssign(var Msg:TMessage);
begin
AssignMotor(PChar(Msg.lParam));
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
nach:=(nach+Versatz)*ScrollMultiplier;
p1:=Round(nach); {Gerundeter Wert}
p2:=Round((nach-p1)*100); {Verbleibende Differenz}
SbGrob^.SetPosition(p1);
SbFein^.SetPosition(p2);
end;
procedure TMain.SetScrollRanges;
{Ermittelt ScrollMultiplier als Potenz von 10 derart, daß der Grob-Rollbalken
im Page-Betrieb mindestens 5x, höchstens jedoch 50x angeklickt
werden muß, um einen Bereich zu durchschreiten}
var
Z: TReal;
begin
with MotorR do begin
Z:=RightBound-LeftBound; {Abstand bestimmen}
Z:=ln(Z/333.333)/ln(10); {Dekadischer Logarithmus}
Z:=Round(Z);
Z:=1/exp(Z*ln(10));
ScrollMultiplier:=Z;
SbFein^.SetRange(-100,100);
SbGrob^.SetRange(Round(MotorR.LeftBound*Z+0.5),
Round(MotorR.RightBound*Z-0.5));
end;
end;
function TMain.DoReffahrt:boolean;
{DDE-Befehl "Referenzfahrt"}
begin
DoReffahrt:=false;
SetMStrom(true);
if SMSync(AMotor.Handle)=0 then begin
SetInMove(true);
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
Nach:=Nach+Versatz;
if SMMoveAbs(AMotor.Handle,Round(Nach*256*MotorR.StepsPerUnit))=0 then begin
SetInMove(true);
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;
begin
if MoveMotorQuiet(nach) then begin
MoveMotor:=true;
end else begin
Real2S(Nach,EdPrecis,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;
begin
New(PApp(Application),Init(AppName));
Application^.Run;
Application^.Done;
end.
| Detected encoding: OEM (CP437) | 1
|
|
|