Создание курсора с процентом выполнения

Delphi , ОС и Железо , Мышка и Курсор

Автор: Роман Василенко
WEB-сайт: http://delphibase.endimus.com

{ **** UBPFD *********** by delphibase.endimus.com ****
>> 
Функция возвращает хэндл на созданный курсор Windows (hcursor, hicon)
с процентным соотношением, указанным в min,max и pos.
Своего рода ProgressBar, но только зашитый в курсор.

Зависимости: Windows, SysUtils, Graphics, Classes
Автор:       Роман Василенко, romix@nm.ru, Пятигорск
Copyright:   Василенко Роман
Дата:        07 мая 2002 г.
***************************************************** }

//Используемые модули
uses Windows, SysUtils, Graphics, Classes;

//Сама функция

function create_prc_cursor(min, max, pos: integer): hicon;
var
  cwidth, cheight: integer;
  ii: iconinfo;
  bmc, bmm: tbitmap;
  icon: hicon;
  tw: integer;
  tx: string;

  function int_percent(umin, umax, upos, uabs: integer): integer;
  begin
    result := 0;
    if umax < umin then
      exit;
    if upos < umin then
      exit;
    if upos > umax then
    begin
      result := 100;
      exit;
    end;
    if (umin = upos) and (umax = upos) then
    begin
      result := 100;
      exit;
    end;
    result := round((upos - umin) / ((umax - umin) / uabs));
  end;

  function create_curspace: tbitmap;
  begin
    result := tbitmap.create;
    result.pixelformat := pf4bit;
    result.width := cwidth;
    result.height := cheight;
  end;

begin
  cwidth := getsystemmetrics(sm_cxcursor);
  cheight := getsystemmetrics(sm_cycursor);
  bmc := create_curspace;
  bmm := create_curspace;
  with bmm.Canvas do
  begin
    brush.color := clwhite;
    FillRect(rect(0, 0, bmm.width, bmm.height));
    brush.color := clblack;
    fillrect(rect(0, bmm.height - 8, bmm.width, bmm.height));
    brush.color := clwhite;
    framerect(rect(0, bmm.height - 8, bmm.width, bmm.height));
  end;
  with bmc.canvas do
  begin
    brush.color := clblack;
    FillRect(rect(0, 0, bmc.width, bmc.height));
    brush.color := clwhite;
    fillrect(rect(1 + int_percent(min, max, pos, bmc.width - 2), bmm.height - 7,
      bmc.width - 1, bmc.height - 1));
    brush.color := clwhite;
    framerect(rect(0, bmc.height - 8, bmc.width, bmc.height));
  end;
  tx := inttostr(int_percent(min, max, pos, 100)) + '%';
  with bmm.canvas do
  begin
    font.Size := 8;
    font.style := [fsbold];
    font.color := clwhite;
    brush.color := clwhite;
    tw := textwidth(tx);
    textout((cwidth - tw) div 2, 8, tx);
  end;
  with bmc.canvas do
  begin
    font.Size := 8;
    font.style := [fsbold];
    font.color := clwhite;
    brush.color := clblack;
    textout((cwidth - tw) div 2, 8, tx);
  end;

  ii.fIcon := false;
  ii.hbmColor := bmc.Handle;
  ii.hbmMask := bmm.handle;
  ii.xHotspot := 0;
  ii.yHotspot := 0;
  icon := createiconindirect(ii);
  result := copyicon(icon);
  destroyicon(icon);
  bmc.free;
  bmm.Free;
end;

Пример использования:

...
screen.cursors[1] := create_prc_cursor(0, 100, 25);
screen.cursor := crnone;
screen.cursor := 1;
...

Привет! Я перевёл текст о коде на языке Delphi, который создает пользовательский курсор с функцией прогресс-бара.

Код create_prd_cursor принимает три параметра: min, max и pos, которые представляют собой минимальную, максимальную и текущие позиции прогресс-бара соответственно.

Вот шаг за шагом, что код делает:

1. Он рассчитывает ширину и высоту курсора на основе системных метрик.
2. Он создает два объекта TBitmap (bmc и bmm) с рассчитанными размерами и initializes их формат пикселей в 4-битном грейскейле.
3. Он настраивает канвас для каждого объекта TBitmap:
   • Для bmm, он заполняет всю область белым, затем рисует черный прямоугольник внизу и finally outlines the rectangle with white.
   • Для bmc, он заполняет всю область черным, затем рисует белый прямоугольник, представляющий прогресс-бар, and finally outlines the rectangle with white.
4. Он рассчитывает позицию прогресс-бара в bmc bitmap с помощью функции int_percent, которая возвращает целочисленное значение между 0 и 100, представляющее процент выполнения.
5. Он использует рассчитанную позицию для рисования прогресс-бара в bmc bitmap.
6. Он создает строковое представление текущего процента выполнения (tx) и рисует его на обоих битмапах с помощью функции textout.
7. Он создает структуру IconInfo (ii) с информацией о пользовательском курсоре, включая bmc и bmm bitmaps как иконки цвета и маски соответственно.
8. Он создает новый икон из структуры IconInfo и копирует его для создания отдельного handle для курсора.
9. Наконец, он освобождает временные объекты TBitmap и возвращает handle созданного курсора.

Пример использования показывает, как присвоить этот пользовательский курсор экрану с помощью выражения screen.cursors[1] := create_prd_cursor(0, 100, 25) и затем отображать курсор с помощью выражений screen.cursor := crnone; и screen.cursor := 1;.

В целом, этот код предоставляет простой способ создания пользовательского курсора с функцией прогресс-бара в Delphi.

Создается курсор Windows с процентным соотношением выполнения, который может быть использован в программировании.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: Мышка и Курсор ::