2010. április 30., péntek

Drawing a form border


Problem/Question/Abstract:

How to change the appearance of a forms border?

Answer:

Solve 1:

Actually, it is very easy top change the standard frame border, just by capturing the two events of Non-Client-Paint and Non-Client-Activate and calling your own drawing at your own will onto the form.

First, you will have to find the width of your frame border, which can be done by using the GetSystemMetrics method. Now you can do whatever you want within the canvas, however, you should not leave the frame area.

type
  TForm1 = class(TForm)
  private
    procedure FormFrame;
    procedure WMNCPaint(var Msg: TWMNCPaint); message WM_NCPAINT;
    procedure WMNCActivate(var Msg: TWMNCActivate); message WM_NCACTIVATE;
  public
  end;

procedure TForm1.FormFrame;
var
  YFrame: Integer;
  Rect: TRect;
begin
  YFrame := GetSystemMetrics(SM_CYFRAME);
  Canvas.Handle := GetWindowDC(Handle);
  with Canvas, Rect do
  begin
    Left := 0;
    Top := 0;
    Right := Width;
    Bottom := Height;
    Pen.Style := psClear;

    // draw background of frame
    Brush.Color := clNavy;
    Brush.Style := bsSolid;
    Rectangle(Left, Top, Right, YFrame);
    Rectangle(Left, Top, YFrame, Bottom);
    Rectangle(Right - YFrame, Top, Right, Bottom);
    Rectangle(Left, Bottom - YFrame, Right, Bottom);

    // draw frame pattern
    Brush.Color := clYellow;
    Brush.Style := bsDiagCross;
    Rectangle(Left, Top, Right, YFrame);
    Rectangle(Left, Top, YFrame, Bottom);
    Rectangle(Right - YFrame, Top, Right, Bottom);
    Rectangle(Left, Bottom - YFrame, Right, Bottom);
  end;
end;

procedure TForm1.WMNCActivate(var Msg: TWMNCActivate);
begin
  inherited;
  FormFrame;
end;

procedure TForm1.WMNCPaint(var Msg: TWMNCPaint);
begin
  inherited;
  FormFrame;
end;

If you will have problem when maximizing the form, resize if to the right or the Title caption bar will not update properly, you may try to catch the WM_SIZE message.

procedure WMSize(var Msg: TWMSize); message WM_SIZE;
...
procedure TForm1.WMSize(var Msg: TWMSize);
begin
  inherited;
  FormFrame;
end;


Solve 2:

This will paint a one pixel red border around the entire window.

type
  TForm1 = class(TForm)
  private
    { Private declarations }
    procedure WMNCPaint(var Msg: TWMNCPaint); message WM_NCPAINT;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.WMNCPaint(var Msg: TWMNCPaint);
var
  dc: hDc;
  Pen: hPen;
  OldPen: hPen;
  OldBrush: hBrush;
begin
  inherited;
  dc := GetWindowDC(Handle);
  msg.Result := 1;
  Pen := CreatePen(PS_SOLID, 1, RGB(255, 0, 0));
  OldPen := SelectObject(dc, Pen);
  OldBrush := SelectObject(dc, GetStockObject(NULL_BRUSH));
  Rectangle(dc, 0, 0, Form1.Width, Form1.Height);
  SelectObject(dc, OldBrush);
  SelectObject(dc, OldPen);
  DeleteObject(Pen);
  ReleaseDC(Handle, Canvas.Handle);
end;

Nincsenek megjegyzések:

Megjegyzés küldése