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.
Advertisements

6 thoughts on “Update for Quricol library from Krzysztof Michalowski

  1. Thank you for these very useful postings. I happened to notice a memory leak but only when when the call to GetBitmap is made and in tracking that down, it appears that it just needs a Result.free after DeleteObject(Bmp)line.

    Like

  2. I spoke too soon regarding Result.free as that leads to an exception and it may have something to do with something on my end, but am still seeing a memory leak in GetBitmap. It isn't something critical since I'm not planning to use that particular routine. Thanks again.

    Like

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s