[Only registered and activated users can see links. Click Here To Register...]
Visual Studio Source Code
Quote:
Imports System.Runtime.InteropServices
Imports System.Security.Principal
Imports System.ComponentModel.Design
Imports System.ComponentModel
Imports System.Diagnostics
Imports System.IO
Imports System.Reflection.Emit
Imports System.Runtime.Remoting
Imports System.Management
Imports System.Threading
Imports System.Reflection
Imports Microsoft.Win32
Imports Microsoft.VisualBasic.ApplicationServices
Imports System.Collections.ObjectModel
'Imports System.Management.Automation
Public Class imgGet
'////////////////////////////////////////////////////// Minimier event
#Region "Konstanten"
Const WM_SYSCOMMAND As Int32 = &H112
Const SC_MINIMIZE As Int32 = &HF020
#End Region
Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)
MyBase.WndProc(m)
If m.Msg = WM_SYSCOMMAND Then
If m.WParam.ToInt32 = SC_MINIMIZE Then
RaiseEvent Minimize(New EventArgs())
End If
End If
End Sub
Public Event Minimize(ByVal e As EventArgs)
Private Sub Me_Minimize(ByVal e As EventArgs) Handles Me.Minimize
Me.WindowState = FormWindowState.Minimized
Me.ShowInTaskbar = False
Me.Hide()
End Sub
<DllImport("gdi32.dll")>
Private Shared Function BitBlt(hdcDest As IntPtr, nXDest As Integer, nYDest As Integer, nWidth As Integer, nHeight As Integer, hdcSrc As IntPtr, nXSrc As Integer, nYSrc As Integer, dwRop As Integer) As Boolean
End Function
Public ONoff As Boolean = False
Private Sub imgGet_Load(sender As Object, e As EventArgs) Handles MyBase.Load
FarbeCustom = Color.LimeGreen
ONoff = True
FormCross.Show()
Me.WindowState = FormWindowState.Minimized
Me.ShowInTaskbar = False
Me.Hide()
Startbt.Enabled = False
Stopbt.Enabled = True
End Sub
Public Grösse As Integer
Public FarbeCustom As Color
Private Sub NotifyIcon1_MouseClick(sender As Object, e As MouseEventArgs) Handles NotifyIcon1.MouseClick
If e.Button = MouseButtons.Left Then
Me.WindowState = FormWindowState.Normal
Me.ShowInTaskbar = True
Me.Show()
End If
End Sub
Private Sub Startbt_Click(sender As Object, e As EventArgs) Handles Startbt.Click
ONoff = True
FormCross.Show()
Me.WindowState = FormWindowState.Minimized
Me.ShowInTaskbar = False
Me.Hide()
Startbt.Enabled = False
Stopbt.Enabled = True
End Sub
Private Sub Stopbt_Click(sender As Object, e As EventArgs) Handles Stopbt.Click
ONoff = False
FormCross.FoundEnemy = False
FormCross.Invalidate() ' Neuzeichnen der PictureBox erzwingen
FormCross.Hide()
Startbt.Enabled = True
Stopbt.Enabled = False
End Sub
End Class
|
Quote:
Imports System.Drawing
Imports System.Windows.Forms
Imports System.Runtime.InteropServices
Imports System.Security.Principal
Imports System.ComponentModel.Design
Imports System.ComponentModel
Imports System.Diagnostics
Imports System.IO
Imports System.Reflection.Emit
Imports System.Runtime.Remoting
Imports System.Management
Imports System.Threading
Imports System.Reflection
Imports Microsoft.Win32
Imports Microsoft.VisualBasic.ApplicationServices
Imports System.Collections.ObjectModel
Imports System.Drawing.Imaging
'Imports System.Management.Automation
Public Class FormCross
Inherits Form
Private enemyPosition As New Point(50, 50) ' Startposition des Feindes
Private currentBitmap As Bitmap
Private laterBitmap As Bitmap
Private indi As Integer = 0
Private gleich As Boolean = False
Private diffRect As Rectangle ' Hier speichern wir das Rechteck der Änderung
Private Sub FormCross_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Me.DoubleBuffered = True ' Flimmern reduzieren
Me.Size = New Size(300, 300) ' Größe des Formulars festlegen
End Sub
Dim Soundcheck As Boolean = False
Private Sub FormCross_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles Me.Paint
Dim g As Graphics = e.Graphics
If FoundEnemy = True Then
If imgGet.Soundcb.Checked Then
If Soundcheck = False Then
Console.Beep(1000, 100) ' Erster Ton
System.Threading.Thread.Sleep(10) ' Kurze Pause zwischen den Tönen
Console.Beep(1500, 100) ' Zweiter Ton
System.Threading.Thread.Sleep(10) ' Kurze Pause zwischen den Tönen
Soundcheck = True
End If
End If
' Kästchen an der Position der gefundenen Änderung zeichnen
CordX = diffRect.X
CordY = diffRect.Y
CordW = diffRect.Width
CordH = diffRect.Height
Me.Size = New Size(CordX + 20, CordY + 20) ' Größe des Formulars festlegen
Me.Location = New Point(0, 0) ' Größe des Formulars festleg
g.DrawRectangle(Pens.LimeGreen, New Rectangle(CordX - 70, CordY - 65, 35, 30))
g.DrawString("ENEMY !", New Font("Arial", 15), Brushes.Red, CordX - 90, CordY - 90)
End If
End Sub
Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
If Not bgwCaptureScreens.IsBusy Then
bgwCaptureScreens.RunWorkerAsync()
End If
Me.Invalidate()
'If indi <= 5 Then
' Select Case indi
' Case 1
' currentBitmap = CaptureScreen()
' Case 3
' laterBitmap = CaptureScreen()
' Case 5
' CheckForChanges()
' indi = 0
' End Select
'
' indi += 1
'End If
End Sub
Private WithEvents bgwCaptureScreens As New BackgroundWorker()
Private Sub bgwCaptureScreens_DoWork(sender As Object, e As DoWorkEventArgs) Handles bgwCaptureScreens.DoWork
If indi <= 3 Then
Select Case indi
Case 1
currentBitmap = CaptureScreen()
Case 2
laterBitmap = CaptureScreen()
Case 3
CheckForChanges()
indi = 0
End Select
indi += 1
End If
End Sub
Private Sub bgwCaptureScreens_RunWorkerCompleted(sender As Object, e As RunWorkerCompletedEventArgs) Handles bgwCaptureScreens.RunWorkerCompleted
If e.Error IsNot Nothing Then
' Fehlerbehandlung, falls erforderlich
End If
If FoundEnemy Then
Timer2.Start() ' Timer starten für die Dauer, wie lange "ENEMY !" angezeigt werden soll
End If
Me.Invalidate()
End Sub
' Event Handler für den Abschluss der Hintergrundarbeit der Änderungserkennung
Private Sub Timer2_Tick(sender As Object, e As EventArgs) Handles Timer2.Tick
FoundEnemy = False
Soundcheck = False
Timer2.Stop() ' Timer anhalten
Me.Invalidate() ' Formular neuzeichnen
End Sub
Dim CordX, CordY, CordW, CordH As Integer
Private Sub CheckForChanges()
Using Aufnahme1 As New Bitmap(currentBitmap)
Using Aufnahme2 As New Bitmap(laterBitmap)
gleich = FormCross.BitmapsAreEqual(Aufnahme1, Aufnahme2)
If Not gleich Then
diffRect = FindDifferenceRect(Aufnahme1, Aufnahme2)
Else
diffRect = Rectangle.Empty
End If
End Using
End Using
If gleich Then
imgGet.Text = "Suche.."
Else
imgGet.Text = $"Gefunden X={diffRect.X}, Y={diffRect.Y}, Width={diffRect.Width}, Height={diffRect.Height}"
CordX = diffRect.X
CordY = diffRect.Y
CordW = diffRect.Width
CordH = diffRect.Height
FoundEnemy = True
Timer2.Start() ' Timer starten für die Dauer, wie lange "ENEMY !" angezeigt werden soll
End If
End Sub
Private Function FindDifferenceRect(bm1 As Bitmap, bm2 As Bitmap) As Rectangle
If bm1.Size <> bm2.Size Then Return Nothing ' Wenn die Größen unterschiedlich sind, gibt es keine Änderung
Dim rect As New Rectangle(0, 0, bm1.Width, bm1.Height)
Dim bmpData1 As BitmapData = bm1.LockBits(rect, ImageLockMode.ReadOnly, bm1.PixelFormat)
Dim bmpData2 As BitmapData = bm2.LockBits(rect, ImageLockMode.ReadOnly, bm2.PixelFormat)
Try
Dim bytes As Integer = Math.Abs(bmpData1.Stride) * bm1.Height
Dim buffer1(bytes - 1) As Byte
Dim buffer2(bytes - 1) As Byte
Marshal.Copy(bmpData1.Scan0, buffer1, 0, bytes)
Marshal.Copy(bmpData2.Scan0, buffer2, 0, bytes)
Dim diffRect As Rectangle = Rectangle.Empty
For y As Integer = 0 To bm1.Height - 1
For x As Integer = 0 To bm1.Width - 1
Dim index As Integer = y * bmpData1.Stride + x * 4
If buffer1(index) <> buffer2(index) OrElse
buffer1(index + 1) <> buffer2(index + 1) OrElse
buffer1(index + 2) <> buffer2(index + 2) Then
If diffRect.IsEmpty Then
diffRect = New Rectangle(x, y, 1, 1)
Else
diffRect = Rectangle.Union(diffRect, New Rectangle(x, y, 1, 1))
End If
End If
Next
Next
Return diffRect
Finally
bm1.UnlockBits(bmpData1)
bm2.UnlockBits(bmpData2)
End Try
End Function
Private Function CaptureScreen() As Bitmap
Dim primaryScreen As Screen = Screen.PrimaryScreen
Dim screenSize As Size = New Size(primaryScreen.Bounds.Width, primaryScreen.Bounds.Height)
Dim sGrab As New Bitmap(screenSize.Width, screenSize.Height)
Using g As Graphics = Graphics.FromImage(sGrab)
g.CopyFromScreen(primaryScreen.Bounds.Location, New Point(0, 0), screenSize)
End Using
imgGet.Text = "Suche.."
Return sGrab
End Function
Public Shared Function BitmapsAreEqual(ByVal b1 As Bitmap, ByVal b2 As Bitmap) As Boolean
If b1 Is Nothing OrElse b2 Is Nothing Then Return False
If b1.PixelFormat <> b2.PixelFormat OrElse b1.Height <> b2.Height OrElse b1.Width <> b2.Width Then Return False
Dim rect As New Rectangle(0, 0, b1.Width, b1.Height)
Dim bmpData1 As BitmapData = b1.LockBits(rect, ImageLockMode.ReadOnly, b1.PixelFormat)
Dim bmpData2 As BitmapData = b2.LockBits(rect, ImageLockMode.ReadOnly, b2.PixelFormat)
Try
Dim bytes As Integer = Math.Abs(bmpData1.Stride) * b1.Height
Dim buffer1(bytes - 1) As Byte
Dim buffer2(bytes - 1) As Byte
Marshal.Copy(bmpData1.Scan0, buffer1, 0, bytes)
Marshal.Copy(bmpData2.Scan0, buffer2, 0, bytes)
For i As Integer = 0 To bytes - 1
If buffer1(i) <> buffer2(i) Then
Return False
End If
Next
Return True
Finally
b1.UnlockBits(bmpData1)
b2.UnlockBits(bmpData2)
End Try
End Function
Public FoundEnemy As Boolean = False
End Class
|
12/24/2024 13:43
TerrorBlade__#2
|