Ура. Я научился отслеживать события любого горизонтального скролла. Как в группе, так и на листе. Некоторые моменты еще требуют уточнения, но свет в конце туннеля уже виден)
На радостях выкладываю черновик, может пригодится кому нибудь) Тема закрыта, всем спасибо)
Код: Выделить всё
PROGRAM
! Common equates
HANDLE EQUATE(UNSIGNED)
HWND EQUATE(HANDLE)
HBITMAP EQUATE(HANDLE)
HDC EQUATE(HANDLE)
HGDIOBJ EQUATE(HANDLE)
HBRUSH EQUATE(HANDLE)
WPARAM EQUATE(UNSIGNED)
LPARAM EQUATE(LONG)
SCROLLINFO GROUP,TYPE
cbSize ULONG
fMask ULONG
nMin LONG
nMax LONG
nPage ULONG
nPos LONG
nTrackPos LONG
END
!Scroll-events
SB_LINEUP EQUATE(0)
SB_LINELEFT EQUATE(0)
SB_LINEDOWN EQUATE(1)
SB_LINERIGHT EQUATE(1)
SB_PAGEUP EQUATE(2)
SB_PAGELEFT EQUATE(2)
SB_PAGEDOWN EQUATE(3)
SB_PAGERIGHT EQUATE(3)
SB_THUMBPOSITION EQUATE(4)
SB_THUMBTRACK EQUATE(5)
SB_TOP EQUATE(6)
SB_LEFT EQUATE(6)
SB_BOTTOM EQUATE(7)
SB_RIGHT EQUATE(7)
SB_ENDSCROLL EQUATE(8)
sInfo GROUP(SCROLLINFO) .
POINT GROUP,TYPE
x LONG
y LONG
END
pt GROUP(POINT) .
GWL_WNDPROC EQUATE(-4)
SB_HORZ EQUATE(0)
SB_VERT EQUATE(1)
SB EQUATE(3)
WM_HSCROLL EQUATE(0114h)
WM_VSCROLL EQUATE(0115h)
WM_CTLCOLORSCROLLBAR EQUATE(0137h)
RECT GROUP,TYPE
Left SIGNED
Top SIGNED
Right SIGNED
Bottom SIGNED
END
!Scrollinfo
SIF_RANGE EQUATE(0001H)
SIF_PAGE EQUATE(0002H)
SIF_POS EQUATE(0004H)
SIF_DISABLENOSCROLL EQUATE(0008H)
SIF_TRACKPOS EQUATE(0010H)
SIF_ALL EQUATE(SIF_RANGE+SIF_PAGE+SIF_POS+SIF_TRACKPOS)
tmp like(rect)
MAP
PaintArea_WndProc (HWND hWnd, UNSIGNED wMsg, WPARAM wParam, LPARAM lParam),LONG,PASCAL
MODULE('Windows API')
GetClientRect(HWND, *RECT),PASCAL,RAW
CallWindowProc (LONG lpPrevWndFunc, HWND hWnd, UNSIGNED wMsg, WPARAM wParam, LPARAM lParam),LONG,PASCAL,NAME('CallWindowProcA')
GetScrollPos (HWND hWnd, SIGNED nBar),SIGNED,PASCAL
SetScrollPos (HWND hWnd, SIGNED nBar, SIGNED Pos, BOOL),SIGNED,PASCAL
SetWindowLong (HWND hWnd, SIGNED nIndex, LONG dwNewLong),LONG,PROC,PASCAL,NAME('SetWindowLongA')
SetScrollRange (HWND, SIGNED, SIGNED, SIGNED, BOOL),PASCAL
FindWindowEx(<UNSIGNED>, <UNSIGNED>, <*CSTRING>, <*CSTRING>),UNSIGNED,PASCAL,RAW,NAME('FindWindowExA')
GetScrollInfo(UNSIGNED hWnd, LONG fnBar, ULONG lpsi),BYTE,RAW,PASCAL,NAME('GetScrollInfo'),PROC
END
MODULE('Win32Api')
GetWindowRect(UNSIGNED hWnd, *RECT lpRect),BOOL,PASCAL,RAW,PROC
GetCursorPos(ULONG lpPoint),BYTE,PASCAL,RAW,NAME('GetCursorPos'),PROC
END
END
PaintArea_WndProc_Addr LONG ! Адрес оригинальной процедуры окна
PaintArea_hWnd HWND ! Handle окна области просмотра
myhvnd HWND
PaintArea_hDC HDC ! Контекст области просмотра
PaintArea_hMemDC HDC ! Контекст в памяти с картинкой
PaintArea_hBitMap HBITMAP ! Битовая карта изображения
PaintArea_hOldBitMap HBITMAP ! Предыдущая битовая карта контекста
PaintArea_HScrollPos SIGNED ! Текущая позиция (0-255) горизонтального скролбара
PaintArea_VScrollPos SIGNED ! Текущая позиция (0-255) вертикального скролбара
DataQueue QUEUE,PRE()
Level1 LONG
Level2 LONG
Level3 LONG
Level4 LONG
END
s1 cstring (200)
s2 cstring (200)
PaintArea:Win WINDOW('Paint Area'),AT(,,300,300),FONT('MS Sans Serif',8),CENTER,GRAY,DOUBLE,SYSTEM
LIST,AT(0,0,100,100),USE(?List),FORMAT('[80L(2)|M~loc 1~@s20@#1#80L(2)|M~loc 2~@s20@#2#80L(2)|M~loc 3~@s20@#3#80L(2)|M~loc 4~@s20@#4#]S(144)'),FROM(DataQueue),VScroll, IMM
PROMPT('Horz:'),AT(5,116)
STRING(@s6),AT(28,116),USE(PaintArea_HScrollPos)
PROMPT('Vert:'),AT(74,116)
STRING(@s6),AT(128,116),USE(PaintArea_VScrollPos)
END
!*************************************************************************************************
CODE
OPEN(PaintArea:Win)
Level1 = 1
Level2 = 2
Level3 = 3
Level4 = 4
add (DataQueue)
?List{PROP:From} = DataQueue
PaintArea_hWnd = ?List{PROP:Handle}
! SetScrollRange (myhvnd, SB_HORZ, 0, 255, TRUE)
! Сабклассинг области просмотра
PaintArea_WndProc_Addr = SetWindowLong(PaintArea_hWnd, GWL_WNDPROC, ADDRESS(PaintArea_WndProc))
! Цикл работы с окном
ACCEPT
END
CLOSE(PaintArea:Win)
!*************************************************************************************************
PaintArea_WndProc PROCEDURE(HWND hWnd, UNSIGNED wMsg, WPARAM wParam, LPARAM lParam)
hDC HDC
hWndDC HDC
PosX LONG ! Координаты левого верхнего угла
PosY LONG ! отображаемой части картинки
res BYTE
CODE
CASE wMsg
OF WM_HSCROLL
! PaintArea_HScrollPos = WM_HSCROLL
GetCursorPos(ADDRESS(pt))
sInfo.cbSize = SIZE(SCROLLINFO)
sInfo.fMask = SIF_ALL
GetScrollInfo(hWnd, SB_HORZ, Address(sInfo))
Case BAnd(wParam, 65535) !LOWORD(wParam)
OF SB_LINELEFT
PaintArea_VScrollPos -=10
OF SB_LINERIGHT
PaintArea_VScrollPos +=10
OF SB_PAGELEFT
PaintArea_VScrollPos -=100
OF SB_PAGERIGHT
PaintArea_VScrollPos +=100
OF SB_LEFT
PaintArea_VScrollPos -=1
OF SB_RIGHT
PaintArea_VScrollPos +=1
OF SB_THUMBPOSITION
PaintArea_VScrollPos = +1
OF SB_THUMBTRACK
PaintArea_VScrollPos -=1
End
DISPLAY(?PaintArea_HScrollPos)
DISPLAY(?PaintArea_VScrollPos)
END
RETURN CallWindowProc(PaintArea_WndProc_Addr, hWnd, wMsg, wParam, lParam)
!*************************************************************************************************