Прозрачный курсор показывает неправильный цвет в Delphi

Я хочу нарисовать собственный полупрозрачный курсор, который представляет собой белый круг. Я использую Delphi XE3 в ОС Windows 7.

Мой код работает в некоторой степени. Я могу установить альфа-канал и изменить прозрачность, но цвет - серебристый / темно-серый, а не белый.

Когда я запускаю отладку, я вижу, что устанавливается правильный белый ($B4FFFFFF), где $ B4 - это альфа-значение.

Я адаптировал свой код из этой предыдущей темы

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;

Примечание. Для компиляции вышеупомянутого необходимо добавить единицу "Math" в предложение "users".

Пожалуйста, смотрите прикрепленное изображение

В этом конкретном случае результирующий цвет курсора (часть над белым цветом изображения) составляет $xxCACACA

Я также пробовал другие цвета, кроме белого. Результаты похожи - цвета становятся "затемненными"

Если я установлю альфа-канал на отсутствие прозрачности, то я получу белый курсор, как и предполагалось (но, конечно, он больше не прозрачен).

Я предполагаю, что то, что я вижу, является результатом белого цвета курсора, смешанного дважды:

  1. Смешивание с черным / темным фоном (возможно, маска AND?)

  2. Смешивание с изображением экрана.

Но это только предположение, и я не могу понять, куда идти дальше. Может кто-нибудь помочь, пожалуйста?


Обновление относительно

FCursorColorBMP.AlphaFormat := afDefined;

Когда приведенная выше строка находится в коде, я получаю следующие результаты

Если взять значения цвета (используя MS paint), курсор пересекается с разными цветами, получая эти значения (RGB):

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

Если я пропущу упомянутую строку или изменим ее на

FCursorColorBMP.AlphaFormat := afIgnored;

Тогда я получаю это изображение

Когда я беру цвета, я получаю следующие значения:

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

Увидев ответ Тома Брунберга, я подумал, что сделаю исполняемый файл и запустю его на другом компьютере. Результаты были хорошими и соответствовали результатам Тома.

Итак, в заключение, Alphaformat должен быть установлен в AfIgnored (или опущена строка), что технически решает проблему в некоторых системах.

Однако по какой-то причине моя система по-прежнему отображает неправильный цвет! Мой Win7 работает практически через Parallels в Mac OS - не знаю, является ли это причиной странного поведения.

1 ответ

Решение

Применяя ваш код как есть, я получаю следующий результат:

Однако если я изменю

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

Я получил:

поскольку afIgnored это значение по умолчанию, вы можете просто пропустить строку, как предложил Sertac Akyuz в своем комментарии.

Если вы чувствуете, что белый цвет слишком непрозрачен, уменьшите значение альфа.


Изменить, дополнительная информация:

Хотя я не нашел никакой документации для этого, я очень уверен, что Windows использует альфа-значения при рендеринге курсоров, и поэтому растровое изображение не должно быть предварительно рассчитано. Чтобы подкрепить свои мысли, я сделал следующую проверку с несколькими цветами чистого красного, зеленого и темно-синего:

Общая формула для альфа-смешивания

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

и рассчитывается отдельно для красного, зеленого и синего компонентов.

Используя наложение белого и альфа-значение, как указано выше (A:B4, R:FF, G:FF, B:FF)цветовые компоненты наложения

 - 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. 

Выше значения были взяты с помощью "пипетки" программы редактирования графики.

Значения такие же, как и рассчитанные с

  // 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;

где

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

а также

  // 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;

Предварительный расчет производится при настройке bitmap.AlphaFormat вновь созданного растрового изображения либо afDefined или же afPremultiplied (по умолчанию afIgnored). (увидеть procedure TBitmap.SetAlphaFormat(Value: TAlphaFormat); в Vcl.Graphics)

Другие вопросы по тегам