$385.75


$22.36


$14.79


Расширяем возможности кнопок в Delphi

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

Пример тестировался под winnt, sp5 и win95, sp1.

Также можно создать до 4-х изображений для индикации состояния кнопки

+------+------+-----+------+ ^
|Курсор|Курсор|нажа-|недос-| |
|на кно|за пре| та |тупна | Высота
| пке |делами| | | |
+------+------+-----+------+ v

Вы так же можете присвоить кнопке текстовый заголовок. Можно расположить текст и изображение в любом месте кнопки. Для этого в пример добавлены четыре свойства:


texttop и textleft, Для расположения текста заголовка на кнопке,
и:
glyphtop и glyphleft, Для расположения glyph на кнопке.

Текст заголовка прорисовывается после изображения, потому что они используют одно пространство кнопки, и соответственно заголовок прорисуется поверх изображения. Бэкграунд текста сделан прозрачным. Соответственно мы увидим только текстовые символы поверх изображения.

Найденные баги
----------
1) Если двигать мышку очень быстро, то кнопка может не вернуться в исходное состояние

2) Если кнопка находится в запрещённом состоянии, то при нажатии на неё, будет наблюдаться неприятное мерцание.

Совместимость: delphi 5.x (или выше)

Собственно сам исходничек:

unit newbutton;

interface

uses
windows, messages, sysutils, classes, graphics, controls,
forms, dialogs;

const
fshift = 2; // Изменяем изображение и заголовок , когда кнопка нажата.
fhicolor = $dddddd; // Цвет нажатой кнопки (светло серый)
// windows создаёт этот цвет путём смешивания пикселей clsilver и clwhite (50%).
// такой цвет хорошо выделяет нажатую и отпущенную кнопки.

type
tnewbutton = class(tcustomcontrol)
private
{ private declarations }
fmouseover,fmousedown : boolean;
fenabled : boolean;
// То же, что и всех компонент
fglyph : tpicture;
// То же, что и в speedbutton
fglyphtop,fglyphleft : integer;
// Верх и лево glyph на изображении кнопки
ftexttop,ftextleft : integer;
// Верх и лево текста на изображении кнопки
fnumglyphs : integer;
// То же, что и в speedbutton
fcaption : string;
// Текст на кнопке
ffacecolor : tcolor;
// Цвет изображения (да-да, вы можете задавать цвет изображения кнопки

procedure floadglyph(g : tpicture);
procedure fsetglyphleft(i : integer);
procedure fsetglyphtop(i : integer);
procedure fsetcaption(s : string);
procedure fsettexttop(i : integer);
procedure fsettextleft(i : integer);
procedure fsetfacecolor(c : tcolor);
procedure fsetnumglyphs(i : integer);
procedure fsetenabled(b : boolean);

protected
{ protected declarations }
procedure paint; override;
procedure mousedown(button: tmousebutton; shift: tshiftstate;
x, y: integer); override;
procedure mouseup(button: tmousebutton; shift: tshiftstate;
x, y: integer); override;
procedure wndproc( var message : tmessage); override;
// Таким способом компонент определяет — находится ли курсор мышки на нём или нет
// Если курсор за пределами кнопки, то она всё равно продолжает принимать сообщения мышки.
// Так же кнопка будет принимать сообщения, если на родительском окне нет фокуса.

public
{ public declarations }
constructor create(aowner : tcomponent); override;
destructor destroy; override;

published
{ published declarations }
{----- properties -----}
property action;
// property allowup не поддерживается
property anchors;
property bidimode;
property caption : string
read fcaption write fsetcaption;
property constraints;
property cursor;
// property down не поддерживается
property enabled : boolean
read fenabled write fsetenabled;
// property flat не поддерживается
property facecolor : tcolor
read ffacecolor write fsetfacecolor;
property font;
property glyph : tpicture // Такой способ позволяет получить серую кнопку, которая сможет
// находиться в трёх положениях.
// После нажатия на кнопку, с помощью редактора картинок delphi
// можно будет создать картинки для всех положений кнопки..
read fglyph write floadglyph;
// property groupindex не поддерживается
property glyphleft : integer
read fglyphleft write fsetglyphleft;
property glyphtop : integer
read fglyphtop write fsetglyphtop;
property height;
property hint;
// property layout не поддерживается
property left;
// property margin не поддерживается
property name;
property numglyphs : integer
read fnumglyphs write fsetnumglyphs;
property parentbidimode;
property parentfont;
property parentshowhint;
// property popmenu не поддерживается
property showhint;
// property spacing не поддерживается
property tag;
property textleft : integer
read ftextleft write fsettextleft;
property texttop : integer
read ftexttop write fsettexttop;

