Мастера DELPHI, Delphi programming community Рейтинг@Mail.ru Титульная страница Поиск, карта сайта Написать письмо 
| Новости |
Новости сайта
Поиск |
Поиск по лучшим сайтам о Delphi
FAQ |
Огромная база часто задаваемых вопросов и, конечно же, ответы к ним ;)
Статьи |
Подборка статей на самые разные темы. Все о DELPHI
Книги |
Новинки книжного рынка
Новости VCL
Обзор свежих компонент со всего мира, по-русски!
|
| Форумы
Здесь вы можете задать свой вопрос и наверняка получите ответ
| ЧАТ |
Место для общения :)
Орешник
Коллекция курьезных вопросов из форумов
Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / rsdn.org

 
Чтобы не потерять эту дискуссию, сделайте закладку « предыдущая ветвь | форум | следующая ветвь »

Динамическое создание курсора


Grig ©   (09.07.20 09:24

Всем привет!

Есть функция, создающая курсор из предоставляемого ей битмапа. При этом она должна накладывать на него стандартный системный курсор, что реализовать не получается.


function TDragToolButtonObject.CreateDragCursor(Bitmap: TBitmap;
 Hotspot: TPoint; MaskColor: TColor): HCURSOR;
var
 CursorBitmap, TempBitmap: TBitmap;
 IconInfo: TIconInfo;
begin
 CursorBitmap := TBitmap.Create;
 try
   with CursorBitmap do
   begin
     if Bitmap.PixelFormat = pfDevice then
       Assign(Bitmap)
     else
     begin
       SetSize(Bitmap.Width, Bitmap.Height);
       PixelFormat := pfDevice;
       Canvas.Draw(0, 0, Bitmap);
     end;
     DrawIcon(Canvas.Handle, Hotspot.X, Hotspot.Y, LoadCursor(0, IDC_ARROW)); // (1)
     TransparentColor := MaskColor;
   end;

   with IconInfo do
   begin
     fIcon := False;
     xHotspot := Hotspot.X;
     yHotspot := Hotspot.Y;
     hbmColor := CursorBitmap.Handle;
     hbmMask := CursorBitmap.MaskHandle;
   end;
   Result := CreateIconIndirect(IconInfo);

   {
   // (2)
   CursorBitmap.SaveToFile(ExtractFilePath(Application.ExeName) + 'hbmColor.bmp');
   TempBitmap := TBitmap.Create;
   try
     TempBitmap.Handle := CursorBitmap.MaskHandle;
     TempBitmap.SaveToFile(ExtractFilePath(Application.ExeName) + 'hbmMask.bmp');
   finally
     TempBitmap.Free;
   end;
   {}

 finally
   CursorBitmap.Free;
 end;
end;


Вызов осуществляется примерно следующий образом:


   Bitmap := TBitmap.Create;
   with Bitmap.Canvas do
   begin
     Brush.Style := bsSolid;
     Brush.Color := clLime;
     FillRect(Bitmap.Canvas.ClipRect);
     Brush := Self.Brush;
     Pen.Color := clBlack;
     Rec := Rect(0, 0, Bitmap.Width div 2, Bitmap.Height div 3);
     Rectangle(Rec);
   end;

   Screen.Cursors[crDragToolButton] := CreateDragCursor(Bitmap, Point(4, 4), clLime);


Если закомментировать строку (1), то созданный курсор выглядит как предполагается. В противном случае, курсов выглядит  как  IDC_ARROW с погрешностью на  Hotspot (т.е. он действительно создается). При этом (см. блок (2)) на самом битмапе отрисовано то, что хотелось бы получить, маска битмапа тоже верна.


Grig ©   (16.07.20 16:12[1]

hbmMask и hbmColor надо все-таки делать немного иначе:

hbmMask
Устанавливает битовую маску точечного рисунка значка. Если эта структура определяет черно-белый значок, то эта битовая маска форматируется так, чтобы верхняя половина была битовая маска AND значка, а нижняя половина - битовая маска XOR значка. При этом условии, высота должна быть равняться умноженной на два. Если эта структура определяет цветной значок, то эта маска определяет только битовую маску AND значка.

hbmColor
Дескриптор цветного точечного рисунка значка. Этот член структуры может быть дополнительным, если эта структура определяет черно-белый значок. Битовая маска AND параметра hbmMask применяется с флажком SRCAND в месте назначения; позже, цветной точечный рисунок применяется (использующий XOR) в месте назначения при помощи использования флажка SRCINVERT.


Самый простой способ через ImageList:

function TDragToolButtonObject.CreateDragCursor(Bitmap: TBitmap;
 Hotspot: TPoint; MaskColor: TColor): HCURSOR;
var
 ImageList: TImageList;
 ColorBitmap, MaskBitmap: TBitmap;
 IconInfo: TIconInfo;
begin
 ImageList := TImageList.Create(nil);
 try
   ImageList.BlendColor := MaskColor;
   ImageList.Width := Bitmap.Width;
   ImageList.Height := Bitmap.Height;
   ImageList.AddMasked(Bitmap, MaskColor);

   ColorBitmap := TBitmap.Create;
   try
     ColorBitmap.Canvas.Brush.Color := clBlack;
     ColorBitmap.SetSize(Bitmap.Width, Bitmap.Height);

     MaskBitmap := TBitmap.Create;
     try
       MaskBitmap.Canvas.Brush.Color := clWhite;
       MaskBitmap.SetSize(Bitmap.Width, Bitmap.Height);

       ImageList.Draw(ColorBitmap.Canvas, 0, 0, 0, dsNormal, itImage);
       ImageList.Draw(MaskBitmap.Canvas, 0, 0, 0, dsNormal, itMask);

       with IconInfo do
       begin
         fIcon := False;
         xHotspot := Hotspot.X;
         yHotspot := Hotspot.Y;
         hbmMask := MaskBitmap.Handle;
         hbmColor := ColorBitmap.Handle;
       end;

       Result := CreateIconIndirect(IconInfo);
     finally
       MaskBitmap.Free;
     end;
   finally
     ColorBitmap.Free;
   end;
 finally
   ImageList.Free;
 end;
end;


От наложения системного курсора отказался, отрисовываю вручную. Проблема там в том, что если курсор полупрозрачный, то при его отрисовке на bitmap-е полупрозрачные пиксели смешиваются с цветом фона bitmap-а и маской их, понятно, уже не отбросить. Заморачиваться с этим не стал.


версия для печати

Написать ответ

Ваше имя (регистрация  E-mail 







Разрешается использование тегов форматирования текста:
<b>жирный</b> <i>наклонный</i> <u>подчеркнутый</u>,
а для выделения текста программ, используйте <code> ... </code>
и не забывайте закрывать теги! </b></i></u></code> :)


Наверх

  Рейтинг@Mail.ru     Титульная страница Поиск, карта сайта Написать письмо