Bildschirmtastatur fürs eigene Programm

VaporiZed · 10. April 2020, 15:11

Vielleicht sind dann die Forms von @Gathers MetroControls eine Möglichkeit. AFAIK basieren die auf randlosen Forms, die durch zusätzliche Panels eben mit eigener TitleBar und ControlBoxes versehen sind, sodass die nicht mit einer OnTop-Titelleiste arbeiten, sondern diese Titelleiste quasi in dem Form sind.

DerSmurf · 10. April 2020, 16:53

Uff. Dann müsste ich ja sämtliche Forms in meinem Hauptprogramm ändern.
Ich glaube dann rechne ich die Differenz (also das Spaltmaß) prozentual aus.
Dann passt es ja zumindest fast.
Mit dem Restschlitz lebe ich dann erstmal.
Den Rest hebe ich mir dann für ein Update des Programmes auf, wenn's Mal fertig werden sollte.

Dann mache ich mich jetzt Mal an das resizing der Form, bzw.an das verschieben, wenn es überlappt.

DerSmurf · 16. April 2020, 22:53

Huhu
Eine Frage habe ich zu deiner Version der Tastatur:
aus meinem Dim OneThirdDisplay = CInt(Screen.PrimaryScreen.Bounds.Height / 3)
hast du: Dim OneThirdScreenHeight = CInt(Screen.PrimaryScreen.WorkingArea.Height / 3) gemacht.
Mit der Benennung der Variablen gehe ich absolut mit dir, aber - workingarea.height ist doch die Höhe des Screens in Pixeln OHNE Taskleiste.
.Bounds.height ist die Gesamthöhe - also inkl. Taskleiste.

In deiner Version entsteht bei mir am unteren Bildschirmrand ein "Loch" unter der Tastatur - da wo sonst die Taskleiste ist, wenn sie nicht (wie bei mir) oben ist.
Aber auch wenn die Leiste unten ist, soll die Tastatur die Taskleiste ja überdecken.

Edit: bzw. hier:
Me.Top = Screen.PrimaryScreen.WorkingArea.Height - Me.Height
Das bedeutet ja eigentlich: Bildschirmhöhe - Taskleistenhöhe - Formhöhe

Ah Edit:
Habe gerade herausgefunden, dass meine Tastatur die Taskleiste ja garnicht überlappt, sondern darunter verschwindet... also habe ich folgende Lösung:

VB.NET-Quellcode

Public Enum _Location
Top
Bottom
Left
Right
End Enum
Private Function GetTaskbarLocation() As _Location
Dim bounds As Rectangle = Screen.PrimaryScreen.Bounds
Dim working As Rectangle = Screen.PrimaryScreen.WorkingArea
If working.Height < bounds.Height And working.Y > 0 Then
Return _Location.Top
ElseIf working.Height < bounds.Height And working.Y = 0 Then
Return _Location.Bottom
ElseIf working.Width < bounds.Width And working.X > 0 Then
Return _Location.Left
ElseIf working.Width < bounds.Width And working.X = 0 Then
Return _Location.Right
Else
Return Nothing
End If
End Function
Private Sub 123
If Form Is Nothing Then Throw New Exception("Es wurde kein Form als Referenz festgelegt.")
'Position der Taskleiste ermitteln
Dim TaskBarLocation = GetTaskbarLocation()
Dim OneThirdScreenHeight = CInt(Screen.PrimaryScreen.Bounds.Height / 3)
'Größe der Form
Me.Width = Screen.PrimaryScreen.WorkingArea.Width
Me.Height = OneThirdScreenHeight
'Form am unteren Bildschirmrand ausrichten
If TaskBarLocation = _Location.Top Then
Me.Top = Screen.PrimaryScreen.Bounds.Height - Me.Height
Else
Me.Top = Screen.PrimaryScreen.WorkingArea.Height - Me.Height
End If
Me.Left = 0
End Sub

es bleibt also nur noch die Frage, warum bei dir ein drittel der Bildschirmhöhe durch workingarea und nicht durch bounds bestimmt wird.

und noch ein Edit:
Wenn ich die Subform mit angezeigter Tastatur starte, in der Subform die Tastatur beende und wieder anzeige, funktioniert sie nach dem schließen der Subform in der Mainform nicht mehr.
Also es gehen keine Tasten und auch ein beenden über das MenuStrip ist nicht möglich.

DerSmurf · 18. April 2020, 17:32

Ich habe mich gerade auf die Suche nach einer Lösung gemacht, aber klappt nicht.
Wenn ich mir während der Programm den Code in Einzelschritten angucke, passiert genau was soll.
Aber das Keyboard wird nicht geschlossen (obwohl die Passage im Code fehlerfrei durchläuft).
Also hier mal kurz und knapp.
Fehler: unter bestimmten Bedingungen wird das Keyboard in der Mainform zwar angezeigt, reagiert aber nicht (keine Tastenübertragung) und lässt sich nicht schließen
Fehler reproduzieren:
1. in Mainform Tastatur einblenden | 2. Subform starten | 3. Tastatur in SUbform über Menu Strip schließen und wieder öffnen | 4. Subform schließen

Ich habe hier nun keine Ahnung, wie ich das angehen sol, denn wie gesagt der Code im Einzelschritt macht was er soll.
Edit: falls noch jemand außer Vaproized mitmach hier der Link zu Vaporizeds Post, mit aktuellem Programmdownload:
Bildschirmtastatur fürs eigene Programm

VaporiZed · 18. April 2020, 22:07