property top;
// property transparent не поддерживается
property visible;
property width;
{--- События ---}
property onclick;
property ondblclick;
property onmousedown;
property onmousemove;
property onmouseup;
end;

procedure register; // hello

implementation

{--------------------------------------------------------------------}
procedure tnewbutton.fsetenabled(b : boolean);

begin
if b <> fenabled then
begin
fenabled := b;
invalidate;
end;
end;
{--------------------------------------------------------------------}
procedure tnewbutton.fsetnumglyphs(i : integer);

begin
if i > 0 then
if i <> fnumglyphs then
begin
fnumglyphs := i;
invalidate;
end;
end;
{--------------------------------------------------------------------}
procedure tnewbutton.fsetfacecolor(c : tcolor);

begin
if c <> ffacecolor then
begin
ffacecolor := c;
invalidate;
end;
end;
{--------------------------------------------------------------------}
procedure tnewbutton.fsettexttop(i : integer);

begin
if i >= 0 then
if i <> ftexttop then
begin
ftexttop := i;
invalidate;
end;
end;
{--------------------------------------------------------------------}
procedure tnewbutton.fsettextleft(i : integer);

begin
if i >= 0 then
if i <> ftextleft then
begin
ftextleft := i;
invalidate;
end;
end;
{--------------------------------------------------------------------}
procedure tnewbutton.fsetcaption(s : string);

begin
if (fcaption <> s) then
begin
fcaption := s;
settextbuf(pchar(s));
invalidate;
end;
end;
{--------------------------------------------------------------------}
procedure tnewbutton.fsetglyphleft(i : integer);

begin
if i <> fglyphleft then
if i >= 0 then
begin
fglyphleft := i;
invalidate;
end;
end;
{--------------------------------------------------------------------}
procedure tnewbutton.fsetglyphtop(i : integer);

begin
if i <> fglyphtop then
if i >= 0 then
begin
fglyphtop := i;
invalidate;
end;
end;
{--------------------------------------------------------------------}
procedure tnewbutton.floadglyph(g : tpicture);

var
i : integer;

begin
fglyph.assign(g);
if fglyph.height > 0 then
begin
i := fglyph.width div fglyph.height;
if i <> fnumglyphs then
fnumglyphs := i;
end;
invalidate;
end;
{--------------------------------------------------------------------}
procedure register; // hello

begin
registercomponents(«samples», [tnewbutton]);
end;
{--------------------------------------------------------------------}
constructor tnewbutton.create(aowner : tcomponent);

begin
inherited create(aowner);
{ Инициализируем переменные }
height := 37;
width := 37;
fmouseover := false;
fglyph := tpicture.create;
fmousedown := false;
fglyphleft := 2;
fglyphtop := 2;
ftextleft := 2;
ftexttop := 2;
ffacecolor := clbtnface;
fnumglyphs := 1;
fenabled := true;
end;
{--------------------------------------------------------------------}
destructor tnewbutton.destroy;

begin
if assigned(fglyph) then
fglyph.free; // Освобождаем glyph
inherited destroy;
end;
{--------------------------------------------------------------------}
procedure tnewbutton.paint;

var
fbtncolor,fcolor1,fcolor2,
ftransparentcolor : tcolor;
buffer : array[0..127] of char;
i,j : integer;
x0,x1,x2,x3,x4,y0 : integer;
destrect : trect;
tempglyph : tpicture;

begin
x0 := 0;
x1 := fglyph.width div fnumglyphs;
x2 := x1 + x1;
x3 := x2 + x1;
x4 := x3 + x1;
y0 := fglyph.height;
tempglyph := tpicture.create;
tempglyph.bitmap.width := x1;
tempglyph.bitmap.height := y0;
destrect := rect(0,0,x1,y0);

gettextbuf(buffer,sizeof(buffer)); // получаем caption
if buffer <> «» then
fcaption := buffer;

if fenabled = false then
fmousedown := false; // если недоступна, значит и не нажата

if fmousedown then
begin
fbtncolor := fhicolor; // Цвет нажатой кнопки
fcolor1 := clwhite; // Правая и нижняя окантовка кнопки, когда на неё нажали мышкой.
fcolor2 := clblack; // Верхняя и левая окантовка кнопки, когда на неё нажали мышкой.
end
else
begin
fbtncolor := ffacecolor; // ffacecolor мы сами определяем
fcolor2 := clwhite; // Цвет левого и верхнего края кнопки, когда на неё находится курсор мышки
fcolor1 := clgray; // Цвет правого и нижнего края кнопки, когда на неё находится курсор мышки
end;

