Transparent Listbox...

[edoepke]

VISUAL BASIC ONLY:
I have Googled until my fingers are sore. Is there a way to make a ListBox
or TextBox control transparent (ie: transparent background)? I know it's a
function of Framework that doesn't allow this so please don't remind me. If
it can be done in C, C# or C++ then it should be able to be done in VB 2005.
Since I don't know C++ the code for C++ doesn't help me. (I should expect
someone to tell me to learn C++ but my response to them is ;;;;;;;.) If it
is impossible then what good is the language? Can someone help please. I
don't mind doing the research but please don't send me to a C++ site.

TIA
edoepke

[Mythran]

Re: Transparent Listbox...


"edoepke" <edoepke@comcas t.net> wrote in message
news:yfydnYdwa-pFlfzZ4p2dnA@co mcast.com...[color=blue]
> VISUAL BASIC ONLY:
> I have Googled until my fingers are sore. Is there a way to make a ListBox
> or TextBox control transparent (ie: transparent background)? I know it's a
> function of Framework that doesn't allow this so please don't remind me.
> If it can be done in C, C# or C++ then it should be able to be done in VB
> 2005. Since I don't know C++ the code for C++ doesn't help me. (I should
> expect someone to tell me to learn C++ but my response to them is
> ;;;;;;;.) If it is impossible then what good is the language? Can someone
> help please. I don't mind doing the research but please don't send me to a
> C++ site.
>
> TIA
> edoepke
>[/color]

Well, that's how I look at things! If it can be done in C++, then it CAN be
done in C# :) If they tell me it can't be done, I just do it until I can do
it, or until I forget to continue trying ...

In any case, may want to take a look at using pinvoke (if there are any
api's that allow it).

HTH,
Mythran

[vbnetdev]

Re: Transparent Listbox...

Imports System
Imports System.Runtime. InteropServices
Imports System.Drawing



Namespace ZBobb
'/ <summary>
'/ Win32 support code.
'/ (C) 2003 Bob Bradley / ZBobb@hotmail.c om
'/ </summary>

Public Class win32

Public Const WM_MOUSEMOVE As Integer = &H200
Public Const WM_LBUTTONDOWN As Integer = &H201
Public Const WM_LBUTTONUP As Integer = &H202
Public Const WM_RBUTTONDOWN As Integer = &H204
Public Const WM_LBUTTONDBLCL K As Integer = &H203

Public Const WM_MOUSELEAVE As Integer = &H2A3



Public Const WM_PAINT As Integer = &HF
Public Const WM_ERASEBKGND As Integer = &H14

Public Const WM_PRINT As Integer = &H317

'const int EN_HSCROLL = 0x0601;
'const int EN_VSCROLL = 0x0602;
Public Const WM_HSCROLL As Integer = &H114
Public Const WM_VSCROLL As Integer = &H115


Public Const EM_GETSEL As Integer = &HB0
Public Const EM_LINEINDEX As Integer = &HBB
Public Const EM_LINEFROMCHAR As Integer = &HC9

Public Const EM_POSFROMCHAR As Integer = &HD6




Public Declare Function PostMessage Lib "USER32.DLL " Alias
"PostMessag e" (ByVal hwnd As IntPtr, ByVal msg As System.UInt32, ByVal
wParam As IntPtr, ByVal lParam As IntPtr) As Boolean 'ToDo: Unsigned
Integers not supported


'
' BOOL PostMessage( HWND hWnd,
' UINT Msg,
' WPARAM wParam,
' LPARAM lParam
' );
'

' Put this declaration in your class //IntPtr
Public Declare Function SendMessage Lib "USER32.DLL " Alias
"SendMessag e" (ByVal hwnd As IntPtr, ByVal msg As Integer, ByVal wParam As
IntPtr, ByVal lParam As IntPtr) As Integer





Public Declare Function GetCaretBlinkTi me Lib "USER32.DLL " Alias
"GetCaretBlinkT ime" () As System.UInt32 'ToDo: Unsigned Integers not
supported




Private Const WM_PRINTCLIENT As Integer = &H318

Private Const PRF_CHECKVISIBL E As Long = &H1L
Private Const PRF_NONCLIENT As Long = &H2L
Private Const PRF_CLIENT As Long = &H4L
Private Const PRF_ERASEBKGND As Long = &H8L
Private Const PRF_CHILDREN As Long = &H10L
Private Const PRF_OWNED As Long = &H20L


' Will clean this up later doing something like this
' enum CaptureOptions : long
' {
' PRF_CHECKVISIBL E= 0x00000001L,
' PRF_NONCLIENT = 0x00000002L,
' PRF_CLIENT = 0x00000004L,
' PRF_ERASEBKGND = 0x00000008L,
' PRF_CHILDREN = 0x00000010L,
' PRF_OWNED = 0x00000020L
' }
'


Public Shared Function CaptureWindow(c ontrol As
System.Windows. Forms.Control, ByRef bitmap As System.Drawing. Bitmap) As
Boolean
'This function captures the contents of a window or control
Dim g2 As Graphics = Graphics.FromIm age(bitmap)

'PRF_CHILDREN // PRF_NONCLIENT
Dim meint As Integer = CInt(PRF_CLIENT Or PRF_ERASEBKGND) '|
PRF_OWNED ); // );
Dim meptr As New System.IntPtr(m eint)

