Flicker Free Form Resizing (updated for display formatting)
This article will show you some simple techniques to add flicker-free form resizing of a sizable form, when there is a minimum size limit controlled by the form's Resize event, and the user tries to change the size. Normally, this flicker makes some people wonder if the program is buggy. This article has also grown since its first release. Additional enhancements include simple API calls to make the resizing even smoother, and tops it off with a beginner's introduction to Call-Back functions, where one can intercept the Windows Message Processor (WndProc) for their form and force the form not to resize below specified dimensions.
AI
AI 摘要: This codebase represents a historical implementation of the logic described in the metadata. Our preservation engine analyzes the structure to provide context for modern developers.
源代码
<p><span style="font-family: Arial;"><font size="5"><i><b>Flicker Free Form Resize<br> </b></i></font>By David Ross Goben<br> <br></span><i><span style="font-family: Arial;">You are free to use this information, plus the included snippets in your own forms<br>without even acknowledging my work or me.<br> <br></span></i><span style="font-family: Arial;">If you need to maintain a minimum size to a sizable form, normally you place code in<br>the Resize event that will check to ensure the form has not been resized below a<br>minimum dimension (not counting minimization of the form). But if you do this, we<br>get the following results: If the user sizes the form larger than the minimum, then<br>there is no visible fireworks. However, if they size it below the required minimum,<br>then the form flickers like mad as the <b>Form_Resize</b> event constantly tries<br>to re-inflate the form size to the minimum you have established.<br> <br>Normally, a resize even would contain something like the following minimalist code,<br>which is the source of all the flicker:<br> <br></span><font color="#186125" size="2"><b><span style="color: green; font-family: Courier New;">'********************<br></span></b></font><font size="2"><b><span style="color: green; font-family: Courier New;">' Form_Resize<br>' Resize the form<br></span></b></font><font color="#186125" size="2"><b><span style="color: green; font-family: Courier New;">'********************<br></span></b></font><b><font size="2"><span style="color: navy; font-family: Courier New;">Private Sub Form_Resize()<br> Select Case Me.WindowState<br> Case vbMinimized<br> Exit Sub<br> Case vbNormal<br> If Me.Width < 5000 Then<br> Me.Width = 5000<br> End If<br> If Me.Height < 6000 Then<br> Me.Height = 6000<br> End If<br></span></font></b><font size="2" color="#000080"><b><span style="font-family: Courier New"> </span></b></font><b><font size="2"><span style="color: navy; font-family: Courier New;">End Select<br></span><span style="color: green; font-family: Courier New;"> '<br> 'other control arrangement code goes here.<br> '<br></span></font></b><span style="color: navy; font-family: Courier New;"><b><font size="2">End Sub<br> <br></font></b></span><font size="3"><span style="font-family: Arial;">Typically, you would not want to add "magic numbers" into your program (the form<br>boundary sizes 5000 and 6000), and under typical circumstances you would want to<br>declare them in constants (they are called <b>magic numbers</b>, because later, on when<br>you modify your program, these numbers might do magical things because you may<br>have changed form sizing limits elsewhere)</span><font size="3"><span style="font-family: Arial;">.<br> <br>Regardless, you may want to declare something like this at the top of your form, but<br>using the values you require, and replacing the instances of 5000 and 6000 found in<br>the above example with these constant names <b>MyFormWd</b> and <b>MyFormHt</b>:<br> <br></span></font><font color="#000080" size="2" face="Courier New"><span style="font-weight: 700;">Private</span></font><b><font color="#000080" size="2" face="Courier New"> Const MyFormWd As Long = 5000<br>Private</font></b><font size="3"><b><font color="#000080" size="2" face="Courier New"> Const MyFormHt As Long = 6000<br> </font></b><span style="font-family: Arial;"><br>I will be using these named constants in all the following example code.<br> <br>The simple solution to solving this flicker problem is quick and easy. All it takes is for<br>you to add a timer to your form, naming it something like <b>tmrResize</b>. Set its interval<br>to 250, and disable the timer. Next change the above Resize event code to this:<br> <br></span></font><font color="#186125" size="2"><b><span style="color: green; font-family: Courier New;">'********************<br></span></b></font><font size="3"><font size="2"><b><span style="color: green; font-family: Courier New;">' Form_Resize<br>' Resize the form<br></span></b></font><font color="#186125" size="2"><b><span style="color: green; font-family: Courier New;">'********************<br></span></b></font><b><font size="2"><span style="color: navy; font-family: Courier New;">Private Sub Form_Resize()<br> Select Case Me.WindowState<br> Case vbMinimized<br> Exit Sub<br> Case vbNormal<br></span></font></b></font><span style="color: green; font-family: Courier New;"><font size="3"><b><font size="2"> 'if too small...</font></b></font></span><font size="2"><b><span style="color: navy; font-family: Courier New;"><br> If Me.Width < </span></b></font><b><font color="#000080" size="2" face="Courier New">MyFormWd</font></b><font size="2"><b><span style="color: navy; font-family: Courier New;"> _<br> Or Me.Height < </span></b></font><b><font color="#000080" size="2" face="Courier New">MyFormHt</font></b><font size="3"><b><font size="2"><span style="color: navy; font-family: Courier New;"> Then</span><span style="color: green; font-family: Courier New;"><br></span><span style="color: navy; font-family: Courier New;"> With Me.tmrResize </span><span style="color: green; font-family: Courier New;">'smooth w/timer<br></span><span style="color: navy; font-family: Courier New;"> .Enabled = False </span><span style="color: green; font-family: Courier New;">'turn timer off<br></span><span style="color: navy; font-family: Courier New;"> DoEvents </span><span style="color: green; font-family: Courier New;">'screen catch up<br></span><span style="color: navy; font-family: Courier New;"> .Enabled = True </span><span style="color: green; font-family: Courier New;">'restart timer<br></span><span style="color: navy; font-family: Courier New;"> End With<br> Exit Sub </span><span style="color: green; font-family: Courier New;">'let timer do work</span><span style="color: navy; font-family: Courier New;"><br> End If<br> End Select<br></span><span style="color: green; font-family: Courier New;"> '<br> 'other control arrangement code goes here.<br> '<br></span><span style="color: navy; font-family: Courier New;">End Sub<br> <br></span></font></b><span style="font-family: Arial;">Notice that we disabled the timer (if it was enabled), let the screen catch up with the<br> <b>DoEvents</b>, </span></font><span style="font-family: Arial;">and then enabled (and consequentially reset) the timer. We also ignore<br>any additional form resizing processing if the form gets too small with the early <b>Exit<br>Sub</b> instruction, at least <b><i>while </i></b> the form is too small.<br> <br>Next, add the following event for <b>tmrResize</b>:<br> <br></span><font color="#186125" size="2"><b><span style="color: green; font-family: Courier New;">'********************<br></span></b></font><font size="2"><b><span style="color: green; font-family: Courier New;">' tmrResize_Timer<br>' Check Win for too small<br></span></b></font><font color="#186125" size="2"><b><span style="color: green; font-family: Courier New;">'********************<br></span></b></font><b><font size="2"><span style="color: navy; font-family: Courier New;">Private Sub tmrResize_Timer()<br></span><span style="color: green; font-family: Courier New;"> '<br> 'turn off timer<br> '<br></span><span style="color: navy; font-family: Courier New;"> Me.tmrResize.Enabled = False<br></span><span style="color: green; font-family: Courier New;"> '<br> 'do nothing if minimized<br> '<br></span><span style="color: navy; font-family: Courier New;"> If Me.WindowState = vbMinimized Then<br> Exit Sub<br> End If<br> </span><span style="color: green; font-family: Courier New;">'<br> 'resize to minimum dims<br> '<br></span><span style="color: navy; font-family: Courier New;"> If Me.Width < MyFormWd Then<br> Me.Width = MyFormWd<br> End If<br> If Me.Height < MyFormHt Then<br> Me.Height = MyFormHt<br> End If<br>End Sub<br> <br></span></font></b><span style="font-family: Arial;">And that is all there is to the simple solution. You now have a smooth resizing form.<br>As long as the cursor is moving during the resize, the quarter-second (250 ms) timer<br>will not trigger its event, due to us resetting the timer every time the resize even<br>detects that the form is less than minimum.<br> <br> </span><font face="Arial"><i><font size="4"><b>Adding A Little Pizzaz</b></font></i><font size="3"><br>If you want to add a little pizzaz to this, such as not forcing a proper control refit until<br>the mouse button is actually released, you can just make a minor modification to the<br>above code. All we need to do is to add a single API call that will make the transition<br>even smoother. The API <b>GetKeyState()</b> can be used to quickly check if the mouse<br>pick button is pressed (The so-called Mouse Pick Button is normally called the Left<br>Mouse Button, but this can be deceiving, because on a mouse oriented for left-<br>handedness, the Right Mouse Button is treated internally, at the point our API is<br>looking, as the Left Mouse Button, so our API code will work for both cases without<br>change).<br> <br>You can incorporate the API in 2 ways. Both methods require that you place the<br>following code at the top of your form (or you can declare them Public and place<br>them in a module, if you like):<br> <br></font></font><font size="2"><strong><span style="color: navy; font-family: Courier New;">Private Declare Function GetKeyState _<br> Lib "user32" _<br> (ByVal nVirtKey As Long) As Integer<br></span></strong></font><font size="3"><font size="2"><b><span style="color: navy; font-family: Courier New;"><strong><span style="font-family: Courier New;">Private Const VK_LBUTTON = &H1<br> <br></span></strong></span></b></font><span style="font-family: Arial;">To use it, simply insert the following line as the first code line in the<br><b>tmrResize_Timer()</b> subroutine:<br> <br></span></font><font size="2"><b><span style="color: navy; font-family: Courier New;">If GetKeyState(VK_LBUTTON) < 0 Then Exit Sub<br> <br></span></b></font><font size="3"><span style="font-family: Arial;">With just that tiny refinement, the resize handling just got a whole lot cleaner. Now<br>even if you pause while resizing and the form too small, the form will not<br>automatically spring out after a quarter of a second as long as the mouse pick button<br>is held down.<br> <br> </span></font><span style="font-family: Arial;"><i><font size="4"><b>Adding More Pizzaz</b></font></i></span><font size="3"><span style="font-family: Arial;"><br>The second enhancement can really jazz this up by making it a whole lot smoother<br>than what we just made it with the above refinement. This enhancement needs to<br>have a Boolean flag declared at the top of the form, named something like <b>bResize</b>.<br>It also involves a little fancier footwork, but nothing beyond the Fox Trot. Following<br>are the new <b>Timer</b> and <b>Resize</b> event subroutines (the enhanced entries are marked<br>in <font color="#ff0000">RED</font>):<br> <br></span></font><font size="2"><strong><span style="color: red; font-family: Courier New;">Private Declare Function GetKeyState _<br> Lib "user32" _<br> (ByVal nVirtKey As Long) As Integer<br> </span></strong></font><font size="3"><font size="2"><b><span style="color: red; font-family: Courier New;"><strong><span style="font-family: Courier New;">Private Const VK_LBUTTON = &H1<br></span></strong></span></b></font><strong><font size="2"><span style="color: green; font-family: Courier New;">'flag True when resizing being processed<br></span><span style="color: red; font-family: Courier New;">Private bResize As Boolean<br><br></span></font></strong><font color="#186125" size="2"><b><span style="color: green; font-family: Courier New;">'********************<br></span></b></font><font size="2"><b><span style="color: green; font-family: Courier New;">' Form_Resize<br>' Resize the form<br></span></b></font><font color="#186125" size="2"><b><span style="color: green; font-family: Courier New;">'********************<br></span></b></font><b><font size="2"><span style="color: navy; font-family: Courier New;">Private Sub Form_Resize()<br></span><span style="color: green; font-family: Courier New;"> 'if handling resizing...<br> </span><span style="color: red; font-family: Courier New;">If bResize Then Exit Sub<br> </span><span style="color: navy; font-family: Courier New;">Select Case Me.WindowState<br> Case vbMinimized<br> Exit Sub<br> Case vbNormal<br> </span><span style="color: green; font-family: Courier New;">'if left mouse button down...<br> </span><span style="color: red; font-family: Courier New;">If GetKeyState(VK_LBUTTON) < 0 Then<br> </span><span style="color: green; font-family: Courier New;">'let timer handle fix<br> </span><span style="color: red; font-family: Courier New;">With Me.tmrResize<br> .Enabled = False </span><span style="color: green; font-family: Courier New;">'disable timer<br> </span><span style="color: red; font-family: Courier New;">DoEvents </span><span style="color: green; font-family: Courier New;">'let screen catch up<br> </span><span style="color: red; font-family: Courier New;">.Enabled = True </span><span style="color: green; font-family: Courier New;">'re-enable timer</span><span style="color: red; font-family: Courier New;"><br> End With<br> Exit Sub<br> End If<br> </span></font></b><font size="2"><b><span style="color: green; font-family: Courier New;">'if too small...</span></b></font><b><font size="2"><span style="color: red; font-family: Courier New;"><br> </span><span style="color: navy; font-family: Courier New;">If Me.Width < MyFormWd _<br> Or Me.Height < MyFormHt Then</span><span style="color: green; font-family: Courier New;"><br> </span><span style="color: navy; font-family: Courier New;">With Me.tmrResize </span><span style="color: green; font-family: Courier New;">'smooth w/timer<br> </span><span style="color: navy; font-family: Courier New;">.Enabled = False </span><span style="color: green; font-family: Courier New;">'turn timer off<br> </span><span style="color: navy; font-family: Courier New;">DoEvents </span><span style="color: green; font-family: Courier New;">'screen catch up<br> </span><span style="color: navy; font-family: Courier New;">.Enabled = True </span><span style="color: green; font-family: Courier New;">'restart timer<br> </span><span style="color: navy; font-family: Courier New;">End With<br> Exit Sub </span><span style="color: green; font-family: Courier New;">'let timer do work<br> </span><span style="color: navy; font-family: Courier New;">End If<br> End Select<br> </span><span style="color: green; font-family: Courier New;">'<br> 'other control arrangement code goes here.<br> '<br></span><span style="color: navy; font-family: Courier New;">End Sub<br><br></span></font></b><font color="#186125" size="2"><b><span style="color: green; font-family: Courier New;">'********************<br></span></b></font><font size="2"><b><span style="color: green; font-family: Courier New;">' tmrResize_Timer<br>' Check Win for too small<br></span></b></font><font color="#186125" size="2"><b><span style="color: green; font-family: Courier New;">'********************<br></span></b></font><b><font size="2"><span style="color: navy; font-family: Courier New;">Private Sub tmrResize_Timer()<br></span><span style="color: green; font-family: Courier New;"> '<br> ' Exit if Mouse pick button still down <br> '<br> </span><span style="color: red; font-family: Courier New;">If GetKeyState(VK_LBUTTON) < 0 Then Exit Sub<br> </span><span style="color: green; font-family: Courier New;">'<br> 'turn off timer<br> '<br> </span><span style="color: navy; font-family: Courier New;">Me.tmrResize.Enabled = False<br> </span><span style="color: green; font-family: Courier New;">'<br> 'do nothing if minimized<br> '<br> </span><span style="color: navy; font-family: Courier New;">If Me.WindowState = vbMinimized Then Exit Sub<br> </span><span style="color: green; font-family: Courier New;">'<br> 'resize to minimum dims<br> '<br> </span><span style="color: red; font-family: Courier New;">bResize = True</span><span style="color: green; font-family: Courier New;">'block resize envent<br> </span><span style="color: navy; font-family: Courier New;">If Me.Width < MyFormWd Then<br> Me.Width = MyFormWd<br> End If</span></font></b><font size="2"><span style="color: navy; font-family: Courier New;"><b><br> If Me.Height < MyFormHt Then<br> Me.Height = MyFormHt<br> End If<br> </b></span></font><b><font size="2"><span style="color: red; font-family: Courier New;">bResize = False </span><span style="color: green; font-family: Courier New;">'unblock resize event</span><span style="color: red; font-family: Courier New;"><br> Call Form_Resize </span><span style="color: green; font-family: Courier New;">'now process all resizing</span><span style="color: blue; font-family: Courier New;"><br></span><span style="color: navy; font-family: Courier New;">End Sub<br> <br></span></font></b><span style="font-family: Arial;">Anything beyond these enhancement is normally beyond Beginner or Intermediate<br>code, involving pixel math, additional API invocations, user-defined types, copying<br>memory, and other topics. I suppose it is not as complicated as one might suppose,<br>except that there you will need to modify the code, and save it before testing,<br>because used improperly, it can blow up on you. But having said that...<br> <br> </span></font><span style="font-family: Arial;"><i><font size="4"><b>Adding Alotta Pizzaz: Getting Advanced<br></b></font></i></span><font size="3"><span style="font-family: Arial;">One PSC member, <b>ULLI</b>, suggested sub-classing the form and monitoring the<br>Message Queue for <b>WM_GETMINMAXINFO</b>. If it is found, copy the <b>lParm</b> data<br>(<b>lParm</b> is pointing to a <b>MINMAXINFO</b> structure) to a local duplicate structure (user-<br>defined type), modify the <b>ptMinTrackSize</b> parameters to the desired minimum size,<br>copy the memory back, and tag the message as handled by setting the function's<br>return value to zero. This is all well and good, and I have found this idea posted at<br>other VB sites. I was simply hesitant to post such code here, because beginners do<br>not need things to get any more complicated than they already are, until they have<br>time to absorb more information. Indeed, it is actually more complicated than even<br>what ULLI described, because if you do not set all the other sizing parameters, when<br>you maximize the form, it could disappear right off the screen and rest in limbo.<br> <br>However, for completeness, I will indulge those who actually do want me to get more<br>complicated.<br> <br>I have written this to support multiple forms, because many projects will support<br>various forms to prop up different aspects of their design.<br> <br>The first thing we need to do is define our sub-classing module (a sub-class is<br>simply code that intercepts the operating system's message queue and pre-parses<br>it). Suppose we call it <b>modSubClass.bas</b>, just to be original. This module assumes<br>that I have one form defined, named<b> MyForm</b>. I will ALSO move my two sizing<br>constants from the top of my form from the previous examples to the top of this<br>module. The reason I do this is because I cannot access them from outside the form,<br>and you cannot declare them <b>Public</b> within a Form (they will turn RED for <b><i>real</i></b>;<br>meaning you have a declaration error). Notice that I do declare them public here, in<br>case you will still be using them within your form, otherwise you can declare these<br>two constants as <b>Private</b>.<br> <br>The code that must be duplicated and modified for your form or additional forms will<br>be marked in <font color="#ff0000">RED</font> (do not panic when you see the big block of red code toward the<br>bottom, because you will afterward be shown that you will only need to make 4<br>minuscule changes to it).<br> <br></span></font><font size="2"><b><span style="color: navy; font-family: "Courier New";">Option Explicit<br></span><span style="color: green; font-family: "Courier New";">'*****************<br>' Local Storage and Constants<br>'*****************<br></span><span style="color: red; font-family: "Courier New";">Public m_MyFormhWnd As Long 'subclass hook<br>Public</span></b></font><b><font color="#ff0000" size="2" face="Courier New"> Const MyFormWd As Long = 5000<br>Public</font></b><font color="#ff0000" size="2" face="Courier New"><b> Const MyFormHt As Long = 6000<br></b></font><font size="2"><b><span style="color: red; font-family: "Courier New";"><br></span><span style="color: green; font-family: "Courier New";">'*****************<br>' API Stuff<br>'*****************<br></span><span style="color: navy; font-family: "Courier New";">Public Const GWL_WNDPROC As Long = (-4)<br>Public Const WM_GETMINMAXINFO As Long = &H24<br></span><span style="color: green; font-family: "Courier New";">'<br>' Screen Points in Pixels<br>'<br></span><span style="color: navy; font-family: "Courier New";">Public Type POINTAPI<br>x As Long<br>y As Long<br>End Type<br></span><span style="color: green; font-family: "Courier New";">'<br>' structure for window sizing<br>'<br></span><span style="color: navy; font-family: "Courier New";">Type MINMAXINFO<br> ptReserved As POINTAPI<br> ptMaxSize As POINTAPI<br> ptMaxPosition As POINTAPI<br> ptMinTrackSize As POINTAPI<br> ptMaxTrackSize As POINTAPI<br>End Type<br></span><span style="color: green; font-family: "Courier New";">'<br>' used to assign new WndProc<br>'<br></span><span style="color: navy; font-family: "Courier New";">Public Declare Function SetWindowLong _<br> Lib "user32" Alias "SetWindowLongA" _<br> (ByVal hwnd As Long, _<br> ByVal nIndex As Long, _<br> ByVal dwNewLong As Long) As Long<br></span><span style="color: green; font-family: "Courier New";">'<br>' used to invoke old WndProc<br>'<br></span><span style="color: navy; font-family: "Courier New";">Public Declare Function CallWindowProc _<br> Lib "user32" Alias "CallWindowProcA" _<br> (ByVal lpPrevWndFunc As Long, _<br> ByVal hwnd As Long, _<br> ByVal uMsg As Long, _<br> ByVal wParam As Long, _<br> ByVal lParam As Long) As Long<br></span><span style="color: green; font-family: "Courier New";">'<br>' used to copy MINMAXINFO structure<br>'<br></span><span style="color: navy; font-family: "Courier New";">Public Declare Sub CopyMemory _<br> Lib "kernel32" Alias "RtlMoveMemory" _<br></span><span style="color: navy; font-family: Courier New"> </span><span style="color: navy; font-family: "Courier New";">(hpvDest As Any, _<br></span><span style="color: navy; font-family: Courier New"> </span><span style="color: navy; font-family: "Courier New";">hpvSource As Any, _<br></span><span style="color: navy; font-family: Courier New"> </span><span style="color: navy; font-family: "Courier New";">ByVal cbCopy As Long)<br><br></span><span style="color: green; font-family: "Courier New";">'*****************<br>' HookWin(): Subclass hwnd to VCWndProc<br>'*****************<br></span><span style="color: navy; font-family: "Courier New";">Public Sub HookWin(ByVal hwnd As Long, _<br> PrvhWnd As Long)<br> PrvhWnd = SetWindowLong( _<br> hwnd, _<br> GWL_WNDPROC, _<br> AddressOf MyWndProc)<br>End Sub<br><br></span><span style="color: green; font-family: "Courier New";">'*****************<br>' UnhookWin(): remove subclass hook<br>'*****************<br></span><span style="color: navy; font-family: "Courier New";">Public Sub UnhookWin(ByVal hwnd As Long, _<br> PrvhWnd As Long)<br> Call SetWindowLong( _<br> hwnd, _<br> GWL_WNDPROC, _<br> PrvhWnd)<br> PrvhWnd = 0<br>End Sub<br><br></span></b></font><font size="1"><span style="color: green; font-family: "Courier New";"><font size="2"><b>'*****************<br></b></font></span><font size="2"><b><span style="color: green; font-family: "Courier New";">' Subclassed WindProc Handler<br></span></b><span style="color: green; font-family: "Courier New";"><b>'*****************<br></b></span></font><b><font size="2"><span style="color: navy; font-family: "Courier New";">Private Function MyWndProc( _<br></span><span style="color: navy; font-family: Courier New"> </span><span style="color: navy; font-family: "Courier New";"> ByVal hwnd As Long, _<br></span><span style="color: navy; font-family: Courier New"> </span><span style="color: navy; font-family: "Courier New";"> ByVal uMsg As Long, _<br></span><span style="color: navy; font-family: Courier New"> </span><span style="color: navy; font-family: "Courier New";">ByVal wParam As Long, _<br></span><span style="color: navy; font-family: Courier New"> </span><span style="color: navy; font-family: "Courier New";">ByVal lParam As Long) As Long<br><br> </span></font></b></font><font size="2"><b><span style="color: navy; font-family: "Courier New";">Static Calcs As Boolean </span><span style="font-family: Courier New;"><font color="#008000">'1-time flag</font><font color="#008080"><br></font></span></b><span style="color: navy; font-family: "Courier New";"><b> Static SX As Long </b></span><b><font color="#008000"><span style="font-family: Courier New;">'screenx</span></font><span style="color: navy; font-family: "Courier New";"><br> Static SY As Long </span><font color="#008000"><span style="font-family: Courier New;">'screeny</span></font><span style="color: navy; font-family: "Courier New";"><br> Static STX As Long </span><font color="#008000"><span style="font-family: Courier New;">'TwipsPerPixelX</span></font><span style="color: navy; font-family: "Courier New";"><br> Static STY As Long </span><font color="#008000"><span style="font-family: Courier New;">'TwipsPerPixelY</span></font><span style="color: navy; font-family: "Courier New";"><br><br> </span></b></font><font size="1"><b><font size="2"><span style="color: navy; font-family: "Courier New";">Dim result As Long<br> Dim MnMxInfo As MINMAXINFO<br> </span></font></b></font><b><font size="2"><font color="#008000"><span style="font-family: Courier New;">'<br> ' do this conditional block only one time<br> '<br> </span></font><span style="color: navy; font-family: "Courier New";">If Not Calcs Then<br> STX = Screen.TwipsPerPixelX<br> STY = Screen.TwipsPerPixelY<br> SX = Screen.Width \ STX<br> SY = Screen.Height \ STY<br> Calcs = True<br> End If<br> </span></font></b><font size="1"><b><font size="2"><span style="color: green; font-family: "Courier New";">'<br> ' handle messages<br> '<br> </span><span style="color: navy; font-family: "Courier New";">Select Case hwnd </span><span style="color: green; font-family: "Courier New";">'check which form<br> </span><span style="color: red; font-family: "Courier New";">Case MyForm.hwnd</span><span style="color: green; font-family: "Courier New";">'is my form<br> </span><span style="color: red; font-family: "Courier New";">Select Case uMsg</span><span style="color: green; font-family: "Courier New";">'check message<br> </span><span style="color: red; font-family: "Courier New";">Case WM_GETMINMAXINFO </span><span style="color: green; font-family: "Courier New";">'sizing<br> </span><span style="color: red; font-family: "Courier New";">CopyMemory MnMxInfo, _<br> lParam, _<br> LenB(MnMxInfo)<br> </span></font></b></font><b><font size="2"><span style="color: rgb(255, 0, 0); font-family: Courier New;">With MnMxInfo<br> With .ptMinTrackSize</span><font color="#008000"><span style="font-family: Courier New;">'set min size</span></font><span style="color: rgb(255, 0, 0); font-family: Courier New;"><br> .X = MyFormWd \ STX<br> .Y = MyFormHt \ STY<br> End With<br> </span></font><span style="color: rgb(255, 0, 0); font-family: Courier New;"><font size="2"> With .ptMaxPosition<br> .X = 0<br> .Y = 0<br> End With<br> </font></span><font size="2"><span style="color: rgb(255, 0, 0); font-family: Courier New;">With .ptMaxTrackSize<br> .X = SX<br> .Y = SY<br> End With<br> With .ptMaxSize<br> .X = SX<br> .Y = SY<br> End With<br> End With<br> </span><span style="color: red; font-family: "Courier New";"> CopyMemory ByVal lParam, _<br> MnMxInfo, _<br> LenB(MnMxInfo)<br> MyWndProc = 0<br> Case Else</span><span style="color: green; font-family: "Courier New";"><br> </span><span style="color: red; font-family: "Courier New";">MyWndProc = CallWindowProc( _<br> m_VChWnd, _<br> hwnd, _<br> uMsg, _<br> wParam, _<br> lParam)<br> </span><font color="#ff0000"><span style="font-family: Courier New;"> End Select<br> </span></font><span style="color: navy; font-family: "Courier New";">End Select</span><font color="#008000"><span style="font-family: Courier New">'hwnd</span></font><span style="color: navy; font-family: "Courier New";"><br>End Function</span></font><span style="color: navy; font-family: "Courier New";"><br> <br></span></b><span style="font-family: Arial;">Note that in the above long "red" zone, that the form's maximum size is set to the<br>screen size, which is normally a little bigger than what we would want; rather to keep<br>it within the "displayable" limits, thus keeping our Taskbar in view (unless you have<br>the "<i>Keep the taskbar on top of other windows</i>" option unchecked in the taskbar's<br>options). Do not worry; the operating system will automatically adjust any too large<br>dimensions down to the actual maximum dimensions established for your monitor by<br>the OS for application window viewing.<br> <br>In the above code, you will have to add Long<a style="color: darkgreen; padding-bottom: 1px; font-size: 100%; font-weight: normal; text-decoration: underline; border-bottom-color: darkgreen; border-bottom-width: 0.07em; border-bottom-style: solid; background-color: transparent;" id="itxthook6" class="itxtrst itxtrsta itxthook" href="#" rel="nofollow"><span style="color: darkgreen; font-size: inherit; font-weight: inherit; font-color: inherit;" id="itxthook6w0" class="itxtrst itxtrstspan itxthookspan">storage</span></a> variables for each form you<br>want to police. Presently, I have just <b>m_MyFormhWnd</b> set aside for <b>MyForm</b>, plus<br>its two minimum sizing constants. The rest of the code is cut-and-paste, until we start<br>checking the Windows Message Queue. Note that I also check the message<br>queue's <b>hwnd</b> value for my form. This is in case we want to set up multiple forms.<br>Actually, you can pretty much cut-and-paste most of this red code as well. I marked it<br>all in red simply because <i>this block must be duplicated for each additional form</i>.<br>Below, I will duplicate the above block of red code, but this time I will mark in <font color="#ff0000">RED<br></font> only those portions of it that must be altered <i>for each form</i>:<br> <br></span><font size="1"><b><font size="2"><font color="#000080"><span style="font-family: "Courier New";"> Case </span></font><span style="color: red; font-family: "Courier New";">MyForm</span><font color="#000080"><span style="font-family: "Courier New";"> .hwnd</span></font><span style="color: red; font-family: "Courier New";"></span><span style="color: green; font-family: "Courier New";">'is my form<br> </span><span style="color: rgb(0, 0, 128); font-family: Courier New;"> Select Case uMsg </span><span style="color: green; font-family: "Courier New";">'check message<br> </span><span style="color: rgb(0, 0, 128); font-family: Courier New;"> Case WM_GETMINMAXINFO </span><span style="color: green; font-family: "Courier New";">'sizing<br> </span><font color="#000080"><span style="font-family: Courier New;">CopyMemory MnMxInfo, _<br> lParam, _<br> LenB(MnMxInfo) </span></font><span style="color: red; font-family: "Courier New";"><br> </span></font></b></font><b><font size="2"><span style="color: rgb(0, 0, 128); font-family: Courier New;">With MnMxInfo<br> With .ptMinTrackSize</span><span style="font-family: Courier New;"><font color="#008000">'set min size</font><font color="#000080"><br> .X = </font><font color="#ff0000">MyFormWd</font><font color="#000080"> \ STX<br> .Y = </font><font color="#ff0000">MyFormHt</font><font color="#000080"> \ STY<br> End With<br> </font></span><span style="color: rgb(0, 0, 128); font-family: Courier New;">With .ptMaxPosition<br> .X = 0<br> .Y = 0<br> End With<br> </span><font color="#000080"><span style="font-family: Courier New;"> With .ptMaxTrackSize<br> .X = SX<br> .Y = SY<br> End With<br> With .ptMaxSize<br> .X = SX<br> .Y = SY<br> End With<br> End With<br> </span></font></font></b><font size="1"><b><font color="#000080" size="2"><span style="font-family: Courier New;"> CopyMemory ByVal lParam, _<br> MnMxInfo, _<br> </span></font><font size="2"><font color="#000080"><span style="font-family: Courier New;">LenB(MnMxInfo)<br> MyWndProc = 0<br> Case Else</span></font><span style="color: green; font-family: "Courier New";"><br> </span><span style="color: rgb(0, 0, 128); font-family: Courier New;">MyWndProc = CallWindowProc( _<br> </span><font color="#ff0000"><span style="font-family: Courier New;">m_MyFormhWnd</span></font><span style="color: rgb(0, 0, 128); font-family: Courier New;">, _<br> hwnd, _<br> uMsg, _<br> wParam, _<br> lParam)<br> </span><font color="#000080"><span style="font-family: Courier New;">End Select<br></span></font></font></b></font><span style="font-family: Arial;"><br>As you can see, the changes to the duplicated block of code are minimal. <b>Note</b>:<i>If<br>you noticed, you can do more with the <b>MINMAXINFO</b> user-defined type than just<br>set minimum size. You could modify the </i></span><i><b><span style="font-family: Arial;">ptMaxTrackSize</span></b><span style="font-family: Arial;"> and the </span><b><span style="font-family: Arial;">ptMaxSize</span></b></i><span style="font-family: Arial;"><i><br>entries to prevent a form of being resized beyond a specified size, for example</i>.<br> <br>If you have multiple forms and you are concerned that the common <b>MyWndProc<br></b> function will be passed through before you have invoked the hook (shown below) for<br>all the forms you want to control sizing on, and so wonder if it will wreck havoc on the<br>ones not yet added, or even provide sizing control for a form before you want it<br>handled, do not worry. Because we hook it by also providing the hooking<br>mechanism with the forms "handle" (hwnd), only those forms that have logged their<br>handle with the operating system's hooking mechanism will ever have their<br>messages pass through the above function. Consequentially, once you unhook it, it<br>is also removed from the queue that passes through our customized function, and is<br>handled instead by the operating system's default function.<br> <br> <i><b><font size="4">Drum Roll, Please...<br></font></b></i>Now comes the part where I tell new programmers to add this type of code LAST,<br><i>after everything else is working</i>. The reason for this is that when you hook a form,<br>you cannot just dink around in the IDE mode and pause the program within the<br><b>MyWndProc</b> function or try single-stepping through the code of the hooked form.<br>The reason for this is because the form's message queue is now intercepted, and<br>so the program may lock up (you would be forcing pauses in processes that must be<br>handled unhindered). This is not actually a really bad thing, because the benefits of<br>this code are invaluable. On top of that, you can simply comment the first of the two<br>little lines I am about to share with you to once again allow you to step through the<br>form's code. <i>As a sidebar, Microsoft has a truly excellent (and free) debugger DLL<br>for VB6 called<b>DBGWPROC.DLL</b> that actually allows you to do what I just said you<br>cannot do -- single-step through code that is sub-classed. It is easy to use, though<br>maybe a bit confusing for the beginner. I hope someone has written a short article<br>on it. If not, I will try to get to it, because back when I did a whole lot of form sub-<br>classing, this was one of the best tools in my utility kit.</i><br> <br>Anyway, all that is left is to add 2 short lines of code. The first should be placed at<br>the bottom of the <b>Form_Load</b> event, and the other at the bottom of the<br> <b>Form_Unload</b> event.<br> <br>The line to be placed at the bottom of the <b>Form_Load</b> event is:<br> <br></span><b><font color="#000080" size="2" face="Courier New">Call HookWin(Me.hwnd,</font><font color="#ff0000" size="2" face="Courier New">m_MyFormhWnd</font><font color="#000080" size="2" face="Courier New">)<br> </font></b><span style="font-family: Arial;"><br>This command will hook the message queue for <b>MyForm.frm</b> to our custom<br>windows processor (<b>MyWndPorc</b>). Once this executes, I would ask you to refrain<br>from interrupting your program. It may be harsh, but the benefits are plentiful. If you<br>find that you will later need to debug your code, then simply place a comment tag on<br>this line before running it to prevent it from firing. It is that easy.<br> <br>The second "line" of code that should be placed at the bottom of the <b>Form_Unload<br></b> event is:<br> <br></span><b><font color="#000080" size="2" face="Courier New">If CBool(</font><font color="#ff0000" size="2" face="Courier New">m_MyFormhWnd</font><font color="#000080" size="2" face="Courier New">) Then<br> Call UnhookWin(Me.hwnd, </font><font color="#ff0000" size="2" face="Courier New">m_MyFormhWnd</font><font color="#000080" size="2" face="Courier New">)<br>End If <br> </font></b><span style="font-family: Arial;"><br>One last suggestion before testing this code: <u><i><b>SAVE YOUR PROGRAM CODE</b></i></u>.<br>Actually, just hit the Save option or hit Ctrl-S prior to running and testing it. That way,<br>if by some chance the program locks up, you can kill the VB process (<b>CTRL-SHIFT-<br>ESC</b> on <b><i>XP</i></b> to bring up the process viewer), and reload the program in VB again to<br>check your work.<br> <br>And that is all there is to it. Granted, this <i>WndProc</i> code is a little tougher than the<br>initial techniques offered at the start of this article, and the consequences of abuse<br>are more severe. But in truth, once you get some experience under your belt, all the<br>cautionary warnings and flailing of arms (like Kermit the Frog) I have done will seem<br>silly, because by then you will clearly understand these concepts, and addressing<br>them will be second nature.<br> <br><i><b><font size="4">Closing Comment</font></b></i><br>Technically, the last part of this article was beyond most, but maybe not all beginners<br>(when I was a VB beginner, I had come over from Visual Fortran and Visual C++, so<br>I would be right at home with this code), but people wanted to see this more powerful<br>enhancement in this article. I certainly hope that you have enjoyed it.<br> <br>--David<br></span></p>
原始评论 (3)
从 Wayback Machine 恢复