Создать кнопку в правом верхнем углу формы

procedure TTitleBtnForm.DrawTitleButton;
var
bmap : TBitmap; {Bitmap to be drawn - 16 X 16 : 16 Colors}
XFrame, {X and Y size of Sizeable area of Frame}
YFrame,
XTtlBit, {X and Y size of Bitmaps in caption}
YTtlBit : Integer;
begin
{Get size of form frame and bitmaps in title bar}
XFrame := GetSystemMetrics(SM_CXFRAME);
YFrame := GetSystemMetrics(SM_CYFRAME);
XTtlBit := GetSystemMetrics(SM_CXSIZE);
YTtlBit := GetSystemMetrics(SM_CYSIZE);
 
{$IFNDEF WIN32}
TitleButton := Bounds(Width - (3 * XTtlBit) - ((XTtlBit div 2) - 2),
YFrame - 1,
XTtlBit + 2,
YTtlBit + 2);
 
{$ELSE} {Delphi 2.0 positioning}
if (GetVerInfo = VER_PLATFORM_WIN32_NT) then
TitleButton := Bounds(Width - (3 * XTtlBit) - ((XTtlBit div 2) - 2),
YFrame - 1,
XTtlBit + 2,
YTtlBit + 2)
else
TitleButton := Bounds(Width - XFrame - 4*XTtlBit + 2,
XFrame + 2,
XTtlBit + 2,
YTtlBit + 2);
{$ENDIF}
 
Canvas.Handle := GetWindowDC(Self.Handle); {Get Device context for drawing}
try
{Draw a button face on the TRect}
DrawButtonFace(Canvas, TitleButton, 1, bsAutoDetect, False, False, False);
bmap := TBitmap.Create;
bmap.LoadFromFile('help.bmp');
with TitleButton do
{$IFNDEF WIN32}
Canvas.Draw(Left + 2, Top + 2, bmap);
{$ELSE}
if (GetVerInfo = VER_PLATFORM_WIN32_NT) then
Canvas.Draw(Left + 2, Top + 2, bmap)
else
Canvas.StretchDraw(TitleButton, bmap);
{$ENDIF}
 
finally
ReleaseDC(Self.Handle, Canvas.Handle);
bmap.Free;
Canvas.Handle := 0;
end;
end;
 
Step 1 above is accomplished by making four calls to the WinAPI
function, GetSystemMetrics, asking the system for the width and
height of the window that can be sized (SM_CXFRAME and
SM_CYFRAME), and the size of the bitmaps contained on the title
bar (SM_CXSIZE and SM_CYSIZE).
 
Step 2 is performed with the Bounds function which returns a
TRect defined by the size and position parameters which are
supplied to it. Notice that I used some conditional compiler
directives here. This is because the size of the title bar buttons in
Windows 95 and Windows 3.1 are different, so they have to be
sized differently.
 
And since I wanted to be able to compile this in either version of
Windows, I used a test for the predefined symbol, WIN32, to
see what version of Windows the program is compiled under.
However, since the Windows NT UI is the same as Windows 3.1,
it's necessary to grab further version information under
the Win32 conditional to see if the Windows version is Windows NT.
If it is, then we define the TRect to be just like the Windows 3.1
TRect.
 
To perform Step 3, we make a call to the Buttons unit's
DrawButtonFace to draw button features within the TRect that we
defined. As added treat, I included code to draw a bitmap in the
button. Again, you'll see that I used a conditional compiler directive
to draw the bitmap under different versions of Windows.
 
I did this purely for personal reasons because the bitmap that I used
was 16 X 16 pixels in dimension, which might be too big for Win95
buttons. So I used StretchDraw under Win32 to stretch the bitmap to
the size of the button.
 
Trapping the Drawing and Painting Events
 
You have to make sure that the button will stay visible every time the
form repaints itself. Painting occurs in response to activation and
resizing, which fire off paint and text setting messages that will
redraw the form. If you don't have a facility to redraw your button,
you'll lose it every time a repaint occurs.
 
So what we have to do is write event handlers which will perform their
default actions, but also redraw our button when they fire off. The
following four procedures handle the paint triggering and painting
events:
 
{Paint triggering events}
procedure TForm1.WMNCActivate(var Msg : TWMNCActivate);
begin
Inherited;
DrawTitleButton;
end;
 
procedure TForm1.FormResize(Sender: TObject);
begin
Perform(WM_NCACTIVATE, Word(Active), 0);
end;
 
{Painting events}
procedure TForm1.WMNCPaint(var Msg : TWMNCPaint);
begin
Inherited;
DrawTitleButton;
end;
 
procedure TForm1.WMSetText(var Msg : TWMSetText);
begin
Inherited;
DrawTitleButton;
end;
 
Every time one of these events fires off, it makes a call to the
DrawTitleButton procedure. This will ensure that our button is
always visible on the title bar. Notice that we use the default handler
OnResize on the form to force it to perform a
WM_NCACTIVATE.
 
Handling Mouse Clicks
 
Now that we've got code that draws our button and ensures that it's
always visible, we have to handle mouse-clicks on the button. The
way we do this is with two procedures. The first procedure tests to
see if the mouse-click was in the area of our button, then the second
procedure actually performs the code execution associated with our
button. Let's look at the code below:
 
{Mouse-related procedures}
procedure TForm1.WMNCHitTest(var Msg : TWMNCHitTest);
begin
Inherited;
{Check to see if the mouse was clicked in the area of the button}
with Msg do
if PtInRect(TitleButton, Point(XPos - Left, YPos - Top)) then
Result := htTitleBtn;
end;
 
procedure TForm1.WMNCLButtonDown(var Msg : TWMNCLButtonDown);
begin
inherited;
if (Msg.HitTest = htTitleBtn) then
ShowMessage('You pressed the new button');
end;
 
