加特殊二维码

This commit is contained in:
DESKTOP-E401PHE\Administrator 2025-07-18 15:23:24 +08:00
parent d6ad31e4c3
commit 0b1e1b9c8f
2 changed files with 86 additions and 39 deletions

View File

@ -12,19 +12,19 @@ uses
RM_Common, RM_Class, RM_GridReport, RM_e_Xls, Menus, MovePanel, cxTextEdit,
cxLookAndFeels, cxLookAndFeelPainters, cxNavigator, cxContainer, ShellAPI,
cxCurrencyEdit, MMSystem, dxSkinsCore, dxSkinBlack, dxSkinBlue,
dxSkinBlueprint, dxSkinCaramel, dxSkinCoffee, dxSkinDarkRoom,
dxSkinDarkSide, dxSkinDevExpressDarkStyle, dxSkinDevExpressStyle,
dxSkinFoggy, dxSkinGlassOceans, dxSkinHighContrast, dxSkiniMaginary,
dxSkinLilian, dxSkinLiquidSky, dxSkinLondonLiquidSky, dxSkinMcSkin,
dxSkinMetropolis, dxSkinMetropolisDark, dxSkinMoneyTwins,
dxSkinOffice2007Black, dxSkinOffice2007Blue, dxSkinOffice2007Green,
dxSkinOffice2007Pink, dxSkinOffice2007Silver, dxSkinOffice2010Black,
dxSkinOffice2010Blue, dxSkinOffice2010Silver, dxSkinOffice2013DarkGray,
dxSkinOffice2013LightGray, dxSkinOffice2013White, dxSkinPumpkin,
dxSkinSeven, dxSkinSevenClassic, dxSkinSharp, dxSkinSharpPlus,
dxSkinSilver, dxSkinSpringTime, dxSkinStardust, dxSkinSummer2008,
dxSkinTheAsphaltWorld, dxSkinsDefaultPainters, dxSkinValentine,
dxSkinVS2010, dxSkinWhiteprint, dxSkinXmas2008Blue, dxSkinscxPCPainter;
dxSkinBlueprint, dxSkinCaramel, dxSkinCoffee, dxSkinDarkRoom, dxSkinDarkSide,
dxSkinDevExpressDarkStyle, dxSkinDevExpressStyle, dxSkinFoggy,
dxSkinGlassOceans, dxSkinHighContrast, dxSkiniMaginary, dxSkinLilian,
dxSkinLiquidSky, dxSkinLondonLiquidSky, dxSkinMcSkin, dxSkinMetropolis,
dxSkinMetropolisDark, dxSkinMoneyTwins, dxSkinOffice2007Black,
dxSkinOffice2007Blue, dxSkinOffice2007Green, dxSkinOffice2007Pink,
dxSkinOffice2007Silver, dxSkinOffice2010Black, dxSkinOffice2010Blue,
dxSkinOffice2010Silver, dxSkinOffice2013DarkGray, dxSkinOffice2013LightGray,
dxSkinOffice2013White, dxSkinPumpkin, dxSkinSeven, dxSkinSevenClassic,
dxSkinSharp, dxSkinSharpPlus, dxSkinSilver, dxSkinSpringTime, dxSkinStardust,
dxSkinSummer2008, dxSkinTheAsphaltWorld, dxSkinsDefaultPainters,
dxSkinValentine, dxSkinVS2010, dxSkinWhiteprint, dxSkinXmas2008Blue,
dxSkinscxPCPainter;
type
TfrmJYOrderCDOne = class(TForm)
@ -714,7 +714,7 @@ end;
procedure TfrmJYOrderCDOne.ToolButton1Click(Sender: TObject);
var
fPrintFile: string;
Txt, fImagePath: string;
Txt, fImagePath,Txt1, fImagePath1: string;
Moudle: THandle;
Makebar: TMakebar;
Mixtext: TMixtext;
@ -781,10 +781,27 @@ begin
ExportFtErpFile('ͨÓñêÇ©.rmf', ADOQueryCmd);
fPrintFile := ExtractFilePath(Application.ExeName) + 'Report\ͨÓñêÇ©.rmf';
end;
try
Moudle := LoadLibrary('MakeQRBarcode.dll');
@Makebar := GetProcAddress(Moudle, 'Make');
@Mixtext := GetProcAddress(Moudle, 'MixText');
Txt1 := Trim(ADOQueryPrint.fieldbyname('SOrddefstr4').AsString) + '000' + floatTostr(ADOQueryPrint.fieldbyname('Mjlen').AsFloat * 10);
Txt1 := UTF8Encode(Txt1);
fImagePath1 := ExtractFilePath(Application.ExeName) + 'image\temp1.bmp';
if not DirectoryExists(pchar(ExtractFilePath(Application.ExeName) + 'image')) then
CreateDirectory(pchar(ExtractFilePath(Application.ExeName) + 'image'), nil);
if FileExists(fImagePath1) then
DeleteFile(fImagePath1);
Makebar(pchar(Txt1), Length(Txt1), 3, 3, 0, PChar(fImagePath1), 3);
except
application.MessageBox('条形码生成失败!', '提示信息', MB_ICONERROR);
Order_Main.EnableControls;
exit;
end;
if FileExists(fPrintFile) then
begin
RMVariables['QRBARCODE'] := fImagePath;
RMVariables['QRBARCODE1'] := fImagePath1;
RM2.LoadFromFile(fPrintFile);
//RM2.ShowReport;
RM2.PrintReport;
@ -1505,7 +1522,7 @@ begin
sql.add(',@flag=''2'' ');
Open;
end;
with ADOQueryhx do
with ADOQueryhx do
begin
Close;
sql.Clear;
@ -1517,7 +1534,7 @@ begin
Open;
end;
end;
if (trim(ComboBox1.Text) = '쇱駱쯤데(櫓匡)') or (trim(ComboBox1.Text) = '멂뵀츠玖쯤데') then
if (trim(ComboBox1.Text) = '检验码单(中文)') or (trim(ComboBox1.Text) = '缸号明细码单') then
begin
with ADOQueryTemp do
begin
@ -1569,7 +1586,7 @@ begin
end;
end;
if (trim(ComboBox1.Text) = '쇱駱쯤데') then
if (trim(ComboBox1.Text) = '检验码单') or (trim(ComboBox1.Text) = '检验码单(花型)') then
begin
with ADOQueryTemp do
begin
@ -1619,7 +1636,7 @@ begin
Open;
end;
end;
if (trim(ComboBox1.Text) = '쇱駱쯤데(丹빻)') then
if (trim(ComboBox1.Text) = '检验码单(印花)') then
begin
with ADOQueryTemp do
begin

