Initial commit - Delphi MES client project

2026-05-07 20:25:34 +08:00
commit 819b4824f6
466 changed files with 1176403 additions and 0 deletions
@@ -0,0 +1,155 @@
+unit uCodeConent;
+
+interface
+
+uses
+  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
+  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Objects,
+  System.ImageList, FMX.ImgList, FMX.Controls.Presentation, FMX.Edit,uTcpDevice,
+  FMX.Layouts, System.Rtti, FMX.Grid.Style, FMX.Memo, FMX.ScrollBox, FMX.Grid,
+  Winapi.Windows, uDM,uShowInfo, FMX.StdCtrls,uKsoap,uSafeLog,Winapi.ActiveX,
+  System.StrUtils, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
+  IdHTTP, REST.Types, Data.Bind.Components, Data.Bind.ObjectScope, REST.Client,
+  FMX.Memo.Types;
+
+type
+  TfrmCodeConent = class(TForm)
+    Rectangle1: TRectangle;
+    ImageList1: TImageList;
+    Rectangle18: TRectangle;
+    Rectangle19: TRectangle;
+    Rectangle20: TRectangle;
+    Text7: TText;
+    Rectangle26: TRectangle;
+    Text17: TText;
+    Rectangle33: TRectangle;
+    Rectangle5: TRectangle;
+    Rectangle35: TRectangle;
+    Text21: TText;
+    Rectangle8: TRectangle;
+    Rectangle10: TRectangle;
+    Rectangle12: TRectangle;
+    Memo1: TMemo;
+    Text4: TText;
+    Text5: TText;
+    procedure FormCreate(Sender: TObject);
+    procedure FormDestroy(Sender: TObject);
+    procedure Rectangle19Click(Sender: TObject);
+  private
+    procedure F2DCodeWork(Sender: TObject;sValue: string);
+    procedure F2DCodeShowState(Avalue: string); //显示读头状态
+    procedure AddLog(sLog:string);
+    { Private declarations }
+  public
+    iDetailCount:Integer;
+    iCount:Integer;
+    vP_ID:Double;
+    vId:integer;
+    F2DCode: T2DCode;
+    Rfid:TRfid;
+    NumEnce:TNumEnce;
+    LotNoRecord:TLotNoRecord;
+    F2DCodeValue:String;
+  end;
+
+var
+ frmCodeConent: TfrmCodeConent;
+
+implementation
+
+{$R *.fmx}
+
+uses uPucFun, uMain, uErrorInfo, IdGlobal;       //609104      , uAlarmLed
+
+procedure TfrmCodeConent.AddLog(sLog:string);
+begin
+  if Memo1.Lines.Count>100 then
+    Memo1.Lines.Delete(0);
+   Memo1.Lines.Add(FormatDateTime('yyyymmdd hh:mm:ss.zzz ',Now)+sLog);
+   Memo1.SelStart:=Length(Memo1.Text);
+   Memo1.SelLength:=0;
+end;
+
+procedure TfrmCodeConent.F2DCodeShowState(Avalue: string); //显示读头状态
+begin
+   AddLog(Avalue);
+end;
+
+procedure TfrmCodeConent.F2DCodeWork(Sender:TObject;sValue: string); //读取条码
+begin
+   AddLog('条码读取成功：'+sValue);
+   F2DCodeValue:= sValue;
+   Close;
+end;
+
+procedure TfrmCodeConent.FormCreate(Sender: TObject);
+var
+    sDevName,sIp,sPort:string;
+    tmpValue:string;
+    i_F2DCode:integer;
+begin
+    Self.width:= 500;
+    Self.height:=400;
+    Memo1.Lines.Clear;
+    i_F2DCode:= 0;
+ //   TxtShowErrorInfo(TxtError,'');
+
+
+    //根据配置加载设备
+  //  for i := 1 to 1 do
+    begin
+        tmpValue:=dm.MemTableReadKeyValue('读头','tv_line_speed1');
+        if tmpValue<>'' then
+        begin
+            if CheckParameter(tmpValue,sDevName,sIp,sPort) then
+            begin
+               if sameText(sDevName.ToLower,'keyence') then //1、2D读头 ,2、鏡板、板翹读头
+               begin
+                 //  inc(i_F2DCode);
+                   F2DCode:=T2DCode.Create(sIp,sPort.ToInteger);
+                   try
+                     F2DCode.Num:=1;
+                     F2DCode.OnWork:=F2DCodeWork;
+                     F2DCode.OnShowState:=F2DCodeShowState;
+                     F2DCode.Connect;
+                   except
+                     workLog.Error('TfrmCodeConent.FormCreate');
+                   end;
+                   TThread.CreateThreadX<Integer>(
+                      procedure (Avalue:Integer)
+                      begin
+                        Sleep(1000);
+                        TThread.Synchronize( nil,
+                           procedure
+                           begin
+                               F2DCode.Open;
+                           end
+                        );
+                      end,1
+                     ).Start;
+               end;
+            end;
+        end;
+    end;
+end;
+
+procedure TfrmCodeConent.FormDestroy(Sender: TObject);
+//var
+//   i:integer;
+begin
+   begin
+      if F2DCode<>nil then
+      begin
+         F2DCode.Close;
+         Sleep(200);
+         FreeandNil(F2DCode);
+      end;
+   end;
+end;
+
+procedure TfrmCodeConent.Rectangle19Click(Sender: TObject);
+begin
+  Close;
+end;
+
+end.