CBAM kafka, NCTS Fremd(Tobb), realyhub
This commit is contained in:
@@ -319,4 +319,184 @@ Public Class MyDatagridview
|
||||
End Sub
|
||||
|
||||
|
||||
' ========================================================
|
||||
' ================== COPY/PASTE SUPPORT ==================
|
||||
' ========================================================
|
||||
' Standard: Nur erste Spalte (MRN) befüllen. Auf False setzen, um Blöcke (mehrere Spalten) zuzulassen.
|
||||
<Browsable(True), DefaultValue(True)>
|
||||
Public Property _PasteSingleColumn As Boolean = True
|
||||
|
||||
Protected Overrides Sub OnKeyDown(e As KeyEventArgs)
|
||||
' Strg+V oder Shift+Insert => Einfügen
|
||||
If (e.Control AndAlso e.KeyCode = Keys.V) OrElse (e.Shift AndAlso e.KeyCode = Keys.Insert) Then
|
||||
PasteFromClipboard()
|
||||
e.Handled = True
|
||||
Return
|
||||
End If
|
||||
MyBase.OnKeyDown(e)
|
||||
End Sub
|
||||
|
||||
''' <summary>
|
||||
''' Fügt den Clipboard-Text (Excel: TAB/CRLF) in die DGV ein.
|
||||
''' </summary>
|
||||
Public Sub PasteFromClipboard()
|
||||
Dim text As String = Clipboard.GetText()
|
||||
If String.IsNullOrWhiteSpace(text) Then Exit Sub
|
||||
|
||||
Dim lines = text.Split({vbCrLf, vbLf, vbCr}, StringSplitOptions.None)
|
||||
If lines.Length > 0 AndAlso lines(lines.Length - 1).Trim() = "" Then
|
||||
ReDim Preserve lines(lines.Length - 2)
|
||||
End If
|
||||
If lines.Length = 0 Then Exit Sub
|
||||
|
||||
Dim startRow As Integer = If(Me.CurrentCell IsNot Nothing, Me.CurrentCell.RowIndex, 0)
|
||||
Dim startCol As Integer = If(Me.CurrentCell IsNot Nothing, Me.CurrentCell.ColumnIndex, 0)
|
||||
If startRow < 0 Then startRow = 0
|
||||
If startCol < 0 Then startCol = 0
|
||||
|
||||
' Temporär das „Neue-Zeile“-Verhalten und Binding einfrieren
|
||||
Dim oldAddRows = Me.AllowUserToAddRows
|
||||
Me.AllowUserToAddRows = False
|
||||
Me.SuspendLayout()
|
||||
Dim cm As CurrencyManager = Nothing
|
||||
Try
|
||||
If TypeOf Me.DataSource Is DataTable Then
|
||||
Dim bs As CurrencyManager = TryCast(Me.BindingContext(Me.DataSource), CurrencyManager)
|
||||
cm = bs
|
||||
cm?.SuspendBinding()
|
||||
End If
|
||||
|
||||
For i As Integer = 0 To lines.Length - 1
|
||||
Dim r As Integer = startRow + i
|
||||
Dim rowText As String = lines(i)
|
||||
If String.IsNullOrWhiteSpace(rowText) Then Continue For
|
||||
|
||||
Dim cells = rowText.Split(vbTab)
|
||||
EnsureRowExists(r)
|
||||
|
||||
If _PasteSingleColumn Then
|
||||
Dim targetCol As Integer = 0 ' MRN-Spalte
|
||||
If targetCol >= 0 AndAlso targetCol < Me.Columns.Count Then
|
||||
SetCellValueSafe(r, targetCol, cells(0))
|
||||
End If
|
||||
Else
|
||||
For j As Integer = 0 To cells.Length - 1
|
||||
Dim c As Integer = startCol + j
|
||||
If c >= 0 AndAlso c < Me.Columns.Count Then
|
||||
SetCellValueSafe(r, c, cells(j))
|
||||
End If
|
||||
Next
|
||||
End If
|
||||
Next
|
||||
|
||||
Me.EndEdit() ' Commits pending edits im Grid
|
||||
If TypeOf Me.DataSource Is DataTable Then
|
||||
DirectCast(Me.DataSource, DataTable).AcceptChanges()
|
||||
End If
|
||||
Finally
|
||||
cm?.ResumeBinding()
|
||||
Me.ResumeLayout()
|
||||
Me.AllowUserToAddRows = oldAddRows
|
||||
Me.Refresh()
|
||||
End Try
|
||||
End Sub
|
||||
|
||||
Private Sub SetCellValueSafe(rowIndex As Integer, colIndex As Integer, raw As String)
|
||||
If rowIndex < 0 OrElse rowIndex >= Me.Rows.Count Then Exit Sub
|
||||
Dim col = Me.Columns(colIndex)
|
||||
Dim v As String = If(raw, String.Empty).Trim()
|
||||
|
||||
' Fall A: Datengebunden -> direkt in DataTable schreiben (über DataPropertyName)
|
||||
If TypeOf Me.DataSource Is DataTable Then
|
||||
Dim dt = DirectCast(Me.DataSource, DataTable)
|
||||
Dim prop = If(String.IsNullOrWhiteSpace(col.DataPropertyName), col.Name, col.DataPropertyName)
|
||||
If Not dt.Columns.Contains(prop) Then
|
||||
' Kein gebundenes Feld vorhanden -> fallback auf Zellenwert
|
||||
GoTo FallbackCell
|
||||
End If
|
||||
|
||||
Dim targetType As Type = dt.Columns(prop).DataType
|
||||
Dim obj As Object = DBNull.Value
|
||||
|
||||
Try
|
||||
If targetType Is GetType(String) Then
|
||||
obj = If(v = "", DBNull.Value, CType(v, String))
|
||||
ElseIf targetType Is GetType(Date) OrElse targetType Is GetType(DateTime) Then
|
||||
If v = "" Then
|
||||
obj = DBNull.Value
|
||||
Else
|
||||
Dim d As DateTime
|
||||
obj = If(DateTime.TryParse(v, d), d.Date, CType(v, Object))
|
||||
End If
|
||||
ElseIf targetType Is GetType(Integer) Then
|
||||
Dim n As Integer
|
||||
obj = If(Integer.TryParse(v, n), n, If(v = "", DBNull.Value, CType(v, Object)))
|
||||
ElseIf targetType Is GetType(Decimal) OrElse targetType Is GetType(Double) OrElse targetType Is GetType(Single) Then
|
||||
Dim decv As Decimal
|
||||
obj = If(Decimal.TryParse(v, Globalization.NumberStyles.Any, Globalization.CultureInfo.CurrentCulture, decv),
|
||||
Convert.ChangeType(decv, targetType),
|
||||
If(v = "", DBNull.Value, CType(v, Object)))
|
||||
Else
|
||||
' generischer Versuch
|
||||
obj = If(v = "", DBNull.Value, Convert.ChangeType(v, targetType))
|
||||
End If
|
||||
Catch
|
||||
obj = If(v = "", DBNull.Value, v)
|
||||
End Try
|
||||
|
||||
' DataRow sichern (bei neu erzeugten Zeilen existiert sie sicher)
|
||||
Dim drv As DataRowView = TryCast(Me.Rows(rowIndex).DataBoundItem, DataRowView)
|
||||
If drv IsNot Nothing Then
|
||||
drv(prop) = obj
|
||||
Else
|
||||
' Falls kein DataRowView (unwahrscheinlich): direkt über Index
|
||||
dt.Rows(rowIndex)(prop) = obj
|
||||
End If
|
||||
|
||||
Return
|
||||
End If
|
||||
|
||||
FallbackCell:
|
||||
' Fall B: Ungebunden -> direkt in die Zelle schreiben
|
||||
Dim cell = Me.Rows(rowIndex).Cells(colIndex)
|
||||
If cell Is Nothing OrElse cell.ReadOnly Then Exit Sub
|
||||
|
||||
Try
|
||||
If cell.ValueType Is GetType(Date) OrElse cell.ValueType Is GetType(DateTime) Then
|
||||
If v = "" Then
|
||||
cell.Value = Nothing
|
||||
Else
|
||||
Dim d As DateTime
|
||||
cell.Value = If(DateTime.TryParse(v, d), d.Date, CType(v, Object))
|
||||
End If
|
||||
ElseIf cell.ValueType Is GetType(Integer) Then
|
||||
Dim n As Integer
|
||||
cell.Value = If(Integer.TryParse(v, n), n, If(v = "", Nothing, v))
|
||||
ElseIf cell.ValueType Is GetType(Decimal) OrElse cell.ValueType Is GetType(Double) Then
|
||||
Dim decv As Decimal
|
||||
cell.Value = If(Decimal.TryParse(v, Globalization.NumberStyles.Any, Globalization.CultureInfo.CurrentCulture, decv), decv, If(v = "", Nothing, v))
|
||||
Else
|
||||
cell.Value = If(v = "", Nothing, v)
|
||||
End If
|
||||
Catch
|
||||
cell.Value = If(v = "", Nothing, v)
|
||||
End Try
|
||||
End Sub
|
||||
|
||||
Private Sub EnsureRowExists(targetRow As Integer)
|
||||
If targetRow < Me.Rows.Count Then Exit Sub
|
||||
|
||||
If TypeOf Me.DataSource Is DataTable Then
|
||||
Dim dt = DirectCast(Me.DataSource, DataTable)
|
||||
Do While targetRow >= (If(Me.AllowUserToAddRows, Me.Rows.Count - 1, Me.Rows.Count))
|
||||
dt.Rows.Add(dt.NewRow())
|
||||
Loop
|
||||
Else
|
||||
Do While targetRow >= (If(Me.AllowUserToAddRows, Me.Rows.Count - 1, Me.Rows.Count))
|
||||
Me.Rows.Add()
|
||||
Loop
|
||||
End If
|
||||
End Sub
|
||||
' ========================================================
|
||||
' ========================================================
|
||||
End Class
|
||||
|
||||
Reference in New Issue
Block a user