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.