How to convert physical points of a TrackBar tics into logical points

Windows specific questions.
Post Reply
kcvinu
Posts: 232
Joined: Oct 07, 2015 16:44
Location: Keralam, India

How to convert physical points of a TrackBar tics into logical points

Post by kcvinu »

Hi all,
I have a TrackBar control. I am using custom draw to draw the channel and tick marks. So far so good. But I have a problem. When I click with mouse or press the page up/ page down key, I need the thumb's tip aligned with the tick mark. I have the current physical position and current logical position of the thumb. But the current logical position is not aligned with my tick mark, I know the tick mark's physical position. Windows API allows me to set the logical position of the tick mark. But how do I convert the physical position of my tick mark into logical position ?
Here is my current code.

Code: Select all

case WM_HSCROLL:
	curr_logical_pos = SendMessage(hTrack, TBM_GETPOS, 0, 0)
	Dim rc As RECT '// This rect contains the thumb's physical pos
	SendMessage(hTrack, TBM_GETTHUMBRECT, 0, @rc)	
Assume that I have this array of x coordinates of the tick marks
[13, 27, 41, 55, 69, 83, 97, 111, 125, 139]
When I press page up key, first two tic positions are aligned to thumb's tip. But when it comes to the third tic, thumb is resting 1 logical point behind.
Pierre Bellisle
Posts: 56
Joined: Dec 11, 2016 17:22

Re: How to convert physical points of a TrackBar tics into logical points

Post by Pierre Bellisle »

Here is an extract of the revelent code for a TrackBar that is not custom draw...
It will snap the thump to be aligned with the nearest tick.
Tested OK...

Code: Select all

 // Code assume RANGE MIN is zero, adjust code if needed
 TrackBarRangeMin_1 = 0
 TrackBarRangeMax_1 = 255

   CASE WM_CREATE / WM_INITDIALOG
     STATIC TickFreq AS LONG
     TickFreq = 48 'Adjust as needed
     SendMessage(hTrackBar1, TBM_SETTICFREQ, TickFreq, 0) 'Set tic frequency

   CASE WM_VSCROLL // WM_HSCROLL
     SELECT CASE lParam

       CASE hTrackBar1
         Dim TrackbarPos  AS LONG
         Dim TipIndex     AS LONG
         Dim LastTickFreq AS LONG

         TrackbarPos = SendMessage(hTrackBar1, TBM_GETPOS, 0, 0)
         TipIndex    = TrackbarPos \ TickFreq + 1 'One based index of the tick preceding TrackbarPos

         SELECT CASE LOWRD(wParam)

           CASE SB_THUMBPOSITION 'Thumb was released
             IF TipIndex * TickFreq <= TrackBarRangeMax_1 THEN
               'All ticks are equal size
               IF TipIndex * TickFreq <= TrackbarPos + TickFreq \ 2 THEN
                 SendMessage(hTrackBar1, TBM_SETPOS, true, (TipIndex - 0) * TickFreq)
               ELSE
                 SendMessage(hTrackBar1, TBM_SETPOS, true, (TipIndex - 1) * TickFreq)
               END IF
             ELSE
               'Needed only if last tick is smaller than the others
               LastTickFreq = TrackBarRangeMax_1 - (TipIndex - 1) * TickFreq
               IF TrackbarPos <= TrackBarRangeMax_1 - LastTickFreq \ 2 THEN
                 SendMessage(hTrackBar1, TBM_SETPOS, true, (TipIndex - 1) * TickFreq) 'End
               ELSE
                 SendMessage(hTrackBar1, TBM_SETPOS, true, (TipIndex - 0) * TickFreq)
               END IF
             END IF

           CASE TB_LINEUP, TB_PAGEUP, TB_TOP
             SendMessage(hTrackBar1, TBM_SETPOS, true, (TipIndex - 1) * TickFreq)

           CASE TB_LINEDOWN, TB_PAGEDOWN, TB_BOTTOM
             SendMessage(hTrackBar1, TBM_SETPOS, true, TipIndex * TickFreq)

         END SELECT

     END SELECT
kcvinu
Posts: 232
Joined: Oct 07, 2015 16:44
Location: Keralam, India

Re: How to convert physical points of a TrackBar tics into logical points

Post by kcvinu »

@ Pierre Bellisle,
Hi, Thank you for the reply. Let me check the code.
Pierre Bellisle
Posts: 56
Joined: Dec 11, 2016 17:22

Re: How to convert physical points of a TrackBar tics into logical points

Post by Pierre Bellisle »

kcvinu,
Here is some compilable code...

Code: Select all

#Define JumpCompiler "<D:\Dev\Free\Compiler\fbc64.exe>"
#Define JumpCompilerCmd "<-s gui -w pedantic "D:\Dev\Free\bas\~~Default.rc">"

#define unicode
#Include Once "Windows.bi"
#Include Once "Win\CommCtrl.bi"
#Include Once "Win\ShellApi.bi"

#Define AppName    "TrackBarSnap"
#Define TrackBar01 101
#Define Static01   201

Const TrackBarRangeMin_1 = 0
Const TrackBarRangeMax_1 = 255

#Define MAKDWD(x, y) (cint(y) shl 16 or cint(x))

Dim Shared As HINSTANCE hInstance : hInstance = GetModuleHandle(NULL)
'_____________________________________________________________________________

Function WndProc(ByVal hWnd As HWND, ByVal uMsg As UINT, ByVal wParam As WPARAM, ByVal lParam As LPARAM) As Integer
 Static hFont       As HFONT
 Static hTrackBar01 As HWND
 Static hStatic01   As HWND
 Static TickFreq    As LONG
 Dim    zBuff       As wString * 8

 Select Case uMsg

   Case WM_CREATE

     'Get Windows default font - - - - - - - - - - - - - - - - - - - - - - - -
     Dim As NONCLIENTMETRICS NotClientMetrics
     NotClientMetrics.cbSize = SizeOf(NONCLIENTMETRICS)
     SystemParametersInfo(SPI_GETNONCLIENTMETRICS, NotClientMetrics.cbSize, @NotClientMetrics, 0)
     hFont = CreateFontIndirect(@NotClientMetrics.lfMessageFont)

     'Create the TrackBar - - - - - - - - - - - - - - - - - - - - - - - - - -
     hTrackBar01  = CreateWindowEx(0, "MsCtls_TrackBar32", "E&xit", _
                                   WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or _
                                   TBS_VERT Or TBS_LEFT Or TBS_AUTOTICKS, _
                                   105, 25, 30, 220, _
                                   hWnd, Cast(HMENU, TrackBar01), _
                                   hInstance, NULL)
     TickFreq = 48
     SendMessage(hTrackBar01, TBM_SETTICFREQ, TickFreq, 0) 'Set tic frequency
     SendMessage(hTrackBar01, TBM_SETRANGE, TRUE, MAKDWD(TrackBarRangeMin_1, TrackBarRangeMax_1)) 'Set range
     SendMessage(hTrackBar01, TBM_SETPAGESIZE, 0, 10) 'Set page size
     SendMessage(hTrackBar01, TBM_SETPOS, TRUE, 50)   'Set initial position
     SendMessage(hTrackBar01, WM_SETFONT, Cast(WPARAM, hFont), TRUE)

     'Create the Static - - - - - - - - - - - - - - - - - - - - - - - - - - -
     hStatic01 = CreateWindowEx(0, "Static", "50", _
                                WS_CHILD Or WS_VISIBLE Or SS_CENTER OR SS_NOTIFY, _
                                105, 245, 30, 20, _
                                hWnd, Cast(HMENU, Static01), _
                                hInstance, NULL)
     SendMessage(hStatic01, WM_SETFONT, Cast(WPARAM, hFont), TRUE)
     '- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

     Return(0)

   CASE WM_VSCROLL
     SELECT CASE lParam

       CASE hTrackBar01
         Dim  TrackbarPos  AS LONG
         Dim  TipIndex     AS LONG
         Dim  LastTickFreq AS LONG

         '*Code assume RANGE MIN is zero, adjust code if needed
         TrackbarPos = SendMessage(hTrackBar01, TBM_GETPOS, 0, 0)
         TipIndex    = TrackbarPos \ TickFreq + 1 'One based index of the tick preceding TrackbarPos

         SELECT CASE LoWord(wParam)

           CASE SB_THUMBPOSITION 'Thumb was released
             IF TipIndex * TickFreq <= TrackBarRangeMax_1 THEN
               'Last tick height is equal to others
               IF TipIndex * TickFreq <= TrackbarPos + TickFreq \ 2 THEN
                 SendMessage(hTrackBar01, TBM_SETPOS, true, (TipIndex - 0) * TickFreq)
               ELSE
                 SendMessage(hTrackBar01, TBM_SETPOS, true, (TipIndex - 1) * TickFreq)
               END IF
             ELSE
               'Needed only if last tick height is smaller than the others
               LastTickFreq = TrackBarRangeMax_1 - (TipIndex - 1) * TickFreq
               IF TrackbarPos <= TrackBarRangeMax_1 - LastTickFreq \ 2 THEN
                 SendMessage(hTrackBar01, TBM_SETPOS, true, (TipIndex - 1) * TickFreq) 'End
               ELSE
                 SendMessage(hTrackBar01, TBM_SETPOS, true, (TipIndex - 0) * TickFreq)
               END IF
             END IF

           CASE TB_LINEUP, TB_PAGEUP, TB_TOP
             SendMessage(hTrackBar01, TBM_SETPOS, true, (TipIndex - 1) * TickFreq)

           CASE TB_LINEDOWN, TB_PAGEDOWN, TB_BOTTOM
             SendMessage(hTrackBar01, TBM_SETPOS, true, TipIndex * TickFreq)

         END SELECT
         zBuff = Str(TrackbarPos)
         SendMessage(hStatic01, WM_SETTEXT, 0, cast(LPARAM, @zBuff))
         Return(0)

     END SELECT

   Case WM_DESTROY
     PostQuitMessage(0)
     Return(0)

 End Select

 Function = DefWindowProc(hWnd, uMsg, wParam, lParam)

End Function
'_____________________________________________________________________________

Function WinMain(ByVal hInstance As HINSTANCE, ByVal hPrevInst As HINSTANCE, _
                 ByVal CmdLine As WString Ptr, ByVal CmdShow As Integer) As UINT
 Dim WinClass   As WNDCLASS
 Dim wMsg       As MSG
 Dim hWnd       As HWND
 Dim hIco       As HICON
 Dim WindowSize As SIZEL
 Dim wsAppName  As WString * 64

 wsAppName              = AppName & SizeOf(UInteger) * 8
 WindowSize.cx          = 250
 WindowSize.cy          = 300
 hIco                   = ExtractIcon(hInstance, "%SystemRoot%\system32\shell32.dll", 293) 'o
 WinClass.style         = CS_HREDRAW Or CS_VREDRAW
 WinClass.lpfnWndProc   = ProcPtr(WndProc)
 WinClass.cbClsExtra    = 0
 WinClass.cbWndExtra    = 0
 WinClass.hInstance     = hInstance
 WinClass.hIcon         = hIco
 WinClass.hCursor       = LoadCursor(NULL, IDC_ARROW)
 WinClass.hbrBackground = Cast(HGDIOBJ, COLOR_BTNFACE + 1) 'Default color
 WinClass.lpszMenuName  = NULL
 WinClass.lpszClassName = @wsAppName

 If (RegisterClass(@WinClass)) Then
   hWnd = CreateWindowEx(WS_EX_WINDOWEDGE, _
                         wsAppName, wsAppName, _
                         WS_OVERLAPPED OR WS_CLIPCHILDREN Or WS_DLGFRAME Or WS_BORDER Or _
                         WS_VISIBLE Or WS_CAPTION Or WS_MINIMIZEBOX Or WS_SYSMENU , _
                         (GetSystemMetrics(SM_CXSCREEN) - WindowSize.cx) / 2, _ 'PosH
                         (GetSystemMetrics(SM_CYSCREEN) - WindowSize.cy) / 2, _ 'PosV
                         WindowSize.cx, WindowSize.cy, _ 'Width, height
                         NULL, NULL, hInstance, NULL)

   ShowWindow(hWnd, SW_SHOW)
   UpdateWindow(hWnd)

   While GetMessage(@wMsg, ByVal NULL, 0, 0) > 0
     If IsDialogMessage(hWnd, @wMsg) = 0 Then
       TranslateMessage(@wMsg)
       DispatchMessage(@wMsg)
     End If
   Wend

  End If
  DestroyIcon(hIco)
  Return(wMsg.message)

