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.