FAQ VCL
Компоненты\Button

:: Меню ::
:: На главную ::
:: FAQ ::
:: Заметки ::
:: Практика ::
:: Win API ::
:: Проекты ::
:: Скачать ::
:: Секреты ::
:: Ссылки ::

:: Сервис ::
:: Написать ::

:: MVP ::

:: RSS ::

Яндекс.Метрика

Как сделать многострочную надпись на TButton?

procedure TForm1.FormCreate(Sender: TObject);
var
  i: integer;
begin
   i := GetWindowLong( Button1.Handle, GWL_STYLE );
   SetWindowLong( Button1.Handle, GWL_STYLE, i or BS_MULTILINE );
   Button1.Caption := 'Многострочная' + #13 + 'надпись';
end;


Как программно нажать на TButton, чтобы это было видно визуально?

procedure TForm1.Button2Click(Sender: TObject);
var
  t: Longint;
begin
   t := GetTickCount;
   // Нажимаем кнопку
   // В качестве второго параметра можно передать любое положительное число или Integer(true)
   Button1.Perform( BM_SETSTATE, 1, 0 );
   // Делаем цикл, чтобы программа не казалась зависшей
   while GetTickCount - t <= 100 do
      Application.ProcessMessages;
   // Отпускаем кнопку
   // В качестве второго параметра можно так же передать Integer(false)
   Button1.Perform( BM_SETSTATE, 0, 0 );
end;

// Определение состояния кнопки
procedure TForm1.Button3Click(Sender: TObject);
begin
   // if Button1.Perform( BM_GETSTATE, 0, 0 ) > 1 then
   if Boolean( Button1.Perform( BM_GETSTATE, 0, 0 ) ) then
      ShowMessage( 'Нажата' )
   else
      ShowMessage( 'Отжата' );
end;


Как кнопке удалить саму себя?

// Способ первый
const
  CM_DELETEME = WM_USER+200;

type
  TForm1 = class(TForm)
    {...}
    procedure CMDELETEME( var Msg: TMessage ); message CM_DELETEME;
    {...}
  end;


procedure TForm1.CMDELETEME(var Msg: TMessage);
begin
   TObject( Msg.LParam ).Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   PostMessage( Handle, CM_DELETEME, 0, LPARAM( Sender ) );
end;

// Способ второй
procedure TForm1.Button1Click(Sender: TObject);
begin
   TButton( Sender ).OnClick := nil;
   Sender.Free;
end;


Как убрать прямоугольник фокуса?

type
  TButton = class(Vcl.StdCtrls.TButton)
  // Практика показывает, что достаточно реализовать
  // лишь один из описанных ниже методов
  private
    procedure WMUpdateUIState(var Msg: TWMUpdateUIState); message WM_UPDATEUISTATE;
  public
    constructor Create(AOwner: TComponent); override;
  end;

implementation

constructor TButton.Create(AOwner: TComponent);
begin
  inherited;
  SendMessage(Handle, WM_UPDATEUISTATE, UIS_SET shl 16 or UISF_HIDEFOCUS, 0);
end;

procedure TButton.WMUpdateUIState(var Msg: TWMUpdateUIState);
begin
  if Msg.Msg = WM_UPDATEUISTATE then
  begin
    Msg.Action := UIS_SET;
    Msg.Flags := UISF_HIDEFOCUS;
  end;
  inherited;
end;


Как добавить иконку щита UAC на кнопку?

procedure TForm1.Button1Click(Sender: TObject);
const
  BCM_SETSHIELD = $160C;
  {$J+}
  ShieldEnabled: Boolean = False;
  {$J-}
begin
  ShieldEnabled := not ShieldEnabled;
  SendMessage(Button1.Handle, BCM_SETSHIELD, 0, LPARAM(ShieldEnabled));
  // А так можно установить иконку в заголовок окна:
  // SendMessage(Handle, WM_SETICON, ICON_SMALL, LoadIcon(0, IDI_SHIELD));
end;

При использовании материала - ссылка на сайт обязательна