Sorry, hab den Thread wieder aus den Augen verloren.
Natürlich klappt das nicht. Wenn das Subform das Keyboard aufruft, ist es dessen Eigentümer. Der Eigentümer (Suform) wird geschlossen, ohne aber das Keyboard zu schließen. Dadurch ist das Keyboard nicht mehr codetechnisch (ohne weiteres) ansprechbar, existiert aber noch (Unterschied .Show <-> .ShowDialog). Aber das Keyboard hat nun den Bezugspartner verloren und weiß dann natürlich auch nicht mehr, welche TextBoxen es manipulieren soll. Es wurde ihm ja nix Neues zugewiesen. MainForm kann es aber auch nicht schließen, weil es mit einer eigenen Variable (Keyboard) hantiert, während IsKeyboardLoaded alle Forms nach einem Keyboard durchforstet.

Eine schnelle (wenn auch nicht gerade saubere) Möglichkeit:

VB.NET-Quellcode

Public Shared Sub CreateAndShowKeyboard(ByRef Keyboard As FrmKeyboard, Owner As Form)
If Keyboard.IsDisposed Then Keyboard = New FrmKeyboard
If IsKeyboardLoaded() Then
Application.OpenForms.Cast(Of Form).First(Function(x) x.Name = FrmKeyboard.Name).Close() '<--- neu/Ersatz
Keyboard = New FrmKeyboard
Else
Keyboard.Form = Owner
Keyboard.Show()
End If
End Sub

DerSmurf · 19. April 2020, 09:56

Ok. Das macht Sinn
Aber mit der Code Änderung ist es doch dann nur möglich in der MainForm ein solches verlorenes Keyboard zu schließen. Die Verwendung wäre ja trotzdem nicht möglich.
Es müsste also geschlossen und wieder geöffnet werden.
Ist es da nicht besser beim Schließen der Subform zu prüfen wer der owner des Keyboards ist und ggf. Die MainForm zum owner zu machen?

VaporiZed · 19. April 2020, 10:05

Klar. Wenn Du aus PropKeyboard eine normale Property machst (und diese ggf. noch umbenennst), kannst Du im MainForm auch schreiben:

VB.NET-Quellcode

Using SubForm As New FrmSubForm
Keyboard.Form = SubForm
With SubForm
.Keyboard = Keyboard
.PropShowKeyboard = KeyboardIsShown
.ShowDialog(Me)
Keyboard = .Keyboard
End With
End Using

DerSmurf · 19. April 2020, 11:11

Um das nachzuvollziehen brauche ich das Programm. Habe gerade nur Handy.
Aber ist diese Version nicht auch sauberer?

DerSmurf · 20. April 2020, 16:52

Holladiho.
Habe die Änderungen umgesetzt und alles klappt - aber eine Frage hab ich noch - zur SIcherheit, dass ich alles richtig verstanden habe.
1. Die Property (auskommentiert ist alt, ohne Kommentar ist neu)

Spoiler anzeigen

Soweit klar. Bisher Writeonly - jetzt auch von außerhalb lesbar.

2.Der Aufruf der Subform - ich habe mal in Kommentaren hinter den Code geschrieben, was da passiert (was ich glaube, dass da passiert).
Hier wäre es ein Traum, wenn du mir ein "richtig so", oder ein "hast es immer noch nicht gerafft" hinterlässt.

Spoiler anzeigen

Edit:
und auf die gleiche Weise kann ich ja dann auch das Keyboard an eine SubSubform - also eine Form die durch die SUbform aufgerufen wird - und zurück übergeben :o)

Ahja und noch ein edit zum resizing / verschieben der aufrufenden Form, damit diese das Keyboard nicht überlappt.
Das habe ich alleine hinbekommen, und zwar wie folgt:

Spoiler anzeigen

VB.NET-Quellcode

Private Sub FrmKeyboard_Shown(sender As Object, e As EventArgs) Handles Me.Shown
If Form Is Nothing Then Throw New Exception("Es wurde kein Form als Referenz festgelegt.")
'Position und Höhe der Taskleiste ermitteln
Dim TaskBarLocation = GetTaskbarLocation()
Dim TaskbarHeight = Screen.PrimaryScreen.Bounds.Height - Screen.PrimaryScreen.WorkingArea.Height
Dim OneThirdScreenHeight = CInt(Screen.PrimaryScreen.Bounds.Height / 3)
'Größe der Form
Me.Width = Screen.PrimaryScreen.WorkingArea.Width
Me.Height = OneThirdScreenHeight
'Form am unteren Bildschirmrand ausrichten
If TaskBarLocation = _Location.Top Then
Me.Top = Screen.PrimaryScreen.Bounds.Height - Me.Height
Else
Me.Top = Screen.PrimaryScreen.WorkingArea.Height - Me.Height
End If
Me.Left = 0
'Prüfen ob Tastatur öffnende Form größer ist, als Tastatur
If _Form.Height > OneThirdScreenHeight * 2 Then
'Prüfen ob Form maximiert
If _Form.WindowState = FormWindowState.Maximized Then _Form.WindowState = FormWindowState.Normal
'Form verkleinern
_Form.Height = Screen.PrimaryScreen.Bounds.Height - Me.Height - TaskbarHeight
'Form positionieren
If TaskBarLocation = _Location.Top Then
_Form.Top = Screen.PrimaryScreen.WorkingArea.Height - Me.Height - _Form.Height + TaskbarHeight
Else
_Form.Top = Screen.PrimaryScreen.WorkingArea.Height - Me.Height - _Form.Height
End If
Else
'Prüfen ob Form die Tastatur überlappt
If _Form.Location.Y + _Form.Height > OneThirdScreenHeight * 2 Then
'Form positionieren
If TaskBarLocation = _Location.Top Then
_Form.Top = Screen.PrimaryScreen.WorkingArea.Height - Me.Height - _Form.Height + TaskbarHeight
Else
_Form.Top = Screen.PrimaryScreen.WorkingArea.Height - Me.Height - _Form.Height
End If
End If
End If
End Sub