End Function
'_____________________________________________________________________________

End WinMain(hInstance, NULL, Command(), SW_NORMAL) 'Call main() and return the error code to the OS
'_____________________________________________________________________________
'
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: How to convert physical points of a TrackBar tics into logical points

Post by dodicat »

Another example

Code: Select all


#Include Once "windows.bi"
#Include once "/win/commctrl.bi"

Declare Function CreateTrackBar(dest As hwnd,x As Long,y As Long,lngth As Long,height As Long,range As Long,pagesize As Long) As hwnd
Declare Function CreateToolTip(X As hwnd,msg As String="") As hwnd
Declare Function fb_Set_Font (Font As String,Size As Integer,Bold As Integer=0,Italic As Integer=0,Underline As Integer=0,StrikeThru As Integer=0) As HFONT
Declare function closest(tp as long,tic as long,range as long) as long

Declare Function main As Long
End main

Function WndProc(hWnd As HWND, msg As UINT, wParam As WPARAM, lParam As LPARAM) As LRESULT
    #define nobreak(n)  End Select: Select Case n
    Static As Ubyte rd,gr,bl 'the colours for the mainwindow
    Static As PAINTSTRUCT ps
    Static As rect r
    Static As HWND bar,label,bar2,label2,bar3,label3,hnw
    var tic=25,range=255

    Select Case msg ' set up
    Case WM_CREATE
        label= CreateWindowEx(NULL,"static", "", WS_VISIBLE Or WS_CHILD , 0, 150, 100, 40, hwnd,NULL, NULL, NULL)
        label2= CreateWindowEx(NULL,"static", "", WS_VISIBLE Or WS_CHILD , 0, 250, 100, 40, hwnd,NULL, NULL, NULL)
        label3= CreateWindowEx(NULL,"static", "", WS_VISIBLE Or WS_CHILD , 0, 350, 100, 40, hwnd,NULL, NULL, NULL)
        hnw=CreateWindowEx(NULL,"static", "", WS_VISIBLE Or WS_CHILD , 0, 450, 190, 40, hwnd,NULL, NULL, NULL)
        setwindowtext(label,"Red 0")
        setwindowtext(label2,"Green 0")
        setwindowtext(label3,"Blue 0")
        setwindowtext(hnw," Happy new year")
        'set up three trackbars
        bar =CreateTrackBar(hwnd,100, 150, 300, 40,range,tic)
        bar2=CreateTrackBar(hwnd,100, 250, 400, 40,range,tic)
        bar3=CreateTrackBar(hwnd,100, 350, 600, 40,range,tic)
        'set up tooltips on all trackbar thumbs  
        CreateToolTip(bar,"Red scaler, length=300")
        CreateToolTip(bar2,"Green scaler, length=400")
        CreateToolTip(bar3,"Blue scaler, length=600") 
        Dim As HFONT   f1=fb_Set_Font("Courier new",14,,true),f2=fb_Set_Font("times new roman",20,,true)
        SendMessage(label,WM_SETFONT,Cast(WPARAM,f1),0)
        SendMessage(label2,WM_SETFONT,Cast(WPARAM,f1),0)
        SendMessage(label3,WM_SETFONT,Cast(WPARAM,f1),0)
        SendMessage(hnw,WM_SETFONT,Cast(WPARAM,f2),0)
    End Select
    
    Select Case hWnd
    
    Case hwnd  
        Select Case msg
        
        Case WM_CTLCOLORstatic
            Var dcH =  Cast(HDC, Wparam)
            SetBkMode(dcH, TRANSPARENT)
            SetTextColor(dcH, BGR(0,0,0))
            Static  BrushH As HBRUSH 
            If BrushH = NULL Then
                BrushH =  Cast(HBRUSH, CreateSolidBrush(BGRA(200,200,200,0)))
            End If
            Return  Cast(LRESULT,BrushH)
            
        Case  WM_HSCROLL                        'TRACKBARS
            
            Select Case lparam
            
            Case bar'red
                var trackpos= SendMessage(bar, TBM_GETPOS, 1, 0)
                setwindowtext(label,"Red "+Str(trackpos))
                rd=closest(trackpos,tic,range)
                 var k=iif(rd>=225,1,0)
                SendMessage(bar,TBM_SETPOS,k,rd)
                nobreak(lparam) ' C style switch
                
            Case bar2 'green
                var trackpos= SendMessage(bar2, TBM_GETPOS, 0, 0)
                setwindowtext(label2,"Green "+Str(trackpos))
                gr=closest(trackpos,tic,range)
                 var k=iif(gr>=225,1,0)
                SendMessage(bar2,TBM_SETPOS,k,gr)
                nobreak(lparam) ' C style switch
                
            Case bar3 'blue
                var trackpos= SendMessage(bar3, TBM_GETPOS, 0, 0)
                setwindowtext(label3,"Blue "+Str(trackpos))
                bl=closest(trackpos,tic,range)
                 var k=iif(bl>=225,1,0)
                SendMessage(bar3,TBM_SETPOS,k,bl)
                nobreak(lparam) ' C style switch
                
            Case Else 'Always gets here
                Static As Long k=1
                k=-k
                getwindowrect(hwnd,@r)
                movewindow(hwnd,r.left,r.top,800+k,600,1)'ACTIVATE WM_PAINT
            End Select
            
            
        Case WM_PAINT
            BeginPaint(hWnd, @ps)
            FillRect(ps.hdc, @ps.rcPaint, CreateSolidBrush(BGR(rd, gr, bl)))
            EndPaint(hWnd, @ps)
            
        Case WM_CLOSE
            PostQuitMessage(NULL) 
            
        Case Else
            'not decided
        End Select
        
    End Select
    
    Return DefWindowProc(hWnd, msg, wParam, lParam)
