Как сделать калькулятор в Delphi?
Delphi - объектно-ориентированный язык программирования, разработанный компанией Borland в 1995 году. Он основан на языке программирования Pascal, но имеет более расширенные возможности и добавлены новые функции.
Как Delphi реализует многоплатформенную разработку?
Delphi является интегрированной средой разработки (IDE), которая позволяет разрабатывать программное обеспечение для различных платформ, включая Windows, macOS, Android и iOS. Delphi достигает многоплатформенности с помощью...
Создание курсора с процентом выполнения
{ **** 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; ...