Das ganze habe ich ins Keyboard Shown Event geschmissen - hier kann ich ja auf die Property Form zugreifen und damit immer die gleiche SUb verwenden, egal, welche Form das Keyboard öffnet.
Dazu nochmal meine Frage von oben.
Bei mir heißt es: Dim OneThirdScreenHeight = CInt(Screen.PrimaryScreen.Bounds.Height / 3)
In deinem Upload nutzt du an dieser Stelle WorkingArea. Warum?

VaporiZed · 20. April 2020, 21:10

Das mit dem Subforming aus dem 2. Codeblock: richtig so!
Das mit dem Resizing: Wenn Du WorkingArea hernimmst, wird eben die Taskleiste immer rausgerechnet. Denn die würde das Keyboard tw. überdecken. Daher dachte ich, dass es sinnvoller wäre, wenn sich Form und Keyboard nur innerhalb der WorkingArea befänden.

DerSmurf · 21. April 2020, 14:18

Ja, ich glaube ich war zu sehr versteift auf mein "drittel des Bildschirms".
Denn ein drittel des Bildschirms ist natürlich Bounds / 3.
Aber letzlich nutze ich ja nicht Bounds - sondern WorkingArea, weil weder Tastatur noch Programm an sich die Taskleiste überdecken.
Also verwende ich ja nicht die tatsächliche Höhe des Bildschirms, sondern dessen Höhe - Taskleistenhöhe.

Es ist alles klar - ich werde die Tastatur ein mein Programm einbauen . und komme der Vollendung immer näher :o)

Also wie immer, vielen, vielen Dank für deine Top Hilfe!

DerSmurf · 23. April 2020, 15:30

Hallo @VaporiZed
Ich habe dieses Thema zwar schon als fertig gemarkert, aber beim einfügen der Tastatur in mein Projekt ergeben sich jetzt doch vorher ungeahnte Problemchen.
Ich fange mal mit dem ersten an:
Ich nutze die Helpers vom @ErfinderDesRades und rufe hiermit eine Subform wie folgt auf:

VB.NET-Quellcode

Private Sub BTNNew_Click(sender As Object, e As EventArgs) Handles BTNNew.Click
PersonBindingSource.EditNew(Of frmEditAddress)
End Sub

Hier schaffe ich es jetzt nicht den Subformaufruf aus unserem Testprojekt einzubauen:

VB.NET-Quellcode

Private Sub SubFormStartenToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles SubFormStartenToolStripMenuItem.Click
Dim KeyboardIsShown = IsKeyboardLoaded()
If KeyboardIsShown Then Keyboard.Close()
Keyboard = New FrmKeyboard
Using SubForm As New FrmSubForm
Keyboard.Form = SubForm
With SubForm
.Keyboard = Keyboard
.PropShowKeyboard = KeyboardIsShown
.ShowDialog(Me)
Keyboard = .Keyboard
End With
End Using
End Sub

Denn ich instanziere die Form ja nicht vor dem anzeigen.
Wie weise ich ihr dann die entsprechenden Eigenschaften zu?

Edit; Hier noch der Code der frmEditAddress

VB.NET-Quellcode

'Es gibt nur zwei Buttons (OK und Cancel - mit entsprechendem Dialog Result), ein Label und TB pro Eintrag im DataSet
Public Class frmEditAddress
Public Property Keyboard As FrmKeyboard
Private ShowKeyboard As Boolean
Public WriteOnly Property PropShowKeyboard As Boolean
Set(NewValue As Boolean)
ShowKeyboard = NewValue
End Set
End Property
Private Sub frmEditAddress_Load(sender As Object, e As EventArgs) Handles MyBase.Load
If ShowKeyboard Then Keyboard.Show()
End Sub
Private Sub BTNShowKeyboard_Click(sender As Object, e As EventArgs) Handles BTNShowKeyboard.Click
FrmMainForm.CreateAndShowKeyboard(Keyboard, Me)
End Sub
Private Sub TextBox_Enter(sender As Object, e As EventArgs) Handles URLTextBox.Enter, StreetTextBox.Enter, PlaceTextBox.Enter, Phone2TextBox.Enter, Phone1TextBox.Enter, NoteTextBox.Enter, Mail2TextBox.Enter, Mail1TextBox.Enter, LastnameTextBox.Enter, FirstnameTextBox.Enter, FaxTextBox.Enter, CustomerNumberTextBox.Enter
Dim FocusedTB = DirectCast(sender, TextBox)
Keyboard.TextBoxToModify = FocusedTB
End Sub
End Class

VaporiZed · 23. April 2020, 16:20

Dann musst Du wohl den dahinterliegenden Code von EditNew herholen und ihn mit Deinem kombinieren. Dieses EditNew ist dafür da, damit man alles mit nur eine Codezeile erledigen kann: SubForm-Aufruf, tDS-Instanz-Weitergabe, Dialoganzeige, Auswertung des DialogResults. Dafür ist aber Dein SubForm nicht ausgelegt bzw. das reicht eben nicht. Der Dialog muss noch modifiziert werden. Daher ist EditNew nicht ausreichend. Keine Ahnung, ob da @ErfinderDesRades ne Überladung hinterlegt hat, welche vor und nach Dialoganzeige noch ne Sub aufrufen kann, welche den Dialog noch modifizieren oder weiter auswerten kann. Ich hatte mir damals bei meinen tDS-Arbeiten sowas gebastelt, aber hier musst Du Dich an EdR wenden oder auf EditNew verzichten.

