Creating Forms with Custom Title Bars (Part II)

Copyright © 1995, Mark R. Johnson

RETURN TO: Creating Forms with Custom Title Bars (Pt. I)

1. Responding to WM_NCxxxx Messages

The WM_NCxxxx messages refer to the non-client area of the window. This area includes the title bar, close button, minimize & maximize buttons, and window border. We will need to respond to the following messages:

This section contains by far the largest portion of code necessary to customize a window's title bar.

Add the following lines between the private and public sections of the TForm1 declaration:

  ...
  protected
    { Protected declarations }
    procedure WndProc(var Message : TMessage); override;
    procedure WMNCCreate(var Message : TWMNCCreate); message WM_NCCREATE;
    procedure WMNCCalcSize(var Message : TWMNCCalcSize); message WM_NCCALCSIZE;
    procedure WMNCHitTest(var Message : TWMNCHitTest); message WM_NCHITTEST;
    procedure WMNCLButtonDblClk(var Message : TWMNCLButtonDblClk); message WM_NCLBUTTONDBLCLK;
    procedure WMNCLButtonDown(var Message : TWMNCLButtonDown); message WM_NCLBUTTONDOWN;
  ...

WM_NCCREATE

In response to the WM_NCCREATE message, we need to modify the form's window style to indicate that it has a small title bar. We also have to make sure that the window does not have the WS_DLGFRAME style, since WS_DLGFRAME and small title bars do not mix well. Here we will also set the initial size of the title bar and the initial state of the window's system menu (hidden), after which, control is passed to the original message handler for default processing.

(Note: Since Windows API functions and types are being used in this project, make sure WinTypes and WinProcs appear in the uses clause of the interface section.)

First, we need to define a window style for small title bars. Add the following constant declaration to the interface section of the unit after the uses clause:

const
  WS_SMALLTITLEBAR : longint = $4000;

Next, we need a place to store the height of the title bar and the state of the system menu. Add the following variables to the private section of the TForm1 declaration:

  ...
    fMenuUp : boolean;       {state of the system menu}
    TitleBarSize : integer;  {height of the title bar in pixels}
  ...

Although it is not used in WMNCCreate(), upcoming procedures will need a way to test for specific window styles. Add the following function declaration to the private section below the TitleBarSize variable, and add the function definition to the implementation section of the unit:

  ...
    function TestWinStyle(dwStyleBit : longint) : boolean;
  ...

function TForm1.TestWinStyle(dwStyleBit : longint) : boolean;
begin
  Result := ((GetWindowLong(Handle, GWL_STYLE) and dwStyleBit) <> 0);
end;

Finally, in response to WM_NCCREATE, we need to set the default small title bar size and to remove the WS_DLGFRAME window style (if present). Add the following procedure definition to the unit's implementation section:

procedure TForm1.WMNCCreate(var Message : TWMNCCreate);
var
  dwStyle : longint;
begin
  fMenuUp := false;  {System menu not initially showing}
  TitleBarSize := (GetSystemMetrics(SM_CYCAPTION) div 2) + 1;
  dwStyle := GetWindowLong(Handle, GWL_STYLE);
  dwStyle := dwStyle or WS_SMALLTITLEBAR;
  if (dwStyle and WS_DLGFRAME) = WS_DLGFRAME then
    dwStyle := dwStyle and not longint(WS_DLGFRAME);
  SetWindowLong(Handle, GWL_STYLE, dwStyle);
  inherited;  {Call default processing.}
end;

WM_NCCALCSIZE

The WM_NCCALCSIZE message is sent to a window when the size and position of its client area needs to be calculated. Since we are creating the title bar, we need to calculate the size of the client area in order to adjust for the custom title bar size.

First, we need to make sure the WS_SMALLTITLEBAR window style is set for this window. Add the following function declaration to the private section below the TestWinStyle() declaration, and add the function definition to the implementation section of the unit:

  ...
    function HasCaption : boolean;
  ...

function TForm1.HasCaption : boolean;
begin
  Result := TestWinStyle(WS_SMALLTITLEBAR);
end;

If the window has a custom title bar and is not minimized, we calculate the size of the client area by incrementing the top edge of the rectangle returned by the default message handler. (See the Delphi on-line help for a definition of the TWMNCCalcSize and TNCCALCSIZE_PARAMS structures.) Add the following procedure definition to the implementation section of the unit:

