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.
Modern Software Design 