Modules/GUIs.ZooFlow/frmFlowForm_Layered.vb
Jonathan Jenne fc72bf5ff1 jj
2020-09-08 11:22:19 +02:00

251 lines
9.6 KiB
VB.net

Imports System.ComponentModel
Imports System.Drawing.Imaging
Imports DigitalData.Modules.Logging
Imports DigitalData.Modules.Messaging
Public Class frmFlowForm_Layered
Private WithEvents Watcher As ClassClipboardWatcher = ClassClipboardWatcher.Singleton
Private ActiveModules As List(Of String)
Private Logger As Logger
Private ESCHitCount As Integer = 0
Private CurrentState As OnFlowFormStateChangedEvent.FlowFormState = OnFlowFormStateChangedEvent.FlowFormState.Default
Private DTIDB_SEARCHES As DataTable
Private IDBSearchActive As Boolean = False
Const WS_EX_LAYERED As Int32 = &H80000
Public Event ClipboardChanged As EventHandler(Of IDataObject)
Public Sub New()
' Dieser Aufruf ist für den Designer erforderlich.
InitializeComponent()
' Fügen Sie Initialisierungen nach dem InitializeComponent()-Aufruf hinzu.
ActiveModules = New List(Of String)
Logger = My.LogConfig.GetLogger()
End Sub
Public Sub New(ActiveModules As List(Of String))
' Dieser Aufruf ist für den Designer erforderlich.
InitializeComponent()
' Fügen Sie Initialisierungen nach dem InitializeComponent()-Aufruf hinzu.
Me.ActiveModules = ActiveModules
Logger = My.LogConfig.GetLogger()
End Sub
Private Sub frmFlowForm_Load(sender As Object, e As EventArgs) Handles MyBase.Load
' === Set Form Properties ===
TopMost = True
AllowDrop = True
ShowInTaskbar = False
SetFormLocation()
SetFormState(OnFlowFormStateChangedEvent.FlowFormState.Default)
' === Register Events ===
AddHandler MouseClick, AddressOf Form_MouseClick
AddHandler MouseMove, AddressOf Form_MouseMove
AddHandler KeyDown, AddressOf Form_KeyDown
' === Register As Event Listener ===
EventBus.Instance.Register(Me)
' === TESTING Actions ===
Dim oSQL = $"SELECT * FROM [dbo].[FNIDB_GET_SEARCH_PROFILES] ({My.Application.User.UserId},'{My.Application.User.Language}')"
Dim oDT As DataTable = My.Database_IDB.GetDatatable(oSQL)
SucheToolStripMenuItem.Visible = False
If Not IsNothing(oDT) Then
If oDT.Rows.Count > 0 Then
IDBSearchActive = True
DTIDB_SEARCHES = oDT
SucheToolStripMenuItem.Visible = True
End If
End If
My.DTAttributes = My.Database_IDB.GetDatatable("SELECT * FROM TBIDB_ATTRIBUTE")
End Sub
Private Sub frmFlowForm_Closed(sender As Object, e As EventArgs) Handles Me.Closed
Try
EventBus.Instance.Unregister(Me)
Catch ex As Exception
Logger.Error(ex)
End Try
End Sub
Private Sub Form_MouseClick(sender As Object, ByVal e As MouseEventArgs)
If e.Button = MouseButtons.Right Then
ContextMenuStrip1.Show(Cursor.Position)
Else
If CurrentState = OnFlowFormStateChangedEvent.FlowFormState.HasSearchResults Then
SetFormState(OnFlowFormStateChangedEvent.FlowFormState.Default)
EventBus.Instance.PostEvent(New OnFlowFormInteractionEvent(OnFlowFormInteractionEvent.FlowFormInteraction.Click))
End If
End If
End Sub
Private Sub Form_MouseMove(ByVal sender As Object, ByVal e As MouseEventArgs)
If e.Button = MouseButtons.Left Then
ClassWin32.ReleaseCapture()
ClassWin32.SendMessage(Handle, ClassWin32.WM_NCLBUTTONDOWN, ClassWin32.HTCAPTION, 0)
End If
End Sub
Private Sub Form_KeyDown(ByVal sender As Object, ByVal e As KeyEventArgs)
If e.KeyCode = Keys.Escape Then
If ESCHitCount > 0 Then
Dim result As DialogResult = MessageBox.Show("Exit Zooflow", "Please Varify", MessageBoxButtons.YesNo)
If result = DialogResult.Yes Then
Application.Exit()
Else
ESCHitCount = 0
End If
Else
ESCHitCount += 1
End If
ElseIf e.KeyCode = Keys.D AndAlso (e.Control) Then
If ActiveModules.Contains(ClassConstants.MODULE_ZOOFLOW) Then
MsgBox("Search")
End If
End If
End Sub
Public Sub OnEvent(e As OnFlowFormStateChangedEvent)
CurrentState = e.State
SetFormState(e.State)
End Sub
Public Sub SetFormState(State As OnFlowFormStateChangedEvent.FlowFormState)
Select Case State
Case OnFlowFormStateChangedEvent.FlowFormState.HasSearchResults
SetBitmap(My.Resources.CW_GEFUNDEN_klein)
Case OnFlowFormStateChangedEvent.FlowFormState.HasFileDropped
SetBitmap(My.Resources.GLOBIX_GEFUNDEN_klein)
Case Else
SetBitmap(My.Resources.ZOO_FLOW_Hintergrund)
End Select
End Sub
Public Sub SetFormLocation()
Me.Location = My.UIConfig.FlowForm.Location
End Sub
Private Sub frmFlowForm_DragOver(sender As Object, e As DragEventArgs) Handles Me.DragOver
If Not ActiveModules.Contains(ClassConstants.MODULE_GLOBAL_INDEXER) Then
e.Effect = DragDropEffects.None
Else
If e.Data.GetDataPresent(DataFormats.FileDrop) Then
' Handle file dragged from Windows
e.Effect = DragDropEffects.Copy
SetFormState(OnFlowFormStateChangedEvent.FlowFormState.HasFileDropped)
ElseIf e.Data.GetDataPresent("FileGroupDescriptor") Then
' Handle a message dragged from Outlook
e.Effect = DragDropEffects.Copy
SetFormState(OnFlowFormStateChangedEvent.FlowFormState.HasFileDropped)
ElseIf e.Data.GetDataPresent("aryFileGroupDescriptor") AndAlso (e.Data.GetDataPresent("FileContents")) Then
' Handle a message dragged from Thunderbird?
e.Effect = DragDropEffects.Copy
SetFormState(OnFlowFormStateChangedEvent.FlowFormState.HasFileDropped)
Else
' Otherwise, do not handle
e.Effect = DragDropEffects.None
End If
End If
End Sub
Private Sub frmFlowForm_DragLeave(sender As Object, e As EventArgs) Handles Me.DragLeave
SetFormState(OnFlowFormStateChangedEvent.FlowFormState.Default)
End Sub
Private Sub Watcher_ClipboardChanged(sender As Object, e As IDataObject) Handles Watcher.ClipboardChanged
If ActiveModules.Contains(ClassConstants.MODULE_CLIPBOARDWATCHER) Then
RaiseEvent ClipboardChanged(sender, e)
End If
End Sub
'''' <summary>
'''' DragDrop Support
'''' </summary>
'Protected Overrides Sub WndProc(ByRef m As Message)
' If m.Msg = &H84 Then
' m.Result = CType(2, IntPtr)
' Return
' End If
' MyBase.WndProc(m)
'End Sub
Public Sub SetBitmap(ByVal bitmap As Bitmap)
SetBitmap(bitmap, 255, bitmap.Width, bitmap.Height)
End Sub
Public Sub SetBitmap(ByVal Bitmap As Bitmap, ByVal Opacity As Byte, ByVal Width As Integer, ByVal Height As Integer)
If Bitmap.PixelFormat <> PixelFormat.Format32bppArgb Then
Throw New ApplicationException("The bitmap must be 32ppp with alpha-channel.")
End If
Dim oScreenDeviceContext As IntPtr = ClassWin32.GetDC(IntPtr.Zero)
Dim oMemoryDeviceContext As IntPtr = ClassWin32.CreateCompatibleDC(oScreenDeviceContext)
Dim oBitmap As IntPtr = IntPtr.Zero
Dim oOldBitmap As IntPtr = IntPtr.Zero
Try
oBitmap = Bitmap.GetHbitmap(Color.FromArgb(0))
oOldBitmap = ClassWin32.SelectObject(oMemoryDeviceContext, oBitmap)
Dim oSize As ClassWin32.Size = New ClassWin32.Size(Width, Height)
Dim oPointSource As ClassWin32.Point = New ClassWin32.Point(0, 0)
Dim oTopPos As ClassWin32.Point = New ClassWin32.Point(Left, Top)
Dim oBlend As ClassWin32.BLENDFUNCTION = New ClassWin32.BLENDFUNCTION With {
.BlendOp = ClassWin32.AC_SRC_OVER,
.BlendFlags = 0,
.SourceConstantAlpha = Opacity,
.AlphaFormat = ClassWin32.AC_SRC_ALPHA
}
ClassWin32.UpdateLayeredWindow(Handle, oScreenDeviceContext, oTopPos, oSize, oMemoryDeviceContext, oPointSource, 0, oBlend, ClassWin32.ULW_ALPHA)
Finally
ClassWin32.ReleaseDC(IntPtr.Zero, oScreenDeviceContext)
If oBitmap <> IntPtr.Zero Then
ClassWin32.SelectObject(oMemoryDeviceContext, oOldBitmap)
ClassWin32.DeleteObject(oBitmap)
End If
ClassWin32.DeleteDC(oMemoryDeviceContext)
End Try
End Sub
''' <summary>
''' More Info: https://docs.microsoft.com/en-us/windows/win32/winmsg/window-features#layered-windows
''' </summary>
''' <returns></returns>
Protected Overrides ReadOnly Property CreateParams As CreateParams
Get
Dim oParams As CreateParams = MyBase.CreateParams
oParams.ExStyle = oParams.ExStyle Or WS_EX_LAYERED
Return oParams
End Get
End Property
Private Sub FlowFormTest1ToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles FlowFormTest1ToolStripMenuItem.Click
frmFlowForm.Show()
End Sub
Private Sub ContextMenuStrip1_Opening(sender As Object, e As CancelEventArgs) Handles ContextMenuStrip1.Opening
End Sub
Private Sub SucheToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles SucheToolStripMenuItem.Click
Dim oForm As New frmSearchStart(DTIDB_SEARCHES)
oForm.Show()
End Sub
End Class