// Рисуем лицо кнопки :)
canvas.brush.color := fbtncolor;
canvas.fillrect(rect(1,1,width — 2,height — 2));

if fmouseover then
begin
canvas.moveto(width,0);
canvas.pen.color := fcolor2;
canvas.lineto(0,0);
canvas.lineto(0,height — 1);
canvas.pen.color := fcolor1;
canvas.lineto(width — 1,height — 1);
canvas.lineto(width — 1, — 1);
end;

if assigned(fglyph) then // bitmap загружен?
begin
if fenabled then // Кнопка разрешена?
begin
if fmousedown then // Мышка нажата?
begin
// mouse down on the button so show glyph 3 on the face
if (fnumglyphs >= 3) then
tempglyph.bitmap.canvas.copyrect(destrect,
fglyph.bitmap.canvas,rect(x2,0,x3,y0));

if (fnumglyphs 1) then
tempglyph.bitmap.canvas.copyrect(destrect,
fglyph.bitmap.canvas,rect(x0,0,x1,y0));

if (fnumglyphs = 1) then
tempglyph.assign(fglyph);

// Извините, лучшего способа не придумал...
// glyph.bitmap.Прозрачность цвета не работает, если Вы выберете в качестве
// прозрачного цвета clwhite...
ftransparentcolor := tempglyph.bitmap.canvas.pixels[0,y0-1];
for i := 0 to x1 — 1 do
for j := 0 to y0 — 1 do
if tempglyph.bitmap.canvas.pixels[i,j] =
ftransparentcolor then
tempglyph.bitmap.canvas.pixels[i,j] := fbtncolor;
//Рисуем саму кнопку
canvas.draw(fglyphleft + 2,fglyphtop + 2,tempglyph.graphic);
end
else
begin
if fmouseover then
begin
// Курсор на кнопке, но не нажат, показываем glyph 1 на морде кнопки
// (если существует)
if (fnumglyphs > 1) then
tempglyph.bitmap.canvas.copyrect(destrect,
fglyph.bitmap.canvas,rect(0,0,x1,y0));
if (fnumglyphs = 1) then
tempglyph.assign(fglyph);
end
else
begin
// Курсор за пределами кнопки, показываем glyph 2 на морде кнопки (если есть)
if (fnumglyphs > 1) then
tempglyph.bitmap.canvas.copyrect(destrect,
fglyph.bitmap.canvas,rect(x1,0,x2,y0));
if (fnumglyphs = 1) then
tempglyph.assign(fglyph);
end;
// Извиняюсь, лучшего способа не нашёл...
ftransparentcolor := tempglyph.bitmap.canvas.pixels[0,y0-1];
for i := 0 to x1 — 1 do
for j := 0 to y0 — 1 do
if tempglyph.bitmap.canvas.pixels[i,j] =
ftransparentcolor then
tempglyph.bitmap.canvas.pixels[i,j] := fbtncolor;
//Рисуем bitmap на морде кнопки
canvas.draw(fglyphleft,fglyphtop,tempglyph.graphic);
end;
end
else
begin
// Кнопка не доступна (disabled), показываем glyph 4 на морде кнопки (если существует)
if (fnumglyphs = 4) then
tempglyph.bitmap.canvas.copyrect(destrect,
fglyph.bitmap.canvas,rect(x3,0,x4,y0))
else
tempglyph.bitmap.canvas.copyrect(destrect,
fglyph.bitmap.canvas,rect(0,0,x1,y0));
if (fnumglyphs = 1) then
tempglyph.assign(fglyph.graphic);

// Извините, лучшего способа не нашлось...
ftransparentcolor := tempglyph.bitmap.canvas.pixels[0,y0-1];
for i := 0 to x1 — 1 do
for j := 0 to y0 — 1 do
if tempglyph.bitmap.canvas.pixels[i,j] =
ftransparentcolor then
tempglyph.bitmap.canvas.pixels[i,j] := fbtncolor;
//Рисуем изображение кнопки
canvas.draw(fglyphleft,fglyphtop,tempglyph.graphic);
end;
end;

// Рисуем caption
if fcaption <> «» then
begin
canvas.pen.color := font.color;
canvas.font.name := font.name;
canvas.brush.style := bsclear;
//canvas.brush.color := fbtncolor;
canvas.font.color := font.color;
canvas.font.size := font.size;
canvas.font.style := font.style;

if fmousedown then
canvas.textout(fshift + ftextleft,fshift + ftexttop,fcaption)
else
canvas.textout(ftextleft,ftexttop,fcaption);
end;