DerSmurf · 23. April 2020, 22:04

Ganz ehrlich, die helpersdll ist mir zu hoch - ich sehr da nicht durch.
Aber wenn es nicht geht, brauche ich die Form ja nur "normal" Instanzieren, ggf. die Tablerow übergeben und das ganze anzeigen. In der Subform binde ich dann die Labels entsprechend, oder fülle sie halt mit Code und bastel ein bisschen Code hinter den speichern Button.
Das ist lästig (weil mehrere Forms), aber stellt ja ( selbst für mich) kein Problem dar.
Aber ich hoffe einfach, dass sich der @ErfinderDesRades in diesen Thread einklinkt. Denn an so etwas hat er bestimmt gedacht.

ErfinderDesRades · 24. April 2020, 19:24

Jo, in einem anneren Thread bin ich auch drauf gekommen, dass die EditNew(Of T) - Methode schlecht designed ist.
Weil man übergibt ihr kein konkretes Form, sondern nur den Form-Typ - das konkrete Form erstellt die Methode dann selbst.
Mit dem Nachteil, dass der Aufrufer am konkreten Form nix mehr einstellen kann.

Da muss ich mir was für überlegen.

kannst mal probieren diesen Code auszutauschen:

VB.NET-Quellcode

''' <summary> editiert bs.Current im angegebenen Dialog-Form. </summary>
<Extension()>
Public Function EditNew(Of TDialog As {Form, New})(bs As BindingSource) As DialogResult
EnsureValidFKDefaults(bs)
Return EditItem(Of TDialog)(bs, bs.AddNew)
End Function
''' <summary> stellt in den FremdschlüsselSpalten DefaultValues sicher, die auf existierende ParentRows verweisen </summary>
Private Sub EnsureValidFKDefaults(bs As BindingSource)
For Each rl As DataRelation In bs.DataTable.ParentRelations
Dim defaultValues = rl.ParentColumns.Select(Function(clmn) clmn.DefaultValue).ToArray
Dim rwDefaultParent = rl.ParentTable.FindX(rl.ParentColumns, defaultValues)
If rwDefaultParent IsNot Nothing Then Continue For ' es gibt bereits eine Default-ParentRow
rwDefaultParent = rl.ParentTable.All.FirstOrDefault ' ansonsten die nächstbeste
If rwDefaultParent Is Nothing Then Throw New InvalidOperationException("es kann keine gültige Default-ParentRow gefunden werden.")
For i = 0 To rl.ParentColumns.Length - 1
rl.ChildColumns(i).DefaultValue = rwDefaultParent(rl.ParentColumns(i))
Next
Next
End Sub
''' <summary> editiert bs.AddNew im angegebenen Dialog-Form. </summary>
<Extension()>
Public Function EditCurrent(Of TDialog As {Form, New})(bs As BindingSource) As DialogResult
Return EditItem(Of TDialog)(bs, bs.Current)
End Function
Private Function EditItem(Of T As {Form, New})(bs As BindingSource, item As Object) As DialogResult
Dim tb = DirectCast(item, DataRowView).Row.Table
Using frm = New T
tb.DataSet.Register(frm, False)
Dim allCtls = New GetChilds(Of Control)(Function(ctl) ctl.Controls).AllAsList(frm)
Dim bindFlags As BindingFlags = BindingFlags.Instance Or BindingFlags.Public _
Or BindingFlags.NonPublic Or BindingFlags.GetField
For Each ctl In allCtls.Where(Function(c) TypeOf c Is ContainerControl AndAlso TypeOf c Is Form OrElse TypeOf c Is UserControl)
For Each fld In ctl.GetType.GetFields(bindFlags).Where(Function(f) f.FieldType = GetType(BindingSource))
Dim bs2 = DirectCast(fld.GetValue(ctl), BindingSource)
If bs2 Is Nothing Then Continue For
If tb Is bs2.DataTable Then
bs2.DataSource = item
EditItem = frm.ShowDialog()
If EditItem = Windows.Forms.DialogResult.OK Then
bs2.EndEdit()
bs.ResetCurrentItem() 'den von der anneren BS geänderten Datensatz neu einlesen.
Else
bs.CancelEdit()
End If
Exit Function
End If
Next
Next
Throw New Exception("es konnte keine geeignete BindingSource gefunden werden.".And2(
"\nHinweis:",
"\nDie Extension-Method '<BindingSource>.", (New StackTrace).GetFrame(1).GetMethod.Name, "()' funktioniert nur, wenn zuvor",
"\n<", tb.DataSet.GetType.Name, ">.Register(<", GetType(T).Name, ">)",
"\naufgerufen wurde."))
End Using
End Function

durch dieses:

VB.NET-Quellcode

''' <summary> editiert bs.Current im angegebenen Dialog-Form. </summary>
<Extension()>
Public Function EditNew(bs As BindingSource, dlg As Form) As DialogResult
EnsureValidFKDefaults(bs)
Return EditItem(bs, bs.AddNew, dlg)
End Function
''' <summary> editiert bs.Current im angegebenen Dialog-Form. </summary>
<Extension()>
Public Function EditNew(Of TDialog As {Form, New})(bs As BindingSource) As DialogResult
Using dlg = New TDialog
Return bs.EditNew(dlg)
End Using
End Function
''' <summary> stellt in den FremdschlüsselSpalten DefaultValues sicher, die auf existierende ParentRows verweisen </summary>
Private Sub EnsureValidFKDefaults(bs As BindingSource)
For Each rl As DataRelation In bs.DataTable.ParentRelations
Dim defaultValues = rl.ParentColumns.Select(Function(clmn) clmn.DefaultValue).ToArray
Dim rwDefaultParent = rl.ParentTable.FindX(rl.ParentColumns, defaultValues)
If rwDefaultParent IsNot Nothing Then Continue For ' es gibt bereits eine Default-ParentRow
rwDefaultParent = rl.ParentTable.All.FirstOrDefault ' ansonsten die nächstbeste
If rwDefaultParent Is Nothing Then Throw New InvalidOperationException("es kann keine gültige Default-ParentRow gefunden werden.")
For i = 0 To rl.ParentColumns.Length - 1
rl.ChildColumns(i).DefaultValue = rwDefaultParent(rl.ParentColumns(i))
Next
Next
End Sub
''' <summary> editiert bs.Current im angegebenen Dialog-Form. </summary>
<Extension()>
Public Function EditCurrent(bs As BindingSource, dlg As Form) As DialogResult
Return EditItem(bs, bs.Current, dlg)
End Function
''' <summary> editiert bs.Current im angegebenen Dialog-Form. </summary>
<Extension()>
Public Function EditCurrent(Of TDialog As {Form, New})(bs As BindingSource) As DialogResult
Using dlg = New TDialog
Return bs.EditCurrent(dlg)
End Using
End Function
Private Function EditItem(bs As BindingSource, currentOrNewItem As Object, dlg As Form) As DialogResult
Dim tb = DirectCast(currentOrNewItem, DataRowView).Row.Table
tb.DataSet.Register(dlg, False)
Dim allCtls = New GetChilds(Of Control)(Function(ctl) ctl.Controls).AllAsList(dlg)
Dim bindFlags As BindingFlags = BindingFlags.Instance Or BindingFlags.Public _
Or BindingFlags.NonPublic Or BindingFlags.GetField
For Each ctl In allCtls.Where(Function(c) TypeOf c Is ContainerControl AndAlso TypeOf c Is Form OrElse TypeOf c Is UserControl)
For Each fld In ctl.GetType.GetFields(bindFlags).Where(Function(f) f.FieldType = GetType(BindingSource))
Dim bs2 = DirectCast(fld.GetValue(ctl), BindingSource)
If bs2 Is Nothing Then Continue For
If tb Is bs2.DataTable Then
bs2.DataSource = currentOrNewItem
EditItem = dlg.ShowDialog()
If EditItem = Windows.Forms.DialogResult.OK Then
bs2.EndEdit()
bs.ResetCurrentItem() 'den von der anneren BS geänderten Datensatz neu einlesen.
Else
bs.CancelEdit()
End If
Exit Function
End If
Next
Next
Throw New Exception("es konnte keine geeignete BindingSource gefunden werden.")
End Function

