Expiring Today—Celebrate National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

Button on Caption Bar?

Posted on 2001-07-24
2
Medium Priority
?
356 Views
Last Modified: 2010-04-06
Hi!

I'm wondering, is it possble to put a button on the caption bar like GetRight does with the minimize to tray button?

Stu.
0
Comment
Question by:Stuart_Johnson
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
2 Comments
 
LVL 17

Accepted Solution

by:
inthe earned 400 total points
ID: 6316071
hi stu,
there are some components on torrys for it (and rx contains one i think)
http://www.torry.net/otherbuttons.htm
also utilminds do some but not free from them..

or can code it yourself ,here is older from paq example:
Regards Barry

unit Unit1;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, Buttons;

type
  TForm1 = class(TForm)
    procedure FormResize(Sender: TObject);
    procedure FormCreate(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
  Form1: TForm1;

const
  htTitleBtn = htSizeLast + 1;

implementation
{$R *.DFM}

procedure TForm1.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('c:\help.bmp');
    //or load bitmap from resource maybe better unless your app is customizable
    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 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;

{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');
     close;
end;

function TForm1.GetVerInfo : DWORD;
var
 verInfo : TOSVERSIONINFO;
begin
  verInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
  if GetVersionEx(verInfo) then
    Result := verInfo.dwPlatformID;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Form1.BorderIcons := Form1.BorderIcons -
           [biSystemMenu, biMinimize, biMaximize];
end;

end.
0
 
LVL 6

Author Comment

by:Stuart_Johnson
ID: 6316265
Thanks Barry!  I ended up using the control TTitleBtn which is great!

Thanks again.

Stu.
0

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

The uses clause is one of those things that just tends to grow and grow. Most of the time this is in the main form, as it's from this form that all others are called. If you have a big application (including many forms), the uses clause in the in…
Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
In this video, Percona Solution Engineer Dimitri Vanoverbeke discusses why you want to use at least three nodes in a database cluster. To discuss how Percona Consulting can help with your design and architecture needs for your database and infras…
In this video, Percona Solution Engineer Rick Golba discuss how (and why) you implement high availability in a database environment. To discuss how Percona Consulting can help with your design and architecture needs for your database and infrastr…
Suggested Courses

718 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question