Отправляет email-рассылки с помощью сервиса Sendsay

Delphi для профессионалов

Рассылка закрыта

При закрытии подписчики были переданы в рассылку "Delphi - проблемы и решения" на которую и рекомендуем вам подписаться.

Вы можете найти рассылки сходной тематики в Каталоге рассылок.

  Октябрь 2002   →
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
24.10.2002
15:05:04
23:21:18
25
26
27
28
29
30
31
Автор
Ведущий

Статистика

8.943 подписчиков
-22 за неделю
←   Все выпуски   →

Delphi для профессионалов - Прорисовка кнопки в заголовке окна


Информационный Канал Subscribe.Ru
eServer.ru :: Хостинг без ограничений!
Рассылка: Delphi для профессионалов

Количество подписчиков: 14
Рассылка 'Delphi для профессионалов'
Прорисовка кнопки в заголовке окна 

unit Unit1;

interface
uses
  Windows, Buttons, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
type
  TForm1 = class(TForm)
    procedure FormResize(Sender: TObject);
  private
    CaptionBtn : TRect;
    procedure DrawCaptButton;
    procedure WMNCPaint(var Msg : TWMNCPaint); message WM_NCPaint;
    procedure WMNCActivate(var Msg : TWMNCActivate); message WM_NCACTIVATE;
    procedure WMSetText(var Msg : TWMSetText); message WM_SETTEXT;
    procedure WMNCHitTest(var Msg : TWMNCHitTest); message WM_NCHITTEST;
    procedure WMNCLButtonDown(var Msg : TWMNCLButtonDown); message WM_NCLBUTTONDOWN;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

const
  htCaptionBtn = htSizeLast + 1;

{$R *.DFM}

procedure TForm1.DrawCaptButton;
var
  xFrame, yFrame, xSize, ySize : Integer;
  R : TRect;
begin
    //Размеры растягиваемой рамки
  xFrame := GetSystemMetrics(SM_CXFRAME);
  yFrame := GetSystemMetrics(SM_CYFRAME);
    //Размеры кнопок в заголовке окна
  xSize := GetSystemMetrics(SM_CXSIZE);
  ySize := GetSystemMetrics(SM_CYSIZE);
    //Определение расположения новой кнопки
  CaptionBtn := Bounds(Width - xFrame - 4*xSize + 2,
                       yFrame + 2, xSize - 2, ySize - 4);
    //Получаем указатель на канву
  Canvas.Handle := GetWindowDC(Self.Handle);
  Canvas.Font.Name := 'Symbol';
  Canvas.Font.Color:= clBlue;
  Canvas.Font.Style := [fsBold];
  Canvas.Pen.Color := clYellow;
  Canvas.Brush.Color := clBtnFace;
  try
    DrawButtonFace(Canvas, CaptionBtn, 1, bsAutoDetect, False, False, False);
    //Определяем меньший четырешугольник для рисования внутри кнопки
    R := Bounds(Width - xFrame - 4 * xSize + 2,
                yFrame + 3, xSize - 6, ySize - 7);
    with CaptionBtn do
    Canvas.TextRect(R, R.Left + 2, R.Top - 1, 'W');
  finally
    ReleaseDC(Self.Handle, Canvas.Handle);
    Canvas.Handle := 0;
  end;
end;

procedure TForm1.WMNCPaint(var Msg : TWMNCPaint);
begin
  inherited;
  DrawCaptButton;
end;

procedure TForm1.WMNCActivate(var Msg : TWMNCActivate);
begin
  inherited;
  DrawCaptButton;
end;

procedure TForm1.WMSetText(var Msg : TWMSetText);
begin
  inherited;
  DrawCaptButton;
end;

procedure TForm1.WMNCHitTest(var Msg : TWMNCHitTest);
begin
  inherited;
  with Msg do
    if PtInRect(CaptionBtn, Point(XPos - Left, YPos - Top)) then
      Result := htCaptionBtn;
end;

procedure TForm1.WMNCLButtonDown(var Msg : TWMNCLButtonDown);
begin
  inherited;
  if (Msg.HitTest = htCaptionBtn) then
    ShowMessage('Вы нажали кнопку в заголовке окна');
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  //Форсируем перерисовку заголовка окна при изменении размеров формы
  Perform(WM_NCACTIVATE, Word(Active), 0);
end;

end.
Все вопросы присылайте по адресу: delphi-ask@igp.org.ua
Все ответы присылайте по адресу: delphi-reply@igp.org.ua
Все подсказки присылайте по адресу: delphi-hint@igp.org.ua
Со всем списком советов можно познакомиться по адресу: http://igp.org.ua/delphine/.
Наш проект Delphine можно найти по следующей ссылке: http://igp.org.ua/products/delphine/.

Заходите в наш форум: Форум Delphi-профессионалов. Адрес: http://igp.org.ua/cgi-bin/yabb/yabb.pl.
Здесь Вы найдете ответы на все Ваши вопросы!
http://subscribe.ru/
E-mail: ask@subscribe.ru 		Отписаться
Убрать рекламу
В избранное