Question

进行“实时”跟踪时，标头控件有时会遗留工件，如下图所示：

前两个图像来自附件程序。第三张图片（没有蓝色）来自Windows资源管理器。

要获取工件，只需将分隔符从程序窗口的右侧边缘拖出，然后迅速将其放回视图即可。可能需要尝试几次，具体取决于将分隔器带回窗口的速度。

Windows资源管理器通过在拖动时使标题 not 绘制黑色竖线来避免此问题。

编辑：正如下面的Sertac所指出的，Windows资源管理器使用了不同的控件，这就是为什么它不会出现问题的原因。

我有两（2）个问题：

如何告诉标题控件 not 绘制垂直黑条？我在文档中找不到任何内容。
如果在没有“所有者绘制”标题的情况下摆脱黑条是不可能的，是否有某种方法可以防止工件出现？

下面用来测试标题控件的程序。

{$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

这是由于尝试同时在两种不同的功能模式下使用控件而导致的人为因素。那样，当然还有鼠标的快速移动...

黑色竖线实际上是指示释放鼠标按钮时分隔符最终位置的指示器。当然，仅当标题控件不能实时反映列的大小时，才使用此指示符。

但是，您正在实时调整列的大小以响应跟踪通知。您应该改为在实时列拖动模式下使用标题控件，以使指示符完全不会显示。

总而言之，包括HDS_FULLDRAG控件样式：

  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);

并保留跟踪通知：

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

如何在跟踪过程中消除标题失真-HDN_TRACK？

1 个答案: