📄 pctoidx.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 + -