Anpassungen

This commit is contained in:
2025-01-22 09:09:06 +01:00
parent 5532a70acd
commit 7c523af046
4 changed files with 182 additions and 43 deletions

View File

@@ -47,19 +47,40 @@ Public Class frmFullScreen
'Me.Close() 'Me.Close()
End Sub End Sub
Private Function MakeScreenshot() As Bitmap 'Private Function MakeScreenshot() As Bitmap
Dim tmp_width As Integer = CursorPos1.X - CursorPos2.X ' Dim tmp_width As Integer = CursorPos1.X - CursorPos2.X
Dim tmp_Height As Integer = CursorPos1.Y - CursorPos2.Y ' Dim tmp_Height As Integer = CursorPos1.Y - CursorPos2.Y
If tmp_width = 0 Then Return Nothing ' If tmp_width = 0 Then Return Nothing
If tmp_Height = 0 Then Return Nothing ' If tmp_Height = 0 Then Return Nothing
If tmp_width <= 0 Then tmp_width *= -1 'Me.Close() ' If tmp_width <= 0 Then tmp_width *= -1 'Me.Close()
If tmp_Height <= 0 Then tmp_Height *= -1 ' Me.Close() ' If tmp_Height <= 0 Then tmp_Height *= -1 ' Me.Close()
' MsgBox(tmp_width & "-" & tmp_Height) ' ' MsgBox(tmp_width & "-" & tmp_Height)
Dim bmp As New Bitmap(tmp_width, tmp_Height) ' Dim bmp As New Bitmap(tmp_width, tmp_Height)
' Dim g = Graphics.FromImage(bmp)
' g.CopyFromScreen(CursorPos1.X, CursorPos1.Y, 0, 0, New Size(tmp_width, tmp_Height))
' g.Dispose()
' Return bmp
'End Function
Private Function MakeScreenshot() As Bitmap
' Berechnung der oberen linken Ecke (Startpunkt des Rechtecks)
Dim x As Integer = Math.Min(CursorPos1.X, CursorPos2.X)
Dim y As Integer = Math.Min(CursorPos1.Y, CursorPos2.Y)
' Berechnung der Breite und Höhe
Dim width As Integer = Math.Abs(CursorPos1.X - CursorPos2.X)
Dim height As Integer = Math.Abs(CursorPos1.Y - CursorPos2.Y)
' Sicherstellen, dass Breite und Höhe gültig sind
If width = 0 Or height = 0 Then Return Nothing
' Erstellen des Screenshots basierend auf dem Rechteck
Dim bmp As New Bitmap(width, height)
Dim g = Graphics.FromImage(bmp) Dim g = Graphics.FromImage(bmp)
g.CopyFromScreen(CursorPos1.X, CursorPos1.Y, 0, 0, New Size(tmp_width, tmp_Height)) g.CopyFromScreen(x, y, 0, 0, New Size(width, height))
g.Dispose() g.Dispose()
Return bmp Return bmp
End Function End Function
@@ -75,41 +96,38 @@ Public Class frmFullScreen
Private Sub PictureBox1_MouseMove(sender As Object, e As MouseEventArgs) Handles pic.MouseMove Private Sub PictureBox1_MouseMove(sender As Object, e As MouseEventArgs) Handles pic.MouseMove
'If isMouseDown = True Then 'If isMouseDown = True Then
' rect.Location = e.Location ' rect.Location = CursorPos1
' If rect.Right > pic.Width Then
' rect.X = pic.Width - rect.Width
' End If
' If rect.Top < 0 Then ' Dim tmp_width As Integer = CursorPos1.X - Cursor.Position.X
' rect.Y = 0 ' Dim tmp_Height As Integer = CursorPos1.Y - Cursor.Position.Y
' End If ' If tmp_width <= 0 Then tmp_width *= -1 'Me.Close()
' If tmp_Height <= 0 Then tmp_Height *= -1 ' Me.Close()
' If rect.Left < 0 Then ' rect.Width = tmp_width
' rect.X = 0 ' rect.Height = tmp_Height
' End If
' If rect.Bottom > pic.Height Then
' rect.Y = pic.Height - rect.Height
' End If
' Refresh() ' Refresh()
'End If 'End If
If isMouseDown = True Then If isMouseDown Then
rect.Location = CursorPos1 ' Berechnung der oberen linken Ecke (Startpunkt des Rechtecks)
Dim x As Integer = Math.Min(CursorPos1.X, Cursor.Position.X)
Dim y As Integer = Math.Min(CursorPos1.Y, Cursor.Position.Y)
' Berechnung der Breite und Höhe
Dim width As Integer = Math.Abs(CursorPos1.X - Cursor.Position.X)
Dim height As Integer = Math.Abs(CursorPos1.Y - Cursor.Position.Y)
Dim tmp_width As Integer = CursorPos1.X - Cursor.Position.X ' Aktualisierung des Rechtecks
Dim tmp_Height As Integer = CursorPos1.Y - Cursor.Position.Y rect.Location = New Point(x, y)
If tmp_width <= 0 Then tmp_width *= -1 'Me.Close() rect.Width = width
If tmp_Height <= 0 Then tmp_Height *= -1 ' Me.Close() rect.Height = height
rect.Width = tmp_width
rect.Height = tmp_Height
' Bildschirm aktualisieren
Refresh() Refresh()
End If End If
End Sub End Sub

