Solved

Drawing border on combobox

Posted on 2010-11-10
11
1,855 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
  • 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
 
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
What Should I Do With This Threat Intelligence?

Are you wondering if you actually need threat intelligence? The answer is yes. We explain the basics for creating useful threat intelligence.

 
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 85

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

How to improve team productivity

Quip adds documents, spreadsheets, and tasklists to your Slack experience
- Elevate ideas to Quip docs
- Share Quip docs in Slack
- Get notified of changes to your docs
- Available on iOS/Android/Desktop/Web
- Online/Offline

Join & Write a Comment

Welcome my friends to the second instalment and follow-up to our Minify and Concatenate Your Scripts and Stylesheets (http://www.experts-exchange.com/Programming/Languages/.NET/ASP.NET/A_4334-Minify-and-Concatenate-Your-Scripts-and-Stylesheets.html)…
This article describes relatively difficult and non-obvious issues that are likely to arise when creating COM class in Visual Studio and deploying it by professional MSI-authoring tools. It is assumed that the reader is already familiar with the cla…
In this seventh video of the Xpdf series, we discuss and demonstrate the PDFfonts utility, which lists all the fonts used in a PDF file. It does this via a command line interface, making it suitable for use in programs, scripts, batch files — any pl…
This video gives you a great overview about bandwidth monitoring with SNMP and WMI with our network monitoring solution PRTG Network Monitor (https://www.paessler.com/prtg). If you're looking for how to monitor bandwidth using netflow or packet s…

706 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

Need Help in Real-Time?

Connect with top rated Experts

14 Experts available now in Live!

Get 1:1 Help Now