ScienceAmateur
ScienceAmateur

Reputation: 531

How to eliminate header artifacts during tracking - HDN_TRACK?

When doing "real time" tracking, the header control occasionally leaves artifacts behind, as the image below shows:

image

The first two images are from the attached program. The third image (without the blue coloring) is from Windows Explorer.

To get the artifacts, simply drag the separator off the right side of program's window right edge and bring it back quickly into view. It may take a couple of tries, depending on how quickly you bring the separator back into the window.

Windows Explorer avoids the problem by having the header not paint that black vertical bar when dragging.

EDIT: As Sertac below pointed out, Windows Explorer uses a different control, which is why it does not exhibit the problem.

I have two (2) questions:

  1. How does one tell the header control not to paint that vertical black bar? I couldn't find anything in the documentation on that.

  2. If getting rid of the black bar is not possible without "owner-drawing" the header, is there some way to prevent the artifact from appearing?

The program I am using to test the header control is below.

{$LONGSTRINGS    OFF}
{$WRITEABLECONST ON}

{$ifdef WIN32}           { tell Windows we want v6 of commctrl                }
  {$R Manifest32.res}
{$endif}

{$ifdef WIN64}
  {$R Manifest64.res}
{$endif}

program _Header_Track;

uses Windows, Messages, CommCtrl;

const
  ProgramName  = 'Header_Track';

{-----------------------------------------------------------------------------}

{$ifdef VER90} { Delphi 2.0 }
type
  ptrint  = longint;
  ptruint = dword;

const
  ICC_WIN95_CLASSES     = $000000FF;              { missing in Delphi 2       }

type
  TINITCOMMONCONTROLSEX = packed record
    dwSize                  : DWORD;
    dwICC                   : DWORD;
  end;
  PINITCOMMONCONTROLSEX = ^TINITCOMMONCONTROLSEX;

  function InitCommonControlsEx(var InitClasses : TINITCOMMONCONTROLSEX)
           : BOOL; stdcall; external comctl32;
{$endif}


{$ifdef VER90}
  // for Delphi 2.0 define GetWindowLongPtr and SetWindowLongPtr as synonyms of
  // GetWindowLong and SetWindowLong respectively.

  function GetWindowLongPtr(Wnd   : HWND;
                            Index : ptrint)
           : ptruint; stdcall; external 'user32' name 'GetWindowLongA';

  function SetWindowLongPtr(Wnd     : HWND;
                            Index   : ptrint;
                            NewLong : DWORD)
           : ptruint; stdcall; external 'user32' name 'SetWindowLongA';

  function GetClassLongPtr(Wnd      : HWND;
                           Index    : ptrint)
           : ptruint; stdcall; external 'user32' name 'GetClassLongA';

  function SetClassLongPtr(Wnd      : HWND;
                           Index    : ptrint;
                           NewLong  : ptruint)
           : ptruint; stdcall; external 'user32' name 'SetClassLongA';
{$endif}


