Files
WorkNote/SanPinPLM/相关操作/4.0-other/999.Delphi脚本记录.md
2025-06-20 09:59:44 +08:00

564 lines
18 KiB
Markdown
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.

# 介绍
本笔记用于记录所有编制过的 `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.itemindex := cbxusr_333.itemindex;
end.
```
## 枚举项联动
`fedtusr_FBaseUnitId` 控件有值,且 `fedtusr_FPurchaseUnitId``fedtusr_FSaleUnitId``fedtusr_FSalePriceUnitId` 等控件没有选择值的情况下,将 `fedtusr_FBaseUnitId` 控件的值赋予给其他控件(仅限于 **值改变时执行**
枚举控件空值为-1从0开始计数
```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 (fedtusr_FBaseUnitId.itemindex <> -1) and (fedtusr_FPurchaseUnitId.Text = '') then
fedtusr_FPurchaseUnitId.itemindex := fedtusr_FBaseUnitId.itemindex;
if (fedtusr_FBaseUnitId.itemindex <> -1) and (fedtusr_FPurchasePriceUnitId.Text = '') then
fedtusr_FPurchasePriceUnitId.itemindex := fedtusr_FBaseUnitId.itemindex;
if (fedtusr_FBaseUnitId.itemindex <> -1) and (fedtusr_FSaleUnitId.Text = '') then
fedtusr_FSaleUnitId.itemindex := fedtusr_FBaseUnitId.itemindex;
if (fedtusr_FBaseUnitId.itemindex <> -1) and (fedtusr_FSalePriceUnitId.Text = '') then
fedtusr_FSalePriceUnitId.itemindex := fedtusr_FBaseUnitId.itemindex;
if (fedtusr_FBaseUnitId.itemindex <> -1) and (fedtusr_FStoreUnitID.Text = '') then
fedtusr_FStoreUnitID.itemindex := fedtusr_FBaseUnitId.itemindex;
if (fedtusr_FBaseUnitId.itemindex <> -1) and (fedtusr_FMinIssueUnitId.Text = '') then
fedtusr_FMinIssueUnitId.itemindex := fedtusr_FBaseUnitId.itemindex;
end.
```
## 获取枚举值写入到文本中
获取枚举控件A的值写入到文本控件B中不适用于装配属性
```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 A.itemindex <> -1 then
B.Text := A.Text;
end.
```
## 截取指定字符前的字符串
`cbxusr_pinpai` 未被勾选时,只保留 `fedtItemCode``-` 之前的部分
```Delphi
uses
MyClass, Variables, BaseUtil, CommonFunc, DataConst, CFFrm, CFSimplePropFrm,
Forms, StdCtrls, Variants, SysUtils, Classes, Controls, Dialogs,
CHostIntf, ProductClas, DocClas, LoginClas, VirtualTrees, CEntClas, PathClas;
var
DashPos: Integer; // 存储 "-" 的位置
begin
// 检查条件itemcode 包含 "-" 并且 cbxusr_pinpai 未勾选
if (Pos('-', fedtItemCode.Text) > 0) and (cbxusr_pinpai.Checked = false) then
begin
// 找到 "-" 的位置
DashPos := Pos('-', fedtItemCode.Text);
// 只保留 "-" 之前的部分
fedtItemCode.Text := Copy(fedtItemCode.Text, 1, DashPos - 1);
end;
if cbxusr_pinpai.checked = false then
fedtusr_gongyingshang.itemindex := -1;
end.
```
## 转换字符串数组的连接字符
当要设置自定义分隔符号,`StringList.Delimiter := '-';` 需要写在转化语句之前
```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
if fedtusr_KHMC.Text <> '' then
StringList.Add(fedtusr_KHMC.Text);
if fedtusr_khth.Text <> '' then
StringList.Add(fedtusr_khth.Text);
if fedtusr_lb.Text <> '' then
StringList.Add(fedtusr_lb.Text);
StringList.Delimiter := '-'; // 设置分隔符为分号
// 转换为逗号分隔的字符串
fedtFShtName.Text := StringList.DelimitedText; // 默认使用逗号作为分隔符
finally
StringList.Free;
end;
end.
```
### 拼接的另一种方式
由于采用 `StringList` 拼接会出现拼接的字符串中包含特殊字符时,默认给该字符串加上双引号的的情况,如图所示
![](assets/0875f15131f11e246ef28751293de75f.png)
那么对此可以采用另一种拼接方式,直接将字符串与字符串拼接起来,不再使用 `StringList` 记录再转化
```Delphi
uses
MyClass, Variables, BaseUtil, CommonFunc, DataConst, CFFrm, CFSimplePropFrm,
Forms, StdCtrls, Variants, SysUtils, Classes, Controls, Dialogs,
CHostIntf, ProductClas, DocClas, LoginClas, VirtualTrees, CEntClas, PathClas;
var
TempStr: string;
begin
TempStr := '';
if fedtusr_KHMC.Text <> '' then
TempStr := fedtusr_KHMC.Text;
if fedtusr_khth.Text <> '' then
begin
if TempStr <> '' then
TempStr := TempStr + '-'; // 添加分隔符
TempStr := TempStr + fedtusr_khth.Text;
end;
if fedtusr_lb.Text <> '' then
begin
if TempStr <> '' then
TempStr := TempStr + '-'; // 添加分隔符
TempStr := TempStr + fedtusr_lb.Text;
end;
fedtFShtName.Text := TempStr; // 直接赋值
end.
```