Visual Basic Window/Form Routines
DrawFocusRect: Simulating Non-Client Form Movement
     
Posted:   Thursday December 26, 1996
Updated:   Monday December 26, 2011
     
Applies to:   VB4-32, VB5, VB6, and VB3, VB4-16 with appropriate declarations
Developed with:   VB4-32, Windows 95
OS restrictions:   None
Author:   VBnet - Randy Birch
     

Related:  

DrawText: Adding Title Text to the Fake TitleBar
     
 Prerequisites
None.

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.

 BAS Module Code
None.

 Form Code
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
 Comments
Run the project, and click & drag on the PictureBox. A dragging rectangle representing the form will appear, and the form will reposition itself where the button is released. To provide for drag capability by clicking on any exposed area of the frame client (excluding the fixed dialog frame), simply add calls to BeginFRDrag, DoFRDrag and EndFRDrag to the form's mouse events as well.

 
 

PayPal Link
Make payments with PayPal - it's fast, free and secure!

 
 
 
 

Copyright 1996-2011 VBnet and Randy Birch. All Rights Reserved.
Terms of Use  |  Your Privacy

 

Hit Counter