Imports C1.Win.C1TrueDBGrid Imports System Imports System.Data Imports System.Data.SqlTypes Imports System.Data.SqlClient Namespace TKB.VV.Utils Public Class clsToolTips Public WithEvents MyTooltip As New ToolTip Dim ToolTipData As DataSet = Globals.ToolTipDaten Dim connection As New SqlConnection() Dim da As New SqlDataAdapter("", connection) Dim l As New List(Of Control) Dim WithEvents evh As MyGenericEventHandler = Globals.MyEventHanlder Public Function Edit_ToolTips(ByRef frm As Form, ByRef ctlcol As Collection) Me.Load_Data() l.Clear() Me.GetControl(frm, "*", l) For Each s As Control In l Try MyTooltip.SetToolTip(s, frm.Name + "|" + s.Name) MyTooltip.Tag = frm.Name Catch ex As Exception MsgBox(ex.Message) End Try Next 'For Each ctl As Control In ctlcol ' Try ' MyTooltip.SetToolTip(ctl, "SetToolTip") ' MyTooltip.Tag = frm.Name + "|" + ctl.Name ' Catch ex As Exception ' End Try 'Next End Function Private Sub MyTooltip_Popup(ByVal sender As Object, ByVal e As System.Windows.Forms.PopupEventArgs) Handles MyTooltip.Popup 'MsgBox(e.AssociatedControl.Name) evh.Edit_Tooltip(MyTooltip.Tag, e.AssociatedControl.Name) 'Dim s As String = MyTooltip.Tag 'Dim sp() As String 'sp = s.Split("|") 'evh.Edit_Tooltip(sp(0), sp(1)) End Sub Public Function Set_ToolTips(ByRef frm As Form) Me.Load_Data() 'MyTooltip.ToolTipIcon = ToolTipIcon.Info MyTooltip.IsBalloon = True MyTooltip.UseFading = True MyTooltip.UseAnimation = True Dim dv As New DataView(ToolTipData.Tables(0), "Aktiv = 1 and (Formularname='" & frm.Name & "' or Formularname='Allgemein')", "", DataViewRowState.CurrentRows) For Each dr As DataRowView In dv l.Clear() Me.GetControl(frm, dr.Item("Controlname"), l) Try For Each ctl As Control In l Try MyTooltip.SetToolTip(ctl, dr.Item("ToolTip")) Catch End Try Next Catch ex As Exception End Try Next End Function ''' ''' Daten ab Datenbank laden ''' ''' Private Sub Load_Data() Try If ToolTipData.Tables.Count < 1 Then ToolTipData.Tables.Clear() Else Exit Sub End If Catch ex As Exception End Try ToolTipData.Tables.Clear() Dim sqlcmd As New SqlCommand sqlcmd.CommandText = "dbo.my_tooltip_get_data" 'sqlcmd.Parameters(1).Value = Globals.clsmitarbeiter.iMitarbeiternr.Value sqlcmd.CommandType = CommandType.StoredProcedure sqlcmd.Connection = connection Try connection.ConnectionString = Globals.sConnectionString connection.Open() da.SelectCommand = sqlcmd da.Fill(ToolTipData, "Tooltips") Globals.SecurityDaten.Tables.Add(ToolTipData.Tables(0).Copy) Catch ex As Exception Finally connection.Close() da.Dispose() sqlcmd.Dispose() End Try End Sub #Region "Utils" ''' ''' Sucht in den Base-Controls sämtliche Controls mit dem Namen in "Key" (Wildcards * möglich) und listet ''' die gefundnen Controls in der Liste L zur weiteren Bearbeitung ''' ''' Base-Contrlo (z.B. aktuelles Formular ''' Schlüssel welcher gesucht werden soll ''' Liste der gefundenen Objekte ''' True wenn eines oder mehr Controls gefunden wurden, false wenn kein Control gefunden wurde. ''' ''' Private Function GetControl(ByVal BaseControl As Control, ByVal Key As String, ByRef L As List(Of Control), Optional ByVal ReturnAtFirstElement As Boolean = False) As Boolean If L Is Nothing Then L = New List(Of Control) Dim Gut As Boolean Dim ReturnFlag As Boolean = False If Key IsNot Nothing Then Key = Key.ToLower If BaseControl.HasChildren = True Then For Each ctl As Control In BaseControl.Controls Gut = False If Key Is Nothing Then Gut = True Else If ctl.Name.Length >= Key.Length Then Key = Key.ToLower If Key.StartsWith("*") Then If Key.Substring(1) = ctl.Name.ToLower.Substring(ctl.Name.Length - (Key.Length - 1), Key.Length - 1) Then Gut = True ElseIf Key.EndsWith("*") Then If Key.Substring(0, Key.Length - 1) = ctl.Name.ToLower.Substring(0, Key.Length - 1) Then Gut = True Else If Key = ctl.Name.ToLower Then Gut = True End If End If End If If Gut = True Then L.Add(ctl) If ReturnAtFirstElement = True Then ReturnFlag = True End If If ReturnFlag = False Then Call GetControl(ctl, Key, L) End If Next End If If L.Count - 1 > -1 Then Return True Else Return False End If End Function #End Region End Class End Namespace