⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 pctoidx.pas

📁 System will automatically delete the directory of debug and release, so please do not put files on t
💻 PAS
字号:
unit PCtoIDX;

interface

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

type
  TToIDX_Form = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Label3: TLabel;
    Edit1: TEdit;
    Label4: TLabel;
    OpenDialog1: TOpenDialog;
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
    Procedure SendFileIDX( F: string );
  public
    { Public declarations }
  end;

var
  ToIDX_Form: TToIDX_Form;

implementation

uses WBTAUnit1, WBTA_Var, WBTA_32_IDX;

{$R *.DFM}

procedure Delay(ms : longint);
{$IFNDEF WIN32}
var TheTime : LongInt;
{$ENDIF}
begin
 {$IFDEF WIN32}
  Sleep(ms);
 {$ELSE}
  TheTime := GetTickCount + ms;
  while GetTickCount < TheTime do
    Application.ProcessMessages;
 {$ENDIF}
end;

procedure TToIDX_Form.FormShow(Sender: TObject);
begin
  ToIDX_Form.Left := Form1.Left + (Form1.Width  - ToIDX_Form.Width)  div 2;
  ToIDX_Form.Top  := Form1.Top  + (Form1.Height - ToIDX_Form.Height) div 2;
end;

procedure TToIDX_Form.Button2Click(Sender: TObject);
begin
  If OpenDialog1.Execute then
     Edit1.Text := Opendialog1.Filename;
end;

procedure TToIDX_Form.Button1Click(Sender: TObject);
var S : String;
begin
  Fname := Edit1.Text;
  IF FileExists(Fname) Then begin
     Label3.Caption := Label3.Caption + '  ' +FName;
     SendFileIDX(FName);
  end else begin
    S := 'The specified File '+ FName+' was not found.';
    Application.MessageBox(PChar(S),'Error',
      mb_applmodal+mb_iconerror+mb_ok+mb_defbutton1);

  end;
  Close;
end;

procedure TToIDX_Form.Button3Click(Sender: TObject);
begin
  Doorgaan := False;
  Close;
end;

procedure TToIDX_Form.FormCreate(Sender: TObject);
Var   IdxL70 : Integer;
     Typ, CH : Char;
           S : String[4];
Begin
  Button1.Enabled := False;
  CH := 'X';
  Version :=  WBTA_32_IDX.GetH23;
