2003. december 26., péntek

Add a size grip to a TForm without using a status bar


Problem/Question/Abstract:

How to add a size grip to a TForm without using a status bar

Answer:

A size grip appears on a form in two cases: when a status bar is placed at the bottom of the form or when the form has both a horizontal and a vertical scrollbar. To place a size grip on a form without any of the above, you need to draw it yourself and handle mouse events. The following unit demonstrates drawing a size grip at the bottom right corner (including XP style, if supported):

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms;

type
  TForm1 = class(TForm)
    procedure FormPaint(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    FSizeGripWidth: Integer;
    FSizeGripHeight: Integer;
    FSizeGripRect: TRect;
    procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses
  Themes;

{$R *.dfm}

procedure TForm1.FormPaint(Sender: TObject);
begin
  if ThemeServices.ThemesAvailable then
  begin
    ThemeServices.DrawElement(Canvas.Handle,
      ThemeServices.GetElementDetails(tsSizeBoxRightAlign), FSizeGripRect);
  end
  else
    DrawFrameControl(Canvas.Handle, FSizeGripRect, DFC_SCROLL, DFCS_SCROLLSIZEGRIP);
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  FSizeGripRect := ClientRect;
  FSizeGripRect.Left := FSizeGripRect.Right - FSizeGripWidth;
  FSizeGripRect.Top := FSizeGripRect.Bottom - FSizeGripHeight;
  Refresh;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FSizeGripWidth := GetSystemMetrics(SM_CXVSCROLL);
  FSizeGripHeight := GetSystemMetrics(SM_CYHSCROLL);
end;

procedure TForm1.WMNCHitTest(var Message: TWMNCHitTest);
begin
  inherited;
  if PtInRect(FSizeGripRect, ScreenToClient(SmallPointToPoint(Message.Pos))) then
    Message.Result := HTBOTTOMRIGHT;
end;

end.

Nincsenek megjegyzések:

Megjegyzés küldése