Initial commit

This commit is contained in:
2020-10-21 10:44:38 +02:00
commit 039adbbadf
1125 changed files with 854026 additions and 0 deletions

View File

@@ -0,0 +1,137 @@
<Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()> _
Partial Class FrmUebersicht
Inherits System.Windows.Forms.Form
'Das Formular überschreibt den Löschvorgang, um die Komponentenliste zu bereinigen.
<System.Diagnostics.DebuggerNonUserCode()> _
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
Try
If disposing AndAlso components IsNot Nothing Then
components.Dispose()
End If
Finally
MyBase.Dispose(disposing)
End Try
End Sub
'Wird vom Windows Form-Designer benötigt.
Private components As System.ComponentModel.IContainer
'Hinweis: Die folgende Prozedur ist für den Windows Form-Designer erforderlich.
'Das Bearbeiten ist mit dem Windows Form-Designer möglich.
'Das Bearbeiten mit dem Code-Editor ist nicht möglich.
<System.Diagnostics.DebuggerStepThrough()> _
Private Sub InitializeComponent()
Dim resources As System.ComponentModel.ComponentResourceManager = New System.ComponentModel.ComponentResourceManager(GetType(FrmUebersicht))
Me.ToolStrip1 = New System.Windows.Forms.ToolStrip()
Me.TSBtnQuit = New System.Windows.Forms.ToolStripButton()
Me.ToolStripButton1 = New System.Windows.Forms.ToolStripButton()
Me.MenuStrip1 = New System.Windows.Forms.MenuStrip()
Me.DateiToolStripMenuItem = New System.Windows.Forms.ToolStripMenuItem()
Me.BeendenToolStripMenuItem = New System.Windows.Forms.ToolStripMenuItem()
Me.NeuAnmeldenToolStripMenuItem = New System.Windows.Forms.ToolStripMenuItem()
Me.C1TrueDBGrid1 = New C1.Win.C1TrueDBGrid.C1TrueDBGrid()
Me.ToolStrip1.SuspendLayout()
Me.MenuStrip1.SuspendLayout()
CType(Me.C1TrueDBGrid1, System.ComponentModel.ISupportInitialize).BeginInit()
Me.SuspendLayout()
'
'ToolStrip1
'
Me.ToolStrip1.Items.AddRange(New System.Windows.Forms.ToolStripItem() {Me.TSBtnQuit, Me.ToolStripButton1})
Me.ToolStrip1.Location = New System.Drawing.Point(0, 24)
Me.ToolStrip1.Name = "ToolStrip1"
Me.ToolStrip1.Size = New System.Drawing.Size(977, 25)
Me.ToolStrip1.TabIndex = 6
Me.ToolStrip1.Text = "ToolStrip1"
'
'TSBtnQuit
'
Me.TSBtnQuit.DisplayStyle = System.Windows.Forms.ToolStripItemDisplayStyle.Image
Me.TSBtnQuit.Image = CType(resources.GetObject("TSBtnQuit.Image"), System.Drawing.Image)
Me.TSBtnQuit.ImageTransparentColor = System.Drawing.Color.Magenta
Me.TSBtnQuit.Name = "TSBtnQuit"
Me.TSBtnQuit.Size = New System.Drawing.Size(23, 22)
Me.TSBtnQuit.Text = "ToolStripButton1"
Me.TSBtnQuit.ToolTipText = "Anwendung beenden"
'
'ToolStripButton1
'
Me.ToolStripButton1.DisplayStyle = System.Windows.Forms.ToolStripItemDisplayStyle.Image
Me.ToolStripButton1.Image = CType(resources.GetObject("ToolStripButton1.Image"), System.Drawing.Image)
Me.ToolStripButton1.ImageTransparentColor = System.Drawing.Color.Magenta
Me.ToolStripButton1.Name = "ToolStripButton1"
Me.ToolStripButton1.Size = New System.Drawing.Size(23, 22)
Me.ToolStripButton1.Text = "ToolStripButton1"
'
'MenuStrip1
'
Me.MenuStrip1.Items.AddRange(New System.Windows.Forms.ToolStripItem() {Me.DateiToolStripMenuItem})
Me.MenuStrip1.Location = New System.Drawing.Point(0, 0)
Me.MenuStrip1.Name = "MenuStrip1"
Me.MenuStrip1.Size = New System.Drawing.Size(977, 24)
Me.MenuStrip1.TabIndex = 5
Me.MenuStrip1.Text = "MenuStrip1"
'
'DateiToolStripMenuItem
'
Me.DateiToolStripMenuItem.DropDownItems.AddRange(New System.Windows.Forms.ToolStripItem() {Me.BeendenToolStripMenuItem, Me.NeuAnmeldenToolStripMenuItem})
Me.DateiToolStripMenuItem.Name = "DateiToolStripMenuItem"
Me.DateiToolStripMenuItem.Size = New System.Drawing.Size(46, 20)
Me.DateiToolStripMenuItem.Text = "&Datei"
'
'BeendenToolStripMenuItem
'
Me.BeendenToolStripMenuItem.Name = "BeendenToolStripMenuItem"
Me.BeendenToolStripMenuItem.Size = New System.Drawing.Size(152, 22)
Me.BeendenToolStripMenuItem.Text = "&Beenden"
'
'NeuAnmeldenToolStripMenuItem
'
Me.NeuAnmeldenToolStripMenuItem.Name = "NeuAnmeldenToolStripMenuItem"
Me.NeuAnmeldenToolStripMenuItem.Size = New System.Drawing.Size(152, 22)
Me.NeuAnmeldenToolStripMenuItem.Text = "&Neu anmelden"
'
'C1TrueDBGrid1
'
Me.C1TrueDBGrid1.GroupByCaption = "Drag a column header here to group by that column"
Me.C1TrueDBGrid1.Images.Add(CType(resources.GetObject("C1TrueDBGrid1.Images"), System.Drawing.Image))
Me.C1TrueDBGrid1.Location = New System.Drawing.Point(266, 486)
Me.C1TrueDBGrid1.Name = "C1TrueDBGrid1"
Me.C1TrueDBGrid1.PreviewInfo.Location = New System.Drawing.Point(0, 0)
Me.C1TrueDBGrid1.PreviewInfo.Size = New System.Drawing.Size(0, 0)
Me.C1TrueDBGrid1.PreviewInfo.ZoomFactor = 75.0R
Me.C1TrueDBGrid1.PrintInfo.PageSettings = CType(resources.GetObject("C1TrueDBGrid1.PrintInfo.PageSettings"), System.Drawing.Printing.PageSettings)
Me.C1TrueDBGrid1.Size = New System.Drawing.Size(240, 150)
Me.C1TrueDBGrid1.TabIndex = 7
Me.C1TrueDBGrid1.Text = "C1TrueDBGrid1"
Me.C1TrueDBGrid1.PropBag = resources.GetString("C1TrueDBGrid1.PropBag")
'
'FrmUebersicht
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
Me.ClientSize = New System.Drawing.Size(977, 688)
Me.Controls.Add(Me.C1TrueDBGrid1)
Me.Controls.Add(Me.ToolStrip1)
Me.Controls.Add(Me.MenuStrip1)
Me.Name = "FrmUebersicht"
Me.Text = "Übersicht"
Me.ToolStrip1.ResumeLayout(False)
Me.ToolStrip1.PerformLayout()
Me.MenuStrip1.ResumeLayout(False)
Me.MenuStrip1.PerformLayout()
CType(Me.C1TrueDBGrid1, System.ComponentModel.ISupportInitialize).EndInit()
Me.ResumeLayout(False)
Me.PerformLayout()
End Sub
Friend WithEvents ToolStrip1 As System.Windows.Forms.ToolStrip
Friend WithEvents TSBtnQuit As System.Windows.Forms.ToolStripButton
Friend WithEvents ToolStripButton1 As System.Windows.Forms.ToolStripButton
Friend WithEvents MenuStrip1 As System.Windows.Forms.MenuStrip
Friend WithEvents DateiToolStripMenuItem As System.Windows.Forms.ToolStripMenuItem
Friend WithEvents BeendenToolStripMenuItem As System.Windows.Forms.ToolStripMenuItem
Friend WithEvents NeuAnmeldenToolStripMenuItem As System.Windows.Forms.ToolStripMenuItem
Friend WithEvents C1TrueDBGrid1 As C1.Win.C1TrueDBGrid.C1TrueDBGrid
End Class