Dann sollte es 2 neue Extension-Methoden geben:

BindingSource.EditNew(dlg As Form)
BindingSource.EditCurrent(dlg As Form)

also ohne TypParameter, aber dafür muss eine Dialog-Instanz übergeben werden.
Zu beachten ist, dass die Dialog-Instanz aber auch wieder disposed werden muss.

Äh - das ist ein ungetesteter Schnellschuss, weil ich muss jetzt weg.

DerSmurf · 26. April 2020, 17:50

@ErfinderDesRades
Hmm. Irgendwas haut nicht hin. Da der Code, den ich erstzen soll nicht in meiner HelpersSmallEd auftaucht, habe ich einfach den zu ersetzenden Code einfach reinkopiert, ohne etwas zu ersetzen.
Ich dachte VS wird mir dann schon anzeigen, was doppelt ist. Es wird aber keine Sub als mehrdeutig gekennzeichnet.

Stattdessen bekomme ich den Fehler, dass FindX kein Member von DataTable sei, in folgender Prozedur:

VB.NET-Quellcode

Private Sub EnsureValidFKDefaults(bs As BindingSource)
For Each rl As DataRelation In bs.DataTable.ParentRelations
Dim defaultValues = rl.ParentColumns.Select(Function(clmn) clmn.DefaultValue).ToArray
Dim rwDefaultParent = rl.ParentTable.FindX(rl.ParentColumns, defaultValues)
If rwDefaultParent IsNot Nothing Then Continue For ' es gibt bereits eine Default-ParentRow
rwDefaultParent = rl.ParentTable.All.FirstOrDefault ' ansonsten die nächstbeste
If rwDefaultParent Is Nothing Then Throw New InvalidOperationException("es kann keine gültige Default-ParentRow gefunden werden.")
For i = 0 To rl.ParentColumns.Length - 1
rl.ChildColumns(i).DefaultValue = rwDefaultParent(rl.ParentColumns(i))
Next
Next
End Sub

Ich habe in meinem Projekt die helperssmalled eingebunden, hier wird mir Versionsnummer 1.0.0.0 angezeigt.
Hier noch der Code der Klasse bindingsourceX: aus meinerm Helpers Projekt:

Spoiler anzeigen

Quellcode

