//---------------------------------------------------------------------------
//
// String To ICON
//
//---------------------------------------------------------------------------
//
//  Copyright ù 2005 Ray Adams
//                     IMPORTANT NOTE:
// This software is provided 'as-is', without any express or
// implied warranty. In no event will the author be held
// liable for any damages arising from the use of this
// software.
// Permission is granted to anyone to use this software for
// any purpose, including commercial applications, and to
// alter it and redistribute it freely, subject to the
// following restrictions:
// 1. The origin of this software must not be misrepresented,
//    you must not claim that you wrote the original software.
//    If you use this software in a product, an acknowledgment
//    in the product documentation would be appreciated but is
//    not required.
// 2. Altered source versions must be plainly marked as such,
//    and must not be misrepresented as being the original
//    software.
// 3. This notice may not be removed or altered from any
//    source distribution.
unit strtoicon;

interface
uses Windows,CommCtrl;

function StringToIcon (const st : string;textcolor:dword) : HIcon;
procedure GetMaskBitmaps(hSourceBitmap:HBITMAP;clrTransparent:dword;
             var hAndMaskBitmap:HBitmap;var hXorMaskBitmap:HBitmap);
function CreateIconFromBitmap(hSourceBitmap:HBITMAP;clrTransparent:DWORD):HICON;

implementation

procedure GetMaskBitmaps(hSourceBitmap: HBITMAP;
  clrTransparent: dword; var hAndMaskBitmap, hXorMaskBitmap: HBitmap);
var dc:HDC;
    hMainDC:HDC;
    hAndMaskDC:HDC;
    hXorMaskDC:HDC;
    bm:BITMAP;
    hOldMainBitmap:HBitmap;
    hOldAndMaskBitmap:HBitmap;
    hOldXorMaskBitmap:HBitmap;
    MainBitPixel:DWORD;
    x,y:longint;
begin
        DC:=GetDC(0);
        hMainDC:=CreateCompatibleDC(DC);
        hAndMaskDC:=CreateCompatibleDC(DC);
        hXorMaskDC:=CreateCompatibleDC(DC);

        GetObject(hSourceBitmap,sizeof(BITMAP),@bm);

        hAndMaskBitmap  := CreateCompatibleBitmap(DC,bm.bmWidth,bm.bmHeight);
        hXorMaskBitmap  := CreateCompatibleBitmap(DC,bm.bmWidth,bm.bmHeight);

        hOldMainBitmap := SelectObject(hMainDC,hSourceBitmap);
        hOldAndMaskBitmap := SelectObject(hAndMaskDC,hAndMaskBitmap);
        hOldXorMaskBitmap := SelectObject(hXorMaskDC,hXorMaskBitmap);

        for x:=0 to bm.bmWidth-1 do
        begin
                for y:=0 to bm.bmHeight-1 do
                begin
                        MainBitPixel := GetPixel(hMainDC,x,y);
                        if(MainBitPixel = clrTransparent) then
                        begin
                                SetPixel(hAndMaskDC,x,y,RGB(255,255,255));
                                SetPixel(hXorMaskDC,x,y,RGB(0,0,0));
                        end
                        else
                        begin
                                SetPixel(hAndMaskDC,x,y,RGB(0,0,0));
                                SetPixel(hXorMaskDC,x,y,MainBitPixel);
                        end;
                end;
        end;

        SelectObject(hMainDC,hOldMainBitmap);
        SelectObject(hAndMaskDC,hOldAndMaskBitmap);
        SelectObject(hXorMaskDC,hOldXorMaskBitmap);

        DeleteDC(hXorMaskDC);
        DeleteDC(hAndMaskDC);
        DeleteDC(hMainDC);

        ReleaseDC(0,DC);

end;

function CreateIconFromBitmap(hSourceBitmap: HBITMAP;
  clrTransparent: DWORD): HICON;
var
    hAndMask:HBITMAP;
    hXorMask:HBITMAP;
    iconinfo:TICONINFO;
begin
        GetMaskBitmaps(hSourceBitmap,clrTransparent,hAndMask,hXorMask);
        if(hAndMask=0) or (hXorMask=0) then
        begin
             result:=0;
             exit;
        end;

        iconinfo.fIcon          := true;
        iconinfo.xHotspot       := 0;
        iconinfo.yHotspot       := 0;
        iconinfo.hbmMask        := hAndMask;
        iconinfo.hbmColor       := hXorMask;

        result := CreateIconIndirect(iconinfo);
        DeleteObject(hAndMask);
        DeleteObject(hXorMask);
end;

function StringToIcon (const st : string;textcolor:dword) : HIcon;
var bm:HBitmap;
    dc:HDC;
    hb,font:THandle;
    brush:TLogBrush;
    r:TRect;
begin
     bm:=CreateBitmap(16,16,1,32,nil);
     dc:=CreateCompatibleDC(0);
     DeleteObject(SelectObject(dc,bm));

     brush.lbColor:=$808000;
     brush.lbStyle:=BS_SOLID;
     brush.lbHatch:=0;
     hb:=CreateBrushIndirect(brush);
     DeleteObject(SelectObject(dc,hb));
     r.Left:=0;
     r.Top:=0;
     r.Right:=16;
     r.Bottom:=16;
     FillRect(dc,r,hb);
     font:=CreateFont(16,7,0,0,0,0,1,0,ANSI_CHARSET,OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, ANTIALIASED_QUALITY,
        FF_DONTCARE, 'Tahoma');
     DeleteObject(SelectObject(dc,font));
     SetTextColor(dc, textcolor);
     SetBkMode(dc, TRANSPARENT);
     TextOut(dc,0,0,PChar(st),2);

     DeleteDC(dc);
     result:=CreateIconFromBitmap(bm,$808000);
     DeleteObject(hb);
     DeleteObject(font);
     DeleteObject(bm);
end;
end.

