1 Attachment(s)
VB - Flexible Shangle (window resizing grip)
The resizing grip in the corner of a window is called a shangle (supposedly a combination of shingle and triangle).
This code is a sample of how to create your own.
I have used a couple of labels to draw the graphic for the shangle, but I guess you could another control and have a shangle of any size/color/design you wanted, perhaps the nifty XP one with dots instead of diagonal lines. Code could also be modified to put the shangel somewhere other than in the corner. A pull-down handle perhaps, or at the bottom left, for RightToLeft forms.
Code is a bit of a cludge (hate that timer for instance) and I'm sure somebody with more time than me can easily improve it.
Mail me if you post a better one and I'll delete this post.
Here's module1.bas
VB Code:
Option Explicit
Declare Function ReleaseCapture Lib "user32" () As Long
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Const WM_NCLBUTTONDOWN = &HA1
Public Const HTBOTTOMRIGHT = 17
Sub DriveShangle(f As Form)
'PURPOSE: Negate VB's call to SetCapture, and tell Windows
' that the user is trying to resize the form.
ReleaseCapture
SendMessage f.hwnd, WM_NCLBUTTONDOWN, HTBOTTOMRIGHT, ByVal 0&
End Sub
Sub FixShangle(f As Form)
'PURPOSE: Position size grip labels at lower-right.
With f.labShangle(0)
.Move .Container.ScaleWidth - .Width, .Container.ScaleHeight - .Height
End With
With f.labShangle(1)
.Move .Container.ScaleWidth - .Width, .Container.ScaleHeight - .Height
End With
If f.WindowState = vbNormal Then
f.labShangle(0).Visible = True
f.labShangle(1).Visible = True
f.timShangle.Enabled = Not f.timShangle.Enabled
Else
f.labShangle(0).Visible = False
f.labShangle(1).Visible = False
f.timShangle.Enabled = False
End If
End Sub
here's form 1. Needs a couple of labels in an array and a timer, as you can see.
VB Code:
Option Explicit
Private Sub Form_Resize()
FixShangle Me 'Position the Shangle
End Sub
Private Sub labShangle_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
DriveShangle Me 'Do window resizing with the Shangle
End Sub
Private Sub timShangle_Timer()
FixShangle Me 'Redraw the Shange after a normalise event
End Sub