View File

@@ -17,6 +17,7 @@ Public Class frmMainOCR
Private Declare Sub UnregisterHotKey Lib "user32" (ByVal hWnd As IntPtr, ByVal id As Integer) Private Declare Sub UnregisterHotKey Lib "user32" (ByVal hWnd As IntPtr, ByVal id As Integer)
Private Const Key_NONE As Integer = &H0 Private Const Key_NONE As Integer = &H0
Private Const WM_HOTKEY As Integer = &H312 Private Const WM_HOTKEY As Integer = &H312
Private Const VK_ESCAPE As Integer = &H1B ' ESC-Taste
Protected Overrides Sub WndProc(ByRef m As Message) Protected Overrides Sub WndProc(ByRef m As Message)
'die messages auswerten 'die messages auswerten
If m.Msg = WM_HOTKEY Then If m.Msg = WM_HOTKEY Then
@@ -27,9 +28,23 @@ Public Class frmMainOCR
' MessageBox.Show("Sie haben die SUPTERTEST gedrückt!") ' MessageBox.Show("Sie haben die SUPTERTEST gedrückt!")
Button1.PerformClick() Button1.PerformClick()
End Select End Select
ElseIf m.Msg = VK_ESCAPE Then
MsgBox("TTTT")
CloseAllFrmFullScreen()
End If End If
MyBase.WndProc(m) MyBase.WndProc(m)
End Sub End Sub
Public Sub CloseAllFrmFullScreen()
' Iteriere über alle geöffneten Formulare
For Each form As Form In Application.OpenForms.Cast(Of Form).ToList()
' Prüfe, ob das Formular vom Typ frmFullScreen ist
If TypeOf form Is frmFullScreen Then
form.Close() ' Schließe das Formular
End If
Next
End Sub
Private Sub Form1_FormClosing(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing Private Sub Form1_FormClosing(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
'die tab taste wieder freigeben 'die tab taste wieder freigeben
UnregisterHotKey(Me.Handle, 1) UnregisterHotKey(Me.Handle, 1)
@@ -125,6 +140,8 @@ Public Class frmMainOCR
f.Location = SCR.WorkingArea.Location f.Location = SCR.WorkingArea.Location
'f.ShowDialog() 'f.ShowDialog()
f.Show() f.Show()
f.TopMost = True
f.BringToFront()
FORMS_SCR.Add(f) FORMS_SCR.Add(f)
PictureBox1.BackgroundImage = f.captured PictureBox1.BackgroundImage = f.captured
AddHandler f.CAPTURED_IMG, Sub(frmFullScreen As frmFullScreen) AddHandler f.CAPTURED_IMG, Sub(frmFullScreen As frmFullScreen)
@@ -209,7 +226,8 @@ Public Class frmMainOCR
' ' If annotation.IsNot Nothing Then ResultText &= annotation.Description & vbNewLine ' ' If annotation.IsNot Nothing Then ResultText &= annotation.Description & vbNewLine
'Next 'Next
If response2 IsNot Nothing AndAlso response2.Text <> "" Then If response2 IsNot Nothing AndAlso response2.Text <> "" Then
Dim f2 As New frmMessage(response2.Text) Dim f2 As New frmMessage()
f2.setMessageText(response2.Text)
f2.Show() f2.Show()
End If End If

View File

@@ -46,10 +46,12 @@ Partial Class frmMessage
' '
'RichTextBox 'RichTextBox
' '
Me.RichTextBox.BackColor = System.Drawing.Color.White
Me.RichTextBox.Dock = System.Windows.Forms.DockStyle.Fill Me.RichTextBox.Dock = System.Windows.Forms.DockStyle.Fill
Me.RichTextBox.Font = New System.Drawing.Font("Microsoft Sans Serif", 12.0!) Me.RichTextBox.Font = New System.Drawing.Font("Microsoft Sans Serif", 12.0!)
Me.RichTextBox.Location = New System.Drawing.Point(0, 30) Me.RichTextBox.Location = New System.Drawing.Point(0, 30)
Me.RichTextBox.Name = "RichTextBox" Me.RichTextBox.Name = "RichTextBox"
Me.RichTextBox.ReadOnly = True
Me.RichTextBox.Size = New System.Drawing.Size(369, 88) Me.RichTextBox.Size = New System.Drawing.Size(369, 88)
Me.RichTextBox.TabIndex = 1 Me.RichTextBox.TabIndex = 1
Me.RichTextBox.Text = "" Me.RichTextBox.Text = ""

View File

@@ -1,21 +1,122 @@
Public Class frmMessage Imports System.Runtime.InteropServices
Dim MessageTxt Public Class frmMessage
Sub New(MessageTxt) ' Windows-API-Funktion deklarieren
<DllImport("user32.dll", SetLastError:=True)>
Private Shared Function SetWindowPos(
hWnd As IntPtr,
hWndInsertAfter As IntPtr,
X As Integer,
Y As Integer,
cx As Integer,
cy As Integer,
uFlags As UInteger
) As Boolean
End Function
' Dieser Aufruf ist für den Designer erforderlich. ' Konstanten für SetWindowPos
Private Shared ReadOnly HWND_TOPMOST As New IntPtr(-1)
Private Const SWP_NOSIZE As UInteger = &H1
Private Const SWP_NOMOVE As UInteger = &H2
Private Const SWP_NOACTIVATE As UInteger = &H10
' Windows-API-Funktion deklarieren
<DllImport("gdi32.dll", EntryPoint:="CreateRoundRectRgn")>
Private Shared Function CreateRoundRectRgn(
nLeftRect As Integer,
nTopRect As Integer,
nRightRect As Integer,
nBottomRect As Integer,
nWidthEllipse As Integer,
nHeightEllipse As Integer
) As IntPtr
End Function
<DllImport("user32.dll", EntryPoint:="SetWindowRgn")>
Private Shared Function SetWindowRgn(
hWnd As IntPtr,
hRgn As IntPtr,
bRedraw As Boolean
) As Integer
End Function
' Konstruktor
Public Sub New()
InitializeComponent() InitializeComponent()
Me.MessageTxt = MessageTxt End Sub
' Fügen Sie Initialisierungen nach dem InitializeComponent()-Aufruf hinzu. ' Konstruktor
Public Sub New(responseText As String)
InitializeComponent()
Me.Text = responseText
End Sub End Sub
Private Sub frmMessage_Load(sender As Object, e As EventArgs) Handles Me.Load ' Methode zum Anzeigen des Fensters
Dim MessageTxt
Public Sub setMessageText(MessageTxt)
Me.MessageTxt = MessageTxt
End Sub
'Sub New(MessageTxt)
' ' Dieser Aufruf ist für den Designer erforderlich.
' InitializeComponent()
' Me.MessageTxt = MessageTxt
' ' Fügen Sie Initialisierungen nach dem InitializeComponent()-Aufruf hinzu.
'End Sub
' Methode, um die Form im Vordergrund anzuzeigen, ohne Fokus zu ziehen
Public Sub ShowInForegroundNoFocus()
' Aufrufen der SetWindowPos-API
SetWindowPos(Me.Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE Or SWP_NOACTIVATE)
End Sub
' Form Load-Event für runde Ecken
Private Sub frmMessage_Load(sender As Object, e As EventArgs) Handles MyBase.Load
' Größe der abgerundeten Ecken (Radius)
Dim cornerRadius As Integer = 30
' Region erstellen
Dim rgn As IntPtr = CreateRoundRectRgn(
0,
0,
Me.Width,
Me.Height,
cornerRadius,
cornerRadius
)
' Anwenden der Region auf das Fenster
SetWindowRgn(Me.Handle, rgn, True)
'--------------------------------------------
ShowInForegroundNoFocus()
'--------------------------------------------
Me.KeyPreview = True ' Ermöglicht der Form, Tastendrücke zu erfassen
'--------------------------------------------
'
RichTextBox.Text = MessageTxt RichTextBox.Text = MessageTxt
Clipboard.SetText(MessageTxt.Replace("\n", "\r\n")) Clipboard.SetText(MessageTxt.Replace("\n", "\r\n"))
End Sub End Sub
Private Sub Timer_Tick(sender As Object, e As EventArgs) Handles Timer.Tick Private Sub Timer_Tick(sender As Object, e As EventArgs) Handles Timer.Tick
Me.Close() Me.Close()
End Sub End Sub
' Eventhandler für KeyDown hinzufügen
Private Sub frmMessage_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown
' Prüfen, ob die ESC-Taste gedrückt wurde
If e.KeyCode = Keys.Escape Then
Me.Close() ' Fenster schließen
End If
End Sub
Private Sub frmMessage_Shown(sender As Object, e As EventArgs) Handles Me.Shown
Panel1.Focus()
End Sub
End Class End Class