Solved

Drawing border on combobox

Posted on 2010-11-10
11
1,989 Views
Last Modified: 2012-05-10
I'm trying to change the border color on a combobox in a vb.net windows form. So, I'm intercepting the WM_NCPAINT message in WndProc to draw the box, but when I run the application, the border is blipped out almost immediately. So, I just see it for some milliseconds each time I bring the application to the foreground. What am I'm missing?
Declare Function GetWindowDC Lib "user32" Alias "GetWindowDC" (ByVal hwnd As IntPtr) As IntPtr

  Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)
    Const WM_NCPAINT = &H85
    If m.Msg = WM_NCPAINT Then
      Dim hdc As IntPtr = GetWindowDC(m.HWnd)
      Dim g As Graphics = Graphics.FromHdc(hdc)
      Dim p As New Pen(Color.Red, 4)
      g.DrawRectangle(p, New Rectangle(0, 0, Me.Width, Me.Height))
    Else
      MyBase.WndProc(m)
    End If
  End Sub

Open in new window

0
Comment
Question by:wellhole
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 5
  • 5
11 Comments
 
LVL 7

Assisted Solution

by:rogerard
rogerard earned 100 total points
ID: 34105827
change the me.width and height to clientrectangle.width and height
0
 
LVL 9

Author Comment

by:wellhole
ID: 34106334
That doesn't do anything.
0
 
LVL 7

Expert Comment

by:rogerard
ID: 34106415
Then this


g.drawrectangle(p, New Rectangle(ClientRectangle.X, ClientRectangle.Y, Me.ClientRectangle.Width, Me.ClientRectangle.Height))

Open in new window

0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 7

Expert Comment

by:rogerard
ID: 34106434
If that doesn't work, instead try drawing it on the OnPaint event.  btw, the clientrectangle is the visible rectangle of the control.
0
 
LVL 9

Author Comment

by:wellhole
ID: 34106627
So far your code suggestions haven't made any difference compared to the original code. they just blip for a millisecond and then never show up again unless i hide and show the form and same thing happens.
0
 
LVL 7

Expert Comment

by:rogerard
ID: 34107951
Try using this routine instead.

     Protected Overrides Sub OnPaint(e As PaintEventArgs)
               MyBase.OnPaint(e)
               Dim borderWidth As Integer = 1
               Dim borderColor As Color = Color.Blue
               ControlPaint.DrawBorder(e.Graphics, e.ClipRectangle, borderColor, borderWidth, ButtonBorderStyle.Solid, borderColor, borderWidth, ButtonBorderStyle.Solid, borderColor, borderWidth, ButtonBorderStyle.Solid, borderColor, borderWidth, ButtonBorderStyle.Solid)
          End Sub 'OnPaint 

Open in new window

0
 
LVL 9

Author Comment

by:wellhole
ID: 34113598
I don't get anything besides the regular combobox with that.
' $Log$

Imports System
Imports System.Threading
Imports System.Security
Imports System.Security.Cryptography

Public Class CbCust
  Inherits ComboBox

  Private Const DISPLAY_COLUMN As String = "rmname"
  Private Const VALUE_COLUMN As String = "rmcust"

  Private _salesmen As New List(Of String)
  Private _custchanged As Boolean = False
  Private _showactiveonly As Boolean = True

  Private loaded As Boolean = False

  Public Sub New()
    MyBase.New()

    Me.DisplayMember = DISPLAY_COLUMN
    Me.ValueMember = VALUE_COLUMN
  End Sub

  Private Sub CbCust_HandleCreated(ByVal sender As Object, ByVal e As EventArgs) Handles Me.HandleCreated
    If Not loaded Then
      If System.ComponentModel.LicenseManager.UsageMode = ComponentModel.LicenseUsageMode.Runtime Then
        LoadCustomerCombobox(Me)
      End If
      loaded = True
    End If
  End Sub

  Private Shared cbCustListLock As New Object
  Private Shared cbCustList As New List(Of CbCust)
  Private Shared Sub LoadCustomerCombobox(ByVal cbCust As CbCust)
    'Console.WriteLine("LOAD")
    Static cbCustDS As DataSet = Nothing    ' REQUIRES SHARED METHOD
    Dim renew As Boolean = cbCustDS Is Nothing
    Dim ds As DataSet

    SyncLock cbCustListLock
      cbCustList.Add(cbCust)
    End SyncLock

    Dim result As MsgBoxResult
    Do
      Try
        If renew Then
          Dim path As String : If System.Deployment.Application.ApplicationDeployment.IsNetworkDeployed Then path = System.IO.Path.Combine(System.Deployment.Application.ApplicationDeployment.CurrentDeployment.DataDirectory, Constants.CUSTOMERLIST_CACHE) Else path = Constants.CUSTOMERLIST_CACHE
          Dim keypath As String = path & Constants.CUSTOMERLIST_CACHE_KEY
          If Not Utilities.IsCurrentDriveNetworked AndAlso System.IO.File.Exists(path) AndAlso System.IO.File.Exists(keypath) Then
            Try
              Dim rsa As RSACryptoServiceProvider = ReadRsa(keypath)
              If Not rsa Is Nothing Then
                Dim en As LargeEncryptedObject = ReadData(path)
                If Not en Is Nothing Then
                  Dim dt As DataTable = en.DecryptContainedObject(rsa.ToXmlString(True))

                  cbCustDS = New DataSet
                  cbCustDS.Tables.Add(dt)
                  StartCacheCustomerList(cbCustDS)  ' thread grab a new list for caching
                End If
              End If
            Catch ex As Exception
              ' if read error, then get new list
              cbCustDS = Nothing
            End Try
          End If

          If cbCustDS Is Nothing Then
            cbCustDS = db.displayCustomerList
            CacheNewCustomerList(cbCustDS)
          End If

          SetUpCustomerList(cbCustDS)
          ds = cbCustDS
        Else
          ds = cbCustDS.Copy
        End If
        cbCust.DataSource = ds.Tables("Table").DefaultView
        cbCust.ShowActiveOnly(cbCust._showactiveonly)
        result = MsgBoxResult.Cancel
      Catch ex As System.Exception
        result = MessageBox.Show("Exception->Customer list: " & vbCrLf _
                & ex.Message, "LoadCustomerCombobox", MessageBoxButtons.RetryCancel)
      End Try
    Loop While result = MsgBoxResult.Retry
  End Sub

  Private Shared Sub SetUpCustomerList(ByVal ds As DataSet)
    Dim row As System.Data.DataRow = ds.Tables("Table").NewRow
    row(DISPLAY_COLUMN) = String.Empty
    row(VALUE_COLUMN) = String.Empty
    row("rmdel") = "A"
    ds.Tables("Table").Rows.InsertAt(row, 0)
  End Sub

  Private Shared Sub UnloadCustomerCombobox(ByVal cbCust As CbCust)
    SyncLock cbCustListLock
      'Console.WriteLine("UNLOAD")
      cbCustList.Remove(cbCust)
    End SyncLock
  End Sub

  Public Shadows Sub CbCust_Disposed(ByVal sender As Object, ByVal e As EventArgs) Handles Me.Disposed
    'Console.WriteLine("DISPOSED")
    UnloadCustomerCombobox(Me)
  End Sub

  Private Shared Function ReadRsa(ByVal keypath As String) As RSACryptoServiceProvider
    If System.IO.File.Exists(keypath) Then
      Dim fs As System.IO.FileStream = Nothing
      Try
        fs = New System.IO.FileStream(keypath, System.IO.FileMode.Open)
        Dim r As New System.IO.BinaryReader(fs)
        Dim rsa As New RSACryptoServiceProvider
        rsa.FromXmlString(r.ReadString())
        Return rsa
      Finally
        If Not fs Is Nothing Then fs.Close()
      End Try
    End If
    Return Nothing
  End Function

  Private Shared Function ReadData(ByVal path As String) As Object
    If System.IO.File.Exists(path) Then
      Dim fs As System.IO.FileStream = Nothing
      Try
        fs = New System.IO.FileStream(path, System.IO.FileMode.Open)
        Dim bf As New System.Runtime.Serialization.Formatters.Binary.BinaryFormatter
        Return bf.Deserialize(fs)
      Finally
        If Not fs Is Nothing Then fs.Close()
      End Try
    End If
    Return Nothing
  End Function

  Private Shared Sub WriteRsa(ByVal keypath As String, ByVal rsa As RSACryptoServiceProvider)
    Dim fs As New System.IO.FileStream(keypath, System.IO.FileMode.Create)
    Dim w As New System.IO.BinaryWriter(fs)
    w.Write(rsa.ToXmlString(True))
    w.Flush()
    fs.Close()
  End Sub

  Private Shared Sub WriteData(ByVal path As String, ByVal rsa As RSACryptoServiceProvider, ByVal data As Object)
    Dim fs As New System.IO.FileStream(path, System.IO.FileMode.Create)
    Dim bf As New System.Runtime.Serialization.Formatters.Binary.BinaryFormatter
    Dim en As New LargeEncryptedObject(data, rsa.ToXmlString(False))
    bf.Serialize(fs, en)
    fs.Close()
  End Sub

  Private Shared Sub CacheNewCustomerList(ByVal ds As DataSet)
    If Not Utilities.IsCurrentDriveNetworked Then
      Dim path As String : If System.Deployment.Application.ApplicationDeployment.IsNetworkDeployed Then path = System.IO.Path.Combine(System.Deployment.Application.ApplicationDeployment.CurrentDeployment.DataDirectory, Constants.CUSTOMERLIST_CACHE) Else path = Constants.CUSTOMERLIST_CACHE
      Dim keypath As String = path & Constants.CUSTOMERLIST_CACHE_KEY

      ' Generate a new key pair.
      Dim rsa As New RSACryptoServiceProvider
      ' Write the full key information to the hard drive.
      WriteRsa(keypath, rsa)
      WriteData(path, rsa, ds.Tables("Table"))
    End If
  End Sub
  Private Shared Sub CacheCustomerList(ByVal cbCustDS As DataSet)
    Dim update As Boolean
    Dim ds As DataSet = db.displayCustomerList

    If ds.Tables("Table").Columns.Count <> cbCustDS.Tables("Table").Columns.Count Then update = True
    If Not update AndAlso ds.Tables("Table").Rows.Count <> cbCustDS.Tables("Table").Rows.Count - 1 Then update = True
    If Not update Then
      For i As Integer = 0 To ds.Tables("Table").Rows.Count - 1
        For j As Integer = 0 To ds.Tables("Table").Columns.Count - 1
          If ds.Tables("Table").Rows(i)(j) <> cbCustDS.Tables("Table").Rows(i + 1)(j) Then
            update = True
            Exit For
          End If
        Next
        If update Then Exit For
      Next
    End If

    If update Then
      CacheNewCustomerList(ds)
      SetUpCustomerList(ds)
      SyncLock cbCustListLock
        For Each cb As CbCust In cbCustList
          cb.UpdateCbCustDatasource(ds)
        Next
        ' swap datatable into cbCustDS
        cbCustDS.Tables.RemoveAt(0)
        Dim dt As DataTable = ds.Tables("Table")
        ds.Tables.Remove(dt)
        cbCustDS.Tables.Add(dt)
      End SyncLock
    End If
  End Sub
  Private Shared Sub StartCacheCustomerList(ByVal cbCustDS As DataSet)
    Dim t As New Thread(AddressOf CacheCustomerList)
    t.IsBackground = True
    t.Priority = ThreadPriority.Lowest
    t.Start(cbCustDS)
  End Sub

  Private Delegate Sub UpdateCbCustDatasource_Delegate(ByVal ds As DataSet)
  Private Sub UpdateCbCustDatasource(ByVal ds As DataSet)
    If Me.InvokeRequired Then
      Me.Invoke(New UpdateCbCustDatasource_Delegate(AddressOf UpdateCbCustDatasource), ds)
    Else
      ' backup
      Dim txt As String = Me.Text
      Dim selstart As Integer = Me.SelectionStart
      Dim sellength As Integer = Me.SelectionLength

      ' create
      Dim dt As DataTable = ds.Tables("Table").Copy
      dt.DefaultView.RowFilter = CType(Me.DataSource, DataView).RowFilter

      '' insert the blank row at top
      'Dim dr As DataRow = dt.NewRow
      'dr.ItemArray = CType(Me.DataSource, DataView).Table.Rows(0).ItemArray
      'dt.Rows.InsertAt(dr, 0)

      ' restore
      Me.DataSource = dt.DefaultView
      Me.ShowActiveOnly(_showactiveonly)
      Me.Text = txt
      Me.SelectionStart = selstart
      Me.SelectionLength = sellength
    End If
  End Sub

  Public Sub ShowActiveOnly(ByVal active As Boolean)
    _showactiveonly = active
    If Not Me.DataSource Is Nothing Then CType(Me.DataSource, System.Data.DataView).RowFilter = IIf(active, "rmdel = 'A'", "")
  End Sub

  Public Property GetCust() As String
    Get
      Dim cust As String
      If Me.SelectedIndex >= 0 Then
        cust = Utilities.GetString(Me.SelectedValue)
      ElseIf _salesmen.Count = 0 Then
        cust = Me.Text
      Else
        cust = String.Empty
      End If
      Return cust
    End Get
    Set(ByVal value As String)
      'Me.DroppedDown = True   ' REQUIRED to make things work.... not sure why -- Jiong
      Me.SelectedIndex = -1
      'If Me.SelectedIndex < 0 Then
      Me.Text = value
      'End If
      Me.SelectedValue = value
    End Set
  End Property

  Public ReadOnly Property GetName() As String
    Get
      If SelectedIndex >= 0 AndAlso GetCust <> String.Empty Then
        For Each dr As DataRowView In Items
          If Not IsDBNull(dr(ValueMember)) AndAlso dr(ValueMember) = SelectedValue Then
            Dim retval As String = dr(DisplayMember)
            If retval.EndsWith(")") Then
              Dim lastopen As Integer = retval.LastIndexOf("(")
              If lastopen >= 0 Then retval = retval.Substring(0, lastopen).Trim
            ElseIf retval.Contains(" = ") Then
              Dim lastopen As Integer = retval.LastIndexOf(" = ")
              If lastopen >= 0 Then retval = retval.Substring(0, lastopen).Trim
            End If
            Return retval
          End If
        Next
      End If
      Return String.Empty
    End Get
  End Property

  Private Sub cbCust_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Me.TextChanged
    _custchanged = True
  End Sub
  Private Sub cbCust_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Me.SelectedIndexChanged
    _custchanged = False
  End Sub

  Private Sub cbCust_KeyDown(ByVal sender As System.Object, ByVal e As KeyEventArgs) Handles Me.KeyDown
    If e.KeyCode = Keys.Enter Then
      cbCust_LostFocus(sender, e)
      Me.SelectionLength = Me.Text.Length
      e.SuppressKeyPress = True
      e.Handled = True
    End If
  End Sub
  Private Sub cbCust_LostFocus(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Me.LostFocus
    If _custchanged Then
      _custchanged = False
      If Me.Text <> String.Empty Then Me.SelectedValue = Me.Text
    End If
  End Sub

  Public Sub AddSalesman(ByVal slsm As String)
    _salesmen.Add(slsm)
    Dim str As String = ""
    For Each slsm In _salesmen
      str &= IIf(str = "", "", ",") & slsm
    Next
    CType(Me.DataSource, DataTable).DefaultView.RowFilter = "rmsmno in (" & str & ")"
    CType(Me.DataSource, DataTable).Rows(0)("rmsmno") = slsm
  End Sub
  Public Sub AddSalesman(ByVal slsmlist As List(Of String))
    _salesmen.AddRange(slsmlist)
    Dim str As String = "", slsm
    For Each slsm In _salesmen
      str &= IIf(str = "", "", ",") & slsm
    Next
    CType(Me.DataSource, DataTable).DefaultView.RowFilter = "rmsmno in (" & str & ")"
    If _salesmen.Count > 0 Then CType(Me.DataSource, DataTable).Rows(0)("rmsmno") = _salesmen(0)
  End Sub

  Protected Overrides Sub OnPaint(ByVal e As PaintEventArgs)
    MyBase.OnPaint(e)
    Dim borderWidth As Integer = 1
    Dim borderColor As Color = Color.Blue
    ControlPaint.DrawBorder(e.Graphics, e.ClipRectangle, borderColor, borderWidth, ButtonBorderStyle.Solid, borderColor, borderWidth, ButtonBorderStyle.Solid, borderColor, borderWidth, ButtonBorderStyle.Solid, borderColor, borderWidth, ButtonBorderStyle.Solid)
  End Sub

End Class

Open in new window

0
 
LVL 7

Expert Comment

by:rogerard
ID: 34114332
Here is some code I found that will probably help.  Scrap what I've given you so far.  I think the part of the code for drawborder is what you're looking for.

http://www.codeproject.com/KB/cpp/flatcombobox.aspx

How this person controlled the painting was to use a timer and updating the state to trigger refreshing (via invalidation) when needed.
0
 
LVL 9

Author Comment

by:wellhole
ID: 34114524
That's way too complicated for what I'm trying to accomplish. I figured it out myself with some guess work.

Just had to replace WM_NCPAINT with WM_PAINT, and run MyBase.WndProc(m) first.

  Declare Function GetWindowDC Lib "user32" Alias "GetWindowDC" (ByVal hwnd As IntPtr) As IntPtr

  Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)
    MyBase.WndProc(m)

    Const WM_PAINT As Integer = &HF

    Select Case m.Msg
      Case WM_PAINT
        Dim hdc As IntPtr = GetWindowDC(m.HWnd)
        Dim g As Graphics = Graphics.FromHdc(hdc)
        Dim p As New Pen(Color.Red, 4)
        g.DrawRectangle(p, Me.ClientRectangle)
    End Select
  End Sub

