Quelltext /~heha/messtech/kreuzt.zip/GRILL/DIALOGS.PAS

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.
Vorgefundene Kodierung: OEM (CP437)1
Umlaute falsch? - Datei sei ANSI-kodiert (CP1252)