Dim hdc As System.IntPtr = g2.GetHdc()
win32.SendMessa ge(control.Hand le, win32.WM_PRINT, hdc, meptr)

g2.ReleaseHdc(h dc)
g2.Dispose()

Return True
End Function 'CaptureWindow
End Class 'win32
End Namespace 'ZBobb


Imports System
Imports System.Collecti ons
Imports System.Componen tModel
Imports System.Drawing
Imports System.Data
Imports System.Windows. Forms


Imports System.Drawing. Imaging


Namespace ZBobb
'/ <summary>
'/ AlphaBlendTextB ox: A .Net textbox that can be translucent to the
background.
'/ (C) 2003 Bob Bradley / ZBobb@hotmail.c om
'/ </summary>
'/



Public Class AlphaBlendTextB ox
Inherits System.Windows. Forms.TextBox
#Region "private variables"

Private myPictureBox As uPictureBox
Private myUpToDate As Boolean = False
Private myCaretUpToDate As Boolean = False
Private myBitmap As Bitmap
Private myAlphaBitmap As Bitmap

Private myFontHeight As Integer = 10

Private myTimer1 As System.Windows. Forms.Timer

Private myCaretState As Boolean = True

Private myPaintedFirstT ime As Boolean = False

Private myBackColor As Color = Color.White
Private myBackAlpha As Integer = 10

'/ <summary>
'/ Required designer variable.
'/ </summary>
Private components As System.Componen tModel.Containe r = Nothing

#End Region


#Region "public methods and overrides"


Public Sub New()
' This call is required by the Windows.Forms Form Designer.
InitializeCompo nent()
' TODO: Add any initialization after the InitializeCompo nent
call
Me.BackColor = myBackColor

Me.SetStyle(Con trolStyles.User Paint, False)
Me.SetStyle(Con trolStyles.AllP aintingInWmPain t, True)
Me.SetStyle(Con trolStyles.Doub leBuffer, True)


myPictureBox = New uPictureBox()
Me.Controls.Add (myPictureBox)
myPictureBox.Do ck = DockStyle.Fill
End Sub 'New



Protected Overrides Sub OnResize(ByVal e As EventArgs)

MyBase.OnResize (e)
Me.myBitmap = New Bitmap(Me.Clien tRectangle.Widt h,
Me.ClientRectan gle.Height) '(this.Width,th is.Height);
Me.myAlphaBitma p = New Bitmap(Me.Clien tRectangle.Widt h,
Me.ClientRectan gle.Height) '(this.Width,th is.Height);
myUpToDate = False
Me.Invalidate()
End Sub 'OnResize



'Some of these should be moved to the WndProc later
Protected Overrides Sub OnKeyDown(ByVal e As KeyEventArgs)
MyBase.OnKeyDow n(e)
myUpToDate = False
Me.Invalidate()
End Sub 'OnKeyDown


Protected Overrides Sub OnKeyUp(ByVal e As KeyEventArgs)
MyBase.OnKeyUp( e)
myUpToDate = False
Me.Invalidate()
End Sub 'OnKeyUp


Protected Overrides Sub OnKeyPress(ByVa l e As KeyPressEventAr gs)
MyBase.OnKeyPre ss(e)
myUpToDate = False
Me.Invalidate()
End Sub 'OnKeyPress


Protected Overrides Sub OnMouseUp(ByVal e As MouseEventArgs)
MyBase.OnMouseU p(e)
Me.Invalidate()
End Sub 'OnMouseUp


Protected Overrides Sub OnGiveFeedback( ByVal gfbevent As
GiveFeedbackEve ntArgs)
MyBase.OnGiveFe edback(gfbevent )
myUpToDate = False
Me.Invalidate()
End Sub 'OnGiveFeedback