//Version := Form1.SpatieWeg(version);
  Typ := Version[1];
  IF Pos('SLOSYN',Version) = 0  Then Begin
     IdxL70 := GetL70;  { only for indexers, not for SS2000}
  End Else IdxL70 := 1;
  S := IntToStr(IdxL70);
  If ContrType IN[4..5] then begin
     Label1.Caption := 'Unit ID : ' + IntToStr(IDXNum);
     Label2.Caption := 'Software rev : ' + version;
     { changed WB 24.02.95 made simple automatic file choosing procedure,
     { before it was complex with H23 table.   }
     IF IdxL70 IN [1,2,5,10,125] Then begin
        case Typ of
          '0' : begin { old blue label PI indexer }
                  Label4.Caption := 'Old blue label Indexer';
                  FName := 'PI-' + S;
                end;
          'I' : begin { new red label PI indexer  }
                  Label4.Caption := 'New red label Indexer';
                  FName := 'PI-' + S;
                end;
          'E' : begin { new EPI indexer           }
                 Label4.Caption := 'New enhanched Indexer';
                 FName := 'EPI-' + S;
                end;
          'S' : begin { SS2000 serie indexer      }
                  Label4.Caption := 'SS2000 serie Indexer';
                  FName := 'PI-' + S;
                end;
          'P' : begin { SS2000 serie indexer      }
                  Label4.Caption := 'SS2000 serie Indexer';
                  FName := 'PI-' + S;
                end;
          'D' : begin { direct drive              }
                  Label4.Caption := 'Direct Drive System';
                  FName := 'PI-' + S;
                end
        End; { case }
     End else  CH := 'M';
  end;   // if unit type 3..4

  IF CH <> 'M' Then Begin
     FName := FName + '.'+ EXT;   { add extension }
     Edit1.text  := FName;
     Button1.Enabled := True;
  end else begin
    FName := '*.'+EXT;
    OpenDialog1.Filter := 'Program files (*.pgm)|*.PGM';
    OpenDialog1.DefaultExt := FName;
  end;
end;

Procedure TToIDX_Form.SendFileIDX( F: string );
Var Sr, Ss : String;
   StrL : TStringList;
//   Doorgaan  : Boolean;
   TimeOut, I: Integer;
   Fp : integer;
Begin
  Button1.Enabled := False;  // disable send file
  Button2.Enabled := False;  // disable file select
  Edit1.Text := 'Removing old program....';
  StrL := TStringList.Create;
  StrL.Clear;
  StrL.LoadFromFile(F);
  Doorgaan := True;
  Form1.Comport1.WriteStr('N001'+CHR($0A)+CHR($0D));   { put linenumber on 1 }
  Sleep(100);
  Form1.Comport1.WriteStr('L48 0'+CHR($0A)+CHR($0D));  { set to all lines }
  Sleep(300);
  Form1.Comport1.WriteStr('L26 2'+CHR($0A)+CHR($0D));  { get equal sign }
  Sleep(300);
  Form1.ComPort1.ClearBuffer(True, True);
  Form1.Comport1.WriteStr('H12'+CHR($0A)+CHR($0D));    { clear whole program }
  Sleep(400);
  TimeOut := 0;
  Repeat
    Application.ProcessMessages;
    Sleep(10);
    INC(TimeOut);
    Edit1.Text := Edit1.Text + '.';  {new}
    IF TimeOut > 500 Then
       Doorgaan := False;
    Form1.ComPort1.ReadStr(Sr, 5);
    Sr := Form1.CleanStr(Sr);  //  Sr := GetStr;
  Until ((POS('=',Sr) <> 0) OR (Doorgaan = False));
  Sleep(300);
  Fp := 0;  // start at line zero
//OpenFile(F);                      { go line by line trough input file }
  While ((Fp < StrL.Count ) AND (Doorgaan= True)) do Begin
    Ss := StrL.Strings[Fp];  // Readln(Fin,Ss); { get one line from input file }
    INC(Fp); // ready for next line
    IF Length(Ss) = 0 Then Ss := ' ';   { enable sending emty lines WB 18aug92 }
    IF Pos('L26',Ss) <> 0 Then Ss := ' ';                { skip lines with L26 }
    I := pos(';',Ss) - 1;
    IF I > 0 then Ss := copy(Ss,1,I);          { remove comment preceeded by ' }
   { skip L26, L70, L48, L49  ???? }
    Form1.Comport1.WriteStr(Ss + CR);                 { send string to indexer }
    Sleep(20);
    TimeOut := 0;  { reset timer }
    Repeat  // wait for the = sign
       Application.ProcessMessages;
       Sleep(20);
       INC(TimeOut);
       IF TimeOut = 200 Then Doorgaan := False;
       Form1.ComPort1.ReadStr(Sr,5);  // Sr := GetStr;
    Until ((POS('=',Sr) <> 0) OR (Doorgaan = False));

    { read lines back from indexer to put on screen }
    IF POS('N',Ss) <> 0 Then  begin { write lines to screen }
       Form1.Comport1.WriteStr('H13'+LF+CR);
       Sleep(55);
       Form1.ComPort1.ReadStr(Sr,35);  // Sr := GetStr;
       Sr := Form1.CleanStr(Sr);
       If pos('=',Sr) <> 0 then     // remove = sign
          delete(Sr,pos('=',Sr),1);
       Edit1.Text :=  'Line: ' + Copy(Sr,1,5); // show line number progress
    End;

    IF POS('L',Ss) <> 0 Then  { write lines to screen }
       Edit1.Text := 'Parameter : '+ Copy(Ss,1,4);
  End; { While EOF loop }

  Form1.Comport1.WriteStr('L26 0'+CHR($0A)+CHR($0D));  { set factory default }
  Sleep(200);
  Form1.Comport1.WriteStr('L48 20 N001'+CHR($0A)+CHR($0D));
  Sleep(200);

  IF Doorgaan = True Then Begin
     For I := 1 To 3 Do begin
        beep;
        Delay(1000);
     end;
  End ELSE Begin
    IF TimeOut > 49 Then
       Application.MessageBox('There was a communication problem when'
       +#13#10+' the program was send to the control.',
       'Communication error', mb_applmodal+mb_iconwarning+mb_ok+mb_defbutton1);
  End;
  StrL.Free; {Close(Fin); }                           { close input file  }
End;


{
procedure TForm1.Button1Click(Sender: TObject);
begin
  MessageBeep(word(-1));
  Delay(200);
  MessageBeep(word(-1));
  Delay(200);
  MessageBeep(word(-1));
end;
}

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -