PureBasic Forums - English

Code: Select all

Enumeration
#Win
#TrackBar
#TxtVal
EndEnumeration

#TBS_TOOLTIPS = $100
#TBS_DOWNISLEFT = $0400

Procedure Win()
;#-------------
Protected iFlags.i = #PB_Window_SystemMenu | #PB_Window_ScreenCentered
Protected iEvent.i = 0, iExit.i = #False, sVal.s

              If OpenWindow(#Win, 0, 0, 200, 200, "Vertical TrackBar", iFlags)

                    TrackBarGadget(#TrackBar, 40, 10, 40, 180, 0, 100, #PB_TrackBar_Vertical|#TBS_TOOLTIPS) 
                        TextGadget(#TxtVal,  110, 60, 50,  20, "", #PB_Text_Right | #PB_Text_Border)
                      ;SendMessage_(GadgetID(#Trackbar),#TBM_SETRANGEMIN,1,0)
                      ;SendMessage_(GadgetID(#Trackbar),#TBM_SETRANGEMAX,1,100)

                    Repeat

                                iEvent = WaitWindowEvent(1)
                         Select iEvent

                                  Case #PB_Event_CloseWindow : iExit = #True

                                  Case #PB_Event_Gadget

                                       Select EventGadget()

                                                 Case #TrackBar
                                                      sVal = Str(GetGadgetState(#TrackBar))
                                                      SetGadgetText(#TxtVal, sVal)
                                       EndSelect
                         EndSelect

                    Until iExit = #True

              EndIf
EndProcedure

Win()
End

Code: Select all

#TBM_SETTOOLTIPS = $41D
#TTF_TRACK = $20

Global ti.TOOLINFO,TTIP

Procedure IsMouseOver(hWnd) 
    GetWindowRect_(hWnd,r.RECT) 
    GetCursorPos_(p.POINT) 
    Result = PtInRect_(r,p\y << 32 + p\x) 
    ProcedureReturn Result 
EndProcedure 

Procedure track()
   Text$ = Str(GetGadgetState(1))
   ti\lpszText = @Text$
   SendMessage_(TTIP, #TTM_UPDATETIPTEXT, 0, @ti)
   SendMessage_(TTIP, #TTM_TRACKACTIVATE, 1, @ti)
EndProcedure

OpenWindow(0, 0, 0, 275, 210, "TrackBar Tooltip", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
    TrackBarGadget(1, 20, 20, 26,170, 0, 100,#PB_TrackBar_Ticks|#PB_TrackBar_Vertical)
    FrameGadget(2, 19,19,28,172,"",#PB_Frame_Flat)
    TextGadget(3,100,20,80,20,"",#PB_Text_Center|#PB_Text_Border)
    TextGadget(4,100,60,80,20,"",#PB_Text_Center|#PB_Text_Border)
    
    TTIP = CreateWindowEx_(0, #TOOLTIPS_CLASS, "", #TTS_NOPREFIX, 0, 0, 0, 0, WindowID(0), 0, GetModuleHandle_(0), 0)
    ti\cbSize = SizeOf(ti)
    ti\hWnd = WindowID(0)
    ti\uFlags = #TTF_IDISHWND | #TTF_TRACK | #TTF_CENTERTIP
    ti\uId = GadgetID(1)
    Text$ = Str(GetGadgetState(1))
    ti\lpszText = @Text$
    SendMessage_(GadgetID(1), #TBM_SETTOOLTIPS, TTIP, 0)
    SendMessage_(TTIP, #TTM_ADDTOOL, 0, @ti)
    BindGadgetEvent(1,@Track(),#PB_All)
Repeat
    Select WaitWindowEvent()
      Case #PB_Event_CloseWindow
          Quit = 1
          
      Case #PB_Event_Gadget
          Select EventGadget()
              Case 1
                  SetGadgetText(3,Str(GetGadgetState(1)))                         ;Position using PB
                  SetGadgetText(4,Str(SendMessage_(GadgetID(1),#TBM_GETPOS,0,0))) ;Position using API
          EndSelect
          
      Case #WM_LBUTTONDOWN,#WM_MOUSEMOVE
          If IsMouseOver(GadgetID(1))
            SendMessage_(TTIP, #TTM_TRACKACTIVATE, 1, @ti)
          Else
            SendMessage_(TTIP, #TTM_TRACKACTIVATE, 0, @ti)
          EndIf
      EndSelect
 Until Quit = 1