$777.19


$29.58


$811.19


Расширяем возможности кнопок в 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.

 

Интересное

Хакеры могут включить...
PandaLabs обнаружила Shark2 - утилиту для создания троянов, выложенную для продажи на нескольких интернет-форумах. Еe создатели уже выпустили несколько обновлений, поэтому фактически в сети...
Подробнее...
Быстродействие FAT и NTFS
В этой статье я попытаюсь дать оценку быстродействию файловых систем, используемых в операционных системах Windows95/98/ME, а также Windows NT/2000. Статья не содержит графиков и результатов...
Подробнее...
10 причин медленной работы...
Пользователи редко жалуются на работу новых ПК. Немудрено, ведь и система, и программы запускаются мгновенно. Однако со временем они начинают замечать, что система работает всё медленнее и с...
Подробнее...
Unix+ Samba + ftpd,...
Есть такая проблема: сложно найти ftpd, понимающий перекодировку имен файлов. Если хранить файлы на сервере в koi8, то ftpшник выдает винде крякозябры. Если хранить в CP1251, то ftp не передает...
Подробнее...
Обзор и установка системы...
ВведениеДумаю, в настоящее время никто уже не станет спорить с утверждением, что процесс вхождения Linux в корпоративный мир стал необратимым, а процент установок этой операционной системы на...
Подробнее...
Обзор ASP
Этот текст предназначен для тех, кто никогда не имел дела с ASP, и вообще смутно себе представляет возможности программирования на стороне сервера. Я ставил себе задачу, создать у читателя общее...
Подробнее...
Начало создания сайта
Структура узлаОдним из главных слагаемых успеха узла является правильная организация его структуры. От нее зависит не только удобство навигации, но и легкость его пополнения, добавления разделов....
Подробнее...
Уроки программирования на...
В данной книге будут рассматриваться самые эффективные способы написания кода с помощью классов MFC(Microsoft Foundation Class Library). Вы пройдете весь курс за пару дней. Примеры несложные,...
Подробнее...
Скрытая загрузка
Не для кого не секрет, что в наше время Интернет-странички просто переполнены различной графикой (баннеры, дизайн странички, графические счетчики) — без этого уже почти невозможно представить...
Подробнее...
Как через форму положить...
Один из частых вопросов, это как через форму положить файл на сервер. Делается это весьма легко, всего около 10 строк кода и php скрипт готов. И при этом ничего кроме php вам не понадобится.Для...
Подробнее...