procedure BlendImage(bmp : Tbitmap32; color : Tcolor; alpha:integer);

var

   P           : PColor32;

   I           : integer;

   sum1,sum2   : real;

   CB,CR,CG    : Integer;

   oCB,oCR,oCG : Integer;

   nCB,nCR,nCG : Integer;

   tempAlpha   : integer;

   change      : Integer;

begin

  alpha := min(alpha,255);

  alpha := max(alpha,0);

  CR := GetRValue(colortorgb(color));

  CG := GetGValue(colortorgb(color));

  CB := GetBValue(colortorgb(color));

  sum1 := (CB+CR+CG)/3;

  with bmp do begin

    try

      P := PixelPtr[0, 0];

      for I := 0 to Width * Height - 1 do

      begin

        tempAlpha := (P^ shr 24);

        if tempAlpha <> 0 then begin

          oCR    := (P^ and $00FF0000)shr 16;

          oCG    := (P^ and $0000FF00)shr 8;

          oCB    :=  P^ and $0000FF;

          sum2   := (oCB+oCR+oCG)/3;

          change := round(sum2-sum1);

          nCR    := CR + change;

          nCG    := CG + change;

          nCB    := CB + change;

          nCR    := round((alpha/255)*nCR+((255-alpha)/255)*oCR);

          nCG    := round((alpha/255)*nCG+((255-alpha)/255)*oCG);

          nCB    := round((alpha/255)*nCB+((255-alpha)/255)*oCB);

          if nCB > 255 then nCB := 255

          else if nCB < 0 then nCB := 0;

          if nCR > 255 then nCR := 255

          else if nCR < 0 then nCR := 0;

          if nCG > 255 then nCG := 255

          else if nCG < 0 then nCG := 0;

          P^ := color32(nCR,nCG,nCB,tempAlpha);

        end;

        Inc(P); // proceed to the next pixel

      end;

    finally

    end;

  end;

end;

function LoadPng(Bmp : TBitmap32; IconFile:string) : boolean;

var

   ADIB : TBitmap32;

   i, j: integer;

   P: PColor32;

   A: PByte;

   ABmp: TBitmap;

   APng: TPngObject;

   Canvas: TCanvas;

begin

     result := False;

     APng := TPngObject.Create;

     ABmp := TBitmap.Create;

     ADib := TBitmap32.Create;

     try

        // Load and assign to the a bitmap

        APng.LoadFromfile(IconFile);

        APng.AssignTo(ABmp);

 

        // We now *draw* the bitmap to our bitmap.. this will clear alpha in places

        // where drawn.. so we can use it later

        ADib.SetSize(APng.Width, APng.Height);

        ADib.Clear(clBlack32);

        Canvas := TCanvas.Create;

        try

           Canvas.Handle := ADib.Handle;

           Canvas.Draw(0,0,ABmp);

        finally

               Canvas.Free;

        end;

 

     // Flip the alpha channel

     P := @ADib.Bits[0];

     for i := 0 to ADib.Width * ADib.Height - 1 do

     begin

          P^ := P^ XOR $FF000000;

          inc(P);

     end;

 

     // The previous doesn't handle bitwise alpha info, so we do that here

     for i := 0 to APng.Height - 1 do

     begin

          A := PByte(APng.AlphaScanLine[i]);

          if assigned(A) then

          begin

               P := @ADib.Bits[i * ADib.Width];

               for j := 0 to APng.Width - 1 do

               begin

                    P^ := SetAlpha(P^, A^);

                    inc(P); inc(A);

               end;

          end else break;

     end;

 

     finally

            result := True;

 

            APng.Free;

            ABmp.Free;

            Bmp := ADib;

            Bmp.DrawMode := dmBlend;

     end;

end;

procedure IconToImage(Bmp : TBitmap32; const icon : hicon);

var

   w,h,i    : Integer;

   p        : PColorArray;

   p2       : pColor32;

   bmi      : BITMAPINFO;

   AlphaBmp : Tbitmap32;

   tempbmp  : Tbitmap;

   info     : Ticoninfo;

   dc       : hdc;

   alphaUsed : boolean;

begin

     Alphabmp := nil;

     tempbmp := Tbitmap.Create;

     dc := createcompatibledc(0);

     try

        //get info about icon

        GetIconInfo(icon,info);

        tempbmp.handle := info.hbmColor;

        ///////////////////////////////////////////////////////

        // Here comes a ugly step were it tries to paint it as

        // a 32 bit icon and check if it is successful.

        // If failed it will paint it as an icon with fewer colors.

        // No way of deciding bitcount in the beginning has been

        // found reliable , try if you want too.   /Malx

        ///////////////////////////////////////////////////////

        AlphaUsed := false;

        if true then

        begin //32-bit icon with alpha

              w := tempbmp.Width;

              h := tempbmp.Height;

              Bmp.setsize(w,h);

              with bmi.bmiHeader do

              begin

                   biSize := SizeOf(bmi.bmiHeader);

                   biWidth := w;

                   biHeight := -h;

                   biPlanes := 1;

                   biBitCount := 32;

                   biCompression := BI_RGB;

                   biSizeImage := 0;

                   biXPelsPerMeter := 1; //dont care

                   biYPelsPerMeter := 1; //dont care

                   biClrUsed := 0;

                   biClrImportant := 0;

              end;

              GetMem(p,w*h*SizeOf(TColorRec));

              GetDIBits(tempbmp.Canvas.Handle,tempbmp.Handle,0,h,p,bmi,DIB_RGB_COLORS);

              P2 := Bmp.PixelPtr[0, 0];

              for i := 0 to w*h-1 do

              begin

                   if (p[i].a > 0) then alphaused := true;

                   P2^ := color32(p[i].r,p[i].g,p[i].b,p[i].a);

                   Inc(P2);// proceed to the next pixel

              end;

              FreeMem(p);

        end;

        if not(alphaused) then

        begin // 24,16,8,4,2 bit icons

              Bmp.Assign(tempbmp);

              AlphaBmp := Tbitmap32.Create;

              tempbmp.handle := info.hbmMask;

              AlphaBmp.Assign(tempbmp);

              Invert(AlphaBmp,AlphaBmp);

              Intensitytoalpha(Bmp,AlphaBmp);

        end;

     finally

            DeleteDC(dc);

            AlphaBmp.free;

            tempbmp.free;

     end;

end;

            DeleteObject(info.hbmMask);

            DeleteObject(info.hbmColor);

     finally

            DeleteDC(dc);

            AlphaBmp.free;

            tempbmp.free;

            DeleteObject(info.hbmMask);  // WICHTIG

            DeleteObject(info.hbmColor); //  WICHTIG

     end;