Imports System.ComponentModel Imports DPM2016.MyCombobox Public Class frmFirma Dim m_haschanges As Boolean Property HasChanges As Boolean Get Return m_haschanges End Get Set(value As Boolean) m_haschanges = value End Set End Property Dim m_firmanr As Integer = 0 Property Firmanr As Integer Get Return m_firmanr End Get Set(value As Integer) m_firmanr = value Fill_Stammdaten() Get_Data() AddChanges(Me) Me.txtName1.Select() Me.Finanzen1.Patientnr = value Me.HasChanges = False Me.ClsDokumente1.Patientnr = Me.Firmanr End Set End Property #Region "Deklarationen" Dim DB As New clsDB Dim FormReadonly As Boolean = False Dim log As New clsLog Dim WithEvents evh As Generic_Event_Handler = Globals.EVH Dim spalten As New Tabellenspalte Dim Firmaap As New DataTable #End Region #Region "Closing / Check_Changes" ''' ''' Prüfung, ob Datenänderungen vorgenommen wurden. ''' ''' Private Function Check_Changes() As Boolean If Me.FormReadonly Then Return True Exit Function End If Dim msgres As MsgBoxResult If Me.HasChanges Then msgres = MsgBox("Daten wurden verändert. Wollen Sie die Änderungen speichern", vbYesNo + vbQuestion) Select Case msgres Case MsgBoxResult.Yes Save_Data() Return True Case MsgBoxResult.Cancel Return False Case MsgBoxResult.No Me.HasChanges = False Return True End Select Else Return True End If End Function #End Region #Region "Eventhandler ChangeEreignisse" ''' ''' Allg Eventhandler für Chanage-Ereignise festlegen ''' ''' ''' Private Sub AddChanges(ByVal Container As Control) Dim l As New List(Of Control) Me.GetControl(Me, "*", l) Dim evh As EventHandler = AddressOf ChangesMade For Each c As Control In l If TypeOf c Is TextBox Then Dim ctl As TextBox = c AddHandler ctl.TextChanged, evh End If If TypeOf c Is MaskedTextBox Then Dim ctl As MaskedTextBox = c AddHandler ctl.TextChanged, evh End If If TypeOf c Is ComboBox Then Dim ctl As ComboBox = c AddHandler ctl.SelectedValueChanged, evh End If If TypeOf c Is RichTextBox Then Dim ctl As RichTextBox = c AddHandler ctl.TextChanged, evh End If If TypeOf c Is CheckBox Then If c.Name <> "cboxNurAktive" Then Dim ctl As CheckBox = c AddHandler ctl.CheckedChanged, evh End If End If If TypeOf c Is DateTimePicker Then Dim ctl As DateTimePicker = c AddHandler ctl.ValueChanged, evh End If If TypeOf c Is CheckedListBox Then Dim ctl As CheckedListBox = c AddHandler ctl.ItemCheck, AddressOf ChecketListBoxChange End If Next End Sub ''' ''' Envent-Handler für Change-Ereignisse ''' ''' ''' ''' Private Sub ChangesMade(ByVal sender As Object, ByVal e As System.EventArgs) Me.HasChanges = True Dim objtype As System.Type = sender.GetType If objtype.Name = "MaskedTextBox" Then Dim o As MaskedTextBox = sender If o.Text = "01.01.1900" Then o.Text = " . . " End If End Sub Private Sub ChecketListBoxChange(ByVal sender As Object, ByVal e As System.Windows.Forms.ItemCheckEventArgs) Me.HasChanges = True End Sub ''' ''' 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 #Region "Daten_Laden" Public Sub Fill_Stammdaten() log.Writelog("PartnerDetails: Fill_Stammdaten", clsLog.Logtype.Information) Me.cbboxSprache.Table = "Sprache" Me.cbboxSprache.Displaymember = "Sprachbezeichnung" Me.cbboxSprache.Valuemember = "Sprachcode" Me.cbboxStatus.Table = "Status" Me.cbboxStatus.Displaymember = "Status" Me.cbboxStatus.Valuemember = "nrstatus" log.Writelog("PartnerDetails: Fill_Stammdaten Ende", clsLog.Logtype.Information) End Sub Private Sub frmFirma_Load(sender As Object, e As EventArgs) Handles MyBase.Load Select Case Globals.Funktionsstufe Case 2 Me.Finanzen.Visible = False End Select If Globals.License.DMS = False Then Me.SuperTabControl1.Tabs("Dokumente").Visible = False End If Dim db As New clsDB If Firmanr = 0 Then db.Get_Tabledata("Firma", "Select * from firma order by name1, ort", "", "", False) Me.Firmanr = db.dsDaten.Tables(0).Rows(0).Item(0) End If Get_Data() Select Case Globals.Funktionsstufe Case 2 Me.tsbtnFinanzen.Visible = False End Select End Sub Sub Get_Data() Dim ctlname As String Dim colname As String Try DB.Get_Tabledata("firma", " where nrfirma=" + Me.Firmanr.ToString) Dim r As DataRow = DB.dsDaten.Tables(0).Rows(0) For Each c As DataColumn In DB.dsDaten.Tables(0).Columns colname = c.ColumnName For Each Ctl As Control In Me.Panel1.Controls ' Me.Controls 'Dim objtype As System.Type = Ctl.GetType 'If objtype.Name = "Label" Then ' Exit For 'End If ctlname = Ctl.Name log.Writelog("Firmadetails: Get_Data: " + Ctl.Name, clsLog.Logtype.Information) If UCase(Ctl.Name) = "TXT" + UCase(c.ColumnName) Then log.Writelog("--Firmadetails: Get_Data: " + Ctl.Name + " " + c.ColumnName, clsLog.Logtype.Information) Ctl.Text = r(c.ColumnName).ToString Exit For End If If UCase(Ctl.Name) = "CBBOX" + UCase(c.ColumnName) Then log.Writelog("--Firmadetails: Get_Data: " + Ctl.Name + " " + c.ColumnName, clsLog.Logtype.Information) Dim ct As MyCombobox Dim o As Object = Ctl Try o.SelectedValue = r(c.ColumnName) Catch o.SelectedValue = -1 End Try Exit For End If If UCase(Ctl.Name) = "CBTXTBOX" + UCase(c.ColumnName) Then log.Writelog("--Partnerdtails: Get_Data: " + Ctl.Name + " " + c.ColumnName, clsLog.Logtype.Information) Dim ct As ComboBox Dim o As Object = Ctl Try o.text = r(c.ColumnName) Catch o.Text = "" End Try Exit For End If If UCase(Ctl.Name) = "DT" + UCase(c.ColumnName) Then log.Writelog("--Firmadetails: Get_Data: " + Ctl.Name + " " + c.ColumnName, clsLog.Logtype.Information) Dim dt As DateTimePicker dt = Ctl Try dt.Value = r(c.ColumnName) dt.Format = DateTimePickerFormat.Short Catch dt.CustomFormat = " " 'An empty SPACE dt.Format = DateTimePickerFormat.Custom End Try Exit For End If If UCase(Ctl.Name) = "CHK" + UCase(c.ColumnName) Then Dim cb As CheckBox cb = Ctl Try cb.Checked = r(c.ColumnName) Catch ex As Exception End Try Exit For End If Next Select Case UCase(c.ColumnName) Case "AG" Set_Adresstype("Arbeitgeber", r(c.ColumnName).ToString) log.Writelog("--Firmendetails: Get_Data Set_Adresstyp: " + c.ColumnName, clsLog.Logtype.Information) Case "VS" Set_Adresstype("Versicherung", r(c.ColumnName).ToString) log.Writelog("--Firmendetails: Get_Data Set_Adresstyp: " + c.ColumnName, clsLog.Logtype.Information) Case "KK" Set_Adresstype("Krankenkasse", r(c.ColumnName).ToString) log.Writelog("--Firmendetails: Get_Data Set_Adresstyp: " + c.ColumnName, clsLog.Logtype.Information) Case "IV" Set_Adresstype("IV", r(c.ColumnName).ToString) log.Writelog("--Firmendetails: Get_Data Set_Adresstyp: " + c.ColumnName, clsLog.Logtype.Information) Case "FS" Set_Adresstype("Fürsorge", r(c.ColumnName).ToString) log.Writelog("--Firmendetails: Get_Data Set_Adresstyp: " + c.ColumnName, clsLog.Logtype.Information) Case "Garant" Set_Adresstype("Garant", r(c.ColumnName).ToString) log.Writelog("--Firmendetails: Get_Data Set_Adresstyp: " + c.ColumnName, clsLog.Logtype.Information) End Select Next Refresh_AP() Catch ex As Exception log.Writelog("Privatdetails: Get_Data: " + ctlname + " / " + colname + " " + ex.Message, clsLog.Logtype.ApplError) End Try End Sub Sub Refresh_AP() DB.Get_Tabledata("Firmaap", "where aktiv=1 and nrfirma=" + Firmanr.ToString) Me.Firmaap.Rows.Clear() Me.Firmaap = DB.dsDaten.Tables(0).Copy Me.c1daten.DataSource = Firmaap spalten.Spaltentitel_aktualisieren(Me.c1daten, DB.dsDaten.Tables(0).TableName, DB.dsDaten.Tables(0)) End Sub Private Sub Set_Adresstype(ByVal feldname, value) Dim i As Integer For i = 0 To Me.chklbAdresstyp.Items.Count - 1 If UCase(chklbAdresstyp.Items(i).ToString) = UCase(feldname) Then Try If value <> False Then chklbAdresstyp.SetItemCheckState(i, CheckState.Checked) Else chklbAdresstyp.SetItemCheckState(i, CheckState.Unchecked) Catch ex As Exception chklbAdresstyp.SetItemCheckState(i, CheckState.Unchecked) End Try End If Next End Sub #End Region #Region "Daten speichern" Private Sub dtgueltigab_ValueChanged(sender As Object, e As EventArgs) Handles dtgueltigab.ValueChanged, dtgueltigbis.ValueChanged Dim dt As DateTimePicker dt = sender dt.CustomFormat = "" dt.Format = DateTimePickerFormat.Short End Sub Private Sub btndeldatetimeab_Click(sender As Object, e As EventArgs) Handles btndeldatetimeab.Click dtgueltigab.CustomFormat = " " 'An empty SPACE dtgueltigab.Format = DateTimePickerFormat.Custom End Sub Private Sub btndeldatetimebis_Click(sender As Object, e As EventArgs) Handles btndeldatetimebis.Click dtgueltigbis.CustomFormat = " " 'An empty SPACE dtgueltigbis.Format = DateTimePickerFormat.Custom End Sub #End Region #Region "Daten speichern" Public Sub Save_Data() DB.Get_Tabledata("firma", " where nrfirma=" + Me.Firmanr.ToString) Dim r As DataRow = DB.dsDaten.Tables(0).Rows(0) For Each c As DataColumn In DB.dsDaten.Tables(0).Columns For Each Ctl As Control In Me.Panel1.Controls 'Me.Controls If UCase(Ctl.Name) = "TXT" + UCase(c.ColumnName) Then If UCase(Ctl.Name) <> "TXTMUTIERT_AM" And UCase(Ctl.Name) <> "TXTERSTLLT_AM" Then r(c.ColumnName) = Ctl.Text Exit For End If End If If UCase(Ctl.Name) = "CBBOX" + UCase(c.ColumnName) Then Dim ct As MyCombobox Dim o As Object = Ctl Try r(c.ColumnName) = o.selectedvalue Catch ex As Exception r(c.ColumnName) = 0 End Try Exit For End If If UCase(Ctl.Name) = "CBTXTBOX" + UCase(c.ColumnName) Then Dim ct As MyCombobox Dim o As Object = Ctl Try r(c.ColumnName) = o.text Catch ex As Exception r(c.ColumnName) = "" End Try Exit For End If If UCase(Ctl.Name) = "DT" + UCase(c.ColumnName) Then Dim dt As DateTimePicker dt = Ctl If dt.CustomFormat = " " Then r(c.ColumnName) = System.DBNull.Value Else r(c.ColumnName) = dt.Value End If Exit For End If If UCase(Ctl.Name) = "CHK" + UCase(c.ColumnName) Then Dim cb As CheckBox cb = Ctl r(c.ColumnName) = cb.Checked Exit For End If Next Select Case UCase(c.ColumnName) Case "AG" r(c.ColumnName) = Get_Adresstype("Arbeitgeber", r(c.ColumnName)) Case "VS" r(c.ColumnName) = Get_Adresstype("Versicherung", r(c.ColumnName)) Case "KK" r(c.ColumnName) = Get_Adresstype("Krankenkasse", r(c.ColumnName)) Case "IV" r(c.ColumnName) = Get_Adresstype("IV", r(c.ColumnName)) Case "FS" r(c.ColumnName) = Get_Adresstype("Fürsorge", r(c.ColumnName)) Case "GARANT" r(c.ColumnName) = Get_Adresstype("GARANT", r(c.ColumnName)) End Select Next r("Mutiert_am") = Now r("mutierer") = Globals.ActUser DB.Update_Data() Me.HasChanges = False End Sub Private Function Get_Adresstype(ByVal feldname, value) As Integer Try Dim i As Integer For i = 0 To Me.chklbAdresstyp.Items.Count - 1 If UCase(chklbAdresstyp.Items(i).ToString) = UCase(feldname) Then Return chklbAdresstyp.GetItemChecked(i) End If Next Catch Return -1 End Try End Function Private Sub tsbtnSave_Click(sender As Object, e As EventArgs) Handles tsbtnSave.Click Save_Data() End Sub #End Region #Region "Scroll" Private Sub tsbtnfirst_Click(sender As Object, e As EventArgs) Handles tsbtnfirst.Click If Me.Check_Changes = False Then Exit Sub Dim db As New clsDB db.Get_Tabledata("Firma", "", db.Get_SQL(24)) Me.Firmanr = db.dsDaten.Tables(0).Rows(0).Item(0) db.Dispose() End Sub Private Sub tsbtnlast_Click(sender As Object, e As EventArgs) Handles tsbtnlast.Click If Me.Check_Changes = False Then Exit Sub Dim db As New clsDB db.Get_Tabledata("Firma", "", db.Get_SQL(25)) Me.Firmanr = db.dsDaten.Tables(0).Rows(0).Item(0) db.Dispose() End Sub Private Sub tsbtnnext_Click(sender As Object, e As EventArgs) Handles tsbtnnext.Click If Me.Check_Changes = False Then Exit Sub Dim db As New clsDB Try db.Get_Tabledata("Firma", "", db.Get_SQL(26), "'" + Me.txtName1.Text + "'") Me.Firmanr = db.dsDaten.Tables(0).Rows(0).Item(0) Catch Me.Firmanr = Me.Firmanr End Try db.Dispose() End Sub Private Sub tsbtprev_Click(sender As Object, e As EventArgs) Handles tsbtprev.Click If Me.Check_Changes = False Then Exit Sub Dim db As New clsDB Try db.Get_Tabledata("firma", "", db.Get_SQL(27), "'" + Me.txtName1.Text + "'") Me.Firmanr = db.dsDaten.Tables(0).Rows(0).Item(0) Catch Me.Firmanr = Me.Firmanr End Try db.Dispose() End Sub Private Sub ToolStripButton7_Click(sender As Object, e As EventArgs) Handles ToolStripButton7.Click Try Dim f As New frmFirmaAP f.nrfirmaap = Me.c1daten.Columns("nrfirmaap").Value f.firmanr = Me.c1daten.Columns("nrfirma").Value f.ShowDialog() Refresh_AP() Catch ex As Exception End Try End Sub Private Sub ToolStripButton8_Click(sender As Object, e As EventArgs) Handles ToolStripButton8.Click If MsgBox("Ansprechpartner wirklich löschen?", vbYesNo + vbQuestion) = vbYes Then Dim f As New frmFirmaAP f.nrfirmaap = Me.c1daten.Columns("nrfirmaap").Value f.firmanr = Me.c1daten.Columns("nrfirma").Value f.Visible = False f.Show() f.Delete_ap() f.Close() Refresh_AP() End If End Sub Private Sub ToolStripButton6_Click(sender As Object, e As EventArgs) Handles ToolStripButton6.Click Dim f As New frmFirmaAP f.nrfirmaap = 0 f.firmanr = Me.Firmanr f.ShowDialog() Refresh_AP() End Sub Private Sub tsbtnquit_Click(sender As Object, e As EventArgs) Handles tsbtnquit.Click Me.Close() End Sub Private Sub tsbtnnew_Click(sender As Object, e As EventArgs) Handles tsbtnnew.Click Dim db As New clsDB Dim newkey As Integer = db.Get_DBKey("Firma") db.Get_Tabledata("Firma", " where nrfirma=500000") Dim r As DataRow r = db.dsDaten.Tables(0).NewRow For Each c As DataColumn In db.dsDaten.Tables(0).Columns r.Item(c) = db.dsDaten.Tables(0).Rows(0).Item(c) Next db.dsDaten.Tables(0).Rows(0).Item(0) = newkey db.dsDaten.Tables(0).Rows(0).Item("Erstellt_am") = Now db.dsDaten.Tables(0).Rows(0).Item("mutiert_am") = Now db.dsDaten.Tables(0).Rows(0).Item("mutierer") = Globals.ActUser db.dsDaten.Tables(0).Rows(0).Item("aktiv") = True db.dsDaten.Tables(0).Rows(0).Item("Gueltigab") = Now db.dsDaten.Tables(0).Rows.Add(r) db.Update_Data() Me.Firmanr = newkey db.Dispose() End Sub Private Sub tstxtsuche_KeyDown(sender As Object, e As KeyEventArgs) Handles tstxtsuche.KeyDown If e.KeyCode = Keys.Enter Then Dim db As New clsDB Dim nrfirma As Integer = db.Search("Firma", Me.tstxtsuche.Text) If nrfirma <> -1 Then Me.Firmanr = nrfirma If Me.SuperTabControl1.SelectedTab.Name = "Dokumente" Then Me.ClsDokumente1.Patientnr = Me.Firmanr Me.ClsDokumente1.Refresh_Grid() End If db.Dispose() db.Dispose() End If End Sub Private Sub txtPLZ_Leave(sender As Object, e As EventArgs) Handles txtPlz.Leave If Me.txtOrt.Text = "" Then IntTables.Get_Ort_Kantton(Me.txtPlz.Text, Me.txtOrt, Me.cbtxtboxKanton) End Sub Private Sub frmFirma_Closing(sender As Object, e As CancelEventArgs) Handles Me.Closing If Me.Check_Changes = False Then e.Cancel = True End Sub Private Sub tsbtnFinanzen_Click(sender As Object, e As EventArgs) Handles tsbtnFinanzen.Click If Me.Finanzen1.Visible = False Then Me.Finanzen1.Visible = True Else Me.Finanzen1.Visible = False End Sub Private Sub txtName1_TextChanged(sender As Object, e As EventArgs) Handles txtName1.TextChanged, txtName2.TextChanged, txtOrt.TextChanged, txtPlz.TextChanged Me.Text = Me.txtnrfirma.Text + " " + Me.txtName1.Text + " " + Me.txtName2.Text + ", " + Me.txtPlz.Text + " " + Me.txtOrt.Text End Sub Private Sub tstxtsuche_Click(sender As Object, e As EventArgs) Handles tstxtsuche.Click End Sub Private Sub SuperTabControl1_SelectedTabChanged(sender As Object, e As DevComponents.DotNetBar.SuperTabStripSelectedTabChangedEventArgs) Handles SuperTabControl1.SelectedTabChanged If SuperTabControl1.SelectedTab.Name = "Dokumente" Then Me.ClsDokumente1.Patientnr = Me.Firmanr Me.ClsDokumente1.refreshdata() End If End Sub #End Region End Class