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

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

{ **** 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;
...

Другое по теме:

Категории

Статьи

Советы

Copyright © 2022 - All Rights Reserved - www.delphirus.com