Справочник функций

Ваш аккаунт

Войти через: 
Забыли пароль?
Регистрация
Информацию о новых материалах можно получать и без регистрации:

Почтовая рассылка

Подписчиков: -1
Последний выпуск: 19.06.2015

Помогите сделать скроллинг для дочерней Forms

20K
12 октября 2010 года
Disa-PV
5 / / 25.10.2006
Есть MDIform она вызывает Form на этой форме исходя из файла создаются новые элементы. И у меня возникла проблема, не хватает места на Form-е.
Я вижу два варианта.
Первый это увеличить форму – это у меня не получилось.
Второй поставить скроллинг –это я не умею.
По этому прошу помогите пожалуйста.
20K
14 октября 2010 года
Disa-PV
5 / / 25.10.2006
Нашел ответ.
Добовляем не эту форму Picture и Скролленг. Далее Все что бало на форме перенносим в Picture и Picture задаем нужных нам размеров, также можно менять и в процессе выполнения. В Скролленге задаем максимум разницу между формой и Picture.
А чтобы работоло колесико мыши пишим следующий код

В переменную Wheel передаётся направление вращение: -1 при движении вниз или 1 при движении вверх

'КОД ФОРМЫ
Option Explicit

Private Sub Form_Load()
Call Hook(Me.hwnd)
End Sub

Private Sub Form_Unload(Cancel As Integer)
Call UnHook(Me.hwnd)
End Sub


'КОД МОДУЛЯ
Option Explicit
Private Declare Function CallWindowProcA Lib "user32" (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 SetWindowLongA Lib "user32" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetWindowTextA Lib "user32" (ByVal hwnd As Long, ByVal lpString As String) As Long
Private Const GWL_WNDPROC = -4
Private Const WM_MOUSEWHEEL = &H20A
Private lpPrevWndProc As Long, Wheel As Integer

Sub Hook(hwnd As Long)
lpPrevWndProc = SetWindowLongA(hwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub

Sub UnHook(hwnd As Long)
Call SetWindowLongA(hwnd, GWL_WNDPROC, lpPrevWndProc)
End Sub

Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
On Error GoTo xErr
If uMsg = WM_MOUSEWHEEL Then
If wParam = -7864320 Or wParam = -23592960 Or wParam = -15728640 Then Wheel = -1
If wParam = 7864320 Or wParam = 23592960 Or wParam = 15728640 Then Wheel = 1
' Выводит сообщение на форму
Call SetWindowTextA(Form1.hwnd, "Wheel " & Wheel)
' не посредственно управление скролленгом
If Wheel = 1 Then
Form1.VScroll1.Value = Form1.VScroll1.Value - Form1.VScroll1.LargeChange
End If
If Wheel = -1 Then
Form1.VScroll1.Value = Form1.VScroll1.Value + Form1.VScroll1.LargeChange
End If
Else
WindowProc = CallWindowProcA(lpPrevWndProc, hwnd, uMsg, wParam, lParam)
End If
xErr:
End Function
Реклама на сайте | Обмен ссылками | Ссылки | Экспорт (RSS) | Контакты
Добавить статью | Добавить исходник | Добавить хостинг-провайдера | Добавить сайт в каталог