Group_99/D7myYunxiang
7
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

打印窗体添加二维码

Browse Source
This commit is contained in:
DESKTOP-E401PHE\Administrator 2025-08-30 14:29:28 +08:00
parent a44aa2e3e5
commit f4818e3a29
9 changed files with 363 additions and 330 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

88
A00标签打印/U_ClientPrintRmf.dfm
View File

@ -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

217
A00标签打印/U_ClientPrintRmf.pas
View File

@ -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

120
A00标签打印/U_LabelPrint.dfm
View File

@ -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

37
A00标签打印/U_LabelPrint.pas
View File

@ -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);

2
A00标签打印/U_LabelPrintFun.pas
View File

@ -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

219
A00标签打印/U_QrCodeFun.pas Normal file
View File

@ -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.

5
云翔一码通/U_YMTRKInPut.dfm
View File

@ -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

2
云翔一码通/U_YMTRKList.pas
View File

@ -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;

3
云翔一码通/YXYMT.dpr
View File

@ -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}