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

Содержание материала

Автор: Maarten de Haan

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

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

<--------- Ширина --------->

+------+------+-----+------+ ^

| пке |делами| | | |

+------+------+-----+------+ v

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

TextTop и TextLeft, Для расположения текста заголовка на кнопке,

и:

GlyphTop и GlyphLeft, Для расположения Glyph на кнопке.

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

Найденные баги

----------

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

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

Code:

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;

{--------------------------------------------------------------------}

Procedure TNewButton.fSetNumGlyphs(I : Integer);

Begin

If I > 0 then

If I <> fNumGlyphs then

Begin

fNumGlyphs := I;

Invalidate;

End;

{--------------------------------------------------------------------}

Procedure TNewButton.fSetFaceColor(C : TColor);

Begin

If C <> fFaceColor then

Begin

fFaceColor := C;

Invalidate;

End;

{--------------------------------------------------------------------}

Procedure TNewButton.fSetTextTop(I : Integer);

Begin

If I >= 0 then

If I <> fTextTop then

Begin

fTextTop := I;

Invalidate;

End;

{--------------------------------------------------------------------}

Procedure TNewButton.fSetTextLeft(I : Integer);

Begin

If I >= 0 then

If I <> fTextLeft then

Begin

fTextLeft := I;

Invalidate;

End;

{--------------------------------------------------------------------}

Procedure TNewButton.fSetCaption(S : String);

Begin

If (fCaption <> S) then

Begin

fCaption := S;

SetTextBuf(PChar(S));

Invalidate;

End;

{--------------------------------------------------------------------}

Procedure TNewButton.fSetGlyphLeft(I : Integer);

Begin

If I <> fGlyphLeft then

If I >= 0 then

Begin

fGlyphLeft := I;

Invalidate;

End;

{--------------------------------------------------------------------}

Procedure TNewButton.fSetGlyphTop(I : Integer);

Begin

If I <> fGlyphTop then

If I >= 0 then

Begin

fGlyphTop := I;

Invalidate;

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 < 3) and (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;

// Рисуем 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;

inherited WndProc(Message); // отправляем сообщение остальным получателям

End;

{--------------------------------------------------------------------}

End.

{====================================================================}

Новые статьи

Ранние статьи

Как програмно нажать SpeedButton?

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