[Back to DELPHI SWAG index]  [Back to Main SWAG index]  [Original]

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:

Cut out the DFM, DPR and PAS files below :

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.

{ DFM FILE - form file}

object Form1: TForm1
  Left = 245
  Top = 137
  BorderStyle = bsNone
  Caption = 'Form1'
  ClientHeight = 101
  ClientWidth = 198
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  PixelsPerInch = 96
  TextHeight = 13
  object Panel1: TPanel
    Left = 8
    Top = 8
    Width = 185
    Height = 41
    BorderStyle = bsSingle
    Caption = 'Panel1'
    TabOrder = 0
    OnMouseDown = Panel1MouseDown
    OnMouseMove = Panel1MouseMove
    OnMouseUp = Panel1MouseUp
  end
  object Panel2: TPanel
    Left = 8
    Top = 56
    Width = 185
    Height = 41
    Caption = 'Come Caption'
    TabOrder = 1
    object Button1: TButton
      Left = 52
      Top = 8
      Width = 87
      Height = 25
      Caption = 'Toggle Title Bar'
      TabOrder = 0
      OnClick = Button1Click
    end
  end
end

{ DPR FILE }

program Project1;

uses
  Forms,
  Unit1 in 'Unit1.pas' {Form1};

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

[Back to DELPHI SWAG index]  [Back to Main SWAG index]  [Original]