The effect is as follows:
The source code is as follows:
'********************************************************** *********************************************************** ************************************ The DataGrid column style, display Website type, link '************************************************************* *********************************************************** ************************************************************************** Public Class FiveColumn_Style2 Inherits DataGridColumnstyle
Private xMargin As Integer = 2 Private yMargin As Integer = 2 Private CurrentRow As Integer = -1 'for datagrid_mousemove event, causing the updated label' '' '' '' '' '' 'desired control Private WithEvents m_Label As LinkLabel 'show link' Private WithEvents Pic_Favorite As PictureBox 'favorites over whether to join the show' Private WithEvents Pic_State As PictureBox 'shows whether the play opened Private WithEvents Pic_Analize As PictureBox' '' '' '' '' '' 'picture Private Image_Favorite_true needed As Image Private Image_Favorite_false As Image Private Image_State_true As Image Private Image_State_false As Image Private Image_State_unknow As Image Private Image_Analize_true As Image Private Image_Analize_false As Image
Public WriteOnly Property SetPath_Favorite_true () As String Set (ByVal Path As String) '' read the image Image_Favorite_true = Image.FromFile (Path) End Set End Property Public WriteOnly Property SetPath_Favorite_false () As String Set (ByVal Path As String) Image_Favorite_false = Image .FromFile (Path) End Set End Property Public WriteOnly Property SetPath_State_true () As String Set (ByVal Value As String) Image_State_true = Image.FromFile (Value) End Set End Property Public WriteOnly Property SetPath_State_false () As String Set (ByVal Value As String ) Image_State_false = Image.FromFile (Value) End Set End Property Public WriteOnly Property SetPath_State_unknow () As String Set (ByVal Value As String) Image_State_unknow = Image.FromFile (Value) End Set End Property Public WriteOnly Property SetPath_Analize_true () As String Set (ByVal Value As String) Image_Analize_true = Image.FromFile (Value) End Set End Property Public WriteOnly Property SetPath_Analize_false () As String Set (ByVal Value As String) Image_Analize_false = Image.FromFile ( Value) End Set End Property 'text required prompt Private ServerToolTip As ToolTip' display server information Private TopicToolTip As ToolTip 'summary information' Private ContentToolTip As ToolTip 'information content' prompt text Private m_tipstr As String = ""
Private WithEvents m_datagrid As DataGrid 'Private m_CurrentRow As Integer = -1' for datagrid_mouseup event, after a selected row causes discoloration Private ImagePath As String = Application.StartupPath 'shows the results of the analysis Private WithEvents m_tootip As Form2' provided when the user clicks the current Datagird current Private Sub SetCurrentRowNum (ByVal Value As Integer) Me.CurrentRow = Value If Me.CurrentRow <0 Then m_Label.Visible = False Me.Pic_Analize.Visible = False End If End Sub 'initialization Sub New () Me.CurrentRow = -1 m_Label = New LinkLabel () m_Label.Font = New Font ( "Arial", 9, FontStyle.Regular) m_Label.Text = "" m_Label.Visible = False m_Label.TextAlign = ContentAlignment.TopLeft m_Label.Height = 10 Me.Pic_Analize = New picturebox () pic_analize.sizemode = PictureBoxSizeMode.stretchiMage Pic_analize.cursor = Cursors.hand Pic_anali Ze.size = me.imagesize me.pic_analize.visible = false
ServerTooltip = new tooltip () Topictooltip = new tooltip ()
'M_tootip = New Form2 () End Sub' click on a holiday chain, open url Private Sub Label_LinkClicked (ByVal sender As Object, ByVal e As System.Windows.Forms.LinkLabelLinkClickedEventArgs) Handles m_Label.LinkClicked Dim myproc As System.Diagnostics. Process myproc = new system.diagnostics.process () MyProc.Start ("IExplore.exe", M_Label.tag) End Sub '---------------------- ------------------------------ 'Method in inheriting from the DataGridColumnStyle class "--------- -------------------------------------------- Protected Overloads overrides Sub Abort (ByVal RowNum As Integer) End Sub 'accept changes Protected Overloads Overrides Function Commit (ByVal DataSource As CurrencyManager, _ ByVal RowNum As Integer) As Boolean End Function' focus away Protected Overloads Overrides Sub ConcedeFocus () End Sub 'edit a cell Protected Overloads overrides sub Edit (Byval Source A s CurrencyManager, _ ByVal Rownum As Integer, _ ByVal Bounds As Rectangle, _ ByVal [ReadOnly] As Boolean, _ ByVal InstantText As String, _ ByVal CellIsVisible As Boolean) End SubProtected Overloads Overrides Function GetMinimumHeight () As Integer
End Function Protected GetPreferredHeight (Byval Value As Object) AS Integer Dim NewlineIndex as Integer = 0 DIM Newlines as INTEGER = 0 TRY
Dim ValueString As String = Me.GetText (Value) Do While NewLineIndex <> -1 NewLineIndex = ValueString.IndexOf ( "r / n", NewLineIndex 1) NewLines = 1 End While Loop Catch es As Exception End Try Return FontHeight * newLines yMargin End Function Protected Overloads Overrides Function GetPreferredSize (ByVal g As Graphics, _ ByVal Value As Object) As Size Dim Extents As Size Try Extents = System.Drawing.Size.Ceiling (g.MeasureString (GetText (Value), _ Me .DataGridtablestyle.DataGrid.font) Extents.width = xmargin * 2 DataGridTableGridLineWidth Extents.Height = YMARGIN CATCH ES AS EXTTY TRY RETURN End Function Protected Overloads Overrides Sub Paint (ByVal g As Graphics, _ ByVal Bounds As Rectangle, ByVal Source As CurrencyManager, _ ByVal RowNum As Integer _) from Paint 'and bottom cells (g, Bounds, Source, RowNum, False) End Sub Private const Botton As Integer = 2 'Three Small Icon Intervals Private Const Intnear As INTEGER = 3' Image Size Imagesize As New Size (13, 13) 'Text Different lines Display Private const rowdisplay as integer = 3'
Text branch Private Function TextMuiltilize (ByVal str As String, ByRef g As Graphics) As String If g Is Nothing Then Exit Function If str = "" Then Exit Function Dim newstr As String Dim tmpStr As String 'assume we are using same fonts Dim Font as system.drawing.font = new font ("Song Body", 9) DIM I as integer = 0 'we want to measure the width of string Byte by byte in case we found' Double Bytes Characters. If We Find It Has Reached The Right Bounds, We 'Append a Line Break do while str.length> 0 DO if str.length <= 0 THEN EXIT DO END IF G.MEASURESTRING (Tmpstr & Left (STR, 1), FONT) .WIDTH> = (Me.Width - 1) THEN EXIT Do End if Tmpstr = Tmpstr & Left (STR, 1) Str = Str.Substring (1) Loop if newstr = "" "the newstr = tmpstr else newstr = newstr & vbcrf & tmpstr END IF i = i 1 if I> = rowdisplay the 'ife there is a fouth line, we move, we move, we move, we move Str.Length> 0 Then str = Right (Tmpstr, 2) & str newstr = left (newstr, len (newstr) - 3) & "..." end if exit do end if tmpstr = "
Loop Return newstr End FunctionPrivate Structure Range_Str Public Range As CharacterRange Public Str As String End Structure 'keyword discoloration Private Sub PaintKeyWord (ByVal newStr As String, ByVal keyword As String, ByVal Bounds As Rectangle, ByVal RowNum As Integer, ByVal dbrush As Brush, ByRef g As Graphics) If newStr = "" Then Exit Sub Try 'and in which the characters stored charactarrange Dim CharRangeList As ArrayList = CreatCRange (newStr, keyword) Dim i As Integer Dim count As Integer If CharRangeList.Count> 32 Then count = 32 Else Count = charrangelist.count endiff arraylist's Range ARRAY DIM CRANGEARRAY (Count - 1) as characterRange for i = 0 to count - 1 CRANGEARRAY (i) = CType (CharrangeList (i), Range_Str) .range Next 'string format Dim stringFormat As New StringFormat stringFormat.SetMeasurableCharacterRanges (CRangeArray) stringFormat.Alignment = StringAlignment.Near stringFormat.LineAlignment = StringAlignment.Near' stringFormat.FormatFlags = StringFormatFlags.MeasureTrailingSpaces
'Defining Fonts Dim Font As System.drawing.Font = New Font ("Song", 9)' Size Dim NewsTrsize As Sizef = G.MeasureString (Newstr, Font) 'The Bounds Dim Boundsf as New Rectanglef is located in New Rectanglef (Bounds.X xMargin, bounds.Y yMargin, newstrsize.Width, newstrsize.Height) 'generated on the respective Region Dim stringRegions CharacterRange bounds on by this method () As Region = g.MeasureCharacterRanges (newStr, font, boundsf StringFormat) Bounds according to each related keyword string, draw a red for i = 0 to stringregions.Length - 1 Dim MeasureRect As Rectanglef = StringRegions (i) .GetBounds (g) DIM m_SIZE As Sizef = g.MeasureString (CType (CharRangeList (i), Range_Str) .Str, font) Dim MymeasureRect As New RectangleF (measureRect.X - 1, measureRect.Y, m_size.Width - m_size.Width * 30/100, m_size.Height - m_size.Height * 20/100) if me.m_datagrid.currentrowindex = row Num Then g.FillRectangle (dbrush, MymeasureRect) Else g.FillRectangle (Brushes.White, MymeasureRect) End If g.DrawString (CType (CharRangeList (i), Range_Str) .Str, font, Brushes.Red, MymeasureRect.X - xMargin , MymeasureRect.Y) Next Catch e As System.Exception Trace.WriteLine ( "ERROR AT KEYWORD RED" & e.ToString) End Try End Sub Private Function CreatCRange (ByVal OriStr As String, ByVal Keyword As String) As ArrayList
Dim myRangeArray As New ArrayList () If OriStr = "" Then Return myRangeArray End If 'scanned text, each character to see whether it exists in the intermediate key, if exit then add Range_Str structure into arraylist to return Dim i As Integer For i = 0 to Oristr.Length - 1 if Keyword.tolower.indexof (Oristr.Chars (i) .tostring.tolower)> = 0 THEN DIM R_S AS NEW RANGE_STR () R_S.Range = New CharacterRange (i, 1) R_S.STR = Oristr.Chars (i) MyRangeArray.add (r_s) end if next return myrangeArray End Function 'URL and three icons between intervals private const urlnear as integer = 35 private const analizenum as integer = 5' Heavy painting main function Protected overloads overrides Sub Paint (Byval Bounds as Rectangle, _ Byval Source As Currencymana ger, _ ByVal RowNum As Integer, _ ByVal AlignToRight As Boolean) 'Videos BACKGROUND Dim dbrush As Brush = New SolidBrush (System.Drawing.Color.FromArgb (CType (230, Byte), CType (236, Byte), CType (238 , Byte))) Dim m_CurrentRow As Integer = Me.m_datagrid.CurrentRowIndex If m_CurrentRow = RowNum Then g.FillRectangle (dbrush, Bounds) Else g.FillRectangle (Brushes.White, Bounds) End If 'custom font Dim font As System.Drawing .Font = new font ("Song", 9) '
Get binding text and distinguish between Dim Text As String = GetText (Source, Rownum)). Replace (VBLF, ") DIM STR () AS String = Microsoft.visualBasic.Split (Text," $ @ ") ' Title and URL must have DIM keyword as string = str (0) .trim 'keyword DIM URL AS STRING' link if str.length> 1 THEN URL = STR (1) .trim end if Dim Content AS String 'Content IF STR .Length> 2 THEN Content = STR (2) .trim end if Dim State as integer = 0 DIM server as string = "" DIM MODIFED AS STRING = "" DIM INALIZEINFO AS STRING = " Possible text assignment if str.length> 3 Then if char.isdigit (Str (3) .trim) Then State = STR (3) .trim else state = 0 end if End ifness = 0 end if end if str.length> 4 THEN Server = Str (4) .trim end ifness = Str (5) .trim end ifness = Str (5) .Trim End ifness = Str.Length> 6 ThenalizeInfo = Str (6) .trim end if str.length> 7 The IF STR (7) .trim = "" "The Boolfavorite = 0 else Boolfavorite = STR (7) .trim end if End if 'calculates the size of the URL DIM TEXTSIZE As Sizef = G.MeasureString (URL, New FONT (" Song ", 9) ) 'Setting your location' '
URL DIM POINT_URL AS New Point (Bounds.x Me.Xmargin, Bounds.y Bounds.Height - Me.Botton - Textsize.Height) '' Content Dim Point_Content As New Point (Bounds.x Me.xmargin, Bounds. Y me.ymargin) 'Favorite Dim Point_favorite as new point (Bounds.x Bounds.width - 3 * (INTNEAR ImageSize.width), Bounds.Y Bounds.Height - Imagesize.Height - Me.Botton) 'State Dim point_state As New Point (Bounds.X Bounds.Width - 2 * (intnear imagesize.Width), bounds.Y Bounds.Height - imagesize.Height - Me.botton)' 'analize Dim point_analize As New Point (Bounds.x Bounds.Width - (intnear imageso.width), Bounds.Y Bounds.height - imagesize.height - me.botton) Dim Newstr AS String = TextMuiftilize (Content, g) 'painting content g.drawstring (Newstr, font, brushes.black, bouss.x me.xmargin, bouss.y me.ymargin) 'Draw key ME.PAINTKEYWORD (Newstr, Keyword, Bo UNDS, ROWNUM, DBRUSH, G) 'When it is not a neutral line, draw image Dimlinefont AS New Font ("Song", 9, FontStyle.underline)' Painting URL 'If the URL is too long DIM NewURL AS STRING DIM URL_WIDTH AS INTEGER = (Me.Width - 3 * (Me.intnear Me.imagesize.Width) - UrlNear) If g.MeasureString (Url, font) .Width> Url_Width Then Dim layoutSize As New SizeF (Url_Width, TextSize.Height) Dim newStringFormat As new stringformat () 'measure string.'
Dim charactersFitted As obtain the number of characters within bounds Integer 'to obtain the number of rows of characters Dim linesFilled As Integer Dim stringSize As SizeF = g.MeasureString (Url, font, layoutSize, newStringFormat, charactersFitted, linesFilled) NewUrl = Url.Substring within bounds ( 0, charactersFitted) & "..." Else newUrl = Url End If Dim url_format As New StringFormat () url_format.HotkeyPrefix = Drawing.Text.HotkeyPrefix.Show g.DrawString (newUrl, lineFont, Brushes.Blue, point_url.X, Point_URL.Y, URL_FORMAT) 'Painting Results Analysis
If AnalizeInfo.Length> AnalizeNum Then 'g.DrawImage (Me.Image_Analize_false, point_analize.X, point_analize.Y, imagesize.Width, imagesize.Height)' Else g.DrawImage (Me.Image_Analize_true, point_analize.X, point_analize.Y, Imagesize.width, imagesize.height) Endix
'Videos state If State = 0 Then g.DrawImage (Me.Image_State_false, point_state.X, point_state.Y, imagesize.Width, imagesize.Height) ElseIf State = 1 Then g.DrawImage (Me.Image_State_true, point_state.X, point_state Else G.drawImage (me.image_state_unknow, point_state.x, point_state.y, imagesize.width, imagesize.height) endiff
'Videos favorite If BoolFavorite = 0 Then' g.DrawImage (Me.Image_Favorite_false, point_favorite.X, point_favorite.Y, imagesize.Width, imagesize.Height) Else g.DrawImage (Me.Image_Favorite_true, point_favorite.X, point_favorite.Y, Imagesize.width, image, hood .Drawing.color.fromargb (ctype (230, byte), ctype (236, byte), ctype (238, byte) Else m_label.backcolor = color.White end if '' for linkLabel setting bounds m_label.tag = url m_label .Text = newURL 'Sets the location and size of Label display and size DIM URLSIZE AS SIZEF = G.MeasureString (NewURL, New Font ("Song", 9)) M_Label.SetBounds (Point_url.x, Point_URL.Y, URLSIZE.WIDTH 2, urlsize.height) m_label.visible = true '' Set whether the Bounds '' '' of the Picture control can not start if state = 0 Then ServerTooltip.removeAll () Else Me.m_tipstr = "Server Type:" & Server & vbCrLf & "last updated:" & Modifed ServerToolTip.SetToolTip (m_Label, Me.m_tipstr) End If
'Set bounds picturebox results of the analysis of' no result 'If you do not have the page analysis does not display pictures If AnalizeInfo.Length> AnalizeNum Then Me.Pic_Analize.Image = Me.Image_Analize_true Me.Pic_Analize.Enabled = True Me.Pic_Analize.Tag = AnalizeInfo Me.m_tipstr = "view summary" TopicToolTip.SetToolTip (Pic_Analize, Me.m_tipstr) Me.Pic_Analize.Visible = True Else Me.Pic_Analize.Visible = False End If Me.Pic_Analize.SetBounds (point_analize.X, point_analize.Y, imagesize .Width, imagesize.height) endiff If the location of Label is not the current line, don't display label if m_datagrid.hittest (m_label.location ).Row <> currentrow life m_label.visible = false me.pic_analize.visible = false End IFEND Sub Protected Overloads Sub Paint (Byvalg As Graphics, _ Byva L Bounds as Rectangle, _ byval source as currencymanager, _ byval rush as brush, _ byval forebrush as brrs, _ byval alignight as boolean
Paint (G, Bounds, Source, Rownum, False) End Sub
Protected Overloads Overrides Sub SetDataGridInColumn (ByVal Value As DataGrid) MyBase.SetDataGridInColumn (Value) 'is added as linklabel datagrid child controls Value.Controls.Add (m_Label) Value.Controls.Add (Me.Pic_Analize)' Value.Controls.Add ( Me.Pic_State) 'reference datagrid Me.m_datagrid = Value End Sub Protected Overloads Overrides Sub UpdateUI (ByVal Source As CurrencyManager, _ ByVal RowNum As Integer, ByVal InstantText As String) End Sub Private ReadOnly Property DataGridTableGridLineWidth () As Integer Get If Me. DataGridTableStyle.GridLineStyle = DataGridLineStyle.Solid Then Return 1 Else Return 0 End text If End get End Property 'bound data source obtained a row of a column Private Function GetText (ByVal Value As Object) As String If Value is System. DBNULL.VALUE THEN R ETURN NULLTEXT IF NOT VALUE IS NOTHING THEN RETURUE.TOSTRING ELSE RETURN STRING.EMPTY END If End Function 'Record Ratio Value PRIVATE OLDROWNUM AS INTEGER = -1' In the mousemove event, the current line is triggered, and the OLD line paint Private Sub m_datagrid_MouseMove (ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles m_datagrid.MouseMove 'lives if the form is not active form, do not move If not (Form.ActiveForm is m_datagrid.FindForm) Then EXIT SUB END IF 'Gets Row and Column Valid.hittestinfo =
m_datagrid.HitTest (m_datagrid.PointToClient (m_datagrid.MousePosition)) 'Set the current line Me.SetCurrentRowNum (hittest.Row) End Sub' when clicking on the label, but also needs to change color Private Sub Label_MouseDown (ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles m_Label.MouseDown, Pic_Analize.MouseDown Dim hittest As DataGrid.HitTestInfo = m_datagrid.HitTest (m_datagrid.PointToClient (m_datagrid.MousePosition)) If hittest.Row> = 0 Then Me.m_datagrid.CurrentRowIndex = Hittest.row end if 'refreshes the entire Grid, -------------------- Reserved, can be changed to refresh cell m_datagrid.refresh () end SUB
Private Sub m_datagrid_DataSourceChanged (ByVal sender As Object, ByVal e As System.EventArgs) Handles m_datagrid.DataSourceChanged m_Label.Visible = False Me.Pic_Analize.Visible = False End Sub Private Sub m_tootip_Deactivate (ByVal sender As Object, ByVal e As System.EventArgs) Handles m_tootip.deactivate if not (m_tootip.isdisposed) THEN M_TOOTIP.CLOSE () end if me.m_label.Findform.Activate () m_datagrid.focus () End Sub
PRIVATE SUB FIVECOLUMN_STYLE2_WIDTHCHANGED (Byval e as system.eventargs) Handles mybase.widthchanged me.m_label.visible = false me.pic_analize.visible = false End Sub
Private Sub Pic_Analize_MouseEnter (ByVal sender As Object, ByVal e As System.EventArgs) Handles Pic_Analize.MouseEnter If IsNothing (m_tootip) Then ElseIf m_tootip.IsDisposed Then Else Exit Sub End If m_tootip = New Form2 () Dim PicLocate As Point = New Point ( m_datagrid.MousePosition.X Pic_Analize.Width, m_datagrid.MousePosition.Y Pic_Analize.Height) m_tootip.Location = New Point (PicLocate.X - m_tootip.Width, PicLocate.Y - m_tootip.Height) m_tootip.SetText = Pic_Analize.Tag m_tootip.Show () AddHandler m_tootip.PctBack.MouseLeave, AddressOf m_tootip_MouseLeave End SubPrivate Sub m_tootip_MouseLeave (ByVal sender As Object, ByVal e As System.EventArgs) 'Handles m_tootip.MouseLeave Dim rect As Rectangle = (New Rectangle (m_tootip.Location, m_tootip .Size)) ife 'donothing Else if not (m_tootip.isdisposed) THEN
M_tootip.close () end if end if me.m_label.form.activate () m_datagrid.focus () End Sub
END CLASS
Subsequent test program code. . .
