![]() |
|
#1
|
||||
|
||||
![]() Сабж: Как реализовать всплывающие подсказки на WinAPI?
Вариант "загляни в исодники Delphi и посмотри, как оно реализовано" не подходит - сейчас шКодю на C++, Delphi под рукой нет. Гугл предлагает создавать новое окно вручную... Оставайтесь хорошими людьми... VK id2634397, ds [at] phoenix [dot] dj |
#2
|
||||
|
||||
![]() Цитата:
Код:
procedure THintWindow.CreateParams(var Params: TCreateParams); begin inherited CreateParams(Params); with Params do begin Style := WS_POPUP or WS_BORDER; WindowClass.Style := WindowClass.Style or CS_SAVEBITS; if NewStyleControls then ExStyle := WS_EX_TOOLWINDOW; // CS_DROPSHADOW requires Windows XP or above if CheckWin32Version(5, 1) then WindowClass.Style := WindowClass.style or CS_DROPSHADOW; if NewStyleControls then ExStyle := WS_EX_TOOLWINDOW; AddBiDiModeExStyle(ExStyle); end; end; кста if NewStyleControls then ExStyle := WS_EX_TOOLWINDOW; у всех 2 раза в коде?) это я просто скопировал кусок из Controls.pas. Пишу программы за еду. __________________ Последний раз редактировалось NumLock, 09.10.2011 в 08:43. |
#3
|
||||
|
||||
![]() Да ну, неужели в WinAPI нет стандартных функций для подсказок? В жизни не поверю...
Оставайтесь хорошими людьми... VK id2634397, ds [at] phoenix [dot] dj |
#4
|
||||
|
||||
![]() Цитата:
Код:
unit Unit1; interface uses CommCtrl, Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TForm1 = class(TForm) Button1: TButton; Edit1: TEdit; Memo1: TMemo; ListBox1: TListBox; procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; FToolTip: HWND; const TTI_NONE = 0; TTI_INFO = 1; TTI_WARNING = 2; TTI_ERROR = 3; TTS_ALWAYSTIP = $01; TTS_NOPREFIX = $02; TTS_NOANIMATE = $10; TTS_NOFADE = $20; TTS_BALLOON = $40; TTS_CLOSE = $80; TTM_SETTITLE = WM_USER+32; implementation {$R *.dfm} procedure AddTool(Control: TWinControl; Text: String; Center: Boolean); var ti: TOOLINFO; begin ZeroMemory(@ti, SizeOf(TOOLINFO)); ti.cbSize:=SizeOf(TOOLINFO); if Center then ti.uFlags:=TTF_SUBCLASS or TTF_CENTERTIP else ti.uFlags:=TTF_SUBCLASS; ti.hwnd:=Control.Handle; ti.lpszText:=PChar(Text); GetClientRect(Control.Handle, ti.Rect); SendMessage(FToolTip, TTM_ADDTOOL, 0, LPARAM(@ti)); end; procedure TForm1.FormCreate(Sender: TObject); begin FToolTip:=CreateWindowEx(WS_EX_TOPMOST, TOOLTIPS_CLASS, nil, TTS_BALLOON or WS_POPUP or TTS_NOPREFIX or TTS_ALWAYSTIP, 0, 0, 0, 0, 0, 0, HInstance, nil); AddTool(Button1, 'Button1', True); AddTool(Edit1, 'Edit1', True); AddTool(Memo1, 'Memo1', False); AddTool(ListBox1, 'ListBox1', False); end; procedure TForm1.FormDestroy(Sender: TObject); begin DestroyWindow(FToolTip); end; end. стиль баллон можно убрать TTS_BALLOON, чтобы выглядела как обычно. Пишу программы за еду. __________________ |
#5
|
||||
|
||||
![]() Оставайтесь хорошими людьми... VK id2634397, ds [at] phoenix [dot] dj |
#6
|
||||
|
||||
![]() Вот вариант:
Код:
unit DSHintWnd; interface uses Windows, Messages; type tagNMTTDISPINFOA = packed record hdr : TNMHdr; lpszText : PAnsiChar; szText : array[0..79] of AnsiChar; hinst : HINST; uFlags : UINT; lParam : LPARAM; end; tagNMTTDISPINFO = tagNMTTDISPINFOA; PNMTTDispInfoA = ^TNMTTDispInfoA; PNMTTDispInfo = PNMTTDispInfoA; TNMTTDispInfoA = tagNMTTDISPINFOA; TNMTTDispInfo = TNMTTDispInfoA; PToolInfoA = ^TToolInfoA; PToolInfo = PToolInfoA; TToolInfoA = packed record cbSize : UINT; uFlags : UINT; hwnd : HWND; uId : UINT; Rect : TRect; hInst : THandle; lpszText : PAnsiChar; end; TToolInfo = TToolInfoA; const TTS_ALWAYSTIP = $01; TTS_NOPREFIX = $02; TTF_IDISHWND = $0001; TTF_SUBCLASS = $0010; TTM_ACTIVATE = WM_USER + 1; TTM_SETDELAYTIME = WM_USER + 3; TTM_ADDTOOL = WM_USER + 4; TTM_DELTOOL = WM_USER + 5; TTM_RELAYEVENT = WM_USER + 7; TTM_UPDATETIPTEXT = WM_USER + 12; TTM_GETTOOLCOUNT = WM_USER + 13; TTM_SETTIPBKCOLOR = WM_USER + 19; TTM_SETTIPTEXTCOLOR = WM_USER + 20; TTM_GETTIPBKCOLOR = WM_USER + 22; TTM_SETMAXTIPWIDTH = WM_USER + 24; TTM_SETMARGIN = WM_USER + 26; TTM_GETMARGIN = WM_USER + 27; TTN_FIRST = 0-520; TTN_GETDISPINFO = TTN_FIRST; TTN_NEEDTEXTA = TTN_FIRST - 0; TTN_NEEDTEXT = TTN_NEEDTEXTA; type TToolTip = class private id : UINT; fParent, Handle : HWND; fActive : Boolean; fHint : String; fTxtColor, fBkColor : TColorRef; procedure SetActive(Value : Boolean); procedure SetHint(Hint : String); procedure SetTxtColor(Color : TColorRef); procedure SetBkColor(Color : TColorRef); public constructor Create(hParent : HWND); destructor Destroy; override; procedure AddHintRect(R : TRect; Hint : String); procedure RelayMouseMove(Pos: TSmallPoint); procedure Clear; procedure Activate; procedure Deactivate; published property Active : Boolean read fActive write SetActive; property Hint : String read fHint write SetHint; property HintTxtColor: TColorRef read fTxtColor write SetTxtColor; property HintBkColor: TColorRef read fBkColor write SetBkColor; end; implementation const MAX_TOOLTIP_WINDOW_WIDTH = 220; TOOLTIPS_CLASS = 'tooltips_class32'; var ti : TToolInfo; constructor TToolTip.Create(hParent : HWND); var R : TRect; begin Handle := CreateWindowEx(WS_EX_TOPMOST, TOOLTIPS_CLASS, nil, TTS_ALWAYSTIP, 0, 0, 0, 0, hParent, 0, hInstance, nil); if Handle <> 0 then begin FillChar(ti, SizeOf(ti), 0); ti.cbSize := SizeOf(TToolInfo); ti.uFlags := TTF_SUBCLASS; ti.hInst := hInstance; SendMessage(Handle, TTM_GETMARGIN, 0, Integer(@R)); SetRect(R, R.Left + 2, R.Top + 2, R.Right + 2, R.Bottom + 2); SendMessage(Handle, TTM_SETMARGIN, 0, Integer(@R)); SendMessage(Handle, TTM_SETMAXTIPWIDTH, 0, MAX_TOOLTIP_WINDOW_WIDTH); SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE); end; fParent := hParent; fActive := True; end; destructor TToolTip.Destroy; begin inherited; // DestroyWindow(Handle); end; procedure TToolTip.AddHintRect(R: TRect; Hint: String); begin ti.cbSize := sizeof(TToolInfo); ti.hwnd := fParent; ti.Rect := R; ti.lpszText := PChar(Hint); inc(id); SendMessage(Handle, TTM_ADDTOOL, 0, Integer(@ti)); fHint := Hint; SetActive(False); end; procedure TToolTip.SetHint(Hint : String); var Rect : TRect; Bol : Boolean; begin if (fParent <> 0) and (GetClientRect(fParent, Rect)) then begin ti.cbSize := SizeOf(TToolInfo); ti.hwnd := fParent; ti.Rect := Rect; Bol := Length(ti.lpszText) <> 0; ti.lpszText := PChar(Hint); if Bol then SendMessage(Handle, TTM_UPDATETIPTEXT, 0, Integer(@ti)) else SendMessage(Handle, TTM_ADDTOOL, 0, Integer(@ti)); fHint := Hint; end; SetActive(False); end; procedure TToolTip.SetTxtColor(Color: TColorRef); begin SendMessage(Handle, TTM_SETTIPTEXTCOLOR, Color, 0); end; procedure TToolTip.SetBkColor(Color: TColorRef); begin SendMessage(Handle, TTM_SETTIPBKCOLOR, Color, 0); end; procedure TToolTip.RelayMouseMove(Pos: TSmallPoint); var Msg : TMsg; begin Msg.wParam := 0; Msg.lParam := LongInt(Pos); Msg.message := wm_MouseMove; Msg.hwnd := fParent; SendMessage(Handle, TTM_RelayEvent, 0, LongInt(@Msg)); end; procedure TToolTip.Clear; var I : Integer; begin ti.cbSize := SizeOf(ti); ti.hwnd := fParent; for I := 0 to id - 1 do begin ti.uId := I; SendMessage(Handle, TTM_DELTOOL, 0, LongInt(@ti)); end; id := 0; end; procedure TToolTip.Activate; begin if fActive then Exit; SendMessage(Handle, TTM_ACTIVATE, 1, 0); fActive:= True; end; procedure TToolTip.Deactivate; begin if not fActive then Exit; SendMessage(Handle, TTM_ACTIVATE, 0, 0); fActive:= False; end; procedure TToolTip.SetActive(Value : Boolean); begin if Value then Activate else Deactivate; end; end. Je venus de nulle part 55.026263 с.ш., 73.397636 в.д. |