 Prior to the release of VB4 with its ToolWindow
BorderStyle, a tool window-style form needed to be created by adding a
picture box to a form, setting the form to borderless, no caption, no
control box, and adding code to move the
form by clicking on the fake title bar created by the picture box. In
the early days many different methods were circulated, primarily
involving VB's form Move command and the form's MouseMove event. While
this could move the form - often jerking - it did not (in pre-drag
contents Windows) show the form as it was moving.
The routine detailed
here was first developed in VB3 under Win3.1. Although its particular use
is a bit outdated, given that later windows non-client messages and one
SendMessage call provides click-anywhere-and-drag functionality, it
nonetheless shows the code required to reposition a form by
clicking/dragging using a fake titlebar and in the process create a
bounding rectangle (focus rect) to provide visual feedback of the move
similar to that when moving a normal window. This is independent of
Windows' option that provides for showing window contents while dragging.
The code utilized in Picture1's Mouse events can be easily and directly ported to the form's mouse events, thereby providing the means
to drag a form around by clicking any portion of a form's exposed background
rather than a specific control simulating a titlebar. |
| Begin a new project, and create
a form
containing a picture box (Picture1) -- it is unnecessary to set the
back colour of the picture box as the
form load code determines the user's Active Window colour preference and sets the picture box to that colour.
Add
twelve command buttons in a control array (Command1(0) - Command1(11)) to
act as the toolbar buttons.
Add another Command button (Command2) that will be hidden off-screen
providing a place to put focus and in doing so removing the focus rect
from the command buttons when clicked.
Set the form's window style to 3 - Fixed Dialog, the caption to empty, and the Control, Minimize and Maximize buttons to False. Set the forms
ScaleMode to 1 - Twip. AutoRedraw and ClipControls can both be False. Set the ShowInTaskBar property to false (VB4/VB5/VB6 only). Add the
following to the form: |
Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
' applications, but you may not reproduce
' or publish this code on any web site,
' online service, or distribute as source
' on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Const COLOR_ACTIVECAPTION = 2
Private Const SM_CXDLGFRAME = 7
Private Const SM_CYDLGFRAME = 8
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type POINTAPI
x As Long
y As Long
End Type
Private pt1 As POINTAPI
Private pt2 As POINTAPI
Private rc1 As RECT
Private rc2 As RECT
Private rcsave As RECT
Private twipsx As Long
Private twipsy As Long
Private Declare Function GetWindowRect Lib "user32" _
(ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function GetSysColor Lib "user32" _
(ByVal nIndex As Long) As Long
Private Declare Function GetSystemMetrics Lib "user32" _
(ByVal nIndex As Long) As Long
Private Declare Function DrawFocusRect Lib "user32" _
(ByVal hdc As Long, lpRect As RECT) As Long
Private Declare Function ClientToScreen Lib "user32" _
(ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function GetDC Lib "user32" _
(ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" _
(ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Sub Form_Load()
Dim frameHeight As Long
Dim frameWidth As Long
Dim cnt As Long
twipsx = Screen.TwipsPerPixelX
twipsy = Screen.TwipsPerPixelY
With Picture1
.Align = 1
.Height = 255
.BackColor = GetSysColor(COLOR_ACTIVECAPTION)
.BorderStyle = 0
End With
'instead of images this positions
'the controls and prints their index
'number for reference. All control
'sizes are based on the size of Command1(0),
'so set it appropriately. The form size is
'calculated for you and will fit if the
'control box and caption are removed,
'and the form's border style is not 2-sizeable.
For cnt = 0 To 11 Step 2
Command1(cnt).Move 0, _
Picture1.Height + (Command1(0).Height * (cnt \ 2)), _
Command1(0).Width, _
Command1(0).Height
Command1(cnt).Caption = cnt
Next
For cnt = 1 To 12 Step 2
Command1(cnt).Move Command1(0).Width, _
Picture1.Height + (Command1(0).Height * (cnt \ 2)), _
Command1(0).Width, _
Command1(0).Height
Command1(cnt).Caption = cnt
Next
'move command2 off-screen
Command2.Left = -10000
'compute the width of the left and right dialog frame
frameHeight = (GetSystemMetrics(SM_CYDLGFRAME) * 2)
'compute the width of the top and bottom dialog frame
frameWidth = (GetSystemMetrics(SM_CXDLGFRAME) * 2)
'set the "tool window" size
'for a 2x6 button matrix
Me.Height = (Command1(0).Height * 6) + Picture1.Height + (frameHeight * 2)
Me.Width = (Command1(0).Width * 2) + (frameWidth * 2)
End Sub
Private Sub Form_Activate()
'set to focus to the dummy
'button off-screen to remove
'the focus rect from the
'clicked button
Command2.SetFocus
End Sub
Private Sub Picture1_MouseDown(Button As Integer, _
Shift As Integer, _
x As Single, y As Single)
BeginFRDrag x, y
End Sub
Private Sub Picture1_MouseMove(Button As Integer, _
Shift As Integer, _
x As Single, y As Single)
If Button = 1 Then DoFRDrag x, y
End Sub
Private Sub Picture1_MouseUp(Button As Integer, _
Shift As Integer, _
x As Single, y As Single)
EndFRDrag x, y
End Sub
Private Sub Command1_Click(Index As Integer)
'set to focus to the dummy
'button off-screen to remove
'the focus rect from the
'clicked button
Command2.SetFocus
'perform the action for the
'button index clicked
Select Case Index
Case 0
Case 1 '... and so on
Case Else
End Select
End Sub
Private Sub BeginFRDrag(x As Single, y As Single)
Dim hdc As Long
'storage for later
pt1.x = x
pt1.y = y
'get screen RECT of form
Call GetWindowRect(Me.hwnd, rc1)
'get point of MouseDown in screen coordinates
'using a temp point, as the API will change it
pt2 = pt1
Call ClientToScreen(Me.hwnd, pt2)
'get the desktop hDc
hdc = GetDC(ByVal 0)
Call DrawFocusRect(hdc, rc2)
Call ReleaseDC(0, hdc)
'save rect to erase it later
rcsave = rc2
End Sub
Private Sub DoFRDrag(x As Single, y As Single)
Dim hdc As Long
Dim pt As POINTAPI
pt.x = x
pt.y = y
ClientToScreen Me.hwnd, pt
rc2.Left = (rc1.Left + pt.x / twipsx) - (pt2.x / twipsx)
rc2.Top = (rc1.Top + pt.y / twipsy) - (pt2.y / twipsy)
rc2.Right = (rc1.Right + pt.x / twipsx) - (pt2.x / twipsx)
rc2.Bottom = (rc1.Bottom + pt.y / twipsy) - (pt2.y / twipsy)
hdc = GetDC(ByVal 0)
Call DrawFocusRect(hdc, rcsave) 'erase saved rect
Call DrawFocusRect(hdc, rc2) 'draw new rect
Call ReleaseDC(0, hdc)
rcsave = rc2 'save new rect
End Sub
Private Sub EndFRDrag(x As Single, y As Single)
Dim hdc As Long
Dim newleft As Single
Dim newtop As Single
hdc = GetDC(ByVal 0)
Call DrawFocusRect(hdc, rcsave) 'erase saved rect
Call ReleaseDC(0, hdc)
'move the form to the new coordinates
newleft = x - pt1.x + (rc1.Left * twipsx)
newtop = y - pt1.y + (rc1.Top * twipsy)
Me.Move newleft, newtop
End Sub |
