API Drawing (Rectangles) Within Container 1

[SiJP]

I've created a couple of basic functions that will draw rectangles around an object to give the appearance of gradient borders. It works quite well, but there is a bug.

Whilst a textbox on the form will highlight correctly, a textbox within a frame will not.

Any help would be great!

(full form code to follow, so dump this is notepad and save as frm file)

VERSION 5.00
Begin VB.Form frmForm 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Form"
   ClientHeight    =   6645
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   10380
   ForeColor       =   &H00000000&
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   6645
   ScaleWidth      =   10380
   StartUpPosition =   2  'CenterScreen
   Begin VB.TextBox txtTextBox 
      BorderStyle     =   0  'None
      Height          =   255
      Index           =   3
      Left            =   60
      TabIndex        =   4
      Top             =   1140
      Width           =   3015
   End
   Begin VB.TextBox txtTextBox 
      BorderStyle     =   0  'None
      Height          =   255
      Index           =   2
      Left            =   60
      TabIndex        =   3
      Top             =   780
      Width           =   3015
   End
   Begin VB.TextBox txtTextBox 
      BorderStyle     =   0  'None
      Height          =   255
      Index           =   1
      Left            =   60
      TabIndex        =   2
      Top             =   420
      Width           =   3015
   End
   Begin VB.TextBox txtTextBox 
      Appearance      =   0  'Flat
      BackColor       =   &H00FFFFFF&
      BorderStyle     =   0  'None
      ForeColor       =   &H00000000&
      Height          =   255
      Index           =   0
      Left            =   60
      TabIndex        =   1
      Top             =   60
      Width           =   3015
   End
   Begin VB.Frame Frame1 
      Caption         =   "Frame"
      Height          =   5055
      Left            =   180
      TabIndex        =   0
      Top             =   1500
      Width           =   10095
      Begin VB.TextBox txtTextBox 
         BorderStyle     =   0  'None
         Height          =   255
         Index           =   4
         Left            =   120
         TabIndex        =   5
         Top             =   240
         Width           =   855
      End
   End
End
Attribute VB_Name = "FrmForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private vObject As Object

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type


Private Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function InflateRect Lib "user32" (lpRect As RECT, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hdc As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long

Private Sub HighlightObject()

Dim R As RECT
Dim j As Integer
Dim lDC As Long

Me.Cls
Me.ScaleMode = vbPixels

With vObject
    lDC = GetDC(vObject.Container.hwnd)
    SetRect R, (.Left), (.Top), (.Left + .Width), (.Top + .Height)
End With

For j = 0 To 4
    
    Select Case j
    Case 0
        Me.ForeColor = vbGrayText
    Case 1
        Me.ForeColor = RGB(144, 166, 187)
    Case 2
        Me.ForeColor = RGB(163, 196, 227)
    Case 3
        Me.ForeColor = RGB(191, 211, 232)
    Case 4
        Me.ForeColor = RGB(215, 224, 235)
    End Select

    InflateRect R, 1, 1
    With R
        Rectangle lDC, R.Left, R.Top, R.Right, R.Bottom
    End With
Next

ReleaseDC lDC, vObject.Container.hwnd

End Sub

Private Sub Command1_GotFocus()
    Set vObject = Command1
    HighlightObject
End Sub

Private Sub txtTextBox_GotFocus(Index As Integer)
    Set vObject = txtTextBox(Index)
    HighlightObject
End Sub

Private Sub Form_paint()
    HighlightObject
End Sub

Private Sub Form_Load()
    Set vObject = txtTextBox(0)
End Sub

------------------------
Hit any User to continue

 

[HughLerwill]

The code will not work on a Frame because a Frame has no Hwnd property and you cannot create a DC for it (it can't be drawn upon).

You can get it to work if you enclose the textbox in a PictureBox and then put the latter on the Frame.

You will need to modify your procedure as follows;

Private Sub HighlightObject()

Dim R As RECT
Dim j As Integer
Dim lDC As Long

vObject.Container.Cls
vObject.Container.ScaleMode = vbPixels

With vObject
lDC = GetDC(vObject.Container.hwnd)
SetRect R, (.Left), (.Top), (.Left + .Width), (.Top + .Height)
End With

For j = 0 To 4

Select Case j
Case 0
vObject.Container.ForeColor = vbGrayText
Case 1
vObject.Container.ForeColor = RGB(144, 166, 187)
Case 2
vObject.Container.ForeColor = RGB(163, 196, 227)
Case 3
vObject.Container.ForeColor = RGB(191, 211, 232)
Case 4
vObject.Container.ForeColor = RGB(215, 224, 235)
End Select

InflateRect R, 1, 1
With R
Rectangle lDC, R.Left, R.Top, R.Right, R.Bottom
End With
Next

ReleaseDC lDC, vObject.Container.hwnd

End Sub

It will only work (typically) for Forms and PictureBoxes.

 

[SiJP]

Thanks Hugh - thats working better now.

I did think that it was because maybe the ZOrder or control .left might have somthing to do with it, but never that the frame doesn't have a hwnd!

Only downside of the above is when switching from the textbox-in picture control-on frame to a textbox on my form - calling .cls wont clear the existing rectangle!

Still, one for me to play with.

Cheers
Simon



------------------------
Hit any User to continue

 

[SiJP]

fyi - got the cls working by creating a vLastObject variable, and enumerating this with the current object...

All working now heh, thanks



------------------------
Hit any User to continue

 

[HughLerwill]

What I told you about the Frame not having an Hwnd property was not true; more crucially perhaps is it does not have an hDC property which both Pictures and Forms do.

Pleased to hear you have it working anyway.

regards Hugh,