vault backup: 2025-05-13 14:48:43

This commit is contained in:
SeedList
2025-05-13 14:48:43 +08:00
parent 94344a4d04
commit a7aa1d08b1
68 changed files with 130 additions and 130 deletions

View File

@ -0,0 +1,424 @@
# 介绍
本笔记用于记录所有编制过的 `Delphi` 脚本,以便于沉淀相关知识
## 多属性值拼接至另一属性中
`fedtusr_substrate_id``fedtusr_substrate_id2``fedtusr_substrate_id3``fedtusr_substrate_id4` 控件中获取值,以逗号为分隔符,按顺序进行拼接,结果输出到 `mmmusr_substrate2` 控件中
```Delphi
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` 控件中,如果不存在,则将其添加进去,并进行排序
```Delphi
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` 控件中,如果不存在,则弹窗提示
```delphi
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` 的值
```Delphi
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 ` 语句,通过物料代码去获取指定属性的值,要求是这个物料得先被创建出来,才能正常执行脚本,否则会提示找不到这个物料
```Delphi
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`
```Delphi
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`:影响出库成本
```Delphi
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` → `影响价格(仓位)`
- 输出信息从技术性控件名变为业务人员可读的自然语言
```Delphi
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` 可以直接获取,直接赋值,但是不能直接设置在控件上)
```Delphi
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.
```