14 KiB
14 KiB
介绍
本笔记用于记录所有编制过的 Delphi 脚本，以便于沉淀相关知识
多属性值拼接至另一属性中
从 fedtusr_substrate_id、fedtusr_substrate_id2、fedtusr_substrate_id3、fedtusr_substrate_id4 控件中获取值，以逗号为分隔符，按顺序进行拼接，结果输出到 mmmusr_substrate2 控件中
uses MyClass,Variables,BaseUtil,CommonFunc,DataConst,CFFrm,CFSimplePropFrm,Forms,StdCtrls,Variants,SysUtils,Classes,Controls,Dialogs,
CHostIntf,ProductClas,DocClas,LoginClas,VirtualTrees,CEntClas,PathClas;
var
StringList: TStringList;
begin
// 创建和初始化TStringList
StringList := TStringList.Create;
try
// 如果fedtusr_substrate_id的值不为空，则将值添加到StringList中
if fedtusr_substrate_id.Text <> '' then
StringList.Add(fedtusr_substrate_id.Text);
if fedtusr_substrate_id2.Text <> '' then
StringList.Add(fedtusr_substrate_id2.Text);
if fedtusr_substrate_id3.Text <> '' then
StringList.Add(fedtusr_substrate_id3.Text);
if fedtusr_substrate_id4.Text <> '' then
StringList.Add(fedtusr_substrate_id4.Text);
// 转换为逗号分隔的字符串
mmmusr_substrate2.Text := StringList.DelimitedText; // 默认使用逗号作为分隔符
// 如果需要指定其他分隔符，可以设置Delimiter属性
// StringList.Delimiter := ';'; // 设置分隔符为分号
// Result := StringList.DelimitedText;
finally
StringList.Free;
end;
end.
属性值添加至另一属性中
fedtusr_gys 控件中的值有多个，采取 ; 进行分隔，现要验证 fedtusr_shgys 控件中的值是否存在于 fedtusr_gys 控件中，如果不存在，则将其添加进去，并进行排序
uses MyClass,Variables,BaseUtil,CommonFunc,DataConst,CFFrm,CFSimplePropFrm,Forms,StdCtrls,Variants,SysUtils,Classes,Controls,Dialogs,
CHostIntf,ProductClas,DocClas,LoginClas,VirtualTrees,CEntClas,PathClas;
var
gysList: TStringList;
begin
try
// 初始化 TStringList
gysList := TStringList.Create;
gysList.Delimiter := ';';
gysList.StrictDelimiter := True;
// 将 fedtusr_gys 按分号分隔成列表
gysList.DelimitedText := fedtusr_gys.Text;
if gysList.IndexOf(fedtusr_shgys.Text) = -1 then
begin
// 如果不存在，则添加到 fedtusr_gys 中
gysList.Add(fedtusr_shgys.Text);
gysList.Sort;
// 将列表重新组合成字符串，使用分号分隔
fedtusr_gys.Text := gysList.DelimitedText;
end;
finally
gysList.Free;
end;
end.
属性值是否被另一属性所包含校验
fedtusr_gys 控件中的值有多个，采取 ; 进行分隔，现要验证 fedtusr_shgys 控件中的值是否存在于 fedtusr_gys 控件中，如果不存在，则弹窗提示
uses MyClass,Variables,BaseUtil,CommonFunc,DataConst,CFFrm,CFSimplePropFrm,Forms,StdCtrls,Variants,SysUtils,Classes,Controls,Dialogs,
CHostIntf,ProductClas,DocClas,LoginClas,VirtualTrees,CEntClas,PathClas;
var
gysList: TStringList;
begin
try
// 初始化 TStringList
gysList := TStringList.Create;
gysList.Delimiter := ';';
gysList.StrictDelimiter := True;
// 将 fedtusr_gys 按分号分隔成列表
gysList.DelimitedText := fedtusr_gys.Text;
if gysList.IndexOf(fedtusr_shgys.Text) = -1 then
begin
ShowMessage('默认供应商未包含在供应商列表中');
end;
finally
gysList.Free;
end;
end.
不同属性一致性设置
fedtDrawId 的值设置为 fedtItemCode 的值
uses MyClass,Variables,BaseUtil,CommonFunc,DataConst,CFFrm,CFSimplePropFrm,Forms,StdCtrls,Variants,SysUtils,Classes,Controls,Dialogs,
CHostIntf,ProductClas,DocClas,LoginClas,VirtualTrees,CEntClas,PathClas;
begin
//注释：在下面添加您的脚本代码
// 检查 物料编码 是否为空
if Trim(fedtItemCode.Text) <> '' then
begin
// 如果 物料编码 不为空，则将 代号 的值设置为 物料编码 的值
fedtDrawId.Text := fedtItemCode.Text;
end
else
begin
// 如果 物料编码 为空，则清空 代号
fedtDrawId.Text := '';
end;
end.
执行SQL语句获取查询结果
主要内容为通过 chiGetFieldValueBySql 方法去执行 SQL 语句，通过物料代码去获取指定属性的值，要求是这个物料得先被创建出来，才能正常执行脚本，否则会提示找不到这个物料
uses MyClass,Variables,BaseUtil,CommonFunc,DataConst,CFFrm,CFSimplePropFrm,Forms,StdCtrls,Variants,SysUtils,Classes,Controls,Dialogs,
CHostIntf,ProductClas,DocClas,LoginClas,VirtualTrees,CEntClas,PathClas;
Var
str: String;
begin
try
// 1. 查询usr_333的值
str := chiGetFieldValueBySql('select usr_333 from pdmitem where itemcode = ''' + fedtItemCode.Text + '''');
// 2. 检查查询结果
if str = '' then
begin
ShowMessage('未找到物料编码: ' + fedtItemCode.Text);
Exit;
end;
// 3. 如果usr_333为1，则更新usr_444为1
if str = '1' then
begin
// 执行更新操作
cbxusr_444.checked := false;
// 可选：显示操作成功提示
ShowMessage('已自动将usr_444更新为1');
end;
except
on E: Exception do
ShowMessage('操作失败: ' + E.Message);
end;
end.
更新是否控件
检验 cbxusr_333 控件的值，如果为 false，那么 cbxusr_444 控件的值必须为 false
uses MyClass,Variables,BaseUtil,CommonFunc,DataConst,CFFrm,CFSimplePropFrm,Forms,StdCtrls,Variants,SysUtils,Classes,Controls,Dialogs,
CHostIntf,ProductClas,DocClas,LoginClas,VirtualTrees,CEntClas,PathClas;
begin
try
// 校验逻辑：当 cbxusr_333 未选中时，强制 cbxusr_444 也未选中
if not cbxusr_333.Checked then
begin
// 如果 cbxusr_444 当前是选中状态，则强制取消选中
if cbxusr_444.Checked then
begin
cbxusr_444.Checked := False;
// 可选：显示提示信息
ShowMessage('已自动将444设为未选中状态，因为333未选中');
end;
end;
except
on E: Exception do
ShowMessage('执行脚本时出错: ' + E.Message);
end;
end.
批量校验控件并进行更新
自动检查并强制更新一组相关联的复选框(CheckBox)控件的状态，确保当某个"启用"复选框未被选中时，其相关联的"影响"复选框也必须处于未选中状态
脚本核心功能
- 强制关联逻辑：当某个"启用"复选框(如cbxusr_01_FIsEnable)未被选中时，自动将其关联的3个"影响"复选框(cbxusr_01_FIsAffectPrice、cbxusr_01_FIsAffectPlan、cbxusr_01_FIsAffectCost)设为未选中状态
- 适用范围：处理5组不同的控件组合(01-04和06)，每组都有相同的关联关系
控件命名规则与对应关系
-
命名模式：
cbxusr_XX_FIsYYYYY-
XX代表业务类型：01(仓库)、02(仓位)、03(BOM版本)、04(批号)、06(计划跟踪号) -
FIsYYYYY代表功能：-
FIsEnable：启用控制 -
FIsAffectPrice：影响价格 -
FIsAffectPlan：影响计划 -
FIsAffectCost：影响出库成本
-
-
uses MyClass,Variables,BaseUtil,CommonFunc,DataConst,CFFrm,CFSimplePropFrm,Forms,StdCtrls,Variants,SysUtils,Classes,Controls,Dialogs,
CHostIntf,ProductClas,DocClas,LoginClas,VirtualTrees,CEntClas,PathClas;
var
ModifiedControls: TStringList;
CurrentForm: TForm; // 添加窗体变量
procedure ProcessControls(EnablePrefix: string);
var
EnableCheckBox: TCheckBox;
AffectCheckBox: TCheckBox;
AffectNames: array[0..2] of string;
AffectControlName: string;
i: Integer;
begin
AffectNames[0] := 'FIsAffectPrice';
AffectNames[1] := 'FIsAffectPlan';
AffectNames[2] := 'FIsAffectCost';
// 通过当前窗体查找组件
EnableCheckBox := TCheckBox(CurrentForm.FindComponent('cbxusr_' + EnablePrefix + '_FIsEnable'));
if Assigned(EnableCheckBox) and not EnableCheckBox.Checked then
begin
for i := 0 to High(AffectNames) do
begin
AffectControlName := 'cbxusr_' + EnablePrefix + '_' + AffectNames[i];
AffectCheckBox := TCheckBox(CurrentForm.FindComponent(AffectControlName));
if Assigned(AffectCheckBox) and AffectCheckBox.Checked then
begin
ModifiedControls.Add(AffectControlName);
AffectCheckBox.Checked := False;
end;
end;
end;
end;
begin
ModifiedControls := TStringList.Create;
try
try
// 获取当前活动窗体
CurrentForm := Screen.ActiveForm;
if not Assigned(CurrentForm) then
begin
ShowMessage('无法获取当前窗体');
Exit;
end;
ProcessControls('01');
ProcessControls('02');
ProcessControls('03');
ProcessControls('04');
ProcessControls('06');
if ModifiedControls.Count > 0 then
begin
ShowMessage(
'以下控件的值已被自动修改为未选中状态:' + #13#10 +
'--------------------------------' + #13#10 +
ModifiedControls.Text + #13#10 +
'--------------------------------' + #13#10 +
'因为对应的Enable控件未选中'
);
end;
except
on E: Exception do
ShowMessage('执行脚本时出错: ' + E.Message);
end;
finally
ModifiedControls.Free;
end;
end.
进一步优化
中文语义化输出（核心优化）
-
新增
GetControlChineseName函数实现控件名称到中文描述的智能转换 -
示例转换：
-
cbxusr_01_FIsEnable→启用(仓库) -
cbxusr_02_FIsAffectPrice→影响价格(仓位)
-
-
输出信息从技术性控件名变为业务人员可读的自然语言
uses MyClass,Variables,BaseUtil,CommonFunc,DataConst,CFFrm,CFSimplePropFrm,Forms,StdCtrls,Variants,SysUtils,Classes,Controls,Dialogs,
CHostIntf,ProductClas,DocClas,LoginClas,VirtualTrees,CEntClas,PathClas;
var
ModifiedControls: TStringList;
CurrentForm: TForm;
// 获取控件的中文描述
function GetControlChineseName(ControlName: string): string;
var
Prefix, Suffix: string;
PrefixDesc, SuffixDesc: string;
begin
// 提取前缀(01/02/03/04/06)和后缀(FIsEnable/FIsAffectPrice等)
Prefix := Copy(ControlName, Pos('_', ControlName) + 1, 2);
Suffix := Copy(ControlName, Pos('_', ControlName) + 4, MaxInt);
// 映射前缀到中文描述
if Prefix = '01' then PrefixDesc := '仓库'
else if Prefix = '02' then PrefixDesc := '仓位'
else if Prefix = '03' then PrefixDesc := 'BOM版本'
else if Prefix = '04' then PrefixDesc := '批号'
else if Prefix = '06' then PrefixDesc := '计划跟踪号'
else PrefixDesc := '未知';
// 映射后缀到中文描述
if Suffix = 'FIsEnable' then SuffixDesc := '启用'
else if Suffix = 'FIsAffectPrice' then SuffixDesc := '影响价格'
else if Suffix = 'FIsAffectPlan' then SuffixDesc := '影响计划'
else if Suffix = 'FIsAffectCost' then SuffixDesc := '影响出库成本'
else SuffixDesc := '未知';
Result := SuffixDesc + '(' + PrefixDesc + ')';
end;
procedure ProcessControls(EnablePrefix: string);
var
EnableCheckBox: TCheckBox;
AffectCheckBox: TCheckBox;
AffectNames: array[0..2] of string;
AffectControlName, EnableControlName: string;
i: Integer;
ChineseDesc: string;
begin
AffectNames[0] := 'FIsAffectPrice';
AffectNames[1] := 'FIsAffectPlan';
AffectNames[2] := 'FIsAffectCost';
EnableControlName := 'cbxusr_' + EnablePrefix + '_FIsEnable';
EnableCheckBox := TCheckBox(CurrentForm.FindComponent(EnableControlName));
if Assigned(EnableCheckBox) and not EnableCheckBox.Checked then
begin
for i := 0 to High(AffectNames) do
begin
AffectControlName := 'cbxusr_' + EnablePrefix + '_' + AffectNames[i];
AffectCheckBox := TCheckBox(CurrentForm.FindComponent(AffectControlName));
if Assigned(AffectCheckBox) and AffectCheckBox.Checked then
begin
ChineseDesc := GetControlChineseName(AffectControlName);
ModifiedControls.Add(ChineseDesc + ' 已被自动修改为未选中状态，因为 ' +
GetControlChineseName(EnableControlName) + ' 未被选中');
AffectCheckBox.Checked := False;
end;
end;
end;
end;
begin
ModifiedControls := TStringList.Create;
try
try
CurrentForm := Screen.ActiveForm;
if not Assigned(CurrentForm) then
begin
ShowMessage('无法获取当前窗体');
Exit;
end;
ProcessControls('01');
ProcessControls('02');
ProcessControls('03');
ProcessControls('04');
ProcessControls('06');
if ModifiedControls.Count > 0 then
begin
ShowMessage(
'以下控件的值已被自动修改:' + #13#10 +
'--------------------------------' + #13#10 +
ModifiedControls.Text + #13#10 +
'--------------------------------'
);
end;
except
on E: Exception do
ShowMessage('执行脚本时出错: ' + E.Message);
end;
finally
ModifiedControls.Free;
end;
end.
更新枚举选项
cbxusr_444 控件的值必须等于 cbxusr_333 控件的值（枚举选项用 .Text 可以直接获取，直接赋值，但是不能直接设置在控件上）
uses MyClass,Variables,BaseUtil,CommonFunc,DataConst,CFFrm,CFSimplePropFrm,Forms,StdCtrls,Variants,SysUtils,Classes,Controls,Dialogs,
CHostIntf,ProductClas,DocClas,LoginClas,VirtualTrees,CEntClas,PathClas;
begin
cbxusr_444.Text := cbxusr_333.Text;
end.