Transparent Text Box Control

Hey,

I've searched through the forums on this topic and I couldn't find anything of use, but I do apologise if this is something that has been discussed before.

Basically, I would like to know where, if anywhere, I can get my hands on a transparent text box control, i.e. a text box with a transparent background and no borders but with opaque text.

Has anyone ever come across such a thing?

Thanking you in advance...

well this might be as close as you will get

http://www.planetsourcecode.com/vb/s...23090&lngWId=1

Here's one by Aaron Young. I tried to find the link to where I grabbed it from on this forum but coul'nd find it.
I'm pretty sure I only added the txtEdit_KeyDown bit. Hope you don't mind me posting it Aaron? :)
Cheers!

VB Code:

'inside a module
'>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<
'         Example of Transparent Textbox
'
'       Written by Aaron Young, June 2001
'
'          Email: [email][email protected][/email]
'>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<
Option Explicit
 
Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
 
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function CreatePatternBrush Lib "gdi32" (ByVal hBitmap As Long) As Long
Private Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode As Long) As Long
 
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
 
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
 
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function UpdateWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function InvalidateRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT, ByVal bErase As Long) As Long
 
Private Const GWL_WNDPROC = (-4)
 
Private Const SW_HIDE = 0
Private Const SW_SHOW = 5
 
Private Const WM_CTLCOLOREDIT = &H133
Private Const WM_MOVE = &H3
Private Const WM_COMMAND = &H111
 
Private Const TRANSPARENT = 1
Private Const OPAQUE = 2
 
Private Const EM_GETRECT = &HB2
 
Private Const SRCCOPY = &HCC0020
 
Private lFormHwnd As Long
Private oEdit As TextBox
Private lBackGround As Long
Private lBitmap As Long
Private lOldObj As Long
Private lWindowFunc As Long
Private lBrush As Long
 
Public Sub MakeTransparent(ByVal hwnd As Long, ByRef oTextEdit As TextBox)
    ' Subclass the WindowProc of the Form Window and
    ' Get a Reference to the Textbox we want to make appear Transparent
    lFormHwnd = hwnd
    Set oEdit = oTextEdit
    lWindowFunc = SetWindowLong(lFormHwnd, GWL_WNDPROC, AddressOf WindowCallBack)
End Sub
 
Public Sub ReleaseTransparency()
    ' Release the Subclass on the Forms WindowProc
    ' And Release the reference to the Textbox
    Call SetWindowLong(lFormHwnd, GWL_WNDPROC, lWindowFunc)
    Set oEdit = Nothing
    ' Clean up the Brush, Bitmap and HDC created for the Transparency effect
    Call SelectObject(lBackGround, lOldObj)
    Call DeleteObject(lBitmap)
    Call DeleteObject(lBrush)
    Call DeleteDC(lBackGround)
End Sub
 
Public Sub GetBackGround(ByVal hwnd As Long)
    ' Make the Textbox appear transparent, by painting it with the image
    ' from the Desktop currently under the Textbox control.
    Dim tWIN As RECT
    Dim lObj As Long
    Dim lDeskDC As Long
    Dim bNew As Boolean
    
    ' Hide the Form containing the Textbox to expose the DeskTop underneath
    ' To get rid of the "Focus" effect, consider moving the Form off screen instead
    ' So that it retains focus.
    Call ShowWindow(lFormHwnd, SW_HIDE)
    
    DoEvents
    
    ' Track whether we're doing this for the first time.
    bNew = (lBitmap = 0)
    
    ' If it's not the First time, delete the old Brush, Bitmap and HDC
    ' To preserve GDI resources
    If Not bNew Then
        Call DeleteObject(lBrush)
        Call SelectObject(lBackGround, lOldObj)
        Call DeleteObject(lBitmap)
        Call DeleteDC(lBackGround)
    End If
    
    ' Get the area occupied by the Textbox
    Call GetWindowRect(oEdit.hwnd, tWIN)
    With tWIN
        ' Grap a DC for the Desktop
        lDeskDC = GetDC(0)
        ' Create a compatible Bitmap with the Desktop DC the size of the Textbox Area
        lBitmap = CreateCompatibleBitmap(lDeskDC, .Right - .Left, .Bottom - .Top)
        ' Create a compatible DC to store the current transparency image in.
        lBackGround = CreateCompatibleDC(lDeskDC)
        ' Select the Bitmap into the DC
        lOldObj = SelectObject(lBackGround, lBitmap)
        ' Now copy the currenty image from the Desktop to the Temp. DC
        BitBlt lBackGround, 0, 0, .Right - .Left, .Bottom - .Top, lDeskDC, .Left, .Top, SRCCOPY
    End With
        
    ' Create a Brush using the Bitmap to be used by the Textbox when repainting.
    lBrush = CreatePatternBrush(lBitmap)
    
    ' Release the Desktop DC and Show the Form again.
    Call ReleaseDC(0, lDeskDC)
    Call ShowWindow(lFormHwnd, SW_SHOW)