View File

@@ -0,0 +1,818 @@
Imports C1.Win.C1TrueDBGrid
Imports System
Imports System.Data
Imports System.Data.SqlTypes
Imports System.Data.SqlClient
Namespace Utils
''' <summary>
''' Formular-Security-Objekte auslesen und auf DB schreiben bzw. Formular-Security zur Laufzeit setzen
''' </summary>
''' <remarks></remarks>
Public Class MySecurity
Dim tt As New TKB.VV.Utils.clsToolTips
Dim SecurityData As DataSet = Globals.SecurityDaten
Dim connection As New SqlConnection()
Dim da As New SqlDataAdapter("", connection)
Dim IntForm As Form
Dim ctlcol As New Collection
Dim formname As String = ""
''' <summary>
''' Formularsecurity setzen
''' </summary>
''' <param name="f">Aktuelles Formular</param>
''' <returns></returns>
''' <remarks></remarks>
Public Function Set_Form_Security(ByRef f As Form)
IntForm = f
formname = f.Name
'Load form DB
Load_Data(f.Name)
'Load FormObjects
Me.ctlcol.Clear()
formname = f.Name
For Each ctl As Control In f.Controls
Objectanalysis(ctl)
' AddHandler ctl.HelpRequested, AddressOf Object_MouseDown
'ctl.ContextMenuStrip = Globals.TTContextMenuStrip
'AddHandler ctl.KeyDown, AddressOf Object_MouseDown
Next
Set_Security()
If Globals.Set_ToolTips = True Then
tt.Edit_ToolTips(f, ctlcol)
Else
tt.Set_ToolTips(f)
End If
End Function
Public Function Set_Menu_Security(ByRef f As Form, ByRef menu As ToolStripMenuItem, ByVal Menuname As String)
IntForm = f
formname = f.Name
Load_Data(f.Name)
Me.ctlcol.Clear()
formname = f.Name
Dim ctl As Object = menu
Dim typ As System.Type = ctl.GetType
ctlcol.Add(New MyFormControls(ctl, formname, typ.Name, Menuname, ctl.Name))
Set_Security()
'If Globals.Set_ToolTips = True Then
' tt.Edit_ToolTips(f, ctlcol)
'Else
' tt.Set_ToolTips(f)
'End If
End Function
Public Function Set_Form_Readonly(ByRef f As Form)
IntForm = f
Me.formname = f.Name
Load_Data(f.Name)
Me.ctlcol.Clear()
For Each ctl As Control In f.Controls
Objectanalysis_readonly(ctl)
Next
End Function
Public Function Set_Form_Default(ByRef f As Form)
IntForm = f
Me.formname = f.Name
Load_Data(f.Name)
Me.ctlcol.Clear()
For Each ctl As Control In f.Controls
Objectanalysis_default(ctl)
Next
End Function
Private Function Objectanalysis_readonly(ByRef ctl As Object) As String
Dim typ As System.Type = ctl.GetType
Select Case LCase(typ.Name)
Case "splitcontainer"
ctlcol.Add(New MyFormControls(ctl, formname, typ.Name, ctl.Name, ""))
Dim tmpsplit As SplitContainer = ctl
For Each ctrl As Object In tmpsplit.Panel1.Controls
Objectanalysis_readonly(ctrl)
Next
For Each ctrl As Object In tmpsplit.Panel2.Controls
Objectanalysis_readonly(ctrl)
Next
Case "tabcontrol", "clsmytabcontrol"
ctlcol.Add(New MyFormControls(ctl, formname, typ.Name, ctl.Name, ""))
Dim tmptabcontrol As TabControl = ctl
For Each ctl In tmptabcontrol.TabPages
Objectanalysis_readonly(ctl)
Next
Case "tabpage"
Dim tmptabpage As TabPage = ctl
ctlcol.Add(New MyFormControls(ctl, formname, typ.Name, ctl.Name, tmptabpage.Parent.Name, 1))
For Each ctl In tmptabpage.Controls
Objectanalysis_readonly(ctl)
Next
Case "groupbox"
ctlcol.Add(New MyFormControls(ctl, formname, typ.Name, ctl.Name, ""))
Dim tmptabpage As GroupBox = ctl
For Each ctl In tmptabpage.Controls
Objectanalysis_readonly(ctl)
Next
Case "panel"
ctlcol.Add(New MyFormControls(ctl, formname, typ.Name, ctl.Name, ""))
Dim tmppanel As Panel = ctl
For Each ctl In tmppanel.Controls
Objectanalysis_readonly(ctl)
Next
Case "textbox"
Dim x As TextBox = ctl
x.BackColor = Color.LightGray
x.ForeColor = Color.Black
x.ReadOnly = True
Case "maskedtextbox"
Dim x As MaskedTextBox = ctl
x.BackColor = Color.LightGray
x.ForeColor = Color.Black
x.ReadOnly = True
Case "combobox"
Dim x As ComboBox = ctl
x.Enabled = False
x.BackColor = Color.LightGray
x.ForeColor = Color.Black
Case "checkbox"
Dim x As CheckBox = ctl
x.Enabled = False
Case "radiobutton"
Dim x As RadioButton = ctl
x.Enabled = False
Case "comboboxtree"
Dim x As Object = ctl
x.enabled = False
x.BackColor = Color.LightGray
x.ForeColor = Color.Black
Case "richtextbox"
Dim x As Object = ctl
x.BackColor = Color.LightGray
x.ForeColor = Color.Black
x.ReadOnly = True
Case "button"
Dim x As Button = ctl
x.Enabled = False
Case "listbox"
Dim x As Object = ctl
ctl.enabled = False
Case "checkedlistbox"
Dim x As Object = ctl
ctl.enabled = False
Case "datetimepicker"
Dim x As Object = ctl
ctl.enabled = False
Case Else
End Select
End Function
Private Function Objectanalysis_default(ByRef ctl As Object) As String
Dim typ As System.Type = ctl.GetType
Select Case LCase(typ.Name)
Case "splitcontainer"
ctlcol.Add(New MyFormControls(ctl, formname, typ.Name, ctl.Name, ""))
Dim tmpsplit As SplitContainer = ctl
For Each ctrl As Object In tmpsplit.Panel1.Controls
Objectanalysis_default(ctrl)
Next
For Each ctrl As Object In tmpsplit.Panel2.Controls
Objectanalysis_default(ctrl)
Next
Case "tabcontrol", "clsmytabcontrol"
ctlcol.Add(New MyFormControls(ctl, formname, typ.Name, ctl.Name, ""))
Dim tmptabcontrol As TabControl = ctl
For Each ctl In tmptabcontrol.TabPages
Objectanalysis_default(ctl)
Next
Case "tabpage"
Dim tmptabpage As TabPage = ctl
ctlcol.Add(New MyFormControls(ctl, formname, typ.Name, ctl.Name, tmptabpage.Parent.Name, 1))
For Each ctl In tmptabpage.Controls
Objectanalysis_default(ctl)
Next
Case "groupbox"
ctlcol.Add(New MyFormControls(ctl, formname, typ.Name, ctl.Name, ""))
Dim tmptabpage As GroupBox = ctl
For Each ctl In tmptabpage.Controls
Objectanalysis_default(ctl)
Next
Case "panel"
ctlcol.Add(New MyFormControls(ctl, formname, typ.Name, ctl.Name, ""))
Dim tmppanel As Panel = ctl
For Each ctl In tmppanel.Controls
Objectanalysis_default(ctl)
Next
Case "textbox"
Dim x As TextBox = ctl
x.BackColor = Color.White
x.ForeColor = Color.Black
x.Enabled = True
Case "maskedtextbox"
Dim x As MaskedTextBox = ctl
x.BackColor = Color.White
x.ForeColor = Color.Black
x.Enabled = True
Case "combobox"
Dim x As ComboBox = ctl
x.Enabled = True
x.BackColor = Color.White
x.ForeColor = Color.Black
Case "checkbox"
Dim x As CheckBox = ctl
x.Enabled = True
Case "radiobutton"
Dim x As RadioButton = ctl
x.Enabled = True
Case "comboboxtree"
Dim x As Object = ctl
x.enabled = True
x.BackColor = Color.White
x.ForeColor = Color.Black
Case "richtextbox"
Dim x As Object = ctl
x.BackColor = Color.White
x.ForeColor = Color.Black
x.readonly = True
Case "button"
Dim x As Button = ctl
x.Enabled = True
Case "listbox"
Dim x As Object = ctl
ctl.enabled = True
Case "checkedlistbox"
Dim x As Object = ctl
ctl.enabled = True
Case "datetimepicker"
Dim x As Object = ctl
ctl.enabled = True
Case Else
End Select
End Function
''' <summary>
''' Daten ab Datenbank laden
''' </summary>
''' <remarks></remarks>
Private Sub Load_Data(ByVal Formname As String)
Try
'xxx
If SecurityData.Tables.Count > 0 Then
SecurityData.Tables.Clear()
End If
' Exit Sub
Catch ex As Exception
End Try
SecurityData.Tables.Clear()
Dim sqlcmd As New SqlCommand
sqlcmd.CommandText = "dbo.my_security_get_data"
sqlcmd.Parameters.Add("@FormName", SqlDbType.VarChar, 255)
sqlcmd.Parameters.Add("@Mitarbeiternr", SqlDbType.Int, 4)
sqlcmd.Parameters(0).Value = Formname
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(SecurityData, "SecurityTable")
Globals.SecurityDaten.Tables.Add(SecurityData.Tables(0).Copy)
Catch ex As Exception
Finally
connection.Close()
da.Dispose()
sqlcmd.Dispose()
End Try
End Sub
''' <summary>
''' Prüft die DB-Einträge mit den Formcontrols und bei Übereinstimmung werden die Security-Einstellungen gesetzt
''' </summary>
''' <remarks></remarks>
Private Sub Set_Security()
Dim i As Integer
For i = 0 To Me.SecurityData.Tables(0).Rows.Count - 1
Dim SecurityObject As String = Me.SecurityData.Tables(0).Rows(i).Item("SecurityObject")
Dim SecurityObjectitem As String = Me.SecurityData.Tables(0).Rows(i).Item("SecurityObjectItem")
Dim read_only As Boolean = Me.SecurityData.Tables(0).Rows(i).Item("readonly")
Dim invisible As Boolean = Me.SecurityData.Tables(0).Rows(i).Item("invisible")
Dim ii As Integer
For ii = 1 To ctlcol.Count
Dim secobj As MyFormControls = ctlcol(ii)
If secobj.MySecurityObject = SecurityObject And secobj.MySecurityObjectItem = SecurityObjectitem Then
Set_Preferences(secobj.MyControl, read_only, invisible, SecurityObjectitem)
End If
Next
Next
End Sub
''' <summary>
''' Security-Einstellungen setzen
''' </summary>
''' <param name="obj">Betroffenes Objeckt (Menuitem, Conrol usw.)</param>
''' <param name="read_only">Readonly ja/nein</param>
''' <param name="invisible">Sichtbar ja/nein</param>
''' <param name="SecurityObjectItem">Name des Unterobjektes - wird für die Spalteneinstellungen von C1TruedbGrids verwendet</param>
''' <remarks></remarks>
Private Sub Set_Preferences(ByRef obj As Object, ByVal read_only As Boolean, ByVal invisible As Boolean, ByVal SecurityObjectItem As String)
Dim objtype As System.Type = obj.GetType
Select Case LCase(objtype.Name)
Case "button"
Dim ctl As Button = obj
If read_only Then ctl.Enabled = False
If invisible Then
ctl.Visible = False
ctl.Enabled = False
End If
Case "toolstripmenuitem"
Dim ctl As ToolStripMenuItem = obj
If read_only Then ctl.Enabled = False
If invisible Then
ctl.Visible = False
ctl.Enabled = False
End If
Case "textbox", "label", "combobox", "checkbox", "toolstripbutton", "panel", "datetimepicker"
If read_only Then obj.Enabled = False
If invisible Then obj.Visible = False
Case "richtextbox"
If read_only Then obj.Enabled = False
Try
obj.readonly = True
obj.enabled = True
Catch ex As Exception
End Try
If invisible Then obj.Visible = False
Case "tabpage"
If invisible Then
Dim tbp As TabPage = obj
For Each x As MyFormControls In Me.ctlcol
If x.MySecurityObject = tbp.Parent.Name Then
Dim tb As TabControl = x.MyControl
tb.TabPages.Remove(tbp)
Exit Sub
End If
Next
End If
'20100406 - TabPageHandling
If read_only Then
'obj.enabled = False
For Each CTLX As Control In obj.CONTROLS
Me.Objectanalysis_readonly(CTLX)
Next
End If
Case "c1truedbgrid"
Dim ctl As C1TrueDBGrid = obj
If SecurityObjectItem = "" Then
If read_only Then ctl.Enabled = False
If invisible Then obj.Visible = False
Else
If read_only Then ctl.Splits(0).DisplayColumns(SecurityObjectItem).Locked = True
If invisible Then ctl.Splits(0).DisplayColumns(SecurityObjectItem).Visible = False
End If
End Select
End Sub
#Region "Read Objects from Form and save to Database"
Dim tmpmenuname As String
''' <summary>
''' Alle Controls des Formulars zusammensuchen und auf der DB speichern
''' </summary>
''' <param name="f">Betroffenes Formular</param>
''' <returns></returns>
''' <remarks></remarks>
Public Function List_Form_Controls(ByRef f As Form)
Me.ctlcol.Clear()
formname = f.Name
For Each ctl As Control In f.Controls
Objectanalysis(ctl)
Next
Dim i As Integer
For i = 1 To ctlcol.Count
Dim secobj As MyFormControls = ctlcol(i)
secobj.Write_Object_to_DB()
Next
End Function
''' <summary>
''' Sämtliche Controls vom Formular auslesen
''' </summary>
''' <param name="ctl"></param>
''' <returns></returns>
''' <remarks></remarks>
Private Function Objectanalysis(ByRef ctl As Object) As String
Dim typ As System.Type = ctl.GetType
Select Case LCase(typ.Name)
Case "menustrip"
ctlcol.Add(New MyFormControls(ctl, formname, typ.Name, ctl.Name, ""))
tmpmenuname = ctl.name
ReadMenu(ctl)
Case "contextmenustrip"
ctlcol.Add(New MyFormControls(ctl, formname, typ.Name, ctl.Name, ""))
tmpmenuname = ctl.name
ReadContextMenu(ctl)
Case "toolstrip"
ctlcol.Add(New MyFormControls(ctl, formname, typ.Name, ctl.Name, ""))
Dim tmptoolstrop As ToolStrip = ctl
Try
Dim ic As Integer
For ic = 0 To tmptoolstrop.Items.Count - 1
Try
Dim subobj As ToolStripButton
subobj = tmptoolstrop.Items(ic)
ctlcol.Add(New MyFormControls(subobj, formname, typ.Name, ctl.Name, subobj.Name, 1))
Catch ex As Exception
End Try
Next
'For Each subobj As ToolStripButton In tmptoolstrop.Items
'ctlcol.Add(New MyFormControls(subobj, formname, typ.Name, ctl.Name, subobj.Name, 1))
'Next
Catch
End Try
Case "splitcontainer"
ctlcol.Add(New MyFormControls(ctl, formname, typ.Name, ctl.Name, ""))
Dim tmpsplit As SplitContainer = ctl
For Each ctrl As Object In tmpsplit.Panel1.Controls
Objectanalysis(ctrl)
Next
For Each ctrl As Object In tmpsplit.Panel2.Controls
Objectanalysis(ctrl)
Next
Case "tabcontrol", "clsmytabcontrol"
ctlcol.Add(New MyFormControls(ctl, formname, typ.Name, ctl.Name, ""))
Dim tmptabcontrol As TabControl = ctl
For Each ctl In tmptabcontrol.TabPages
Objectanalysis(ctl)
Next
Case "tabpage"
Dim tmptabpage As TabPage = ctl
ctlcol.Add(New MyFormControls(ctl, formname, typ.Name, ctl.Name, tmptabpage.Parent.Name, 1))
For Each ctl In tmptabpage.Controls
Objectanalysis(ctl)
Next
Case "groupbox"
ctlcol.Add(New MyFormControls(ctl, formname, typ.Name, ctl.Name, ""))
Dim tmptabpage As GroupBox = ctl
For Each ctl In tmptabpage.Controls
Objectanalysis(ctl)
Next
Case "panel"
ctlcol.Add(New MyFormControls(ctl, formname, typ.Name, ctl.Name, ""))
Dim tmppanel As Panel = ctl
For Each ctl In tmppanel.Controls
Objectanalysis(ctl)
Next
Case "c1truedbgrid"
ctlcol.Add(New MyFormControls(ctl, formname, typ.Name, ctl.Name, ""))
Dim ctrl As C1TrueDBGrid = ctl
Dim i As Integer
For i = 0 To ctrl.Columns.Count - 1
ctlcol.Add(New MyFormControls(ctl, formname, typ.Name, ctl.Name, ctrl.Columns(i).Caption, 0, ctrl.Columns(i).Caption))
Next
Try
If ctrl.ContextMenuStrip.Name <> "" Then
Dim x As ContextMenuStrip = ctrl.ContextMenuStrip
Objectanalysis(x)
End If
Catch ex As Exception
End Try
For Each xctl As Object In ctrl.Controls
Objectanalysis(xctl)
Next
Case "treeview"
ctlcol.Add(New MyFormControls(ctl, formname, typ.Name, ctl.Name, ""))
Dim ctrl As TreeView = ctl
Try
If ctrl.ContextMenuStrip.Name <> "" Then
Dim x As ContextMenuStrip = ctrl.ContextMenuStrip
Objectanalysis(x)
End If
Catch ex As Exception
End Try
Case Else
If ctl.name = "TreeStruktur" Then
End If
ctlcol.Add(New MyFormControls(ctl, formname, typ.Name, ctl.Name, ""))
End Select
End Function
''' <summary>
''' Auslesen von MenuItems
''' </summary>
''' <param name="x"></param>
''' <returns></returns>
''' <remarks></remarks>
'''
Dim level As Integer = 0
Private Function ReadMenu(ByRef x As Object)
Dim tmpmnu As MenuStrip = x
level = 0
For Each xx As Object In tmpmnu.Items
Dim objtype As System.Type = xx.GetType
If LCase(objtype.Name) = "toolstripmenuitem" Then
ctlcol.Add(New MyFormControls(xx, formname, "menustrip", tmpmenuname, xx.Name, level))
get_all_menus(xx)
End If
Next
End Function
''' <summary>
''' Auslesen von ContextMenuItems
''' </summary>
''' <param name="x"></param>
''' <returns></returns>
''' <remarks></remarks>
'''
Private Function ReadContextMenu(ByRef x As Object)
Dim tmpmnu As ContextMenuStrip = x
level = 0
Try
For Each xx As Object In tmpmnu.Items
Dim objtype As System.Type = xx.GetType
If LCase(objtype.Name) = "toolstripmenuitem" Then
ctlcol.Add(New MyFormControls(xx, formname, "menustrip", tmpmenuname, xx.Name, level))
get_all_menus(xx)
End If
' ctlcol.Add(New MyFormControls(xx, formname, "contextmenustrip", tmpmenuname, xx.Name, level))
' get_all_menus(xx)
Next
Catch ex As Exception
End Try
End Function
''' <summary>
''' Auslesen von Menu-Subitems
''' </summary>
''' <param name="xx"></param>
''' <returns></returns>
''' <remarks></remarks>
Private Function get_all_menus(ByRef xx As ToolStripMenuItem)
level = level + 1
For Each subobj As Object In xx.DropDownItems
If LCase(subobj.GetType.Name) = "toolstripmenuitem" Then
ctlcol.Add(New MyFormControls(subobj, formname, "menustrip", tmpmenuname, subobj.Name, level))
get_all_menus(subobj)
End If
Next
level = level - 1
End Function
''' <summary>
''' Prüft, ob das Security-Objekt bereits auf der DB vorhanden ist
''' </summary>
''' <param name="securityform">Formular</param>
''' <param name="securityobjecttype">Objekttyp</param>
''' <param name="securityobject">Objektname</param>
''' <param name="securityobjectitem">Objektitem</param>
''' <returns></returns>
''' <remarks></remarks>
Private Function Objexists(ByVal securityform As String, ByVal securityobjecttype As String, ByVal securityobject As String, ByVal securityobjectitem As String) As Boolean
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
scmCmdToExecute.CommandText = "dbo.[my_security_check_entry]"
scmCmdToExecute.CommandType = CommandType.StoredProcedure
scmCmdToExecute.Connection = conn.scoDBConnection
Try
scmCmdToExecute.Parameters.Add(New SqlParameter("@form", SqlDbType.VarChar, 255, ParameterDirection.Input, True, 0, 0, "", DataRowVersion.Proposed, securityform))
scmCmdToExecute.Parameters.Add(New SqlParameter("@objecttype", SqlDbType.VarChar, 255, ParameterDirection.Input, True, 0, 0, "", DataRowVersion.Proposed, securityobjecttype))
scmCmdToExecute.Parameters.Add(New SqlParameter("@object", SqlDbType.VarChar, 255, ParameterDirection.Input, True, 0, 0, "", DataRowVersion.Proposed, securityobject))
scmCmdToExecute.Parameters.Add(New SqlParameter("@objectitem", SqlDbType.VarChar, 255, ParameterDirection.Input, True, 0, 0, "", DataRowVersion.Proposed, securityobjectitem))
scmCmdToExecute.Parameters.Add(New SqlParameter("@objexists", SqlDbType.Int, 4, ParameterDirection.Output, True, 0, 0, "", DataRowVersion.Proposed, 0))
scmCmdToExecute.Connection.Open()
scmCmdToExecute.ExecuteNonQuery()
If scmCmdToExecute.Parameters("@objexists").Value > 0 Then
Return True
Else
Return False
End If
Catch ex As Exception
Finally
scmCmdToExecute.Connection.Close()
End Try
End Function
#End Region
#Region "ScreenDoku"
Public Function Print_Screen(ByRef ctl As Control)
saveasbitmap(ctl, ctl.Name)
End Function
Public Function Generate_HTML()
saveasbitmap(Me.IntForm, "testform")
'Exit Function
'Dim x As MyFormControls
'For Each x In ctlcol
' Try
' saveasbitmap(x.MyControl, x.MyFormname & "_" & x.MySecurityObject & "_" & x.MySecurityObjectItem)
' If x.MySecurityObjecttype = "ToolStrip" And x.MySecurityObjectItem = "" Then
' Dim gaga As ToolStrip = x.MyControl
' For Each c As ToolStripButton In gaga.Items
' Dim xxx As Control = CType(c, Control)
' xxx = CType(c, Control)
' saveasbitmap(xxx, "xxx")
' Next
' End If
' Catch ex As Exception
' MsgBox(ex.Message)
' End Try
'Next
End Function
Public Function saveasbitmap(ByRef ctl As Control, ByVal filename As String)
Dim g As Graphics = ctl.CreateGraphics
Dim b As New Bitmap(ctl.Width, ctl.Height)
ctl.DrawToBitmap(b, New Rectangle(0, 0, ctl.Width, ctl.Height))
'b.Save("E:\Software-Projekte\Vertragsverwaltung\Screens\" & filename & ".jpg", System.Drawing.Imaging.ImageFormat.Jpeg)
End Function
#End Region
End Class
''' <summary>
''' Klasse für ein Control-Objekt
''' </summary>
''' <remarks></remarks>
Public Class MyFormControls
Public MyControl As Object
Public MyFormname As String
Public MySecurityObjecttype As String
Public MySecurityObject As String
Public MySecurityObjectItem As String
Public MyDescription As String
Public MyLevel As Integer
''' <summary>
''' Neue Instanz erstellen
''' </summary>
''' <param name="ctl">Control-Objekt</param>
''' <param name="Formname">Betroffenes Formular</param>
''' <param name="securityobjecttype">Objekttyp</param>
''' <param name="Securityobject">Objektname</param>
''' <param name="SecurityObjectItem">Unterobjekt (z.B. bei Menus, Spalten von C1TrueDBGrids)</param>
''' <remarks></remarks>
Sub New(ByVal ctl As Object, ByVal Formname As String, ByVal securityobjecttype As String, ByVal Securityobject As String, ByVal SecurityObjectItem As String, Optional ByVal level As Integer = 0, Optional ByVal desc As String = "")
MyControl = ctl
MySecurityObjecttype = securityobjecttype
MyFormname = Formname
MySecurityObject = Securityobject
MySecurityObjectItem = SecurityObjectItem
If desc = "" Then
MyDescription = Get_Description(ctl)
Else
MyDescription = desc
End If
Try
MyDescription = MyDescription.Replace("&", "")
Catch ex As Exception
End Try
MyLevel = level
End Sub
Private Function Get_Description(ByRef ctl As Object) As String
Dim typ As System.Type = ctl.GetType
Select Case LCase(typ.Name)
Case "menustrip", "toolstripmenuitem", "toolstrip", "toolstripbutton", "contextmenustrip", "tabpage", "c1truedbgrid", "label"
Return ctl.Text
Case Else
Return ctl.Name
End Select
End Function
''' <summary>
''' Schreibt einen Datnsatz in die Tabelle SecurityObjects
''' </summary>
''' <returns></returns>
''' <remarks></remarks>
Public Function Write_Object_to_DB()
If Objexists() Then Exit Function
Dim sectbl As New DB.clsSecurityObject
Dim dbkey As New DB.clsMyKey_Tabelle
dbkey.cpMainConnectionProvider = Globals.conn
Dim newkey As Integer = dbkey.get_dbkey("SecurityObject")
sectbl.cpMainConnectionProvider = Globals.conn
conn.OpenConnection()
sectbl.iSecurityObjectNr = New SqlInt32(CType(newkey, Int32))
sectbl.sSecurityForm = New SqlString(CType(MyFormname, String))
sectbl.sSecurityObjectType = New SqlString(CType(Me.MySecurityObjecttype, String))
sectbl.sSecurityObject = New SqlString(CType(Me.MySecurityObject, String))
sectbl.sSecurityObjectItem = New SqlString(CType(Me.MySecurityObjectItem, String))
sectbl.bAktiv = New SqlBoolean(CType(True, Boolean))
sectbl.daErstellt_am = New SqlDateTime(CType(Now, DateTime))
sectbl.daMutiert_am = New SqlDateTime(CType(Now, DateTime))
sectbl.sSecurityObjectDescriotion = New SqlString(CType(Me.MyDescription, String))
sectbl.iLevel = New SqlInt32(CType(Me.MyLevel, Int32))
sectbl.iMutierer = New SqlInt32(CType(Globals.clsmitarbeiter.iMitarbeiternr.Value, Int32))
sectbl.iMandantnr = New SqlInt32(CType(Globals.clsmitarbeiter.iMandantnr.Value, Int32))
sectbl.Insert()
conn.CloseConnection(True)
sectbl.Dispose()
dbkey.Dispose()
End Function
''' <summary>
'''Prüft, ob das Security-Objekt bereits auf der DB vorhanden ist
''' </summary>
''' <returns></returns>
''' <remarks></remarks>
Private Function Objexists() As Boolean
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
scmCmdToExecute.CommandText = "dbo.[my_security_check_entry]"
scmCmdToExecute.CommandType = CommandType.StoredProcedure
scmCmdToExecute.Connection = conn.scoDBConnection
Try
scmCmdToExecute.Parameters.Add(New SqlParameter("@form", SqlDbType.VarChar, 255, ParameterDirection.Input, True, 0, 0, "", DataRowVersion.Proposed, Me.MyFormname))
scmCmdToExecute.Parameters.Add(New SqlParameter("@objecttype", SqlDbType.VarChar, 255, ParameterDirection.Input, True, 0, 0, "", DataRowVersion.Proposed, Me.MySecurityObjecttype))
scmCmdToExecute.Parameters.Add(New SqlParameter("@object", SqlDbType.VarChar, 255, ParameterDirection.Input, True, 0, 0, "", DataRowVersion.Proposed, Me.MySecurityObject))
scmCmdToExecute.Parameters.Add(New SqlParameter("@objectitem", SqlDbType.VarChar, 255, ParameterDirection.Input, True, 0, 0, "", DataRowVersion.Proposed, Me.MySecurityObjectItem))
scmCmdToExecute.Parameters.Add(New SqlParameter("@objexists", SqlDbType.Int, 4, ParameterDirection.Output, True, 0, 0, "", DataRowVersion.Proposed, 0))
scmCmdToExecute.Connection.Open()
scmCmdToExecute.ExecuteNonQuery()
If scmCmdToExecute.Parameters("@objexists").Value > 0 Then
Return True
Else
Return False
End If
Catch ex As Exception
Finally
scmCmdToExecute.Connection.Close()
End Try
End Function
End Class
Public Class ControlsCollection
Private Shared m_controls As Collection
Public Sub New(ByVal myForm As Form)
m_controls = New Collection
'create a control walker to get
'all controls on the form
Dim aControlWalker As New ControlWalker(myForm)
End Sub
'This property returns the collection of all controls
'on the form
ReadOnly Property Controls() As Collection
Get
Return m_controls
End Get
End Property
Public Function FindControl(ByVal ctlname As String) As Boolean
Dim i As Integer
For i = 1 To Me.m_controls.Count
Dim ctl As Control = m_controls(i)
If UCase(ctl.Name) = UCase(ctlname) Then MsgBox("found")
Next
End Function
Private Class ControlWalker
' This class recursively walks through all controls
' in a container, and all containers contained in
' this container, visiting all controls throughout
' the hierarchy
Private mContainer As Object
Public Sub New(ByVal Container As Object)
Dim cControl As Control
If Container.haschildren Then
For Each cControl In Container.controls
'add this control to the controls collection
m_controls.Add(cControl)
If cControl.HasChildren Then
'This control has children, create another
'ControlWalk go visit each of them
Dim cWalker As New ControlWalker(cControl)
End If
Next cControl
End If
End Sub
End Class
End Class
End Namespace

