Mega Code Archive
Changing my forms border color [custom border]
<![CDATA[
Question:
I need to change the color for my form's border within my application without changing the systemwide setting.
Answer:
You could set BorderStyle to bsNone and draw it yourself. This involves also drawing the caption bar. It's cleaner to intercept the WM_NCPAINT windows message and do your own drawing there.
Below is a unit (originally by C. Wijffels) that does this. Method TBcForm.GetCaptionRect shows how to calculate the to be painted rectangle using GetSystemMetrics() (in that case for the caption bar; the calculation for custom borders will be slightly different).
unit sBcForm;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
DsgnIntF;
type
TBcForm = class(TForm)
private
{ private declarations }
FCaption: TCaption;
procedure CMFontChanged(var Msg: TMessage);
message CM_FONTCHANGED;
procedure WMWinIniChange(var Msg: TWMWinIniChange);
message WM_WININICHANGE;
procedure WMNCPaint(var Msg: TWMNCPaint);
message WM_NCPAINT;
procedure WMNCActivate(var Msg: TWMNCActivate);
message WM_NCACTIVATE;
procedure WMSetText(var Msg: TWMSetText);
message WM_SETTEXT;
procedure WMSysCommand(var Msg: TWMSysCommand);
message WM_SYSCOMMAND;
procedure WMGetMinMaxInfo(var Msg: TWMGetMinMaxInfo);
message WM_GETMINMAXINFO;
procedure DrawCaption(AActive: boolean);
function GetCaptionRect : TRect;
procedure SetCaption(const Value: TCaption);
protected
{ protected declarations }
public
{ public declarations }
constructor Create(AOwner: TComponent);
override;
published
{ published declarations }
property Caption : TCaption read FCaption write SetCaption;
end;
procedure register;
implementation
procedure register;
begin { register }
RegisterCustomModule(TBcForm, TCustomModule)
end; { register }
{ TBcForm }
constructor TBcForm.Create(AOwner: TComponent);
begin { TBcForm.Create }
inherited;
inherited Caption := ''
end; { TBcForm.Create }
function TBcForm.GetCaptionRect : TRect;
var
iRect: TRect;
begin { TBcForm.GetCaptionRect }
with iRect do
if (csDesigning in ComponentState) then
begin
Top := GetSystemMetrics(SM_CYSIZEFRAME);
Bottom := Top;
Left := GetSystemMetrics(SM_CXBORDER) + GetSystemMetrics(SM_CXSIZEFRAME);
Right := 2 * Left + GetSystemMetrics(SM_CXSIZEFRAME) +
3 * GetSystemMetrics(SM_CXSIZE);
Bottom := Bottom + GetSystemMetrics(SM_CYSIZE);
Left := Left + GetSystemMetrics(SM_CXSIZE)
end { (csDesigning in ComponentState) }
else
begin
if (BorderStyle in [bsSizeable, bsSizeToolWin]) then
begin
Top := GetSystemMetrics(SM_CYSIZEFRAME);
Bottom := Top;
Left := GetSystemMetrics(SM_CXBORDER) + GetSystemMetrics(SM_CXSIZEFRAME);
Right := 2 * Left + GetSystemMetrics(SM_CXSIZEFRAME)
end { (BorderStyle in [bsSizeable, bsSizeToolWin]) }
else
begin
Top := GetSystemMetrics(SM_CYFIXEDFRAME);
Bottom := Top;
Left := GetSystemMetrics(SM_CXBORDER) + GetSystemMetrics(SM_CXFIXEDFRAME);
Right := 2 * Left + GetSystemMetrics(SM_CXFIXEDFRAME)
end; { not ((BorderStyle in [bsSizeable, bsSizeToolWin])) }
if (BorderStyle in [bsToolWindow, bsSizeToolWin]) then
begin
Bottom := Bottom + GetSystemMetrics(SM_CYSMSIZE)
end { (BorderStyle in [bsToolWindow, bsSizeToolWin]) }
else
begin
Bottom := Bottom + GetSystemMetrics(SM_CYSIZE);
if (BorderStyle<>bsDialog)
and
(biSystemMenu in BorderIcons) then
Left := Left + GetSystemMetrics(SM_CXSIZE)
end; { not ((BorderStyle in [bsToolWindow, bsSizeToolWin])) }
if (BorderStyle in [bsToolWindow, bsSizeToolWin, bsDialog]) then
begin
if (biSystemMenu in BorderIcons) then
begin
Right := Right + GetSystemMetrics(SM_CXSIZE);
if (biHelp in BorderIcons) then
Right := Right + GetSystemMetrics(SM_CXSIZE)
end; { (biSystemMenu in BorderIcons) }
end { (BorderStyle in [bsToolWindow, bsSizeToolWin, bsDialog]) }
else
if (biSystemMenu in BorderIcons) then
begin
Right := Right + GetSystemMetrics(SM_CXSIZE);
if (biMinimize in BorderIcons)
or
(biMaximize in BorderIcons) then
Right := Right + 2 * GetSystemMetrics(SM_CXSIZE)
else
if (biHelp in BorderIcons) then
Right := Right + GetSystemMetrics(SM_CXSIZE)
end; { (biSystemMenu in BorderIcons) }
end; { not ((csDesigning in ComponentState)) }
GetWindowRect(Handle, Result);
Result.Right := Result.Right - Result.Left - iRect.Right;
Result.Left := iRect.Left;
Result.Top := iRect.Top;
Result.Bottom := iRect.Bottom
end; { TBcForm.GetCaptionRect }
procedure TBcForm.DrawCaption(AActive: boolean);
var
iNCM: TNonClientMetrics;
iRect: TRect;
iCanvas: TCanvas;
iFlags: integer;
begin { TBcForm.DrawCaption }
if (BorderStyle<>bsNone) then
begin
iRect := GetCaptionRect;
iCanvas := TCanvas.Create;
iCanvas.Handle := GetWindowDC(Handle);
with iCanvas do
try
Font := Self.Font;
iNCM.cbSize := SizeOf(iNCM);
SystemParametersInfo(SPI_GETNONCLIENTMETRICS, SizeOf(iNCM), @iNCM,
0);
if (BorderStyle in [bsToolWindow, bsSizeToolWin]) then
Font.Height := ((iNCM.lfCaptionFont.lfHeight * 7) div
8)
else
Font.Height := iNCM.lfCaptionFont.lfHeight;
if (iNCM.lfCaptionFont.lfWeight<700) then
Font.Style := []
else
Font.Style := [fsBold];
Brush.Style := bsClear;
iFlags := DT_EXPANDTABS or DT_LEFT or DT_VCENTER or DT_SINGLELINE or
DT_END_ELLIPSIS;
iFlags := DrawTextBiDiModeFlags(iFlags);
if (AActive) then
begin
Font.Color := GetSysColor(COLOR_BACKGROUND);
OffsetRect(iRect, +1, +1);
DrawText(Handle, PChar(Caption), -1, iRect, iFlags);
OffsetRect(iRect, -1, -1);
Font.Color := GetSysColor(COLOR_CAPTIONTEXT)
end { (AActive) }
else
Font.Color := GetSysColor(COLOR_INACTIVECAPTIONTEXT);
DrawText(Handle, PChar(Caption), -1, iRect, iFlags)
finally
ReleaseDC(Self.Handle, Handle);
iCanvas.Free
end; { try }
end; { (BorderStyle<>bsNone) }
end; { TBcForm.DrawCaption }
procedure TBcForm.WMNCActivate(var Msg: TWMNCActivate);
begin { TBcForm.WMNCActivate }
inherited;
DrawCaption(Msg.Active)
end; { TBcForm.WMNCActivate }
procedure TBcForm.WMNCPaint(var Msg: TWMNCPaint);
begin { TBcForm.WMNCPaint }
inherited;
DrawCaption(Active)
end; { TBcForm.WMNCPaint }
procedure TBcForm.WMSetText(var Msg: TWMSetText);
begin { TBcForm.WMSetText }
inherited;
DrawCaption(Active)
end; { TBcForm.WMSetText }
procedure TBcForm.WMSysCommand(var Msg: TWMSysCommand);
begin { TBcForm.WMSysCommand }
inherited;
DrawCaption(Active)
end; { TBcForm.WMSysCommand }
procedure TBcForm.WMGetMinMaxInfo(var Msg: TWMGetMinMaxInfo);
begin { TBcForm.WMGetMinMaxInfo }
inherited
// Msg.MinMaxInfo.ptMinTrackSize := Point(630, 475);
end; { TBcForm.WMGetMinMaxInfo }
procedure TBcForm.SetCaption(const Value: TCaption);
begin { TBcForm.SetCaption }
if (FCaption<>Value) then
begin
FCaption := Value;
Perform(WM_NCPAINT, 0, 0)
end; { (FCaption<>Value) }
end; { TBcForm.SetCaption }
procedure TBcForm.CMFontChanged(var Msg: TMessage);
begin { TBcForm.CMFontChanged }
inherited;
Perform(WM_NCPAINT, 0, 0)
end; { TBcForm.CMFontChanged }
procedure TBcForm.WMWinIniChange(var Msg: TWMWinIniChange);
begin { TBcForm.WMWinIniChange }
inherited;
Perform(WM_NCPAINT, 0, 0)
end; { TBcForm.WMWinIniChange }
end.
]]>