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.