Вверх ↑
Разработчик
Ответов: 26235
Рейтинг: 2140
#1: 2022-07-12 23:58:33 ЛС | профиль | цитата
Немного поправил. Теперь вроде нормально работает без XP-стиля и вроде корректно отображает хинты при отключенном трекинге без непонятного прыгания.
Схема

Add(MainForm,2887726,245,231)
{
 Position=1
 Point(PHandle)
 link(onCreate,13943538:doInitSubClass,[])
}
Add(InlineCode,13943538,336,245)
{
 WorkPoints=#14:doInitSubClass|
 EventPoints=#36:onHDMouseDown=ARG(MouseCode,ItemIdx)|
 DataPoints=#7:pHandle|8:HintList|8:Tracking|
 Code=#15:unit HiAsmUnit;|0:|9:interface|0:|40:uses Windows, Messages, kol,Share,Debug;|0:|5:const|28:  HDM_HITTEST   = $00001206;|28:  HHT_ONHEADER  = $00000002;|28:  HHT_ONDIVIDER = $00000004;|28:  HHT_ONDIVOPEN = $00000008;|0:|30:  TTDT_AUTOMATIC          = 0;|30:  TTDT_RESHOW             = 1;|30:  TTDT_AUTOPOP            = 2;|32:  TTDT_INITIAL            = 3;  |0:|25:  TID_POLLMOUSE    = 100;|25:  MOUSE_POLL_DELAY = 500;|0:|4:type|35:  PHDHitTestInfo = ^THDHitTestInfo;|32:  THDHitTestInfo = packed record|18:    Point: TPoint;|20:    Flags: Cardinal;|18:    Item: Integer;|6:  end;|34:  HD_HITTESTINFO = THDHITTESTINFO;|0:|4:type|28: THiAsmClass = class(TDebug)|10:   private|0:|9:   public|19:     onHDMouseDown,|13:     pHandle,|14:     HintList,|25:     Tracking: THI_Event;|21:	 constructor Create;|34:     destructor Destroy; override;|59:     procedure doInitSubClass(var _Data:TData; Index:word);|5: end;|0:|14:implementation|0:|116:  function TrackMouseEvent(var EventTrack: TTrackMouseEvent): BOOL; stdcall; external user32 name 'TrackMouseEvent';|0:|4:type|23:  UINT_PTR  = Cardinal;|23:  DWORD_PTR = Cardinal;|0:|141:  TSubClassProc = function (hWnd:HWND; uMsg:UINT; wParam:WPARAM; lParam:LPARAM; uIdSubclass:UINT_PTR; dwRefData:DWORD_PTR) :LRESULT; stdcall;|5:const|28:   cctrl = Windows.comctl32;|0:|3:var|21:  Header: HWND = 0;  |21:  fTThwnd: HWND = 0; |33:  t_MouseEvent: TTrackMouseEvent;|16:  ti: TTOOLINFO;|22:  pHintList: PStrList;|24:  CurItem: integer = -2;|29:  InitTimer: boolean = false;|0:|178:function SetWindowSubclass   (hWnd: Windows.HWND; pfnSubclass: TSubClassProc; uIdSubclass: UINT_PTR; dwRefData: DWORD_PTR):BOOL; stdcall; external cctrl name 'SetWindowSubclass';|181:function RemoveWindowSubclass(hWnd: Windows.HWND; pfnSubclass: TSubClassProc; uIdSubclass: UINT_PTR):BOOL;                       stdcall; external cctrl name 'RemoveWindowSubclass';|176:function DefSubclassProc     (hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM):LRESULT;                                   stdcall; external cctrl name 'DefSubclassProc';|0:|145:function sws_HeaderWndProc(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM; uIdSubclass: UINT_PTR; dwRefData: DWORD_PTR):LRESULT; stdcall;|3:var|23:  MyClass: THiAsmClass;|13:  pt: TPoint;|32:  HDHitTestInfo: THDHitTestInfo;|16:  dc, di: TData;|5:begin|37:  MyClass := THiAsmClass(dwRefData); |56:  Result := DefSubclassProc(hWnd, uMsg, wParam, lParam);|14:  case uMsg of|17:    WM_MOUSEMOVE:|9:    begin|54:      t_MouseEvent.cbSize := SizeOf(TTrackMouseEvent);|37:      t_MouseEvent.hwndTrack := hWnd;|37:      t_MouseEvent.dwHoverTime := 10;|41:      t_MouseEvent.dwFlags := TME_LEAVE; |36:      TrackMouseEvent(t_MouseEvent);|6:      |29:      pt.X := LoWord(lParam);|30:      pt.Y := HiWord(lParam); |32:      HDHitTestInfo.Point := pt;|31:      HDHitTestInfo.flags := 0;|67:      Sendmessage(hWnd, HDM_HITTEST, 0, DWORD_PTR(@HDHitTestInfo));|49:      if HDHitTestInfo.flags <> HHT_ONHEADER then|33:        HDHitTestInfo.Item := -1;|41:	  if HDHitTestInfo.Item <> CurItem then |11:      begin|66:        ti.lpszText := PChar(pHintList.Items[HDHitTestInfo.Item]);|67:        SendMessage(fTThwnd, TTM_UPDATETIPTEXT, 0, dword_ptr(@ti));|39:        CurItem := HDHitTestInfo.Item; |67:        SendMessage(fTThwnd, TTM_TRACKACTIVATE, 0, dword_ptr(@ti));|21:		InitTimer := false;|10:      end;|52:      if (ToIntegerEvent(MyClass.Tracking) = 1) then|75:        SendMessage(fTThwnd, TTM_TRACKPOSITION, 0, MAKELPARAM(pt.X, pt.Y));|24:	  if not InitTimer then|8:	  begin|61:        SetTimer(hWnd, TID_POLLMOUSE, MOUSE_POLL_DELAY, nil);|20:		InitTimer := true;|7:	  end;|5:	end;|13:    WM_TIMER:|9:    begin|65:      SendMessage(fTThwnd, TTM_TRACKACTIVATE, 1, dword_ptr(@ti));|37:      KillTimer(hWnd, TID_POLLMOUSE);|25:      InitTimer := false;|8:    end;|51:    WM_LBUTTONDOWN, WM_RBUTTONDOWN, WM_MBUTTONDOWN:|6:	begin|39:	  if (wParam = 1) or (wParam = 2) then|33:        dtInteger(dc, wParam - 1)|30:      else if wParam = 16 then|24:        dtInteger(dc, 2)|7:	  else|7:		exit;|29:      pt.X := LoWord(lParam);|30:      pt.Y := HiWord(lParam); |32:      HDHitTestInfo.Point := pt;|42:      HDHitTestInfo.flags := HHT_ONHEADER;|67:      Sendmessage(hWnd, HDM_HITTEST, 0, dword_ptr(@HDHitTestInfo));|40:      dtInteger(di, HDHitTestInfo.Item);|19:	  dc.ldata := @di;|45:      _hi_onEvent_(MyClass.onHDMouseDown, dc)|5:	end;|18:    WM_MOUSELEAVE:|6:	begin|65:      SendMessage(fTThwnd, TTM_TRACKACTIVATE, 0, dword_ptr(@ti));|37:      KillTimer(hWnd, TID_POLLMOUSE);|25:      InitTimer := false;|5:	end;|6:  end;|4:end;|0:|31:constructor THiAsmClass.Create;|5:begin|12:  inherited;|26:  pHintList := NewStrList;|4:end;|0:|31:destructor THiAsmClass.Destroy;|5:begin|17:  pHintList.free;|21:  if Header <> 0 then|56:    RemoveWindowSubclass(Header, @sws_HeaderWndProc, 1);|22:  if fTThwnd <> 0 then|7:  begin|57:    SendMessage(fTThwnd, TTM_DELTOOL, 0, dword_ptr(@ti));|27:    DestroyWindow(fTThwnd);|6:  end;|12:  inherited;|4:end;|0:|37:procedure THiAsmClass.doInitSubClass;|3:var|21:  sControl: PControl;|28:  Buf: array [Byte] of Char;|5:begin|48:  sControl := PControl(ToIntegerEvent(pHandle));|38:  if not Assigned(sControl) then exit;|59:  GetClassName(sControl.GetWindowHandle, Buf, sizeof(Buf));|42:  if Buf <> 'obj_SysListView32' then exit;|0:|52:  pHintList.SetText(ToStringEvent(HintList), false);|50:  Header := sControl.Perform(LVM_GETHEADER, 0, 0);|38:  FillChar(ti, sizeof(TTOOLINFO), #0);|33:  ti.cbSize := sizeof(TTOOLINFO);|63:  ti.uFlags := TTF_SUBCLASS or TTF_IDISHWND or TTF_TRANSPARENT;|20:  ti.hwnd := Header;|16:  ti.hinst := 0;|20:  ti.uId := Header; |0:|106:  fTThwnd := CreateWindowEx(WS_EX_TOPMOST, TOOLTIPS_CLASS, nil, TTS_NOPREFIX or TTS_ALWAYSTIP or WS_POPUP,|108:             integer(CW_USEDEFAULT), integer(CW_USEDEFAULT), integer(CW_USEDEFAULT), integer(CW_USEDEFAULT),|41:             Header, 0, hInstance, nil );|0:|94:  SetWindowPos(fTThwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE);|55:  SendMessage(fTThwnd, TTM_ADDTOOL, 0, dword_ptr(@ti));|63://  SendMessage(fTThwnd, TTM_SETDELAYTIME, TTDT_AUTOMATIC, -1);|81:  SetWindowSubclass(Header, @sws_HeaderWndProc, 1, dword_ptr(THiAsmClass(Self)));|4:end;|0:|4:end.|
 link(onHDMouseDown,12301008:doEvent,[])
 link(pHandle,13232672:PHandle,[])
 link(HintList,13015242:Text,[(349,145)(370,145)])
 link(Tracking,4930132:State,[(356,222)(370,222)])
}
Add(MTStrTbl,13232672,308,98)
{
 Width=384
 Height=185
 Align=2
 Columns=#3:111|3:222|3:333|
 Point(PHandle)
 Point(onMouseDown)
}
Add(PopupMenu,2558660,525,259)
{
 @Hint=#91:Тестовый вызов меню над пустым полем заголовка. Можно вывести над любым элементом заголовка|
 Menu=#6:Test_1|6:Test_2|6:Test_3|
 AddHint(41,-46,199,39,@Hint)
}
Add(StrList,13015242,364,105)
{
 @Hint=#121:Список хинтов для каждого элемента заголовка. При отсутствии хинта с нужным индексом хинт над элементом выводится не буде|0:|
 Strings=#24:Первый элемент заголовка|24:Второй элемент заголовка|24:Третий элемент заголовка|
 AddHint(50,30,193,52,@Hint)
}
Add(Case,4367113,469,252)
{
 Value=Integer(-1)
 link(onTrue,2558660:doPopupHere,[])
}
Add(MT_IndexToChanel,12301008,413,245)
{
 link(onEvent2,4367113:doCase,[])
}
Add(Button,6878611,245,196)
{
 Left=25
 Top=205
 Width=90
 TabOrder=-1
 Caption="Tracking On"
 link(onClick,4930132:doOn,[])
}
Add(Button,7495608,245,154)
{
 Left=120
 Top=205
 Width=90
 TabOrder=-1
 Caption="Tracking Off"
 link(onClick,4930132:doReset,[(354,160)(354,195)])
}
Add(Switch,4930132,364,182)
{
 @Hint=#20:Управление трекингом|
 DataOn=Integer(1)
 DataOff=Integer(0)
 Default=0
 Point(State)
 Point(doOn)
 AddHint(40,37,134,13,@Hint)
}

карма: 22

0
Редактировалось 1 раз(а), последний 2022-07-12 23:59:14