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 Connection = ADOConnection1
LockType = ltReadOnly LockType = ltReadOnly
Parameters = <> Parameters = <>
Left = 273 Left = 441
Top = 12 Top = 198
end end
object ADOConnection1: TADOConnection object ADOConnection1: TADOConnection
LoginPrompt = False LoginPrompt = False
Left = 27 Left = 195
Top = 12 Top = 198
end end
object ImageList1: TImageList object ImageList1: TImageList
DrawingStyle = dsTransparent DrawingStyle = dsTransparent
Height = 32 Height = 32
Width = 32 Width = 32
Left = 109 Left = 359
Top = 136 Top = 322
Bitmap = { Bitmap = {
494C010119002400040020002000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 494C010119002400040020002000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
000000000000360000002800000080000000E0000000010020000000000000C0 000000000000360000002800000080000000E0000000010020000000000000C0
@ -3743,8 +3743,8 @@ object frmClientPrintRmf: TfrmClientPrintRmf
object RMDB_1: TRMDBDataSet object RMDB_1: TRMDBDataSet
Visible = True Visible = True
DataSet = CDS_1 DataSet = CDS_1
Left = 273 Left = 523
Top = 136 Top = 322
end end
object RM1: TRMGridReport object RM1: TRMGridReport
ThreadPrepareReport = True ThreadPrepareReport = True
@ -3763,34 +3763,34 @@ object frmClientPrintRmf: TfrmClientPrintRmf
CompressThread = False CompressThread = False
LaterBuildEvents = True LaterBuildEvents = True
OnlyOwnerDataSet = False OnlyOwnerDataSet = False
Left = 273 Left = 523
Top = 198 Top = 384
ReportData = {} ReportData = {}
end end
object RMDB_2: TRMDBDataSet object RMDB_2: TRMDBDataSet
Visible = True Visible = True
DataSet = CDS_2 DataSet = CDS_2
Left = 355 Left = 195
Top = 136 Top = 384
end end
object CDS_Label: TClientDataSet object CDS_Label: TClientDataSet
Aggregates = <> Aggregates = <>
Params = <> Params = <>
Left = 27 Left = 277
Top = 136 Top = 322
end end
object ADO_Prt: TADOQuery object ADO_Prt: TADOQuery
Connection = ADOConnection1 Connection = ADOConnection1
LockType = ltReadOnly LockType = ltReadOnly
Parameters = <> Parameters = <>
Left = 355 Left = 523
Top = 12 Top = 198
end end
object RMDB_3: TRMDBDataSet object RMDB_3: TRMDBDataSet
Visible = True Visible = True
DataSet = CDS_3 DataSet = CDS_3
Left = 27 Left = 277
Top = 198 Top = 384
end end
object RMXLSExport1: TRMXLSExport object RMXLSExport1: TRMXLSExport
ShowAfterExport = True ShowAfterExport = True
@ -3803,78 +3803,78 @@ object frmClientPrintRmf: TfrmClientPrintRmf
ScaleX = 1.000000000000000000 ScaleX = 1.000000000000000000
ScaleY = 1.000000000000000000 ScaleY = 1.000000000000000000
CompressFile = False CompressFile = False
Left = 27 Left = 277
Top = 260 Top = 446
end end
object RMJPEGExport1: TRMJPEGExport object RMJPEGExport1: TRMJPEGExport
ScaleX = 1.000000000000000000 ScaleX = 1.000000000000000000
ScaleY = 1.000000000000000000 ScaleY = 1.000000000000000000
Left = 355 Left = 195
Top = 198 Top = 446
end end
object RMBarCodeObject1: TRMBarCodeObject object RMBarCodeObject1: TRMBarCodeObject
Left = 191 Left = 441
Top = 136 Top = 322
end end
object ADOQueryCmd: TADOQuery object ADOQueryCmd: TADOQuery
Connection = ADOConnection1 Connection = ADOConnection1
Parameters = <> Parameters = <>
Left = 109 Left = 277
Top = 12 Top = 198
end end
object ADO_While: TADOQuery object ADO_While: TADOQuery
Connection = ADOConnection1 Connection = ADOConnection1
LockType = ltReadOnly LockType = ltReadOnly
Parameters = <> Parameters = <>
Left = 355 Left = 195
Top = 74 Top = 260
end end
object RMDB_4: TRMDBDataSet object RMDB_4: TRMDBDataSet
Visible = True Visible = True
DataSet = CDS_4 DataSet = CDS_4
Left = 109 Left = 359
Top = 198 Top = 384
end end
object RMDB_5: TRMDBDataSet object RMDB_5: TRMDBDataSet
Visible = True Visible = True
DataSet = CDS_5 DataSet = CDS_5
Left = 191 Left = 441
Top = 198 Top = 384
end end
object ADOQueryReport: TADOQuery object ADOQueryReport: TADOQuery
Connection = ADOConnection1 Connection = ADOConnection1
Parameters = <> Parameters = <>
Left = 191 Left = 359
Top = 12 Top = 198
end end
object CDS_1: TClientDataSet object CDS_1: TClientDataSet
Aggregates = <> Aggregates = <>
Params = <> Params = <>
Left = 123 Left = 277
Top = 288 Top = 260
end end
object CDS_2: TClientDataSet object CDS_2: TClientDataSet
Aggregates = <> Aggregates = <>
Params = <> Params = <>
Left = 259 Left = 359
Top = 304 Top = 260
end end
object CDS_3: TClientDataSet object CDS_3: TClientDataSet
Aggregates = <> Aggregates = <>
Params = <> Params = <>
Left = 203 Left = 441
Top = 360 Top = 260
end end
object CDS_4: TClientDataSet object CDS_4: TClientDataSet
Aggregates = <> Aggregates = <>
Params = <> Params = <>
Left = 331 Left = 523
Top = 376 Top = 260
end end
object CDS_5: TClientDataSet object CDS_5: TClientDataSet
Aggregates = <> Aggregates = <>
Params = <> Params = <>
Left = 411 Left = 195
Top = 376 Top = 322
end end
end end

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

@ -52,12 +52,9 @@ type
FparamBlclid: string; FparamBlclid: string;
procedure PrintReport(); procedure PrintReport();
procedure ExportReport(); procedure ExportReport();
procedure InitAdo(Ado: TADOQuery; Cds: TClientDataSet; SqlStr: string); procedure GetPrtData(Ado: TADOQuery; Cds: TClientDataSet; SqlStr: string);
function GetQrCode(Txt: string): string;
procedure InitArgs(); procedure InitArgs();
function EnsureQrCodeDirectory: Boolean;
function ClearQrCodeDirectory: Boolean;
procedure IintCDS(SADOQry: TADOQuery; mClientDataset: TclientDataSet);
{ Private declarations } { Private declarations }
public public
FPrintJson: PChar; FPrintJson: PChar;
@ -68,17 +65,13 @@ type
{ Public declarations } { Public declarations }
end; 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 var
frmClientPrintRmf: TfrmClientPrintRmf; frmClientPrintRmf: TfrmClientPrintRmf;
implementation implementation
uses uses
U_RTFun, superobject; U_RTFun, superobject, U_QrCodeFun;
{$R *.dfm} {$R *.dfm}
constructor TfrmClientPrintRmf.Create(AOwner: TComponent; JsonArgs: PChar); constructor TfrmClientPrintRmf.Create(AOwner: TComponent; JsonArgs: PChar);
@ -88,165 +81,6 @@ begin
end; 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; procedure TfrmClientPrintRmf.InitArgs;
var var
JSONObject, item: ISuperObject; JSONObject, item: ISuperObject;
@ -320,9 +154,8 @@ begin
// RM1.PreviewButtons := [rmpbZoom, rmpbLoad, rmpbSave, rmpbFind, rmpbPageSetup, rmpbExit, rmpbSaveToXLS, rmpbExport, rmpbNavigator]; // RM1.PreviewButtons := [rmpbZoom, rmpbLoad, rmpbSave, rmpbFind, rmpbPageSetup, rmpbExit, rmpbSaveToXLS, rmpbExport, rmpbNavigator];
end; end;
procedure TfrmClientPrintRmf.InitAdo(Ado: TADOQuery; Cds: TClientDataSet; SqlStr: string); procedure TfrmClientPrintRmf.GetPrtData(Ado: TADOQuery; Cds: TClientDataSet; SqlStr: string);
var
QrCodeIdField: TField;
begin begin
if Trim(SqlStr) = '' then if Trim(SqlStr) = '' then
Exit; Exit;
@ -333,36 +166,12 @@ begin
Close; Close;
SQL.Clear; SQL.Clear;
SQL.Add(SqlStr); SQL.Add(SqlStr);
if IsDebug then
ShowMessage(sql.Text);
Open; Open;
end; end;
IintCDS(Ado, Cds); IintCDS(Ado, Cds);
SetQrCodePath(Cds, FQrCodeField);
// 检查是否存在二维码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; end;
procedure TfrmClientPrintRmf.ExportReport(); procedure TfrmClientPrintRmf.ExportReport();
@ -458,11 +267,11 @@ begin
exit; exit;
end; end;
InitAdo(ADO_Prt, CDS_1, SqlStr1); GetPrtData(ADO_Prt, CDS_1, SqlStr1);
InitAdo(ADO_Prt, CDS_2, SqlStr2); GetPrtData(ADO_Prt, CDS_2, SqlStr2);
InitAdo(ADO_Prt, CDS_3, SqlStr3); GetPrtData(ADO_Prt, CDS_3, SqlStr3);
InitAdo(ADO_Prt, CDS_4, SqlStr4); GetPrtData(ADO_Prt, CDS_4, SqlStr4);
InitAdo(ADO_Prt, CDS_5, SqlStr5); GetPrtData(ADO_Prt, CDS_5, SqlStr5);
if FExportFileType = '' then if FExportFileType = '' then
begin begin

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

@ -2,7 +2,7 @@ object frmLabelPrint: TfrmLabelPrint
Left = 880 Left = 880
Top = 409 Top = 409
Width = 277 Width = 277
Height = 181 Height = 178
Caption = #25253#34920#25171#21360 Caption = #25253#34920#25171#21360
Color = clBtnFace Color = clBtnFace
Font.Charset = DEFAULT_CHARSET Font.Charset = DEFAULT_CHARSET
@ -22,7 +22,7 @@ object frmLabelPrint: TfrmLabelPrint
Left = 0 Left = 0
Top = 0 Top = 0
Width = 269 Width = 269
Height = 150 Height = 147
Align = alClient Align = alClient
BevelInner = bvRaised BevelInner = bvRaised
BevelOuter = bvLowered BevelOuter = bvLowered
@ -164,20 +164,20 @@ object frmLabelPrint: TfrmLabelPrint
Connection = ADOConnection1 Connection = ADOConnection1
LockType = ltReadOnly LockType = ltReadOnly
Parameters = <> Parameters = <>
Left = 631 Left = 549
Top = 258 Top = 205
end end
object ADOConnection1: TADOConnection object ADOConnection1: TADOConnection
LoginPrompt = False LoginPrompt = False
Left = 467 Left = 385
Top = 258 Top = 205
end end
object ImageList1: TImageList object ImageList1: TImageList
DrawingStyle = dsTransparent DrawingStyle = dsTransparent
Height = 32 Height = 32
Width = 32 Width = 32
Left = 467 Left = 467
Top = 382 Top = 329
Bitmap = { Bitmap = {
494C010119002400040020002000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 494C010119002400040020002000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
000000000000360000002800000080000000E0000000010020000000000000C0 000000000000360000002800000080000000E0000000010020000000000000C0
@ -3884,9 +3884,9 @@ object frmLabelPrint: TfrmLabelPrint
end end
object RMDB_1: TRMDBDataSet object RMDB_1: TRMDBDataSet
Visible = True Visible = True
DataSet = ADO_1 DataSet = CDS_1
Left = 631 Left = 631
Top = 382 Top = 329
end end
object RM1: TRMGridReport object RM1: TRMGridReport
ThreadPrepareReport = True ThreadPrepareReport = True
@ -3906,47 +3906,33 @@ object frmLabelPrint: TfrmLabelPrint
LaterBuildEvents = True LaterBuildEvents = True
OnlyOwnerDataSet = False OnlyOwnerDataSet = False
Left = 631 Left = 631
Top = 444 Top = 391
ReportData = {} ReportData = {}
end end
object RMDB_2: TRMDBDataSet object RMDB_2: TRMDBDataSet
Visible = True Visible = True
DataSet = ADO_2 DataSet = CDS_2
Left = 713 Left = 713
Top = 382 Top = 329
end end
object CDS_Label: TClientDataSet object CDS_Label: TClientDataSet
Aggregates = <> Aggregates = <>
Params = <> Params = <>
Left = 795 Left = 385
Top = 320 Top = 329
end end
object ADO_1: TADOQuery object ADO_Prt: TADOQuery
Connection = ADOConnection1 Connection = ADOConnection1
LockType = ltReadOnly LockType = ltReadOnly
Parameters = <> Parameters = <>
Left = 713 Left = 631
Top = 258 Top = 205
end
object ADO_2: TADOQuery
Connection = ADOConnection1
LockType = ltReadOnly
Parameters = <>
Left = 795
Top = 258
end end
object RMDB_3: TRMDBDataSet object RMDB_3: TRMDBDataSet
Visible = True Visible = True
DataSet = ADO_3 DataSet = CDS_3
Left = 795 Left = 385
Top = 382 Top = 391
end
object ADO_3: TADOQuery
Connection = ADOConnection1
LockType = ltReadOnly
Parameters = <>
Left = 467
Top = 320
end end
object RMXLSExport1: TRMXLSExport object RMXLSExport1: TRMXLSExport
ShowAfterExport = True ShowAfterExport = True
@ -3959,55 +3945,71 @@ object frmLabelPrint: TfrmLabelPrint
ScaleX = 1.000000000000000000 ScaleX = 1.000000000000000000
ScaleY = 1.000000000000000000 ScaleY = 1.000000000000000000
CompressFile = False CompressFile = False
Left = 467 Left = 385
Top = 506 Top = 453
end end
object RMJPEGExport1: TRMJPEGExport object RMJPEGExport1: TRMJPEGExport
ScaleX = 1.000000000000000000 ScaleX = 1.000000000000000000
ScaleY = 1.000000000000000000 ScaleY = 1.000000000000000000
Left = 713 Left = 713
Top = 444 Top = 391
end end
object RMBarCodeObject1: TRMBarCodeObject object RMBarCodeObject1: TRMBarCodeObject
Left = 549 Left = 549
Top = 382 Top = 329
end end
object ADOQueryCmd: TADOQuery object ADOQueryCmd: TADOQuery
Connection = ADOConnection1 Connection = ADOConnection1
Parameters = <> Parameters = <>
Left = 549 Left = 467
Top = 258 Top = 205
end end
object ADO_While: TADOQuery object ADO_While: TADOQuery
LockType = ltReadOnly LockType = ltReadOnly
Parameters = <> Parameters = <>
Left = 713 Left = 713
Top = 320 Top = 205
end
object ADO_4: TADOQuery
Connection = ADOConnection1
LockType = ltReadOnly
Parameters = <>
Left = 549
Top = 320
end end
object RMDB_4: TRMDBDataSet object RMDB_4: TRMDBDataSet
Visible = True Visible = True
DataSet = ADO_4 DataSet = CDS_4
Left = 467 Left = 467
Top = 444 Top = 391
end
object ADO_5: TADOQuery
Connection = ADOConnection1
LockType = ltReadOnly
Parameters = <>
Left = 631
Top = 320
end end
object RMDB_5: TRMDBDataSet object RMDB_5: TRMDBDataSet
Visible = True Visible = True
DataSet = ADO_5 DataSet = CDS_5
Left = 549 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
end end

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

@ -36,11 +36,9 @@ type
RM1: TRMGridReport; RM1: TRMGridReport;
RMDB_2: TRMDBDataSet; RMDB_2: TRMDBDataSet;
CDS_Label: TClientDataSet; CDS_Label: TClientDataSet;
ADO_1: TADOQuery; ADO_Prt: TADOQuery;
btnShow: TSpeedButton; btnShow: TSpeedButton;
ADO_2: TADOQuery;
RMDB_3: TRMDBDataSet; RMDB_3: TRMDBDataSet;
ADO_3: TADOQuery;
RMXLSExport1: TRMXLSExport; RMXLSExport1: TRMXLSExport;
RMJPEGExport1: TRMJPEGExport; RMJPEGExport1: TRMJPEGExport;
RMBarCodeObject1: TRMBarCodeObject; RMBarCodeObject1: TRMBarCodeObject;
@ -53,10 +51,13 @@ type
ComboBox1: TcxComboBox; ComboBox1: TcxComboBox;
ComboBox_Print: TcxComboBox; ComboBox_Print: TcxComboBox;
btnPrint: TSpeedButton; btnPrint: TSpeedButton;
ADO_4: TADOQuery;
RMDB_4: TRMDBDataSet; RMDB_4: TRMDBDataSet;
ADO_5: TADOQuery;
RMDB_5: TRMDBDataSet; RMDB_5: TRMDBDataSet;
CDS_1: TClientDataSet;
CDS_2: TClientDataSet;
CDS_3: TClientDataSet;
CDS_4: TClientDataSet;
CDS_5: TClientDataSet;
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject); procedure FormShow(Sender: TObject);
@ -67,13 +68,13 @@ type
procedure cbbLabPropertiesButtonClick(Sender: TObject); procedure cbbLabPropertiesButtonClick(Sender: TObject);
private private
IsDebug, FPreviewPrint, IsSql1, IsSql2, IsSql3, IsSql4, IsSql5: Boolean; IsDebug, FPreviewPrint, IsSql1, IsSql2, IsSql3, IsSql4, IsSql5: Boolean;
FLMType: string; FLMType, FQrCodeField: string;
FFiltration1, FFiltration2, FFiltration3, FFiltration4, FFiltration5: string; FFiltration1, FFiltration2, FFiltration3, FFiltration4, FFiltration5: string;
FSuccessfulFun: string; FSuccessfulFun: string;
FparamBlclid: string; FparamBlclid: string;
procedure InitGrid(); procedure InitGrid();
procedure PrintLabel(MIsShow: Boolean); 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(); procedure InitArgs();
{ Private declarations } { Private declarations }
public public
@ -90,7 +91,7 @@ var
implementation implementation
uses uses
U_RTFun, U_LabelMapSet, superobject; U_RTFun, U_LabelMapSet, superobject, U_QrCodeFun;
{$R *.dfm} {$R *.dfm}
constructor TfrmLabelPrint.Create(AOwner: TComponent; JsonArgs: PChar); constructor TfrmLabelPrint.Create(AOwner: TComponent; JsonArgs: PChar);
@ -127,7 +128,7 @@ begin
FSuccessfulFun := JSONObject.S['SuccessfulFun']; FSuccessfulFun := JSONObject.S['SuccessfulFun'];
FLMType := JSONObject.S['LMType']; FLMType := JSONObject.S['LMType'];
FPreviewPrint := JSONObject.B['PreviewPrint']; FPreviewPrint := JSONObject.B['PreviewPrint'];
FQrCodeField := JSONObject.S['QrCodeField'];
DConString := JSONObject.S['DConString']; DConString := JSONObject.S['DConString'];
DCode := JSONObject.S['DCode']; DCode := JSONObject.S['DCode'];
DName := JSONObject.S['DName']; DName := JSONObject.S['DName'];
@ -208,7 +209,7 @@ begin
end; end;
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 begin
with Ado do with Ado do
begin begin
@ -227,6 +228,9 @@ begin
ShowMessage(sql.Text); ShowMessage(sql.Text);
Open; Open;
end; end;
IintCDS(Ado, Cds);
SetQrCodePath(Cds, FQrCodeField);
end; end;
procedure TfrmLabelPrint.PrintLabel(MIsShow: Boolean); procedure TfrmLabelPrint.PrintLabel(MIsShow: Boolean);
@ -248,19 +252,19 @@ begin
if CDS_Label.Locate('LMName', LBName, []) then if CDS_Label.Locate('LMName', LBName, []) then
begin begin
if trim(CDS_Label.fieldbyname('LMSql1').AsString) <> '' then 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 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 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 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 if trim(CDS_Label.fieldbyname('LMSql5').AsString) <> '' then
InitAdo(ADO_5, IsSql5, 'LMSql5', FFiltration5); GetPrtData(ADO_Prt, CDS_5, IsSql5, 'LMSql5', FFiltration5);
end; end;
fPrintFile := ExtractFilePath(Application.ExeName) + 'Report\' + LBName + '.rmf'; fPrintFile := ExtractFilePath(Application.ExeName) + 'Report\' + LBName + '.rmf';
@ -292,7 +296,8 @@ begin
ConnectionString := DConString; ConnectionString := DConString;
Connected := true; Connected := true;
end; end;
EnsureQrCodeDirectory();
ClearQrCodeDirectory();
end; end;
procedure TfrmLabelPrint.btnPrintClick(Sender: TObject); procedure TfrmLabelPrint.btnPrintClick(Sender: TObject);

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

@ -17,8 +17,6 @@ function FormPrint(App: Tapplication; JsonArgs: PChar): PChar;
begin begin
with TfrmLabelPrint.Create(App, PChar(JsonArgs)) do with TfrmLabelPrint.Create(App, PChar(JsonArgs)) do
begin begin
if ShowModal = 1 then if ShowModal = 1 then
Result := FJsonOut Result := FJsonOut
else 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 object frmYMTRKInPut: TfrmYMTRKInPut
Left = 513 Left = 309
Top = 336 Top = 236
Width = 1829 Width = 1829
Height = 623 Height = 623
Align = alClient Align = alClient
@ -111,7 +111,6 @@ object frmYMTRKInPut: TfrmYMTRKInPut
Caption = #39068#33394 Caption = #39068#33394
DataBinding.FieldName = 'SPColor' DataBinding.FieldName = 'SPColor'
HeaderAlignmentHorz = taCenter HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 69 Width = 69
end end
object v1Column17: TcxGridDBColumn object v1Column17: TcxGridDBColumn

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

@ -455,7 +455,7 @@ begin
if CDS_Main.IsEmpty then if CDS_Main.IsEmpty then
Exit; Exit;
MFiltration := Trim(CDS_Main.fieldbyname('SPID').AsString); 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)); FormPrint(Application, PChar(FPrintJson));
end; end;

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

@ -23,7 +23,8 @@ uses
U_ClientPrintRmf in '..\A00±êÇ©´òÓ¡\U_ClientPrintRmf.pas' {frmClientPrintRmf}, U_ClientPrintRmf in '..\A00±êÇ©´òÓ¡\U_ClientPrintRmf.pas' {frmClientPrintRmf},
U_LabelMapSet in '..\A00±êÇ©´òÓ¡\U_LabelMapSet.pas' {frmLabelMapSet}, U_LabelMapSet in '..\A00±êÇ©´òÓ¡\U_LabelMapSet.pas' {frmLabelMapSet},
U_LabelPrint in '..\A00±êÇ©´òÓ¡\U_LabelPrint.pas' {frmLabelPrint}, 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} {$R *.res}