tempglyph.free; // Освобождаем временный glyph
end;
{--------------------------------------------------------------------}
// Нажата клавиша мышки на кнопке ?
procedure tnewbutton.mousedown(button: tmousebutton;
shift: tshiftstate;x, y: integer);

var
ffmousedown,ffmouseover : boolean;

begin
ffmousedown := true;
ffmouseover := true;
if (ffmousedown <> fmousedown) or (ffmouseover <> fmouseover) then
begin
fmousedown := ffmousedown;
fmouseover := ffmouseover;
invalidate; // не перерисовываем кнопку без необходимости.
end;
inherited mousedown(button,shift,x,y);;
end;
{--------------------------------------------------------------------}
// Отпущена клавиша мышки на кнопке ?
procedure tnewbutton.mouseup(button: tmousebutton; shift: tshiftstate;
x, y: integer);

var
ffmousedown,ffmouseover : boolean;

begin
ffmousedown := false;
ffmouseover := true;
if (ffmousedown <> fmousedown) or (ffmouseover <> fmouseover) then
begin
fmousedown := ffmousedown;
fmouseover := ffmouseover;
invalidate; // не перерисовываем кнопку без необходимости.
end;
inherited mouseup(button,shift,x,y);
end;
{--------------------------------------------------------------------}
// Эта процедура перехватывает события мышки, если она даже за пределами кнопки
// Перехватываем оконные сообщения
procedure tnewbutton.wndproc( var message : tmessage);

var
p1,p2 : tpoint;
bo : boolean;

begin
if parent <> nil then
begin
getcursorpos(p1); // Получаем координаты курсона на экране
p2 := self.screentoclient(p1); // Преобразуем их в координаты относительно кнопки
if (p2.x > 0) and (p2.x < width) and
(p2.y > 0) and (p2.y < height) then
bo := true // Курсор мышки в области кнопки
else
bo := false; // Курсор мышки за пределами кнопки

if bo <> fmouseover then // не перерисовываем кнопку без необходимости.
begin
fmouseover := bo;
invalidate;
end;
end;
inherited wndproc(message); // отправляем сообщение остальным получателям
end;
{--------------------------------------------------------------------}
end.

 

Интересное

Эксплойты
Эксплойт (англ. exploit — использовать) — это общий термин в сообществе компьютерной безопасности для обозначения фрагмента программного кода который, используя возможности предоставляемые...
Подробнее...
Windows Defender
В декабре 2004 Microsoft приобрела компанию GIANT, и её уважаемую и популярную антишпионскую утилиту. Первая бета совместного продукта появилась в январе 2005, бета 2 была выпущена практически...
Подробнее...
Виртуальный выделенный сервер
В последнее время некоторые российские провайдеры стали предоставлять услуги хостинга на виртуальных выделенных серверах. Во всём мире эта услуга не нова. Там, наряду с обычным хостингом, она...
Подробнее...
10 правил грамотной игры в...
Сегодня большинство пользователей Интернета знают о том, что почтовые рассылки являются одним из самых дешевых и эффективных методов рекламы. И это правда. Беда только в том, что основная масса...
Подробнее...
CSS вёрстка: учимся сами
Время от времени в мой почтовый ящик приходит очередное письмо, содержащее всего одну просьбу: меня просят рассказать о неком алгоритме изучения «блочной» вёрстки. Настало время...
Подробнее...
Эволюция 3D-графики в...
Воспроизведение видео и трехмерные игры — очень ресурсоемкие задачи для мобильного телефона, поэтому до недавнего времени они были трудно реализуемы. Но прогресс не стоит на месте, и в портативных...
Подробнее...
Когда плохой дизайн...
Создавать сайты сейчас стало проще: если вы не знаете, как вам оформить определенный элемент дизайна страницы, все что вам нужно сделать, это зайти на двадцать наиболее посещаемых сайтов в...
Подробнее...
Куда идет Windows?
ВведениеНравится это или нет, но Microsoft Windows применяется практически повсеместно. Свыше 90 процентов настольных и портативных компьютеров работают под управлением Windows. В течение двух...
Подробнее...
CSS дизайн: с учетом контекста
Веб-стандарты обещают нам улучшенную поддержку мультимедиа: возможность оптимизировать контент под возможности компьютерных экранов, портативных устройств, принтеров, проекторов, и подобных...
Подробнее...
Новый троян использует...
Специалисты по вопросам компьютерной безопасности предупреждают о появлении новой вредоносной программы под названием Mebroot, при помощи которой злоумышленники теоретически могут захватить полный...
Подробнее...