Вверх ↑
Разработчик
Ответов: 26066
Рейтинг: 2120
#1: 2022-07-12 19:27:29 ЛС | профиль | цитата
Вот что получилось. Как говорится -- тестовый прототип

Схема

Add(MainForm,2887726,525,329)
{
Position=1
Point(PHandle)
link(onCreate,13943538:doInitSubClass,[])
}
Add(InlineCode,13943538,616,343)
{
WorkPoints=#14:doInitSubClass|
EventPoints=#36:onHDMouseDown=ARG(MouseCode,ItemIdx)|14:onHDMouseEnter|14:onHDMouseLeave|
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:|0:|30: TTDT_AUTOMATIC = 0;|30: TTDT_RESHOW = 1;|30: TTDT_AUTOPOP = 2;|32: TTDT_INITIAL = 3; |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,|20: onHDMouseEnter,|20: onHDMouseLeave,|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;|34: InitMouseEvent: boolean = false;|16: ti: TTOOLINFO;|22: pHintList: PStrList;|24: CurItem: integer = -2;|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|29: if not InitMouseEvent then|8: begin|56: t_MouseEvent.cbSize := SizeOf(TTrackMouseEvent);|42: t_MouseEvent.dwFlags := TME_HOVER;|41: t_MouseEvent.hwndTrack := Header;|40: t_MouseEvent.dwHoverTime := 100;|38: TrackMouseEvent(t_MouseEvent);|31: InitMouseEvent := true;|10: end;|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; |10: end;|52: if (ToIntegerEvent(MyClass.Tracking) = 1) then|75: SendMessage(fTThwnd, TTM_TRACKPOSITION, 0, MAKELPARAM(pt.X, pt.Y));|65: SendMessage(fTThwnd, TTM_TRACKACTIVATE, 1, dword_ptr(@ti));|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_MOUSEHOVER:|6: begin|40: t_MouseEvent.dwFlags := TME_LEAVE;|42: _hi_onEvent(MyClass.onHDMouseEnter);|5: end;|18: WM_MOUSELEAVE:|6: begin|65: SendMessage(fTThwnd, TTM_TRACKACTIVATE, 0, dword_ptr(@ti));|30: InitMouseEvent := false;|42: _hi_onEvent(MyClass.onHDMouseLeave);|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));|61: 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,[(629,243)(650,243)])
link(Tracking,4930132:State,[(636,320)(650,320)])
}
Add(MTStrTbl,13232672,588,196)
{
Width=384
Height=185
Align=2
Columns=#3:111|3:222|3:333|
Point(PHandle)
Point(onMouseDown)
}
Add(StyleXP,2894046,525,196)
{
}
Add(PopupMenu,2558660,805,357)
{
@Hint=#91:Тестовый вызов меню над пустым полем заголовка. Можно вывести над любым элементом заголовка|
Menu=#6:Test_1|6:Test_2|6:Test_3|
AddHint(41,-46,199,39,@Hint)
}
Add(StrList,13015242,644,203)
{
@Hint=#121:Список хинтов для каждого элемента заголовка. При отсутствии хинта с нужным индексом хинт над элементом выводится не будет|
Strings=#24:Первый элемент заголовка|24:Второй элемент заголовка|24:Третий элемент заголовка|
AddHint(50,30,193,52,@Hint)
}
Add(Case,4367113,749,350)
{
Value=Integer(-1)
link(onTrue,2558660:doPopupHere,[])
}
Add(MT_IndexToChanel,12301008,693,343)
{
link(onEvent2,4367113:doCase,[])
}
Add(Button,6878611,525,294)
{
Left=25
Top=205
Width=90
TabOrder=-1
Caption="Tracking On"
link(onClick,4930132:doOn,[])
}
Add(Button,7495608,525,252)
{
Left=120
Top=205
Width=90
TabOrder=-1
Caption="Tracking Off"
link(onClick,4930132:doReset,[(634,258)(634,293)])
}
Add(Switch,4930132,644,280)
{
@Hint=#20:Управление трекингом|
DataOn=Integer(1)
DataOff=Integer(0)
Default=0
Point(State)
Point(doOn)
AddHint(40,37,134,13,@Hint)
}

карма: 22

1
Голосовали:fox-video
Редактировалось 3 раз(а), последний 2022-07-12 19:30:45