procedure TForm1.WMNCCalcSize(var Message : TWMNCCalcSize);
begin
  inherited;  {Call default processing.}
  if HasCaption and not IsIconic(Handle) then
    Inc(Message.CalcSize_Params^.rgrc[0].top, TitleBarSize);
end;

WM_NCHITTEST

The WM_NCHITTEST message is sent to a window any time the mouse moves over it. In response, the window is expected to determine if the mouse has moved over the frame, control box, or min/max buttons and return the appropriate value in Result. This value is then passed back to the window in the WM_NCLBUTTONxxxx messages, among others.

For our purposes, we will allow the default message handler take care of the standard borders (since we have not altered them). However, if the default handler returns HTNOWHERE, then we will need to check for positioning over the control box, caption, or min/max buttons. Before we can do this, however, we need to define functions for calculating the bounding rectangles of each of these items.

Add the following functions declarations to the private section of TForm1, and add the corresponding definitions to the implementation section of the unit:

  ...
    function GetTitleBarRect(var rc : TRect) : boolean;
    function GetControlBoxRect(var rc : TRect) : boolean;
    function GetMinButtonRect(var rc : TRect) : boolean;
    function GetMaxButtonRect(var rc : TRect) : boolean;
    function GetButtonRect(nPos : word; var rc : TRect) : boolean;
  ...

function TForm1.GetTitleBarRect(var rc : TRect) : boolean;
begin
  Result := false;  {Initially assume no caption.}
  if HasCaption then begin
    GetWindowRect(Handle, rc);
    if TestWinStyle(WS_THICKFRAME) then  {Adjust for borders.}
      InflateRect(rc, -GetSystemMetrics(SM_CXFRAME),
                      -GetSystemMetrics(SM_CYFRAME))
    else if TestWinStyle(DS_MODALFRAME) then
      InflateRect(rc, -(GetSystemMetrics(SM_CXDLGFRAME)
                      + GetSystemMetrics(SM_CXBORDER)),
                      -(GetSystemMetrics(SM_CYDLGFRAME)
                      + GetSystemMetrics(SM_CYBORDER)))
    else if TestWinStyle(WS_BORDER) then
      InflateRect(rc, -GetSystemMetrics(SM_CXBORDER),
                      -GetSystemMetrics(SM_CYBORDER));
    rc.bottom := rc.top + TitleBarSize;
    Result := true;
  end else
    SetRectEmpty(rc);
end;

function TForm1.GetControlBoxRect(var rc : TRect) : boolean;
begin
  Result := false;  {Initially assume no control box.}
  if GetTitleBarRect(rc) then begin
    if TestWinStyle(WS_SYSMENU) then begin
      rc.right := rc.left + TitleBarSize - 1;
      Dec(rc.bottom);
      Result := true;
    end else
      SetRectEmpty(rc);
  end;
end;

function TForm1.GetMinButtonRect(var rc : TRect) : boolean;
begin
  Result := false;  {Initially assume no min. button.}
  if TestWinStyle(WS_MINIMIZEBOX) then begin
    if TestWinStyle(WS_MAXIMIZEBOX) then  {If win has a maximize box,}
      Result := GetButtonRect(2, rc)      {min. box is in position 2.}
    else                                  {Otherwise,                }
      Result := GetButtonRect(1, rc);     {min. box is in position 1.}
  end else
    SetRectEmpty(rc);
end;

function TForm1.GetMaxButtonRect(var rc : TRect) : boolean;
begin
  Result := false;  {Initially assume no max. button.}
  if TestWinStyle(WS_MAXIMIZEBOX) then
    Result := GetButtonRect(1, rc)
  else
    SetRectEmpty(rc);
end;

function TForm1.GetButtonRect(nPos : word; var rc : TRect) : boolean;
begin
  Result := false;  {Initially assume no button.}
  if GetTitleBarRect(rc) then begin
    Dec(rc.right, TitleBarSize * (nPos - 1));
    rc.left := rc.right - TitleBarSize + 1;
    Result := true;
  end;
end;

Now add the WMNCHitTest procedure to the implementation section of the unit:

