diff --git a/public10/ThreeFun/Fun/U_RTFun.pas b/public10/ThreeFun/Fun/U_RTFun.pas index 797e7b3..7bf5783 100644 --- a/public10/ThreeFun/Fun/U_RTFun.pas +++ b/public10/ThreeFun/Fun/U_RTFun.pas @@ -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; diff --git a/椤圭洰浠ｇ爜/RTBasicsV1/A00閫氱敤鏂规硶/U_CustomFun.pas b/椤圭洰浠ｇ爜/RTBasicsV1/A00閫氱敤鏂规硶/U_CustomFun.pas new file mode 100644 index 0000000..d77e955 --- /dev/null +++ b/椤圭洰浠ｇ爜/RTBasicsV1/A00閫氱敤鏂规硶/U_CustomFun.pas @@ -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. + diff --git a/椤圭洰浠ｇ爜/RTBasicsV1/A00閫氱敤鏂规硶/U_HttpFun.pas b/椤圭洰浠ｇ爜/RTBasicsV1/A00閫氱敤鏂规硶/U_HttpFun.pas new file mode 100644 index 0000000..6297224 --- /dev/null +++ b/椤圭洰浠ｇ爜/RTBasicsV1/A00閫氱敤鏂规硶/U_HttpFun.pas @@ -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.Count; + for k := 0 to Cloint - 1 do + begin + JSONPair := jsonArray.Items[i].GetValue.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.Count; + CDS_1.FieldDefs.Clear; + for j := 0 to Cloint - 1 do + begin + JSONPair := jsonArray.Items[i].GetValue.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.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. + diff --git a/椤圭洰浠ｇ爜/RTBasicsV1/A00閫氱敤鏂规硶/U_PrintLabFun.pas b/椤圭洰浠ｇ爜/RTBasicsV1/A00閫氱敤鏂规硶/U_PrintLabFun.pas new file mode 100644 index 0000000..789e042 --- /dev/null +++ b/椤圭洰浠ｇ爜/RTBasicsV1/A00閫氱敤鏂规硶/U_PrintLabFun.pas @@ -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. + diff --git a/椤圭洰浠ｇ爜/RTBasicsV1/A00閫氱敤鏂规硶/uFomat_JSON.pas b/椤圭洰浠ｇ爜/RTBasicsV1/A00閫氱敤鏂规硶/uFomat_JSON.pas new file mode 100644 index 0000000..293d1cf --- /dev/null +++ b/椤圭洰浠ｇ爜/RTBasicsV1/A00閫氱敤鏂规硶/uFomat_JSON.pas @@ -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. diff --git a/椤圭洰浠ｇ爜/RTBasicsV1/A00閫氱敤鏂规硶/uSZHN_JSON.pas b/椤圭洰浠ｇ爜/RTBasicsV1/A00閫氱敤鏂规硶/uSZHN_JSON.pas new file mode 100644 index 0000000..9e5eeaa --- /dev/null +++ b/椤圭洰浠ｇ爜/RTBasicsV1/A00閫氱敤鏂规硶/uSZHN_JSON.pas @@ -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. diff --git a/椤圭洰浠ｇ爜/RTBasicsV1/A01鍩虹鍏徃绠＄悊/U_Customer.dfm b/椤圭洰浠ｇ爜/RTBasicsV1/A01鍩虹鍏徃绠＄悊/U_Customer.dfm index 58b6c4b..a783783 100644 --- a/椤圭洰浠ｇ爜/RTBasicsV1/A01鍩虹鍏徃绠＄悊/U_Customer.dfm +++ b/椤圭洰浠ｇ爜/RTBasicsV1/A01鍩虹鍏徃绠＄悊/U_Customer.dfm @@ -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