End Sub
 
Private Function WindowCallBack(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim tRECT As RECT
    
    ' Trap any unforeseen errors
    On Error Resume Next
    
    Select Case Msg
    Case WM_CTLCOLOREDIT
    ' The WM_CTLCOLOREDIT is sent to the Form when the Editbox is about to be repainted
    ' By Returning a Brush handle we can control what's used to paint the background
    ' To make the Box appear transparent, pass a Bitmap of the area under the Form
        
        ' Set the Background Mode to Transparent so that the "TextOut" operations
        ' Don't fill the spaces around the Text with a solid background color.
        Call SetBkMode(wParam, TRANSPARENT)
        WindowCallBack = lBrush
    
    Case WM_MOVE
    ' Triggered when the Form has been moved, at this point we want to get a fresh
    ' Snapshot of what's under the Form to maintain the illusion of Transparency.
        
        Call GetBackGround(lFormHwnd)
        WindowCallBack = CallWindowProc(lWindowFunc, hwnd, Msg, wParam, lParam)
    
    Case WM_COMMAND
    ' Triggered when the Form recieves a command for the Textbox, if you have more than
    ' The Textbox on the Form, you'll want to single out your Textbox from the messages
           
        ' Call the default behaviour first in this case, so we have the opportunity
        ' To clean up unwanted side-effects of this implementation.
        WindowCallBack = CallWindowProc(lWindowFunc, hwnd, Msg, wParam, lParam)
            
        ' Part of the Problem with this method is the Textbox only updates the line it's on
        ' This causes ugly graphical side effects when you backup over text or scroll down
        ' The Textbox outside the visible area.
        ' To get around this, I'm issuing a "Refresh" after each "WM_COMMAND" to update the
        ' whole textbox area, this can give an annoying flicker, but like I said, it aint
        ' Perfect, but it's a starting point.
        
        ' To make this nicer you could narrow down to the calls that cause the annoying
        ' Glitches and only refresh in those instances.
        Call SendMessage(lParam, EM_GETRECT, 0, tRECT)
        Call InvalidateRect(lParam, tRECT, 1)
        Call UpdateWindow(lParam)
                
    Case Else
    
        WindowCallBack = CallWindowProc(lWindowFunc, hwnd, Msg, wParam, lParam)
    
    End Select
    
End Function
 
' Some basic Word manipulation functions, these can be used to extract
' The windows message sent with the "WM_COMMAND" message, see API Help
' Form detais.
Public Function LoWord(ByVal lValue As Long) As Long
    LoWord = lValue And &HFFFF&
End Function
 
Public Function HiWord(ByVal lValue As Long) As Long
    HiWord = (lValue / &H10000) And &HFFFF&
End Function
 
Public Function MakeLong(ByVal lLo As Long, ByVal lHi As Long) As Long
    MakeHiLoWord = (lHi * &H10000) + lLo
End Function

VB Code:

'on a form with a textbox named txtEdit
 
Private Sub Form_Initialize()
    ' Get the initial background image
    GetBackGround hwnd
End Sub
Private Sub Form_Load()
    ' Make the Textbox appear transparent
    MakeTransparent hwnd, txtEdit
    txtEdit.Text = "hello how are you today?" & vbCrLf & "(press escape to exit)"
    txtEdit.FontSize = 18
End Sub
 
Private Sub Form_Resize()
    ' Resize the Textbox to fill the whole form
    ' and grab the desktop image under the form.
    txtEdit.Move 0, 0, ScaleWidth, ScaleHeight
    GetBackGround hwnd
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
    ' Remove transparency...
    ' IMPORTANT >> DO NOT CLOSE VIA THE STOP BUTTON IN THE IDE <<
    ' DOING SO WILL CAUSE VB TO CRASH, THIS CODE NEEDS TO BE TRIGGERED FIRST
    ' TO REMOVE THE SUBCLASSING.
    ReleaseTransparency
End Sub
 
Private Sub txtEdit_KeyDown(KeyCode As Integer, Shift As Integer)
    Select Case KeyCode
    Case vbKeyEscape
    Unload Me
    End Select
End Sub

Cool, this works nicely:) Well done Aaron, if anybody had trouble making it from the code above, i zipped an example up here.

Thank Aaron though or the writer for the code:)

I thought there's something like Microsoft Forms 2.0 component.
It has a transparent textbox control.

Yeah there is lol, thats the 3rd time you have mentioned about that control;) :lol:

you cant distribute that control with your applications. the end user would HAVE to have office installed to make use of it

Is that the same for all controls under that license group?

Quote:

---

Originally posted by Madboy
Is that the same for all controls under that license group?

---

it goes for the entire ms forms 2.0 component