Imports System.Linq
Imports System.Collections
Imports System.Collections.Generic
Imports System.Data
Imports System.Diagnostics
Imports System.Runtime.CompilerServices
Imports System.ComponentModel
Imports System.Reflection
Namespace System.Windows.Forms
Public Module BindingSourceX
<Extension()>
Public Function EditNew(Of T As {Form, New})(bs As BindingSource, defaultValues As List(Of Tuple(Of DataColumn, Object)), Optional owner As Form = Nothing, Optional onErrorRetry As Boolean = False) As DialogResult
Dim drv = DirectCast(bs.AddNew, DataRowView)
defaultValues.ForEach(Sub(tpl) drv(tpl.Item1.ColumnName) = tpl.Item2)
Return EditItem(Of T)(bs, drv, onErrorRetry, owner)
End Function
''' <summary> editiert bs.Current im angegebenen Dialog-Form. </summary>
<Extension()>
Public Function EditNew(Of TEditForm As {Form, New})(bs As BindingSource, Optional onErrorRetry As Boolean = False, Optional owner As Form = Nothing) As DialogResult
Return EditItem(Of TEditForm)(bs, bs.AddNew, onErrorRetry, owner)
End Function
''' <summary> editiert bs.AddNew im angegebenen Dialog-Form. </summary>
<Extension()>
Public Function EditCurrent(Of TEditForm As {Form, New})(bs As BindingSource, Optional onErrorRetry As Boolean = False, Optional owner As Form = Nothing) As DialogResult
Return EditItem(Of TEditForm)(bs, bs.Current, onErrorRetry, owner)
End Function
Private Function EditItem(Of T As {Form, New})(bs As BindingSource, item As Object, onErrorRetry As Boolean, owner As Form) As DialogResult
EditItem = DialogResult.Retry
Dim tb = DirectCast(item, DataRowView).Row.Table
While EditItem = DialogResult.Retry
Using frm = New T
tb.DataSet.Register(frm, False)
Dim allCtls = New GetChilds(Of Control)(Function(ctl) ctl.Controls).AllAsList(frm)
Dim bindFlags As BindingFlags = BindingFlags.Instance Or BindingFlags.Public _
Or BindingFlags.NonPublic Or BindingFlags.GetField
For Each ctl In allCtls.Where(Function(c) TypeOf c Is ContainerControl AndAlso TypeOf c Is Form OrElse TypeOf c Is UserControl)
For Each fld In ctl.GetType.GetFields(bindFlags).Where(Function(f) f.FieldType Is GetType(BindingSource))
Dim bs2 = DirectCast(fld.GetValue(ctl), BindingSource)
If bs2 Is Nothing Then Continue For
If tb Is bs2.DataTable Then
bs2.DataSource = item
Try
EditItem = frm.ShowDialog(owner)
If EditItem <> DialogResult.Cancel Then
Try
bs2.EndEdit()
' BusyDelay.SetCallback(Sub() bs2.MoveToRow(DirectCast(item, DataRowView).Row))
Catch ex As Exception
If Not onErrorRetry Then Throw
EditItem = MessageBox.Show(ex.Message, ex.GetType.Name, MessageBoxButtons.RetryCancel)
Continue While
End Try
End If
Finally
If EditItem = DialogResult.Cancel Then
bs.CancelEdit()
Else
If DirectCast(bs.List, DataView).Sort <> "" Then bs.MoveToRow(DirectCast(item, DataRowView).Row)
bs.ResetCurrentItem() 'den von der anneren BS geänderten Datensatz neu einlesen.
End If
End Try
Exit Function
End If
Next
Next
Throw New Exception("could not find a proper BindingSource.")
End Using
End While
End Function
''' <summary>
''' provides a placeholder-syntax for filters. Sample: dv.FilterX("Datum >= ? And ? >= Datum", dtpVon.Value, dtpBis.Value)
''' </summary>
''' <exception cref="ArgumentException">expression contains more placeholders than values are passed</exception>
<Extension()>
Public Sub FilterX(bs As BindingSource, expression As String, ParamArray values() As Object)
Dim filter = GetFilterString(expression, values)
bs.Filter = If(bs.Filter = filter, "", filter) ' GetFilterString(expression, values)
End Sub
''' <summary>
''' provides a placeholder-syntax for filters. Sample: dv.FilterX("Datum >= ? And ? >= Datum", dtpVon.Value, dtpBis.Value)
''' </summary>
''' <exception cref="ArgumentException">expression contains more placeholders than values are passed</exception>
<Extension()>
Public Sub FilterX(dv As DataView, expression As String, ParamArray values() As Object)
dv.RowFilter = GetFilterString(expression, values)
End Sub
Private Function GetFilterString(expression As String, values() As Object) As String
Dim splits = expression.Split("?"c) ' identify placeholder '?'
If splits.Count > values.Length + 1 Then Throw New ArgumentException(
"expression contains more placeholders than values are passed")
For i = 0 To splits.Length - 2
Dim val = values(i)
Dim sb = New Text.StringBuilder("{0}")
If TypeOf (val) Is Date Then
sb.Insert(0, "#"c).Append("#"c)
ElseIf TypeOf (val) Is String Then
With splits(i)
If .EndsWith("*") Then sb.Insert(0, "*"c) : splits(i) = .Remove(.Length - 1, 1)
End With
With splits(i + 1)
If .StartsWith("*") Then sb.Append("*"c) : splits(i + 1) = .Remove(0, 1)
End With
sb.Insert(0, "'"c).Append("'"c)
End If
splits(i) &= String.Format(Globalization.CultureInfo.InvariantCulture, sb.ToString, val)
Next
Return String.Concat(splits)
End Function
<Extension()>
Public Sub ListChangedEnabled(bs As BindingSource, value As Boolean)
bs.RaiseListChangedEvents = value
If value Then bs.ResetBindings(False)
End Sub
<Extension()>
Public Sub ChangeBinding(bs As BindingSource, dataSource As Object, datamember As String)
With bs
.RaiseListChangedEvents = False
.DataSource = dataSource
.DataMember = datamember
.RaiseListChangedEvents = True
.ResetBindings(False)
End With
End Sub
<Extension()>
Public Function Dataset(bs As BindingSource) As DataSet
Dim BindSource As BindingSource = Nothing
Do Until bs Is Nothing
BindSource = bs
bs = TryCast(bs.DataSource, BindingSource)
Loop
Dim src = BindSource.DataSource
Dim ds = TryCast(src, DataSet)
If ds.NotNull Then Return ds
Dim tb = TryCast(src, DataTable)
If tb.NotNull Then Return tb.DataSet
Dim rw = TryCast(src, DataRow)
If rw.NotNull Then Return rw.Table.DataSet
Dim drv = TryCast(src, DataRowView)
If drv.NotNull Then Return drv.Row.Table.DataSet
If TypeOf src Is DataView Then Throw New Exception(
"DatasetFromBindingSource: Dont set BindingSources DataSource on DataView. It's buggy!")
Return Nothing
End Function
<Extension()>
Public Function DataTable(Source As BindingSource) As DataTable
While Source.DataMember = ""
Dim drv = TryCast(Source.DataSource, DataRowView)
If drv.NotNull Then Return drv.Row.Table
Source = TryCast(Source.DataSource, BindingSource)
If Source.Null Then Return Nothing
End While
Dim DTS As DataSet = Dataset(Source)
If DTS Is Nothing Then Return Nothing
Dim SourceDataMember As String = Source.DataMember
If DTS.Relations.Contains(SourceDataMember) Then
Return DTS.Relations(SourceDataMember).ChildTable
ElseIf DTS.Tables.Contains(SourceDataMember) Then
Return DTS.Tables(SourceDataMember)
Else
Throw New Exception(String.Concat("Im Dataset anhand des BindingSource-Datamembers '",
SourceDataMember, "' keine Tabelle gefunden"))
End If
End Function
<Extension()>
Public Function All(Of T As DataRow)(bs As BindingSource) As IEnumerable(Of T)
Return From drv In bs.Cast(Of DataRowView)() Select DirectCast(drv.Row, T)
End Function
<Extension()>
Public Function All(Of T As DataRow)(subj As DataView) As IEnumerable(Of T)
Return From drv In subj.Cast(Of DataRowView)() Select DirectCast(drv.Row, T)
End Function
''' <summary>
''' returnt die Datarow am index. Bei ungültigem index Nothing (keine OutOfRange-Exception!)
''' </summary>
<Extension()>
Public Function At(Of T As DataRow)(subj As DataView, index As Integer) As T
If index < 0 OrElse index >= subj.Count Then Return Nothing
Return DirectCast(DirectCast(subj(index), DataRowView).Row, T)
End Function
''' <summary> returnt die typisierte Datarow an aktueller Position - oder Nothing. </summary>
<Extension()>
Public Function At(Of T As DataRow)(bs As BindingSource) As T
Return DirectCast(bs.At(bs.Position), T)
End Function
''' <summary>
''' returnt die typisierte Datarow am index. Bei ungültigem index Nothing (keine OutOfRange-Exception!)
''' </summary>
<Extension()>
Public Function At(Of T As DataRow)(bs As BindingSource, index As Integer) As T
Return DirectCast(bs.At(index), T)
End Function
''' <summary> returnt die untypisierte Datarow an aktueller Position. </summary>
<Extension()>
Public Function At(bs As BindingSource) As DataRow
Return bs.At(bs.Position)
End Function
''' <summary>
''' returnt die Datarow am index. Bei ungültigem index Nothing (keine OutOfRange-Exception!)
''' </summary>
<Extension()>
Public Function At(bs As BindingSource, index As Integer) As DataRow
If index < 0 OrElse index >= bs.Count Then Return Nothing
Return DirectCast(bs(index), DataRowView).Row
End Function
<Extension()>
Public Function FindX(Of T As DataRow)(bs As BindingSource, predicate As Func(Of T, Boolean)) As Integer
For i As Integer = 0 To bs.Count - 1
If predicate(DirectCast(DirectCast(bs(i), DataRowView).Row, T)) Then Return i
Next
Return -1
End Function
<Extension()>
Public Function FindX(bs As BindingSource, columnName As String, Key As Object) As Integer
'BindingSource.Find funzt nicht bei relateten BindingSourcses
'FindX = bs.Find(PropertyName, Key)
For i As Integer = 0 To bs.Count - 1
If DirectCast(bs(i), DataRowView)(columnName).Equals(Key) Then Return i
Next
Return -1
End Function
Private Function KeysMatch(row As DataRow, cols As DataColumn(), keys As Object()) As Boolean
For ii = 0 To cols.Length - 1
If Not Object.Equals(keys(ii), row(cols(ii))) Then Return False
Next
Return True
End Function
''' <summary> stellt den Datensatz mit den angegebenen Primärschlüssel-Werten ein </summary>
<Extension()>
Public Function MoveTo(bs As BindingSource, primKeys() As Object) As Boolean
If bs.Count = 0 Then Return False
Dim rw = DirectCast(bs(0), DataRowView).Row
Dim cols = rw.Table.PrimaryKey
Dim i = 0
Try
If KeysMatch(rw, cols, primKeys) Then Return True
For i = 1 To bs.Count - 1
rw = DirectCast(bs(i), DataRowView).Row
If KeysMatch(rw, cols, primKeys) Then Return True
Next
Finally
bs.Position = i
End Try
Return False
End Function
<Extension()>
Public Function MoveToRow(bs As BindingSource, row As DataRow) As Boolean
If row Is bs.At Then Return True
If bs.IsBindingSuspended Then Return False
Dim dv = DirectCast(bs.List, DataView)
For i As Integer = 0 To bs.Count - 1
If dv(i).Row Is row Then
bs.CancelEdit() 'ansonsten setzter u.U. beim Moven die vorherige Row auf Rowstate.Changed
bs.Position = i
Return True
End If
Next
Return False
End Function
''' <summary> stellt den Datensatz mit dem angegebenen Primärschlüssel-Wert ein </summary>
<Extension()>
Public Function MoveTo(bs As BindingSource, primKey As Object) As Boolean
If bs.Count = 0 Then Return False
Return bs.MoveTo(DirectCast(bs(0), DataRowView).Row.Table.PrimaryKey(0).ColumnName, primKey)
End Function
''' <summary>
''' stellt den ersten Datensatz ein, dessen Wert in der angegebenen spalte mit Key übereinstimmt
''' </summary>
<Extension()>
Public Function MoveTo(bs As BindingSource, columnName As String, Key As Object) As Boolean
Dim i = bs.FindX(columnName, Key)
MoveTo = i >= 0
bs.Position = i
End Function
''' <summary> stellt die angegebene DataRow ein </summary>
<Extension()>
Public Function MoveTo(bs As BindingSource, row As DataRow) As Boolean
Dim dv = DirectCast(bs.List, DataView)
For i As Integer = 0 To bs.Count - 1
If dv(i).Row Is row Then
bs.CancelEdit() 'ansonsten setzter u.U. beim Moven die vorherige Row auf Rowstate.Changed
bs.Position = i
Return True
End If
Next
Return False
End Function
''' <summary> stellt die erste matchende DataRow ein </summary>
<Extension()>
Public Function MoveTo(Of T As DataRow)(bs As BindingSource, predicate As Func(Of T, Boolean)) As Boolean
Dim dv = DirectCast(bs.List, DataView)
For i As Integer = 0 To bs.Count - 1
If predicate(DirectCast(dv(i).Row, T)) Then
bs.Position = i
Return True
End If
Next
Return False
End Function
<System.Diagnostics.DebuggerStepThrough()>
<Extension()>
Public Function AddNewX(Of T As DataRow)(bs As BindingSource) As T
Return DirectCast(DirectCast(bs.AddNew(), DataRowView).Row, T)
End Function
<System.Diagnostics.DebuggerStepThrough()>
<Extension()>
Public Function RowX(Of T As DataRow)(subj As DataRowView) As T
Return DirectCast(subj.Row, T)
End Function
<System.Diagnostics.DebuggerStepThrough()>
<Extension()>
Public Function AddNewX(Of T)(subj As IBindingList) As T
Return DirectCast(subj.AddNew(), T)
End Function
''' <summary> for debugging-purposes </summary>
Public Function CheckChanges(dts As DataSet) As Boolean
dts = dts.GetChanges
If dts.Null Then MessageBox.Show("no Changes") : Return False
Dim tbls = dts.Tables.Cast(Of DataTable)().ToArray
Dim rws = tbls.SelectMany(Function(tb) tb.Rows.Cast(Of DataRow)())
Dim infos = From tbl In tbls From rw In tbl.Rows.Cast(Of DataRow)()
Select String.Concat(rw.GetType.Name,
String.Concat(rw.ItemArray.Select(Function(itm) " " & itm.ToString).ToArray))
MessageBox.Show(String.Join(Lf, infos.ToArray))
Return True
End Function
End Module
Public Class BindingSourceConfig
Private Shared ReadOnly _NotSetObject As New Object, _NotSetString As String = "NotSet"
Public DataSource As Object = _NotSetObject, Datamember As String = _NotSetString, Sort As String = _NotSetString, Filter As String = _NotSetString, AllowNew As Boolean?
Public Sub ExchangeConfig(bs As BindingSource)
Dim tmp = DirectCast(MemberwiseClone(), BindingSourceConfig)
AllowNew = bs.AllowNew : Datamember = bs.DataMember : DataSource = bs.DataSource : Filter = bs.Filter : Sort = DirectCast(bs.List, DataView).Sort
DirectCast(bs, ISupportInitialize).BeginInit()
With tmp
If .AllowNew.HasValue Then bs.AllowNew = .AllowNew.Value
If .DataSource IsNot _NotSetObject AndAlso .DataSource IsNot bs.DataSource Then bs.DataMember = Nothing : bs.DataSource = .DataSource
If .Datamember IsNot _NotSetString Then bs.DataMember = .Datamember
If .Filter IsNot _NotSetString Then bs.Filter = .Filter
DirectCast(bs, ISupportInitialize).EndInit()
If .Sort IsNot _NotSetString Then DirectCast(bs.List, DataView).Sort = .Sort
End With
End Sub
End Class
End Namespace

Bildschirmtastatur fürs eigene Programm

VB.NET-Quellcode

VB.NET-Quellcode

VB.NET-Quellcode

VB.NET-Quellcode

VB.NET-Quellcode

VB.NET-Quellcode

VB.NET-Quellcode

VB.NET-Quellcode

VB.NET-Quellcode

VB.NET-Quellcode

VB.NET-Quellcode

VB.NET-Quellcode

Quellcode

Benutzer online 1

Ähnliche Themen

3 Benutzer haben hier geschrieben