unit Dialogs;
{Diverse Dialogfenster}
interface
uses WinProcs,WinTypes,OWindows,ODialogs,objects,
smsh,smsp,loadsave,umstep,strings;
const
ID_RangeFrom=101;
ID_RangeToPos=102;
ID_RangeStep=103;
ID_RbStepW=104;
ID_RbSteps=105;
ID_RbKey=106;
ID_RbWait=107;
ID_RangeWait=108;
type
PBereichDlg=^TBereichDlg;
TBereichDlg=object(TDialog)
LRange: TRange;
procedure SetupWindow; virtual;
procedure IDHilfe(var Msg:TMessage); virtual ID_First+ID_Help;
procedure IDRbWeite(var Msg:TMessage); virtual ID_First+ID_RbStepW;
procedure IDRbSchritte(var Msg:TMessage); virtual ID_First+ID_RbSteps;
procedure IDRbTaste(var Msg:TMessage); virtual ID_First+ID_RbKey;
procedure IDRbWarte(var Msg:TMessage); virtual ID_First+ID_RbWait;
function GetX:boolean;
function GetT:boolean;
function GetAEXT:Boolean;
procedure SetAEXT;
function CanClose:Boolean; virtual;
end;
{************************************************************}
const
ID_Proceed=101;
ID_Timer=ID_StepDlg;
type
PStepDlg=^TStepDlg;
TStepDlg=object(TDialog)
procedure SetupWindow; virtual;
procedure IDProceed(var Msg:TMessage); virtual ID_First+ID_Proceed;
procedure WMTimer(var Msg:TMessage); virtual WM_First+WM_Timer;
procedure WMMovEnd(var Msg:TMessage); virtual WM_First+WM_MovEnd;
destructor Done; virtual;
end;
{*** SETUP **************************************************}
const
ID_EdConfig =101;
ID_New =102;
ID_Delete =103;
ID_Save =104;
type
PSetupDlg=^TSetupDlg;
TSetupDlg=object(TDialog)
LMotorR: TMotorR;
procedure SetupWindow; virtual;
procedure IDNew(var Msg:TMessage); virtual ID_First+ID_New;
procedure IDDelete(var Msg:TMessage); virtual ID_First+ID_Delete;
procedure IDHelp(var Msg:TMessage); virtual ID_First+ID_Help;
function CanClose:Boolean; virtual;
end;
{*** Motor-Select *******************************************}
const
ID_CBSel=101;
ID_OKNewWindow=10;
type
PMSelDlg=^TMSelDlg;
TMSelDlg=object(TDialog)
procedure SetupWindow; virtual;
procedure IDOKNewWindow(var Msg:TMessage); virtual ID_First+ID_OKNewWindow;
procedure IDHelp(var Msg:TMessage); virtual ID_First+ID_Help;
function CanClose:Boolean; virtual;
end;
{************************************************************}
function CheckPassword(Wnd:HWnd):Boolean;
function ChangePassword(Wnd:HWnd):Boolean;
implementation
function CheckPassDlg(Wnd:HWnd; Msg,wParam:Word; lParam:LongInt):Bool; export;
var
S: array[0..sizeof(Password)-1] of Char;
begin
CheckPassDlg:=false;
case Msg of
WM_InitDialog: CheckPassDlg:=true;
WM_Command: case wParam of
IDOK: begin
wParam:=GetDlgItem(Wnd,101);
GetWindowText(wParam,S,sizeof(S));
if lstrcmp(S,Password)=0 then begin
Authorized:=true;
EndDialog(Wnd,ID_OK);
end else begin
if Hinweis1(Wnd,18,nil)=IDRetry then begin {"Paßwort falsch"}
SendMessage(wParam,EM_SetSel,0,$FFFF0000); {Markieren}
SetFocus(wParam); {Fokussieren}
end else begin
EndDialog(Wnd,IDCancel);
end;
end;
end;
IDCancel: EndDialog(Wnd,wParam);
ID_Help: WinHelp(Wnd,HelpFileName,HELP_Context,923);
end{case wParam};
end{case Msg};
end;
function CheckPassword;
begin
CheckPassword:=Authorized
or (DialogBox(Seg(HInstance),PChar(923),Wnd,@CheckPassDlg)=ID_OK);
end;
function ChangePassDlg(Wnd:HWnd; Msg,wParam:Word; lParam:LongInt):Bool; export;
var
S,S2: array[0..sizeof(Password)-1] of Char;
begin
ChangePassDlg:=false;
case Msg of
WM_InitDialog: begin
if Authorized then begin
wParam:=GetDlgItem(Wnd,101);
SetWindowText(wParam,Password);
EnableWindow(wParam,false); {Paßwort ist schon OK}
end;
ChangePassDlg:=true;
end;
WM_Command: case wParam of
IDOK: begin
repeat
wParam:=GetDlgItem(Wnd,101);
GetWindowText(wParam,S,sizeof(S));
if lstrcmp(S,Password)<>0 then begin Msg:=18; break; end;
Authorized:=true;
GetDlgItemText(Wnd,102,S,sizeof(S));
wParam:=GetDlgItem(Wnd,103);
GetWindowText(wParam,S2,sizeof(S2));
if lstrcmp(S,S2)<>0 then begin Msg:=19; break; end;
Msg:=0;
lstrcpy(Password,S);
EndDialog(Wnd,IDOK);
until true;
if Msg<>0 then begin
if Hinweis1(Wnd,Msg,nil)=IDRetry then begin {"Paßwort falsch"}
SendMessage(wParam,EM_SetSel,0,$FFFF0000); {Markieren}
SetFocus(wParam); {Fokussieren}
end else EndDialog(Wnd,IDCancel);
end;
end;
IDCancel: EndDialog(Wnd,IDCancel);
ID_Help: WinHelp(Wnd,HelpFileName,HELP_Context,CM_Password);
end{case wParam};
end{case Msg};
end;
function ChangePassword;
begin
ChangePassword:=DialogBox(Seg(HInstance),PChar(CM_Password),Wnd,
@ChangePassDlg)=ID_OK;
end;
procedure ReplaceUnits(FromWnd:HWnd; SP:PChar);
var
S,S1: TS31;
begin
while FromWnd<>0 do begin
GetWindowText(FromWnd,S,sizeof(S));
wvsprintf(S1,S,SP);
SetWindowText(FromWnd,S1);
FromWnd:=GetWindow(FromWnd,GW_HWndNext);
end;
end;
procedure TBereichDlg.SetupWindow;
begin
inherited SetupWindow;
LRange:=Range;
ReplaceUnits(GetWindow(HWindow,GW_Child),MotorR.UnitName);
with LRange do begin
SetAEXT;
CheckRadioButton(HWindow,ID_RbStepW,ID_RbSteps,
ID_RbStepW+Word(StepCheck));
CheckRadioButton(HWindow,ID_RbKey,ID_RbWait,
ID_RbKey+Word(WaitCheck));
EnableWindow(GetDlgItem(HWindow,ID_RangeWait),WaitCheck);
end;
end;
procedure TBereichDlg.IDHilfe(var Msg:TMessage);
var
S: TS31;
begin
WinHelp(HWindow,HelpFileName,HELP_Context,ID_Bereich);
end;
procedure TBereichDlg.IDRbWeite(var Msg:TMessage);
begin
if Msg.lParamHi=BN_Clicked then begin
GetAEXT;
LRange.StepCheck:=false;
SetAEXT;
end;
end;
procedure TBereichDlg.IDRbSchritte(var Msg:TMessage);
begin
if Msg.lParamHi=BN_Clicked then begin
GetAEXT;
LRange.StepCheck:=true;
SetAEXT;
end;
end;
procedure TBereichDlg.IDRbTaste(var Msg:TMessage);
begin
if Msg.lParamHi=BN_Clicked then begin
LRange.WaitCheck:=false;
EnableWindow(GetDlgItem(HWindow,ID_RangeWait),false);
end;
end;
procedure TBereichDlg.IDRbWarte(var Msg:TMessage);
begin
if Msg.lParamHi=BN_Clicked then begin
LRange.WaitCheck:=true;
EnableWindow(GetDlgItem(HWindow,ID_RangeWait),true);
SetFocus(GetDlgItem(HWindow,ID_RangeWait));
end;
end;
{Schrittweite ermitteln; From und ToPos müssen eingelesen sein!}
function TBereichDlg.GetX:boolean;
begin
with LRange do begin
GetX:=false;
if GetReal(HWindow,ID_RangeStep,Step) then begin
if StepCheck then begin
if Step>0 then begin {Nur positive Schritt-Zahlen}
Step:=(ToPos-From)/Step;
GetX:=true;
end;
end else begin
if (ToPos-From)*Step<0 then Step:=-Step;
if (ToPos-From)*Step>0 then begin
GetX:=true; {okay wenn gleiche Richtung und wenn <>0}
end;
end;
end;
end;
end;
function TBereichDlg.GetT:boolean;
begin
with LRange do begin
Wait:=GetDlgItemInt(HWindow,ID_RangeWait,nil,false);
GetT:= not WaitCheck or (Wait<>0);
end;
end;
function TBereichDlg.GetAEXT:Boolean;
begin
with LRange do begin
GetAEXT:=GetReal(HWindow, ID_RangeFrom,From)
and GetReal(HWindow, ID_RangeToPos,ToPos)
and GetX
and GetT;
end;
end;
procedure TBereichDlg.SetAEXT;
var
S: TS31;
begin
with LRange do begin
Real2S(From,3,S);
SetDlgItemText(HWindow,ID_RangeFrom,S);
Real2S(ToPos,3,S);
SetDlgItemText(HWindow,ID_RangeToPos,S);
if StepCheck then
Real2S((ToPos-From)/Step,0,S)
else
Real2S(Step,3,S);
SetDlgItemText(HWindow,ID_RangeStep,S);
SetDlgItemInt(HWindow,ID_RangeWait,Wait,false);
end;
end;
function TBereichDlg.CanClose:Boolean;
begin
if GetAEXT then begin
Range:=LRange; {Alles rückschreiben}
if AutoSave then SaveRange(CurrentConfig);
CanClose:=true;
end else begin
CanClose:=Hinweis1(HWindow,ST_BereichFehler,nil)=IDCancel;
end;
end;
{************************************************************}
procedure TStepDlg.SetupWindow;
begin
inherited SetupWindow;
InformDlg:=HWindow; {Rückinformation}
SendMessage(Parent^.HWindow,WM_Proceed,1,0); {Initialisieren}
end;
{"Weiter"-Taste gedrückt; sie bricht ggf. die Wartezeit ab!}
procedure TStepDlg.IDProceed(var Msg:TMessage);
begin
WMTimer(Msg);
end;
procedure TStepDlg.WMTimer(var Msg:TMessage);
begin
KillTimer(HWindow,ID_Timer);
if SendMessage(Parent^.HWindow,WM_Proceed,0,0)=0
then EndDlg(0); {Ende und alles fertig!}
end;
procedure TStepDlg.WMMovEnd(var Msg:TMessage);
begin
if Range.WaitCheck then {Stillstandszeit starten}
SetTimer(HWindow,ID_Timer,Range.Wait,nil);
end;
destructor TStepDlg.Done;
begin
KillTimer(HWindow,ID_Timer);
InformDlg:=0;
inherited Done;
end;
{************************************************************}
procedure SetInt(Wnd:HWnd; ID:Word; Template:PChar; W:Word);
var S: TS31;
begin
wvsprintf(S,Template,W); SetDlgItemText(Wnd,ID,S);
end;
procedure SetReal(Wnd:HWnd; ID:Word; R:TReal);
var S: TS31;
begin
Real2S(R,3,S); SetDlgItemText(Wnd,ID,S);
end;
procedure TSetupDlg.SetupWindow;
var
S:TS255;
SP:PChar;
I,W: Word;
begin
inherited SetupWindow;
{links}
if LongRec(CurrentConfig).Hi<>0 then begin
SetDlgItemText(HWindow,ID_EdConfig,CurrentConfig);
EnableWindow(GetItemHandle(ID_EdConfig),false); {Editfeld deaktivieren}
EnableWindow(GetItemHandle(ID_New),true); {Schalter "Neu" aktivieren}
EnableWindow(GetItemHandle(ID_Delete),true); {Schalter "Löschen" -"-}
end;
with AMotor do begin
CheckDlgButton(HWindow,31,Word(CFlags and MC_FreeOnMovEnd <>0));
CheckDlgButton(HWindow,32,Word(CFlags and MC_SyncRequired <>0));
CheckDlgButton(HWindow,71+(CFlags div MC_Table) and 3,1);
CheckDlgButton(HWindow,75,Word(CFlags and MC_Signed <>0));
SetInt(HWindow,81,'%03X',PortHWE);
SetInt(HWindow,82,'%04X',RefW);
SetInt(HWindow,83,'%04X',EndW);
SetInt(HWindow,91,'%03X',PortEAB);
SetInt(HWindow,92,'%04X',OnW);
SetInt(HWindow,93,'%04X',BrakeW);
SetInt(HWindow,41,'%03X',PortA);
SetInt(HWindow,42,'%03X',PortB);
end;
{rechts}
LMotorR:=MotorR;
with LMotorR do begin
ReplaceUnits(GetDlgItem(HWindow,51),UnitName);
SetDlgItemText(HWindow,51,UnitName);
SetReal(HWindow,54,RefSpeed);
SetReal(HWindow,53,MaxSpeed);
SetReal(HWindow,55,MaxAccel);
SetReal(HWindow,56,RefPoint);
SetReal(HWindow,57,LeftBound);
SetReal(HWindow,58,RightBound);
SetReal(HWindow,52,StepsPerUnit);
SetReal(HWindow,59,FastRefOfs);
end;
end;
procedure TSetupDlg.IDNew(var Msg:TMessage);
begin
EnableWindow(GetItemHandle(ID_EdConfig),true); {Editfeld aktivieren}
SendDlgItemMsg(ID_EdConfig,EM_SetSel,0,$FFFF0000); {Alles markieren}
SetFocus(GetItemHandle(ID_EdConfig)); {fokussieren}
EnableWindow(GetItemHandle(ID_New),false); {Schalter "Neu" deaktivieren}
EnableWindow(GetItemHandle(ID_Delete),false); {Schalter "Löschen" -"-}
end;
procedure TSetupDlg.IDDelete(var Msg:TMessage);
begin
if CheckPassword(HWindow)
and (Hinweis(HWindow,ST_Sure,CurrentConfig)=IDOK) then begin
SendMessage(Parent^.HWindow,WM_Assign,0,0); {Aktiven Motor löschen}
WritePrivateProfileString('Motors',CurrentConfig,nil,Profile);
EndDlg(0); {Ende mit Dialog}
end;
end;
procedure TSetupDlg.IDHelp(var Msg:TMessage);
begin
WinHelp(HWindow,HelpFileName,HELP_Context,CM_Setup);
end;
function TSetupDlg.CanClose:Boolean;
var
S:TS31;
EC,EW:Word;
Z: Real;
I: Integer;
begin
CanClose:=false;
SMGetMotor(AMotor.Handle,AMotor); {Evtl. Veränderungen bei Grenzen??}
repeat
EC:=ST_BadHex;
with AMotor do begin
CFlags:=0;
if IsDlgButtonChecked(HWindow,31)=1 then CFlags:=CFlags or MC_FreeOnMovEnd;
if IsDlgButtonChecked(HWindow,32)=1 then CFlags:=CFlags or MC_SyncRequired;
for EW:=71 to 74 do if IsDlgButtonChecked(HWindow,EW)=1 then begin
CFlags:=CFlags or (EW-71) * MC_Table;
break;
end;
if IsDlgButtonChecked(HWindow,75)=1 then CFlags:=CFlags or MC_Signed;
EW:=81; if not GetDlgItemHex(HWindow,EW,PortHWE) then break;
EW:=82; if not GetDlgItemHex(HWindow,EW,RefW) then break;
EW:=83; if not GetDlgItemHex(HWindow,EW,EndW) then break;
EW:=91; if not GetDlgItemHex(HWindow,EW,PortEAB) then break;
EW:=92; if not GetDlgItemHex(HWindow,EW,OnW) then break;
EW:=93; if not GetDlgItemHex(HWindow,EW,BrakeW) then break;
EW:=41; if not GetDlgItemHex(HWindow,EW,PortA) then break;
EW:=42; if not GetDlgItemHex(HWindow,EW,PortB) then break;
end;
with LMotorR do begin {recter Teil}
GetDlgItemText(HWindow,51,UnitName,sizeof(UnitName));
EC:=ST_BereichFehler;
EW:=52; if not GetReal(HWindow,EW,StepsPerUnit) then break;
EW:=54; if not GetReal(HWindow,EW,RefSpeed) then break;
EW:=53; if not GetReal(HWindow,EW,MaxSpeed) then break;
EW:=55; if not GetReal(HWindow,EW,MaxAccel) then break;
EW:=56; if not GetReal(HWindow,EW,RefPoint) then break;
EW:=57; if not GetReal(HWindow,EW,LeftBound) then break;
if LeftBound>RefPoint then break;
EW:=58; if not GetReal(HWindow,EW,RightBound) then break;
if RefPoint>RightBound then break;
EW:=59; if not GetReal(HWindow,EW,FastRefOfs) then break;
if StepsPerUnit=0.0 then break; {Negatives Vorzeichen kehrt Richtung um!}
end;
EC:=ST_NameRequired; EW:=ID_EdConfig;
if IsWindowEnabled(GetItemHandle(EW)) then begin {Neuer Motor?}
if GetDlgItemText(HWindow,EW,S,sizeof(S))=0 then break;
EC:=ST_AlreadyExist;
if GetPrivateProfileInt('Motors',S,0,Profile)=1 then break;
end;
EW:=0;
until true;
if EW=0 then begin
if IsWindowEnabled(GetItemHandle(ID_EdConfig)) then begin {Neuer Motor?}
SendMessage(Parent^.HWindow,WM_Assign,0,LongInt(@S));
end else begin
SMSetMotor(false,AMotor); {Nur neue Parameter setzen}
end;
MotorR:=LMotorR;
CanClose:=true;
if AutoSave and CheckPassword(HWindow) then SaveSet(CurrentConfig);
end else begin
Hinweis1(HWindow,EC,S); {Anmeckern}
SendDlgItemMsg(EW,EM_SetSel,0,$FFFF0000); {Markieren}
SetFocus(GetItemHandle(EW)); {Fokussieren}
end;
end;
{************************************************************}
procedure TMSelDlg.SetupWindow;
var
S: array[0..1023] of Char;
SP:PChar;
I,W: Word;
begin
inherited SetupWindow;
LoadString(Seg(HInstance),ST_None,S,sizeof(S)); {"[kein]"}
SendDlgItemMsg(ID_CbSel,CB_AddString,0,LongInt(@S));
GetPrivateProfileString('Motors',nil,'',S,sizeof(S),Profile);
SP:=S; {Laufzeiger}
while SP^<>#0 do begin
SendDlgItemMsg(ID_CbSel,CB_AddString,0,LongInt(SP));
SP:=StrEnd(SP)+1; {hinter die Null!}
end;
if LongRec(CurrentConfig).Hi<>0
then SendDlgItemMsg(ID_CbSel,CB_SelectString,Word(-1),LongInt(CurrentConfig))
else SendDlgItemMsg(ID_CbSel,CB_SetCurSel,0,0);
end;
procedure TMSelDlg.IDOKNewWindow(var Msg:TMessage);
var
I: Integer;
S: TS255;
begin
GetModuleFileName(Seg(HInstance),S,sizeof(S));
I:=SendDlgItemMsg(ID_CbSel,CB_GetCurSel,0,0);
if I>0 then begin
lstrcat(S,' ');
SendDlgItemMsg(ID_CbSel,CB_GetLBText,I,Longint(S+lstrlen(S)));
end;
WinExec(S,CmdShow); {parametrisierten Prozeß abspalten}
EndDlg(IDCancel);
end;
procedure TMSelDlg.IDHelp(var Msg:TMessage);
begin
WinHelp(HWindow,HelpFileName,HELP_Context,CM_MSel);
end;
function TMSelDlg.CanClose:Boolean;
var
I:Integer;
S: TS31;
begin
I:=SendDlgItemMsg(ID_CbSel,CB_GetCurSel,0,0);
if I>0 then begin
SendDlgItemMsg(ID_CbSel,CB_GetLBText,I,LongInt(@S));
CanClose:=SendMessage(Parent^.HWindow,WM_Assign,0,LongInt(@S))=0;
end else begin
CanClose:=SendMessage(Parent^.HWindow,WM_Assign,0,0)=0;
end;
end;
end.
| Detected encoding: OEM (CP437) | 1
|
|
|