Hoi Freunde,
ich habe mir aus dem Netz dieses Beispiel für eine Lupe geladen und versuche das nun, auf meine Bedürfnisse anzupassen - was aber nicht klappen will.
Hier erstma der Beispielcode (recht lang):
'Beispiel: VB .Net - Lupe
'
Option Strict On
Option Explicit On
Public Class Form1
Private px As Integer
Private py As Integer
Private Sub CreateImage(ByVal Width As Integer, ByVal Height As Integer, _
ByVal zoom As Integer)
Try
Dim hBitmap As Bitmap = New Bitmap(Width, Height)
Dim DesktopHdc As IntPtr = GetDC(IntPtr.Zero)
Dim g As Graphics = Graphics.FromImage(hBitmap)
Dim DestinationHdc As IntPtr = g.GetHdc()
BitBlt( _
DestinationHdc, 0, 0, hBitmap.Width, hBitmap.Height, DesktopHdc, _
Control.MousePosition.X - 10, Control.MousePosition.Y - 10, _
CType(SRCCOPY, RasterOperations))
ReleaseDC(IntPtr.Zero, DesktopHdc)
g.ReleaseHdc(DestinationHdc)
g.Dispose()
Dim b As Bitmap = New Bitmap( _
(hBitmap.Width * zoom), _
(hBitmap.Height * zoom), _
Imaging.PixelFormat.Format24bppRgb)
Dim g1 As Graphics = Graphics.FromImage(b)
g1.InterpolationMode = Drawing2D.InterpolationMode.HighQualityBicubic
g1.DrawImage(hBitmap, 0, 0, b.Width, b.Height)
g1.Dispose()
Me.PictureBox1.Image = b
Catch ex As Exception
MsgBox(ex.ToString)
End Try
End Sub
Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) _
Handles Timer1.Tick
CreateImage(200, 80, CInt(NumericUpDown1.Value))
End Sub
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) _
Handles MyBase.Load
With Timer1
.Interval = 1
.Enabled = True
With PictureBox1
.Size = CType(New Point(200, 76), Drawing.Size)
.Location = New Point(2, 2)
With Me
.FormBorderStyle = Windows.Forms.FormBorderStyle.None
.Size = CType(New Point(260, 80), Drawing.Size)
With ToolTip1
.SetToolTip(Me, "Form verschieben")
.SetToolTip(PictureBox1, "Rechtsklick-Auswahlmenue aufrufen")
With NumericUpDown1
.Minimum = 2
.Maximum = 4
.Value = 2
.Increment = 1
End With
End With
End With
End With
End With
End Sub
Protected Overrides Sub WndProc(ByRef msg As System.Windows.Forms.Message)
MyBase.WndProc(msg)
If msg.Msg = WM_NCHITTEST Then
msg.Result = New IntPtr(HT_CAPTION)
End If
End Sub
Private Sub Form1_MouseDown(ByVal sender As System.Object, _
ByVal e As System.Windows.Forms.MouseEventArgs) _
Handles MyBase.MouseDown
Me.Capture = False
WndProc(Message.Create(Handle, WM_NCLBUTTONDOWN, _
IntPtr.op_Explicit(HT_CAPTION), _
IntPtr.Zero))
End Sub
Private Sub Form1_Paint(ByVal sender As Object, _
ByVal e As System.Windows.Forms.PaintEventArgs) Handles Me.Paint
Dim rc As Rectangle = New Rectangle(New Point(0, 0), Me.Size)
With rc
.Width = .Width - 1
.Height = .Height - 1
e.Graphics.DrawRectangle(Pens.Navy, rc)
End With
End Sub
Private Sub Button1_Click(ByVal sender As System.Object, _
ByVal e As System.EventArgs) Handles Button1.Click
Application.Exit()
End Sub
Private Sub ExitToolStripMenuItem_Click(ByVal sender As System.Object, _
ByVal e As System.EventArgs) Handles ExitToolStripMenuItem.Click
Application.Exit()
End Sub
Private Sub MinimizeToolStripMenuItem_Click(ByVal sender As System.Object, _
ByVal e As System.EventArgs) Handles MinimizeToolStripMenuItem.Click
If Me.WindowState = FormWindowState.Normal Then _
Me.WindowState = FormWindowState.Minimized
End Sub
Private Sub AboutToolStripMenuItem_Click(ByVal sender As System.Object, _
ByVal e As System.EventArgs) Handles AboutToolStripMenuItem.Click
MessageBox.Show("Download from: http://www.visual-basic5.de", "Info", _
MessageBoxButtons.OK, MessageBoxIcon.Information)
End Sub
Private Sub OnTopToolStripMenuItem_Click(ByVal sender As System.Object, _
ByVal e As System.EventArgs) Handles OnTopToolStripMenuItem.Click
Static n As Integer
n = n Xor 1
If n = 1 Then
Me.TopMost = True
OnTopToolStripMenuItem.Text = "No TopMost"
Else
Me.TopMost = False
OnTopToolStripMenuItem.Text = "TopMost"
End If
End Sub
End Class
Public Module Win32Api
Public Declare Function ReleaseDC Lib "user32.dll" _
(ByVal hWnd As IntPtr, _
ByVal hdc As IntPtr) _
As Integer
Public Declare Function GetDC Lib "user32.dll" _
(ByVal hWnd As IntPtr) _
As IntPtr
Public Declare Auto Function BitBlt Lib "gdi32.dll" _
(ByVal hdcDest As IntPtr, _
ByVal nXDest As Integer, _
ByVal nYDest As Integer, _
ByVal nWidth As Integer, _
ByVal nHeight As Integer, _
ByVal hdcSrc As IntPtr, _
ByVal nXSrc As Integer, _
ByVal nYSrc As Integer, _
ByVal dwRop As RasterOperations) As Boolean
Public Const SRCCOPY As Integer = &HCC0020
Public Enum RasterOperations
SRCCOPY = &HCC0020
SRCPAINT = &HEE0086
SRCAND = &H8800C6
SRCINVERT = &H660046
SRCERASE = &H440328
NOTSRCCOPY = &H330008
NOTSRCERASE = &H1100A6
MERGECOPY = &HC000CA
MERGEPAINT = &HBB0226
PATCOPY = &HF00021
PATPAINT = &HFB0A09
PATINVERT = &H5A0049
DSTINVERT = &H550009
BLACKNESS = &H42
WHITENESS = &HFF0062
End Enum
Public Const WM_NCLBUTTONDOWN As Integer = &HA1
Public Const WM_NCHITTEST As Integer = &H84
Public Const HT_CAPTION As Integer = &H2
End Module
Es funktioniert alles wie es soll - nur funktioniert die Lupe über den gesamten Bildschirm, ich möchte das aber auf eine PictureBox1 beschränken.
Ich habe eine simple Form mit 2 Pictureboxes:
in Nr.1 wird das Bild (aus einer TreeView-Komponente ausgewählt) angezeigt.
Nun möchte ich, dass wenn die Maus über der PictureBox1 ist, den Zoombreich in PictureBox2 anzeigt:
das klappt wie gesagt auch, nur dass eben alles (oüm ganzen Bildschirm) dort gezoomt angezeigt wird.
Ich schätze mal, das liegt an dem Paint-Event, aber alle Versuche den auf die PictureBox1 zu beschränken, scheitern.
Doei
Trixi
Be a good forum member - mark posts that contain the answers to your questions or those that are helpful
