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
  // 检查二维码ID字段是否存在
  QrCodeIdField := Cds.FindField(FQrCodeField);
  if QrCodeIdField = nil then
    Exit;

  // 初始化变量
  LastQrCodeId := '';
  LastQrCodePath := '';

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

        // 如果当前内容与上一条相同，则复用二维码路径
        if (CurrentQrCodeId = LastQrCodeId) and (LastQrCodePath <> '') then
        begin
          Edit;
          FieldByName('QRBARCODE').AsString := LastQrCodePath;
          Post;
        end
        else
        begin
          // 生成新的二维码并记录路径
          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('无法创建二维码目录: ' + QrCodeDir);
    end;
    Result := True;
  except
    on E: Exception do
    begin
      Application.MessageBox(PChar('创建二维码目录失败: ' + E.Message), '错误', MB_ICONERROR);
    end;
  end;
end;

// 清空二维码目录中的所有文件
function ClearQrCodeDirectory: Boolean;
var
  QrCodeDir: string;
  SearchRec: TSearchRec;
begin
  Result := False;
  QrCodeDir := ExtractFilePath(Application.ExeName) + 'QrCode\';

  try
    if not DirectoryExists(QrCodeDir) then
      Exit; // 目录不存在视为成功
    // 删除目录下所有.bmp文件
    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('清空二维码目录失败: ' + E.Message), '错误', 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 := ''; // 初始化返回路径

  try
    Moudle := LoadLibrary('MakeQRBarcode.dll');
    if Moudle = 0 then
      RaiseLastOSError;

    @Makebar := GetProcAddress(Moudle, 'Make');
    if not Assigned(Makebar) then
      raise Exception.Create('找不到 Make 函数');

    @Mixtext := GetProcAddress(Moudle, 'MixText');
    if not Assigned(Mixtext) then
      raise Exception.Create('找不到 MixText 函数');

    // 生成时间戳文件名 (格式: YYYYMMDD_HHMMSSZZZ)
    Sleep(10);
    TimeStamp := FormatDateTime('yyyymmdd_hhnnsszzz', Now) + '_' + IntToStr(Random(1000));
    fImagePath := ExtractFilePath(Application.ExeName) + 'QrCode\' + TimeStamp + '.bmp';

    // 确保目录存在
    if not DirectoryExists(ExtractFilePath(fImagePath)) then
      ForceDirectories(ExtractFilePath(fImagePath));

    Makebar(pchar(Txt), Length(Txt), 3, 3, 0, PChar(fImagePath), 3);

    Result := fImagePath; // 返回生成的文件路径
  except
    on E: Exception do
    begin
      application.MessageBox(PChar('条形码生成失败：' + E.Message), '错误', MB_ICONERROR);
    end;
  end;
end;

end.