End Function

Function CreateToolTip(X As hwnd,msg As String="") As hwnd
    Dim As hwnd  TT= CreateWindowEx(0,"ToolTips_Class32","",64,0,0,0,0,X,0,GetModuleHandle(0),0)
    '64=bubble,0 = rectangle
    SendMessage(TT, TTM_SETMAXTIPWIDTH, 0 , 180) 
    SendMessage(TT, TTM_SETDELAYTIME, TTDT_INITIAL ,40) 
    SendMessage(TT, TTM_SETDELAYTIME, TTDT_RESHOW  ,60)
    Dim bubble As TOOLINFO 
    bubble.cbSize = Len(TOOLINFO) 
    bubble.uFlags = TTF_IDISHWND Or TTF_SUBCLASS 
    bubble.uId = Cast(Uinteger,X) 
    bubble.lpszText = Strptr(msg)
    SendMessage(TT, TTM_ADDTOOL, 0,Cast(LPARAM,@bubble))
    Return TT
End Function

Function CreateTrackBar(dest As hwnd,x As Long,y As Long,lngth As Long,height As Long,range As Long,pagesize As Long) As hwnd
    Dim As hwnd h=CreateWindowEx(NULL,TRACKBAR_CLASS, "Trackbar Control", WS_VISIBLE Or WS_CHILD Or  TBS_AUTOTICKS Or TBS_ENABLESELRANGE,x,y,lngth,height,dest,NULL, NULL, NULL)
    SendMessage(h,TBM_SETRANGE,TRUE, MAKELONG(0,range))
    SendMessage(h,TBM_SETTICFREQ,pagesize,0)'Set tic frequency
    SendMessage(h,TBM_SETPAGESIZE,0,pagesize) 'Set page size
    Return h
End Function

Function fb_Set_Font (Font As String,Size As Integer,Bold As Integer,Italic As Integer,Underline As Integer,StrikeThru As Integer) As HFONT
    Dim As HDC hDC=GetDC(HWND_DESKTOP)
    Dim As Integer CyPixels=GetDeviceCaps(hDC,LOGPIXELSY)
    ReleaseDC(HWND_DESKTOP,hDC)
    Return CreateFont(0-(Size*CyPixels)/72,0,0,0,Bold,Italic,Underline,StrikeThru,ANSI_CHARSET _
    ,OUT_TT_PRECIS,CLIP_DEFAULT_PRECIS,DEFAULT_QUALITY,FF_DONTCARE,Font)
