VB - Flexible Shangle (window resizing grip)

[BrianHawley]

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

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.

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