Developer
123 lines
3.2 KiB
ObjectPascal
123 lines
3.2 KiB
ObjectPascal
unit uTCPDeviceNew;
|
|
|
|
interface
|
|
|
|
uses
|
|
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
|
|
FMX.Types, FMX.Graphics, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.StdCtrls,
|
|
uFrameBase, System.ImageList, FMX.ImgList, FMX.ListBox, uksoap,System.StrUtils,
|
|
FMX.Controls.Presentation, FMX.Edit, FMX.Objects,uListConent,uShowInfo,uTCPDevice,
|
|
FMX.ScrollBox, FMX.Memo;
|
|
|
|
type
|
|
TTCPDeviceNew = class
|
|
private
|
|
procedure F2DCodeCreate();
|
|
procedure F2DCodeDelete();
|
|
public
|
|
F2DCodeValue:String;
|
|
F2DCode: T2DCode;
|
|
constructor Create();
|
|
destructor Destroy; override;
|
|
procedure F2DCodeShowState(Avalue: string); //显示读头状态
|
|
procedure F2DCodeWork(Sender:TObject;sValue: string); //读取条码
|
|
end;
|
|
|
|
var
|
|
TCPDeviceNew: TTCPDeviceNew;
|
|
|
|
implementation
|
|
|
|
uses uDM, uPucFun, uSafeLog;
|
|
|
|
constructor TTCPDeviceNew.Create;
|
|
begin
|
|
F2DCodeCreate();
|
|
end;
|
|
|
|
destructor TTCPDeviceNew.Destroy;
|
|
begin
|
|
F2DCodeDelete;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TTCPDeviceNew.F2DCodeCreate();
|
|
var
|
|
sDevName,sIp,sPort:string;
|
|
tmpValue:string;
|
|
i:integer;
|
|
begin
|
|
//Rectangle001.Visible:=ksoap.P_LINE='油墨印刷機';
|
|
|
|
//根据配置加载设备
|
|
for i := 1 to 1 do
|
|
begin
|
|
tmpValue:=dm.MemTableReadKeyValue('读头','tv_line_speed'+i.ToString);
|
|
if tmpValue<>'' then
|
|
begin
|
|
if CheckParameter(tmpValue,sDevName,sIp,sPort) then
|
|
begin
|
|
if sameText(sDevName.ToLower,'keyence') then //2D读头
|
|
begin
|
|
F2DCode:=T2DCode.Create(sIp,sPort.ToInteger);
|
|
F2DCode.Num:=i;
|
|
F2DCode.OnWork:=F2DCodeWork;
|
|
F2DCode.OnShowState:=F2DCodeShowState;
|
|
F2DCode.Connect;
|
|
TThread.CreateThreadX<Integer>(
|
|
procedure (Avalue:Integer)
|
|
begin
|
|
Sleep(1000);
|
|
TThread.Synchronize( nil,
|
|
procedure
|
|
begin
|
|
// F2DCode.Open;
|
|
// WorkLog.MessageInfo('%s条码%s读取Open'+sIp+(sPort));
|
|
end
|
|
);
|
|
end,i
|
|
).Start;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TTCPDeviceNew.F2DCodeDelete;
|
|
begin
|
|
if F2DCode<>nil then
|
|
begin
|
|
F2DCode.Close;
|
|
Sleep(200);
|
|
F2DCode.DisConnect;
|
|
F2DCode.Destroy;
|
|
// F2DCode:= nil;
|
|
FreeandNil(F2DCode);
|
|
WorkLog.Debug('连接已关闭');
|
|
end;
|
|
end;
|
|
|
|
procedure TTCPDeviceNew.F2DCodeShowState(Avalue: string); //显示读头状态
|
|
begin
|
|
// AddLog(Avalue);
|
|
WorkLog.Debug('条码读取狀態'+Avalue);
|
|
if (pos('连接成功',Avalue)>0) and (F2DCode<>nil) then
|
|
F2DCode.Open;
|
|
end;
|
|
|
|
procedure TTCPDeviceNew.F2DCodeWork(Sender:TObject;sValue: string); //读取条码
|
|
begin
|
|
F2DCodeValue:= sValue;
|
|
WorkLog.Debug('条码读取:'+F2DCodeValue);
|
|
// WorkLog.MessageInfo('条码读取:'+self.Name);
|
|
// if sValue='ERROR' then
|
|
// BEGIN
|
|
// // AddLog('条码读取出错'+sValue);
|
|
// // WorkLog.MessageInfo('条码读取出错'+sValue);
|
|
// // TxtBarCodePrompt.Text:='二维码读取出错';
|
|
// Exit;
|
|
// END;
|
|
end;
|
|
|
|
end.
|