Форум: "Система";
Текущий архив: 2003.02.27;
Скачать: [xml.tar.bz2];
ВнизКак добавить кнопку в заголовок окна? Найти похожие ветки
← →
@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;
Скачать: [xml.tar.bz2];
Память: 0.45 MB
Время: 0.009 c