edv/VERAG_OCR
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Anpassungen

Browse Source
This commit is contained in:
Andreas Luxbauer
2025-01-22 09:09:06 +01:00
parent 5532a70acd
commit 7c523af046
4 changed files with 182 additions and 43 deletions
Download Patch File Download Diff File Expand all files Collapse all files

86
VERAG_OCR/frmFullScreen.vb
View File

@@ -47,19 +47,40 @@ Public Class frmFullScreen
'Me.Close()
End Sub
Private Function MakeScreenshot() As Bitmap
Dim tmp_width As Integer = CursorPos1.X - CursorPos2.X
Dim tmp_Height As Integer = CursorPos1.Y - CursorPos2.Y
If tmp_width = 0 Then Return Nothing
If tmp_Height = 0 Then Return Nothing
'Private Function MakeScreenshot() As Bitmap
' Dim tmp_width As Integer = CursorPos1.X - CursorPos2.X
' Dim tmp_Height As Integer = CursorPos1.Y - CursorPos2.Y
' If tmp_width = 0 Then Return Nothing
' If tmp_Height = 0 Then Return Nothing
If tmp_width <= 0 Then tmp_width *= -1 'Me.Close()
If tmp_Height <= 0 Then tmp_Height *= -1 ' Me.Close()
' MsgBox(tmp_width & "-" & tmp_Height)
Dim bmp As New Bitmap(tmp_width, tmp_Height)
' If tmp_width <= 0 Then tmp_width *= -1 'Me.Close()
' If tmp_Height <= 0 Then tmp_Height *= -1 ' Me.Close()
' ' MsgBox(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)
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()
Return bmp
End Function
@@ -75,41 +96,38 @@ Public Class frmFullScreen
Private Sub PictureBox1_MouseMove(sender As Object, e As MouseEventArgs) Handles pic.MouseMove
'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
' rect.Y = 0
' End If
' Dim tmp_width As Integer = CursorPos1.X - Cursor.Position.X
' Dim tmp_Height As Integer = CursorPos1.Y - Cursor.Position.Y
' 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.X = 0
' End If
' rect.Width = tmp_width
' rect.Height = tmp_Height
' If rect.Bottom > pic.Height Then
' rect.Y = pic.Height - rect.Height
' End If
' Refresh()
'End If
'End If
If isMouseDown = True Then
rect.Location = CursorPos1
If isMouseDown Then
' 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
Dim tmp_Height As Integer = CursorPos1.Y - Cursor.Position.Y
If tmp_width <= 0 Then tmp_width *= -1 'Me.Close()
If tmp_Height <= 0 Then tmp_Height *= -1 ' Me.Close()
rect.Width = tmp_width
rect.Height = tmp_Height
' Aktualisierung des Rechtecks
rect.Location = New Point(x, y)
rect.Width = width
rect.Height = height
' Bildschirm aktualisieren
Refresh()
End If
End Sub

20
VERAG_OCR/frmMainOCR.vb
View File

@@ -17,6 +17,7 @@ Public Class frmMainOCR
Private Declare Sub UnregisterHotKey Lib "user32" (ByVal hWnd As IntPtr, ByVal id As Integer)
Private Const Key_NONE As Integer = &H0
Private Const WM_HOTKEY As Integer = &H312
Private Const VK_ESCAPE As Integer = &H1B ' ESC-Taste
Protected Overrides Sub WndProc(ByRef m As Message)
'die messages auswerten
If m.Msg = WM_HOTKEY Then
@@ -27,9 +28,23 @@ Public Class frmMainOCR
' MessageBox.Show("Sie haben die SUPTERTEST gedrückt!")
Button1.PerformClick()
End Select
ElseIf m.Msg = VK_ESCAPE Then
MsgBox("TTTT")
CloseAllFrmFullScreen()
End If
MyBase.WndProc(m)
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
'die tab taste wieder freigeben
UnregisterHotKey(Me.Handle, 1)
@@ -125,6 +140,8 @@ Public Class frmMainOCR
f.Location = SCR.WorkingArea.Location
'f.ShowDialog()
f.Show()
f.TopMost = True
f.BringToFront()
FORMS_SCR.Add(f)
PictureBox1.BackgroundImage = f.captured
AddHandler f.CAPTURED_IMG, Sub(frmFullScreen As frmFullScreen)
@@ -209,7 +226,8 @@ Public Class frmMainOCR
' ' If annotation.IsNot Nothing Then ResultText &= annotation.Description & vbNewLine
'Next
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()
End If

2
VERAG_OCR/frmMessage.Designer.vb generated
View File

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

117
VERAG_OCR/frmMessage.vb
View File

@@ -1,21 +1,122 @@
Public Class frmMessage
Imports System.Runtime.InteropServices
Dim MessageTxt
Sub New(MessageTxt)
Public Class frmMessage
' 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()
Me.MessageTxt = MessageTxt
' Fügen Sie Initialisierungen nach dem InitializeComponent()-Aufruf hinzu.
End Sub
' Konstruktor
Public Sub New(responseText As String)
InitializeComponent()
Me.Text = responseText
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
Clipboard.SetText(MessageTxt.Replace("\n", "\r\n"))
End Sub
Private Sub Timer_Tick(sender As Object, e As EventArgs) Handles Timer.Tick
Me.Close()
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