Ошибка: Failed to parse the Currency Converter XML document.
$20 402.53


Ошибка: Failed to parse the Currency Converter XML document.
$2 491.33


Ошибка: Failed to parse the Currency Converter XML document.
$2 952.28


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

 

Интересное

Очистка списка последних...
При частом применении команды «Подключить сетевой диск» (Map Network Drive) в Windows XP, в списке последних операций (Most Recently Used, MRU) появляется множество различных сетевых путей. В этом...
Подробнее...
Cинхронизация времени...
ЗадачаОрганизовать синхронизацию времени контроллеров домена с внешними источниками.Исходные данные.Все серверы W2K3 Схема подключения к внешней сети Internet-Router-ISA-DC.Router управляется...
Подробнее...
"Грабим" странички
С аудиограбберами знакомы все. Нам предстоит сделать свой собственный граббер информации из Интернета. Нам понадобится подопытный кролик, на роль которого я предлагаю выбрать сайт...
Подробнее...
Java обгоняет по...
Одним из главных недостатков языка Java традиционно считается невысокая скорость работы программ по сравнению с приложениями на языке С++. И для приложений, где переносимость между платформами или...
Подробнее...
Полезные функции для...
Эта статья фактически краткий справочник по функциям для работы с файлами.Описываемые функции редко кто использует, но это не значит, что они бесполезны.Напротив, они очень даже полезны... Но они...
Подробнее...
Психология в дизайне
Эта статья больше заинтересует дизайнеров. Те из них, кто имеет высшее образование в этой области, уже знакомы со многими, из перечисленных здесь фактов. Но статистика показывает, что основной...
Подробнее...
Photoshop CS2. Стань...
Книга предназначена для всех, кто хочет овладеть самой новой версией программы Photoshop — CS2, — от начинающих дизайнеров до пользователей, работающих с цифровыми фотографиями. В доступной форме...
Подробнее...
.htaccess - великий и...
Как известно, самым популярным на сей день веб-сервером является Apache в различных версиях (а вовсе не IIS, как утверждает Microsoft). Его ставят на свои сервера большинство хостителей, услуга же...
Подробнее...
Режим редактирования в IE
Оказывается ie может редактировать открытые им документы, и не только текст, но и в том числе вставлять имиджи и т.п. По сути дела полноценный html-editor у нас в руках, но только об этом...
Подробнее...
Создание Web-броузера на...
Читая и перечитывая вопросы и ответы я все время натыкался на вопросы о компоненте T WebBrowser . Сначала я думал, что все просто, но когда самому понадобилось написать приложение с использованием...
Подробнее...