Files
dyp/backup_ansi/uFrameBase.pas
T
2026-05-07 20:25:34 +08:00

335 lines
8.9 KiB
ObjectPascal
Raw Blame History

This file contains ambiguous Unicode characters
This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
unit uFrameBase;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Graphics, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.StdCtrls,
FMX.Layouts,FMX.Objects,FMX.Edit,FMX.ListBox, System.StrUtils, uSafeLog, System.JSON;
type
TFrameBase = class(TFrame)
private
{ Private declarations }
public
FOnButtonClick: TNotifyEvent;
GridLayout: TGridLayout;
sLotNum,sGoodsNo:string; //批号的数量
JSonProcessSensorData: string;
function GetRightPart(const InputStr, Delimiter: string): string; virtual;
function FormatDataToJSON(const AData: string): string; virtual;
function GetJSONValue(const JSONString, Key: string): string; virtual;
function DefaultXN: Boolean; virtual;
procedure ClearAll();
function GetRadioTxt(var sTxt:string):boolean;
function GetFixture_Code():string;virtual; //返回治具ID
function GetFixture_work():string;virtual; //返回原物料編號
procedure Initialize();virtual; //初始化
//填写默认值 参数1 料号API返回数据,参数二是缺省值API返回数据
procedure FillDefaultValue(sPartnumValue,sDefaultTxt:string);virtual;
function F2DCodeCreate(): boolean; virtual;//連接读头
function DoExec():boolean;virtual; //执行插入主表,或打开窗体
function DoPlc():boolean;virtual;//执行plc
function CheckValid(var sTxt:string):boolean;virtual; //检测输入数据的有效性
procedure Error(Option:TStyledControl;TxtError:TText;sError:string);
procedure ErrorLayout(Option:TGridLayout;TxtError:TText;sError:string);
procedure NumbersOnly(Sender: TObject; var Key: Word;
var KeyChar: Char; Shift: TShiftState);virtual;//执行plc
property OnButtonClick: TNotifyEvent read FOnButtonClick write FOnButtonClick;
end;
TFrameClass = class of TFrameBase;
implementation
{$R *.fmx}
uses uListConent, uPucFun;
//取最右边的值
function TFrameBase.GetRightPart(const InputStr, Delimiter: string): string;
var
PosIndex: Integer;
begin
// 查找分隔符位置
PosIndex := Pos(Delimiter, InputStr);
if PosIndex > 0 then
// 找到分隔符:截取分隔符右侧内容
Result := Copy(InputStr, PosIndex + Length(Delimiter), MaxInt)
else
// 未找到分隔符:返回整个字符串
Result := InputStr;
// WorkLog.MessageInfo(IntToStr(PosIndex)+'Result:'+Result);
end;
function TFrameBase.FormatDataToJSON(const AData: string): string;
var
TempStr: string;
StartPos, EndPos: Integer;
Parts: TArray<string>;
I: Integer;
KeyValue: TArray<string>;
JSONObj: TJSONObject;
begin
TempStr := AData;
// 移除波形部分
StartPos := Pos('波形:[[', TempStr);
if StartPos > 0 then
begin
EndPos := PosEx(']]', TempStr, StartPos);
if EndPos > 0 then
Delete(TempStr, StartPos, EndPos - StartPos + 2);
end;
// 移除所有单引号
TempStr := StringReplace(TempStr, '''', '', [rfReplaceAll]);
// 移除所有空格
TempStr := StringReplace(TempStr, ' ', '', [rfReplaceAll]);
//统一特:殊字符
TempStr := StringReplace(TempStr, '', ':', [rfReplaceAll]);
// 使用逗号分割字符串
Parts := TempStr.Split([',']);
// 创建JSON对象
JSONObj := TJSONObject.Create;
try
for I := 0 to High(Parts) do
begin
// 跳过空部分
if Parts[I] = '' then
Continue;
// 分割键值对
KeyValue := Parts[I].Split([':']);
// 确保有键和值
if Length(KeyValue) >= 2 then
begin
// 处理特殊情况:硬件版本和软件版本中的b字符
if (KeyValue[0] = '硬件版本') or (KeyValue[0] = '软件版本') then
KeyValue[1] := StringReplace(KeyValue[1], 'b', '', [rfReplaceAll]);
// 添加到JSON对象
JSONObj.AddPair(KeyValue[0], KeyValue[1]);
end;
end;
// 返回格式化的JSON字符串
Result := JSONObj.Format(2);
WorkLog.MessageInfo('JSONObj: %s', [JSONObj.Format(2)]);
finally
JSONObj.Free;
end;
end;
function TFrameBase.GetJSONValue(const JSONString, Key: string): string;
var
JSONValue: TJSONValue;
JSONObj: TJSONObject;
Pair: TJSONPair;
begin
Result := '';
try
// WorkLog.MessageInfo('Result1: %s, %s', [JSONString,Key]);
// 解析JSON字符串
JSONValue := TJSONObject.ParseJSONValue(JSONString);
if Assigned(JSONValue) then
begin
// WorkLog.MessageInfo('Result2: %s', [JSONValue.ToString]);
try
// 检查是否为JSON对象
if JSONValue is TJSONObject then
begin
JSONObj := TJSONObject(JSONValue);
// WorkLog.MessageInfo('Result3: %s', [JSONObj.ToString]);
// 使用GetValue方法获取指定键的值
if JSONObj.GetValue(Key) <> nil then
begin
Result := JSONObj.GetValue(Key).Value;
// WorkLog.MessageInfo('Result4: %s, %s', [Key, Result]);
end;
end;
finally
JSONValue.Free;
end;
end;
except
end;
WorkLog.MessageInfo('Result: %s, %s', [Key, Result]);
end;
procedure TFrameBase.NumbersOnly(Sender: TObject; var Key: Word;
var KeyChar: Char; Shift: TShiftState);
var
i: Boolean;
begin
i := (KeyChar <= #8) or (KeyChar <= #8) and (KeyChar < #48) or (KeyChar > #57);
if i then
KeyChar := #0;
if not (KeyChar in ['0'..'9', '.', #13]) then
KeyChar := #0;
if (KeyChar = '.') and (Pos('.', TEdit(Sender).Text) > 0) then
KeyChar := #0;
end;
function TFrameBase.GetFixture_Code():string; //返回治具ID
begin
Result:='-1';
end;
function TFrameBase.GetFixture_work():string; //返回治具ID
begin
Result:='-1';
end;
procedure TFrameBase.ClearAll();
var
I:integer;
begin
for I := 0 to self.ComponentCount-1 do
begin
if TComponent(self.Components[i]) is TEdit then
begin
TEdit(self.Components[i]).Text:='';
Continue;
end;
if TComponent(self.Components[i]) is TComboBox then
TComboBox(self.Components[i]).ItemIndex:=0;
end;
end;
procedure TFrameBase.ErrorLayout(Option:TGridLayout;TxtError:TText;sError:string);
var
PointA,PointB: TPointF;
begin
PointA:=Option.LocalToAbsolute(PointF(Option.Width, 0));
PointB:=self.LocalToAbsolute(PointF(0,0));
TxtError.Position.X:=PointA.X-PointB.X-6;
TxtError.Position.y:=PointA.Y-PointB.y+4; //PointA.Y-Self.ParentControl.Position.Y-30;
TxtError.Text:=sError;
end;
procedure TFrameBase.Error(Option:TStyledControl;TxtError:TText;sError:string);
var
PointA,PointB: TPointF;
begin
PointA:=Option.LocalToAbsolute(PointF(Option.Width,0));
PointB:=self.LocalToAbsolute(PointF(0,0));
TxtError.Position.y:=PointA.Y-PointB.y+2;
TxtError.Position.X:=PointA.X-PointB.X;
TxtError.Text:=sError;
if sError<>'' then Option.SetFocus;
end;
function TFrameBase.GetRadioTxt(var sTxt:string):boolean;
var
RadioButton:TRadioButton;
i:integer;
begin
Result:=true;
sTxt:='';
if GridLayout<>nil then //检测TOP面,BOT面
begin
for i := 0 to GridLayout.ChildrenCount-1 do //有选项没显示,返回也为真
begin
RadioButton:=TRadioButton(GridLayout.Children[i]);
if RadioButton.Visible then
begin
Result:=false;
end;
end;
if not Result then //有显示的
for i := 0 to GridLayout.ChildrenCount-1 do
begin
RadioButton:=TRadioButton(GridLayout.Children[i]);
if RadioButton.IsChecked then
begin
sTxt:=RadioButton.Text;
Result:=true;
end;
end;
end;
end;
procedure TFrameBase.FillDefaultValue(sPartnumValue,sDefaultTxt:string); //填写默认值
begin
with TStringList.Create do
try
// a:= TStringList.Create;
Delimiter:= ',';
DelimitedText:= sDefaultTxt;
// if Count>=1 then Edit6.Text:=Strings[0];
// if Count>=2 then Edit5.Text:=Strings[1];
// if Count>=3 then Edit4.Text:=Strings[2];
// if Count>=4 then Edit2.Text:=Strings[3];
// if Count>=5 then Edit9.Text:=Strings[4];
// if Count>=6 then Edit1.Text:=Strings[5];
// if Count>=7 then Edit3.Text:=Strings[6];
// if Count>=8 then Edit_KuangJi.Text:=Strings[7];
// if Count>=9 then Edit_ChengShi.Text:=Strings[8];
// if Count>=10 then Edit7.Text:=Strings[9];
finally
Free;
end;
end;
function TFrameBase.DefaultXN: Boolean;
begin
Result:= True;
end;
function TFrameBase.DoExec():boolean;
begin
Result:=true;
// //打开窗体
// if Result then
// begin
// frmListConent:=TfrmListConent.Create(nil);
// try
//// frmListConent.LotNoRecord:=LotNoRecord;
//// frmListConent.vP_ID:=LotNoRecord.P_ID;
//// frmListConent.vId:=vId;
//// frmListConent.Text6.Text:='更改烤架編號';
// frmListConent.ShowModal;
// finally
// frmListConent.Free;
// end;
// end;
end;
function TFrameBase.CheckValid(var sTxt:string):boolean;
begin
Result:=false;
end;
function TFrameBase.F2DCodeCreate(): boolean;
begin
Result:=false;
end;
function TFrameBase.DoPlc(): boolean;
begin
Result:=true;
end;
procedure TFrameBase.Initialize(); //初始化
begin
end;
end.