File diff suppressed because it is too large Load Diff

View File

@@ -0,0 +1,64 @@
Public Class frmVorgabeDefinition
Dim Vorgabedefinition As New clsVorgabeDefinition
Dim mKey As Integer
Property Key As Integer
Get
Return mKey
End Get
Set(value As Integer)
mKey = value
End Set
End Property
Dim m_VorgabeID As Integer
Property VorgabeID As Integer
Get
Return m_VorgabeID
End Get
Set(value As Integer)
m_VorgabeID = value
End Set
End Property
Private Sub TSBtnQuit_Click(sender As Object, e As EventArgs) Handles TSBtnQuit.Click
Me.Close()
End Sub
Private Sub btnAbbruch_Click(sender As Object, e As EventArgs) Handles btnAbbruch.Click
Me.DialogResult = DialogResult.Abort
End Sub
Private Sub btnSave_Click(sender As Object, e As EventArgs) Handles btnSave.Click
Me.DialogResult = DialogResult.OK
If Me.Key = -1 Then
Vorgabedefinition.Add_New()
Me.Key = Vorgabedefinition.iVorgabeDefinitionNr
Else
Vorgabedefinition.Get_Data(Me.Key)
End If
Vorgabedefinition.sDefinition = New SqlTypes.SqlString(CType(Me.txtDefinition.Text, String))
Vorgabedefinition.sBemerkungen = New SqlTypes.SqlString(CType(Me.txtBemerkung.Text, String))
Vorgabedefinition.daGueltig_bis = New SqlTypes.SqlDateTime(CType(Me.dtGueltigbis.Value, DateTime))
Vorgabedefinition.iVorgabeNr = New SqlTypes.SqlInt32(CType(Me.VorgabeID, Int16))
Vorgabedefinition.bAktiv = New SqlTypes.SqlBoolean(CType(Me.cbaktiv.Checked, Boolean))
Vorgabedefinition.sBezeichnung = New SqlTypes.SqlString(CType(Me.txtBezeichnung.Text, String))
Vorgabedefinition.Save_Data()
Me.Close()
End Sub
Private Sub frmVorgabeDefinition_Load(sender As Object, e As EventArgs) Handles MyBase.Load
If Me.Key > 0 Then
Vorgabedefinition.Get_Data(Me.Key)
Me.txtDefinition.Text = Vorgabedefinition.sDefinition.Value.ToString
Me.txtBemerkung.Text = Vorgabedefinition.sBemerkungen.Value.ToString
Me.dtGueltigbis.Value = Vorgabedefinition.daGueltig_bis.Value
Me.cbaktiv.Checked = Vorgabedefinition.bAktiv.Value = True
Me.txtBezeichnung.Text = Vorgabedefinition.sBezeichnung.Value.ToString
Else
Me.cbaktiv.Checked = True
Me.dtGueltigbis.Value = "31.12.2099"
End If
End Sub
End Class