Imports DevExpress.XtraGrid.Views.Tile Imports DigitalData.Modules.Database Imports DigitalData.Modules.Logging Public Class ChatControl Private ReadOnly IdColumn As String = "GUID" Private ReadOnly IdentificationColumn As String = "USER_FROM" Private ReadOnly MessageColumn As String = "MESSAGE_TEXT" Private ReadOnly DateColumn As String = "ADDED_WHEN" Private ReadOnly ToUserColumn As String = "TO_USER" Public Delegate Sub ConversationEnded() Public Event Conversation_Ended As ConversationEnded Public Delegate Sub ConversationUsersAdded_Success() Public Event Conversation_UsersAdded_Success As ConversationUsersAdded_Success Private Db As MSSQLServer Private LogConfig As LogConfig Private Logger As Logger Private AddMessage As Boolean Private oAddUSerForm As Form 'Private ReadOnly UsernameColorsDict As New Dictionary(Of String, Color) 'Private ReadOnly UsernameColors As New List(Of Color) From { ' Color.Purple, ' Color.Red, ' Color.LightBlue, ' Color.DarkSeaGreen '} Private IsAssistKeyPressed As Boolean = False Private AssistListBox As ListBox = New ListBox() Public IDBObjectId As Long Public ConnStringIDB As String Public ConversationIdentification As String Public UserID As Long Public Username As String Public User_Language As String Public CurrentConversationID As Long Public CurrentConversation_State As String Public CurrentConversation_UserActive As Boolean Public oDTConv_User As DataTable Public CurrentMentionedUser As String Public CurrentMentionedUserID As Long Public CurrentIdentifier Public User_Datatable_Select As DataTable Public DT_Rights As DataTable Public QU_Conv_End As DataTable Public Sub New() InitializeComponent() End Sub Public Function Init(LogConfig As LogConfig, ConnectionStringIDB As String, ConversationIdentification As String, UserID As Long, Username As String, USER_LANG As String, Qust_Conv_End As DataTable, DTRIGHTS As DataTable) Try CurrentConversationID = 0 Me.LogConfig = LogConfig Me.Logger = LogConfig.GetLogger() Me.ConnStringIDB = ConnectionStringIDB Me.ConversationIdentification = ConversationIdentification Me.UserID = UserID Me.Username = Username Me.User_Language = USER_LANG QU_Conv_End = Qust_Conv_End DT_Rights = DTRIGHTS Me.Db = New MSSQLServer(LogConfig, ConnStringIDB) Return True Catch ex As Exception Logger.Error(ex) Return False End Try End Function Sub Check_Rights() Dim oSQL As String ToolStripMenuItemConv_end.Visible = False tsmenitmHamburger.Visible = False AddMessage = False Dim oView As DataView = New DataView(DT_Rights) oView.RowFilter = "CONF_TITLE = 'CONVERSATION_USER_ACTIVE'" If oView.Count = 1 Then CurrentConversation_UserActive = True Else CurrentConversation_UserActive = False End If For Each oRow As DataRow In DT_Rights.Rows If oRow.Item("CONF_TITLE").ToString.Contains("CONVERSATION_RIGHT") Then Select Case oRow.Item("CONF_VALUE") Case "Start|Stop" ToolStripMenuItemConv_end.Visible = True tsmenitmHamburger.Visible = True AddMessage = True Case "AddMessage" AddMessage = True Case "Admin" ToolStripMenuItemConv_end.Visible = True BenutzerHinzufügenToolStripMenuItem.Visible = True tsmenitmHamburger.Visible = True AddMessage = True Case "Start" BenutzerHinzufügenToolStripMenuItem.Visible = True tsmenitmHamburger.Visible = True Case "Stop" ToolStripMenuItemConv_end.Visible = True End Select ElseIf oRow.Item("CONF_TITLE") = "CONVERSATION_ADD_USER_SELECT" Then oSQL = oRow.Item("CONF_VALUE") oSQL = oSQL.Replace("@CONVID", CurrentConversationID) User_Datatable_Select = Db.GetDatatable(oSQL) Logger.Debug($"User_Datatable_Select [{User_Datatable_Select}]") End If Next If CurrentConversation_State = "Started" Then pnlMessage.Visible = AddMessage Else pnlMessage.Visible = False tsmenitmHamburger.Visible = False End If End Sub Public Function GetConversations(IDBObjectId As Long) CurrentConversationID = 0 Dim oSQL As String = $"SELECT DISTINCT T.CONVERSATION_ID,T.TITLE,T.CONVERSATION_STATE,T.ADDED_WHEN FROM VWIDB_CONVERSATION T INNER JOIN VWIDB_CONVERSATION_USER T1 ON T.CONVERSATION_ID = T1.CONV_ID WHERE IDB_OBJ_ID = {IDBObjectId} AND T1.USER_ID = {UserID} ORDER BY CONVERSATION_ID DESC" Dim oDatatable As DataTable = Db.GetDatatable(oSQL) Dim oConversations As New List(Of String) If Not IsNothing(oDatatable) Then Dim i = 0 For Each oROW As DataRow In oDatatable.Rows Dim oItem = oROW.Item("CONVERSATION_ID").ToString + "|" + oROW.Item("TITLE").ToString + "|" + oROW.Item("CONVERSATION_STATE").ToString + "|" + oDatatable.Rows(0).Item("ADDED_WHEN").ToString oConversations.Insert(i, oItem) i += 1 If oROW.Item("CONVERSATION_STATE") = "Started" Then If CurrentConversationID = 0 Then CurrentConversationID = oROW.Item("CONVERSATION_ID") LoadConversation(CurrentConversationID) End If End If Next End If Return oConversations End Function Public Sub LoadConversation(ConversationId As Long) ListBoxUserMention.Visible = False RichTextBox1.Text = "" Dim oSQL As String = $"SELECT * FROM VWIDB_CONV_MESSAGES WHERE CONV_ID = {ConversationId} ORDER BY GUID" Dim oDatatable As DataTable = Db.GetDatatable(oSQL) ' BuildUsernameColorDict(oDatatable) oSQL = $"SELECT * FROM VWIDB_CONVERSATION WHERE CONVERSATION_ID = {ConversationId}" Dim oDatatable2 As DataTable = Db.GetDatatable(oSQL) GridChatOld.DataSource = ChatSource GridChat.DataSource = ChatSource ChatSource.DataSource = oDatatable tsmitmTitle.Text = oDatatable2.Rows(0).Item("TITLE") CurrentConversationID = ConversationId CurrentConversation_State = oDatatable2.Rows(0).Item("CONVERSATION_STATE") oSQL = $"SELECT * FROM VWIDB_CONVERSATION_USER WHERE CONV_ID = {ConversationId}" oDTConv_User = Db.GetDatatable(oSQL) If TeilnehmerToolStripMenuItem.HasDropDownItems Then TeilnehmerToolStripMenuItem.DropDownItems.Clear() End If If ConversationIdentification.Contains("@") Then CurrentIdentifier = "EMAIL" Else CurrentIdentifier = "USERNAME" End If AssistListBox.Items.Clear() ListBoxUserMention.Items.Clear() Try For Each oROW As DataRow In oDTConv_User.Rows Dim oConvUser oConvUser = oROW.Item(CurrentIdentifier) If IsDBNull(oConvUser) Then oConvUser = String.Empty End If If oConvUser.ToString = String.Empty Then If CurrentIdentifier = "EMAIL" Then oConvUser = $"No Email for User '{oROW.Item("USERNAME")}'" Else oConvUser = $"No Identification for UserID '{oROW.Item("USER_ID")}'" End If Else ListBoxUserMention.Items.Add("@" & oConvUser.ToString.Substring(0, oConvUser.ToString.IndexOf("@"))) AssistListBox.Items.Add("@" & oConvUser.ToString.Substring(0, oConvUser.ToString.IndexOf("@"))) End If Dim oToolStripItem As ToolStripMenuItem = New ToolStripMenuItem(oConvUser.ToString) TeilnehmerToolStripMenuItem.DropDownItems.Add(oToolStripItem) Next AddHandler AssistListBox.SelectedIndexChanged, AddressOf AssistListBox_Changed Catch ex As Exception MsgBox(ex.Message, MsgBoxStyle.Critical, "Error adding ConversationUsers") End Try Check_Rights() End Sub Public Sub NewMessage(MessageText As String) Try Dim oSQL As String = $"EXEC [PRIDB_NEW_CONVERSATION_MESSAGE] {CurrentConversationID},'{MessageText}', '{ConversationIdentification}', {CurrentMentionedUserID},'{User_Language}'" Logger.Debug($"NewMessageSQL: {oSQL}") Dim oResult = Db.GetScalarValue(oSQL) LoadConversation(CurrentConversationID) RichTextBox1.Text = String.Empty ChatViewOld.MoveLast() ChatView.MoveLast() Catch ex As Exception Logger.Error(ex) End Try End Sub 'Private Sub BuildUsernameColorDict(Datatable As DataTable) ' Dim oIndex = 0 ' UsernameColorsDict.Clear() ' Datatable.AsEnumerable(). ' Select(Function(Row) Row.Item(IdentificationColumn)). ' Distinct().ToList(). ' ForEach(Sub(Name) ' UsernameColorsDict.Add(Name, UsernameColors.Item(oIndex)) ' oIndex += 1 ' End Sub) 'End Sub Private Sub ChatView_CustomItemTemplate(sender As Object, e As TileViewCustomItemTemplateEventArgs) Handles ChatViewOld.CustomItemTemplate Dim oRow As DataRow = ChatViewOld.GetDataRow(e.RowHandle) Dim oIdentification As String = oRow.Item(IdentificationColumn) Dim oToUser = oRow.Item(ToUserColumn) If Not IsDBNull(oToUser) Then e.Template = e.Templates.Item("ChatTo") Else 'If oIdentification = ConversationIdentification Or oIdentification = Username Then ' e.Template = e.Templates.Item("ChatRight") 'Else ' e.Template = e.Templates.Item("ChatLeft") 'End If e.Template = e.Templates.Item("ChatLeft") End If End Sub Private Sub ChatView_ItemCustomize(sender As Object, e As TileViewItemCustomizeEventArgs) Handles ChatViewOld.ItemCustomize Dim oRow As DataRow = ChatViewOld.GetDataRow(e.RowHandle) Dim oUsername As String = oRow.Item(IdentificationColumn) Dim oMessage As String = oRow.Item(MessageColumn) Dim oToUser = oRow.Item(ToUserColumn) ' Dim oColor As Color = UsernameColorsDict.Item(oUsername) If oUsername = ConversationIdentification Or oUsername = Username Then e.Item.AppearanceItem.Normal.BackColor = Color.PaleTurquoise e.Item.Item(IdentificationColumn).Appearance.Normal.ForeColor = Color.Purple Else e.Item.Item(IdentificationColumn).Appearance.Normal.ForeColor = Color.Red End If e.Item.ItemSize = DevExpress.XtraEditors.TileItemSize.Wide End Sub Private Sub SimpleButton1_Click(sender As Object, e As EventArgs) Handles btnSendMessage.Click If RichTextBox1.Text.Count > 0 Then NewMessage(RichTextBox1.Text) End If End Sub Private Sub ToolStripMenuItemConv_end_Click(sender As Object, e As EventArgs) Handles ToolStripMenuItemConv_end.Click If CurrentConversationID <> 0 Then Dim result As MsgBoxResult result = MessageBox.Show(QU_Conv_End.Rows(0).Item("STRING1").ToString, QU_Conv_End.Rows(0).Item("STRING2").ToString, MessageBoxButtons.YesNo, MessageBoxIcon.Exclamation) If result = MsgBoxResult.Yes Then Dim oSQL = $"EXEC PRIDB_END_CONVERSATION {CurrentConversationID}, '{Username}', '{User_Language}'" If Db.ExecuteNonQuery(oSQL) = True Then RaiseEvent Conversation_Ended() Else MsgBox("Unexpected error in PRIDB_END_CONVERSATION - Check Your log!", MsgBoxStyle.Exclamation) End If End If End If End Sub Private Sub BenutzerHinzufügenToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles BenutzerHinzufügenToolStripMenuItem.Click Dim oForm = New Form() Dim oaddUS As ChatAddUser.ChatAddUser = New ChatAddUser.ChatAddUser() oaddUS.Init(LogConfig, ConnStringIDB, CurrentConversationID, Username, User_Language, User_Datatable_Select) oForm.Controls.Add(oaddUS) oaddUS.Dock = DockStyle.Fill oForm.MaximizeBox = False oForm.MinimizeBox = False oForm.FormBorderStyle = FormBorderStyle.FixedDialog oForm.StartPosition = FormStartPosition.CenterScreen oForm.Text = "" AddHandler oaddUS.User_Added, AddressOf onUsersAdded oAddUSerForm = oForm oForm.ShowDialog() End Sub Sub onUsersAdded() RaiseEvent Conversation_UsersAdded_Success() oAddUSerForm.Close() End Sub Private Function GetPoint(ByVal textBoxControl As RichTextBox) As Point Dim graphics_1 As Graphics = Graphics.FromHwnd(textBoxControl.Handle) Dim size As SizeF = graphics_1.MeasureString(textBoxControl.Text.Substring(0, textBoxControl.SelectionStart), textBoxControl.Font) Dim coord As New Point(CInt(size.Width) + textBoxControl.Location.X, CInt(size.Height) + textBoxControl.Location.Y) Return coord End Function Private Sub RichTextBox1_KeyUp(sender As Object, e As KeyEventArgs) Handles RichTextBox1.KeyUp If e.Control And e.KeyCode = Keys.Enter And RichTextBox1.Text.Count > 0 Then NewMessage(RichTextBox1.Text) ElseIf (Keys.Alt AndAlso Keys.Control) And e.KeyCode = keys.Q Then With RichTextBox1 ListBoxUserMention.Left = .GetPositionFromCharIndex(.SelectionStart).X + .Left + 10 ListBoxUserMention.Top = .GetPositionFromCharIndex(.SelectionStart).Y + .Top + 20 ' Jetzt ListBox einblendenden, Focus auf diese setzen ' und den ersten Eintrag selektieren ListBoxUserMention.Visible = True ListBoxUserMention.Focus() ListBoxUserMention.SelectedIndex = 0 End With 'Dim opoint As Point = GetPoint(sender) 'AssistListBox.PointToClient(opoint) 'pnlMessage.Controls.Add(AssistListBox) 'AssistListBox.Show() 'AssistListBox.BringToFront() ' '@ was pressed End If End Sub Sub AssistListBox_Changed() Try RichTextBox1.Text = RichTextBox1.Text + AssistListBox.SelectedItem + ": " RichTextBox1.SelectionFont = New Font("Tahoma", 10, FontStyle.Bold And FontStyle.Underline) RichTextBox1.Text = RichTextBox1.Text.Replace("@@", "@") pnlMessage.Controls.Remove(AssistListBox) 'RichTextBox1.SelectedText = AssistListBox.SelectedItem Catch ex As Exception Logger.Error(ex) End Try End Sub Sub ADD_MentionedUser(pUser As String) Dim oPos As Integer = RichTextBox1.TextLength Dim oUsertext = pUser & ": " With RichTextBox1 .AppendText(Replace(.Text, "@", vbNullString) & oPos) .Select(oPos, oUsertext.Length) .SelectionColor = Color.Blue .Select() End With End Sub Private Sub ListBoxUserMention_KeyUp(sender As Object, e As KeyEventArgs) Handles ListBoxUserMention.KeyUp If e.KeyCode = Keys.Return Then Dim oMentionedUser As String = ListBoxUserMention.SelectedItem 'ADD_MentionedUser(strTag) With RichTextBox1 CUrrentMentionedUser = oMentionedUser ' Logger.Debug($"ListBoxUserMention_KeyUp.CurrentMentionedUser = {CurrentMentionedUser}") For Each oROW As DataRow In oDTConv_User.Rows Dim oConvUser2beChecked oConvUser2beChecked = oROW.Item(CurrentIdentifier) If IsDBNull(oConvUser2beChecked) Then oConvUser2beChecked = String.Empty End If If oConvUser2beChecked.ToString = String.Empty Then If CurrentIdentifier = "EMAIL" Then oConvUser2beChecked = $"No Email for User '{oROW.Item("USERNAME")}'" Else oConvUser2beChecked = $"No Identification for UserID '{oROW.Item("USER_ID")}'" End If End If CurrentMentionedUser = CurrentMentionedUser.Substring(1, CurrentMentionedUser.Length - 1) 'Logger.Debug($"oConvUser2beChecked = {CurrentMentionedUser}") If oConvUser2beChecked.ToString.Contains(CurrentMentionedUser) Then CurrentMentionedUserID = oROW.Item("USER_ID") Logger.Debug($"CurrentMentionedUserID Changed: {CurrentMentionedUserID}") End If Next ' Das "Steuerzeichen" # ersetzen durch einen NullString .Text = Replace(.Text, "@", vbNullString) & oMentionedUser & ": " ' wo soll der Cursor nach dem Einfügen in der RTB stehen? .SelectionStart = .TextLength ' Listbox wieder auf den ersten Eintrag setzen ' und ausblenden ListBoxUserMention.SelectedItem = 0 ListBoxUserMention.Visible = False ' Focus wieder auf RTB setzen .Focus() End With End If End Sub Private Sub ChatView_CustomDrawRowPreview(sender As Object, e As DevExpress.XtraGrid.Views.Base.RowObjectCustomDrawEventArgs) Handles ChatView.CustomDrawRowPreview Dim oRow As DataRow = ChatViewOld.GetDataRow(e.RowHandle) Dim oUsername As String = oRow.Item(IdentificationColumn) Dim oToUser = oRow.Item(ToUserColumn) Dim oIsOwnMessage As Boolean = oUsername = ConversationIdentification Or oUsername = Username ' Eigene Nachrichten If oIsOwnMessage Then e.Appearance.BackColor = Color.White End If ' Andere Nachrichten If Not oIsOwnMessage Then e.Appearance.BackColor = Color.PaleTurquoise End If End Sub Private Sub ChatView_CustomDrawCell(sender As Object, e As DevExpress.XtraGrid.Views.Base.RowCellCustomDrawEventArgs) Handles ChatView.CustomDrawCell Dim oRow As DataRow = ChatViewOld.GetDataRow(e.RowHandle) Dim oUsername As String = oRow.Item(IdentificationColumn) Dim oToUser = oRow.Item(ToUserColumn) Dim oIsOwnMessage As Boolean = oUsername = ConversationIdentification Or oUsername = Username ' Eigene Nachrichten If oIsOwnMessage Then e.Appearance.BackColor = Color.White End If ' Andere Nachrichten If Not oIsOwnMessage Then If Not (IsNothing(oToUser) Or IsDBNull(oToUser)) Then If oToUser = Username Or oToUser = ConversationIdentification Then e.Appearance.BackColor = Color.LightSalmon Else e.Appearance.BackColor = Color.PaleTurquoise End If Else e.Appearance.BackColor = Color.PaleTurquoise End If End If End Sub End Class