Protected Overrides Sub OnMouseLeave(By Val e As EventArgs)
'found this code to find the current cursor location
'at http://www.syncfusion.com/FAQ/WinFor...c50c.asp#q597q
Dim ptCursor As Point = Cursor.Position

Dim f As Form = Me.FindForm()
ptCursor = f.PointToClient (ptCursor)
If Not Me.Bounds.Conta ins(ptCursor) Then
MyBase.OnMouseL eave(e)
End If
End Sub 'OnMouseLeave


Protected Overrides Sub OnChangeUICues( ByVal e As UICuesEventArgs )
MyBase.OnChange UICues(e)
myUpToDate = False
Me.Invalidate()
End Sub 'OnChangeUICues



'--
Protected Overrides Sub OnGotFocus(ByVa l e As EventArgs)
MyBase.OnGotFoc us(e)
myCaretUpToDate = False
myUpToDate = False
Me.Invalidate()


myTimer1 = New System.Windows. Forms.Timer(Me. components)
myTimer1.Interv al = CInt(win32.GetC aretBlinkTime() ) ' usually
around 500;
AddHandler myTimer1.Tick, AddressOf myTimer1_Tick
myTimer1.Enable d = True
End Sub 'OnGotFocus


Protected Overrides Sub OnLostFocus(ByV al e As EventArgs)
MyBase.OnLostFo cus(e)
myCaretUpToDate = False
myUpToDate = False
Me.Invalidate()

myTimer1.Dispos e()
End Sub 'OnLostFocus


'--
Protected Overrides Sub OnFontChanged(B yVal e As EventArgs)
If Me.myPaintedFir stTime Then
Me.SetStyle(Con trolStyles.User Paint, False)
End If
MyBase.OnFontCh anged(e)

If Me.myPaintedFir stTime Then
Me.SetStyle(Con trolStyles.User Paint, True)
End If

myFontHeight = GetFontHeight()


myUpToDate = False
Me.Invalidate()
End Sub 'OnFontChanged


Protected Overrides Sub OnTextChanged(B yVal e As EventArgs)
MyBase.OnTextCh anged(e)
myUpToDate = False
Me.Invalidate()
End Sub 'OnTextChanged



Protected Overrides Sub WndProc(ByRef m As Message)

MyBase.WndProc( m)

' need to rewrite as a big switch
If m.Msg = win32.WM_PAINT Then
myPaintedFirstT ime = True

If Not myUpToDate OrElse Not myCaretUpToDate Then
GetBitmaps()
End If
myUpToDate = True
myCaretUpToDate = True

If Not (myPictureBox.I mage Is Nothing) Then
myPictureBox.Im age.Dispose()
End If
myPictureBox.Im age = CType(myAlphaBi tmap.Clone(), Image)


ElseIf m.Msg = win32.WM_HSCROL L OrElse m.Msg = win32.WM_VSCROL L
Then
myUpToDate = False
Me.Invalidate()

ElseIf m.Msg = win32.WM_LBUTTO NDOWN OrElse m.Msg =
win32.WM_RBUTTO NDOWN OrElse m.Msg = win32.WM_LBUTTO NDBLCLK Then
' || m.Msg == win32.WM_MOUSEL EAVE ///****
myUpToDate = False
Me.Invalidate()

ElseIf m.Msg = win32.WM_MOUSEM OVE Then
If m.WParam.ToInt3 2() <> 0 Then 'shift key or other buttons
myUpToDate = False
Me.Invalidate()
End If
End If
End Sub 'WndProc



'System.Diagnos tics.Debug.Writ eLine("Pro: " + m.Msg.ToString( "X"));


'/ <summary>
'/ Clean up any resources being used.
'/ </summary>
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
If disposing Then
'this.BackColor = Color.Pink;
If Not (components Is Nothing) Then
components.Disp ose()
End If
End If
MyBase.Dispose( disposing)
End Sub 'Dispose

#End Region


#Region "public property overrides"


Public Shadows Property BorderStyle() As BorderStyle
Get
Return MyBase.BorderSt yle
End Get
Set(ByVal value As BorderStyle)
If Me.myPaintedFir stTime Then
Me.SetStyle(Con trolStyles.User Paint, False)
End If
MyBase.BorderSt yle = value

If Me.myPaintedFir stTime Then
Me.SetStyle(Con trolStyles.User Paint, True)
End If
Me.myBitmap = Nothing
Me.myAlphaBitma p = Nothing
myUpToDate = False
Me.Invalidate()
End Set
End Property


Public Shadows Property BackColor() As Color
Get
Return Color.FromArgb( MyBase.BackColo r.R,
MyBase.BackColo r.G, MyBase.BackColo r.B)
End Get
Set(ByVal value As Color)
myBackColor = value
MyBase.BackColo r = value
myUpToDate = False
End Set
End Property

