\    File: Tooltip.f
\  Author: Jeff Kelm
\ Created: 18-Nov-1998
\ Updated: 31-Dec-1998
\ a class for managing tooltips

Comment:  Revision History (most recent first)
19981231
 - Incorporated the new ChildWindow class.
19981118
 - file created
Comment;



NEEDS BasicWin.f
CR .( Loading Tooltip class...)



\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ \\\  A generic tooltip control class
\
:Class Tooltip  <Super ChildWindow

   Record: ti   \ The TOOLINFO structure
      INT  cbSize
      INT  uFlags
      INT  hwnd
      INT  uId
       INT  left \ RECT
       INT  top
       INT  right
       INT  bottom
      INT  hinst
      INT  lpszText
   ;RecordSize: sizeof(TOOLINFO)

   :M DefStyle: ( -- style)   \ default control style
      WS_POPUP WS_BORDER OR  WS_CLIPSIBLINGS OR  WS_CHILD OR
      ;M

   :M DefExStyle: ( -- exStyle)   \ default extended style
      WS_EX_TOOLWINDOW
      ;M

   :M DefClassName: ( -- ClassName)   \ default class name
      Z" tooltips_class32"
      ;M

   :M Create: ( hParent)   \ creates an empty trackbar in parent window
      Create: super
      sizeof(TOOLINFO) TO cbSize
      NULL TO hinst
      ;M

comment:
:Class Tooltip  <Super BaseWindow

   Record: ti   \ The TOOLINFO structure
      INT  cbSize
      INT  uFlags
      INT  hwnd
      INT  uId
       INT  left \ RECT
       INT  top
       INT  right
       INT  bottom
      INT  hinst
      INT  lpszText
   ;RecordSize: sizeof(TOOLINFO)

   :M DefStyle: ( -- style)   \ default control style
      WS_POPUP WS_BORDER OR  WS_CLIPSIBLINGS OR
      ;M

   :M DefExStyle: ( -- exStyle)   \ default extended style
      WS_EX_TOOLWINDOW
      ;M

   :M Create: ( hParent)   \ creates an empty trackbar in parent window
      >R  NULL appInst NULL  R>
      CW_USEDEFAULT CW_USEDEFAULT CW_USEDEFAULT CW_USEDEFAULT
      DefStyle: self  WS_CHILD OR  \ style
      NULL TOOLTIPS_CLASS  DefExStyle: self
         Call CreateWindowEx  DUP TO hWnd  ?WinError
      sizeof(TOOLINFO) TO cbSize
      NULL TO hinst
      ;M
comment;

comment:
   :M AddControl: ( lpszText hControl)   \ register a control
      TO uId  TO lpszText
      TTF_IDISHWND TTF_CENTERTIP OR  TTF_SUBCLASS OR  TO uFlags
      ti rel>abs 0 TTM_ADDTOOL SendMessage: self  ?WinError
      ;M

   :M AddRegion: ( lpszText id lpRect hWnd)   \ register a region of a window
      TO hwnd  Put: Rect  TO uId  TO lpszText
      TTF_CENTERTIP TTF_SUBCLASS OR  TO uFlags
      ti rel>abs 0 TTM_ADDTOOL SendMessage: self  ?WinError
      ;M

   :M SetText: ( lzString)   \ set new text for a previously defined tool
      TO lpszText
      ti rel>abs 0 TTM_UPDATETIPTEXT SendMessage: self  DROP
      ;M

   :M GetText: ( -- lsString)   \ get the current text for a tool
      ti rel>abs 0 TTM_GETTEXT SendMessage: self  DROP
      lpszText
      ;M
comment;

   :M AddTool: ( lpTOOLINFO)   \ add tool in TOOLINFO structure to tooltip
      rel>abs 0 TTM_ADDTOOL SendMessage: self  ?WinError
      ;M

   :M SetText: ( lzString lpTOOLINFO)   \ set new text for a previously defined tool
      SWAP OVER 9 CELLS + !
      rel>abs 0 TTM_UPDATETIPTEXT SendMessage: self  DROP
      ;M

   :M GetText: ( lpTOOLINFO -- lsString)   \ get the current text for a tool
      DUP rel>abs 0 TTM_GETTEXT SendMessage: self  DROP
      9 CELLS +
      ;M

;Class