Const WM_NOTIFY = &H4E
Сообщение WM_NOTIFY посылается общими элементами управлениями своим родительским окнам при наступлении события или когда элементу управления требуется некоторая информация
Возвращаемое значение игнорируется за исключением некоторых случаев
' Создайте новый проект. ' В меню Project выберите Components. Отметьте элементы ' Rich Textbox и Common Dialog. ' Добавьте на форму CommandButton, CommonDialog, RichTextBox. ' Для RichTextBox1 установите свойство ScrollBars в 2-rtfVertical. ' Код для Form1 Option Explicit Private Sub Form_Load() ' Создадим Hook и глобальную переменную ' для дескриптора Richtextbox hwnd Call NewWindowProc(Me.hWnd) RichWnd = RichTextBox1.hWnd End Sub Private Sub Command1_Click() ' Загрузим файл в элемент richtextbox With CommonDialog1 .Filter = "All Files|*.*|Text Files|*.txt|RTF Files|*.rtf" .ShowOpen RichTextBox1.FileName = .FileName End With End Sub Private Sub Form_Resize() ' 1.)Populate global variables with the Height and Width of the ' Richtextbox control. ' 2.)Set an event mask for the Richtextbox control. ' 3.)Посылаем сообщение EM_REQUESTRESIZE в Form. gblWidth = RichTextBox1.Width / Screen.TwipsPerPixelX gblHeight = ((Form1.Height - RichTextBox1.Top) - 450) / _ Screen.TwipsPerPixelY Call SetMask(RichWnd) Call SendMessage(RichWnd, EM_REQUESTRESIZE, 0, 0) End Sub Private Sub Form_Unload(Cancel As Integer) ' Remove the Windows Hook Call ResetWindProc(Me.hWnd) End Sub ' Код для модуля BAS Option Explicit Private rResize As REQSIZE ' указатель на структуру REQSIZE Private MaskHdr As nmhdr ' указатель на структуру nmhdr Private OldWndProc As Long Private Const GWL_WNDPROC = (-4) Private Const WM_USER = &H400 Private Const WM_NOTIFY = &H4E Private Const SWP_NOMOVE = &H2 Private Const SWP_SHOWWINDOW = &H40 Private Const EM_GETEVENTMASK = (WM_USER + 59) Private Const EM_SETEVENTMASK = (WM_USER + 69) Private Const ENM_REQUESTRESIZE As Long = &H40000 Private Const EN_REQUESTRESIZE = &H701 Public gblWidth As Long ' <--- Var Holder for Richtext Width Public gblHeight As Long ' <--- Var Holder for Richtext Height Public Const EM_REQUESTRESIZE = (WM_USER + 65) Public Const VBNullPtr = 0& Public RichWnd As Long ' <--- Var Holder for Richtext Hwnd Private Type nmhdr hwndFrom As Long idfrom As Long code As Long End Type Private Type rect Left As Long Top As Long Right As Long Bottom As Long End Type Private Type REQSIZE nmhdr As nmhdr rect As rect End Type Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" _ (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _ ByVal lParam 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 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 Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _ (Destination As Any, Source As Any, ByVal Length As Long) Public Declare Function SetWindowPos Lib "user32" _ (ByVal hwnd As Long, ByVal hWndInsAfter As Long, ByVal x As Long, _ ByVal y As Long, ByVal cx As Long, ByVal cy As Long, _ ByVal wFlags As Long) As Long ' Call SetWindowLong to instantiate the Window Procedure by passing the ' Address of MyWndProc. Public Sub NewWindowProc(fhWnd As Long) On Error Resume Next OldWndProc = SetWindowLong(fhWnd, GWL_WNDPROC, AddressOf MyWndProc) End Sub ' Once the Hook is in place, All messages will be processed by this ' function. Test for a WM_NOTIFY and parse the lParam to search for a ' specific value. In this case we are looking for EN_REQUESTRESIZE in the ' nmhdr structure. If an EN_REQUESTRESIZE is found then grab the next ' structure(REQSIZE) from the lParam. Public Function MyWndProc(ByVal hwnd As Long, _ ByVal Msg As Long, _ ByVal wParam As Long, _ ByVal lParam As Long) As Long On Error Resume Next Select Case Msg Case WM_NOTIFY Call CopyMemory(MaskHdr, ByVal lParam, Len(MaskHdr)) If MaskHdr.code = EN_REQUESTRESIZE Then Call CopyMemory(rResize, ByVal lParam, Len(rResize)) If rResize.rect.Bottom < gblHeight Then Call SetWindowPos(RichWnd, VBNullPtr, _ 0, 0, gblWidth, _ rResize.rect.Bottom, _ SWP_SHOWWINDOW Or SWP_NOMOVE) Else Call SetWindowPos(RichWnd, VBNullPtr, _ 0, 0, _ gblWidth, gblHeight, _ SWP_SHOWWINDOW Or SWP_NOMOVE) End If ' By modifying 2 of the above parameters you can create an endless bottom ' Richtext control. This may be desirable if you plan to wrap the control ' and use it on a web page. To test this, comment the 'If' Statement above ' and replace it with the SetWindowPos Function call below. ' The control will now Resize itself to its actual contents. ' Call SetWindowPos(RichWnd, VBNullPtr, _ ' 0, 0, _ ' gblWidth, rResize.rect.Bottom, _ ' SWP_SHOWWINDOW Or SWP_NOMOVE) End If Case Else ' Handle other messages here. End Select ' Reset windowproc MyWndProc = CallWindowProc(OldWndProc, hwnd, Msg, wParam, lParam) End Function Public Sub ResetWindProc(hwnd As Long) On Error Resume Next ' Call SetWindowLong to remove the Windows Hook from app. Call SetWindowLong(hwnd, GWL_WNDPROC, OldWndProc) End Sub Public Sub SetMask(fhWnd As Long) On Error Resume Next Dim CurrentMask As Long Dim NewMask As Long ' Set the Event Mask to be called. CurrentMask = SendMessage(fhWnd, EM_GETEVENTMASK, 0, 0) NewMask = (CurrentMask Or ENM_REQUESTRESIZE) Call SendMessage(fhWnd, EM_SETEVENTMASK, 0, ENM_REQUESTRESIZE) End Sub