From f4818e3a292dbf3df90d550cbda25623865a4d01 Mon Sep 17 00:00:00 2001 From: "DESKTOP-E401PHE\\Administrator" Date: Sat, 30 Aug 2025 14:29:28 +0800 Subject: [PATCH] =?UTF-8?q?=E6=89=93=E5=8D=B0=E7=AA=97=E4=BD=93=E6=B7=BB?= =?UTF-8?q?=E5=8A=A0=E4=BA=8C=E7=BB=B4=E7=A0=81?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- A00标签打印/U_ClientPrintRmf.dfm | 88 ++++++------- A00标签打印/U_ClientPrintRmf.pas | 217 ++---------------------------- A00标签打印/U_LabelPrint.dfm | 120 ++++++++--------- A00标签打印/U_LabelPrint.pas | 37 +++--- A00标签打印/U_LabelPrintFun.pas | 2 - A00标签打印/U_QrCodeFun.pas | 219 +++++++++++++++++++++++++++++++ 云翔一码通/U_YMTRKInPut.dfm | 5 +- 云翔一码通/U_YMTRKList.pas | 2 +- 云翔一码通/YXYMT.dpr | 3 +- 9 files changed, 363 insertions(+), 330 deletions(-) create mode 100644 A00标签打印/U_QrCodeFun.pas diff --git a/A00标签打印/U_ClientPrintRmf.dfm b/A00标签打印/U_ClientPrintRmf.dfm index 3db3572..042f1b9 100644 --- a/A00标签打印/U_ClientPrintRmf.dfm +++ b/A00标签打印/U_ClientPrintRmf.dfm @@ -22,20 +22,20 @@ object frmClientPrintRmf: TfrmClientPrintRmf Connection = ADOConnection1 LockType = ltReadOnly Parameters = <> - Left = 273 - Top = 12 + Left = 441 + Top = 198 end object ADOConnection1: TADOConnection LoginPrompt = False - Left = 27 - Top = 12 + Left = 195 + Top = 198 end object ImageList1: TImageList DrawingStyle = dsTransparent Height = 32 Width = 32 - Left = 109 - Top = 136 + Left = 359 + Top = 322 Bitmap = { 494C010119002400040020002000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 000000000000360000002800000080000000E0000000010020000000000000C0 @@ -3743,8 +3743,8 @@ object frmClientPrintRmf: TfrmClientPrintRmf object RMDB_1: TRMDBDataSet Visible = True DataSet = CDS_1 - Left = 273 - Top = 136 + Left = 523 + Top = 322 end object RM1: TRMGridReport ThreadPrepareReport = True @@ -3763,34 +3763,34 @@ object frmClientPrintRmf: TfrmClientPrintRmf CompressThread = False LaterBuildEvents = True OnlyOwnerDataSet = False - Left = 273 - Top = 198 + Left = 523 + Top = 384 ReportData = {} end object RMDB_2: TRMDBDataSet Visible = True DataSet = CDS_2 - Left = 355 - Top = 136 + Left = 195 + Top = 384 end object CDS_Label: TClientDataSet Aggregates = <> Params = <> - Left = 27 - Top = 136 + Left = 277 + Top = 322 end object ADO_Prt: TADOQuery Connection = ADOConnection1 LockType = ltReadOnly Parameters = <> - Left = 355 - Top = 12 + Left = 523 + Top = 198 end object RMDB_3: TRMDBDataSet Visible = True DataSet = CDS_3 - Left = 27 - Top = 198 + Left = 277 + Top = 384 end object RMXLSExport1: TRMXLSExport ShowAfterExport = True @@ -3803,78 +3803,78 @@ object frmClientPrintRmf: TfrmClientPrintRmf ScaleX = 1.000000000000000000 ScaleY = 1.000000000000000000 CompressFile = False - Left = 27 - Top = 260 + Left = 277 + Top = 446 end object RMJPEGExport1: TRMJPEGExport ScaleX = 1.000000000000000000 ScaleY = 1.000000000000000000 - Left = 355 - Top = 198 + Left = 195 + Top = 446 end object RMBarCodeObject1: TRMBarCodeObject - Left = 191 - Top = 136 + Left = 441 + Top = 322 end object ADOQueryCmd: TADOQuery Connection = ADOConnection1 Parameters = <> - Left = 109 - Top = 12 + Left = 277 + Top = 198 end object ADO_While: TADOQuery Connection = ADOConnection1 LockType = ltReadOnly Parameters = <> - Left = 355 - Top = 74 + Left = 195 + Top = 260 end object RMDB_4: TRMDBDataSet Visible = True DataSet = CDS_4 - Left = 109 - Top = 198 + Left = 359 + Top = 384 end object RMDB_5: TRMDBDataSet Visible = True DataSet = CDS_5 - Left = 191 - Top = 198 + Left = 441 + Top = 384 end object ADOQueryReport: TADOQuery Connection = ADOConnection1 Parameters = <> - Left = 191 - Top = 12 + Left = 359 + Top = 198 end object CDS_1: TClientDataSet Aggregates = <> Params = <> - Left = 123 - Top = 288 + Left = 277 + Top = 260 end object CDS_2: TClientDataSet Aggregates = <> Params = <> - Left = 259 - Top = 304 + Left = 359 + Top = 260 end object CDS_3: TClientDataSet Aggregates = <> Params = <> - Left = 203 - Top = 360 + Left = 441 + Top = 260 end object CDS_4: TClientDataSet Aggregates = <> Params = <> - Left = 331 - Top = 376 + Left = 523 + Top = 260 end object CDS_5: TClientDataSet Aggregates = <> Params = <> - Left = 411 - Top = 376 + Left = 195 + Top = 322 end end diff --git a/A00标签打印/U_ClientPrintRmf.pas b/A00标签打印/U_ClientPrintRmf.pas index d588af9..de365a7 100644 --- a/A00标签打印/U_ClientPrintRmf.pas +++ b/A00标签打印/U_ClientPrintRmf.pas @@ -52,12 +52,9 @@ type FparamBlclid: string; procedure PrintReport(); procedure ExportReport(); - procedure InitAdo(Ado: TADOQuery; Cds: TClientDataSet; SqlStr: string); - function GetQrCode(Txt: string): string; + procedure GetPrtData(Ado: TADOQuery; Cds: TClientDataSet; SqlStr: string); procedure InitArgs(); - function EnsureQrCodeDirectory: Boolean; - function ClearQrCodeDirectory: Boolean; - procedure IintCDS(SADOQry: TADOQuery; mClientDataset: TclientDataSet); + { Private declarations } public FPrintJson: PChar; @@ -68,17 +65,13 @@ type { Public declarations } end; - TMakebar = procedure(ucData: pchar; nDataLen: integer; nErrLevel: integer; nMask: integer; nBarEdition: integer; szBmpFileName: pchar; nScale: integer); stdcall; - - TMixtext = procedure(szSrcBmpFileName: PChar; szDstBmpFileName: PChar; sztext: PChar; fontsize, txtheight, hmargin, vmargin, txtcntoneline: integer); stdcall; - var frmClientPrintRmf: TfrmClientPrintRmf; implementation uses - U_RTFun, superobject; + U_RTFun, superobject, U_QrCodeFun; {$R *.dfm} constructor TfrmClientPrintRmf.Create(AOwner: TComponent; JsonArgs: PChar); @@ -88,165 +81,6 @@ begin end; // άĿ¼ڣ -function TfrmClientPrintRmf.EnsureQrCodeDirectory: Boolean; -var - QrCodeDir: string; -begin - Result := False; - QrCodeDir := ExtractFilePath(Application.ExeName) + 'QrCode\'; - - try - if not DirectoryExists(QrCodeDir) then - begin - if not ForceDirectories(QrCodeDir) then - raise Exception.Create('޷άĿ¼: ' + QrCodeDir); - end; - Result := True; - except - on E: Exception do - begin - Application.MessageBox(PChar('άĿ¼ʧ: ' + E.Message), '', MB_ICONERROR); - end; - end; -end; - -// նάĿ¼еļ -function TfrmClientPrintRmf.ClearQrCodeDirectory: Boolean; -var - QrCodeDir: string; - SearchRec: TSearchRec; -begin - Result := False; - QrCodeDir := ExtractFilePath(Application.ExeName) + 'QrCode\'; - - try - if not DirectoryExists(QrCodeDir) then - Exit; // Ŀ¼Ϊɹ - // ɾĿ¼.bmpļ - if FindFirst(QrCodeDir + '*.bmp', faAnyFile, SearchRec) = 0 then - begin - repeat - DeleteFile(QrCodeDir + SearchRec.Name); - until FindNext(SearchRec) <> 0; - FindClose(SearchRec); - end; - - Result := True; - except - on E: Exception do - begin - Application.MessageBox(PChar('նάĿ¼ʧ: ' + E.Message), '', MB_ICONERROR); - end; - end; -end; - -procedure TfrmClientPrintRmf.IintCDS(SADOQry: TADOQuery; mClientDataset: TclientDataSet); -var - i, k: integer; - mfieldName: string; - mSize: integer; -begin - mfieldName := ''; - mClientDataset.FieldDefs.Clear; - with SADOQry do - begin - for i := 0 to fieldCount - 1 do - begin - if (Fields[i].DataType = ftString) and (Fields[i].Size = 0) then - begin - mSize := 1; - end - else - mSize := Fields[i].Size; - mfieldName := trim(fields[i].FieldName); - mClientDataset.FieldDefs.Add(mfieldName, Fields[i].DataType, mSize); - - end; - end; - mClientDataset.FieldDefs.Add('QRBARCODE', ftString, 200); - mClientDataset.Close; - mClientDataset.CreateDataSet; - - if SADOQry.IsEmpty then - exit; - - SADOQry.first; - k := 1; - try - mClientDataset.DisableControls; - mClientDataset.Filtered := false; - - while not SADOQry.Eof do - begin - with mClientDataset do - begin - Append; - for i := 0 to SADOQry.FieldCount - 1 do - begin - fields[i].value := SADOQry.Fields[i].Value; - end; - - fieldByName('QRBARCODE').value := ''; - inc(k); - Post; - end; - SADOQry.Next; - end; - if not mClientDataset.IsEmpty then - begin - mClientDataset.First; - end; - finally - mClientDataset.EnableControls; - end; - -end; - -function TfrmClientPrintRmf.GetQrCode(Txt: string): string; -var - fPrintFile: string; - fImagePath: string; - Moudle: THandle; - Makebar: TMakebar; - Mixtext: TMixtext; - CurRow: Integer; - TimeStamp: string; -begin - Result := ''; // ʼ· - - try - Moudle := LoadLibrary('MakeQRBarcode.dll'); - if Moudle = 0 then - RaiseLastOSError; - - @Makebar := GetProcAddress(Moudle, 'Make'); - if not Assigned(Makebar) then - raise Exception.Create('Ҳ Make '); - - @Mixtext := GetProcAddress(Moudle, 'MixText'); - if not Assigned(Mixtext) then - raise Exception.Create('Ҳ MixText '); - - // ʱļ (ʽ: YYYYMMDD_HHMMSSZZZ) - Sleep(10); - TimeStamp := FormatDateTime('yyyymmdd_hhnnsszzz', Now) + '_' + IntToStr(Random(1000)); - fImagePath := ExtractFilePath(Application.ExeName) + 'QrCode\' + TimeStamp + '.bmp'; - - // ȷĿ¼ - if not DirectoryExists(ExtractFilePath(fImagePath)) then - ForceDirectories(ExtractFilePath(fImagePath)); - - Makebar(pchar(Txt), Length(Txt), 3, 3, 0, PChar(fImagePath), 3); - - Result := fImagePath; // ɵļ· - except - on E: Exception do - begin - application.MessageBox(PChar('ʧܣ' + E.Message), '', MB_ICONERROR); - end; - end; -end; - procedure TfrmClientPrintRmf.InitArgs; var JSONObject, item: ISuperObject; @@ -320,9 +154,8 @@ begin // RM1.PreviewButtons := [rmpbZoom, rmpbLoad, rmpbSave, rmpbFind, rmpbPageSetup, rmpbExit, rmpbSaveToXLS, rmpbExport, rmpbNavigator]; end; -procedure TfrmClientPrintRmf.InitAdo(Ado: TADOQuery; Cds: TClientDataSet; SqlStr: string); -var - QrCodeIdField: TField; +procedure TfrmClientPrintRmf.GetPrtData(Ado: TADOQuery; Cds: TClientDataSet; SqlStr: string); + begin if Trim(SqlStr) = '' then Exit; @@ -333,36 +166,12 @@ begin Close; SQL.Clear; SQL.Add(SqlStr); + if IsDebug then + ShowMessage(sql.Text); Open; end; IintCDS(Ado, Cds); - - // ǷڶάIDֶ - if Trim(FQrCodeField) = '' then - Exit; - - QrCodeIdField := Cds.FindField(FQrCodeField); - if QrCodeIdField = nil then - Exit; - - // ɶά벢󶨵ClientDataSet - with Cds do - begin - DisableControls; - try - First; - while not Eof do - begin - Edit; - FieldByName('QRBARCODE').AsString := GetQrCode(QrCodeIdField.AsString); - Post; - Next; - end; - finally - First; - EnableControls; - end; - end; + SetQrCodePath(Cds, FQrCodeField); end; procedure TfrmClientPrintRmf.ExportReport(); @@ -458,11 +267,11 @@ begin exit; end; - InitAdo(ADO_Prt, CDS_1, SqlStr1); - InitAdo(ADO_Prt, CDS_2, SqlStr2); - InitAdo(ADO_Prt, CDS_3, SqlStr3); - InitAdo(ADO_Prt, CDS_4, SqlStr4); - InitAdo(ADO_Prt, CDS_5, SqlStr5); + GetPrtData(ADO_Prt, CDS_1, SqlStr1); + GetPrtData(ADO_Prt, CDS_2, SqlStr2); + GetPrtData(ADO_Prt, CDS_3, SqlStr3); + GetPrtData(ADO_Prt, CDS_4, SqlStr4); + GetPrtData(ADO_Prt, CDS_5, SqlStr5); if FExportFileType = '' then begin diff --git a/A00标签打印/U_LabelPrint.dfm b/A00标签打印/U_LabelPrint.dfm index 9d62c47..35c8941 100644 --- a/A00标签打印/U_LabelPrint.dfm +++ b/A00标签打印/U_LabelPrint.dfm @@ -2,7 +2,7 @@ object frmLabelPrint: TfrmLabelPrint Left = 880 Top = 409 Width = 277 - Height = 181 + Height = 178 Caption = #25253#34920#25171#21360 Color = clBtnFace Font.Charset = DEFAULT_CHARSET @@ -22,7 +22,7 @@ object frmLabelPrint: TfrmLabelPrint Left = 0 Top = 0 Width = 269 - Height = 150 + Height = 147 Align = alClient BevelInner = bvRaised BevelOuter = bvLowered @@ -164,20 +164,20 @@ object frmLabelPrint: TfrmLabelPrint Connection = ADOConnection1 LockType = ltReadOnly Parameters = <> - Left = 631 - Top = 258 + Left = 549 + Top = 205 end object ADOConnection1: TADOConnection LoginPrompt = False - Left = 467 - Top = 258 + Left = 385 + Top = 205 end object ImageList1: TImageList DrawingStyle = dsTransparent Height = 32 Width = 32 Left = 467 - Top = 382 + Top = 329 Bitmap = { 494C010119002400040020002000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 000000000000360000002800000080000000E0000000010020000000000000C0 @@ -3884,9 +3884,9 @@ object frmLabelPrint: TfrmLabelPrint end object RMDB_1: TRMDBDataSet Visible = True - DataSet = ADO_1 + DataSet = CDS_1 Left = 631 - Top = 382 + Top = 329 end object RM1: TRMGridReport ThreadPrepareReport = True @@ -3906,47 +3906,33 @@ object frmLabelPrint: TfrmLabelPrint LaterBuildEvents = True OnlyOwnerDataSet = False Left = 631 - Top = 444 + Top = 391 ReportData = {} end object RMDB_2: TRMDBDataSet Visible = True - DataSet = ADO_2 + DataSet = CDS_2 Left = 713 - Top = 382 + Top = 329 end object CDS_Label: TClientDataSet Aggregates = <> Params = <> - Left = 795 - Top = 320 + Left = 385 + Top = 329 end - object ADO_1: TADOQuery + object ADO_Prt: TADOQuery Connection = ADOConnection1 LockType = ltReadOnly Parameters = <> - Left = 713 - Top = 258 - end - object ADO_2: TADOQuery - Connection = ADOConnection1 - LockType = ltReadOnly - Parameters = <> - Left = 795 - Top = 258 + Left = 631 + Top = 205 end object RMDB_3: TRMDBDataSet Visible = True - DataSet = ADO_3 - Left = 795 - Top = 382 - end - object ADO_3: TADOQuery - Connection = ADOConnection1 - LockType = ltReadOnly - Parameters = <> - Left = 467 - Top = 320 + DataSet = CDS_3 + Left = 385 + Top = 391 end object RMXLSExport1: TRMXLSExport ShowAfterExport = True @@ -3959,55 +3945,71 @@ object frmLabelPrint: TfrmLabelPrint ScaleX = 1.000000000000000000 ScaleY = 1.000000000000000000 CompressFile = False - Left = 467 - Top = 506 + Left = 385 + Top = 453 end object RMJPEGExport1: TRMJPEGExport ScaleX = 1.000000000000000000 ScaleY = 1.000000000000000000 Left = 713 - Top = 444 + Top = 391 end object RMBarCodeObject1: TRMBarCodeObject Left = 549 - Top = 382 + Top = 329 end object ADOQueryCmd: TADOQuery Connection = ADOConnection1 Parameters = <> - Left = 549 - Top = 258 + Left = 467 + Top = 205 end object ADO_While: TADOQuery LockType = ltReadOnly Parameters = <> Left = 713 - Top = 320 - end - object ADO_4: TADOQuery - Connection = ADOConnection1 - LockType = ltReadOnly - Parameters = <> - Left = 549 - Top = 320 + Top = 205 end object RMDB_4: TRMDBDataSet Visible = True - DataSet = ADO_4 + DataSet = CDS_4 Left = 467 - Top = 444 - end - object ADO_5: TADOQuery - Connection = ADOConnection1 - LockType = ltReadOnly - Parameters = <> - Left = 631 - Top = 320 + Top = 391 end object RMDB_5: TRMDBDataSet Visible = True - DataSet = ADO_5 + DataSet = CDS_5 Left = 549 - Top = 444 + Top = 391 + end + object CDS_1: TClientDataSet + Aggregates = <> + Params = <> + Left = 385 + Top = 267 + end + object CDS_2: TClientDataSet + Aggregates = <> + Params = <> + Left = 467 + Top = 267 + end + object CDS_3: TClientDataSet + Aggregates = <> + Params = <> + Left = 549 + Top = 267 + end + object CDS_4: TClientDataSet + Aggregates = <> + Params = <> + Left = 631 + Top = 267 + end + object CDS_5: TClientDataSet + Aggregates = <> + Params = <> + Left = 713 + Top = 267 end end diff --git a/A00标签打印/U_LabelPrint.pas b/A00标签打印/U_LabelPrint.pas index c1c88d7..23970e8 100644 --- a/A00标签打印/U_LabelPrint.pas +++ b/A00标签打印/U_LabelPrint.pas @@ -36,11 +36,9 @@ type RM1: TRMGridReport; RMDB_2: TRMDBDataSet; CDS_Label: TClientDataSet; - ADO_1: TADOQuery; + ADO_Prt: TADOQuery; btnShow: TSpeedButton; - ADO_2: TADOQuery; RMDB_3: TRMDBDataSet; - ADO_3: TADOQuery; RMXLSExport1: TRMXLSExport; RMJPEGExport1: TRMJPEGExport; RMBarCodeObject1: TRMBarCodeObject; @@ -53,10 +51,13 @@ type ComboBox1: TcxComboBox; ComboBox_Print: TcxComboBox; btnPrint: TSpeedButton; - ADO_4: TADOQuery; RMDB_4: TRMDBDataSet; - ADO_5: TADOQuery; RMDB_5: TRMDBDataSet; + CDS_1: TClientDataSet; + CDS_2: TClientDataSet; + CDS_3: TClientDataSet; + CDS_4: TClientDataSet; + CDS_5: TClientDataSet; procedure FormCreate(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure FormShow(Sender: TObject); @@ -67,13 +68,13 @@ type procedure cbbLabPropertiesButtonClick(Sender: TObject); private IsDebug, FPreviewPrint, IsSql1, IsSql2, IsSql3, IsSql4, IsSql5: Boolean; - FLMType: string; + FLMType, FQrCodeField: string; FFiltration1, FFiltration2, FFiltration3, FFiltration4, FFiltration5: string; FSuccessfulFun: string; FparamBlclid: string; procedure InitGrid(); procedure PrintLabel(MIsShow: Boolean); - procedure InitAdo(Ado: TADOQuery; IsSql: Boolean; LMSql, FFiltration: string); + procedure GetPrtData(Ado: TADOQuery; Cds: TClientDataSet; IsSql: Boolean; LMSql, FFiltration: string); procedure InitArgs(); { Private declarations } public @@ -90,7 +91,7 @@ var implementation uses - U_RTFun, U_LabelMapSet, superobject; + U_RTFun, U_LabelMapSet, superobject, U_QrCodeFun; {$R *.dfm} constructor TfrmLabelPrint.Create(AOwner: TComponent; JsonArgs: PChar); @@ -127,7 +128,7 @@ begin FSuccessfulFun := JSONObject.S['SuccessfulFun']; FLMType := JSONObject.S['LMType']; FPreviewPrint := JSONObject.B['PreviewPrint']; - + FQrCodeField := JSONObject.S['QrCodeField']; DConString := JSONObject.S['DConString']; DCode := JSONObject.S['DCode']; DName := JSONObject.S['DName']; @@ -208,7 +209,7 @@ begin end; end; -procedure TfrmLabelPrint.InitAdo(Ado: TADOQuery; IsSql: Boolean; LMSql, FFiltration: string); +procedure TfrmLabelPrint.GetPrtData(Ado: TADOQuery; Cds: TClientDataSet; IsSql: Boolean; LMSql, FFiltration: string); begin with Ado do begin @@ -227,6 +228,9 @@ begin ShowMessage(sql.Text); Open; end; + + IintCDS(Ado, Cds); + SetQrCodePath(Cds, FQrCodeField); end; procedure TfrmLabelPrint.PrintLabel(MIsShow: Boolean); @@ -248,19 +252,19 @@ begin if CDS_Label.Locate('LMName', LBName, []) then begin if trim(CDS_Label.fieldbyname('LMSql1').AsString) <> '' then - InitAdo(ADO_1, IsSql1, 'LMSql1', FFiltration1); + GetPrtData(ADO_Prt, CDS_1, IsSql1, 'LMSql1', FFiltration1); if trim(CDS_Label.fieldbyname('LMSql2').AsString) <> '' then - InitAdo(ADO_2, IsSql2, 'LMSql2', FFiltration2); + GetPrtData(ADO_Prt, CDS_2, IsSql2, 'LMSql2', FFiltration2); if trim(CDS_Label.fieldbyname('LMSql3').AsString) <> '' then - InitAdo(ADO_3, IsSql3, 'LMSql3', FFiltration3); + GetPrtData(ADO_Prt, CDS_3, IsSql3, 'LMSql3', FFiltration3); if trim(CDS_Label.fieldbyname('LMSql4').AsString) <> '' then - InitAdo(ADO_4, IsSql4, 'LMSql4', FFiltration4); + GetPrtData(ADO_Prt, CDS_4, IsSql4, 'LMSql4', FFiltration4); if trim(CDS_Label.fieldbyname('LMSql5').AsString) <> '' then - InitAdo(ADO_5, IsSql5, 'LMSql5', FFiltration5); + GetPrtData(ADO_Prt, CDS_5, IsSql5, 'LMSql5', FFiltration5); end; fPrintFile := ExtractFilePath(Application.ExeName) + 'Report\' + LBName + '.rmf'; @@ -292,7 +296,8 @@ begin ConnectionString := DConString; Connected := true; end; - + EnsureQrCodeDirectory(); + ClearQrCodeDirectory(); end; procedure TfrmLabelPrint.btnPrintClick(Sender: TObject); diff --git a/A00标签打印/U_LabelPrintFun.pas b/A00标签打印/U_LabelPrintFun.pas index f83b77a..23b70dc 100644 --- a/A00标签打印/U_LabelPrintFun.pas +++ b/A00标签打印/U_LabelPrintFun.pas @@ -17,8 +17,6 @@ function FormPrint(App: Tapplication; JsonArgs: PChar): PChar; begin with TfrmLabelPrint.Create(App, PChar(JsonArgs)) do begin - - if ShowModal = 1 then Result := FJsonOut else diff --git a/A00标签打印/U_QrCodeFun.pas b/A00标签打印/U_QrCodeFun.pas new file mode 100644 index 0000000..17d5abc --- /dev/null +++ b/A00标签打印/U_QrCodeFun.pas @@ -0,0 +1,219 @@ +unit U_QrCodeFun; + +interface + +uses + Windows, SysUtils, DB, Controls, Forms, DBClient, ADODB, ExtCtrls, + RM_GridReport, RM_Dataset, RM_E_llPDF, RM_BarCode, RM_e_Graphic, RM_e_Jpeg, + RM_e_Xls, RM_System; + +type + TMakebar = procedure(ucData: pchar; nDataLen: integer; nErrLevel: integer; nMask: integer; nBarEdition: integer; szBmpFileName: pchar; nScale: integer); stdcall; + + TMixtext = procedure(szSrcBmpFileName: PChar; szDstBmpFileName: PChar; sztext: PChar; fontsize, txtheight, hmargin, vmargin, txtcntoneline: integer); stdcall; + +function EnsureQrCodeDirectory: Boolean; + +function ClearQrCodeDirectory: Boolean; + +procedure IintCDS(SADOQry: TADOQuery; mClientDataset: TclientDataSet); + +function GetQrCode(Txt: string): string; + +procedure SetQrCodePath(Cds: TclientDataSet; FQrCodeField: string); + +implementation + +procedure SetQrCodePath(Cds: TclientDataSet; FQrCodeField: string); +var + QrCodeIdField: TField; +begin + // ǷڶάIDֶ + if Trim(FQrCodeField) = '' then + Exit; + + QrCodeIdField := Cds.FindField(FQrCodeField); + if QrCodeIdField = nil then + Exit; + + // ɶά벢󶨵ClientDataSet + with Cds do + begin + DisableControls; + try + First; + while not Eof do + begin + Edit; + FieldByName('QRBARCODE').AsString := GetQrCode(QrCodeIdField.AsString); + Post; + Next; + end; + finally + First; + EnableControls; + end; + end; +end; + +function EnsureQrCodeDirectory: Boolean; +var + QrCodeDir: string; +begin + Result := False; + QrCodeDir := ExtractFilePath(Application.ExeName) + 'QrCode\'; + + try + if not DirectoryExists(QrCodeDir) then + begin + if not ForceDirectories(QrCodeDir) then + raise Exception.Create('޷άĿ¼: ' + QrCodeDir); + end; + Result := True; + except + on E: Exception do + begin + Application.MessageBox(PChar('άĿ¼ʧ: ' + E.Message), '', MB_ICONERROR); + end; + end; +end; + +// նάĿ¼еļ +function ClearQrCodeDirectory: Boolean; +var + QrCodeDir: string; + SearchRec: TSearchRec; +begin + Result := False; + QrCodeDir := ExtractFilePath(Application.ExeName) + 'QrCode\'; + + try + if not DirectoryExists(QrCodeDir) then + Exit; // Ŀ¼Ϊɹ + // ɾĿ¼.bmpļ + if FindFirst(QrCodeDir + '*.bmp', faAnyFile, SearchRec) = 0 then + begin + repeat + DeleteFile(QrCodeDir + SearchRec.Name); + until FindNext(SearchRec) <> 0; + FindClose(SearchRec); + end; + + Result := True; + except + on E: Exception do + begin + Application.MessageBox(PChar('նάĿ¼ʧ: ' + E.Message), '', MB_ICONERROR); + end; + end; +end; + +procedure IintCDS(SADOQry: TADOQuery; mClientDataset: TclientDataSet); +var + i, k: integer; + mfieldName: string; + mSize: integer; +begin + mfieldName := ''; + mClientDataset.FieldDefs.Clear; + with SADOQry do + begin + for i := 0 to fieldCount - 1 do + begin + if (Fields[i].DataType = ftString) and (Fields[i].Size = 0) then + begin + mSize := 1; + end + else + mSize := Fields[i].Size; + mfieldName := trim(fields[i].FieldName); + mClientDataset.FieldDefs.Add(mfieldName, Fields[i].DataType, mSize); + + end; + end; + mClientDataset.FieldDefs.Add('QRBARCODE', ftString, 200); + mClientDataset.Close; + mClientDataset.CreateDataSet; + + if SADOQry.IsEmpty then + exit; + + SADOQry.first; + k := 1; + try + mClientDataset.DisableControls; + mClientDataset.Filtered := false; + + while not SADOQry.Eof do + begin + with mClientDataset do + begin + Append; + for i := 0 to SADOQry.FieldCount - 1 do + begin + fields[i].value := SADOQry.Fields[i].Value; + end; + + fieldByName('QRBARCODE').value := ''; + inc(k); + Post; + end; + SADOQry.Next; + end; + if not mClientDataset.IsEmpty then + begin + mClientDataset.First; + end; + finally + mClientDataset.EnableControls; + end; + +end; + +function GetQrCode(Txt: string): string; +var + fPrintFile: string; + fImagePath: string; + Moudle: THandle; + Makebar: TMakebar; + Mixtext: TMixtext; + CurRow: Integer; + TimeStamp: string; +begin + Result := ''; // ʼ· + + try + Moudle := LoadLibrary('MakeQRBarcode.dll'); + if Moudle = 0 then + RaiseLastOSError; + + @Makebar := GetProcAddress(Moudle, 'Make'); + if not Assigned(Makebar) then + raise Exception.Create('Ҳ Make '); + + @Mixtext := GetProcAddress(Moudle, 'MixText'); + if not Assigned(Mixtext) then + raise Exception.Create('Ҳ MixText '); + + // ʱļ (ʽ: YYYYMMDD_HHMMSSZZZ) + Sleep(10); + TimeStamp := FormatDateTime('yyyymmdd_hhnnsszzz', Now) + '_' + IntToStr(Random(1000)); + fImagePath := ExtractFilePath(Application.ExeName) + 'QrCode\' + TimeStamp + '.bmp'; + + // ȷĿ¼ + if not DirectoryExists(ExtractFilePath(fImagePath)) then + ForceDirectories(ExtractFilePath(fImagePath)); + + Makebar(pchar(Txt), Length(Txt), 3, 3, 0, PChar(fImagePath), 3); + + Result := fImagePath; // ɵļ· + except + on E: Exception do + begin + application.MessageBox(PChar('ʧܣ' + E.Message), '', MB_ICONERROR); + end; + end; +end; + +end. + diff --git a/云翔一码通/U_YMTRKInPut.dfm b/云翔一码通/U_YMTRKInPut.dfm index 4fada7d..c238add 100644 --- a/云翔一码通/U_YMTRKInPut.dfm +++ b/云翔一码通/U_YMTRKInPut.dfm @@ -1,6 +1,6 @@ object frmYMTRKInPut: TfrmYMTRKInPut - Left = 513 - Top = 336 + Left = 309 + Top = 236 Width = 1829 Height = 623 Align = alClient @@ -111,7 +111,6 @@ object frmYMTRKInPut: TfrmYMTRKInPut Caption = #39068#33394 DataBinding.FieldName = 'SPColor' HeaderAlignmentHorz = taCenter - Options.Editing = False Width = 69 end object v1Column17: TcxGridDBColumn diff --git a/云翔一码通/U_YMTRKList.pas b/云翔一码通/U_YMTRKList.pas index cd24055..f33787d 100644 --- a/云翔一码通/U_YMTRKList.pas +++ b/云翔一码通/U_YMTRKList.pas @@ -455,7 +455,7 @@ begin if CDS_Main.IsEmpty then Exit; MFiltration := Trim(CDS_Main.fieldbyname('SPID').AsString); - FPrintJson := '{ "LMType": "LMType","PreviewPrint": true,"DConString": "' + DConString + '","DCode": "' + DCode + '","DName": "' + DName + '", "PrtArgs": [ { "IsSql": true, "Filtration": " ' + MFiltration + '" }] }'; + FPrintJson := '{ "LMType": "LMType","QrCodeField": "MXID","PreviewPrint": true,"DConString": "' + DConString + '","DCode": "' + DCode + '","DName": "' + DName + '", "PrtArgs": [ { "IsSql": true, "Filtration": " ' + MFiltration + '" }] }'; FormPrint(Application, PChar(FPrintJson)); end; diff --git a/云翔一码通/YXYMT.dpr b/云翔一码通/YXYMT.dpr index 4058dc0..84a51f1 100644 --- a/云翔一码通/YXYMT.dpr +++ b/云翔一码通/YXYMT.dpr @@ -23,7 +23,8 @@ uses U_ClientPrintRmf in '..\A00ǩӡ\U_ClientPrintRmf.pas' {frmClientPrintRmf}, U_LabelMapSet in '..\A00ǩӡ\U_LabelMapSet.pas' {frmLabelMapSet}, U_LabelPrint in '..\A00ǩӡ\U_LabelPrint.pas' {frmLabelPrint}, - U_LabelPrintFun in '..\A00ǩӡ\U_LabelPrintFun.pas'; + U_LabelPrintFun in '..\A00ǩӡ\U_LabelPrintFun.pas', + U_QrCodeFun in '..\A00ǩӡ\U_QrCodeFun.pas'; {$R *.res}