Mega Code Archive
Floatwin
<![CDATA[
Subject: 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:
EITHER grab the uuencoded stuff at the bottom of this post. The uuencoded part includes
the unit, the project file, the resource file and the form file. [Removed.]
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... ;-)
Have fun, and while you're at it, go grab the two Delphi projects at my homepage
http://www.it.kth.se/~ao/...
-----------------------------------------------------------------------------
! The Windoze program you want is at http://www.it.kth.se/~ao/yacpu20.zip !
! !
! Anders Ohlsson - ao@sto.foa.se - http://www.it.kth.se/~ao !
-----------------------------------------------------------------------------
***THE CODE******************************************************************
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;
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;
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;
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;
end.
]]>