floatingwindow.pas

Floating Window.It is descendant of TCustomPanel. You can: - Drag on its title bar. - Set title ba

unit FloatingWindow;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, ExtCtrls, Controls;

type
  TTitleBarPosition = (tbTop, tbLeft);

  TFloatingWindow = class(TCustomPanel)
  private
    { Private declarations }
    fExpanded: Boolean;
    fSizeable: Boolean;
    fShowButtons: Boolean;
    fTitleBarPosition: TTitleBarPosition;
    fOnExpand: TNotifyEvent;
    fOnHide: TNotifyEvent;
    fOnShow: TNotifyEvent;
    rCloseButton: TRect;
    rExpandButton: TRect;
    saveHeight: Integer;
    active: Boolean;
    isOverCloseButton: Boolean;
    isOverExpandButton: Boolean;
    procedure DrawClient;
    procedure DrawNonClient;
    procedure WMNCHitTest(var msg: TMessage); message WM_NCHITTEST;
    procedure WMNCCalcSize(var msg: TMessage); message WM_NCCALCSIZE;
    procedure WMNCPaint(var msg: TMessage); message WM_NCPAINT;
    procedure WMWindowPosChanging(var msg: TWMWindowPosChanging); message WM_WINDOWPOSCHANGING;
    procedure CMMouseLeave(var msg: TMessage); message CM_MOUSELEAVE;

    procedure SetCtl3D(Value: Boolean);
    procedure SetExpanded(const Value: Boolean);
    procedure SetTitleBarPosition(const Value: TTitleBarPosition);
    procedure SetShowButtons(const Value: Boolean);
    procedure RotateFont(f: TFont; alpha: Integer);
  protected
    { Protected declarations }
    procedure Paint; override;
    procedure DoEnter; override;
    procedure DoExit; override;
    procedure WndProc(var msg: TMessage); override;
  public
    { Public declarations }
    constructor Create(aOwner: TComponent); override;
    procedure Hide;
    procedure Show;
  published
    { Published declarations }
    property Ctl3D write SetCtl3D;
    property Expanded: Boolean read fExpanded write SetExpanded default true;
    property Sizeable: Boolean read fSizeable write fSizeable default true;
    property ShowButtons: Boolean read fShowButtons write SetShowButtons default true;
    property TitleBarPosition: TTitleBarPosition read fTitleBarPosition write SetTitleBarPosition default tbTop;
    property OnExpand: TNotifyEvent read fOnExpand write fOnExpand;
    property OnHide: TNotifyEvent read fOnHide write fOnHide;
    property OnShow: TNotifyEvent read fOnShow write fOnShow;
  public
    property DockManager;
    property MouseCapture;
  published
    property Align;
    property Alignment;
    property Anchors;
    property AutoSize;
    property BiDiMode;
    property Caption;
    property Color;
    property Constraints;
    property UseDockManager default True;
    property DockSite;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property FullRepaint;
    property Font;
    property Locked;
    property ParentBiDiMode;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnCanResize;
    property OnClick;
    property OnConstrainedResize;
    property OnContextPopup;
    property OnDockDrop;
    property OnDockOver;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnGetSiteInfo;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnResize;
    property OnStartDock;
    property OnStartDrag;
    property OnUnDock;
  end;

procedure Register;

implementation

const
  CAPTION_WIDTH = 16;

{ TFloatingWindow }

procedure TFloatingWindow.CMMouseLeave(var msg: TMessage);
begin
  inherited;
  isOverCloseButton := false;
  isOverExpandButton := false;
  DrawNonClient
end;

constructor TFloatingWindow.Create(aOwner: TComponent);
begin
  inherited;
  Height := 105;
  fExpanded := true;
  fSizeable := true;
  fShowButtons := true;
  fTitleBarPosition := tbTop;
  saveHeight := Height;
end;

procedure TFloatingWindow.DoEnter;
begin
  inherited;
  active := true;
  DrawNonClient;
end;

procedure TFloatingWindow.DoExit;
begin
  inherited;
  active := false;
  DrawNonClient
end;

procedure TFloatingWindow.DrawClient;
begin
  Canvas.Brush.Color := Color;
  Canvas.FillRect(ClientRect)
end;

procedure TFloatingWindow.DrawNonClient;
const
  arrTextColors: array[Boolean] of TColor = (clInactiveCaptionText, clCaptionText);
  arrCaptionColors: array[Boolean] of TColor = (clInactiveCaption, clActiveCaption);
var
  r: TRect;
  cnv: TCanvas;
  k: Byte;
