Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 2003.11.13;
Скачать: [xml.tar.bz2];

Вниз

Кнопка рядом с ...   Найти похожие ветки 

 
LORDIK   (2003-11-03 12:07) [0]

Как сделать свою кнопку рядом с кнопками минимизыровать, закрыть, развернуть окно?


 
Stratos   (2003-11-03 12:12) [1]

FAQ читать надо!
FAQ - Интерфейс - TForm -> ...


 
Rouse_   (2003-11-03 12:12) [2]

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;
const htCaptionBtn = htSizeLast + 1;
var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.DrawCaptButton;
var xFrame, yFrame, xSize, ySize : Integer;
R : TRect;
begin
//Dimensions of Sizeable Frame
xFrame := GetSystemMetrics(SM_CXFRAME);
yFrame := GetSystemMetrics(SM_CYFRAME);
//Dimensions of Caption Buttons
xSize := GetSystemMetrics(SM_CXSIZE);
ySize := GetSystemMetrics(SM_CYSIZE);
//Define the placement of the new caption button
CaptionBtn := Bounds(Width - xFrame - 4*xSize + 2,
yFrame + 2, xSize - 2, ySize - 4);
//Get the handle to canvas using Form"s device context
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);
//Define a smaller drawing rectangle within the button
R := Bounds(Width - xFrame - 4 * xSize + 2,
yFrame + 3, xSize - 6, ySize - 7);
with CaptionBtn do
Canvas.TextRect(R, R.Left + 4, R.Top - 1, "z");
finally
ReleaseDC(Self.Handle, Canvas.Handle);
Canvas.Handle := 0;
end;
end;

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

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

procedure TForm1.FormResize(Sender: TObject);
begin
Perform(WM_NCACTIVATE, Word(Active), 0);
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("You hit the button on the caption bar");
end;

end.


Желаю успехов


 
ZEE   (2003-11-03 13:54) [3]

[2] - вот только в ХР будет выглядеть неочень...



Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2003.11.13;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.45 MB
Время: 0.029 c
3-40862
RomCom
2003-10-25 19:25
2003.11.13
Как дождатся конца фильтрации


3-40841
alxx
2003-10-21 16:38
2003.11.13
dbExpress


1-41416
Vadim S
2003-10-29 16:15
2003.11.13
Invalid pointer operation


6-41783
pupsik
2003-09-18 11:51
2003.11.13
Отладка Web приложения


3-40852
3APA3A
2003-10-20 23:38
2003.11.13
Что такое MSSQL?





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский