动态变化大小的RichTextBox: "Bottomless RichTexBox"

Option Explicit

Private Sub Form_Load()
' Create a Hook and populate a global variable with the Richtextbox hwnd.
   Call NewWindowProc(Me.hWnd)
   RichWnd = RichTextBox1.hWnd
End Sub

Private Sub Command1_Click()
' Load a file into the richtextbox control
   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.)Send an EM_REQUESTRESIZE Message to the Form.

   gblWidth = RichTextBox1.Width / Screen.TwipsPerPixelX
   gblHeight = ((Form1.Height - RichTextBox1.Top) - 450) / _
               Screen.TwipsPerPixelY
   Call SetMask(RichWnd)
   Call SendMessage(RichWnd,EM_REQUESTRESIZE,0)
End Sub

Private Sub Form_Unload(Cancel As Integer)
   Call ResetWindProc(Me.hWnd) ' Remove the Windows Hook
End Sub

Option Explicit

' Private Variables

Private rResize As REQSIZE ' <--- Pointer to REQSIZE Structure
Private MaskHdr As nmhdr   ' <--- Pointer to nmhdr Structure
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 Variables

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 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,Len(rResize))


            If rResize.rect.Bottom < gblHeight Then
               Call SetWindowPos(RichWnd,VBNullPtr,_
                                 0,gblWidth,_
                                 rResize.rect.Bottom,_
                                 SWP_SHOWWINDOW Or SWP_NOMOVE)

            Else
               Call SetWindowPos(RichWnd,_
                                    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,_
'                             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,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)
   NewMask = (CurrentMask Or ENM_REQUESTRESIZE)
   Call SendMessage(fhWnd,EM_SETEVENTMASK,ENM_REQUESTRESIZE)
End Sub