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;
Feliratkozás:
Megjegyzések küldése (Atom)
Nincsenek megjegyzések:
Megjegyzés küldése