489 lines
12 KiB
ObjectPascal
489 lines
12 KiB
ObjectPascal
unit U_ClientPrintRmf;
|
||
|
||
interface
|
||
|
||
uses
|
||
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
|
||
Dialogs, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData, cxDataStorage,
|
||
cxEdit, DB, cxDBData, ToolWin, ComCtrls, cxGridCustomTableView,
|
||
cxGridTableView, cxGridDBTableView, cxGridLevel, cxClasses, cxControls,
|
||
cxGridCustomView, cxGrid, DBClient, ADODB, ImgList, StdCtrls, ExtCtrls,
|
||
cxTextEdit, cxGridCustomPopupMenu, cxGridPopupMenu, cxLookAndFeels,
|
||
cxLookAndFeelPainters, cxNavigator, dxBarBuiltInMenu, RM_Common, RM_Class,
|
||
RM_GridReport, RM_Dataset, RM_E_llPDF, RM_BarCode, RM_e_Graphic, RM_e_Jpeg,
|
||
RM_e_Xls, cxContainer, cxMaskEdit, cxDropDownEdit, cxMRUEdit, dxSkinsCore,
|
||
dxSkinsDefaultPainters, cxProgressBar, cxButtons, RM_System;
|
||
|
||
type
|
||
TfrmClientPrintRmf = class(TForm)
|
||
ADOQueryTemp: TADOQuery;
|
||
ADOConnection1: TADOConnection;
|
||
ImageList1: TImageList;
|
||
RMDB_1: TRMDBDataSet;
|
||
RM1: TRMGridReport;
|
||
RMDB_2: TRMDBDataSet;
|
||
CDS_Label: TClientDataSet;
|
||
ADO_Prt: TADOQuery;
|
||
RMDB_3: TRMDBDataSet;
|
||
RMXLSExport1: TRMXLSExport;
|
||
RMJPEGExport1: TRMJPEGExport;
|
||
RMBarCodeObject1: TRMBarCodeObject;
|
||
ADOQueryCmd: TADOQuery;
|
||
ADO_While: TADOQuery;
|
||
RMDB_4: TRMDBDataSet;
|
||
RMDB_5: TRMDBDataSet;
|
||
ADOQueryReport: TADOQuery;
|
||
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);
|
||
procedure FormDestroy(Sender: TObject);
|
||
procedure TV1DblClick(Sender: TObject);
|
||
private
|
||
IsDebug, FPreviewPrint, fIsPreview: Boolean;
|
||
FLMType, FLBName, FQrCodeField: string;
|
||
FExportFileType, FExportFileName: string;
|
||
SqlStr1, SqlStr2, SqlStr3, SqlStr4, SqlStr5: string;
|
||
FSuccessfulFun: string;
|
||
FparamBlclid: string;
|
||
procedure PrintReport();
|
||
procedure ExportReport();
|
||
procedure InitAdo(Ado: TADOQuery; Cds: TClientDataSet; SqlStr: string);
|
||
function GetQrCode(Txt: string): string;
|
||
procedure InitArgs();
|
||
function EnsureQrCodeDirectory: Boolean;
|
||
function ClearQrCodeDirectory: Boolean;
|
||
procedure IintCDS(SADOQry: TADOQuery; mClientDataset: TclientDataSet);
|
||
{ Private declarations }
|
||
public
|
||
FPrintJson: PChar;
|
||
FJsonOut: PChar;
|
||
DConString, DCode, DName: string;
|
||
constructor Create(AOwner: TComponent; JsonArgs: PChar);
|
||
|
||
{ 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;
|
||
|
||
{$R *.dfm}
|
||
constructor TfrmClientPrintRmf.Create(AOwner: TComponent; JsonArgs: PChar);
|
||
begin
|
||
inherited Create(AOwner);
|
||
FPrintJson := JsonArgs;
|
||
end;
|
||
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ά<EFBFBD><CEAC><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ŀ¼<C4BF><C2BC><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ڣ<EFBFBD>
|
||
|
||
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('<27><EFBFBD><DEB7><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ά<EFBFBD><CEAC>Ŀ¼: ' + QrCodeDir);
|
||
end;
|
||
Result := True;
|
||
except
|
||
on E: Exception do
|
||
begin
|
||
Application.MessageBox(PChar('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ά<EFBFBD><CEAC>Ŀ¼ʧ<C2BC><CAA7>: ' + E.Message), '<27><><EFBFBD><EFBFBD>', MB_ICONERROR);
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
// <20><><EFBFBD>ն<EFBFBD>ά<EFBFBD><CEAC>Ŀ¼<C4BF>е<EFBFBD><D0B5><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ļ<EFBFBD>
|
||
function TfrmClientPrintRmf.ClearQrCodeDirectory: Boolean;
|
||
var
|
||
QrCodeDir: string;
|
||
SearchRec: TSearchRec;
|
||
begin
|
||
Result := False;
|
||
QrCodeDir := ExtractFilePath(Application.ExeName) + 'QrCode\';
|
||
|
||
try
|
||
if not DirectoryExists(QrCodeDir) then
|
||
Exit; // Ŀ¼<C4BF><C2BC><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ϊ<EFBFBD>ɹ<EFBFBD>
|
||
// ɾ<><C9BE>Ŀ¼<C4BF><C2BC><EFBFBD><EFBFBD><EFBFBD><EFBFBD>.bmp<6D>ļ<EFBFBD>
|
||
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('<27><><EFBFBD>ն<EFBFBD>ά<EFBFBD><CEAC>Ŀ¼ʧ<C2BC><CAA7>: ' + E.Message), '<27><><EFBFBD><EFBFBD>', 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 := ''; // <20><>ʼ<EFBFBD><CABC><EFBFBD><EFBFBD><EFBFBD><EFBFBD>·<EFBFBD><C2B7>
|
||
|
||
try
|
||
Moudle := LoadLibrary('MakeQRBarcode.dll');
|
||
if Moudle = 0 then
|
||
RaiseLastOSError;
|
||
|
||
@Makebar := GetProcAddress(Moudle, 'Make');
|
||
if not Assigned(Makebar) then
|
||
raise Exception.Create('<27>Ҳ<EFBFBD><D2B2><EFBFBD> Make <20><><EFBFBD><EFBFBD>');
|
||
|
||
@Mixtext := GetProcAddress(Moudle, 'MixText');
|
||
if not Assigned(Mixtext) then
|
||
raise Exception.Create('<27>Ҳ<EFBFBD><D2B2><EFBFBD> MixText <20><><EFBFBD><EFBFBD>');
|
||
|
||
// <20><><EFBFBD><EFBFBD>ʱ<EFBFBD><CAB1><EFBFBD><EFBFBD><EFBFBD>ļ<EFBFBD><C4BC><EFBFBD> (<28><>ʽ: YYYYMMDD_HHMMSSZZZ)
|
||
Sleep(10);
|
||
TimeStamp := FormatDateTime('yyyymmdd_hhnnsszzz', Now) + '_' + IntToStr(Random(1000));
|
||
fImagePath := ExtractFilePath(Application.ExeName) + 'QrCode\' + TimeStamp + '.bmp';
|
||
|
||
// ȷ<><C8B7>Ŀ¼<C4BF><C2BC><EFBFBD><EFBFBD>
|
||
if not DirectoryExists(ExtractFilePath(fImagePath)) then
|
||
ForceDirectories(ExtractFilePath(fImagePath));
|
||
|
||
Makebar(pchar(Txt), Length(Txt), 3, 3, 0, PChar(fImagePath), 3);
|
||
|
||
Result := fImagePath; // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ɵ<EFBFBD><C9B5>ļ<EFBFBD>·<EFBFBD><C2B7>
|
||
except
|
||
on E: Exception do
|
||
begin
|
||
application.MessageBox(PChar('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ʧ<EFBFBD>ܣ<EFBFBD>' + E.Message), '<27><><EFBFBD><EFBFBD>', MB_ICONERROR);
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
procedure TfrmClientPrintRmf.InitArgs;
|
||
var
|
||
JSONObject, item: ISuperObject;
|
||
jsonArray: TSuperArray;
|
||
i, loopCount: Integer;
|
||
begin
|
||
// <20><><EFBFBD><EFBFBD> JSON <20>ַ<EFBFBD><D6B7><EFBFBD>
|
||
JSONObject := SO(FPrintJson);
|
||
if JSONObject = nil then
|
||
begin
|
||
Application.MessageBox('PrintJson<6F><6E>ʽ<EFBFBD>쳣!', '<27><>ʾ', 0);
|
||
Exit;
|
||
end;
|
||
|
||
// <20><>ȡ<EFBFBD><C8A1><EFBFBD><EFBFBD><EFBFBD>ֶ<EFBFBD>
|
||
fIsPreview := JSONObject.B['IsPreview'];
|
||
IsDebug := JSONObject.B['IsDebug'];
|
||
FSuccessfulFun := JSONObject.S['SuccessfulFun'];
|
||
FLMType := JSONObject.S['LMType'];
|
||
FPreviewPrint := JSONObject.B['PreviewPrint'];
|
||
FLBName := JSONObject.S['LBName'];
|
||
FExportFileType := JSONObject.S['ExportFileType'];
|
||
FExportFileName := JSONObject.S['ExportFileName'];
|
||
FQrCodeField := JSONObject.S['QrCodeField'];
|
||
DConString := JSONObject.S['DConString'];
|
||
DCode := JSONObject.S['DCode'];
|
||
DName := JSONObject.S['DName'];
|
||
|
||
// <20><><EFBFBD><EFBFBD>Ĭ<EFBFBD>ϵ<EFBFBD><CFB5><EFBFBD><EFBFBD>ļ<EFBFBD><C4BC><EFBFBD>
|
||
if Trim(FExportFileName) = '' then
|
||
FExportFileName := FLBName;
|
||
|
||
|
||
|
||
// <20><>ʼ<EFBFBD><CABC> SQL <20>ַ<EFBFBD><D6B7><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
SqlStr1 := '';
|
||
SqlStr2 := '';
|
||
SqlStr3 := '';
|
||
SqlStr4 := '';
|
||
SqlStr5 := '';
|
||
|
||
// <20><>ȡ<EFBFBD><C8A1><EFBFBD><EFBFBD><EFBFBD><EFBFBD> PrtArgs <20><><EFBFBD><EFBFBD>
|
||
jsonArray := JSONObject.A['PrtArgs'];
|
||
if Assigned(jsonArray) then
|
||
begin
|
||
// ȷ<><C8B7>ѭ<EFBFBD><D1AD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>5<EFBFBD><35>Ԫ<EFBFBD>أ<EFBFBD>
|
||
loopCount := jsonArray.Length;
|
||
|
||
for i := 0 to loopCount - 1 do
|
||
begin
|
||
item := jsonArray.O[i];
|
||
case i of
|
||
0:
|
||
SqlStr1 := item.S['SqlStr'];
|
||
1:
|
||
SqlStr2 := item.S['SqlStr'];
|
||
2:
|
||
SqlStr3 := item.S['SqlStr'];
|
||
3:
|
||
SqlStr4 := item.S['SqlStr'];
|
||
4:
|
||
SqlStr5 := item.S['SqlStr'];
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
// <20><><EFBFBD>ñ<EFBFBD><C3B1><EFBFBD>Ԥ<EFBFBD><D4A4><EFBFBD><EFBFBD>ť
|
||
// if FPreviewPrint then
|
||
// RM1.PreviewButtons := [rmpbZoom, rmpbLoad, rmpbSave, rmpbPrint, rmpbFind, rmpbPageSetup, rmpbExit, rmpbSaveToXLS, rmpbExport, rmpbNavigator]
|
||
// else
|
||
// RM1.PreviewButtons := [rmpbZoom, rmpbLoad, rmpbSave, rmpbFind, rmpbPageSetup, rmpbExit, rmpbSaveToXLS, rmpbExport, rmpbNavigator];
|
||
end;
|
||
|
||
procedure TfrmClientPrintRmf.InitAdo(Ado: TADOQuery; Cds: TClientDataSet; SqlStr: string);
|
||
var
|
||
QrCodeIdField: TField;
|
||
begin
|
||
if Trim(SqlStr) = '' then
|
||
Exit;
|
||
|
||
// ִ<><D6B4>ADO<44><4F>ѯ
|
||
with Ado do
|
||
begin
|
||
Close;
|
||
SQL.Clear;
|
||
SQL.Add(SqlStr);
|
||
Open;
|
||
end;
|
||
IintCDS(Ado, Cds);
|
||
|
||
// <20><><EFBFBD><EFBFBD><EFBFBD>Ƿ<EFBFBD><C7B7><EFBFBD><EFBFBD>ڶ<EFBFBD>ά<EFBFBD><CEAC>ID<49>ֶ<EFBFBD>
|
||
if Trim(FQrCodeField) = '' then
|
||
Exit;
|
||
|
||
QrCodeIdField := Cds.FindField(FQrCodeField);
|
||
if QrCodeIdField = nil then
|
||
Exit;
|
||
|
||
// <20><><EFBFBD>ɶ<EFBFBD>ά<EFBFBD>벢<EFBFBD><EFBFBD>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;
|
||
|
||
procedure TfrmClientPrintRmf.ExportReport();
|
||
var
|
||
fPrintFile, fExportPath: string;
|
||
begin
|
||
fPrintFile := ExtractFilePath(Application.ExeName) + 'Report\' + FLBName + '.rmf';
|
||
if FileExists(fPrintFile) then
|
||
begin
|
||
RM1.LoadFromFile(fPrintFile);
|
||
RMVariables['LBPrtCode'] := dcode;
|
||
RMVariables['LBPrtName'] := dname;
|
||
|
||
fExportPath := ExtractFilePath(Application.ExeName) + FExportFileName + '.' + FExportFileType;
|
||
if not DirectoryExists(ExtractFileDir(fExportPath)) then
|
||
CreateDir(ExtractFileDir(fExportPath));
|
||
RM1.PrepareReport; //ֱ<>ӵ<EFBFBD><D3B5><EFBFBD>
|
||
// if FExportFileType = 'pdf' then
|
||
// RM1.ExportTo(RMllPDFExport1, fExportPath)
|
||
// else
|
||
RM1.ExportTo(RMXLSExport1, fExportPath);
|
||
|
||
FJsonOut := '{"success":true,"message":"<22><><EFBFBD><EFBFBD><EFBFBD>ɹ<EFBFBD>!"}';
|
||
end
|
||
else
|
||
begin
|
||
FJsonOut := '{"success":false,"message":"<22><><EFBFBD><EFBFBD><EFBFBD>ļ<EFBFBD>û<EFBFBD>ҵ<EFBFBD>!"}';
|
||
end;
|
||
|
||
end;
|
||
|
||
procedure TfrmClientPrintRmf.PrintReport();
|
||
var
|
||
fPrintFile: string;
|
||
begin
|
||
fPrintFile := ExtractFilePath(Application.ExeName) + 'Report\' + FLBName + '.rmf';
|
||
if FileExists(fPrintFile) then
|
||
begin
|
||
RM1.LoadFromFile(fPrintFile);
|
||
// RM1.DefaultCopies := StrToIntDef(ComboBox1.Text, 1);
|
||
RMVariables['LBPrtCode'] := dcode;
|
||
RMVariables['LBPrtName'] := dname;
|
||
if fIsPreview then
|
||
RM1.ShowReport
|
||
else
|
||
RM1.PrintReport;
|
||
|
||
FJsonOut := '{"success":true,"message":"<22><>ӡ<EFBFBD>ɹ<EFBFBD>!"}';
|
||
end
|
||
else
|
||
begin
|
||
FJsonOut := '{"success":false,"message":"<22><><EFBFBD><EFBFBD><EFBFBD>ļ<EFBFBD>û<EFBFBD>ҵ<EFBFBD>!"}';
|
||
end;
|
||
|
||
end;
|
||
|
||
procedure TfrmClientPrintRmf.FormCreate(Sender: TObject);
|
||
begin
|
||
FPreviewPrint := True;
|
||
InitArgs();
|
||
|
||
with ADOConnection1 do
|
||
begin
|
||
Connected := false;
|
||
ConnectionString := DConString;
|
||
Connected := true;
|
||
end;
|
||
// <20><><EFBFBD><EFBFBD><EFBFBD>ļ<EFBFBD><C4BC><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ֲ<EFBFBD><D6B2>䣩
|
||
ExportFtErpFile(FLBName + '.rmf', ADOQueryReport);
|
||
EnsureQrCodeDirectory();
|
||
ClearQrCodeDirectory();
|
||
end;
|
||
|
||
procedure TfrmClientPrintRmf.FormClose(Sender: TObject; var Action: TCloseAction);
|
||
begin
|
||
|
||
Action := cafree;
|
||
end;
|
||
|
||
procedure TfrmClientPrintRmf.FormShow(Sender: TObject);
|
||
begin
|
||
|
||
if flbName = '' then
|
||
begin
|
||
FJsonOut := '{"success":false,"message":"δ<><CEB4><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ӡ<EFBFBD><D3A1>ǩ!"}';
|
||
self.Close;
|
||
exit;
|
||
end;
|
||
if SqlStr1 = '' then
|
||
begin
|
||
FJsonOut := '{"success":false,"message":"δ<><CEB4><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ӡ<EFBFBD><D3A1><EFBFBD><EFBFBD>!"}';
|
||
self.Close;
|
||
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);
|
||
|
||
if FExportFileType = '' then
|
||
begin
|
||
PrintReport();
|
||
end
|
||
else
|
||
ExportReport();
|
||
|
||
self.Close;
|
||
end;
|
||
|
||
procedure TfrmClientPrintRmf.TV1DblClick(Sender: TObject);
|
||
begin
|
||
ModalResult := 1;
|
||
end;
|
||
|
||
procedure TfrmClientPrintRmf.FormDestroy(Sender: TObject);
|
||
begin
|
||
frmClientPrintRmf := nil;
|
||
end;
|
||
|
||
end.
|
||
|