Re: Not showing form's outline when resizing
- From: "Jack" <replyto@it>
- Date: Sat, 5 Apr 2008 20:20:17 -0400
Mike, it is so easy to see.
Just please try to resize window which has some limit introduced.
For example:
Form_Resize
If Me.Width > 2000 Then Me.Width = 2000
End Sub
When resizing horizontally you will see the window's outline following mouse
pointer and moving back to Me.Width = 2000 position.
That flickering is terrible!
What I need is just to stop that flickering.
Jack
"Mike Williams" <mike@xxxxxxxxxxxxxxxxx> wrote in message
news:%23FeGI4xdIHA.5280@xxxxxxxxxxxxxxxxxxxxxxx
"Jack" <replyto@it> wrote in message
news:OODXgmwdIHA.148@xxxxxxxxxxxxxxxxxxxxxxx
Am I barking at wrong tree?
Nope. You're on the right track with subclassing. But to be honest I don't
really understand your question. Firstly, your subject line indicates that
you do not want to show the Form's outline when resizing? What do you mean
by "outline"? Do you mean you don't want to show its border (in other
words, do you want a Borderless Form but still allow the user to resize
it)? If so then it can easily be achieved, but I'm not sure that is
actually what you want?
Also, I'm not quite sure what you mean by "the Form is allowed to resize
only diagonally"? Do you not want the Form to resize at all when the user
is dragging the top or bottom handles? If not, why not? And are you aware
that even when the user is dragging the corner handle he can (unless your
code prevents it) still perform exactly the same "vertical only" or
"horizontal only" resizing action? Do you mean that you want to allow the
user to resize the Form but that you want the Form to always maintain a
specific aspect ratio (width to height ratio) while he is doing so? If
that is what you want then the following code will do it for you.
In this specific example the user is still allowed to use whatever
resizing handle he wishes (although that can be prevented if you wish to
do so) but whatever he does when dragging the handle the Form will always
maintain its original aspect ratio. Also, the resize is limited so that
the Form can never be less than half and never more than twice its
original width (or height), although that specific function can be
removed if you wish. One other point is that this specific example forces
the Form to maintain its original overall aspect ratio (such that the
ratio between its Width and its Height always remains the same). This of
course results in the aspect ratio of its client area being allowed to be
different (because of the constant nature of the width of the borders and
the height of the caption bar). It would however be possible to change it
so that the Form instead retains its original "client area aspect ratio",
so that the aspect ratio of the client area of the Form remains constant,
if that is what you wish. By the way, this is some code which I found on
the web somewhere and which I have modified, but I can't remember now
where I got it from so I cannot properly credit the original author (in
other words, it is not my own code, I nicked it!).
Is this the sort of thing you're after?
Mike
' ***** START OF FORM CODE *****
Option Explicit
Private Sub Form_Load()
startWidth = 400 ' pixels
startHeight = 300 ' pixels
Me.Width = startWidth * Screen.TwipsPerPixelX
Me.Height = startHeight * Screen.TwipsPerPixelY
Hook Me.hwnd
End Sub
Private Sub Form_Resize()
' report the result
Dim wide As Long, high As Long, ratio As Single
wide = Me.ScaleX(Me.Width, vbTwips, vbPixels)
high = Me.ScaleY(Me.Height, vbTwips, vbPixels)
Me.Caption = Format(wide) & " x " & Format(high) & _
" (" & Format(wide / high, "0.0") & ")"
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call Unhook(Me.hwnd)
End Sub
' ***** END OF FORM CODE *****
'
' ***** START OF MODULE CODE *****
Option Explicit
Public DefWindowProc As Long
Private Const GWL_WNDPROC As Long = (-4)
Private Const WM_DESTROY = &H2
Private Const WM_SIZING = &H214
Private Const WMSZ_LEFT = 1
Private Const WMSZ_RIGHT = 2
Private Const WMSZ_TOP = 3
Private Const WMSZ_TOPLEFT = 4
Private Const WMSZ_TOPRIGHT = 5
Private Const WMSZ_BOTTOM = 6
Private Const WMSZ_BOTTOMLEFT = 7
Private Const WMSZ_BOTTOMRIGHT = 8
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
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 CallWindowProc Lib "user32" _
Alias "CallWindowProcA" _
(ByVal lpPrevWndFunc As Long, _
ByVal hwnd As Long, _
ByVal uMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Private Declare Sub CopyMemory Lib "KERNEL32" _
Alias "RtlMoveMemory" _
(hpvDest As Any, _
hpvSource As Any, _
ByVal cbCopy As Long)
Private Const WM_GETMINMAXINFO = &H24
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type MINMAXINFO
ptReserved As POINTAPI
ptMaxSize As POINTAPI
ptMaxPosition As POINTAPI
ptMinTrackSize As POINTAPI
ptMaxTrackSize As POINTAPI
End Type
Private Declare Sub CopyMemoryToMinMaxInfo _
Lib "KERNEL32" Alias "RtlMoveMemory" _
(hpvDest As MINMAXINFO, ByVal hpvSource As Long, _
ByVal cbCopy As Long)
Private Declare Sub CopyMemoryFromMinMaxInfo _
Lib "KERNEL32" Alias "RtlMoveMemory" _
(ByVal hpvDest As Long, hpvSource As MINMAXINFO, _
ByVal cbCopy As Long)
Public startWidth As Single, startHeight As Single
Public Sub Unhook(hwnd As Long)
If DefWindowProc Then
Call SetWindowLong(hwnd, GWL_WNDPROC, DefWindowProc)
DefWindowProc = 0
End If
End Sub
Public Sub Hook(hwnd As Long)
DefWindowProc = SetWindowLong(hwnd, GWL_WNDPROC, _
AddressOf WindowProc)
End Sub
Function WindowProc(ByVal hwnd As Long, _
ByVal uMsg As Long, ByVal wParam As Long, _
ByVal lParam As Long) As Long
Dim rc As RECT
Dim MinMax As MINMAXINFO
Select Case uMsg
Case WM_SIZING
'copy the RECT pointed to in
'lParam into a RECT structure
CopyMemory rc, ByVal lParam, LenB(rc)
'wParam tells which one of the eight
'possible resizing handles is being used.
'Set the appropriate RECT member to the
'size required to maintain aspect ratio,
'and copy back into the RECT struct for
'processing by Windows.
Select Case wParam
Case WMSZ_LEFT
rc.Bottom = (rc.Right - rc.Left) _
* startHeight / startWidth + rc.Top
WindowProc = 1
Case WMSZ_RIGHT
rc.Bottom = (rc.Right - rc.Left) _
* startHeight / startWidth + rc.Top
WindowProc = 1
Case WMSZ_TOP
rc.Right = (rc.Bottom - rc.Top) _
* startWidth / startHeight + rc.Left
WindowProc = 1
Case WMSZ_BOTTOM
rc.Right = (rc.Bottom - rc.Top) _
* startWidth / startHeight + rc.Left
WindowProc = 1
Case WMSZ_TOPLEFT
rc.Left = (rc.Top - rc.Bottom) _
* startWidth / startHeight + (rc.Right)
WindowProc = 1
Case WMSZ_TOPRIGHT
rc.Right = (rc.Bottom - rc.Top) _
* startWidth / startHeight + rc.Left
WindowProc = 1
Case WMSZ_BOTTOMLEFT
rc.Bottom = (rc.Right - rc.Left) _
* startHeight / startWidth + (rc.Top)
WindowProc = 1
Case WMSZ_BOTTOMRIGHT
rc.Bottom = (rc.Right - rc.Left) _
* startHeight / startWidth + rc.Top
WindowProc = 1
End Select
CopyMemory ByVal lParam, rc, LenB(rc)
Case WM_DESTROY:
'kill subclassing if active
If DefWindowProc <> 0 Then
Call Unhook(Form1.hwnd)
End If
Case WM_GETMINMAXINFO
'Retrieve default MinMax settings
CopyMemoryToMinMaxInfo MinMax, lParam, Len(MinMax)
'Specify new minimum size for window.
MinMax.ptMinTrackSize.x = startWidth / 2
MinMax.ptMinTrackSize.y = startHeight / 2
'Specify new maximum size for window.
MinMax.ptMaxTrackSize.x = startWidth * 2
MinMax.ptMaxTrackSize.y = startHeight * 2
'Copy local structure back.
CopyMemoryFromMinMaxInfo lParam, MinMax, Len(MinMax)
Case Else
'process other windows messages
WindowProc = CallWindowProc(DefWindowProc, hwnd, _
uMsg, wParam, lParam)
End Select
End Function
' ***** END OF MODULE CODE *****
.
- Follow-Ups:
- Re: Not showing form's outline when resizing
- From: Mike Williams
- Re: Not showing form's outline when resizing
- Prev by Date: Re: OT troll bait: Annual Trolley Car Awards
- Next by Date: Re: Cannot solve complex problem
- Previous by thread: Re: Not showing form's outline when resizing
- Next by thread: Re: Not showing form's outline when resizing
- Index(es):
Relevant Pages
|
