Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2003.02.27;
Скачать: CL | DM;

Вниз

Как добавить кнопку в заголовок окна?   Найти похожие ветки 

 
@ngel ©   (2002-12-28 19:57) [0]

Народ, поможите... Оч-чень надо.


 
Diamond Cat ©   (2002-12-29 04:03) [1]

вроде эта тема не раз обсуждалась но в связи с празднииками
unit Unit1;

interface

uses
Windows, Messages, Forms, Classes, Controls, Buttons, StdCtrls,// YzFrameControl,
ExtCtrls;

type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
function DrawButton(State: Cardinal): boolean;
protected
procedure WndProc(var Message: TMessage); override;
procedure WMNCLButtonDown(var Message: TWMNCLButtonDown ); message WM_NCLButtonDown;
procedure WMNCLButtonUp(var Message: TWMNCLButtonUp ); message WM_NCLButtonUp;
public
procedure ButtonClicked;
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.ButtonClicked;
begin
if height>height-clientheight then height:=height-clientheight else height:=171;
end;

function TForm1.DrawButton(State: Cardinal): boolean;
var
P: TPoint;
R: TRect;
DC: hDC;
begin
GetCursorPos(P);
Dec(P.X, Left);
Dec(P.Y, Top);
R.Left := GetSystemMetrics(SM_CxFrame)+45 + Canvas.TextWidth(Caption);
R.Right := Width - GetSystemMetrics(SM_CxFrame) - 20;
R.Top := GetSystemMetrics(SM_CyFrame)+GetSystemMetrics(SM_CYEDGE);
R.Bottom := GetSystemMetrics(SM_CYSIZE)+GetSystemMetrics(SM_CYEDGE);
Result := (State = 0) or PtInRect(R, P);
if Result
then begin
DC := GetWindowDC(Handle);
try
if height=height-clientheight then DrawFrameControl(DC, R, DFC_SCROLL , DFCS_SCROLLDOWN or State) else
DrawFrameControl (DC, R, DFC_SCROLL , DFCS_SCROLLUP or State)
finally
ReleaseDC(Handle, DC)
end
end;
end;

procedure TForm1.WMNCLButtonDown(var Message: TWMNCLButtonDown);
begin
if not DrawButton(DFCS_Pushed) then inherited
end;

procedure TForm1.WMNCLButtonUp(var Message: TWMNCLButtonUp);
begin
if DrawButton(0) then ButtonClicked else inherited
end;

procedure TForm1.WndProc(var Message: TMessage);
begin
inherited WndProc(Message);
case Message.Msg of
wm_ncactivate,WM_NCCALCSIZE,wm_setfocus,wm_killfocus, WM_Activate, WM_ncPaint, WM_WindowPosChanging: DrawButton(0)
end { of case };
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
BorderIcons := BorderIcons - [biminimize];
BorderIcons := BorderIcons - [bimaximize];
borderStyle:=bssizeable;
height:=171;
width:=400;
end;

end.


 
cdadmitriy ©   (2002-12-29 11:07) [2]

Max"s Caption Bar Buttons for Delphi 5,6,7
Copyright (c) 2002 Bitvad



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

Текущий архив: 2003.02.27;
Скачать: CL | DM;

Наверх




Память: 0.47 MB
Время: 0.016 c
1-87437
BorisUK
2003-02-18 13:56
2003.02.27
Проблема с маской или у меня :)


14-87658
KinderSurprise
2003-02-11 01:04
2003.02.27
Всем доброй ночи!


1-87378
AnnReal
2003-02-17 16:44
2003.02.27
Трабл с BitBtn, глотает нажатие Enter, а он необх. в др. месте


7-87722
Масим
2002-12-23 20:46
2003.02.27
как включить спейкер программно?


14-87623
vajo
2003-02-10 10:20
2003.02.27
Oracle 8, SQL Server 2000