加特殊二维码

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

@ -2,7 +2,7 @@ unit U_JYOrderCDOne;
interface interface
uses uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ComCtrls, ToolWin, cxStyles, cxCustomData, Dialogs, StdCtrls, ExtCtrls, ComCtrls, ToolWin, cxStyles, cxCustomData,
cxGraphics, cxFilter, cxData, cxDataStorage, cxEdit, DB, cxDBData, ADODB, cxGraphics, cxFilter, cxData, cxDataStorage, cxEdit, DB, cxDBData, ADODB,
@ -12,19 +12,19 @@ uses
RM_Common, RM_Class, RM_GridReport, RM_e_Xls, Menus, MovePanel, cxTextEdit, RM_Common, RM_Class, RM_GridReport, RM_e_Xls, Menus, MovePanel, cxTextEdit,
cxLookAndFeels, cxLookAndFeelPainters, cxNavigator, cxContainer, ShellAPI, cxLookAndFeels, cxLookAndFeelPainters, cxNavigator, cxContainer, ShellAPI,
cxCurrencyEdit, MMSystem, dxSkinsCore, dxSkinBlack, dxSkinBlue, cxCurrencyEdit, MMSystem, dxSkinsCore, dxSkinBlack, dxSkinBlue,
dxSkinBlueprint, dxSkinCaramel, dxSkinCoffee, dxSkinDarkRoom, dxSkinBlueprint, dxSkinCaramel, dxSkinCoffee, dxSkinDarkRoom, dxSkinDarkSide,
dxSkinDarkSide, dxSkinDevExpressDarkStyle, dxSkinDevExpressStyle, dxSkinDevExpressDarkStyle, dxSkinDevExpressStyle, dxSkinFoggy,
dxSkinFoggy, dxSkinGlassOceans, dxSkinHighContrast, dxSkiniMaginary, dxSkinGlassOceans, dxSkinHighContrast, dxSkiniMaginary, dxSkinLilian,
dxSkinLilian, dxSkinLiquidSky, dxSkinLondonLiquidSky, dxSkinMcSkin, dxSkinLiquidSky, dxSkinLondonLiquidSky, dxSkinMcSkin, dxSkinMetropolis,
dxSkinMetropolis, dxSkinMetropolisDark, dxSkinMoneyTwins, dxSkinMetropolisDark, dxSkinMoneyTwins, dxSkinOffice2007Black,
dxSkinOffice2007Black, dxSkinOffice2007Blue, dxSkinOffice2007Green, dxSkinOffice2007Blue, dxSkinOffice2007Green, dxSkinOffice2007Pink,
dxSkinOffice2007Pink, dxSkinOffice2007Silver, dxSkinOffice2010Black, dxSkinOffice2007Silver, dxSkinOffice2010Black, dxSkinOffice2010Blue,
dxSkinOffice2010Blue, dxSkinOffice2010Silver, dxSkinOffice2013DarkGray, dxSkinOffice2010Silver, dxSkinOffice2013DarkGray, dxSkinOffice2013LightGray,
dxSkinOffice2013LightGray, dxSkinOffice2013White, dxSkinPumpkin, dxSkinOffice2013White, dxSkinPumpkin, dxSkinSeven, dxSkinSevenClassic,
dxSkinSeven, dxSkinSevenClassic, dxSkinSharp, dxSkinSharpPlus, dxSkinSharp, dxSkinSharpPlus, dxSkinSilver, dxSkinSpringTime, dxSkinStardust,
dxSkinSilver, dxSkinSpringTime, dxSkinStardust, dxSkinSummer2008, dxSkinSummer2008, dxSkinTheAsphaltWorld, dxSkinsDefaultPainters,
dxSkinTheAsphaltWorld, dxSkinsDefaultPainters, dxSkinValentine, dxSkinValentine, dxSkinVS2010, dxSkinWhiteprint, dxSkinXmas2008Blue,
dxSkinVS2010, dxSkinWhiteprint, dxSkinXmas2008Blue, dxSkinscxPCPainter; dxSkinscxPCPainter;
type type
TfrmJYOrderCDOne = class(TForm) TfrmJYOrderCDOne = class(TForm)
@ -439,7 +439,7 @@ var
begin begin
ReadCxGrid('检验报告JF', Tv1, '检验管理'); ReadCxGrid('检验报告JF', Tv1, '检验管理');
fsj := 'select distinct(Filler) name from WFB_MJJY '; fsj := 'select distinct(Filler) name from WFB_MJJY ';
Strmd := 'select distinct(text) name,index1 from A_MaDan order by index1 '; Strmd := 'select distinct(text) name,index1 from A_MaDan order by index1 ';
SInitComBoxBySql(ADOQueryCmd, Filler, False, fsj); SInitComBoxBySql(ADOQueryCmd, Filler, False, fsj);
SInitComBoxBySql(ADOQueryCmd, ComboBox1, False, Strmd); SInitComBoxBySql(ADOQueryCmd, ComboBox1, False, Strmd);
BegDate.DateTime := SGetServerDate10(ADOQueryTemp) - 1; BegDate.DateTime := SGetServerDate10(ADOQueryTemp) - 1;
@ -714,7 +714,7 @@ end;
procedure TfrmJYOrderCDOne.ToolButton1Click(Sender: TObject); procedure TfrmJYOrderCDOne.ToolButton1Click(Sender: TObject);
var var
fPrintFile: string; fPrintFile: string;
Txt, fImagePath: string; Txt, fImagePath,Txt1, fImagePath1: string;
Moudle: THandle; Moudle: THandle;
Makebar: TMakebar; Makebar: TMakebar;
Mixtext: TMixtext; Mixtext: TMixtext;
@ -781,10 +781,27 @@ begin
ExportFtErpFile('通用标签.rmf', ADOQueryCmd); ExportFtErpFile('通用标签.rmf', ADOQueryCmd);
fPrintFile := ExtractFilePath(Application.ExeName) + 'Report\通用标签.rmf'; fPrintFile := ExtractFilePath(Application.ExeName) + 'Report\通用标签.rmf';
end; 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 if FileExists(fPrintFile) then
begin begin
RMVariables['QRBARCODE'] := fImagePath; RMVariables['QRBARCODE'] := fImagePath;
RMVariables['QRBARCODE1'] := fImagePath1;
RM2.LoadFromFile(fPrintFile); RM2.LoadFromFile(fPrintFile);
//RM2.ShowReport; //RM2.ShowReport;
RM2.PrintReport; RM2.PrintReport;
@ -1505,19 +1522,19 @@ begin
sql.add(',@flag=''2'' '); sql.add(',@flag=''2'' ');
Open; Open;
end; end;
with ADOQueryhx do with ADOQueryhx do
begin begin
Close; Close;
sql.Clear; sql.Clear;
sql.add('exec P_Do_PrintMd_HZ '); sql.add('exec P_Do_PrintMd_HZ ');
sql.add('@mainID=' + quotedstr(Trim(''))); sql.add('@mainID=' + quotedstr(Trim('')));
sql.add(',@DName=' + quotedstr(Trim(DCode))); sql.add(',@DName=' + quotedstr(Trim(DCode)));
sql.add(',@flag=''4'' '); sql.add(',@flag=''4'' ');
// showmessage(sql.text); // showmessage(sql.text);
Open; Open;
end; end;
end; end;
if (trim(ComboBox1.Text) = '쇱駱쯤데(櫓匡)') or (trim(ComboBox1.Text) = '멂뵀츠玖쯤데') then if (trim(ComboBox1.Text) = '检验码单(中文)') or (trim(ComboBox1.Text) = '缸号明细码单') then
begin begin
with ADOQueryTemp do with ADOQueryTemp do
begin begin
@ -1569,7 +1586,7 @@ begin
end; end;
end; end;
if (trim(ComboBox1.Text) = '쇱駱쯤데') then if (trim(ComboBox1.Text) = '检验码单') or (trim(ComboBox1.Text) = '检验码单(花型)') then
begin begin
with ADOQueryTemp do with ADOQueryTemp do
begin begin
@ -1579,7 +1596,7 @@ begin
sql.add('@DName=' + quotedstr(Trim(DCode))); sql.add('@DName=' + quotedstr(Trim(DCode)));
Open; Open;
end; end;
SCreateCDS20(ADOQueryTemp, CDS_HZ); SCreateCDS20(ADOQueryTemp, CDS_HZ);
SInitCDSData20(ADOQueryTemp, CDS_HZ); SInitCDSData20(ADOQueryTemp, CDS_HZ);
with ADOQueryPrint do with ADOQueryPrint do
@ -1619,7 +1636,7 @@ begin
Open; Open;
end; end;
end; end;
if (trim(ComboBox1.Text) = '쇱駱쯤데(丹빻)') then if (trim(ComboBox1.Text) = '检验码单(印花)') then
begin begin
with ADOQueryTemp do with ADOQueryTemp do
begin begin
@ -2032,7 +2049,7 @@ begin
end; end;
end; end;
ADOQueryCmd.Connection.CommitTrans; ADOQueryCmd.Connection.CommitTrans;
Order_Main.EnableControls; Order_Main.EnableControls;
application.MessageBox('数据保存成功!', '提示信息'); application.MessageBox('数据保存成功!', '提示信息');
Panel11.Visible := false; Panel11.Visible := false;
TBRafresh.Click; TBRafresh.Click;

