rtgit/RTFormwork
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

rtfun

Browse Source
This commit is contained in:
“ddf” 2024-08-27 15:48:31 +08:00
parent 64feebdd0e
commit f3d758f548
7 changed files with 1195 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

195
public10/ThreeFun/Fun/U_RTFun.pas
View File

@ -11,7 +11,7 @@ uses
cxTreeView, cxGrid, cxDBLookupComboBox, cxCalendar, cxCurrencyEdit,
cxGridExportLink, ExtCtrls, Buttons, DBClient, RTComboBox, cxDropDownEdit,
cxGridBandedTableView, cxGridDBBandedTableView, cxRichEdit, cxButtonEdit,
IniFiles, WinSock, IdHTTP, dxcore, cxTextEdit, FireDAC.Comp.Client,
IniFiles, WinSock, IdHTTP, dxcore, cxTextEdit, FireDAC.Comp.Client, cxCheckBox,
Vcl.Clipbrd, cxMemo, dxLayoutControl;
type
@ -68,7 +68,13 @@ procedure SInitComBoxBySql(ADOQueryTmp: TADOQuery; cb: TComboBox; emptyFlag: Boo
procedure SInitTcxComBoxBySql(ADOQueryTmp: TADOQuery; cb: TcxComboBox; emptyFlag: Boolean; mSql: string);
// 给TcxGriddbColumn中的TComboBox赋值
procedure SInitCxGridComboBoxBySql(ADOQueryTmp: TADOQuery; c3: TcxGriddbColumn; FSql: string; PState: Integer; IsNull: Boolean; Shmeg: string);
// 给TcxGriddbColumn中的TComboBox赋值 V2
procedure SInitCxGridComboBoxBySqlV2(ADOQueryTmp: TADOQuery; Tv1: TcxGridDBTableView; FieldName: string; mSql: string);
// ¸øTcxGridDBBandedColumnÖеÄTComboBox¸³Öµ
procedure SInitCxBandGridComboBoxBySql(ADOQueryTmp: TADOQuery; c3: TcxGridDBBandedColumn; FSql: string; PState: Integer; IsNull: Boolean; Shmeg: string);
@ -475,9 +481,10 @@ begin
begin
for i := 0 to MTV.ColumnCount - 1 do
begin
if Trim(TEdit(TMPanel.Controls[j]).Name) = Trim(MTV.Columns[i].DataBinding.FieldName) then
if UpperCase(Trim(TEdit(TMPanel.Controls[j]).Name)) = UpperCase(Trim(MTV.Columns[i].DataBinding.FieldName)) then
begin
MTV.Columns[i].Visible := IsVisible;
MTV.Columns[i].Hidden := not IsVisible;
Continue;
end;
end;
@ -492,15 +499,54 @@ begin
begin
for i := 0 to MTV.ColumnCount - 1 do
begin
if Trim(TComboBox(TMPanel.Controls[j]).Name) = Trim(MTV.Columns[i].DataBinding.FieldName) then
if UpperCase(Trim(TComboBox(TMPanel.Controls[j]).Name)) = UpperCase(Trim(MTV.Columns[i].DataBinding.FieldName)) then
begin
MTV.Columns[i].Visible := IsVisible;
MTV.Columns[i].Hidden := not IsVisible;
Continue;
end;
end;
end;
end;
end;
if TMPanel.Controls[j] is TcxTextEdit then
begin
if Trim(TcxTextEdit(TMPanel.Controls[j]).Hint) = Hintvalue then
begin
with MTV do
begin
for i := 0 to MTV.ColumnCount - 1 do
begin
if UpperCase(Trim(TcxTextEdit(TMPanel.Controls[j]).Name)) = UpperCase(Trim(MTV.Columns[i].DataBinding.FieldName)) then
begin
MTV.Columns[i].Visible := IsVisible;
MTV.Columns[i].Hidden := not IsVisible;
Continue;
end;
end;
end;
end;
end;
if TMPanel.Controls[j] is TcxComboBox then
begin
if Trim(TcxComboBox(TMPanel.Controls[j]).Hint) = Hintvalue then
begin
with MTV do
begin
for i := 0 to MTV.ColumnCount - 1 do
begin
if UpperCase(Trim(TcxComboBox(TMPanel.Controls[j]).Name)) = UpperCase(Trim(MTV.Columns[i].DataBinding.FieldName)) then
begin
MTV.Columns[i].Visible := IsVisible;
MTV.Columns[i].Hidden := not IsVisible;
Continue;
end;
end;
end;
end;
end;
end;
end;
end;
@ -526,13 +572,27 @@ begin
TEdit(Controls[i]).Text := Trim(TMClientDataset.FieldByName(TEdit(Controls[i]).Name).AsString);
end;
end;
if Controls[i] is TcxTextEdit then
begin
if Trim(TcxTextEdit(Controls[i]).Hint) = Hintvalue then
begin
TcxTextEdit(Controls[i]).Text := Trim(TMClientDataset.FieldByName(TcxTextEdit(Controls[i]).Name).AsString);
end;
end;
if Controls[i] is TComboBox then
begin
if Trim(TEdit(Controls[i]).Hint) = Hintvalue then
if Trim(TComboBox(Controls[i]).Hint) = Hintvalue then
begin
TComboBox(Controls[i]).ItemIndex := TComboBox(Controls[i]).Items.IndexOf(Trim(TMClientDataset.FieldByName(TComboBox(Controls[i]).Name).AsString));
end;
end;
if Controls[i] is TcxComboBox then
begin
if Trim(TcxComboBox(Controls[i]).Hint) = Hintvalue then
begin
TcxComboBox(Controls[i]).ItemIndex := TcxComboBox(Controls[i]).Properties.Items.IndexOf(Trim(TMClientDataset.FieldByName(TcxComboBox(Controls[i]).Name).AsString));
end;
end;
end;
end;
end;
@ -591,6 +651,54 @@ begin
TEdit(Controls[i]).Text := '';
end;
end;
if Controls[i] is TcxCheckBox then
begin
if TcxCheckBox(Controls[i]).Hint = HintValue then
begin
TcxCheckBox(Controls[i]).Visible := IsHide;
if IsClear then
TcxCheckBox(Controls[i]).Checked := False;
end;
end;
if Controls[i] is TLabel then
begin
if TLabel(Controls[i]).Hint = HintValue then
begin
TLabel(Controls[i]).Visible := IsHide;
end;
end;
if Controls[i] is TcxComboBox then
begin
if TcxComboBox(Controls[i]).Hint = HintValue then
begin
TcxComboBox(Controls[i]).Visible := IsHide;
if IsClear then
TcxComboBox(Controls[i]).ItemIndex := -1;
end;
end;
if Controls[i] is TcxTextEdit then
begin
if Trim(TcxTextEdit(Controls[i]).Hint) = HintValue then
begin
TcxTextEdit(Controls[i]).Visible := IsHide;
if IsClear then
TcxTextEdit(Controls[i]).Text := '';
end;
end;
if Controls[i] is TcxButtonEdit then
begin
if Trim(TcxButtonEdit(Controls[i]).Hint) = HintValue then
begin
TcxButtonEdit(Controls[i]).Visible := IsHide;
if IsClear then
TcxButtonEdit(Controls[i]).Text := '';
end;
end;
end;
end;
end;
@ -1435,7 +1543,7 @@ begin
ADOQueryCmd.fieldByName(Controls[i].Name).Value := null;
end
else
ADOQueryCmd.fieldByName(Controls[i].Name).Value := TDateTimePicker(Controls[i]).DateTime;
ADOQueryCmd.fieldByName(Controls[i].Name).Value := FormatDateTime('yyyy-MM-dd', TDateTimePicker(Controls[i]).Date);
end
else if Controls[i] is TcxDateEdit then
begin
@ -1466,6 +1574,7 @@ begin
continue;
if Controls[i].Tag <> FTag then
continue;
if Controls[i] is TEdit then
begin
TEdit(Controls[i]).Text := '';
@ -1478,18 +1587,6 @@ begin
begin
Tmemo(Controls[i]).Text := '';
end
else if Controls[i] is TDateTimePicker then
begin
if TDateTimePicker(Controls[i]).ShowCheckbox = true then
begin
TDateTimePicker(Controls[i]).Checked := false;
end;
end
else if Controls[i] is TcxRichEdit then
begin
TcxRichEdit(Controls[i]).Text := '';
end
else if Controls[i] is TBtnEditC then
begin
TBtnEditC(Controls[i]).Text := '';
@ -1505,6 +1602,35 @@ begin
idx := -1;
TComboBox(Controls[i]).ItemIndex := idx;
end
else if Controls[i] is TDateTimePicker then
begin
if TDateTimePicker(Controls[i]).ShowCheckbox = true then
begin
TDateTimePicker(Controls[i]).Checked := false;
end;
end
else if Controls[i] is TcxRichEdit then
begin
TcxRichEdit(Controls[i]).Text := '';
end
else if Controls[i] is TcxTextEdit then
begin
TcxTextEdit(Controls[i]).Text := '';
end
else if Controls[i] is TcxComboBox then
begin
idx := -1;
TcxComboBox(Controls[i]).ItemIndex := idx;
end
else if Controls[i] is TcxMemo then
begin
TcxMemo(Controls[i]).Text := '';
end
else if Controls[i] is TcxButtonEdit then
begin
TcxButtonEdit(Controls[i]).Text := '';
TcxButtonEdit(Controls[i]).Properties.LookupItems.Text := '';
end
end;
end;
end;
@ -2200,6 +2326,37 @@ begin
end;
procedure SInitCxGridComboBoxBySqlV2(ADOQueryTmp: TADOQuery; Tv1: TcxGridDBTableView; FieldName: string; mSql: string);
begin
with ADOQueryTmp do
begin
close;
sql.Clear;
sql.Add(mSql);
Open;
if isEmpty then
begin
exit;
end
else
begin
// 通过目标列的字段名，获取需要添加内容的 ComboBox
with TcxComboBoxProperties(Tv1.GetColumnByFieldName(FieldName).Properties) do
begin
Items.Clear;
// 循环添加查询结果到 ComboBox 中
ADOQueryTmp.First;
while not ADOQueryTmp.Eof do
begin
Items.Add(ADOQueryTmp.FieldByName('Name').AsString);
ADOQueryTmp.Next;
end;
end;
end;
end;
end;
procedure SInitCxBandGridComboBoxBySql(ADOQueryTmp: TADOQuery; c3: TcxGridDBBandedColumn; FSql: string; PState: Integer; IsNull: Boolean; Shmeg: string);
var
A: TA;
@ -2524,8 +2681,8 @@ begin
while not eof do
begin
//cxgrid.find
mcxGridDbColumn1:= cxGrid.GetColumnByFieldName(trim(fieldByName('fieldName').asstring)) ;
if (mcxGridDbColumn1 <> nil) and (lowercase(mcxGridDbColumn1.Name)=lowercase(trim(fieldByName('columnName').asstring))) then
mcxGridDbColumn1 := cxGrid.GetColumnByFieldName(trim(fieldByName('fieldName').asstring));
if (mcxGridDbColumn1 <> nil) and (lowercase(mcxGridDbColumn1.Name) = lowercase(trim(fieldByName('columnName').asstring))) then
begin
mcxGridDbColumn1.Visible := fieldByName('Visible').AsBoolean;
mcxGridDbColumn1.Width := fieldByName('width').asInteger;

133
项目代码/RTBasicsV1/A00通用方法/U_CustomFun.pas Normal file
View File

@ -0,0 +1,133 @@
unit U_CustomFun;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, ToolWin, StdCtrls, BtnEdit, cxStyles, cxCustomData,
cxGraphics, cxFilter, cxData, cxDataStorage, cxEdit, DBGrids, DB, cxDBData,
cxGridLevel, cxClasses, cxControls, cxGridCustomView, ADODB, StrUtils, Midas,
cxGridCustomTableView, cxGridTableView, cxGridDBTableView, cxTimeEdit,
cxTreeView, cxGrid, cxDBLookupComboBox, cxCalendar, cxCurrencyEdit,
cxGridExportLink, ExtCtrls, Buttons, DBClient, RTComboBox, cxDropDownEdit,
cxGridBandedTableView, cxGridDBBandedTableView, cxRichEdit, cxButtonEdit,
IniFiles, WinSock, IdHTTP, dxcore, cxTextEdit, FireDAC.Comp.Client,
Vcl.Clipbrd, cxMemo, dxLayoutControl;
procedure CreatCDSData(ADO1: TADOQuery; Tv1: TcxGridDBTableView; FType: string);
procedure CreatLabelEdit(ADO1: TADOQuery; Tv1: TcxGridDBTableView; TMPanel: TPanel; FType: string);
implementation
uses
U_DataLink;
procedure CreatCDSData(ADO1: TADOQuery; Tv1: TcxGridDBTableView; FType: string);
var
FieldName, Caption, FootNote, SqlStr: string;
Column: TcxGridDBColumn;
begin
SqlStr := 'SELECT ZDYName AS FieldName, Note AS Caption, Note1 AS FLabel, Note2 AS FootNote FROM KH_ZDY where Type=''' + FType + ''' ';
with ADO1 do
begin
Filtered := False;
Close;
sql.Clear;
sql.Add(SqlStr);
Open;
end;
Tv1.BeginUpdate;
try
while Tv1.ColumnCount > 0 do //清空所有列
Tv1.Columns[0].Free;
// 遍历查询结果
while not ADO1.Eof do
begin
FieldName := ADO1.FieldByName('FieldName').AsString;
Caption := ADO1.FieldByName('Caption').AsString;
FootNote := ADO1.FieldByName('FootNote').AsString;
// 创建新列
Column := Tv1.CreateColumn;
Column.Caption := Caption;
Column.DataBinding.FieldName := FieldName;
Column.Width := 100;
Column.HeaderAlignmentHorz := taCenter;
ADO1.Next;
end;
finally
Tv1.EndUpdate;
end;
end;
procedure CreatLabelEdit(ADO1: TADOQuery; Tv1: TcxGridDBTableView; TMPanel: TPanel; FType: string);
var
LabelControl: TLabel;
EditControl: TEdit;
Caption, FLabel, FieldName, SqlStr: string;
I, CurrentTop, CurrentLeft, ControlWidth, LabelWidth: Integer;
begin
SqlStr := 'SELECT ZDYName AS FieldName, Note AS Caption, Note1 AS FLabel, Note2 AS FootNote FROM KH_ZDY where Type=''' + FType + ''' ';
with ADO1 do
begin
Filtered := False;
Close;
sql.Clear;
sql.Add('SELECT ZDYName AS FieldName, Note AS Caption, Note1 AS FLabel FROM KH_ZDY where Type=''WBGlide'' ');
Open;
end;
// 清空现有控件
for I := TMPanel.ControlCount - 1 downto 0 do
begin
TMPanel.Controls[I].Free;
end;
// 初始化位置(所有控件的顶部位置,第一个控件的左侧位置,Edit框的宽度)
CurrentTop := 10;
CurrentLeft := 10;
ControlWidth := 100;
// 遍历查询结果并创建标签和编辑框
I := 0;
while not ADO1.Eof do
begin
Caption := ADO1.FieldByName('Caption').AsString;
FLabel := ADO1.FieldByName('FLabel').AsString;
FieldName := ADO1.FieldByName('FieldName').AsString;
if FLabel = '是' then
begin
// 创建新Label
LabelControl := TLabel.Create(TMPanel);
LabelControl.Parent := TMPanel;
LabelControl.Caption := Caption;
LabelControl.Left := CurrentLeft;
LabelControl.Top := CurrentTop + 3; //下移一点，为了和Edit框对齐
LabelControl.AutoSize := True;
// 计算标签的宽度
LabelWidth := LabelControl.Width;
// 创建新Edit
EditControl := TEdit.Create(TMPanel);
EditControl.Parent := TMPanel;
EditControl.Left := CurrentLeft + LabelWidth + 3; // 在Label右边，并留有间隔
EditControl.Top := CurrentTop; // 设置距顶距离
EditControl.Width := ControlWidth; // 设置宽度
EditControl.Name := FieldName; // 设置Name属性
EditControl.Tag := 2; // 刷新触发过滤
// 更新位置
CurrentLeft := EditControl.Left + EditControl.Width + 20; // 为下一个控件的位置留空间
EditControl.Text := '';
Inc(I);
end;
ADO1.Next;
end;
end;
end.

359
项目代码/RTBasicsV1/A00通用方法/U_HttpFun.pas Normal file
View File

@ -0,0 +1,359 @@
unit U_HttpFun;
interface
uses
System.SysUtils, System.Net.HttpClientComponent, System.Classes, System.JSON,
Datasnap.DBClient, Data.DB;
function UrlDecode(const AStr: AnsiString): AnsiString;
function GetRequest(Url: string): string;
function RTGetRequest(Url: string): string;
procedure JsonToDataset(JsonStr, ArrName: string; CDS_1: TclientDataSet);
function JsonErr(JsonStr, Success: string): string;
function JsonGetChildValue(JsonStr, KeyName: string): string;
function JsonGetChildObject(JsonStr, KeyName: string): string;
function YongYouGettoken(): string;
function YongYouSpliceUrl(BsUrl, ChildUrl, from_account, to_account, app_key, token, arg: string): string;
procedure JsonToCHDA(JSONStr, ArrName: string; CDS_1: TclientDataSet);
implementation
uses
U_DataLink;
function RTGetRequest(Url: string): string;
var
vHttp: TNetHTTPClient;
vUTF8: TStringStream;
begin
vHttp := TNetHTTPClient.Create(nil);
vUTF8 := TStringStream.Create('', TEncoding.GetEncoding(65001));
try
with vHttp do
begin
vUTF8.Clear;
ConnectionTimeout := 2000; // 2秒
ResponseTimeout := 10000; // 10秒
AcceptCharSet := 'utf-8';
AcceptEncoding := '65001';
AcceptLanguage := 'zh-CN';
ContentType := 'text/html';
UserAgent := 'Embarcadero URI Client/1.0';
try
Get(Url, vUTF8);
Result := vUTF8.DataString; // UrlDecode(vUTF8.DataString); //TNetEncoding.URL.
except
on E: Exception do
// Error sending data: (12002) 操作超时.
// Error receiving data: (12002) 操作超时
if Copy(E.Message, 1, Pos(':', E.Message) - 1) = 'Error sending data' then
Result := '{"RtErr":"接口连接失败！"}'
else if Copy(E.Message, 1, Pos(':', E.Message) - 1) = 'Error receiving data' then
Result := '{"RtErr":"接口传输数据失败，请延长接收超时时间"}'
else
Result := '{"RtErr":"' + E.Message + '"}';
end;
end;
finally
vUTF8.Free;
vHttp.Free;
end;
end;
procedure JsonToCHDA(JSONStr, ArrName: string; CDS_1: TclientDataSet);
var
JSONObject, JSONObject2: TJSONObject; // JSON类
JSONPair: TJSONPair;
i, j, k: Integer; // 循环变量
Cloint: Integer; // 循环变量
temp: string; // 临时使用变量
jsonArray: TJSONArray; // JSON数组变量
mfieldName: string;
mSize: Integer;
begin
JSONObject := nil;
try
CDS_1.DisableControls;
CDS_1.FieldDefs.Clear;
CDS_1.FieldDefs.Add('code', ftString, 255);
CDS_1.FieldDefs.Add('name', ftString, 255);
CDS_1.FieldDefs.Add('specs', ftString, 255);
CDS_1.FieldDefs.Add('SSel', ftBoolean, 0);
CDS_1.close;
CDS_1.CreateDataSet;
{ 从字符串生成JSON }
JSONObject := TJSONObject.ParseJSONValue(JSONStr) as TJSONObject;
if JSONObject.Count > 0 then
begin
// json数组
jsonArray := TJSONArray(JSONObject.GetValue(ArrName));
if jsonArray.Count > 0 then
begin
// 循环取得JSON数组中每个元素
for i := 0 to jsonArray.Size - 1 do
begin
with CDS_1 do
begin
Append;
Cloint := jsonArray.Items[i].GetValue<TJSONObject>.Count;
for k := 0 to Cloint - 1 do
begin
JSONPair := jsonArray.Items[i].GetValue<TJSONObject>.Pairs[k];
if Findfield(JSONPair.JsonString.Value) <> nil then
begin
FieldByName(JSONPair.JsonString.Value).Value := JSONPair.JSONValue.Value;
end;
end;
Post;
end;
end;
end;
end
else
begin
temp := '没有数据！';
end;
finally
CDS_1.First;
CDS_1.EnableControls;
JSONObject.Free;
end;
end;
function YongYouGettoken(): string;
var
JsonStr: string;
JSONObject: TJSONObject; // JSON类
JSONPair: TJSONPair;
i, Cloint: integer;
begin
Result := '';
BJ_Url := 'https://api.yonyouup.com/api/';
BJ_FromAccount := 'hbyl2024';
BJ_ToAccount := 'hbyl2024:mesapp';
BJ_appKey := 'opaeaf8afe01e3fe21f';
JsonStr := GetRequest('https://api.yonyouup.com/system/token?from_account=hbyl2024&app_key=opaeaf8afe01e3fe21f&app_secret=8d699f9b39ac41139941f224d5da154e');
if JsonErr(JsonStr, '0') = '0' then
begin
BJ_token := JsonGetChildValue(JsonGetChildObject(JsonStr, 'token'), 'id');
end
else
begin
Result := JsonStr;
end;
end;
function YongYouSpliceUrl(BsUrl, ChildUrl, from_account, to_account, app_key, token, arg: string): string;
begin
Result := BsUrl + ChildUrl + '?from_account=' + from_account + '&to_account=' + to_account + '&app_key=' + app_key + '&token=' + token + arg;
end;
function UrlDecode(const AStr: AnsiString): AnsiString;
var
Sp, Rp, Cp: PAnsiChar;
s: AnsiString;
begin
SetLength(Result, Length(AStr));
Sp := PAnsiChar(AStr);
Rp := PAnsiChar(Result);
Cp := Sp;
while Sp^ <> #0 do
begin
case Sp^ of
'+':
Rp^ := ' ';
'%':
begin
Inc(Sp);
if Sp^ = '%' then
Rp^ := '%'
else
begin
Cp := Sp;
Inc(Sp);
if (Cp^ <> #0) and (Sp^ <> #0) then
begin
s := AnsiChar('$') + Cp^ + Sp^;
Rp^ := AnsiChar(StrToInt(string(s)));
end;
end;
Cp := Cp;
end;
else
Rp^ := Sp^;
end;
Inc(Rp);
Inc(Sp);
end;
SetLength(Result, Rp - PAnsiChar(Result));
end;
function GetRequest(Url: string): string;
var
vHttp: TNetHTTPClient;
vUTF8: TStringStream;
begin
vHttp := TNetHTTPClient.Create(nil);
vUTF8 := TStringStream.Create('', TEncoding.GetEncoding(65001));
try
with vHttp do
begin
vUTF8.Clear;
ConnectionTimeout := 2000; // 2秒
ResponseTimeout := 10000; // 10秒
AcceptCharSet := 'utf-8';
AcceptEncoding := '65001';
AcceptLanguage := 'zh-CN';
ContentType := 'text/html';
UserAgent := 'Embarcadero URI Client/1.0';
try
Get(Url, vUTF8);
Result := vUTF8.DataString; // UrlDecode(vUTF8.DataString); //TNetEncoding.URL.
except
on E: Exception do
// Error sending data: (12002) 操作超时.
// Error receiving data: (12002) 操作超时
if Copy(E.Message, 1, Pos(':', E.Message) - 1) = 'Error sending data' then
Result := '{"RtErr":"接口连接失败！"}'
else if Copy(E.Message, 1, Pos(':', E.Message) - 1) = 'Error receiving data' then
Result := '{"RtErr":"接口传输数据失败，请延长接收超时时间"}'
else
Result := '{"RtErr":"' + E.Message + '"}';
end;
end;
finally
vUTF8.Free;
vHttp.Free;
end;
end;
procedure JsonToDataset(JSONStr, ArrName: string; CDS_1: TclientDataSet);
var
JSONObject, JSONObject2: TJSONObject; // JSON类
JSONPair: TJSONPair;
i, j, k: Integer; // 循环变量
Cloint: Integer; // 循环变量
temp: string; // 临时使用变量
jsonArray: TJSONArray; // JSON数组变量
mfieldName: string;
mSize: Integer;
begin
JSONObject := nil;
try
CDS_1.DisableControls;
{ 从字符串生成JSON }
JSONObject := TJSONObject.ParseJSONValue(JSONStr) as TJSONObject;
if JSONObject.Count > 0 then
begin
// json数组
jsonArray := TJSONArray(JSONObject.GetValue(ArrName));
if jsonArray.Count > 0 then
begin
// 循环取得JSON数组中每个元素
for i := 0 to jsonArray.Size - 1 do
begin
if i = 0 then
begin
Cloint := jsonArray.Items[i].GetValue<TJSONObject>.Count;
CDS_1.FieldDefs.Clear;
for j := 0 to Cloint - 1 do
begin
JSONPair := jsonArray.Items[i].GetValue<TJSONObject>.Pairs[j];
CDS_1.FieldDefs.Add(JSONPair.JsonString.Value, ftString, 255);
end;
CDS_1.FieldDefs.Add('SSel', ftBoolean, 0);
CDS_1.close;
CDS_1.CreateDataSet;
end;
with CDS_1 do
begin
Append;
for k := 0 to Cloint - 1 do
begin
JSONPair := jsonArray.Items[i].GetValue<TJSONObject>.Pairs[k];
if Findfield(JSONPair.JsonString.Value) <> nil then
FieldByName(JSONPair.JsonString.Value).Value := JSONPair.JSONValue.Value;
end;
Post;
end;
end;
end;
end
else
begin
temp := '没有数据！';
end;
finally
CDS_1.First;
CDS_1.EnableControls;
JSONObject.Free;
end;
end;
function JsonErr(JsonStr, Success: string): string;
var
JSONObject: TJSONObject; // JSON类
JSONPair: TJSONPair;
i, Cloint: integer;
begin
Result := Success;
JSONObject := TJSONObject.ParseJSONValue(JsonStr) as TJSONObject;
Cloint := JSONObject.Count;
for i := 0 to Cloint - 1 do
begin
JSONPair := JSONObject.Pairs[i];
if JSONPair.JsonString.Value = 'errcode' then
Result := JSONPair.JSONValue.Value;
end;
end;
function JsonGetChildObject(JsonStr, KeyName: string): string;
var
JSONObject: TJSONObject; // JSON类
begin
Result := '';
JSONObject := TJSONObject.ParseJSONValue(JsonStr) as TJSONObject;
Result := JSONObject.GetValue(KeyName).ToString;
end;
function JsonGetChildValue(JsonStr, KeyName: string): string;
var
JSONObject: TJSONObject; // JSON类
JSONPair: TJSONPair;
i, Cloint: integer;
Z, X: string;
begin
Result := '';
JSONObject := TJSONObject.ParseJSONValue(JsonStr) as TJSONObject;
Cloint := JSONObject.Count;
for i := 0 to Cloint - 1 do
begin
JSONPair := JSONObject.Pairs[i];
Z := JSONPair.JsonString.Value;
X := JSONPair.JSONValue.Value;
if JSONPair.JsonString.Value = KeyName then
Result := JSONPair.JSONValue.Value;
end;
end;
end.

122
项目代码/RTBasicsV1/A00通用方法/U_PrintLabFun.pas Normal file
View File

@ -0,0 +1,122 @@
unit U_PrintLabFun;
interface
uses
ADODB, System.SysUtils, Vcl.Forms;
procedure PrintServerLabel(ADO_Prt: TADOQuery; mSheets, mprintFlag, mprinter: Integer; FFiltration1: string);
procedure PrintServerLabelStkId(ADO_Prt: TADOQuery; mSheets, mprintFlag, mprinter: Integer; FFiltration1: string);
implementation
uses
U_printPdf, U_RTFun, U_DataLink;
procedure PrintServerLabel(ADO_Prt: TADOQuery; mSheets, mprintFlag, mprinter: Integer; FFiltration1: string);
var
MaxBLCLID, LBName: string;
WBoolean: Boolean;
i: Integer;
Mmessage, MpdfFileId, Mcode: string;
begin
with ADO_Prt do
begin
Close;
SQL.Clear;
sql.Add(' EXEC P_Trade_Card_Prt1 ');
SQL.Add(' @Filtration=''' + Trim(FFiltration1) + '''');
Open;
end;
if ADO_Prt.IsEmpty then
begin
raise Exception.Create('标签内容未找到!');
end;
LBName := Trim(ADO_Prt.fieldbyname('LabVolume').AsString);
try
if GetLSNo(ADO_Prt, MaxBLCLID, 'L', 'Bs_Report_Cloud_Log', 4, 1) = False then
begin
end;
with ADO_Prt do
begin
Close;
SQL.Clear;
sql.Add('select * from Bs_Report_Cloud_Log where 1=2');
Open;
end;
with ADO_Prt do
begin
Append;
FieldByName('BLCLID').Value := MaxBLCLID;
FieldByName('Filler').Value := dname;
FieldByName('LMName').Value := LBName;
FieldByName('LMSql1').Value := 'P_Trade_Card_Prt1';
FieldByName('Filtration1').Value := Trim(FFiltration1);
FieldByName('IsSql1').Value := 0;
FieldByName('Sheets').Value := mSheets;
Post;
end;
printPdf(Application, 1, PChar('title'), PChar(dcode), PChar(dname), PChar(MaxBLCLID), mSheets, mprintFlag, mprinter, PChar(DConString));
except
application.MessageBox(PChar(Exception(ExceptObject).Message), '提示信息', 0);
end;
end;
procedure PrintServerLabelStkId(ADO_Prt: TADOQuery; mSheets, mprintFlag, mprinter: Integer; FFiltration1: string);
var
MaxBLCLID, LBName: string;
WBoolean: Boolean;
i: Integer;
Mmessage, MpdfFileId, Mcode: string;
begin
with ADO_Prt do
begin
Close;
SQL.Clear;
sql.Add(' EXEC P_Trade_Cloth_Prt_Lab ');
SQL.Add(' @Filtration=''' + Trim(FFiltration1) + '''');
Open;
end;
if ADO_Prt.IsEmpty then
begin
raise Exception.Create('标签内容未找到!');
end;
LBName := Trim(ADO_Prt.fieldbyname('LabVolume').AsString);
try
if GetLSNo(ADO_Prt, MaxBLCLID, 'L', 'Bs_Report_Cloud_Log', 4, 1) = False then
begin
end;
with ADO_Prt do
begin
Close;
SQL.Clear;
sql.Add('select * from Bs_Report_Cloud_Log where 1=2');
Open;
end;
with ADO_Prt do
begin
Append;
FieldByName('BLCLID').Value := MaxBLCLID;
FieldByName('Filler').Value := dname;
FieldByName('LMName').Value := LBName;
FieldByName('LMSql1').Value := 'P_Trade_Cloth_Prt_Lab';
FieldByName('Filtration1').Value := Trim(FFiltration1);
FieldByName('IsSql1').Value := 0;
FieldByName('Sheets').Value := mSheets;
Post;
end;
printPdf(Application, 1, PChar('title'), PChar(dcode), PChar(dname), PChar(MaxBLCLID), mSheets, mprintFlag, mprinter, PChar(DConString));
except
application.MessageBox(PChar(Exception(ExceptObject).Message), '提示信息', 0);
end;
end;
end.

157
项目代码/RTBasicsV1/A00通用方法/uFomat_JSON.pas Normal file
View File

@ -0,0 +1,157 @@
{格式化 JSON 单元
}
unit uFomat_JSON;
interface
uses
system.JSON,
System.SysUtils, System.Variants, System.Classes;
const
Level_indent = 2;
//格式化 JSON 字符串
// JSONStr : 表示需要格式化的 JSON字符串
// lv : 表示缩进层级
function JSON_Format(JSONStr : string; lv : Word = 0) : string;
//格式化数组, 缩进
function JSON_Fromat_Array(ja : TJSONArray; lv : word = 0) : string;
//跨过的indent
function LI(lv : Word) : string;
implementation
//格式化 JSON 字符串
// JSONStr : 表示需要格式化的 JSON字符串
// Left_Space : 表示左边统一留多少个空格
// Level_index ：表示每级缩进多个个空格
function JSON_Format(JSONStr : string; lv : Word = 0) : string;
var
S : string;
jo : TJSONObject;
jo1: TJSONObject;
jp : TJSONPair;
js : TJSONString;
jn : TJSONNumber;
jb : TJSONBool;
ja : TJSONArray;
jpe : TJSONObject.TEnumerator;
begin
//1. 解析 JSONStr
jo := TJSONObject.ParseJSONValue(JSONStr) as TJSONObject;
if jo = nil then Exit(JSONStr);
Result := '{' + #13#10;
try
jpe := jo.GetEnumerator;
if jpe = nil then Exit(JSONSTr);
while jpe.MoveNext do
begin
jp := jpe.Current;
if jp.JsonValue.TryGetValue(jo1) then
begin
Result := Result + LI(lv + 1) + '"' + jp.JsonString.Value + '":'#13#10;
Result := Result + LI(lv + 1) + JSON_Format(jo1.ToJSON,lv + 2);
Continue;
end
else
if jp.JsonValue.TryGetValue(jn) then //数字
Result := Result + LI(lv + 1) + '"' + jp.JsonString.Value + '": ' + jn.Value + ','#13#10
else
if jp.JsonValue.TryGetValue(jb) then //Boolean
Result := Result + LI(lv + 1) + '"' + jp.JsonString.Value + '": ' + jb.Value + ','#13#10
else
if jp.JsonValue.TryGetValue(ja) then //字符串
begin
Result := Result + LI(lv + 1) + '"' + jp.JsonString.Value + '": '#13#10;
Result := Result + LI(lv + 1) + JSON_Fromat_Array(ja,lv + 1);
end
else
if jp.JsonValue.TryGetValue(js) then //字符串
Result := Result + LI(lv + 1) + '"' + jp.JsonString.Value + '": "' + js.Value + '",'#13#10
end;
//去掉最后一行的 ,
S := Result.Substring(Length(Result) - 3,3);
if S = ','#13#10 then
Result := Result.Substring(0,Length(Result) - 3) + #13#10;
//最后结果的 }
if lv > 0 then
begin
lv := lv - 1;
Result := Result + LI(lv) + '},'#13#10;
end
else
Result := Result + LI(0) + '}'#13#10;
finally
if jo <> nil then
jo.Free;
if jpe <> nil then
jpe.Free;
end;
end;
//格式化数组, 缩进
function JSON_Fromat_Array(ja : TJSONArray; lv : word = 0) : string;
var
jae : TJSONArray.TEnumerator;
jv : TJSONValue;
js : TJSONString;
jn : TJSONNumber;
jb : TJSONBool;
jo : TJSONObject;
ja1 : TJSONArray;
S : string;
begin
//
Result := '['#13#10;
jae := ja.GetEnumerator;
if jae = nil then Exit('');
while jae.MoveNext do
begin
jv := jae.Current;
//进行数据处理
if jv.TryGetValue(jn) then //Number
Result := Result + LI(lv + 1) + jn.Value + ','#13#10
else
if jv.TryGetValue(jb) then //Boolean
Result := Result + LI(lv + 1) + jb.Value + ','#13#10
else
if jv.TryGetValue(jo) then //JSONObject
begin
Result := Result + LI(lv + 1) + JSON_Format(jo.ToString,lv + 2) ;
end
else
if jv.TryGetValue(ja1) then //JSONArray
Result := Result + LI(lv + 1) + JSON_Fromat_Array(ja1,lv + 1)
else
if jv.TryGetValue(js) then //string
Result := Result + LI(lv + 1) + '"' + js.Value + '",'#13#10;
end;
//去掉最后一行的 ,
S := Result.Substring(Length(Result) - 3,3);
if S = ','#13#10 then
Result := Result.Substring(0,Length(Result) - 3) + #13#10;
Result := Result + LI(lv) + '],'#13#10;
if jae <> nil then
jae.Free;
end;
//跨过的indent
function LI(lv : Word) : string;
begin
Result := StringOfChar(' ', lv * Level_indent);
end;
end.

248
项目代码/RTBasicsV1/A00通用方法/uSZHN_JSON.pas Normal file
View File

@ -0,0 +1,248 @@
{**************************************
时间：2021-06-18
功能：1 实现delphi原生的JSON操作为 S[] 操作方式
作者：sensor QQ:910731685
}
unit uSZHN_JSON;
interface
uses
//System.Classes,
//System.Types,
//System.DateUtil,
//System.Generics.Collections,
System.SysUtils,
System.JSON;
type
TJSONObjectHelper = class helper for TJSONObject
private
function Get_ValueS(PairName : string) : string;
procedure Set_ValueS(PairName,PairValue : string);
function Get_ValueI(PairName : string) : Integer;
procedure Set_ValueI(PairName : string; PairValue : Integer);
function Get_ValueI64(PairName : string) : Int64;
procedure Set_ValueI64(PairName : string; PairValue : Int64);
function Get_ValueD(PairName : string) : TDateTime;
procedure Set_ValueD(PairName : string; PairValue : TDateTime);
function Get_ValueB(PairName : string) : Boolean;
procedure Set_ValueB(PairName : string; PairValue : Boolean);
function Get_ValueA(PairName : string) : TJSONArray;
procedure Set_ValueA(PairName : string; PairValue : TJSONArray);
function Get_ValueO(PairName : string) : TJSONObject;
procedure Set_ValueO(PairName : string; PairValue : TJSONObject);
public
//判断某个字段是否存在
function PairExists(PairName : string) : Boolean;
procedure Remove(PairName : string);
//定义字段读取函数
property S[PairName : string] : string read Get_ValueS write Set_ValueS;
property I[PairName : string] : integer read Get_ValueI write Set_ValueI;
property I64[PairName : string] : Int64 read Get_ValueI64 write Set_ValueI64;
property D[PairName : string] : TDateTime read Get_ValueD write Set_ValueD;
property B[PairName : string] : Boolean read Get_ValueB write Set_ValueB;
property A[PairName : string] : TJSONArray read Get_ValueA write Set_ValueA;
property O[PairName : string] : TJSONObject read Get_ValueO write Set_ValueO;
end;
implementation
{ TJSONObjectHelper }
function TJSONObjectHelper.Get_ValueS(PairName: string): string;
var
js : TJSONString;
begin
if PairName = '' then Exit;
if Self.TryGetValue(PairName,js) then
Result := js.Value
else
Result := '';
end;
function TJSONObjectHelper.PairExists(PairName: string): Boolean;
begin
Result := Self.Values[PairName] <> nil;
end;
procedure TJSONObjectHelper.Remove(PairName: string);
begin
Self.RemovePair(PairName).Free;
end;
procedure TJSONObjectHelper.Set_ValueS(PairName, PairValue: string);
var
js : TJSONString;
begin
//1. 首先查找有没有该字段, 如果有，则直接删除
if Self.TryGetValue(PairName,js) then
begin
Self.RemovePair(PairName).Free; //如果没有free，就会产生内存泄露
end;
//2. 然后在增加
Self.AddPair(PairName, PairValue);
end;
function TJSONObjectHelper.Get_ValueI(PairName: string): Integer;
var
ji : TJSONNumber;
begin
if PairName = '' then Exit(0);
if Self.TryGetValue(PairName,ji) then
Result := ji.AsInt
else
Result := 0;
end;
procedure TJSONObjectHelper.Set_ValueI(PairName: string; PairValue: Integer);
var
jn : TJSONNumber;
begin
//1. 首先查找有没有该字段, 如果有，则直接删除
if Self.TryGetValue(PairName,jn) then
Self.RemovePair(PairName).Free;
//2. 然后在增加
Self.AddPair(PairName, TJSONNumber.Create(PairValue));
end;
function TJSONObjectHelper.Get_ValueD(PairName: string): TDateTime;
var
ji : TJSONNumber;
begin
if PairName = '' then Exit(0);
if Self.TryGetValue(PairName,ji) then
Result := ji.AsDouble
else
Result := 0;
end;
procedure TJSONObjectHelper.Set_ValueD(PairName: string; PairValue: TDateTime);
var
jn : TJSONNumber;
begin
//1. 首先查找有没有该字段, 如果有，则直接删除
if Self.TryGetValue(PairName,jn) then
Self.RemovePair(PairName).Free;
Self.AddPair(PairName, TJSONNumber.Create(PairValue));
end;
function TJSONObjectHelper.Get_ValueB(PairName: string): Boolean;
var
jb : TJSONBool;
begin
if PairName = '' then Exit(False);
if Self.TryGetValue(PairName,jb) then
Result := jb.AsBoolean
else
Result := False;
end;
procedure TJSONObjectHelper.Set_ValueB(PairName: string; PairValue: Boolean);
var
jb : TJSONBool;
begin
//1. 首先查找有没有该字段, 如果有，则直接删除
if Self.TryGetValue(PairName,jb) then
Self.RemovePair(PairName).Free;
Self.AddPair(PairName, TJSONBool.Create(PairValue));
end;
function TJSONObjectHelper.Get_ValueI64(PairName: string): Int64;
var
ji : TJSONNumber;
begin
if PairName = '' then Exit(0);
if Self.TryGetValue(PairName,ji) then
Result := ji.AsInt64
else
Result := 0;
end;
procedure TJSONObjectHelper.Set_ValueI64(PairName: string; PairValue: Int64);
var
jn : TJSONNumber;
begin
//1. 首先查找有没有该字段, 如果有，则直接删除
if Self.TryGetValue(PairName,jn) then
Self.RemovePair(PairName).Free;
Self.AddPair(PairName, TJSONNumber.Create(PairValue));
end;
function TJSONObjectHelper.Get_ValueA(PairName: string): TJSONArray;
var
ja : TJSONArray;
begin
if PairName = '' then Exit(nil);
Self.TryGetValue(PairName,Result);
end;
procedure TJSONObjectHelper.Set_ValueA(PairName: string; PairValue: TJSONArray);
var
ja : TJSONArray;
begin
//1. 首先查找有没有该字段, 如果有，则直接删除
if Self.TryGetValue(PairName,ja) then
Self.RemovePair(PairName).Free;
Self.AddPair(PairName, PairValue);
end;
function TJSONObjectHelper.Get_ValueO(PairName: string): TJSONObject;
var
jo : TJSONObject;
begin
if PairName = '' then Exit(nil);
if Self.TryGetValue(PairName,jo) then
Result := jo
else
Result := nil;
end;
procedure TJSONObjectHelper.Set_ValueO(PairName: string; PairValue: TJSONObject);
var
jo : TJSONObject;
begin
//1. 首先查找有没有该字段, 如果有，则直接删除
if Self.TryGetValue(PairName,jo) then
Self.RemovePair(PairName).Free;
Self.AddPair(PairName, PairValue as TJSONObject);
end;
end.

4
项目代码/RTBasicsV1/A01基础公司管理/U_Customer.dfm
View File

@ -130,7 +130,6 @@ inherited frmCustomer: TfrmCustomer
Color = clWhite
ParentBackground = False
TabOrder = 1
ExplicitTop = 24
object Label3: TLabel
Left = 205
Top = 20
@ -207,8 +206,6 @@ inherited frmCustomer: TfrmCustomer
Height = 287
Align = alClient
TabOrder = 2
ExplicitLeft = -1
ExplicitTop = 116
object Tv1: TcxGridDBTableView
Navigator.Buttons.CustomButtons = <>
Navigator.Buttons.Delete.Enabled = False
@ -407,7 +404,6 @@ inherited frmCustomer: TfrmCustomer
DataBinding.FieldName = 'Contacts'
DataBinding.IsNullValueType = True
PropertiesClassName = 'TcxTextEditProperties'
Properties.CharCase = ecUpperCase
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 70