753 lines
25 KiB
Markdown
753 lines
25 KiB
Markdown
# 介绍
|
||
|
||
本笔记用于记录所有编制过的 `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` 枚举控件的值，需要使用到 `itemindex` 去获取
|
||
|
||
```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.
|
||
```
|
||
|
||
### 枚举itemindex说明
|
||
|
||
`itemindex` 是指枚举的序号，当为空时，`itemindex` 为 `-1`，不为空时，从 `0` 开始计数（切记！不是从 `1` 开始）
|
||
|
||
如果枚举序号不同，哪怕枚举值一样也是无用的
|
||
|
||
> 例如
|
||
>
|
||
> `cbxusr_444` 枚举控件有三个枚举分别是：`A`、`B`、`C`，对应的值是：`1`，`2`，`3`
|
||
>
|
||
> `cbxusr_333` 枚举控件有三个枚举分别是：`3`、`2`、`1`，对应的值是：`C`，`B`，`A`
|
||
>
|
||
> 若想达到效果，当 `cbxusr_444` 枚举控件选择 `A` 的时候，`cbxusr_333` 枚举控件要更新成 `3`
|
||
>
|
||
> 那么使用 `cbxusr_333.itemindex := cbxusr_444.itemindex;` 是无法实现的，因为 `cbxusr_444` 枚举控件选择 `A` 的时候，`iteminde` 为 `0`，而 `cbxusr_333` 枚举控件的 `itemindex` 为 `0` 的时候，对应的是枚举 `3`
|
||
>
|
||
> `cbxusr_444.Text := cbxusr_333.Text;` 的效果说明：
|
||
>
|
||
> `cbxusr_333` 枚举控件选择 `3` 的时候，`cbxusr_333.Text` 获取到的就是 `3`，而将这个值赋值给 `cbxusr_444.Text` 后，实际上在数据库里 `cbxusr_444` 是存储着 `3` 的，虽然在页面上最初会显示成 `3`，但当我们保存后，`3` 所对应的 `C` 枚举会显示在 `cbxusr_444` 控件内
|
||
|
||
## 枚举项联动
|
||
|
||
`fedtusr_FBaseUnitId` 控件有值，且 `fedtusr_FPurchaseUnitId`、`fedtusr_FSaleUnitId`、`fedtusr_FSalePriceUnitId` 等控件没有选择值的情况下，将 `fedtusr_FBaseUnitId` 控件的值赋予给其他控件（仅限于 **值改变时执行**）
|
||
|
||
枚举控件空值为-1，从0开始计数（计数方式见 [枚举itemindex说明](#枚举itemindex说明) ）
|
||
|
||
```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;
|
||
>>>>>>> origin/main
|
||
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` 拼接会出现拼接的字符串中包含特殊字符时，默认给该字符串加上双引号的的情况，如图所示
|
||
|
||
|
||
|
||
那么对此可以采用另一种拼接方式，直接将字符串与字符串拼接起来，不再使用 `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.
|
||
```
|
||
|
||
## 删除文本中的空格
|
||
|
||
删除掉指定控件中输入的文本的空格
|
||
|
||
```delphi
|
||
uses
|
||
MyClass, Variables, BaseUtil, CommonFunc, DataConst, CFFrm, CFSimplePropFrm,
|
||
Forms, StdCtrls, Variants, SysUtils, Classes, Controls, Dialogs,
|
||
CHostIntf, ProductClas, DocClas, LoginClas, VirtualTrees, CEntClas, PathClas;
|
||
|
||
// 在begin之前定义过程
|
||
procedure RemoveSpacesFromEdit(EditControl: TCustomEdit);
|
||
var
|
||
OriginalText: string;
|
||
begin
|
||
OriginalText := EditControl.Text;
|
||
// 使用StringReplace函数删除所有空格
|
||
EditControl.Text := StringReplace(OriginalText, ' ', '', [rfReplaceAll]);
|
||
end;
|
||
|
||
begin
|
||
// 调用过程处理edtSpec控件
|
||
RemoveSpacesFromEdit(edtSpec);
|
||
end.
|
||
```
|
||
|
||
### 删除其他空白字符
|
||
|
||
如果需要删除其他空白字符（如制表符、换行符），可以修改过程为
|
||
|
||
```delphi
|
||
uses
|
||
MyClass, Variables, BaseUtil, CommonFunc, DataConst, CFFrm, CFSimplePropFrm,
|
||
Forms, StdCtrls, Variants, SysUtils, Classes, Controls, Dialogs,
|
||
CHostIntf, ProductClas, DocClas, LoginClas, VirtualTrees, CEntClas, PathClas;
|
||
|
||
// 在begin之前定义过程
|
||
procedure RemoveSpacesFromEdit(EditControl: TCustomEdit);
|
||
var
|
||
OriginalText: string;
|
||
begin
|
||
OriginalText := EditControl.Text;
|
||
// 删除所有空白字符
|
||
OriginalText := StringReplace(OriginalText, ' ', '', [rfReplaceAll]);
|
||
// 制表符
|
||
OriginalText := StringReplace(OriginalText, #9, '', [rfReplaceAll]);
|
||
// 换行符
|
||
OriginalText := StringReplace(OriginalText, #13#10, '', [rfReplaceAll]);
|
||
EditControl.Text := OriginalText;
|
||
end;
|
||
|
||
begin
|
||
// 调用过程处理edtSpec控件
|
||
RemoveSpacesFromEdit(edtSpec);
|
||
end.
|
||
```
|
||
|
||
## 根据输入内容在数据库中查询，获取查询结果作为下拉列表以供选择
|
||
|
||
根据在 `fedtusr_sqlmj` 控件中输入的内容，在数据库中进行查询，并将查询结果去重后，列出头十条作为下拉选择，以供 `fedtusr_sqlmj` 控件选择
|
||
|
||
```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
|
||
|
||
//注释：在下面添加您的脚本代码
|
||
str := fedtusr_sqlmj.Text;
|
||
if Length(str) > 0 then
|
||
begin
|
||
if Length(chiGetFieldValueBySql('select top 1 usr_sqlmj from pdmitem where usr_sqlmj like ''%' + str + '%''')) > 0 then
|
||
begin
|
||
chiFillComboBox('select distinct top 10 usr_sqlmj from pdmitem where usr_sqlmj like ''%' + str + '%''',fedtusr_sqlmj);
|
||
end
|
||
else
|
||
begin
|
||
chiFillComboBox('select ''''',fedtusr_sqlmj);
|
||
end;
|
||
end;
|
||
end.
|
||
```
|
||
|
||
### 前置要求
|
||
|
||
接收下拉选择的控件的 **按钮类型** 必须是 **下拉** 才行（属性的类型可以是文本，也可以是枚举，枚举要求枚举来源为空）
|
||
|
||
|
||
|
||
此外，脚本必须放在 **按钮** 的 **单击执行** 中
|
||
|
||
|
||
|
||
## 获取当前日期拼接到字符串中
|
||
|
||
获取当前的日期，并以 `yyyy-mm-dd` 的格式拼接到字符串末尾
|
||
|
||
```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_lb.Text <> '' then
|
||
begin
|
||
TempStr := TempStr + fedtusr_lb.Text;
|
||
end;
|
||
|
||
if fedtusr_KHMC.Text <> '' then
|
||
begin
|
||
if TempStr <> '' then
|
||
TempStr := TempStr + '-'; // 添加分隔符
|
||
TempStr := TempStr + fedtusr_KHMC.Text;
|
||
end;
|
||
|
||
if fedtusr_khth.Text <> '' then
|
||
begin
|
||
if TempStr <> '' then
|
||
TempStr := TempStr + '-'; // 添加分隔符
|
||
TempStr := TempStr + fedtusr_khth.Text;
|
||
end;
|
||
|
||
// 替换为当前时间（总是添加）
|
||
if TempStr <> '' then
|
||
TempStr := TempStr + '-'; // 添加分隔符
|
||
TempStr := TempStr + FormatDateTime('yyyy-mm-dd', Now); // 使用日期格式
|
||
|
||
fedtFShtName.Text := TempStr; // 直接赋值
|
||
end.
|
||
```
|
||
|
||
## 多选枚举控件同步
|
||
|
||
多选枚举同步，需要在属性保存下来后，通过同步按钮进行同步（读写数据库进行）
|
||
|
||
```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
|
||
|
||
//注释：在下面添加您的脚本代码
|
||
if fedtusr_mj1.Text <> '' then
|
||
begin // 添加begin
|
||
str := chiGetFieldValueBySql('select usr_mj1 from pdmitem where itemcode = ' + QuotedStr(fedtItemCode.Text));
|
||
chiExecuteSqlNoResultRec('update pdmitem set usr_mj2 = ' + QuotedStr(str) + ' where itemcode = ' + QuotedStr(fedtItemCode.Text));
|
||
end; // 添加end
|
||
end.
|
||
```
|
||
|
||
## 整数判断
|
||
|
||
条件：物料 **启用库存周期复检** 时，**复检周期须不小于0** 且 **不小于提醒提前期**
|
||
|
||
|
||
|
||
|
||
|
||
// 定义变量存储转换后的整数数值
|
||
var StockCycle, LeadDay: Integer;
|
||
|