{$A+,B-,G+,F-,K+,W-} {Standard-Codeerzeugung}
{$P-,T-,V+,X+} {Compiler-Prfungen}
{ $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 Endprfung
* Sync=0: immer Relativbewegung, Sync=1: immer Absolutbewegung
* ber DDE: mit Sync=0 keine (Absolut-)Bewegung m”glich
* Referenzfahrt ignoriert anfangs gedrckte Endtaster; w„hrenddessen
gedrckte 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 Ausfhrung}
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 fr 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;
{Menkommandos}
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;
{*********** Menkommandos **************}
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;
{Menpunkt "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 Mens:
der "Bereich"-Menpunkt 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 ungltig 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));
{Zurckfokussieren, 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 Drcken 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 durchfhren}
MoveMotor(0.0); {Rckbewegung 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 gengt 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 fr 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); {rcksetzen}
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);
{Rckgaben 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 fr 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 Drcken der Taste tun}
while InMove or MovReq do ShortYield; {Zurckkehren 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 Verfgung 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 gltig 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 prfen}
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 (fr 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: UTF-8 | 0
|