Folge dem Video um zu sehen, wie unsere Website als Web-App auf dem Startbildschirm installiert werden kann.
Anmerkung: Diese Funktion ist in einigen Browsern möglicherweise nicht verfügbar.
Public Class clsAufloesung
Private htControls As New Hashtable
Private meClientSize As New Size
Public Sub Anpassen(ByVal frm As Form)
Try
Dim ctl As Control
Dim ctl2 As Control
Dim ctl3 As Control
Dim ctl4 As Control
Dim ctl5 As Control
Dim ctl6 As Control
Dim pX As Double = meClientSize.Width / frm.ClientSize.Width
Dim pY As Double = meClientSize.Height / frm.ClientSize.Height
Dim rec As Rectangle
'Ebene 1
For Each ctl In frm.Controls
rec = DirectCast(htControls.Item(ctl.Name), Rectangle)
ctl.Left = CInt(rec.Left / pX)
ctl.Top = CInt(rec.Top / pY)
ctl.Width = CInt(rec.Width / pX)
ctl.Height = CInt(rec.Height / pY)
If TypeOf ctl Is GroupBox Then
'Ebene 2
For Each ctl2 In ctl.Controls
rec = DirectCast(htControls.Item(ctl2.Name), Rectangle)
ctl2.Left = CInt(rec.Left / pX)
ctl2.Top = CInt(rec.Top / pY)
ctl2.Width = CInt(rec.Width / pX)
ctl2.Height = CInt(rec.Height / pY)
If TypeOf ctl2 Is GroupBox Then
'Ebene 3
For Each ctl4 In ctl2.Controls
rec = DirectCast(htControls.Item(ctl4.Name), Rectangle)
ctl4.Left = CInt(rec.Left / pX)
ctl4.Top = CInt(rec.Top / pY)
ctl4.Width = CInt(rec.Width / pX)
ctl4.Height = CInt(rec.Height / pY)
ctl4.Refresh()
Next ctl4
End If
ctl2.Refresh()
Next ctl2
End If
If TypeOf ctl Is Panel Then
For Each ctl3 In ctl.Controls
rec = DirectCast(htControls.Item(ctl3.Name), Rectangle)
ctl3.Left = CInt(rec.Left / pX)
ctl3.Top = CInt(rec.Top / pY)
ctl3.Width = CInt(rec.Width / pX)
ctl3.Height = CInt(rec.Height / pY)
If TypeOf ctl2 Is GroupBox Then
'Ebene 3
For Each ctl5 In ctl2.Controls
rec = DirectCast(htControls.Item(ctl5.Name), Rectangle)
ctl5.Left = CInt(rec.Left / pX)
ctl5.Top = CInt(rec.Top / pY)
ctl5.Width = CInt(rec.Width / pX)
ctl5.Height = CInt(rec.Height / pY)
ctl5.Refresh()
'Ebene 4
For Each ctl6 In ctl5.Controls
rec = DirectCast(htControls.Item(ctl6.Name), Rectangle)
ctl6.Left = CInt(rec.Left / pX)
ctl6.Top = CInt(rec.Top / pY)
ctl6.Width = CInt(rec.Width / pX)
ctl6.Height = CInt(rec.Height / pY)
ctl6.Refresh()
Next
Next ctl5
End If
ctl3.Refresh()
Next ctl3
End If
ctl.Refresh()
Next ctl
Catch ex As Exception
MessageBox.Show("Fehler in objAuflösung_Anpassen" & vbCrLf & ex.Message, "Fehler...", MessageBoxButtons.OK, MessageBoxIcon.Error)
End Try
End Sub
Public Sub addHashTable(ByVal frm As Form)
Try
meClientSize = frm.ClientSize
Dim ctl As Control
Dim ctl2 As Control
Dim ctl3 As Control
Dim ctl4 As Control
Dim ctl5 As Control
Dim ctl6 As Control
'Ebene 1
For Each ctl In frm.Controls
htControls.Add(ctl.Name, New Rectangle(ctl.Location, ctl.Size))
If TypeOf ctl Is GroupBox Then
'Ebene 2
For Each ctl2 In ctl.Controls
htControls.Add(ctl2.Name, New Rectangle(ctl2.Location, ctl2.Size))
If TypeOf ctl2 Is GroupBox Then
'Ebene 3
For Each ctl4 In ctl2.Controls
htControls.Add(ctl4.Name, New Rectangle(ctl4.Location, ctl4.Size))
Next ctl4
End If
Next ctl2
End If
If TypeOf ctl Is Panel Then
For Each ctl3 In ctl.Controls
htControls.Add(ctl3.Name, New Rectangle(ctl3.Location, ctl3.Size))
If TypeOf ctl3 Is Panel Then
'Ebene 3
For Each ctl5 In ctl3.Controls
'Ebene4
htControls.Add(ctl5.Name, New Rectangle(ctl5.Location, ctl5.Size))
For Each ctl6 In ctl5.Controls
htControls.Add(ctl6.Name, New Rectangle(ctl6.Location, ctl6.Size))
Next ctl6
Next ctl5
End If
Next ctl3
End If
Next ctl
Catch ex As Exception
MessageBox.Show("Fehler in objAufloesung_addHashTable" & vbCrLf & ex.Message, "Fehler...", MessageBoxButtons.OK, MessageBoxIcon.Error)
End Try
End Sub
End Class
objAufloesung = New clsAufloesung
objAufloesung.addHashTable(Me)
objAufloesung.Anpassen(Me)