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

Show quote Hide quote 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

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



Namespace ZBobb
   '/ <summary>
   '/ Win32 support code.
   '/ (C) 2003 Bob Bradley / ZB***@hotmail.com
   '/ </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_LBUTTONDBLCLK 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
"PostMessage" (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
"SendMessage" (ByVal hwnd As IntPtr, ByVal msg As Integer, ByVal wParam As
IntPtr, ByVal lParam As IntPtr) As Integer





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




      Private Const WM_PRINTCLIENT As Integer = &H318

      Private Const PRF_CHECKVISIBLE 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_CHECKVISIBLE= 0x00000001L,
'   PRF_NONCLIENT = 0x00000002L,
'   PRF_CLIENT  = 0x00000004L,
'   PRF_ERASEBKGND = 0x00000008L,
'   PRF_CHILDREN = 0x00000010L,
'   PRF_OWNED  = 0x00000020L
'  }
'


      Public Shared Function CaptureWindow(control 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.FromImage(bitmap)

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

         Dim hdc As System.IntPtr = g2.GetHdc()
         win32.SendMessage(control.Handle, win32.WM_PRINT, hdc, meptr)

         g2.ReleaseHdc(hdc)
         g2.Dispose()

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


Imports System
Imports System.Collections
Imports System.ComponentModel
Imports System.Drawing
Imports System.Data
Imports System.Windows.Forms


Imports System.Drawing.Imaging


Namespace ZBobb
    '/ <summary>
    '/ AlphaBlendTextBox: A .Net textbox that can be translucent to the
background.
    '/ (C) 2003 Bob Bradley / ZB***@hotmail.com
    '/ </summary>
    '/



    Public Class AlphaBlendTextBox
        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 myPaintedFirstTime As Boolean = False

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

        '/ <summary>
        '/ Required designer variable.
        '/ </summary>
        Private components As System.ComponentModel.Container = Nothing

#End Region


#Region "public methods and overrides"


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

            Me.SetStyle(ControlStyles.UserPaint, False)
            Me.SetStyle(ControlStyles.AllPaintingInWmPaint, True)
            Me.SetStyle(ControlStyles.DoubleBuffer, True)


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



        Protected Overrides Sub OnResize(ByVal e As EventArgs)

            MyBase.OnResize(e)
            Me.myBitmap = New Bitmap(Me.ClientRectangle.Width,
Me.ClientRectangle.Height) '(this.Width,this.Height);
            Me.myAlphaBitmap = New Bitmap(Me.ClientRectangle.Width,
Me.ClientRectangle.Height) '(this.Width,this.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.OnKeyDown(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(ByVal e As KeyPressEventArgs)
            MyBase.OnKeyPress(e)
            myUpToDate = False
            Me.Invalidate()
        End Sub 'OnKeyPress


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


        Protected Overrides Sub OnGiveFeedback(ByVal gfbevent As
GiveFeedbackEventArgs)
            MyBase.OnGiveFeedback(gfbevent)
            myUpToDate = False
            Me.Invalidate()
        End Sub 'OnGiveFeedback



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

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


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



        '--
        Protected Overrides Sub OnGotFocus(ByVal e As EventArgs)
            MyBase.OnGotFocus(e)
            myCaretUpToDate = False
            myUpToDate = False
            Me.Invalidate()


            myTimer1 = New System.Windows.Forms.Timer(Me.components)
            myTimer1.Interval = CInt(win32.GetCaretBlinkTime()) '  usually
around 500;
            AddHandler myTimer1.Tick, AddressOf myTimer1_Tick
            myTimer1.Enabled = True
        End Sub 'OnGotFocus


        Protected Overrides Sub OnLostFocus(ByVal e As EventArgs)
            MyBase.OnLostFocus(e)
            myCaretUpToDate = False
            myUpToDate = False
            Me.Invalidate()

            myTimer1.Dispose()
        End Sub 'OnLostFocus


        '--
        Protected Overrides Sub OnFontChanged(ByVal e As EventArgs)
            If Me.myPaintedFirstTime Then
                Me.SetStyle(ControlStyles.UserPaint, False)
            End If
            MyBase.OnFontChanged(e)

            If Me.myPaintedFirstTime Then
                Me.SetStyle(ControlStyles.UserPaint, True)
            End If

            myFontHeight = GetFontHeight()


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


        Protected Overrides Sub OnTextChanged(ByVal e As EventArgs)
            MyBase.OnTextChanged(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
                myPaintedFirstTime = True

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

                If Not (myPictureBox.Image Is Nothing) Then
                    myPictureBox.Image.Dispose()
                End If
                myPictureBox.Image = CType(myAlphaBitmap.Clone(), Image)


            ElseIf m.Msg = win32.WM_HSCROLL OrElse m.Msg = win32.WM_VSCROLL
Then
                myUpToDate = False
                Me.Invalidate()

            ElseIf m.Msg = win32.WM_LBUTTONDOWN OrElse m.Msg =
win32.WM_RBUTTONDOWN OrElse m.Msg = win32.WM_LBUTTONDBLCLK Then
                '  || m.Msg == win32.WM_MOUSELEAVE  ///****
                myUpToDate = False
                Me.Invalidate()

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



        'System.Diagnostics.Debug.WriteLine("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.Dispose()
                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.BorderStyle
            End Get
            Set(ByVal value As BorderStyle)
                If Me.myPaintedFirstTime Then
                    Me.SetStyle(ControlStyles.UserPaint, False)
                End If
                MyBase.BorderStyle = value

                If Me.myPaintedFirstTime Then
                    Me.SetStyle(ControlStyles.UserPaint, True)
                End If
                Me.myBitmap = Nothing
                Me.myAlphaBitmap = Nothing
                myUpToDate = False
                Me.Invalidate()
            End Set
        End Property


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

        Public Overrides Property Multiline() As Boolean
            Get
                Return MyBase.Multiline
            End Get
            Set(ByVal value As Boolean)
                If Me.myPaintedFirstTime Then
                    Me.SetStyle(ControlStyles.UserPaint, False)
                End If
                MyBase.Multiline = value

                If Me.myPaintedFirstTime Then
                    Me.SetStyle(ControlStyles.UserPaint, True)
                End If
                Me.myBitmap = Nothing
                Me.myAlphaBitmap = 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.CreateGraphics()
            Dim sf_font As SizeF = g.MeasureString("X", Me.Font)
            g.Dispose()
            Return CInt(sf_font.Height)
        End Function 'GetFontHeight



        Private Sub GetBitmaps()

            If myBitmap Is Nothing OrElse myAlphaBitmap Is Nothing OrElse
myBitmap.Width <> Width OrElse myBitmap.Height <> Height OrElse
myAlphaBitmap.Width <> Width OrElse myAlphaBitmap.Height <> Height Then
                myBitmap = Nothing
                myAlphaBitmap = Nothing
            End If



            If myBitmap Is Nothing Then
                myBitmap = New Bitmap(Me.ClientRectangle.Width,
Me.ClientRectangle.Height) '(Width,Height);
                myUpToDate = False
            End If


            If Not myUpToDate Then
                'Capture the TextBox control window
                Me.SetStyle(ControlStyles.UserPaint, False)

                win32.CaptureWindow(Me, myBitmap)

                Me.SetStyle(ControlStyles.UserPaint, True)
                Me.SetStyle(ControlStyles.SupportsTransparentBackColor,
True)
                Me.BackColor = Color.FromArgb(myBackAlpha, myBackColor)
            End If
            '--


            Dim r2 As New Rectangle(0, 0, Me.ClientRectangle.Width,
Me.ClientRectangle.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.SetRemapTable(tempColorMap)

            If Not (myAlphaBitmap Is Nothing) Then
                myAlphaBitmap.Dispose()
            End If

            myAlphaBitmap = New Bitmap(Me.ClientRectangle.Width,
Me.ClientRectangle.Height) '(Width,Height);
            Dim tempGraphics1 As Graphics =
Graphics.FromImage(myAlphaBitmap)

            tempGraphics1.DrawImage(myBitmap, r2, 0, 0,
Me.ClientRectangle.Width, Me.ClientRectangle.Height, GraphicsUnit.Pixel,
tempImageAttr)

            tempGraphics1.Dispose()

            '----
            If Me.Focused AndAlso Me.SelectionLength = 0 Then
                Dim tempGraphics2 As Graphics =
Graphics.FromImage(myAlphaBitmap)
                If myCaretState Then
                    'Draw the caret
                    Dim caret As Point = Me.findCaret()
                    Dim p As New Pen(Me.ForeColor, 3)
                    tempGraphics2.DrawLine(p, caret.X, caret.Y + 0, caret.X,
caret.Y + myFontHeight)
                    tempGraphics2.Dispose()
                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/developers/csharp/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.SelectionStart
            Dim pi_char_loc As New IntPtr(i_char_loc)

            Dim i_point As Integer = win32.SendMessage(Me.Handle,
win32.EM_POSFROMCHAR, 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_loc - 1)
                i_point = win32.SendMessage(Me.Handle, win32.EM_POSFROMCHAR,
pi_char_loc, IntPtr.Zero)
                pointCaret = New Point(i_point)

                Dim g As Graphics = Me.CreateGraphics()
                Dim t1 As String = Me.Text.Substring(Me.Text.Length - 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.Width - sizex.Width)
                pointCaret.X = pointCaret.X + xoffset

                If i_char_loc = Me.Text.Length Then
                    Dim slast As String = Me.Text.Substring([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(ByVal 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(ControlStyles.Selectable, False)
                Me.SetStyle(ControlStyles.UserPaint, True)
                Me.SetStyle(ControlStyles.AllPaintingInWmPaint, True)
                Me.SetStyle(ControlStyles.DoubleBuffer, True)

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





            'uPictureBox
            Protected Overrides Sub WndProc(ByRef m As Message)
                If m.Msg = win32.WM_LBUTTONDOWN OrElse m.Msg =
win32.WM_RBUTTONDOWN OrElse m.Msg = win32.WM_LBUTTONDBLCLK OrElse m.Msg =
win32.WM_MOUSELEAVE OrElse m.Msg = win32.WM_MOUSEMOVE Then
                    'Send the above messages back to the parent control
                    win32.PostMessage(Me.Parent.Handle, CType(m.Msg,
System.UInt32), m.WParam, m.LParam) 'ToDo: Unsigned Integers not supported

                ElseIf m.Msg = win32.WM_LBUTTONUP Then
                    '??  for selects and such
                    Me.Parent.Invalidate()
                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 InitializeComponent()
        End Sub 'InitializeComponent
#End Region


#Region "New Public Properties"


        <Category("Appearance"), Description("The alpha value used to blend
the control's background. Valid values are 0 through 255."),
Browsable(True),
DesignerSerializationVisibility(DesignerSerializationVisibility.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 'AlphaBlendTextBox
End Namespace 'ZBobb

' End AlphaTextBox Class

' End namespace ZBobb

'----



Show quoteHide quote

Saving Blob Data To File
How to disable the numericupdown event firing?
Question en programmation !
Need to lock read a text file, then delete...
Dataset or SQL? wich is faster?
Check if Service is running?
How to interrupt a running program
How to CType() when target type's name is in a string
How to kill a terminal server session (VB.NET)
Safe / Unsafe Native Methods