Modern software design

Thursday, February 16, 2012

Krento 2.1.672.13 released

Krento 2.1.672.13 released and available for download from http://users.telenet.be/serhiy.perevoznyk/krento.html

Reduced CPU usage during the circle rotation
Added compatibility with Narrator for partially sighted people
Fixed bug with the drawing of the complex skins
Implemented smooth kinematic turning of the circle
Central button shows now the list of the available rings for fast ring selection
Windows + Z shows the ring selection even when Krento is not visible
Added configuration parameter for the default number of the empty stones when creating the new circle. You can select the appropriate number or set it to 0 if you want to create an ampty circles always
Added parameter to specify the name of the default circle (like the home page of the browser). The home button can be used to navigate to the default circle
The ico files can be used for stones images

Monday, February 13, 2012

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.

Thursday, February 02, 2012

Krento Screen Saver

Some time ago I received the request for Krento Screen Saver from one of the Krento fans and finally found free time to implement it. You can download freeware Krento Screen Saver from my site: http://users.telenet.be/ws36637/download/KrentoSaverSetup.exe

Friday, January 27, 2012

Krento Chrome Window Skin

Stan Ragets designed a new skin for Krento:

This skin is available for download from his website: http://blog.stanragets.com/2012/01/18/chrome-window-krento-skin

Thursday, January 05, 2012

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.

Quricol Delphi sample

program QuricolDemo;



{$APPTYPE CONSOLE}



uses

  SysUtils,

  Graphics,

  Classes,

  QuricolCodeAnsi in 'QuricolCodeAnsi.pas';



var

  bmp : TBitmap;

  MS : TMemoryStream;

begin

  try

    //Generate Windows bitmap and save to file

    TQRCode.GenerateBitmap('delphi1.bmp', 'http://delphi32.blogspot.com');



    //Generate PNG image and save to file

    TQRCode.GeneratePng('delphi1.png', 'http://delphi32.blogspot.com');



    //Generate TBitmap

    bmp := TQRCode.GetBitmap('http://www.krento.net');

    bmp.SaveToFile('delphi2.bmp');



    //Generate PNG to the memory stream

    MS := TMemoryStream.Create;

    TQRCode.GetPng(MS, 'http://www.krento.net');

    MS.Position := 0;

    MS.SaveToFile('delphi2.png');

    MS.Free;



  except

    on E: Exception do

      Writeln(E.ClassName, ': ', E.Message);

  end;

end.

Tuesday, December 27, 2011

Happy New Year 2012

Wishing all a very Happy New Year!
May this New Year bring newly found prosperity, love, happiness and delight in your life.

Ik wens jullie een jaar vol geluk, harmonie, rust en tijd om te genieten van de fun in het leven!!!
Het allerbeste voor het komende jaar.

Sunday, December 25, 2011

Kerst 2012

De Kerstman vroeg me wat ik wou als kerstcadeau,
Ik heb niet getwijfeld, en hem gezegd,
dat het enige cadeau dat me héél erg zou plezieren is:
dat hij héél goed zorg zou dragen voor de persoon
die dit nu leest!