Floating toolbar - here's some code to do it

Someone asked for some code to make a form with no title bar moveable, kind of like a floating toolbar, for example FreeDock. Actually, for some of the stuff in here I spied on the FreeDock sources...

This requires the use of some WinAPI functions. All WinAPI functions are however available at a touch of a key (F1 - OnLine Help)...

Here's some code that does this (about 100 lines)...

To make this work like intended:

OR start a new project, make the form's borderstyle bsNone, add a panel, set the border style of the panel to bsSingle, add another panel with some caption, add a button that says 'toggle title bar', cut out the below code and insert it were it should be, enable the panel's three event handlers (MouseDown, MouseMove, MouseUp), enable the button's event handler (Click). Hope I didn't forget anything... ;-) It's done faster in Delphi than it's written here... ;-)

unit Unit1;

interface

uses

SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,

Forms, Dialogs, ExtCtrls, StdCtrls;

type

TForm1 = class(TForm)

Panel1: TPanel;

Panel2: TPanel;

Button1: TButton;

procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,

Y: Integer);

procedure Panel1MouseUp(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

OldX,

OldY,

OldLeft,

OldTop : Integer;

ScreenDC : HDC;

MoveRect : TRect;

Moving : Boolean;

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

if Button = mbLeft then begin

SetCapture(Panel1.Handle);

ScreenDC := GetDC(0);

OldX := X;

OldY := Y;

OldLeft := X;

OldTop := Y;

MoveRect := BoundsRect;

DrawFocusRect(ScreenDC,MoveRect);

Moving := True;

end;

procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,

Y: Integer);

begin

if Moving then begin

DrawFocusRect(ScreenDC,MoveRect);

OldX := X;

OldY := Y;

MoveRect := Rect(Left+OldX-OldLeft,Top+OldY-OldTop,

Left+Width+OldX-OldLeft,Top+Height+OldY-OldTop);

DrawFocusRect(ScreenDC,MoveRect);

end;

procedure TForm1.Panel1MouseUp(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

if Button = mbLeft then begin

ReleaseCapture;

DrawFocusRect(ScreenDC,MoveRect);

Left := Left+X-OldLeft;

Top := Top+Y-OldTop;

ReleaseDC(0,ScreenDC);

Moving := False;

end;

procedure TForm1.Button1Click(Sender: TObject);

var

TitleHeight,

BorderWidth,

BorderHeight : Integer;

begin

TitleHeight := GetSystemMetrics(SM_CYCAPTION);

BorderWidth := GetSystemMetrics(SM_CXBORDER)+GetSystemMetrics(SM_CXFRAME)-1;

BorderHeight := GetSystemMetrics(SM_CYBORDER)+GetSystemMetrics(SM_CYFRAME)-2;

if BorderStyle = bsNone then begin

BorderStyle := bsSizeable;

Top := Top-TitleHeight-BorderHeight;

Height := Height+TitleHeight+2*BorderHeight;

Left := Left-BorderWidth;

Width := Width+2*BorderWidth;

end

else begin

BorderStyle := bsNone;

Top := Top+TitleHeight+BorderHeight;

Height := Height-TitleHeight-2*BorderHeight;

Left := Left+BorderWidth;

Width := Width-2*BorderWidth;

end;

end.

Comments

I have one comment on the FloatWin sample, though: it's *much* more complicated than it needs to be. All you have to do is handle Windows' wm_NCHitTest message. Here is some code I wrote for a Borland Tech Info document that does the same thing.

unit Dragmain;

interface

uses

SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,

Forms, Dialogs, StdCtrls;

type

TForm1 = class(TForm)

Button1: TButton;

procedure Button1Click(Sender: TObject);

private

procedure WMNCHitTest(var M: TWMNCHitTest); message wm_NCHitTest;

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.WMNCHitTest(var M: TWMNCHitTest);

begin

inherited; { call the inherited message handler }

if M.Result = htClient then { is the click in the client area? }

M.Result := htCaption; { if so, make Windows think it's }

{ on the caption bar. }

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

Close;

end;

end.