begin
  if csDesigning in ComponentState then active := true;
  r := Rect(0, 0, Width, Height);
  cnv := TCanvas.Create;
  cnv.Handle := GetWindowDC(Handle);

  //Draw window frame
  if Ctl3D then
  begin
    Frame3D(cnv, r, clBtnFace, cl3DDkShadow, 1);
    Frame3D(cnv, r, clWindow, clBtnShadow, 1);
    k := 2;
  end
  else begin
    Frame3D(cnv, r, cl3DDkShadow, cl3DDkShadow, 1);
    k := 1;
  end;

  if fTitleBarPosition = tbTop then
  begin
    //Draw title bar
    r := Rect(k, k, Width - k, CAPTION_WIDTH + k);
    cnv.Font := Font;
    cnv.Font.Color := arrTextColors[active];
    cnv.Brush.Color := arrCaptionColors[active];
    cnv.FillRect(r);
    OffsetRect(r, 4, k - 1);
    Dec(r.Right, 30);
    DrawText(cnv.Handle, PChar(Caption), Length(Caption), r, DT_END_ELLIPSIS);

    if not fShowButtons then
    begin
      SetRectEmpty(rCloseButton);
      SetRectEmpty(rExpandButton)
    end
    else begin
      //Draw buttons
      cnv.Pen.Color := arrTextColors[active];
      cnv.Brush.Color := arrTextColors[active];
      //Draw close button
      rCloseButton := Rect(Width - 12 - k, 2 + k, Width - k, 14 + k);
      r := rCloseButton;
      InflateRect(r, -4, -4);
      if isOverCloseButton then
      begin
        cnv.Pen.Color := clLime;
        cnv.Brush.Color := clLime;
      end
      else begin
        cnv.Pen.Color := arrTextColors[active];
        cnv.Brush.Color := arrTextColors[active];
      end;
      cnv.FillRect(r);
      //Draw expand button
      rExpandButton := Rect(Width - 23 - k, 2 + k, Width - 11 - k, 14 + k);
      if isOverExpandButton then
      begin
        cnv.Pen.Color := clLime;
        cnv.Brush.Color := clLime;
      end
      else begin
        cnv.Pen.Color := arrTextColors[active];
        cnv.Brush.Color := arrTextColors[active];
      end;
      with rExpandButton do
        if Expanded then
          cnv.Polygon([Point(Left + 2, Top + 4), Point(Left + 8, Top + 4), Point(Left + 5, Top + 7)])
        else
          cnv.Polygon([Point(Left + 2, Top + 7), Point(Left + 8, Top + 7), Point(Left + 5, Top + 4)]);
      OffsetRect(rCloseButton, -k, -CAPTION_WIDTH - k);
      OffsetRect(rExpandButton, -k, -CAPTION_WIDTH - k)
    end
  end
  else begin //tbLeft
    //Draw title bar
    r := Rect(k, k, CAPTION_WIDTH + k, Height - k);
    cnv.Font := Font;
    cnv.Font.Color := arrTextColors[active];
    cnv.Brush.Color := arrCaptionColors[active];
    cnv.FillRect(r);
    OffsetRect(r, k - 2, 11);
    r.Right := r.Bottom - r.Top + r.Left - 30;
    RotateFont(cnv.Font, 90);
    DrawText(cnv.Handle, PChar(Caption), Length(Caption), r, DT_END_ELLIPSIS or DT_BOTTOM or DT_SINGLELINE);

    if not fShowButtons then
    begin
      SetRectEmpty(rCloseButton);
      SetRectEmpty(rExpandButton)
    end
    else begin
      //Draw buttons
      //Draw close button
      rCloseButton := Rect(2 + k, k, 14 + k, 12 + k);
      r := rCloseButton;
      InflateRect(r, -4, -4);
      if isOverCloseButton then
      begin
        cnv.Pen.Color := clLime;
        cnv.Brush.Color := clLime;
      end
      else begin
        cnv.Pen.Color := arrTextColors[active];
        cnv.Brush.Color := arrTextColors[active];
      end;
      cnv.FillRect(r);
      //Draw expand button
      rExpandButton := Rect(2 + k, 11 + k, 14 + k, 23 + k);
      if isOverExpandButton then
      begin
        cnv.Pen.Color := clLime;
        cnv.Brush.Color := clLime;
      end
      else begin
        cnv.Pen.Color := arrTextColors[active];
        cnv.Brush.Color := arrTextColors[active];
      end;
      with rExpandButton do
        if Expanded then
          cnv.Polygon([Point(Left + 4, Top + 2), Point(Left + 4, Top + 8), Point(Left + 7, Top + 5)])
        else
          cnv.Polygon([Point(Left + 7, Top + 2), Point(Left + 7, Top + 8), Point(Left + 4, Top + 5)]);
      OffsetRect(rCloseButton, -CAPTION_WIDTH - k, -k);
      OffsetRect(rExpandButton, -CAPTION_WIDTH - k, -k)
    end
  end;

  cnv.Handle := 0;
  cnv.Free
end;