Этот компонент представляет из себя кнопку, на которую не надо нажимать, чтобы получить событие OnClick. Достаточно переместить курсор мышки на кнопку. При создании такого компонента традиционным способом, требуется довольно много времени, так как необходимо обрабатывать мышку, перехватывать её и т.д. Однако результат стоит того!

 

Я знаю как нажать кнопку через keypress, но хотя пользователь определил действие в обработчике события OnClick, сама кнопка не отражает видимых изменений, происходящих при ее нажатии мышью. Кто-нибудь может мне помочь?

 

Вы можете сделать кнопку "нажатой" или "ненажатой", посылая ей сообщение BM_SETSTATE. Определить ее текущее состояние можно, послав ей сообщение BM_GETSTATE.

 

Для нажатия кнопки:

 

Выводите текст надписи непосредственно на "glyph" TBitBtn'а

Code:

procedure TForm1.FormCreate(Sender: TObject);

var

R: TRect;

N: Integer;

Buff: array[0..255] of Char;

begin

with BitBtn1 do

   begin

     Caption := 'A really really long caption';

     Glyph.Canvas.Font := Self.Font;

     Glyph.Width := Width - 6;

     Glyph.Height := Height - 6;

     R := Bounds(0, 0, Glyph.Width, 0);

     StrPCopy(Buff, Caption);

     Caption := '';

     DrawText(Glyph.Canvas.Handle, Buff, StrLen(Buff), R,

       DT_CENTER or DT_WORDBREAK or DT_CALCRECT);

     OffsetRect(R, (Glyph.Width - R.Right) div 2,

       (Glyph.Height - R.Bottom) div 2);

     DrawText(Glyph.Canvas.Handle, Buff, StrLen(Buff), R,

       DT_CENTER or DT_WORDBREAK);

   end;

end;

 

В некоторых видео режимах прозрачная часть glyph'а стандартного TBitBtn становится видной. Как этого избежать?

 

В примере используется техника закраски прозрачной части glyph'а цветом кнопки на которой он находится - таким образом glyph кажется прозрачным.

 

Как выдать текст под наклоном?

 

Чтобы вывести под любым углом текст необходимо использовать TrueType Fonts (например «Arial»). Например:

 

Автор: Dennis Passmore

 

Могу ли я из ресурсов поочередно загружать глифы для кнопок speedbutton и, если да, то как это сделать?

 

Например, если в вашем проекте используется TDBGrid, то иконки кнопок компонента DBNavigator могут линковаться вашей программой, и их можно загрузить для использования в ваших speedbutton следующим образом:

 

сли вы хотите, чтобы кнопка или пункт меню выполнял другую функцию при нажатой кнопке  shift ,

вы можете использовать функцию GetKeyState .

 

GetKeyState принимает в качестве параметра виртуальный код кнопки и возвращает значение меньше 0,

если кнопка нажата.

 

Вы не можете изменить цвет стандартного TButton, так как кнопки управления окнами всегда рисует себя с

цвет кнопки определяется в панели управления. Но можно создать создать новый компонент TButton и ручка

и рисунок поведения есть.

 

 

Code:

unit RVButton;

 

interface

 

uses

  SysUtils, Classes, Controls, Messages, Graphics, Windows;

 

const

  iOffset = 3;

 

type

  TRVButton = class(TGraphicControl)

  private

    FCaption : string;

    FButtonColor: TColor;

    FLButtonDown: boolean;

    FBtnPoints : array[1..2] of TPoint;

    FKRgn : HRgn;

    procedure SetCaption(Value: string);

    procedure SetButtonColor(Value: TColor);

    procedure FreeRegion;

  protected

    procedure Paint; override;

    procedure DrawCircle;

    procedure MoveButton;

    procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;

    procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;

  public

    constructor Create(AOwner: TComponent); override;

    destructor Destroy; override;

  published

    property ButtonColor: TColor read FButtonColor write SetButtonColor;

    property Caption: string read FCaption write SetCaption;

    property Enabled;

    property Font;

    property ParentFont;

    property ParentShowHint;

    property ShowHint;

    property Visible;

    property OnClick;

  end;

 

procedure Register;

 

implementation

 

procedure Register;

begin

  RegisterComponents('Samples', [TRVButton]);

end;

 

{ TRVButton }

 

constructor TRVButton.Create(AOwner: TComponent);