{$ifdef FPC}
  { make the FPC definitions match Delphi's                                   }

type
  THDLAYOUT = record
    Rect        : PRECT;
    WindowPos   : PWINDOWPOS;
  end;
  PHDLAYOUT = ^THDLAYOUT;

function Header_Layout(Wnd : HWND; Layout : PHDLAYOUT) : WINBOOL; inline;
begin
  Header_Layout := WINBOOL(SendMessage(Wnd, HDM_LAYOUT, 0, ptruint(Layout)));
end;
{$endif}

{-----------------------------------------------------------------------------}

function WndProc (Wnd : HWND; Msg : UINT; wParam, lParam : ptrint)
         : ptrint; stdcall;
  { main application/window handler function                                  }
const
  HEADER_ID                = 1000;
  HEADER_ITEMS_WIDTH       =  100;

  Header          : HWND   =    0;

  HeaderText      : packed array[0..2] of pchar =
  (
    'Name',
    'Date modified',
    'Type'
  );

var
  ControlsInit       : TINITCOMMONCONTROLSEX;

  HeaderPos          : TWINDOWPOS;
  HeaderRect         : TRECT;
  HeaderNotification : PHDNOTIFY absolute lParam;  { note overlay on lParam   }

  HeaderLayout       : THDLAYOUT;

  HeaderItem         : THDITEM;

  ClientRect         : TRECT;

  Style              : ptruint;

  i                  : integer;

begin
  WndProc := 0;

  case Msg of
    WM_CREATE:
    begin
      { initialize the common controls library                                }

      with ControlsInit do
      begin
        dwSize := sizeof(ControlsInit);
        dwICC  := ICC_WIN95_CLASSES;                       { includes headers }
      end;

      InitCommonControlsEx(ControlsInit);

      { create the header control                                             }

      Header := CreateWindowEx(0,
                               WC_HEADER,                  { class name       }
                               nil,                        { caption          }
                               HDS_BUTTONS            or
                               WS_CHILD               or
                               WS_VISIBLE             or
                               WS_CLIPCHILDREN        or
                               WS_CLIPSIBLINGS,
                               0,                          { at parent x = 0  }
                               0,                          {           y = 0  }
                               0,                          { width            }
                               0,                          { height           }
                               Wnd,                        { parent           }
                               HEADER_ID,                  { child id         }
                               hInstance,
                               nil);

      if Header = 0 then
      begin
        MessageBox(Wnd,
                   'Couldn''t create a header',
                   'Main Window - WM_CREATE',
                   MB_ICONERROR or MB_OK);

        WndProc := -1;                             { abort window creation    }

        exit;
      end;

      { remove the annoying double click behavior of the header buttons       }

      Style := GetClassLongPtr(Header, GCL_STYLE);
      Style := Style and (not CS_DBLCLKS);
      SetClassLongPtr(Header, GCL_STYLE, Style);

      { tell the header which font to use                                     }

      SendMessage(Header, WM_SETFONT, GetStockObject(DEFAULT_GUI_FONT), 0);

      { insert the column header in the header control                        }

      with HeaderItem do
      for i := low(HeaderText) to high(HeaderText) do
      begin
        mask    := HDI_FORMAT or HDI_TEXT or HDI_WIDTH;
        pszText := HeaderText[i];
        fmt     := HDF_STRING;
        cxy     := HEADER_ITEMS_WIDTH;             { width                    }

        Header_InsertItem(Header, i, HeaderItem);
      end;

      exit;
    end;

    WM_SIZE:
    begin
      { update the header size and location                                   }

      with HeaderLayout do
      begin
        WindowPos := @HeaderPos;
        Rect      := @HeaderRect;
      end;

      GetClientRect(Wnd, ClientRect);
      CopyRect(HeaderRect, ClientRect);

      ZeroMemory(@HeaderPos,  sizeof(HeaderPos));

      Header_Layout(Header, @HeaderLayout);     { updates HeaderPos           }

      { use HeaderPos to place the header where it should be in the window    }

      with HeaderPos do
      begin
        SetWindowPos(Header,
                     Wnd, x, y, cx, cy,
                     Flags);
      end;

      exit;
    end; { WM_SIZE }


    WM_NOTIFY:
    begin
      case HeaderNotification^.Hdr.Code of
        HDN_BEGINTRACK:
        begin
          { Allow dragging using the left mouse button only                   }

          if HeaderNotification^.Button <> 0 then
          begin
            WndProc := ptrint(TRUE);   { don't track                          }
            exit;
          end;

          exit;
        end;

        HDN_TRACK:
        begin
          { tell the header to resize itself                                  }

          Header_SetItem(Header,
                         HeaderNotification^.Item,
                         HeaderNotification^.pitem^);

          exit;
        end;
      end;
    end;

    WM_DESTROY:
    begin
      PostQuitMessage(0);

      exit;
    end;
  end; { case msg }

  WndProc := DefWindowProc (Wnd, Msg, wParam, lParam);
end;

{-----------------------------------------------------------------------------}

function InitAppClass: WordBool;
  { registers the application's window classes                                }
var
  cls : TWndClassEx;

begin
  cls.cbSize          := sizeof(TWndClassEx);           { must be initialized }

  if not GetClassInfoEx (hInstance, ProgramName, cls) then
  begin
    with cls do
    begin
      style           := CS_BYTEALIGNCLIENT;
      lpfnWndProc     := @WndProc;
      cbClsExtra      := 0;
      cbWndExtra      := 0;
      hInstance       := system.hInstance;
      hIcon           := 0;
      hCursor         := LoadCursor(0, IDC_ARROW);
      hbrBackground   := COLOR_WINDOW + 1;
      lpszMenuName    := nil;
      lpszClassName   := ProgramName;
      hIconSm         := 0;
    end;

    InitAppClass := WordBool(RegisterClassEx(cls));
  end
  else InitAppClass := TRUE;
end;

{-----------------------------------------------------------------------------}

function WinMain : integer;
  { application entry point                                                   }
var
  Wnd : HWND;
  Msg : TMsg;

begin
  if not InitAppClass then Halt (255);  { register application's class        }

  { Create the main application window                                        }

  Wnd := CreateWindowEx(WS_EX_CLIENTEDGE,
                        ProgramName,            { class name                  }
                        ProgramName,            { window caption text         }
                        ws_OverlappedWindow or  { window style                }
                        ws_SysMenu          or
                        ws_MinimizeBox      or
                        ws_ClipSiblings     or
                        ws_ClipChildren     or  { don't affect children       }
                        ws_visible,             { make showwindow unnecessary }
                        20,                     { x pos on screen             }
                        20,                     { y pos on screen             }
                        600,                    { window width                }
                        200,                    { window height               }
                        0,                      { parent window handle        }
                        0,                      { menu handle 0 = use class   }
                        hInstance,              { instance handle             }
                        nil);                   { parameter sent to WM_CREATE }

  if Wnd = 0 then Halt;                         { could not create the window }

  while GetMessage (Msg, 0, 0, 0) do            { wait for message            }
  begin
    TranslateMessage (Msg);                     { key conversions             }
    DispatchMessage  (Msg);                     { send to window procedure    }
  end;

  WinMain := Msg.wParam;                        { terminate with return code  }
end;

begin
  WinMain;
end.

Upvotes: 2

Views: 342

Answers (1)

Sertac Akyuz
Sertac Akyuz

Reputation: 54822

This is an artifact caused by attempting to use the control in two different functionality modes at the same time. That, and of course fast mouse movement...

The black vertical line is actually the indicator that hints the final separator position when the mouse button will be released. Of course this indicator is only to be used when the header control does not reflect column resizing at real time.

You are, however, resizing the column at real time responding to the tracking notification. You should instead use the header control in live column drag mode and so that the indicator will not be drawn at all.

In summary, include HDS_FULLDRAG control style:

  Header := CreateWindowEx(0,
                           WC_HEADER,                  { class name       }
                           nil,                        { caption          }
                           HDS_BUTTONS            or
                           WS_CHILD               or
                           WS_VISIBLE             or
                           WS_CLIPCHILDREN        or
                           WS_CLIPSIBLINGS        or
                           HDS_FULLDRAG,
                           0,                          { at parent x = 0  }
                           0,                          {           y = 0  }
                           0,                          { width            }
                           0,                          { height           }
                           Wnd,                        { parent           }
                           HEADER_ID,                  { child id         }
                           hInstance,
                           nil);

and leave out the track notification:

    ...
 { // don't tell the header to resize, it will do it itself
    HDN_TRACK:
    begin
      // tell the header to resize itself                                  

      Header_SetItem(Header,
                     HeaderNotification^.Item,
                     HeaderNotification^.pitem^);

      exit;
    end;
 }
    ...

Upvotes: 5

Related Questions