procedure TForm1.WMNCHitTest(var Message : TWMNCHitTest);
var
  rcCap  : TRect;
  rcMenu : TRect;
  rcMin  : TRect;
  rcMax  : TRect;
begin
  inherited;  {Call default processing.}
  if (Message.Result = HTNOWHERE) and HasCaption and not IsIconic(Handle) then begin
    GetTitleBarRect(rcCap);
    if PtInRect(rcCap, Message.Pos) then begin
      Message.Result := HTCAPTION;
      GetControlBoxRect(rcMenu);
      GetMinButtonRect(rcMin);
      GetMaxButtonRect(rcMax);
      if PtInRect(rcMenu, Message.Pos) then
        Message.Result := HTSYSMENU
      else if PtInRect(rcMin, Message.Pos) then
        Message.Result := HTMINBUTTON
      else if PtInRect(rcMax, Message.Pos) then
        Message.Result := HTMAXBUTTON;
    end;
  end;
  if Message.Result <> HTSYSMENU then
    fMenuUp := false;  {Indicate the system menu is not showing}
end;

WM_NCLBUTTONDBLCLK

The WM_NCLBUTTONDBLCLK message is sent to a window when the left mouse button has been double-clicked over the non-client area. In response to this message, the default handler typically checks if the mouse was positioned over the control box when the double-click occurred. If so, it closes the window. Since we have changed the size of the control box for our small title bar, we must catch this message and perform the checking ourselves.

Add the WMNCLButtonDblClk procedure to the implementation section of the unit:

procedure TForm1.WMNCLButtonDblClk(var Message : TWMNCLButtonDblClk);
begin
  if (Message.HitTest = HTSYSMENU) and HasCaption and not IsIconic(Handle) then
    SendMessage(Handle, WM_CLOSE, 0, 0)
  else
    inherited;  {Call default processing.}
end;

WM_NCLBUTTONDOWN

The WM_NCLBUTTONDOWN message is sent to a window when the left mouse button has been pressed while positioned over the non-client area of the window. Since we are drawing the control box and min/max buttons for our small title bars, we have to handle the WM_NCLBUTTONDOWN message.

When the mouse is positioned over the min. or max. button, we need to draw the button as though it were pressed down. We must then enter a loop in which we capture the subsequent activity of the mouse until the button is released. If the button is released while over the appropriate min/max button, then we can act on that button press.

First, since the system menu (or "control menu") can be reached by clicking the left mouse button over the control box, we need to add a few functions to draw the control box and show the menu. Add the following function & procedure declarations to the private section of TForm1, and the definitions to the implementation section of the unit:

  ...
    function DoMenu : boolean;
    procedure SetupSystemMenu(menu : HMenu);
    procedure DrawControlBox(dc : HDC; fInvert : boolean);
  ...

function TForm1.DoMenu : boolean;
var
  dc   : HDC;
  rc   : TRect;
  pt   : TPoint;
  menu : HMenu;