View File

@ -3,14 +3,27 @@ unit U_MJManageNewFDNew;
interface
uses
Windows, Messages, SysUtils, Variants, math, Classes, Graphics, Controls,StrUtils,
Forms, Dialogs, StdCtrls, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData,
cxDataStorage, cxEdit, DB, cxDBData, cxCalendar, cxGridLevel,
Windows, Messages, SysUtils, Variants, math, Classes, Graphics, Controls,
StrUtils, Forms, Dialogs, StdCtrls, cxStyles, cxCustomData, cxGraphics,
cxFilter, cxData, cxDataStorage, cxEdit, DB, cxDBData, cxCalendar, cxGridLevel,
cxGridCustomTableView, cxGridTableView, cxGridDBTableView, cxClasses,
cxControls, cxGridCustomView, cxGrid, RM_Common, RM_Class, RM_GridReport,
RM_System, RM_Dataset, ADODB, DBClient, cxGridCustomPopupMenu, cxGridPopupMenu,
ExtCtrls, ComCtrls, ToolWin, cxTextEdit, Buttons, cxSplitter, cxCheckBox,
MovePanel, cxLookAndFeels, cxLookAndFeelPainters, cxNavigator, ShellAPI;
MovePanel, cxLookAndFeels, cxLookAndFeelPainters, cxNavigator, ShellAPI,
dxSkinsCore, dxSkinBlack, dxSkinBlue, dxSkinBlueprint, dxSkinCaramel,
dxSkinCoffee, dxSkinDarkRoom, dxSkinDarkSide, dxSkinDevExpressDarkStyle,
dxSkinDevExpressStyle, dxSkinFoggy, dxSkinGlassOceans, dxSkinHighContrast,
dxSkiniMaginary, dxSkinLilian, dxSkinLiquidSky, dxSkinLondonLiquidSky,
dxSkinMcSkin, dxSkinMetropolis, dxSkinMetropolisDark, dxSkinMoneyTwins,
dxSkinOffice2007Black, dxSkinOffice2007Blue, dxSkinOffice2007Green,
dxSkinOffice2007Pink, dxSkinOffice2007Silver, dxSkinOffice2010Black,
dxSkinOffice2010Blue, dxSkinOffice2010Silver, dxSkinOffice2013DarkGray,
dxSkinOffice2013LightGray, dxSkinOffice2013White, dxSkinPumpkin, dxSkinSeven,
dxSkinSevenClassic, dxSkinSharp, dxSkinSharpPlus, dxSkinSilver,
dxSkinSpringTime, dxSkinStardust, dxSkinSummer2008, dxSkinTheAsphaltWorld,
dxSkinsDefaultPainters, dxSkinValentine, dxSkinVS2010, dxSkinWhiteprint,
dxSkinXmas2008Blue, dxSkinscxPCPainter;
type
TfrmMJManageNewFDNewSF = class(TForm)
@ -1751,7 +1764,7 @@ end;
procedure TfrmMJManageNewFDNewSF.PrtData(FMJID: string);
var
fPrintFile: string;
Txt, fImagePath: string;
Txt, fImagePath, Txt1, fImagePath1: string;
Moudle: THandle;
Makebar: TMakebar;
Mixtext: TMixtext;
@ -1777,11 +1790,11 @@ begin
@Mixtext := GetProcAddress(Moudle, 'MixText');
if length(Trim(ADOQueryPrint.fieldbyname('MJSTR4').AsString)) = 1 then
begin
Txt := '013'+Trim(ADOQueryPrint.fieldbyname('PRTColor').AsString)+'0000000'+Trim(ADOQueryPrint.fieldbyname('MJSTR4').AsString)+Rightstr('1000'+ADOQueryPrint.fieldbyname('MJXH').AsString,3);
Txt := '013' + Trim(ADOQueryPrint.fieldbyname('PRTColor').AsString) + '0000000' + Trim(ADOQueryPrint.fieldbyname('MJSTR4').AsString) + Rightstr('1000' + ADOQueryPrint.fieldbyname('MJXH').AsString, 3);
end
else
begin
Txt := '013'+Trim(ADOQueryPrint.fieldbyname('PRTColor').AsString)+'000000'+Trim(ADOQueryPrint.fieldbyname('MJSTR4').AsString)+Rightstr('1000'+ADOQueryPrint.fieldbyname('MJXH').AsString,3);
Txt := '013' + Trim(ADOQueryPrint.fieldbyname('PRTColor').AsString) + '000000' + Trim(ADOQueryPrint.fieldbyname('MJSTR4').AsString) + Rightstr('1000' + ADOQueryPrint.fieldbyname('MJXH').AsString, 3);
end;
fImagePath := ExtractFilePath(Application.ExeName) + 'image\temp.bmp';
if not DirectoryExists(pchar(ExtractFilePath(Application.ExeName) + 'image')) then
@ -1794,7 +1807,23 @@ begin
CDS_MJID.EnableControls;
exit;
end;
try
Moudle := LoadLibrary('MakeQRBarcode.dll');
@Makebar := GetProcAddress(Moudle, 'Make');
@Mixtext := GetProcAddress(Moudle, 'MixText');
Txt1 := Trim(ADOQueryPrint.fieldbyname('SOrddefstr4').AsString) + '000' + floatTostr(ADOQueryPrint.fieldbyname('Mjlen').AsFloat * 10);
Txt1 := UTF8Encode(Txt1);
fImagePath1 := ExtractFilePath(Application.ExeName) + 'image\temp1.bmp';
if not DirectoryExists(pchar(ExtractFilePath(Application.ExeName) + 'image')) then
CreateDirectory(pchar(ExtractFilePath(Application.ExeName) + 'image'), nil);
if FileExists(fImagePath1) then
DeleteFile(fImagePath1);
Makebar(pchar(Txt1), Length(Txt1), 3, 3, 0, PChar(fImagePath1), 3);
except
application.MessageBox('条形码生成失败!', '提示信息', MB_ICONERROR);
CDS_MJID.EnableControls;
exit;
end;
if Trim(ADOQueryPrint.fieldbyname('Slbname').AsString) <> '' then
begin
fPrintFile := ExtractFilePath(Application.ExeName) + 'Report\' + Trim(ADOQueryPrint.fieldbyname('Slbname').AsString);
@ -1809,6 +1838,7 @@ begin
if FileExists(fPrintFile) then
begin
RMVariables['QRBARCODE'] := fImagePath;
RMVariables['QRBARCODE1'] := fImagePath1;
RM2.LoadFromFile(fPrintFile);
RM2.DefaultCopies := strtointdef(trim(ComboBox1.Text), 1);