API Scrollable Form - как "заякорить"контролы?

Программирование на Visual Basic, главный форум. Обсуждение тем программирования на VB 1—6.
Даже если вы плохо разбираетесь в VB и программировании вообще — тут вам помогут. В разумных пределах, конечно.
Правила форума
Темы, в которых будет сначала написано «что нужно сделать», а затем просьба «помогите», будут закрыты.
Читайте требования к создаваемым темам.
giaber
Продвинутый пользователь
Продвинутый пользователь
 
Сообщения: 107
Зарегистрирован: 14.01.2009 (Ср) 13:51

API Scrollable Form - как "заякорить"контролы?

Сообщение giaber » 12.06.2017 (Пн) 9:21

Здравствуйте!
В проекте использую форму со скролбаром. Код взял на просторах инета давно, уже не помню где. Код этот для меня – дремучий лес, как для первоклашки - интегралы. Мне над, чтоб 1 фрейм с несколькими контролами в нём при скроллинге оставался на месте, остальные контролы должны нормально скроллироваться . Подскажите пожалуйста, как мне это реализовать? Спасибо!

Код: Выделить всё
Option Explicit

Private Type SCROLLINFO
    cbSize As Long
    fMask As Long
    nMin As Long
    nMax As Long
    nPage As Long
    nPos As Long
    nTrackPos As Long
End Type

Private Declare Function SetScrollInfo Lib "user32" (ByVal hWnd As Long, ByVal n As Long, lpcScrollInfo As SCROLLINFO, ByVal bool As Boolean) As Long
Private Declare Function GetScrollInfo Lib "user32" (ByVal hWnd As Long, ByVal n As Long, lpScrollInfo As SCROLLINFO) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function ScrollWindowByNum Lib "user32" Alias "ScrollWindow" (ByVal hWnd As Long, ByVal XAmount As Long, ByVal YAmount As Long, ByVal lpRect As Long, ByVal lpClipRect As Long) As Long

Private Const GWL_STYLE = (-16)
Private Const GWL_WNDPROC = (-4)
Private Const WS_VSCROLL = &H200000
Private Const WS_HSCROLL = &H100000
Private Const SWP_FRAMECHANGED = &H20
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOZORDER = &H4
Private Const SWP_NOSIZE = &H1
Private Const SB_HORZ = 0
Private Const SB_VERT = 1
Private Const SB_BOTH = 3
Private Const SB_LINEDOWN = 1
Private Const SB_LINEUP = 0
Private Const SB_PAGEDOWN = 3
Private Const SB_PAGEUP = 2
Private Const SB_THUMBTRACK = 5

Private Const WM_HSCROLL = &H114
Private Const WM_VSCROLL = &H115
Private Const WM_DESTROY = &H2
Private Const SIF_ALL = &H17

Dim s As SCROLLINFO, OldProc As Long, hObj As Long

Public Sub SetScrollBar(objTarget As Object, sbPos As ScrollBarConstants)
    Dim lStyle As Long
    If hObj <> 0 Then Exit Sub
    On Error Resume Next
    hObj = objTarget.hWnd
    If Err Then
        MsgBox "Can not set scrollbars on this object!", vbCritical
        Exit Sub
    End If
    On Error GoTo 0
    lStyle = sbPos * &H100000
    SetWindowLong hObj, GWL_STYLE, GetWindowLong(hObj, GWL_STYLE) Or lStyle
    SetWindowPos hObj, 0, 0, 0, 0, 0, SWP_FRAMECHANGED Or SWP_NOMOVE Or SWP_NOZORDER Or SWP_NOSIZE
    s.cbSize = Len(s)
    s.fMask = SIF_ALL
    s.nMin = 0
    s.nPos = 0
    If (sbPos And vbVertical) = vbVertical Then
        s.nMax = objTarget.Height \ Screen.TwipsPerPixelY
        s.nPage = s.nMax \ 10
        Call SetScrollInfo(hObj, SB_VERT, s, True)
    End If
    If (sbPos And vbHorizontal) = vbHorizontal Then
        s.nMax = objTarget.Width \ Screen.TwipsPerPixelX
        s.nPage = s.nMax \ 10
        Call SetScrollInfo(hObj, SB_HORZ, s, True)
    End If
    OldProc = SetWindowLong(hObj, GWL_WNDPROC, AddressOf WndProc)
End Sub