begin
  Result := false;  {Initially assume no menu}
  if TestWinStyle(WS_SYSMENU) then begin
    dc := GetWindowDC(Handle);
    if dc <> 0 then begin
      {Invert the control box}
      DrawControlBox(dc, true);
      {Pop up the mock-system menu}
      pt := Point(0, -1);
      GetWindowRect(Handle, rc);
      {Convert coordinates to screen coords. using functions in WinProcs unit}
      {("WinProcs" must be given to avoid calling TForm1's ClientToScreen() )}
      WinProcs.ClientToScreen(Handle, pt);
      WinProcs.ClientToScreen(Handle, rc.BottomRight);
      menu := GetSystemMenu(Handle, false);
      SetupSystemMenu(menu);
      TrackPopupMenu(menu, 0, pt.x, pt.y, 0, Handle, @rc);
      DrawControlBox(dc, false);
      ReleaseDC(Handle, dc);
    end;
    Result := true;
  end;
end;

procedure TForm1.SetupSystemMenu(menu : HMenu);
var
  wMove    : word;
  wSize    : word;
  wMinBox  : word;
  wMaxBox  : word;
  wRestore : word;
begin
  {Initially assume all menu items should be grayed}
  wMove    := MF_GRAYED;
  wSize    := MF_GRAYED;
  wMinBox  := MF_GRAYED;
  wMaxBox  := MF_GRAYED;
  wRestore := MF_GRAYED;
  {Now check the window styles, etc.}
  if not (IsIconic(Handle) or IsZoomed(Handle)) then begin
    if TestWinStyle(WS_CAPTION) then
      wMove := MF_ENABLED;
    if TestWinStyle(WS_THICKFRAME) then
      wSize := MF_ENABLED;
  end;
  if TestWinStyle(WS_MINIMIZEBOX) then
    wMinBox := MF_ENABLED;
  if TestWinStyle(WS_MAXIMIZEBOX) or IsIconic(Handle) then
    wMaxBox := MF_ENABLED;
  if IsZoomed(Handle) then
    wRestore := MF_ENABLED;
  EnableMenuItem(menu, SC_MOVE,     wMove);
  EnableMenuItem(menu, SC_SIZE,     wSize);
  EnableMenuItem(menu, SC_MINIMIZE, wMinBox);
  EnableMenuItem(menu, SC_MAXIMIZE, wMaxBox);
  EnableMenuItem(menu, SC_RESTORE,  wRestore);
end;

procedure TForm1.DrawControlBox(dc : HDC; fInvert : boolean);
var
  rc    : TRect;
  rcBox : TRect;
begin
  {Prepare to draw the control box}
  if dc <> 0 then begin
    {Calculate size and position of control box in window coords.}
    GetControlBoxRect(rcBox);
    GetWindowRect(Handle, rc);
    OffsetRect(rcBox, -rc.left, -rc.top);
    {Calculate separator line to right of control box}
    rc := rcBox;
    rc.left := rc.right;
    Inc(rc.right);
    {Fill control box area}
    SetBkColor(dc, ColorToRGB(clSilver));
    ExtTextOut(dc, 0, 0, ETO_OPAQUE, @rcBox, nil, 0, nil);
    {Draw separator line}
    SetBkColor(dc, ColorToRGB(clWindowFrame));
    ExtTextOut(dc, 0, 0, ETO_OPAQUE, @rc, nil, 0, nil);
    {If title bar isn't too small, draw the lil' horizontal doo-hickey}
    if TitleBarSize > 4 then begin
      rc := rcBox;
      rc.top    := rcBox.top + ((TitleBarSize - 1) div 2);
      rc.bottom := rc.top + 3;
      rc.left   := rc.left + 3;
      rc.right  := rc.right - 1;
      SetBKColor(dc, ColorToRGB(clGray));
      ExtTextOut(dc, 0, 0, ETO_OPAQUE, @rc, nil, 0, nil);
      OffsetRect(rc, -1, -1);
      SetBkColor(dc, ColorToRGB(clBlack));
      ExtTextOut(dc, 0, 0, ETO_OPAQUE, @rc, nil, 0, nil);
      InflateRect(rc, -1, -1);
      SetBkColor(dc, ColorToRGB(clWhite));
      ExtTextOut(dc, 0, 0, ETO_OPAQUE, @rc, nil, 0, nil);
    end;
  end;
  {Invert the control box if needed}
  if fInvert then
    InvertRect(dc, rcBox);
end;

For drawing arrows on the min./max. buttons, add the following type declaration to the interface section of the unit, above the TForm1 declaration:

type
  TButtonArrow = (arwUp, arwDown, arwRestore);

Next, we need to add code for drawing the min./max. buttons in the normal and pressed states. Add the following function & procedure declarations to the private section of TForm1, and the definitions to the implementation section of the unit:

  ...
    function DepressMinMaxButton(HitTest : word; var rc : TRect) : boolean;
    procedure DrawButton(dc : HDC; fMin, fDepressed : boolean);
    procedure DrawArrow(dc : HDC; const rc : TRect; style : TButtonArrow);
  ...
function TForm1.DepressMinMaxButton(HitTest : word; var rc : TRect) : boolean;
var
  msg        : TMsg;
  fDepressed : boolean;
  fDone      : boolean;
begin
  fDone := false;  {we've only just begun}
  fDepressed := true;  {initially draw button in down state}
  DrawButton(0, (HitTest = HTMINBUTTON), fDepressed);
  SetCapture(Handle);  {collect all mouse events until WM_LBUTTONUP}
  while not fDone do begin  {loop until the button is released}
    if PeekMessage(msg, 0, WM_MOUSEFIRST, WM_MOUSELAST, PM_REMOVE) then begin
      case msg.message of
      WM_LBUTTONUP:
        begin
          if fDepressed then
            DrawButton(0, (HitTest = HTMINBUTTON), not fDepressed);
          ReleaseCapture;
          Result := PtInRect(rc, msg.pt);
          fDone  := true;
        end;
      WM_MOUSEMOVE:
        if PtInRect(rc, msg.pt) then begin
          if not fDepressed then begin
            fDepressed := true;
            DrawButton(0, (HitTest = HTMINBUTTON), fDepressed);
          end;
        end else begin
          if fDepressed then begin
            fDepressed := false;
            DrawButton(0, (HitTest = HTMINBUTTON), fDepressed);
          end;
        end;
      end;
    end;
  end;
end;

procedure TForm1.DrawButton(dc : HDC; fMin, fDepressed : boolean);
const
  THRESHOLD = 20; {if button less than 20 pixels, use one line of shadow}
var
  rc          : TRect;
  rcButton    : TRect;
  fDC         : boolean;  {did we have to create the DC here?   }
  nOffset     : word;     {displacement by button shadow/hilight}
  n           : integer;
begin
  if TitleBarSize >= THRESHOLD then
    nOffset := 2
  else
    nOffset := 1;
  if dc = 0 then begin
   fDC := true;
   dc  := GetWindowDC(Handle);
  end else
    fDC := false;
  if dc <> 0 then begin
    {Get size & position of button, and convert to window coordinates}
    if fMin then
      GetMinButtonRect(rcButton)
    else
      GetMaxButtonRect(rcButton);
    GetWindowRect(Handle, rc);
    OffsetRect(rcButton, -rc.left, -rc.top);
    {Draw vertical separator line to the left of button}
    rc := rcButton;
    rc.right := rc.left;
    Dec(rc.left);
    Dec(rcButton.bottom);
    SetBkColor(dc, ColorToRGB(clWindowFrame));
    ExtTextOut(dc, 0, 0, ETO_OPAQUE, @rc, nil, 0, nil);
    {Fill button area}
    SetBkColor(dc, ColorToRGB(clSilver));
    ExtTextOut(dc, 0, 0, ETO_OPAQUE, @rcButton, nil, 0, nil);
    if not fDepressed then begin
      {Draw button hilight (left & top)}
      SetBkColor(dc, ColorToRGB(clWhite));
      {Left edge}
      rc := rcButton;
      rc.right := rc.left + 1;
      ExtTextOut(dc, 0, 0, ETO_OPAQUE, @rc, nil, 0, nil);
      {Top edge}
      rc := rcButton;
      rc.bottom := rc.top + 1;
      ExtTextOut(dc, 0, 0, ETO_OPAQUE, @rc, nil, 0, nil);
      {Draw button shadow (right & bottom)}
      SetBkColor(dc, ColorToRGB(clGray));
      {Right edge}
      rc := rcButton;
      rc.left := rc.right - 1;
      ExtTextOut(dc, 0, 0, ETO_OPAQUE, @rc, nil, 0, nil);
      if TitleBarSize > THRESHOLD then begin
        Dec(rc.left);
        Inc(rc.top);
        ExtTextOut(dc, 0, 0, ETO_OPAQUE, @rc, nil, 0, nil);
      end;
      {Bottom edge}
      rc := rcButton;
      rc.top := rc.bottom - 1;
      ExtTextOut(dc, 0, 0, ETO_OPAQUE, @rc, nil, 0, nil);
      if TitleBarSize > THRESHOLD then begin
        Dec(rc.top);
        Inc(rc.left);
        ExtTextOut(dc, 0, 0, ETO_OPAQUE, @rc, nil, 0, nil);
      end;
      {Adjust rcButton to everything inside the shadows/hilights}
      Inc(rcButton.left);
      Inc(rcButton.top);
      Dec(rcButton.right,  nOffset);
      Dec(rcButton.bottom, nOffset);
    end else begin
      {Draw depressed state}
      SetBkColor(dc, ColorToRGB(clGray));
      {Left edge}
      rc := rcButton;
      rc.right := rc.left + nOffset;
      ExtTextOut(dc, 0, 0, ETO_OPAQUE, @rc, nil, 0, nil);
      {Top edge}
      rc := rcButton;
      rc.bottom := rc.top + nOffset;
      ExtTextOut(dc, 0, 0, ETO_OPAQUE, @rc, nil, 0, nil);
      {Adjust rcButton to everything inside the shadows/hilights}
      Inc(rcButton.left, 2 * nOffset);
      Inc(rcButton.top,  2 * nOffset);
    end;
    {Draw the arrows, restricting their size for larger than normal title bars.}
    {A good maximum size for arrows is (SM_CYCAPTION div 2).                   }
    n := (GetSystemMetrics(SM_CYCAPTION) div 2)
         - (rcButton.right - rcButton.left);
    if n < 1 then
      InflateRect(rcButton, (n div 2) - 1, (n div 2) - 1);
    if fMin then
      DrawArrow(dc, rcButton, arwDown)
    else if IsZoomed(Handle) then
      DrawArrow(dc, rcButton, arwRestore)
    else
      DrawArrow(dc, rcButton, arwUp);
    {Release the DC if we created in this procedure}
    if fDC then
      ReleaseDC(Handle, dc);
  end;
end;

procedure TForm1.DrawArrow(dc : HDC; const rc : TRect; style : TButtonArrow);
var
  row     : integer;
  xTip    : integer;
  yTip    : integer;
  rcArrow : TRect;
  nMax    : integer;
begin
  nMax := (rc.bottom - rc.top) shr 1;
  {The arrow is drawn as a series of horizontal lines}
  SetBkColor(dc, ColorToRGB(clBlack));
  xTip := rc.left + ((rc.right - rc.left + 1) shr 1);
  case style of
  arwUp:
    begin
      yTip := rc.top + ((rc.bottom - rc.top - 1) shr 2);
      for row := 1  to nMax do begin
        rcArrow.left   := xTip - row;
        rcArrow.right  := xTip + row - 1;
        rcArrow.top    := yTip + row;
        rcArrow.bottom := rcArrow.top + 1;
        ExtTextOut(dc, 0, 0, ETO_OPAQUE, @rcArrow, nil, 0, nil);
      end;
    end;
  arwDown:
    begin
      yTip := rc.bottom - ((rc.bottom - rc.top - 1) shr 2);
      for row := nMax downto 1 do begin
        rcArrow.left   := xTip - row;
        rcArrow.right  := xTip + row - 1;
        rcArrow.top    := yTip - row;
        rcArrow.bottom := rcArrow.top + 1;
        ExtTextOut(dc, 0, 0, ETO_OPAQUE, @rcArrow, nil, 0, nil);
      end;
    end;
  arwRestore:
    begin
      yTip := rc.top + ((rc.bottom - rc.top - 1) shr 3) - 2;
      for row := 1  to nMax do begin
        rcArrow.left   := xTip - row;
        rcArrow.right  := xTip + row - 1;
        rcArrow.top    := yTip + row;
        rcArrow.bottom := rcArrow.top + 1;
        ExtTextOut(dc, 0, 0, ETO_OPAQUE, @rcArrow, nil, 0, nil);
      end;
      Inc(yTip, (nMax + 1) * 2);
      for row := nMax downto 1 do begin
        rcArrow.left   := xTip - row;
        rcArrow.right  := xTip + row - 1;
        rcArrow.top    := yTip - row;
        rcArrow.bottom := rcArrow.top + 1;
        ExtTextOut(dc, 0, 0, ETO_OPAQUE, @rcArrow, nil, 0, nil);
      end;
    end;
  end;
end;
NOTE: It is a little known fact that the ExtTextOut() API function is the fastest way to draw a filled rectangle in Windows (if you don't want dithered colors or borders). However, there is a bug in the Windows 3.0 8514 display driver when using ExtTextOut() on a memory device context (DC). Since, we're not using memory DC's here, we'll continue to use ExtTextOut() to draw our fast rectangles.

Now, add the WMNCLButtonDown procedure to the implementation section of the unit.

procedure TForm1.WMNCLButtonDown(var Message : TWMNCLButtonDown);
var
  rc : TRect;
  pt : TPoint;
begin
  if HasCaption and not IsIconic(Handle) then begin
    case Message.HitTest of
    HTSYSMENU:
      if not fMenuUp and DoMenu then
        fMenuUp := true
      else
        fMenuUp := false;
    HTMINBUTTON:
      begin
        pt := Point(Message.XCursor, Message.YCursor);
        GetMinButtonRect(rc);
        if DepressMinMaxButton(Message.HitTest, rc) then
          SendMessage(Handle, WM_SYSCOMMAND, SC_MINIMIZE, longint(pt));
      end;
    HTMAXBUTTON:
      begin
        pt := Point(Message.XCursor, Message.YCursor);
        GetMaxButtonRect(rc);
        if DepressMinMaxButton(Message.HitTest, rc) then begin
          if IsZoomed(Handle) then
            SendMessage(Handle, WM_SYSCOMMAND, SC_RESTORE, longint(pt))
          else
            SendMessage(Handle, WM_SYSCOMMAND, SC_MAXIMIZE, longint(pt));
        end;
      end;
    else
      inherited;  {Call default processing.}
    end;
  end else
    inherited;  {Call default processing.}
end;

WM_NCPAINT, WM_NCACTIVATE

The WM_NCPAINT message is sent to a window when it needs to repaint the non-client area, such as when part of the window has become unobscured by another window. It is here that we draw the title bar itself, including caption, control box, and buttons.

The WM_NCACTIVATE message is sent to a window when it either receives or loses the focus. In response, the window needs to repaint the non-client area to change the background color of the window caption accordingly. Here we will redraw the title bar, including caption, control box, and buttons, much as we do in response to the WM_NCPAINT message.

We have already written procedures for drawing the control box and min./max. buttons. Now we need a function to draw the window caption on the title bar. Add the following function declaration to the private section of TForm1, and the definition to the implementation section of the unit:

  ...
    function DrawCaption(fSysMenu, fMin, fMax, fActive : boolean) : boolean;
  ...
function TForm1.DrawCaption(fSysMenu, fMin, fMax, fActive : boolean) : boolean;
const
  THRESHOLD = 20; {if caption >= 20 pixels, use bold font}
var
  dc        : HDC;
  rc        : TRect;
  rcCap     : TRect;
  rgbText   : TColor;
  rgbBkGrnd : TColor;
  hbrCap    : HBrush;
  lpsz      : PChar;
  textlen   : word;
  lf        : TLogFont;
  font      : HFont;
  size      : TSize;
  cx, cy    : integer;
begin
  dc := GetWindowDC(Handle);
  if dc <> 0 then begin
    {Determine colors}
    if fActive then begin
      rgbText   := ColorToRGB(clCaptionText);
      rgbBkGrnd := ColorToRGB(clActiveCaption);
    end else begin
      rgbText   := ColorToRGB(clInactiveCaptionText);
      rgbBkGrnd := ColorToRGB(clInactiveCaption);
    end;
    {Calculate titlebar rectangle in window coords.}
    GetTitleBarRect(rcCap);
    GetWindowRect(Handle, rc);
    OffsetRect(rcCap, -rc.left, -rc.top);
    {Calculate horizontal separator line below titlebar}
    SetRect(rc, rcCap.left, rcCap.bottom - 1, rcCap.right, rcCap.bottom);
    {Draw separator line}
    SetBkMode(dc, TRANSPARENT);
    SelectObject(dc, GetStockObject(NULL_BRUSH));
    SelectObject(dc, GetStockObject(NULL_PEN));
    SetBkColor(dc, ColorToRGB(clWindowFrame));
    ExtTextOut(dc, 0, 0, ETO_OPAQUE, @rc, nil, 0, nil);
    {Shrink caption area to avoid overlapping control box & min/max buttons}
    if fSysMenu then
      Inc(rcCap.left, TitleBarSize);
    if fMax then
      Dec(rcCap.right, TitleBarSize);
    if fMin then
      Dec(rcCap.right, TitleBarSize);
    {Draw caption background (don't use ExtTextOut, we may need dithered colors)}
    hbrCap := CreateSolidBrush(rgbBkGrnd);
    hbrCap := SelectObject(dc, hbrCap);  {swap brushes with device context }
    SelectObject(dc, GetStockObject(NULL_PEN));
    Rectangle(dc, rcCap.left, rcCap.top, rcCap.right + 1, rcCap.bottom);
    hbrCap := SelectObject(dc, hbrCap);  {swap brushes back again          }
    DeleteObject(hbrCap);                {delete the brush we created      }
    {Draw caption text here}
    textlen := GetWindowTextLength(Handle);     {Get length of caption text}
    lpsz := GlobalAllocPtr(GHND, textlen + 2);  {Allocate a text buffer    }
    if lpsz <> nil then begin
      GetWindowText(Handle, lpsz, textlen + 1); {Copy in caption text      }
      rgbText := SetTextColor(dc, rgbText);     {Swap text colors with dc  }
      {Prepare logical font structure to get a font to use.}
      FillChar(lf, sizeof(TLogFont), #0);       {Clear the font structure  }
      lf.lfHeight  := -(TitleBarSize - 3);
      lf.lfCharSet := ANSI_CHARSET;
      lf.lfQuality := DEFAULT_QUALITY;
      lf.lfClipPrecision := CLIP_LH_ANGLES or CLIP_STROKE_PRECIS;
      if TitleBarSize >= THRESHOLD then
        lf.lfWeight := FW_BOLD;
      {Use small fonts for caption since it looks more like "System" than Arial}
      lf.lfPitchAndFamily := FF_SWISS;
      font := CreateFontIndirect(lf);
      font := SelectObject(dc, font);        {swap font with device context}
      {Calculate centering for caption text}
      GetTextExtentPoint(dc, lpsz, textlen, size);
      cx := rcCap.left + ((rcCap.right - rcCap.left - size.cx) div 2);
      cy := rcCap.top + ((rcCap.bottom - rcCap.top - size.cy) div 2);
      if rcCap.left > cx then
        cx := rcCap.left;                  {limit starting position of text}
      {Draw caption text}
      ExtTextOut(dc, cx, cy, ETO_CLIPPED, @rcCap, lpsz, textlen, nil);
      font := SelectObject(dc, font);                 {swap font back again}
      DeleteObject(font);                             {delete it           }
      {Clean up device context & free memory}
      rgbText := SetTextColor(dc, rgbText);           {swap back text color}
      GlobalFreePtr(lpsz);                            {deallocate buffer   }
    end;
    {Draw control box, min button, and max button as needed}
    if fSysMenu then
      DrawControlBox(dc, false);
    if fMin then
      DrawButton(dc, true, false);
    if fMax then
      DrawButton(dc, false, false);
    Result := true;
    ReleaseDC(Handle, dc);
  end;
end;

Normally, we would add WMNCPaint and WMNCActivate message handlers here to handle these window messages. However, for some reason, Delphi will not dispatch messages to these handlers if the form's BorderStyle property is set to bsDialog. For this reason, we must intercept these two messages in the form's WndProc procedure, before the message redirection takes place.

Add the following WndProc procedure override to the implementation section of the unit.

procedure TForm1.WndProc(var Message : TMessage);
var
	fActive  : boolean;
begin
  with Message do begin
    case msg of
    WM_NCPAINT, WM_NCACTIVATE:
      begin
        inherited WndProc(Message);
        if HasCaption and not IsIconic(Handle) then begin
          if msg = WM_NCPAINT then
            fActive := (Handle = GetActiveWindow)
          else
            fActive := (wparam <> 0);
          DrawCaption(TestWinStyle(WS_SYSMENU),
                      TestWinStyle(WS_MINIMIZEBOX),
                      TestWinStyle(WS_MAXIMIZEBOX),
                      fActive);
        end;
      end;
    else
      inherited WndProc(Message);
    end; { case msg of }
  end; { with Message do }
end;
MORE... Creating Forms with Custom Title Bars (Pt. III)


[ Home Page | What's New | About CITY ZOO | Borland Delphi | About the Authors | INDEX ]
keeper@mindspring.com
Copyright © 1995 Mark R. Johnson. This is a CITY ZOO production.
Last revised June 14, 1995.
Enhanced version