End Function

function closest(tp as long,tic as long,range as long) as long
    dim as long d=10000,res
    for n as long=0 to range step tic
       var dd=abs(n-tp)
        if d>dd then d=dd:res=n
    next
    if tp=range then return range
    return res
    end function

Function MAIN As Long
    static as hwnd MainWindow
    ' Create  window class:
    Dim As WNDCLASS wcls
    Function=0
    With wcls
        .style      = CS_HREDRAW Or CS_VREDRAW
        .lpfnWndProc  = @WndProc
        .hInstance    = GetModuleHandle(NULL)
        .hIcon      = LoadIcon(NULL, IDI_APPLICATION)
        .hCursor      = LoadCursor(NULL, IDC_ARROW)
        .hbrBackground  = GetStockObject(WHITE_BRUSH)
        .lpszMenuName  = NULL
        .lpszClassName  = Strptr("WindowClass")
    End With
    
    If RegisterClass(@wcls) = FALSE Then
        MessageBox(NULL, "RegisterClass('WindowClass') FAIL!", "Error!", MB_OK Or MB_ICONERROR)
        End
    End If
    
    'mainwindow
    MainWindow = CreateWindowEx(NULL, "WindowClass", "MainWindow", WS_OVERLAPPEDWINDOW Or WS_VISIBLE, 100, 100, 800, 600, NULL, NULL, NULL, NULL)
    
    Dim As MSG uMsg
    While GetMessage(@uMsg, NULL, NULL, NULL) <> FALSE
        TranslateMessage(@uMsg)
        DispatchMessage(@uMsg)
    Wend
End Function

 
 
Last edited by dodicat on Jan 01, 2023 22:15, edited 2 times in total.
Pierre Bellisle
Posts: 56
Joined: Dec 11, 2016 17:22

Re: How to convert physical points of a TrackBar tics into logical points

Post by Pierre Bellisle »

Hey dodicat!
I do not see any alignment of the thumb with tick mark.
Did you post the right code?
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: How to convert physical points of a TrackBar tics into logical points

Post by dodicat »

Oops, sorry.
I have edited.
Pierre Bellisle
Posts: 56
Joined: Dec 11, 2016 17:22

Re: How to convert physical points of a TrackBar tics into logical points

Post by Pierre Bellisle »

Thank for sharing.
I saw your "Happy new year" message.
Happy new year to you too dodicat and to the FB community!
Last edited by Pierre Bellisle on Jan 02, 2023 21:19, edited 1 time in total.
kcvinu
Posts: 232
Joined: Oct 07, 2015 16:44
Location: Keralam, India

Re: How to convert physical points of a TrackBar tics into logical points

Post by kcvinu »

Pierre Bellisle wrote: Dec 31, 2022 1:24 kcvinu,
Here is some compilable code...
Hi, thank you once again. Sorry for the delayed reply. I was busy with my new year holidays. Well, I like your approach. And I am happy that this time it's a working sample. I have learned some new things from your code. Especially collecting the message box font. That's impressive. Well, in these days, I found a working solution to my problem. This is it.

Code: Select all

case TB_THUMBPOSITION
	if not track.freeMove '// We need to set the thumb to nearest tic, otherwise, we don't care about the position
		pos = track.value
		half = track.frequency \ 2
		diff = track.value Mod track.frequency
		if diff >= half
			pos = (track.frequency - diff) + track.value
		elif diff < half
			pos =  track.value - diff

		if track.reversed '// This trackbar is reversed'
			SendMessage(track.hwnd, TBM_SETPOS, True, (pos * -1)) '// Invert it to minus value'
		else
			SendMessage(track.hwnd, TBM_SETPOS, True, pos)
		end if
	end if
	
Last edited by kcvinu on Jan 02, 2023 21:15, edited 1 time in total.
kcvinu
Posts: 232
Joined: Oct 07, 2015 16:44
Location: Keralam, India

Re: How to convert physical points of a TrackBar tics into logical points

Post by kcvinu »

dodicat wrote: Dec 31, 2022 22:10 Another example
Hi @dodicat,
Thanks a lot for the sample code. I like that approach. Especially the macro stuff.
Post Reply