Public Overrides Property Multiline() As Boolean
Get
Return MyBase.Multilin e
End Get
Set(ByVal value As Boolean)
If Me.myPaintedFir stTime Then
Me.SetStyle(Con trolStyles.User Paint, False)
End If
MyBase.Multilin e = value

If Me.myPaintedFir stTime Then
Me.SetStyle(Con trolStyles.User Paint, True)
End If
Me.myBitmap = Nothing
Me.myAlphaBitma p = Nothing
myUpToDate = False
Me.Invalidate()
End Set
End Property


#End Region


#Region "private functions and classes"


Private Function GetFontHeight() As Integer
Dim g As Graphics = Me.CreateGraphi cs()
Dim sf_font As SizeF = g.MeasureString ("X", Me.Font)
g.Dispose()
Return CInt(sf_font.He ight)
End Function 'GetFontHeight



Private Sub GetBitmaps()

If myBitmap Is Nothing OrElse myAlphaBitmap Is Nothing OrElse
myBitmap.Width <> Width OrElse myBitmap.Height <> Height OrElse
myAlphaBitmap.W idth <> Width OrElse myAlphaBitmap.H eight <> Height Then
myBitmap = Nothing
myAlphaBitmap = Nothing
End If



If myBitmap Is Nothing Then
myBitmap = New Bitmap(Me.Clien tRectangle.Widt h,
Me.ClientRectan gle.Height) '(Width,Height) ;
myUpToDate = False
End If


If Not myUpToDate Then
'Capture the TextBox control window
Me.SetStyle(Con trolStyles.User Paint, False)

win32.CaptureWi ndow(Me, myBitmap)

Me.SetStyle(Con trolStyles.User Paint, True)
Me.SetStyle(Con trolStyles.Supp ortsTransparent BackColor,
True)
Me.BackColor = Color.FromArgb( myBackAlpha, myBackColor)
End If
'--


Dim r2 As New Rectangle(0, 0, Me.ClientRectan gle.Width,
Me.ClientRectan gle.Height)
Dim tempImageAttr As New ImageAttributes ()


'Found the color map code in the MS Help
Dim tempColorMap(0) As ColorMap
tempColorMap(0) = New ColorMap()
tempColorMap(0) .OldColor = Color.FromArgb( 255, myBackColor)
tempColorMap(0) .NewColor = Color.FromArgb( myBackAlpha,
myBackColor)

tempImageAttr.S etRemapTable(te mpColorMap)

If Not (myAlphaBitmap Is Nothing) Then
myAlphaBitmap.D ispose()
End If

myAlphaBitmap = New Bitmap(Me.Clien tRectangle.Widt h,
Me.ClientRectan gle.Height) '(Width,Height) ;
Dim tempGraphics1 As Graphics =
Graphics.FromIm age(myAlphaBitm ap)

tempGraphics1.D rawImage(myBitm ap, r2, 0, 0,
Me.ClientRectan gle.Width, Me.ClientRectan gle.Height, GraphicsUnit.Pi xel,
tempImageAttr)

tempGraphics1.D ispose()

'----
If Me.Focused AndAlso Me.SelectionLen gth = 0 Then
Dim tempGraphics2 As Graphics =
Graphics.FromIm age(myAlphaBitm ap)
If myCaretState Then
'Draw the caret
Dim caret As Point = Me.findCaret()
Dim p As New Pen(Me.ForeColo r, 3)
tempGraphics2.D rawLine(p, caret.X, caret.Y + 0, caret.X,
caret.Y + myFontHeight)
tempGraphics2.D ispose()
End If
End If
End Sub 'GetBitmaps







Private Function findCaret() As Point
' Find the caret translated from code at
' * http://www.vb-helper.com/howto_track_textbox_caret.html
' *
' * and
' *
' * http://www.microbion.co.uk/developer...p/textpos2.htm
' *
' * Changed to EM_POSFROMCHAR
' *
' * This code still needs to be cleaned up and debugged
' *

Dim pointCaret As New Point(0)
Dim i_char_loc As Integer = Me.SelectionSta rt
Dim pi_char_loc As New IntPtr(i_char_l oc)

Dim i_point As Integer = win32.SendMessa ge(Me.Handle,
win32.EM_POSFRO MCHAR, pi_char_loc, IntPtr.Zero)
pointCaret = New Point(i_point)

