D7myYunxiang/A00标签打印/U_ClientPrintRmf.pas

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.