ANSI version of the Quricol Delphi library

Last year I published the Quricol library for Delphi 2010 or better, but some users still need the support for older Delphi versions. As a result I made an update to Quricol library with support not only the Unicode, but also ANSI Delphi code.

//===============================================================================
// Copyright (c) Serhiy Perevoznyk. All rights reserved.

// THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY

// OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING BUT NOT

// LIMITED TO THE IMPLIED WARRANTIES OF MERCHANTABILITY AND

// FITNESS FOR A PARTICULAR PURPOSE.

//===============================================================================

unit QuricolCodeAnsi;

interface

uses

Windows, SysUtils, Classes, Graphics;

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

procedure GeneratePNGA(fileName: PChar; text : PChar; margin : integer; size : integer); stdcall; external 'quricol32.dll';

function GetHBitmapA(text : PChar; margin : integer; size : integer) : HBITMAP; stdcall; external 'quricol32.dll';

procedure GenerateBMPA(fileName: PChar; text : PChar; margin : integer; size : integer); stdcall; external 'quricol32.dll';

procedure GetPNGA(text : PChar; margin : integer; size : integer; var bufSize : integer; out ppvBits : PByte); stdcall; external 'quricol32.dll';

procedure DestroyBuffer(Buffer : PByte); stdcall; external 'quricol32.dll';

{ TQRCode }

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

PixelSize: integer);

begin

GenerateBMPA(PChar(FileName), PChar(Text), Margin, PixelSize);

end;

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

PixelSize: integer);

begin

GeneratePNGA(PChar(FileName), PChar(Text), Margin, PixelSize);

end;

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

PixelSize: integer): TBitmap;

var

Bmp : HBITMAP;

DIB: TDIBSection;

ScreenDC : THandle;

DC : THandle;

begin

Bmp := GetHBitmapA(PChar(Text), Margin, PixelSize);

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);

var

size : integer;

i : integer;

buffer : PByte;

ps : PByte;

begin

size := 0;

GetPNGA(PChar(Text), Margin, PixelSize, size, buffer);

if (size > 0) then

begin

ps := buffer;

for I := 0 to size - 1 do

begin

Stream.Write(ps^, 1);

inc(ps);

end;

DestroyBuffer(buffer);

end;

end;

end.
Advertisements

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