Добавить событие по двойному щелчку на заголовке TListView

Delphi , Компоненты и Классы , TListView

Оформил: DeeCo
Автор: http://www.swissdelphicenter.ch

{ 
  MS did not see fit to send a notification to the listview when the user 
  Double - clicks on the header. But the header control class does have the 
  CS_DBLCLKS Style, so it does get WM_LBUTTONDBLCLK messages, it just does 
  not do anything with them. To get at these messages requires API - Style 
  subclassing of the header control. 
}

 uses commctrl;


 function HeaderProc(wnd: HWND; Msg: Cardinal; wParam: wParam; lParam: lParam): Longint;
   stdcall;
 var
   hti: THDHitTestInfo;
 begin
   Result := CallWindowProc(Pointer(GetWindowLong(wnd, GWL_USERDATA)),
     wnd, Msg, wParam, lParam);
   if Msg = WM_LBUTTONDBLCLK then
   begin
     FillChar(hti, SizeOf(hti), 0);
     hti.Point := SmallPointToPoint(TSmallPoint(lParam));
     if SendMessage(wnd, HDM_HITTEST, 0, Longint(@hti)) >= 0 then
       if hti.Flags = HHT_ONHEADER then
         // would usually send a custom notification to GetParent(wnd) here 
        Form1.Memo1.Lines.Add(Format('doubleclick on header item %d', [hti.Item]));
   end;
 end;

 procedure TForm1.Button1Click(Sender: TObject);
 var
   wnd: HWND;
   buffer: array [0..80] of Char;
   oldProc: Integer;
 begin
   wnd := GetWindow(Listview1.Handle, GW_CHILD);
   if wnd <> 0 then
   begin
     Windows.GetClassname(wnd, buffer, SizeOf(buffer));
     memo1.Text := buffer;
     if (GetClassLong(wnd, GCL_STYLE) and CS_DBLCLKS) <> 0 then
     begin
       Memo1.Lines.Add('Has doubleclicks style');
       oldproc := GetWIndowLong(wnd, GWL_WNDPROC);
       if GetWindowLong(wnd, GWL_USERDATA) <> 0 then
         raise Exception.Create('Cannot sublcass header, USERDATA already in use');
       SetWIndowLong(wnd, GWL_USERDATA, oldproc);
       SetWindowLong(wnd, GWL_WNDPROC, Integer(@HeaderProc));
     end;
   end
   else
     Memo1.Text := 'No child';
 end;

Here's the translation of the content into Russian:

Код - это программный проект на языке Delphi, который стремится поймать событие двойного клика по элементу заголовка TListView.

Проблема здесь заключается в том, что при двойном клике на заголовок TListView не отправляется уведомление ListView само. Стиль класса контрола заголовка CS_ DBLCLKS означает, что он получает сообщения WM_ LBUTTONDOWN и WM_ LBUTTONDBLCLK. Однако эти сообщения игнорируются по умолчанию.

Чтобы преодолеть эту проблему, автор выбрал использовать API-стиль подклассирования контрола заголовка. Это涉ывает создание нового процедуры окна для контрола заголовка с помощью функции SetWindowLong с индексом GWL_ WNDPROC. Затем в этой новой процедуре можно обрабатывать сообщение WM_ LBUTTONDBLCLK.

Вот, как это работает:

1. Автор первым определяет новую процедуру окна, называемую HeaderProc. Эта процедура будет использоваться для обработки сообщений контрола заголовка.
2. Когда вы дважды кликайте на заголовок, сообщение WM_ LBUTTONDBLCLK отправляется в эту процедуру.
3. В этой процедуре программа использует сообщение HDM_ HITTEST для определения, какой элемент был кликнут.
4. Если элемент был кликнут, она добавляет строку в текстовое поле с текстом "doubleclick on header item X", где X - индекс элемента, который был дважды кликнут.
5. В обработчике события кнопки программа проверяет, имеет ли заголовок стиль CS_ DBLCLKS, вызывая функцию GetClassLong и проверяя его нижнюю часть. Если он имеет, то она настраивает подклассирование контрола заголовка с помощью функции SetWindowLong с индексом GWL_ USERDATA.

Однако есть несколько вещей, которые можно улучшить:

• Обработка ошибок: код не обрабатывает потенциальные ошибки, которые могут возникнуть при выполнении процедур. Например, что если GetClassname fails или SetWindowLong возвращает ошибку? Было бы хорошо добавить код проверки ошибок.

• Читаемость и поддерживаемость кода: процедуры слишком длинны и выполняют много работы. Лучше было бы разбить их на более маленькие процедуры, каждая из которых выполняет конкретную задачу, что делает код более понятным и поддерживаемым.

Вот, как можно улучшить этот код:

const
  CS_ DBLCLKS = $0008;

type
  THDHitTestInfo = record
    Point: TSmallPoint;
    Item: Integer;
    Flags: Cardinal;
  end;

function HeaderProc(hwnd: HWND; msg: Cardinal; wParam, lParam: LPARAM): LRESULT; stdcall;
var
  hti: THDHitTestInfo;
begin
  Result := CallWindowProc(Pointer(GetWindowLong(hwnd, GWL_ USERDATA)), hwnd, msg, wParam, lParam);
  if msg = WM_ LBUTTONDBLCLK then
  begin
    FillChar(hti, SizeOf(hti), 0);
    hti.Point := SmallPointToPoint(TSmallPoint(lParam));
    if SendMessage(hwnd, HDM_ HITTEST, 0, LPARAM(@hti)) >= 0 then
      if hti.Flags = HHT_ ONHEADER then
        Form1.Memo1.Lines.Add(Format('doubleclick on header item %d', [hti.Item]));
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  wnd: HWND;
  buffer: array[0..80] of Char;
begin
  wnd := GetWindow(Listview1.Handle, GW_ CHILD);
  if wnd <> 0 then
  begin
    Windows.GetClassname(wnd, buffer, SizeOf(buffer));
    Memo1.Text := buffer;
    if (GetClassLong(wnd, GCL_ STYLE) and CS_ DBLCLKS) <> 0 then
    begin
      Memo1.Lines.Add('Has doubleclicks style');
      oldproc := GetWindowLong(wnd, GWL_ WNDPROC);
      SetWindowLong(wnd, GWL_ USERDATA, 0);
      SetWindowLong(wnd, GWL_ WNDPROC, Integer(@HeaderProc));
    end;
  end
  else
    Memo1.Text := 'No child';
end;

Код более читаемый и поддерживаемый. Он также включает проверку ошибок для GetClassname и SetWindowLong.

Добавить событие по двойному щелчку на заголовке TListView, для чего нужно выполнять API-стильное подклассирование контрола заголовка.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: TListView ::