Public Function WndProc(ByVal hOwner As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim nOldPos As Long
    Select Case wMsg
        Case WM_VSCROLL, WM_HSCROLL
            GetScrollInfo hOwner, wMsg - WM_HSCROLL, s
            nOldPos = s.nPos
            Select Case GetLoWord(wParam)
                Case SB_LINEDOWN
                    s.nPos = s.nPos + 1
                Case SB_LINEUP
                    s.nPos = s.nPos - 1
                Case SB_PAGEDOWN
                    s.nPos = s.nPos + s.nPage
                Case SB_PAGEUP
                    s.nPos = s.nPos - s.nPage
                Case SB_THUMBTRACK
                    s.nPos = GetHiWord(wParam)
            End Select
            If s.nPos < s.nMin Then s.nPos = s.nMin
            If s.nPos > s.nMax Then s.nPos = s.nMax
            SetScrollInfo hOwner, wMsg - WM_HSCROLL, s, True
            If wMsg = WM_VSCROLL Then
                ScrollWindowByNum hOwner, 0, nOldPos - s.nPos, 0, 0
            Else
                ScrollWindowByNum hOwner, nOldPos - s.nPos, 0, 0, 0
            End If
        Case WM_DESTROY
            If hObj <> 0 Then Call SetWindowLong(hObj, GWL_WNDPROC, OldProc)
        Case Else
    End Select
    WndProc = CallWindowProc(OldProc, hOwner, wMsg, wParam, lParam)
End Function

Private Function GetHiWord(dw As Long) As Long
    If dw And &H80000000 Then
        GetHiWord = (dw \ 65535) - 1
    Else
        GetHiWord = dw \ 65535
    End If
End Function

Private Function GetLoWord(dw As Long) As Long
    If dw And &H8000& Then
        GetLoWord = &H8000 Or (dw And &H7FFF&)
    Else
        GetLoWord = dw And &HFFFF&
    End If
End Function


В форме:
Код: Выделить всё
Private Sub Form_Load()
    SetScrollBar Me, vbVertical
End Sub

pronto
Постоялец
Постоялец
 
Сообщения: 597
Зарегистрирован: 04.12.2005 (Вс) 6:20
Откуда: Владивосток

Re: API Scrollable Form - как "заякорить"контролы?

Сообщение pronto » 12.06.2017 (Пн) 14:18

В рамках этого кода никак, потому что прокручивается окно целиком, со всеми дочерними элементами. Почему бы не крутить элементы самому:
Код: Выделить всё
Command1.Top = Command1.Top + 1 ' вниз
Command1.Top = Command1.Top - 1 ' вверх
O, sancta simplicitas!

giaber
Продвинутый пользователь
Продвинутый пользователь
 
Сообщения: 107
Зарегистрирован: 14.01.2009 (Ср) 13:51

Re: API Scrollable Form - как "заякорить"контролы?

Сообщение giaber » 12.06.2017 (Пн) 14:39

да из-за скорости, pronto, на форме десятки CheckBox -ов , боюсь тормозить будет. Большая картинка режется на куски и эти куски выводятся все BitBlt-ом на другую форму - типа превью и у каждого куска должен быть CheckBox чтоб юзер мог отметить те картинки, которые будут сохраняться, а их может быть очень много. На форме этой должны быть управляющи контролы - ну, там, размер превьюшек и ещё может быть что-нибудь. Так эти контролы должны оставаться на месте во время скроллинга, чтоб юзер постоянно имел к ним доступ. Конечно, если не найдётся лучшего варианта - сделаю обычным методом (как вы и предлагаете).
Можно было бы изменять топы "заякореных" контролов в зависимости от значения скролбара, но как получить это значение я тоже не понимаю. С обычным-то скролбаром проблем нет, а здесь непонятно...

UPD
Просмотрел ещё раз код и обнаружил что s.nPos - показывает на сколько сдвинут скролбар, то есть Form1.Text1 = s.nPos показывает нормально. Хотел сделать так:
Код: Выделить всё
Private Sub Form_Load()
    SetScrollBar Me, vbVertical
    cmdTop = Command1.Top 'запоминаем начальное положение топа кнопки
End Sub


А в
Код: Выделить всё
Public Function WndProc(...)
    ...
    End Select
    WndProc = CallWindowProc(OldProc, hOwner, wMsg, wParam, lParam)
    Form1.Text1 = s.nPos
    Form1.Command1.Top = Command1.Top + cmdTop
End Function


Но стали происходить всякие крахи и обрушения VB. Причём, если только отображение - Form1.Text1 = s.nPos, то показывает адекватно, но рушится при закрытии, а если и Form1.Command1.Top = Command1.Top + cmdTop добавляю - вообще чёрти што происходит.

Подскажите кооректный вариант, пожалуйста


Вернуться в Visual Basic 1–6

Кто сейчас на конференции

Сейчас этот форум просматривают: AhrefsBot, Mail.ru [бот] и гости: 10

    TopList