How to eliminate header artifacts during tracking - HDN_TRACK? - delphi

Question

When doing "real time" tracking, the header control occasionally leaves artifacts behind, as the image below shows:
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:
How does one tell the header control not to paint that vertical black bar? I couldn't find anything in the documentation on that.
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.

Answer 1

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;
}
...