If i_char_loc = 0 Then
pointCaret = New Point(0)
ElseIf i_char_loc >= Me.Text.Length Then
pi_char_loc = New IntPtr(i_char_l oc - 1)
i_point = win32.SendMessa ge(Me.Handle, win32.EM_POSFRO MCHAR,
pi_char_loc, IntPtr.Zero)
pointCaret = New Point(i_point)

Dim g As Graphics = Me.CreateGraphi cs()
Dim t1 As String = Me.Text.Substri ng(Me.Text.Leng th - 1, 1)
+ "X"
Dim sizet1 As SizeF = g.MeasureString (t1, Me.Font)
Dim sizex As SizeF = g.MeasureString ("X", Me.Font)
g.Dispose()
Dim xoffset As Integer = CInt(sizet1.Wid th - sizex.Width)
pointCaret.X = pointCaret.X + xoffset

If i_char_loc = Me.Text.Length Then
Dim slast As String = Me.Text.Substri ng([Text].Length -
1, 1)
If slast = ControlChars.Lf Then
pointCaret.X = 1
pointCaret.Y = pointCaret.Y + myFontHeight
End If
End If
End If



Return pointCaret
End Function 'findCaret



Private Sub myTimer1_Tick(B yVal sender As Object, ByVal e As
EventArgs)
'Timer used to turn caret on and off for focused control
myCaretState = Not myCaretState
myCaretUpToDate = False
Me.Invalidate()
End Sub 'myTimer1_Tick



Private Class uPictureBox
Inherits PictureBox

Public Sub New()
Me.SetStyle(Con trolStyles.Sele ctable, False)
Me.SetStyle(Con trolStyles.User Paint, True)
Me.SetStyle(Con trolStyles.AllP aintingInWmPain t, True)
Me.SetStyle(Con trolStyles.Doub leBuffer, True)

Me.Cursor = Nothing
Me.Enabled = True
Me.SizeMode = PictureBoxSizeM ode.Normal
End Sub 'New





'uPictureBox
Protected Overrides Sub WndProc(ByRef m As Message)
If m.Msg = win32.WM_LBUTTO NDOWN OrElse m.Msg =
win32.WM_RBUTTO NDOWN OrElse m.Msg = win32.WM_LBUTTO NDBLCLK OrElse m.Msg =
win32.WM_MOUSEL EAVE OrElse m.Msg = win32.WM_MOUSEM OVE Then
'Send the above messages back to the parent control
win32.PostMessa ge(Me.Parent.Ha ndle, CType(m.Msg,
System.UInt32), m.WParam, m.LParam) 'ToDo: Unsigned Integers not supported

ElseIf m.Msg = win32.WM_LBUTTO NUP Then
'?? for selects and such
Me.Parent.Inval idate()
End If


MyBase.WndProc( m)
End Sub 'WndProc
End Class 'uPictureBox

' End uPictureBox Class

#End Region


#Region "Component Designer generated code"

'/ <summary>
'/ Required method for Designer support - do not modify
'/ the contents of this method with the code editor.
'/ </summary>
Private Sub InitializeCompo nent()
End Sub 'InitializeComp onent
#End Region


#Region "New Public Properties"


<Category("Appe arance"), Description("Th e alpha value used to blend
the control's background. Valid values are 0 through 255."),
Browsable(True) ,
DesignerSeriali zationVisibilit y(DesignerSeria lizationVisibil ity.Visible)> _
Public Property BackAlpha() As Integer

Get
Return myBackAlpha
End Get
Set(ByVal value As Integer)
Dim v As Integer = value
If v > 255 Then
v = 255
End If
myBackAlpha = v
myUpToDate = False
Invalidate()
End Set
End Property

#End Region
End Class 'AlphaBlendText Box
End Namespace 'ZBobb

' End AlphaTextBox Class

' End namespace ZBobb

'----



--
Get a powerful web, database, application, and email hosting with KJM
Solutions

http://www.kjmsolutions.com

"edoepke" <edoepke@comcas t.net> wrote in message
news:yfydnYdwa-pFlfzZ4p2dnA@co mcast.com...[color=blue]
> VISUAL BASIC ONLY:
> I have Googled until my fingers are sore. Is there a way to make a ListBox
> or TextBox control transparent (ie: transparent background)? I know it's a
> function of Framework that doesn't allow this so please don't remind me.
> If it can be done in C, C# or C++ then it should be able to be done in VB
> 2005. Since I don't know C++ the code for C++ doesn't help me. (I should
> expect someone to tell me to learn C++ but my response to them is
> ;;;;;;;.) If it is impossible then what good is the language? Can someone
> help please. I don't mind doing the research but please don't send me to a
> C++ site.
>
> TIA
> edoepke
>[/color]