Search code examples
delphiwinapibitmapcursordelphi-xe3

Transparent cursor shows wrong color in Delphi

I want to draw a custom semi-transparent cursor that is a white circle. I am using Delphi XE3 in Windows 7 OS.

My code is working to some extent. I can set the alpha channel and modify the transparency, but the color is silver/dark gray rather than white.

When I run debugging, I can see the correct white ($B4FFFFFF) is being set, where $B4 is the alpha value.

I have adapted my code from this previous subject

type
pScanLineArray = ^TScanLineArray;
TScanLineArray= array [Word] of Cardinal;

procedure TForm1.Button1Click(Sender: TObject);
  const CursorIdx = TCursor(-25); {arbitrary}
        Mid = 64; {middle of cursor dimension (128)}
        FPenSize = 50;
  var IconInfo : TIconInfo;
      X, Y: Integer;
      AlphaCursor: HCURSOR;
      ForG, BackG, Border: Cardinal;
      Dist: Double;
      LineP: pScanLineArray;
      FCursorMaskBMP,FCursorColorBMP: TBitmap;
begin
  {Create Bitmaps}
  FCursorMaskBMP:= TBitMap.Create;
  FCursorMaskBMP.PixelFormat:= pf32bit;
  FCursorMaskBMP.SetSize(128, 128);

  FCursorColorBMP:= TBitMap.Create;
  FCursorColorBMP.PixelFormat:= pf32bit;
  FCursorColorBMP.SetSize(128, 128);


  {Fill the AND mask. In this case, content ignored by windows}
  FCursorMaskBMP.Monochrome := True;
  FCursorMaskBMP.Canvas.Brush.Color := clWhite;
  FCursorMaskBMP.Canvas.FillRect(FCursorMaskBMP.Canvas.ClipRect);

  {Set all the colors for the cursor}
  ForG:= $B4FFFFFF; {semi-transarent white - for inside of circle}
  BackG:= $00000000; {Full transparent - for outside of circle}
  Border:= $FF000000; {non-transparent black for border}

  {Fill the bitmap}
  for Y := 0 to (FCursorColorBMP.Height - 1) do
  begin
    LineP := FCursorColorBMP.ScanLine[Y];
    for X := 0 to (FCursorColorBMP.Width - 1)do
    begin
      Dist:= SQRT(Power(Y-Mid,2)+Power(X-Mid,2)); {Distance from middle of circle}
      if Dist<FPenSize then  {Within circle - apply forground trasparent color}
        LineP^[X] := ForG
      else
        if (Dist>=FPenSize) and (Dist<FPenSize+1) then
          LineP^[X] := Border {This is the border - apply opaque color of border}
        else
          LineP^[X] := BackG; {Outside circle - apply fully transparent color }
    end;
  end;

  FCursorColorBMP.AlphaFormat := afDefined;  {does not seem to have any effect ?}

  with IconInfo do
  begin
    fIcon := false;
    xHotspot := Mid;
    yHotspot := Mid;
    hbmMask := FCursorMaskBMP.Handle;
    hbmColor := FCursorColorBMP.Handle;
  end;

  AlphaCursor:=CreateIconIndirect(IconInfo);
  Win32Check(Bool(AlphaCursor));   {My guess is that this is some error checking ?}
  Screen.Cursors[CursorIdx] := AlphaCursor;
  Screen.Cursor := CursorIdx;

end;

Note: To compile the above, unit "Math" must be added to the "uses" clause

Please see the attached Imageenter image description here

In this particular case the resulting color of the cursor (the part above the white of the image) is $xxCACACA

I also tried other colors than white. The results are similar - the colors getting "darkened"

If I set the alpha channel to no-transparency, then I get a white cursor as intended (but ofcourse no longer transparent).

My guess is that what I see is the result of the white color of the cursor being blended twice:

  1. A blending with a black/dark background (perhaps the AND mask ?)

  2. A blending with the screen image.

But this is only a guess, and I cant figure out where to go from here. Can anyone help please ?

Update regarding 

FCursorColorBMP.AlphaFormat := afDefined;

When the above line is in the code, I get the following results

enter image description here

If grab the color values (using MS paint) the cursor overlap with the different colors yield these values (RGB):

white overlap: 164, 164, 164
Red overlap  : 157, 97,  100
Green overlap: 89,  127, 89
Blue overlap : 89,  89,  164

If I ommit the mentioned line or change it to 

FCursorColorBMP.AlphaFormat := afIgnored;

Then I get this image

enter image description here

When I grab the colors, I get the following values:

white overlap: 202, 202, 202
Red overlap  : 197, 135, 138
Green overlap: 127, 165, 127
Blue overlap : 127, 127, 202

After seeing Tom Brunberg's answer, I thought I will make an exe file and run it on a different machine. The results were good and concordant with Tom's results.

So in conclusion, Alphaformat should be set to AfIgnored (or line ommited), which technically solves the problem on some systems.

For some reason, my system still displays the wrong color, however ! My Win7 runs virtually via Parallels on Mac OS - don't know if this is the reason for the strange behaviour.

Solution

  • When applying your code as is, I get the following result:

    enter image description here

    If however, I change 

    FCursorColorBMP.AlphaFormat := afIgnored;  {does not seem to have any effect ?}

    I get:

    enter image description here

    Since afIgnored is the default value, you can simply omit the line, as Sertac Akyuz suggested in his comment.

    If you feel the white is too opaque, reduce the alpha value.

    Edit, further information:

    Although I did not find any documentation for it, I am very confident that Windows uses the alpha values while rendering cursors , and therefore the bitmap shall not be precalculated. To backup my thoughts I did the following check with a few colors of pure red, green and darkblue:

    enter image description here

    The general formula for alpha blending is

      output = alpha * foreground + (1-alpha) * background

    and it is calculated separately for the red, green and blue components.

    Using the white overlay and alpha value as above (A:B4, R:FF, G:FF, B:FF) the color components of the overlaid 

     - red field   (R:FF, G:0,  B:0)  becomes R:FF, G:B4, B:B4.
 - green field (R:0,  G:BF, B:0)  becomes R:B4, G:EC, B:B4. 
 - blue field  (R:0,  G:0,  B:7F) becomes R:B4, G:B4, B:D9.

    Above values were taken with an "eyedropper" of a graphics editing program.

    The values are the same as calculated with 

      // Result color components
  resR := a * fgR div $FF + ($FF - a) * bgR div $FF;
  resG := a * fgG div $FF + ($FF - a) * bgG div $FF;
  resB := a * fgB div $FF + ($FF - a) * bgB div $FF;

    where

      // overlay alpha
  a := $B4;
  // overlay color components
  fgR := $FF;
  fgG := $FF;
  fgB := $FF;

    and

      // background color components for the red field
  bgR := $FF;
  bgG := $0;
  bgB := $0;
  // background color components for the green field
  bgR := $0;
  bgG := $BF;
  bgB := $0;
  // background color components for the dark blue field
  bgR := $0;
  bgG := $0;
  bgB := $7F;

    Precalculation is performed when setting bitmap.AlphaFormat of a newly created bitmap to either afDefined or afPremultiplied (default is afIgnored). (see procedure TBitmap.SetAlphaFormat(Value: TAlphaFormat); in Vcl.Graphics)