Open in new window

0
 
LVL 86

Accepted Solution

by:
Mike Tomlinson earned 400 total points
ID: 34116661
You're causing DC memory leaks with your code...which can affect the ENTIRE operating system rather quickly.

See GetWindowDC():
http://msdn.microsoft.com/en-us/library/dd144947(VS.85).aspx

    "After painting is complete, the ReleaseDC function must be called to release the device context. Not releasing the window device context has serious effects on painting requested by applications."

So you need to release "hdc" using ReleaseDC() as this is an un-managed resource being manually created by you.
ReleaseDC(): http://msdn.microsoft.com/en-us/library/dd162920(VS.85).aspx

Similarly, you should be calling "g.Dispose()".

See Graphics.FromHdc():
http://msdn.microsoft.com/en-us/library/20tc8e3b.aspx

    "You should always call the Dispose method to release the Graphics and related resources created by the FromHdc method."
0
 
LVL 9

Author Closing Comment

by:wellhole
ID: 34121482
Good catch.
0

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

In my previous two articles we discussed Binary Serialization (http://www.experts-exchange.com/A_4362.html) and XML Serialization (http://www.experts-exchange.com/A_4425.html). In this article we will try to know more about SOAP (Simple Object Acces…
Today I had a very interesting conundrum that had to get solved quickly. Needless to say, it wasn't resolved quickly because when we needed it we were very rushed, but as soon as the conference call was over and I took a step back I saw the correct …
This is a high-level webinar that covers the history of enterprise open source database use. It addresses both the advantages companies see in using open source database technologies, as well as the fears and reservations they might have. In this…
There's a multitude of different network monitoring solutions out there, and you're probably wondering what makes NetCrunch so special. It's completely agentless, but does let you create an agent, if you desire. It offers powerful scalability …

726 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question