Files
Emmanuele Sassi a709773825 EgwWPFBaseLib 3.1.7.3:
- aggiunta proprieta' per bindare icona del programma invece che averla sempre di default
2026-07-13 18:18:46 +02:00

479 lines
18 KiB
VB.net

' Follow steps 1a or 1b and then 2 to use this custom control in a XAML file.
'
' Step 1a) Using this custom control in a XAML file that exists in the current project.
' Add this XmlNamespace attribute to the root element of the markup file where it is
' to be used:
'
' xmlns:MyNamespace="clr-namespace:Effector.Plugin.Lib"
'
'
' Step 1b) Using this custom control in a XAML file that exists in a different project.
' Add this XmlNamespace attribute to the root element of the markup file where it is
' to be used:
'
' xmlns:MyNamespace="clr-namespace:Effector.Plugin.Lib;assembly=Effector.Plugin.Lib"
'
' You will also need to add a project reference from the project where the XAML file lives
' to this project and Rebuild to avoid compilation errors:
'
' Right click on the target project in the Solution Explorer and
' "Add Reference"->"Projects"->[Browse to and select this project]
'
'
' Step 2)
' Go ahead and use your control in the XAML file. Note that Intellisense in the
' XML editor does not currently work on custom controls and its child elements.
'
' <MyNamespace:EgtWindow/>
'
Imports System.Globalization
Imports System.IO
Imports System.Runtime.InteropServices
Imports System.Text
Imports System.Windows.Controls.Primitives
Imports System.Windows.Interop
Imports System.Xml.Serialization
<TemplatePart(Name:="PART_MinimizeBtn", Type:=GetType(Button))>
<TemplatePart(Name:="PART_MaximizeRestoreBtn", Type:=GetType(Button))>
<TemplatePart(Name:="PART_CloseBtn", Type:=GetType(Button))>
Public Class EgtWindow
Inherits System.Windows.Window
Private Const WM_GETMINMAXINFO As Integer = &H24
Private Const MONITOR_DEFAULTTONEAREST As UInteger = &H2
Private Const SW_SHOWNORMAL As Integer = 1
Private Const SW_SHOWMINIMIZED As Integer = 2
<Serializable>
<StructLayout(LayoutKind.Sequential)>
Public Structure RECT
Public Left As Integer
Public Top As Integer
Public Right As Integer
Public Bottom As Integer
Public Sub New(ByVal left As Integer, ByVal top As Integer, ByVal right As Integer, ByVal bottom As Integer)
Me.Left = left
Me.Top = top
Me.Right = right
Me.Bottom = bottom
End Sub
End Structure
<StructLayout(LayoutKind.Sequential)>
Public Structure MONITORINFO
Public cbSize As Integer
Public rcMonitor As RECT
Public rcWork As RECT
Public dwFlags As UInteger
End Structure
<Serializable>
<StructLayout(LayoutKind.Sequential)>
Public Structure POINT
Public X As Integer
Public Y As Integer
Public Sub New(ByVal x As Integer, ByVal y As Integer)
Me.X = x
Me.Y = y
End Sub
End Structure
<StructLayout(LayoutKind.Sequential)>
Public Structure MINMAXINFO
Public ptReserved As POINT
Public ptMaxSize As POINT
Public ptMaxPosition As POINT
Public ptMinTrackSize As POINT
Public ptMaxTrackSize As POINT
End Structure
<Serializable>
<StructLayout(LayoutKind.Sequential)>
Public Structure WINDOWPLACEMENT
Public length As Integer
Public flags As Integer
Public showCmd As Integer
Public minPosition As POINT
Public maxPosition As POINT
Public normalPosition As RECT
End Structure
Private Shared _cachedIcon As ImageSource
' proprieta' che permette di bindare l'icona dell'applicazione in cui viene lanciata questa dll
Public Shared ReadOnly AppIconProperty As DependencyProperty = DependencyProperty.Register("AppIcon", GetType(ImageSource), GetType(EgtWindow), New PropertyMetadata(Nothing))
Public Property AppIcon As ImageSource
Get
Return CType(GetValue(AppIconProperty), ImageSource)
End Get
Set(value As ImageSource)
SetValue(AppIconProperty, value)
End Set
End Property
' Proprietà che permette di impostare l'altezza della TitleBar
Public Shared ReadOnly TitleBarHeightProperty As DependencyProperty = DependencyProperty.Register("TitleBarHeight", GetType(Double), GetType(EgtWindow), New PropertyMetadata(0.0))
Public Property TitleBarHeight() As Double
Get
Return CType(GetValue(TitleBarHeightProperty), Double)
End Get
Set(ByVal value As Double)
SetValue(TitleBarHeightProperty, value)
End Set
End Property
' Proprietà che permette di impostare uno UserControl per aggiungere elementi alla TitleBar
Public Shared ReadOnly TitlePanelProperty As DependencyProperty = DependencyProperty.Register("TitlePanel", GetType(Panel), GetType(EgtWindow), New PropertyMetadata(Nothing))
Public Property TitlePanel() As Panel
Get
Return DirectCast(GetValue(TitlePanelProperty), Panel)
End Get
Set(ByVal value As Panel)
SetValue(TitlePanelProperty, value)
End Set
End Property
' Proprietà che permette di attivare e disattivare lo spostamento della finestra
Public Shared ReadOnly IsMinimizableProperty As DependencyProperty = DependencyProperty.Register("IsMinimizable", GetType(Boolean), GetType(EgtWindow), New PropertyMetadata(True))
Public Property IsMinimizable() As Boolean
Get
Return CBool(GetValue(IsMinimizableProperty))
End Get
Set(ByVal value As Boolean)
SetValue(IsMinimizableProperty, value)
End Set
End Property
' Proprietà che permette di attivare e disattivare il resize della finestra
Public Shared ReadOnly IsResizableProperty As DependencyProperty = DependencyProperty.Register("IsResizable", GetType(Boolean), GetType(EgtWindow), New PropertyMetadata(True, AddressOf OnIsResizablePropertyChanged))
Public Property IsResizable() As Boolean
Get
Return CBool(GetValue(IsResizableProperty))
End Get
Set(ByVal value As Boolean)
SetValue(IsResizableProperty, value)
End Set
End Property
Private Shared Sub OnIsResizablePropertyChanged(sender As DependencyObject, e As DependencyPropertyChangedEventArgs)
Dim Window As EgtWindow = DirectCast(sender, EgtWindow)
Dim NewValue As Boolean = True
If Boolean.TryParse(e.NewValue, NewValue) Then
Window.ResizeMode = If(NewValue, ResizeMode.CanResize, ResizeMode.NoResize)
Else
Window.ResizeMode = ResizeMode.CanResize
End If
End Sub
' Proprietà che permette di attivare e disattivare il bottone di chiusura della finestra
Public Shared ReadOnly IsClosableProperty As DependencyProperty = DependencyProperty.Register("IsClosable", GetType(Boolean), GetType(EgtWindow), New PropertyMetadata(True))
Public Property IsClosable() As Boolean
Get
Return CBool(GetValue(IsClosableProperty))
End Get
Set(ByVal value As Boolean)
SetValue(IsClosableProperty, value)
End Set
End Property
'Private Shared encoding As Encoding = New UTF8Encoding()
'Private Shared serializer As XmlSerializer = New XmlSerializer(GetType(WINDOWPLACEMENT))
Private m_Placement_AppName As String = ""
Public Sub SetPlacementAppName(Placement_AppName As String)
m_Placement_AppName = Placement_AppName
End Sub
Private m_Placement_KeyName As String = ""
Public Sub SetPlacementKeyName(Placement_KeyName As String)
m_Placement_KeyName = Placement_KeyName
End Sub
Private m_Placement_FileName As String = ""
Public Sub SetPlacementFileName(Placement_FileName As String)
m_Placement_FileName = Placement_FileName
End Sub
#Region "CONSTRUCTOR"
Shared Sub New()
'This OverrideMetadata call tells the system that this element wants to provide a style that is different than its base class.
'This style is defined in themes\generic.xaml
DefaultStyleKeyProperty.OverrideMetadata(GetType(EgtWindow), New FrameworkPropertyMetadata(GetType(EgtWindow)))
End Sub
Sub New()
AddHandler Me.Closing, AddressOf OnWindowClosing
LoadHostApplicationIcon()
End Sub
#End Region ' CONSTRUCTOR
#Region "METHODS"
<DllImport("user32.dll")>
Private Shared Function MonitorFromWindow(ByVal handle As IntPtr, ByVal flags As UInteger) As IntPtr
End Function
<DllImport("user32.dll")>
Private Shared Function GetMonitorInfo(ByVal hMonitor As IntPtr, ByRef lpmi As MONITORINFO) As Boolean
End Function
<DllImport("user32.dll")>
Private Shared Function SetWindowPlacement(ByVal hWnd As IntPtr, <[In]> ByRef lpwndpl As WINDOWPLACEMENT) As Boolean
End Function
<DllImport("user32.dll")>
Private Shared Function GetWindowPlacement(ByVal hWnd As IntPtr, <Out> ByRef lpwndpl As WINDOWPLACEMENT) As Boolean
End Function
Public Overrides Sub OnApplyTemplate()
Dim MinimizeBtn As Button = TryCast(MyBase.GetTemplateChild("PART_MinimizeBtn"), Button)
If Not IsNothing(MinimizeBtn) Then
If IsMinimizable Then
AddHandler MinimizeBtn.Click, AddressOf OnMinimizeButtonClick
Else
MinimizeBtn.Visibility = Visibility.Collapsed
End If
End If
Dim MaximizeRestoreBtn As Button = TryCast(MyBase.GetTemplateChild("PART_MaximizeRestoreBtn"), Button)
If Not IsNothing(MaximizeRestoreBtn) Then
If IsResizable Then
AddHandler MaximizeRestoreBtn.Click, AddressOf OnMaximizeRestoreButtonClick
Else
MaximizeRestoreBtn.Visibility = Visibility.Collapsed
End If
End If
Dim CloseBtn As Button = TryCast(MyBase.GetTemplateChild("PART_CloseBtn"), Button)
If Not IsNothing(CloseBtn) Then
If IsClosable Then
AddHandler CloseBtn.Click, AddressOf OnCloseButtonClick
Else
CloseBtn.Visibility = Visibility.Collapsed
End If
End If
End Sub
Protected Overrides Sub OnSourceInitialized(ByVal e As EventArgs)
MyBase.OnSourceInitialized(e)
CType(PresentationSource.FromVisual(Me), HwndSource).AddHook(AddressOf HookProc)
If Me.SizeToContent = SizeToContent.Manual Then
Dim sPlacement As String = ""
GetPrivateProfileString(m_Placement_AppName, m_Placement_KeyName, "", sPlacement, m_Placement_FileName)
If Not String.IsNullOrWhiteSpace(sPlacement) Then
SetPlacement(sPlacement)
End If
End If
Me.InvalidateMeasure()
End Sub
Public Shared Function HookProc(ByVal hwnd As IntPtr, ByVal msg As Integer, ByVal wParam As IntPtr, ByVal lParam As IntPtr, ByRef handled As Boolean) As IntPtr
If msg = WM_GETMINMAXINFO Then
Dim mmi As MINMAXINFO = CType(Marshal.PtrToStructure(lParam, GetType(MINMAXINFO)), MINMAXINFO)
Dim monitor As IntPtr = MonitorFromWindow(hwnd, MONITOR_DEFAULTTONEAREST)
If monitor <> IntPtr.Zero Then
Dim monitorInfo As MONITORINFO = New MONITORINFO()
monitorInfo.cbSize = Marshal.SizeOf(GetType(MONITORINFO))
GetMonitorInfo(monitor, monitorInfo)
Dim rcWorkArea As RECT = monitorInfo.rcWork
Dim rcMonitorArea As RECT = monitorInfo.rcMonitor
mmi.ptMaxPosition.X = Math.Abs(rcWorkArea.Left - rcMonitorArea.Left)
mmi.ptMaxPosition.Y = Math.Abs(rcWorkArea.Top - rcMonitorArea.Top)
mmi.ptMaxSize.X = Math.Abs(rcWorkArea.Right - rcWorkArea.Left)
mmi.ptMaxSize.Y = Math.Abs(rcWorkArea.Bottom - rcWorkArea.Top)
End If
Marshal.StructureToPtr(mmi, lParam, True)
End If
Return IntPtr.Zero
End Function
Shared Sub SetPlacement(ByVal windowHandle As IntPtr, ByVal placementXml As String)
If String.IsNullOrEmpty(placementXml) Then
Return
End If
Dim placement As WINDOWPLACEMENT
Try
placement = StringToPlacement(placementXml)
'Using memoryStream As TextReader = New StringReader(placementXml)
' placement = CType(serializer.Deserialize(memoryStream), WINDOWPLACEMENT)
'End Using
placement.length = Marshal.SizeOf(GetType(WINDOWPLACEMENT))
placement.flags = 0
placement.showCmd = (If(placement.showCmd = SW_SHOWMINIMIZED, SW_SHOWNORMAL, placement.showCmd))
SetWindowPlacement(windowHandle, placement)
Catch __unusedInvalidOperationException1__ As InvalidOperationException
End Try
End Sub
Private Shared Function PlacementToString(Placement As WINDOWPLACEMENT) As String
Dim sPlacement As String = ""
sPlacement = Placement.length.ToString() & ";" &
Placement.flags.ToString() & ";" &
Placement.showCmd.ToString() & ";"
sPlacement &= PointToString(Placement.minPosition) & ";"
sPlacement &= PointToString(Placement.maxPosition) & ";"
sPlacement &= RectToString(Placement.normalPosition)
Return sPlacement
End Function
Private Shared Function PointToString(Point As POINT) As String
Dim sPoint As String = ""
sPoint = Point.X.ToString() & "," &
Point.Y.ToString()
Return sPoint
End Function
Private Shared Function RectToString(Rect As RECT) As String
Dim sRect As String = ""
sRect = Rect.Left.ToString() & "," &
Rect.Top.ToString() & "," &
Rect.Right.ToString() & "," &
Rect.Bottom.ToString()
Return sRect
End Function
Shared Function GetPlacement(ByVal windowHandle As IntPtr) As String
Dim placement As WINDOWPLACEMENT = New WINDOWPLACEMENT()
GetWindowPlacement(windowHandle, placement)
Return PlacementToString(placement)
'Using TextWriter As StringWriter = New StringWriter()
' serializer.Serialize(TextWriter, placement)
' Return TextWriter.ToString().Replace(Environment.NewLine, "")
'End Using
End Function
Private Shared Function StringToPlacement(sPlacement As String) As WINDOWPLACEMENT
Dim Placement As WINDOWPLACEMENT
Dim sPlacementArray As String() = sPlacement.Split(";"c)
If sPlacementArray.Length < 5 Then
Placement.normalPosition = New RECT(100, 100, 800, 800)
Return Placement
End If
Integer.TryParse(sPlacementArray(0), Placement.length)
Integer.TryParse(sPlacementArray(1), Placement.flags)
Integer.TryParse(sPlacementArray(2), Placement.showCmd)
Placement.minPosition = StringToPoint(sPlacementArray(3))
Placement.maxPosition = StringToPoint(sPlacementArray(4))
Placement.normalPosition = StringToRect(sPlacementArray(5))
Return Placement
End Function
Private Shared Function StringToPoint(sPoint As String) As POINT
Dim sPointArray As String() = sPoint.Split(","c)
Dim nX As Integer = 0
Dim nY As Integer = 0
Integer.TryParse(sPointArray(0), nX)
Integer.TryParse(sPointArray(1), nY)
Return New POINT(nX, nY)
End Function
Private Shared Function StringToRect(sRect As String) As RECT
Dim sRectArray As String() = sRect.Split(","c)
Dim nLeft As Integer = 0
Dim nTop As Integer = 0
Dim nRight As Integer = 0
Dim nBottom As Integer = 0
Integer.TryParse(sRectArray(0), nLeft)
Integer.TryParse(sRectArray(1), nTop)
Integer.TryParse(sRectArray(2), nRight)
Integer.TryParse(sRectArray(3), nBottom)
Return New RECT(nLeft, nTop, nRight, nBottom)
End Function
Public Sub SetPlacement(ByVal placementXml As String)
SetPlacement(New WindowInteropHelper(Me).Handle, placementXml)
End Sub
Public Function GetPlacement() As String
Return GetPlacement(New WindowInteropHelper(Me).Handle)
End Function
Private Sub LoadHostApplicationIcon()
If _cachedIcon IsNot Nothing Then
AppIcon = _cachedIcon
Return
End If
Dim exePath = System.Reflection.Assembly.GetEntryAssembly().Location
Dim ico = System.Drawing.Icon.ExtractAssociatedIcon(exePath)
Using ms As New MemoryStream()
ico.ToBitmap().Save(ms, System.Drawing.Imaging.ImageFormat.Png)
ms.Position = 0
Dim bmp As New BitmapImage()
bmp.BeginInit()
bmp.StreamSource = ms
bmp.CacheOption = BitmapCacheOption.OnLoad
bmp.EndInit()
_cachedIcon = bmp
AppIcon = bmp
End Using
End Sub
#End Region ' METHODS
#Region "EVENTS"
Public Sub OnMinimizeButtonClick(ByVal sender As Object, ByVal e As RoutedEventArgs)
Me.WindowState = WindowState.Minimized
End Sub
Public Sub OnMaximizeRestoreButtonClick(ByVal sender As Object, ByVal e As RoutedEventArgs)
If Me.WindowState = WindowState.Maximized Then
Me.WindowState = WindowState.Normal
Else
Me.WindowState = WindowState.Maximized
End If
End Sub
Public Overridable Sub OnCloseButtonClick(ByVal sender As Object, ByVal e As RoutedEventArgs)
Me.Close()
End Sub
Private Sub OnWindowClosing(sender As Object, e As System.ComponentModel.CancelEventArgs)
If (Keyboard.Modifiers And ModifierKeys.Alt) = ModifierKeys.Alt OrElse Keyboard.IsKeyDown(Key.F4) Then
e.Cancel = True
Return
End If
If Me.SizeToContent = SizeToContent.Manual Then
WritePrivateProfileString(m_Placement_AppName, m_Placement_KeyName, GetPlacement(), m_Placement_FileName)
End If
End Sub
#End Region ' EVENTS
End Class
Public Class CaptionHeightConverter
Implements IValueConverter
Public Function Convert(value As Object, targetType As Type, parameter As Object, culture As CultureInfo) As Object Implements IValueConverter.Convert
If Not TypeOf value Is Double Then Return 39
Dim dValue As Double = CDbl(value)
Return dValue + 7
End Function
Public Function ConvertBack(value As Object, targetType As Type, parameter As Object, culture As CultureInfo) As Object Implements IValueConverter.ConvertBack
Throw New NotImplementedException()
End Function
End Class