Code: Select all
'BY UEZ with scroll added
#include once "windows.bi"
#Include once "/win/commctrl.bi"
Dim As MSG msg ' Message variable (stores massages)
Dim Shared As HWND hWndx, stc1, stc2 ,bar ' Window variable and object variables
Dim As HFONT xFont1, xFont2
Dim Shared As Long tic,range
tic=30
range=300
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_VERT 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 WNDPROC(Byval hWnd As HWND, Byval uMsg As UINT, Byval wParam As WPARAM, Byval lParam As LPARAM) As LRESULT
Select Case umsg
Case WM_DESTROY
PostQuitMessage(NULL)
Return 0
Case WM_CTLCOLORSTATIC
Dim As HDC hdcStatic = Cast(HDC, wParam)
Select Case lParam
Case stc1
SetTextColor(hdcStatic, &hFF0000) 'BGR
SetBkColor(hdcStatic, GetSysColor(COLOR_WINDOW))
Return Cast(INT_PTR, (GetSysColorBrush(COLOR_WINDOW)))
Case stc2
SetTextColor(hdcStatic, &h0000FF) 'BGR
SetBkColor(hdcStatic, GetSysColor(COLOR_WINDOW))
Return Cast(INT_PTR, (GetSysColorBrush(COLOR_WINDOW)))
End Select
'============
Case WM_VSCROLL 'TRACKBARS
Select Case lparam
Case bar
Var t= SendMessage(bar, TBM_GETPOS, 1, 0)
MoveWindow(stc1,0,90+0-t,300,15,true)
MoveWindow(stc2,0,90+25-t,300,15,true)
End Select
Return 0
End Select
Return DefWindowProc(hWnd, uMsg, wParam, lParam)
End Function
Dim As WNDCLASS WinCls
#ifdef unicode
Dim szClassName As WString * 64
Dim szCaption As WString * 64
#else
Dim szClassName As ZString * 64
Dim szCaption As ZString * 64
#endif
szClassName = "FB_GUI"
With WinCls
.style = CS_HREDRAW Or CS_VREDRAW
.lpfnWndProc = Cast(WNDPROC, @WNDPROC)
.hInstance = GetModuleHandle(NULL)
.hIcon = LoadIcon(NULL, IDI_APPLICATION)
.hCursor = LoadCursor(NULL, IDC_ARROW)
.hbrBackground = GetSysColorBrush(COLOR_3DFACE) 'GetStockObject(WHITE_BRUSH)
.lpszMenuName = NULL
.lpszClassName = Strptr(szClassName)
End With
If RegisterClass(@WinCls) = False Then
MessageBox(NULL, "RegisterClass('WindowClass') FAIL!", "Error!", MB_OK Or MB_ICONERROR)
End
End If
' Create window
hWndx = CreateWindowEx( 0, szClassName, "", WS_OVERLAPPEDWINDOW Or WS_VISIBLE , 100, 100, 500, 300, 0, 0, 0, 0 )
' Create 1st Static box
stc1 = CreateWindowEx( 0, "STATIC", "Line 1", WS_VISIBLE Or WS_CHILD, 0, 0+90, 300, 15, hWndx, 0, 0, 0 )
xFont1 = CreateFont(20, 0, 0, 0, FW_BOLD, 0, 0, 0, ANSI_CHARSET, False, False, DEFAULT_QUALITY, DEFAULT_PITCH Or FF_ROMAN, "Courier New")
SendMessage(stc1, WM_SETFONT, Cast(WPARAM, xFont1), True)
' Create 2nd static box
stc2 = CreateWindowEx( 0, "STATIC", "Line 2", WS_VISIBLE Or WS_CHILD, 0, 25+90, 300, 15, hWndx, 0, 0, 0 )
xFont2 = CreateFont(20, 0, 0, 0, FW_BOLD, 0, 0, 0, ANSI_CHARSET, False, False, DEFAULT_QUALITY, DEFAULT_PITCH Or FF_ROMAN, "Courier New")
SendMessage(stc2, WM_SETFONT, Cast(WPARAM, xFont2), True)
'create a vertical trackbar, 300 high, with tic marks each 30
bar =CreateTrackBar(hwndx,450, 0, 30, 260,range,tic)
Dim As MSG uMsg
While GetMessage(@uMsg, 0, 0, 0)
TranslateMessage(@uMsg)
DispatchMessage(@uMsg)
Wend
DeleteObject(xFont1)
DeleteObject(xFont2)
I think you could also do this with normal scroll bars.
You need to get the position of the scroller.