[RESOLVED] Drawing on Windowless Usercontrols

[SassyCat]

Hi all,

I am developing a simple Label control. Pretty much the same as VB6's native version but with few additional features needed for my work. I have stumbled upon two major (yet seemingly minor at first) problems but I'll just stick to one of them in this thread: windowless owner-drawn usercontrols .

As you all know, VB6 Label is windowless and can be transparent as well. But it's not just transparent apparently. It seems that it copies a chunk of desktop's DC (or parent's DC?) to itself and draws text on top of that. That way, its clear-type fonts will properly blend with background graphics. Either that, or it uses begin/end paint method by subclassing its parent WM_PAINT. This cannot be achieved with windows regions or VB6 Usercontrol's "Lightweight" or "Transparent" modes as they require a mask bitmap or mask region and thus no alpha blending can be accomplished with those two. Onto my question....

Not only I am oblivious to how windowless controls function or how to use them, but I have no good reference/manual to start with. Microsoft documentation only covers basic concepts that don't delve into drawing clear type fonts onto your windowless control, or drawing anything at all in fact. My question is how does one draw text over a windowless Usercontrol? I am using DrawTextEx function to draw stuff onto a memory DC but what do I do with that DC if I don't even have a window to start with? I can't subclass anything as there's no window to subclass so I guess there must be some native VB feature I'm missing out. I'll mention again that transparent image property, or mask color property are useless here since DrawTextEx draws a 32bit bitmap onto the target surface, just like VB6 native Label.

If anyone has any suggestion just shoot, I'm totally clueless ATM so still hoping it's just a minor problem.

Thanks in advance!

[LaVolpe]

Welcome to the forums.

1. This is an excellent reference for usercontrols. Note that I'm having trouble accessing the site at the moment, but it's been up for years. Directly addresses VB5 but VB6 is not that different in this case.

2. Windowless controls can have their own DC or not (HasDC property).
a. Own DC: You draw on to the DC (same size as control) and VB transfers it to the form automatically
b. No DC: During the control's Paint event, VB passes you a clipped DC that you draw on directly. That DC is the control's parent's DC. Before the DC is sent to you, anything lower in the zOrder of your control that occupies the same space as your control is already drawn, including the background color as applicable.

3. Drawing text or anything on the control is done by drawing to the DC.
a. Has DC: use UserControl.hDC value. The Paint event is not called if AutoRedraw is True. If True, .Refresh control after drawing
b. No DC: use UserControl.hDC only in the control's Paint event. Accessing it outside of the event can/will produce an error since the control has no DC allocated. AutoRedraw cannot be set on DC-less controls.

Edited: The "No DC" option is how you can ensure transparency. Other methods include using the MaskPicture and MaskColor properties but are somewhat limited.

Regarding subclassing. Each usercontrol has a containerHwnd property.

Hope this clears up some issues.

[petersen]

SassyCat,

Have you used CreateWindowEx to create a "virtual" textbox (passing "Edit" argument)?

That is tha approach that I use to build a user control for dual uses: textbox and label (I used CreateWindowExW because I need to deal with unicode, thus the control is effectively Unicode TextBox User Control or Unicode Label User Control).

You can involve subclassing in your user control if you want. But I don't in this case, because there is no such a need for me (there is no special Event handling that I need). By definition the textbox so created would already have many inherent functions attached to it, e.g. Cut and Paste.

[Edit: For your info, the user control thus created with CreateWindowExW can accept ANSI/Unicode input from (i) clipboard, (ii) keyboard and (iii) writing pad (i.e. "handwriting recognition" in Windows terms). Ordinary VB Label or VB TextBox cannot achieve these, not even VB RTB.]

[some1uk03]

I've suffered on this very same topic too and what you need to do is make your UC 'Windowless' property to False, that way you will have a DC. Once you have this you will have to copy the back of your form/object and draw it as the background of your UC, that way it will look transparent.
But then you may have a problem since it won't work if your control is over an Image control.

So what i Did was, I added a custom property where you Type the name of the Control of which you wish to use its Image. So a link basically which tells me which object is behind my label.

Then I have in part of my code check:

If Not m_AlphaLinkIMG = vbNullString Then  'Make sure there is a link to copy
Dim obj As Control
Dim objPic As StdPicture
    For Each obj In Parent.Controls
       If TypeOf obj Is Image Then
            If obj.name = m_AlphaLinkIMG Then
                    If obj.Picture <> 0 Then
                            wasHere = True
                    Set objPic = obj.Picture
                    End If
            End If
        End If
    Next obj
'
'
'Code continues.. to drawtext etc...
End If

Then i use the image of objPic to copy the BG.

[SassyCat]

Welcome to the forums.
b. No DC: use UserControl.hDC only in the control's Paint event. Accessing it outside of the event can/will produce an error since the control has no DC allocated. AutoRedraw cannot be set on DC-less controls.

Edited: The "No DC" option is how you can ensure transparency. Other methods include using the MaskPicture and MaskColor properties but are somewhat limited.

This solved the issue! It seems VB holds a buffer DC which is available in Paint event thus allowing you double-buffered rendering along with transparency! Really nice. I just call native Refresh method in my properties Set/Let handlers to request repainting.

That's what I've been missing, you're the man LaVolpe.

@petersen
Edit control would be an overkill, this is just a label . I was going for no permanent GDI handles and/or window handles.

@some1uk03
I've put LaVolpe's explanation to use and it worked great. All you have to do is draw inside the Paint event with BackgroundStyle set to Transparent! That way your DC will be laid out automatically by VB to the container surface. This eliminates the need for double buffering as well so you can just draw directly to the control's DC.

Thanks for help all!

[LaVolpe]

This solved the issue! It seems VB holds a buffer DC which is available in Paint event thus allowing you double-buffered rendering along with transparency! Really nice. I just call native Refresh method in my properties Set/Let handlers to request repainting.

That's what I've been missing, you're the man LaVolpe.

I've designed many windowless controls using dc-less options and it works quite well.

One word of advice. Depending on complexity of your drawing (i.e., time consuming), you may want to use an offscreen buffer, copy the passed DC to your offscreen, do the complex drawing and then copy the offscreen back to the passed DC. Also, should you be selecting anything into the passed DC, cache what you pulled out and put it back in else unexpected results can occur.

[Merri]

Because this is directly related to this very issue... I must be missing something.

Create a new UserControl:

BackStyle = Transparent
HasDC = False
ScaleMode = vbPixels
Windowless = False

(These settings should be correct according to the posts in this thread.)

Option Explicit

Public Enum LabelBackStyleConstants
    [Label Transparent] = 0
    [Label Opaque] = 1
End Enum

' API font constants
Private Const FW_BOLD = 700&
Private Const FW_NORMAL = 400&
Private Const LF_FACESIZE = 32&
Private Const LOGPIXELSX = 88&
Private Const LOGPIXELSY = 90&

' API font structure
Private Type LOGFONT
    lfHeight As Long
    lfWidth As Long
    lfEscapement As Long
    lfOrientation As Long
    lfWeight As Long
    lfItalic As Byte
    lfUnderline As Byte
    lfStrikeOut As Byte
    lfCharSet As Byte
    lfOutPrecision As Byte
    lfClipPrecision As Byte
    lfQuality As Byte
    lfPitchAndFamily As Byte
    lfFaceName(31) As Byte
End Type

' API declaration
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function DrawTextW Lib "user32" (ByVal hDC As Long, ByVal lpStr As Long, ByVal nCount As Long, lpRECT As Any, ByVal wFormat As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function MulDiv Lib "kernel32" (ByVal nNumber As Long, ByVal nNumerator As Long, ByVal nDenominator As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function SetBkColor Lib "gdi32" (ByVal hDC As Long, ByVal crColor As Long) As Long
Private Declare Function SetBkMode Lib "gdi32" (ByVal hDC As Long, ByVal nBkMode As Long) As Long
Private Declare Function SetTextColor Lib "gdi32" (ByVal hDC As Long, ByVal crColor As Long) As Long

' properties
Private m_BackColor As Long
Private m_Caption() As Byte
Private m_Color As Long
Private WithEvents m_Font As StdFont
Private m_FontHandle As Long

Public Property Get BackColor() As OLE_COLOR
    BackColor = UserControl.BackColor
End Property

Public Property Let BackColor(ByVal NewValue As OLE_COLOR)
    UserControl.BackColor = NewValue
    If NewValue < 0 Then m_BackColor = GetSysColor(NewValue And &HFF&) Else m_BackColor = NewValue
    UserControl.Refresh
End Property

Public Property Get BackStyle() As LabelBackStyleConstants
    BackStyle = UserControl.BackStyle
End Property

Public Property Let BackStyle(ByVal NewValue As LabelBackStyleConstants)
    UserControl.BackStyle = NewValue
End Property

Public Property Get Caption() As String
    Caption = m_Caption
End Property

Public Property Let Caption(NewValue As String)
    m_Caption = NewValue
    UserControl.Refresh
End Property

Public Property Get Color() As OLE_COLOR
    Color = UserControl.ForeColor
End Property

Public Property Let Color(ByVal NewValue As OLE_COLOR)
    UserControl.ForeColor = NewValue
    If NewValue < 0 Then m_Color = GetSysColor(NewValue And &HFF&) Else m_Color = NewValue
    UserControl.Refresh
End Property

Public Property Get Font() As StdFont
    Set Font = UserControl.Font
End Property

Public Property Set Font(NewValue As StdFont)
    Set UserControl.Font = NewValue
End Property

Private Sub m_Font_FontChanged(ByVal PropertyName As String)
    Debug.Print Time$ & " FontChanged"
    Dim LogicalFont As LOGFONT, lngLen As Long
    ' destroy old font if it exists
    If m_FontHandle Then DeleteObject m_FontHandle
    ' initialize font settings
    With m_Font
        ' determine length of font name
        If Len(.Name) >= LF_FACESIZE Then lngLen = LF_FACESIZE Else lngLen = Len(.Name)
        ' copy maximum allowed length
        CopyMemory LogicalFont.lfFaceName(0), ByVal .Name, lngLen
        ' set other font settings
        LogicalFont.lfHeight = -MulDiv(.Size, GetDeviceCaps(UserControl.hDC, LOGPIXELSY), 72)
        LogicalFont.lfItalic = .Italic
        If Not .Bold Then LogicalFont.lfWeight = FW_NORMAL Else LogicalFont.lfWeight = FW_BOLD
        LogicalFont.lfUnderline = .Underline
        LogicalFont.lfStrikeOut = .Strikethrough
        LogicalFont.lfCharSet = .Charset
    End With
    ' create new font
    m_FontHandle = CreateFontIndirect(LogicalFont)
    ' update control using the new font
    UserControl.Refresh
End Sub

Private Sub UserControl_AmbientChanged(PropertyName As String)
    ' refresh color information
    BackColor = UserControl.BackColor
    Color = UserControl.ForeColor
End Sub

Private Sub UserControl_HitTest(X As Single, Y As Single, HitResult As Integer)
    HitResult = vbHitResultHit
End Sub

Private Sub UserControl_Initialize()
    ' create empty byte array to avoid errors
    m_Caption = vbNullString
End Sub

Private Sub UserControl_InitProperties()
    ' get updates in changes to font
    Set m_Font = UserControl.Font
    ' modernization effort
    With UserControl.Extender.Container
        ' replace container's font with Segoe UI!
        If .Font.Name = "MS Sans Serif" And .Font.Size = 8 Then
            Set .Font = UserControl.Font
        End If
    End With
    ' initial name
    m_Caption = UserControl.Ambient.DisplayName
    ' update colors
    BackColor = UserControl.Ambient.BackColor
    Color = UserControl.Ambient.ForeColor
    ' change font
    Set UserControl.Font = UserControl.Ambient.Font
End Sub

Private Sub UserControl_Paint()
    Dim DC As Long, OldFont As Long, RECT(0 To 3) As Long
    ' do we have a font?
    If m_FontHandle = 0 Then m_Font_FontChanged vbNullString: Exit Sub
    ' cache DC
    DC = UserControl.hDC
    ' set drawing boundaries
    RECT(2) = UserControl.ScaleWidth
    RECT(3) = UserControl.ScaleHeight
    ' do we have any text to draw?
    If UBound(m_Caption) >= 0 Then
        ' set drawing mode to transparent
        SetBkMode DC, 3
        SetBkColor DC, m_BackColor
        ' set font color
        SetTextColor DC, m_Color
        ' replace font with our own
        OldFont = SelectObject(DC, m_FontHandle)
        ' draw stuff!
        DrawTextW DC, VarPtr(m_Caption(0)), (UBound(m_Caption) + 1) \ 2, RECT(0), &H20&
        ' restore original font (which is then destroyed as the DC we just used is destroyed)
        SelectObject DC, OldFont
    End If
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    ' get updates in changes to font
    Set m_Font = UserControl.Font
    ' then get our stuff!
    With PropBag
        BackColor = .ReadProperty("BackColor", vbButtonFace)
        BackStyle = .ReadProperty("BackStyle", 0)
        m_Caption = .ReadProperty("Caption", UserControl.Ambient.DisplayName)
        Color = .ReadProperty("Color", vbButtonText)
        Set UserControl.Font = .ReadProperty("Font", UserControl.Ambient.Font)
    End With
End Sub

Private Sub UserControl_Terminate()
    ' destroy the font we have created
    If m_FontHandle Then DeleteObject m_FontHandle
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    ' save our stuff!
    With PropBag
        .WriteProperty "BackColor", UserControl.BackColor, vbButtonFace
        .WriteProperty "BackStyle", UserControl.BackStyle, 0
        .WriteProperty "Caption", m_Caption, vbNullString
        .WriteProperty "Color", UserControl.ForeColor, vbButtonText
        .WriteProperty "Font", m_Font, UserControl.Ambient.Font
    End With
End Sub

If I paint on the UserControl DC when BackStyle = Transparent -> nothing ever appears. What am I missing?

[LaVolpe]

Set uc's ClipBehavior to None.

[Merri]

Thanks, works It looks like HasDC doesn't have effect in how it works in this case, things that matter are ClipBehavior = None, Windowless = True & doing drawing only in UserControl_Paint.

[DocDix]

I've designed many windowless controls using dc-less options and it works quite well.

One word of advice. Depending on complexity of your drawing (i.e., time consuming), you may want to use an offscreen buffer, copy the passed DC to your offscreen, do the complex drawing and then copy the offscreen back to the passed DC. Also, should you be selecting anything into the passed DC, cache what you pulled out and put it back in else unexpected results can occur.

Thank you very much guys and especially LaVolpe, you just saved my day as I was writting a Image Button component to freshen an old application UI... this forum is just so great!

Have a nice day