begin

  inherited Create(AOwner);

  ControlStyle := [csClickEvents,csCaptureMouse];

  Width := 50;

  Height := 50;

  FButtonColor := clBtnFace;

  FKRgn := 0;

  FLButtonDown := False;

end;

 

destructor TRVButton.Destroy;

begin

  if FKRgn <> 0 then FreeRegion;

  inherited Destroy;

end;

 

procedure TRVButton.DrawCircle;

begin

  FBtnPoints[1] := Point(iOffset,iOffset);

  FBtnPoints[2] := Point(Width - iOffset,Height - iOffset);

  FKRgn := CreateEllipticRgn(FBtnPoints[1].x,FBtnPoints[1].y,FBtnPoints[2].x,FBtnPoints[2].y);

  Canvas.Brush.Color := FButtonColor;

  FillRgn(Canvas.Handle,FKRgn,Canvas.Brush.Handle);

  MoveButton;

end;

 

procedure TRVButton.FreeRegion;

begin

  if FKRgn <> 0 then DeleteObject(FKRgn);

  FKRgn := 0;

end;

 

procedure TRVButton.MoveButton;

var

  Color1: TColor;

  Color2: TColor;

begin

  with Canvas do

    begin

    if not FLButtonDown then

      begin

      Color1 := clBtnHighlight;

      Color2 := clBtnShadow;

      end

    else

      begin

      Color1 := clBtnShadow;

      Color2 := clBtnHighLight;

      end;

 

      Pen.Width := 1;

 

      if FLButtonDown then Pen.Color := clBlack

      else                 Pen.Color := Color2;

 

      Ellipse(FBtnPoints[1].x - 2,FBtnPoints[1].y - 2,FBtnPoints[2].x + 2,FBtnPoints[2].y + 2);

 

      if not FLButtonDown then Pen.Width := 2

      else                     Pen.Width := 1;

 

      Pen.Color := Color1;

 

      Arc(FBtnPoints[1].x,FBtnPoints[1].y,FBtnPoints[2].x,FBtnPoints[2].y,

          FBtnPoints[2].x,FBtnPoints[1].y,FBtnPoints[1].x,FBtnPoints[2].y);

 

      Pen.Color := Color2;

 

      Arc(FBtnPoints[1].x,FBtnPoints[1].y,FBtnPoints[2].x,FBtnPoints[2].y,

          FBtnPoints[1].x,FBtnPoints[2].y,FBtnPoints[2].x,FBtnPoints[1].y);

      end;

 

  SetCaption('');

end;

 

procedure TRVButton.Paint;

begin

  inherited Paint;

  FreeRegion;

  DrawCircle;

end;

 

procedure TRVButton.SetButtonColor(Value: TColor);

begin

  if Value <> FButtonColor then

    begin

    FButtonColor := Value;

    Invalidate;

    end;

end;

 

procedure TRVButton.SetCaption(Value: string);

var

  X: Integer;

  Y: Integer;

begin

  if ((Value <> FCaption) and (Value <> '')) then

  begin

    FCaption := Value;

  end;

 

  with Canvas.Font do

  begin

    Name := Font.Name;

    Size  := Font.Size;

    Style := Font.Style;

    if Self.Enabled then Color := Font.Color

    else

      Color := clDkGray;

  end;

 

  X := (Width div 2) - (Canvas.TextWidth(FCaption) div 2);

  Y := (Height div 2) - (Canvas.TextHeight(FCaption) div 2);

  Canvas.TextOut(X, Y, FCaption);

  //  Invalidate;

end;

 

 

procedure TRVButton.WMLButtonDown(var Message: TWMLButtonDown);

begin

  if not PtInRegion(FKRgn,Message.xPos,Message.yPos) then exit;

  FLButtonDown := True;

  MoveButton;

  inherited;

end;

 

procedure TRVButton.WMLButtonUp(var Message: TWMLButtonUp);

begin

  if not FLButtonDown then exit;

  FLButtonDown := False;

  MoveButton;

  inherited;

end;

 

 

end.

 

Code:

 

SpeedButton1.Perform(WM_LBUTTONDOWN, 0, 0);

SpeedButton1.Perform(WM_LBUTTONUP, 0, 0);

 

 

Code:

procedure TForm1.Button1Click(Sender: TObject);

var

i: Integer;

begin

i := GetWindowLong(Button1.Handle, GWL_STYLE);

SetWindowLong(Button1.Handle, GWL_STYLE, i or BS_MULTILINE);

Button1.Caption := 'Delphi World - ' + #13#10 + 'лучше не бывает!';

end;