D7zzHanglin/A00标签打印/U_QrCodeFun.pas

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;
  CurrentQrCodeId, LastQrCodeId, LastQrCodePath: string;
begin
  // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ά<EFBFBD><CEAC>ID<49>ֶ<EFBFBD><D6B6>Ƿ<EFBFBD><C7B7><EFBFBD><EFBFBD><EFBFBD>
  QrCodeIdField := Cds.FindField(FQrCodeField);
  if QrCodeIdField = nil then
    Exit;

  // <20><>ʼ<EFBFBD><CABC><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
  LastQrCodeId := '';
  LastQrCodePath := '';

  with Cds do
  begin
    DisableControls;
    try
      First;
      while not Eof do
      begin
        CurrentQrCodeId := QrCodeIdField.AsString;

        // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ǰ<EFBFBD><C7B0><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>һ<EFBFBD><D2BB><EFBFBD><EFBFBD>ͬ<EFBFBD><CDAC><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ö<EFBFBD>ά<EFBFBD><CEAC>·<EFBFBD><C2B7>
        if (CurrentQrCodeId = LastQrCodeId) and (LastQrCodePath <> '') then
        begin
          Edit;
          FieldByName('QRBARCODE').AsString := LastQrCodePath;
          Post;
        end
        else
        begin
          // <20><><EFBFBD><EFBFBD><EFBFBD>µĶ<C2B5>ά<EFBFBD>벢<EFBFBD><EBB2A2>¼·<C2BC><C2B7>
          Edit;
          LastQrCodePath := GetQrCode(CurrentQrCodeId);
          FieldByName('QRBARCODE').AsString := LastQrCodePath;
          Post;
          LastQrCodeId := CurrentQrCodeId;
        end;

        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('<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 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 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 := ''; // <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;

end.