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

Автор: 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;

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 < 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;

  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.

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

 

Добавить комментарий

Не использовать не нормативную лексику.

Просьба писать ваши замечания, наблюдения и все остальное,
что поможет улучшить предоставляемую информацию на этом сайте.

ВСЕ КОММЕНТАРИИ МОДЕРИРУЮТСЯ ВРУЧНУЮ, ТАК ЧТО СПАМИТЬ БЕСПОЛЕЗНО!


Защитный код
Обновить