Update for Quricol library from Krzysztof Michalowski

Krzysztof Michalowski modified the code to load library dynamically. This allows you to run a program when there is no library. Here is the code provided to me by Krzysztof.

unit QuricolCode;



interface



uses

  Windows, SysUtils, Classes, Graphics, Dialogs;



type

  TQRCode = class

  public

    class procedure GenerateBitmap(const FileName : string; const Text : string; Margin : integer = 4; PixelSize : integer = 3);

    class procedure GeneratePng(const FileName : string; const Text : string; Margin : integer = 4; PixelSize : integer = 3);

    class function GetBitmap(const Text : string; Margin : integer = 4; PixelSize : integer = 3) : TBitmap;

    class procedure GetPng(Stream : TStream; const Text : string; Margin : integer = 4; PixelSize : integer = 3);

  end;



implementation





{ TQRCode }



class procedure TQRCode.GenerateBitmap(const FileName, Text: string; Margin,

  PixelSize: integer);

type

  TGenerateBMPWProc = procedure (fileName: PWChar; text : PWChar; margin : integer; size : integer); stdcall;

var

  dllHandle : cardinal;

  generateBMPWProc : TGenerateBMPWProc;

begin

dllHandle := LoadLibrary('quricol32.dll');

  if dllHandle <> 0 then

  begin

    try

    @generateBMPWProc := GetProcAddress(dllHandle, 'GenerateBMPW');

    if Assigned (generateBMPWProc) then

      generateBMPWProc(PWChar(FileName), PWChar(Text), Margin, PixelSize)

    else

      ShowMessage('"GenerateBMPW" procedure not found');

    finally

    FreeLibrary(dllHandle);

    end;

  end

  else

  begin

    ShowMessage('quricol32.dll not found / not loaded');

  end;

end;



class procedure TQRCode.GeneratePng(const FileName, Text: string; Margin,

  PixelSize: integer);

type

  TGeneratePNGWProc = procedure (fileName: PWChar; text : PWChar; margin : integer; size : integer); stdcall;

var

  dllHandle : cardinal;

  generatePNGWProc : TGeneratePNGWProc;

begin

dllHandle := LoadLibrary('quricol32.dll');

  if dllHandle <> 0 then

  begin

  try

    @generatePNGWProc := GetProcAddress(dllHandle, 'GeneratePNGW');

    if Assigned (generatePNGWProc) then

      generatePNGWProc(PWChar(FileName), PWChar(Text), Margin, PixelSize)

    else

      ShowMessage('"GeneratePNGW" procedure not found');

  finally

    FreeLibrary(dllHandle);

  end;

  end

  else

  begin

    ShowMessage('quricol32.dll not found / not loaded');

  end;

end;



class function TQRCode.GetBitmap(const Text: string; Margin,

  PixelSize: integer): TBitmap;

type

  TGetHBitmapW = function (text : PWChar; margin : integer; size : integer): HBITMAP; stdcall;

var

  Bmp : HBITMAP;

  DIB: TDIBSection;

  ScreenDC : THandle;

  DC : THandle;

  dllHandle : cardinal;

  GetHBitmapWFunc : TGetHBitmapW;

begin

dllHandle := LoadLibrary('quricol32.dll');

  if dllHandle <> 0 then

  begin

    try

    @GetHBitmapWFunc := GetProcAddress(dllHandle, 'GetHBitmapW');

    if Assigned (GetHBitmapWFunc) then

      Bmp := GetHBitmapWFunc(PWChar(Text), Margin, PixelSize)

    else

      ShowMessage('"GetHBitmapW" function not found');

    finally

     FreeLibrary(dllHandle);

    end;

  end

  else

  begin

    ShowMessage('quricol32.dll not found / not loaded');

  end;



  GetObject(Bmp, SizeOf(DIB), @DIB);

  Result := TBitmap.Create();

  Result.Width := DIB.dsBmih.biWidth;

  Result.Height := DIB.dsBmih.biHeight;

  Result.PixelFormat := pf32bit;

  ScreenDC := GetDC(0);

  DC := CreateCompatibleDC(ScreenDC);

  SelectObject(DC, Bmp);

  ReleaseDC(0, ScreenDC);

  BitBlt(Result.Canvas.Handle, 0, 0, Result.Width, Result.Height, DC, 0, 0, SRCCOPY);

  DeleteDC(DC);

  DeleteObject(Bmp);

end;



class procedure TQRCode.GetPng(Stream: TStream; const Text: string; Margin,

  PixelSize: integer);

type

  TGetPNGW = procedure (text : PWChar; margin : integer; size : integer; var bufSize : integer; out ppvBits : PByte); stdcall;

  TDestroyBuffer = procedure(Buffer : PByte); stdcall;

var

  size : integer;

  i : integer;

  buffer : PByte;

  ps : PByte;

  dllHandle : cardinal;

  GetPNGWProc : TGetPNGW;

  DestroyBufferProc : TDestroyBuffer;

begin

size := 0;

dllHandle := LoadLibrary('quricol32.dll');

  if dllHandle <> 0 then

  begin

  try

   @GetPNGWProc := GetProcAddress(dllHandle, 'GetPNGW');

   if Assigned (GetPNGWProc) then

     GetPNGWProc(PWChar(Text), Margin, PixelSize, size, buffer)

   else

     ShowMessage('"GetPNGW" procedure not found');



   if (size > 0) then

   begin

     ps := buffer;

     for I := 0 to size - 1 do

       begin

         Stream.Write(ps^, 1);

         inc(ps);

       end;

      @DestroyBufferProc := GetProcAddress(dllHandle, 'DestroyBuffer');

      if Assigned (DestroyBufferProc) then

      DestroyBufferProc(buffer)

       else

      ShowMessage('"DestroyBuffer" procedure not found');

   end;

  finally

   FreeLibrary(dllHandle);

  end;

  end

  else

  begin

    ShowMessage('quricol32.dll not found / not loaded');

  end;

end;



end.