The first procedure WMNCHitTest(var Msg :
TWMNCHitTest) is a hit tester message to determine where the
mouse was clicked in the non-client area. In this procedure we test if
the point defined by the message was within the bounds of our
TRect by using the PtInRect function. If the mouse click was
performed in the TRect, then the result of our message is set to
htTitleBtn, which is a constant that was declared as htSizeLast +
1. htSizeLast is a hit test constant generated by hit test events to test
where the last hit occurred.
 
The second procedure is a custom handler for a left mouse-click on
a button in the non-client area. Here we test if the hit test result was
equal to htTitleBtn. If it is, we show a message. This was purely
for simplicity's sake, but you can make any call you choose to at this
point.
 
Putting it All Together
 
Let's look at the entire code in the form to see how it all works together:
 
unit Capbtn;
 
interface
 
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, Buttons;
 
type
TTitleBtnForm = class(TForm)
procedure FormResize(Sender: TObject);
private
TitleButton : TRect;
procedure DrawTitleButton;
{Paint-related messages}
procedure WMSetText(var Msg : TWMSetText); message WM_SETTEXT;
procedure WMNCPaint(var Msg : TWMNCPaint); message WM_NCPAINT;
procedure WMNCActivate(var Msg : TWMNCActivate); message WM_NCACTIVATE;
{Mouse down-related messages}
procedure WMNCHitTest(var Msg : TWMNCHitTest); message WM_NCHITTEST;
procedure WMNCLButtonDown(var Msg : TWMNCLButtonDown);
message WM_NCLBUTTONDOWN;
function GetVerInfo : DWORD;
end;
 
var
TitleBtnForm: TTitleBtnForm;
 
const
htTitleBtn = htSizeLast + 1;
 
implementation
{$R *.DFM}
 
procedure TTitleBtnForm.DrawTitleButton;
var
bmap : TBitmap; {Bitmap to be drawn - 16 X 16 : 16 Colors}
XFrame, {X and Y size of Sizeable area of Frame}
YFrame,
XTtlBit, {X and Y size of Bitmaps in caption}
YTtlBit : Integer;
begin
{Get size of form frame and bitmaps in title bar}
XFrame := GetSystemMetrics(SM_CXFRAME);
YFrame := GetSystemMetrics(SM_CYFRAME);
XTtlBit := GetSystemMetrics(SM_CXSIZE);
YTtlBit := GetSystemMetrics(SM_CYSIZE);
 
{$IFNDEF WIN32}
TitleButton := Bounds(Width - (3 * XTtlBit) - ((XTtlBit div 2) - 2),
YFrame - 1,
XTtlBit + 2,
YTtlBit + 2);
 
{$ELSE} {Delphi 2.0 positioning}
if (GetVerInfo = VER_PLATFORM_WIN32_NT) then
TitleButton := Bounds(Width - (3 * XTtlBit) - ((XTtlBit div 2) - 2),
YFrame - 1,
XTtlBit + 2,
YTtlBit + 2)
else
TitleButton := Bounds(Width - XFrame - 4*XTtlBit + 2,
XFrame + 2,
XTtlBit + 2,
YTtlBit + 2);
{$ENDIF}
 
 
Canvas.Handle := GetWindowDC(Self.Handle); {Get Device context for drawing}
try
{Draw a button face on the TRect}
DrawButtonFace(Canvas, TitleButton, 1, bsAutoDetect, False, False, False);
bmap := TBitmap.Create;
bmap.LoadFromFile('help.bmp');
with TitleButton do
{$IFNDEF WIN32}
Canvas.Draw(Left + 2, Top + 2, bmap);
{$ELSE}
if (GetVerInfo = VER_PLATFORM_WIN32_NT) then
Canvas.Draw(Left + 2, Top + 2, bmap)
else
Canvas.StretchDraw(TitleButton, bmap);
{$ENDIF}
 
finally
ReleaseDC(Self.Handle, Canvas.Handle);
bmap.Free;
Canvas.Handle := 0;
end;
end;
 
{Paint triggering events}
procedure TTitleBtnForm.WMNCActivate(var Msg : TWMNCActivate);
begin
Inherited;
DrawTitleButton;
end;
 
procedure TTitleBtnForm.FormResize(Sender: TObject);
begin
Perform(WM_NCACTIVATE, Word(Active), 0);
end;
 
{Painting events}
procedure TTitleBtnForm.WMNCPaint(var Msg : TWMNCPaint);
begin
Inherited;
DrawTitleButton;
end;
 
procedure TTitleBtnForm.WMSetText(var Msg : TWMSetText);
begin
Inherited;
DrawTitleButton;
end;
 
{Mouse-related procedures}
procedure TTitleBtnForm.WMNCHitTest(var Msg : TWMNCHitTest);
begin
Inherited;
{Check to see if the mouse was clicked in the area of the button}
with Msg do
if PtInRect(TitleButton, Point(XPos - Left, YPos - Top)) then
Result := htTitleBtn;
end;
 
procedure TTitleBtnForm.WMNCLButtonDown(var Msg : TWMNCLButtonDown);
begin
inherited;
if (Msg.HitTest = htTitleBtn) then
ShowMessage('You pressed the new button');
end;
 
function TTitleBtnForm.GetVerInfo : DWORD;
var
verInfo : TOSVERSIONINFO;
begin
verInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
if GetVersionEx(verInfo) then
Result := verInfo.dwPlatformID;
{Returns:
VER_PLATFORM_WIN32s Win32s on Windows 3.1
VER_PLATFORM_WIN32_WINDOWS Win32 on Windows 95
VER_PLATFORM_WIN32_NT Windows NT }
end;
 
end.