wbta_ss2kio.pas

System will automatically delete the directory of debug and release, so please do not put files on t

unit WBTA_SS2KIO;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, DopjeNew;

type
  TSS2K_IO_Form = class(TForm)
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    Button1: TButton;
    Button2: TButton;
    OPTO_IN1: TDopjeNew;
    OPTO_IN2: TDopjeNew;
    OPTO_IN3: TDopjeNew;
    OPTO_IN4: TDopjeNew;
    OPTO_IN5: TDopjeNew;
    OPTO_IN6: TDopjeNew;
    OPTO_IN7: TDopjeNew;
    OPTO_IN8: TDopjeNew;
    DopjeNew9: TDopjeNew;
    DopjeNew10: TDopjeNew;
    DopjeNew11: TDopjeNew;
    DopjeNew12: TDopjeNew;
    DopjeNew13: TDopjeNew;
    DopjeNew14: TDopjeNew;
    DopjeNew15: TDopjeNew;
    DopjeNew16: TDopjeNew;
    OPTO_IN9: TDopjeNew;
    OPTO_IN10: TDopjeNew;
    OPTO_IN11: TDopjeNew;
    OPTO_IN12: TDopjeNew;
    OPTO_IN13: TDopjeNew;
    OPTO_IN14: TDopjeNew;
    OPTO_IN15: TDopjeNew;
    OPTO_IN16: TDopjeNew;
    BCD_IN1: TDopjeNew;
    BCD_IN2: TDopjeNew;
    BCD_IN3: TDopjeNew;
    BCD_IN4: TDopjeNew;
    BCD_IN5: TDopjeNew;
    BCD_IN6: TDopjeNew;
    BCD_IN7: TDopjeNew;
    BCD_IN8: TDopjeNew;
    OUT1: TCheckBox;
    OUT2: TCheckBox;
    OUT3: TCheckBox;
    OUT4: TCheckBox;
    OUT5: TCheckBox;
    OUT6: TCheckBox;
    OUT7: TCheckBox;
    OUT8: TCheckBox;
    OUT9: TCheckBox;
    OUT10: TCheckBox;
    OUT11: TCheckBox;
    OUT12: TCheckBox;
    OUT13: TCheckBox;
    OUT14: TCheckBox;
    OUT15: TCheckBox;
    OUT16: TCheckBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Button3: TButton;
    GroupBox3: TGroupBox;
    Label5: TLabel;
    procedure FormShow(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    Doorgaan : Boolean; // to stop
    Stop : Boolean;
    OptoOP : String[ 8];   { for the outputs         }
    BCDOutStr  : string[8];
    procedure INIT;
    procedure WriteOutput;
    Function CheckCOM : Integer;
  public
    { Public declarations }
  end;

var
  SS2K_IO_Form: TSS2K_IO_Form;

implementation

uses WBTAUnit1, WBTA_Var;

{$R *.DFM}

procedure TSS2K_IO_Form.FormShow(Sender: TObject);
var I : Integer;
begin
  Doorgaan := True;
  SS2K_IO_Form.Left := Form1.Left + (Form1.Width  - SS2K_IO_Form.Width)  div 2;
  SS2K_IO_Form.Top  := Form1.Top  + (Form1.Height - SS2K_IO_Form.Height) div 2;
   for I := 0 to ComponentCount - 1 do begin
     if (Components[I] is TDopjeNew) then begin
        TDopjeNew (Components[I]).PinShape  := circle;
        TDopjeNew (Components[I]).BackColor := clMaroon;
     end;
  end;
  OptoOP := '00000000';
  BCDOutStr  := '00000000';
end;

Function TSS2K_IO_Form.CheckCOM : Integer;
var S : String;
    N : Integer;
begin
  // communication test
  N := 0;
  Stop := True;
  repeat
    Form1.ComPort1.ClearBuffer(True, True);
    Form1.Comport1.WriteStr('H23' + CR);
    Sleep(100);
    INC(N);
    Label5.caption := Label5.caption + '.';  // show progress...
    Application.ProcessMessages;
    NumberOfBytes := Form1.Comport1.InputCount;
    Form1.ComPort1.ReadStr(S, 20);
    If Stop = false then N := 10;
    If pos('SLO',S)<> 0 then Stop := False;
  until (Stop = False) or (N > 5);
  Result := N;
end;

procedure TSS2K_IO_Form.INIT;
var N : integer;
begin
  Label5.caption := 'Initializing...';
  N := CheckCOM;
  If N <  5 then Button3Click(Self);
  If N = 10 then  Label5.caption := 'Aborted';
  If N >  5 then  Label5.caption := 'Communcation error';
  if Doorgaan = false then
     Button1Click(Self);
end;

procedure TSS2K_IO_Form.Button2Click(Sender: TObject);
begin
   Application.HelpContext(150);
end;

procedure TSS2K_IO_Form.Button3Click(Sender: TObject);
var S : string;
    N : Integer;
begin
  Doorgaan := True;
  Label5.caption := 'Running';
  Repeat
    WriteOutput;
    Application.ProcessMessages;
    if Doorgaan = false then Exit;
    Form1.ComPort1.ClearBuffer(True, True);
    Form1.Comport1.WriteStr('H21 ' + LF + CR);
    Sleep(100);
    Application.ProcessMessages;
    if Doorgaan = false then Exit;
    NumberOfBytes := Form1.Comport1.InputCount;
    Form1.ComPort1.ReadStr(S, 20);

    S := Form1.cleanStr(S);
    while pos(' ',S) <>  0 do   // remove spaces
       delete(S,pos(' ',S),1);
    if pos('=',S) <> 0 then     // remove =
       delete(S,pos('=',S),1);
    while length(S) < 16 do
        S := '0' + S;            // no crash on error length
//    Form1.edit2.text := S;
    Application.ProcessMessages;
    if Doorgaan = false then Exit;
    sleep(50);
    if S[16] = '1' then OPTO_IN1.BackColor := clYellow
       else OPTO_IN1.BackColor := clMaroon;
    if S[15] = '1' then OPTO_IN2.BackColor := clYellow
       else OPTO_IN2.BackColor := clMaroon;
    if S[14] = '1' then OPTO_IN3.BackColor := clYellow
       else OPTO_IN3.BackColor := clMaroon;
    if S[13] = '1' then OPTO_IN4.BackColor := clYellow
       else OPTO_IN4.BackColor := clMaroon;
    if S[12] = '1' then OPTO_IN5.BackColor := clYellow
       else OPTO_IN5.BackColor := clMaroon;
    if S[11] = '1' then OPTO_IN6.BackColor := clYellow
       else OPTO_IN6.BackColor := clMaroon;
    if S[10] = '1' then OPTO_IN7.BackColor := clYellow
       else OPTO_IN7.BackColor := clMaroon;
    if S[9] = '1' then OPTO_IN8.BackColor := clYellow
       else OPTO_IN8.BackColor := clMaroon;
    if S[8] = '1' then OPTO_IN9.BackColor := clYellow
       else OPTO_IN9.BackColor := clMaroon;
    if S[7] = '1' then OPTO_IN10.BackColor := clYellow
       else OPTO_IN10.BackColor := clMaroon;
    if S[6] = '1' then OPTO_IN11.BackColor := clYellow
       else OPTO_IN11.BackColor := clMaroon;
    if S[5] = '1' then OPTO_IN12.BackColor := clYellow
       else OPTO_IN12.BackColor := clMaroon;
    if S[4] = '1' then OPTO_IN13.BackColor := clYellow
       else OPTO_IN13.BackColor := clMaroon;
    if S[3] = '1' then OPTO_IN14.BackColor := clYellow
      else OPTO_IN14.BackColor := clMaroon;
    if S[2] = '1' then OPTO_IN15.BackColor := clYellow
       else OPTO_IN15.BackColor := clMaroon;
    if S[1] = '1' then OPTO_IN16.BackColor := clYellow
       else OPTO_IN16.BackColor := clMaroon;

    N := CheckCOM;
    If N <  5 then Label5.caption := 'Running';
    If N = 10 then
       Label5.caption := 'Aborted';
    If N >  5 then
       Label5.caption := 'Communcation error';

   until Doorgaan = False;
end;

procedure TSS2K_IO_Form.WriteOutput;
var  S : String;
begin
  If OUT8.Checked then S := '1'
     else S := '0';
  If OUT7.Checked then S := S + '1'
     else S := S + '0';
  If OUT6.Checked then S := S + '1'
     else S := S + '0';
  If OUT5.Checked then S := S + '1'
     else S := S + '0';
  If OUT4.Checked then S := S + '1'
     else S := S + '0';
  If OUT3.Checked then S := S + '1'
     else S := S + '0';
  If OUT2.Checked then S := S + '1'
     else S := S + '0';
  If OUT1.Checked then S := S + '1'
     else S := S + '0';

  S := 'N000 G47 X' + S + ' H01'+ LF + CR;
  Form1.Comport1.WriteStr(S);
  Sleep(100);
  NumberOfBytes := Form1.Comport1.InputCount;
  Form1.ComPort1.ReadStr(S, 20);
end;

procedure TSS2K_IO_Form.FormActivate(Sender: TObject);
begin
  Application.ProcessMessages;
  sleep(500);
  Application.ProcessMessages;
  init;
end;

procedure TSS2K_IO_Form.Button1Click(Sender: TObject);
begin
  Doorgaan := False; // stop the I/O scanning
  Stop := False;     // stop also comm check
  sleep(300);
  Application.ProcessMessages;
  sleep(200);
  Close;
end;

end.