View File

@ -3,14 +3,27 @@ unit U_MJManageNewFDNew;
interface interface
uses uses
Windows, Messages, SysUtils, Variants, math, Classes, Graphics, Controls,StrUtils, Windows, Messages, SysUtils, Variants, math, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData, StrUtils, Forms, Dialogs, StdCtrls, cxStyles, cxCustomData, cxGraphics,
cxDataStorage, cxEdit, DB, cxDBData, cxCalendar, cxGridLevel, cxFilter, cxData, cxDataStorage, cxEdit, DB, cxDBData, cxCalendar, cxGridLevel,
cxGridCustomTableView, cxGridTableView, cxGridDBTableView, cxClasses, cxGridCustomTableView, cxGridTableView, cxGridDBTableView, cxClasses,
cxControls, cxGridCustomView, cxGrid, RM_Common, RM_Class, RM_GridReport, cxControls, cxGridCustomView, cxGrid, RM_Common, RM_Class, RM_GridReport,
RM_System, RM_Dataset, ADODB, DBClient, cxGridCustomPopupMenu, cxGridPopupMenu, RM_System, RM_Dataset, ADODB, DBClient, cxGridCustomPopupMenu, cxGridPopupMenu,
ExtCtrls, ComCtrls, ToolWin, cxTextEdit, Buttons, cxSplitter, cxCheckBox, 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 type
TfrmMJManageNewFDNewSF = class(TForm) TfrmMJManageNewFDNewSF = class(TForm)
@ -1028,7 +1041,7 @@ begin
if (FDC <> 0) and (Edit12.text <> '') then if (FDC <> 0) and (Edit12.text <> '') then
begin begin
FieldByName('MJLen').Value := FDC; FieldByName('MJLen').Value := FDC;
end end
else else
begin begin
// FieldByName('MJLen').Value := StrToFloatdef(trim(MJLen.Text), 0) - StrToFloatdef(trim(MJQty2.Text), 0) + fjc; // FieldByName('MJLen').Value := StrToFloatdef(trim(MJLen.Text), 0) - StrToFloatdef(trim(MJQty2.Text), 0) + fjc;
@ -1081,7 +1094,7 @@ begin
if trim(fbaotype) = 'ÊÖ¶¯´ò°ü' then if trim(fbaotype) = 'ÊÖ¶¯´ò°ü' then
begin begin
FieldByName('baoNO').Value := Trim(baono.text); FieldByName('baoNO').Value := Trim(baono.text);
FieldByName('baoID').Value := Trim(baoID.Text); FieldByName('baoID').Value := Trim(baoID.Text);
end; end;
Post; Post;
@ -1632,7 +1645,7 @@ begin
end; end;
if Trim(Edit6.Text) <> '' then if Trim(Edit6.Text) <> '' then
begin begin
with ADOTmp do with ADOTmp do
begin begin
Close; Close;
@ -1751,11 +1764,11 @@ end;
procedure TfrmMJManageNewFDNewSF.PrtData(FMJID: string); procedure TfrmMJManageNewFDNewSF.PrtData(FMJID: string);
var var
fPrintFile: string; fPrintFile: string;
Txt, fImagePath: string; Txt, fImagePath, Txt1, fImagePath1: string;
Moudle: THandle; Moudle: THandle;
Makebar: TMakebar; Makebar: TMakebar;
Mixtext: TMixtext; Mixtext: TMixtext;
begin begin
with ADOQueryPrint do with ADOQueryPrint do
begin begin
@ -1772,16 +1785,16 @@ begin
end; end;
try try
Moudle := LoadLibrary('MakeQRBarcode.dll'); Moudle := LoadLibrary('MakeQRBarcode.dll');
@Makebar := GetProcAddress(Moudle, 'Make'); @Makebar := GetProcAddress(Moudle, 'Make');
@Mixtext := GetProcAddress(Moudle, 'MixText'); @Mixtext := GetProcAddress(Moudle, 'MixText');
if length(Trim(ADOQueryPrint.fieldbyname('MJSTR4').AsString)) = 1 then if length(Trim(ADOQueryPrint.fieldbyname('MJSTR4').AsString)) = 1 then
begin 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 end
else else
begin 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; end;
fImagePath := ExtractFilePath(Application.ExeName) + 'image\temp.bmp'; fImagePath := ExtractFilePath(Application.ExeName) + 'image\temp.bmp';
if not DirectoryExists(pchar(ExtractFilePath(Application.ExeName) + 'image')) then if not DirectoryExists(pchar(ExtractFilePath(Application.ExeName) + 'image')) then
@ -1794,7 +1807,23 @@ begin
CDS_MJID.EnableControls; CDS_MJID.EnableControls;
exit; exit;
end; 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 if Trim(ADOQueryPrint.fieldbyname('Slbname').AsString) <> '' then
begin begin
fPrintFile := ExtractFilePath(Application.ExeName) + 'Report\' + Trim(ADOQueryPrint.fieldbyname('Slbname').AsString); fPrintFile := ExtractFilePath(Application.ExeName) + 'Report\' + Trim(ADOQueryPrint.fieldbyname('Slbname').AsString);
@ -1809,6 +1838,7 @@ begin
if FileExists(fPrintFile) then if FileExists(fPrintFile) then
begin begin
RMVariables['QRBARCODE'] := fImagePath; RMVariables['QRBARCODE'] := fImagePath;
RMVariables['QRBARCODE1'] := fImagePath1;
RM2.LoadFromFile(fPrintFile); RM2.LoadFromFile(fPrintFile);
RM2.DefaultCopies := strtointdef(trim(ComboBox1.Text), 1); RM2.DefaultCopies := strtointdef(trim(ComboBox1.Text), 1);