1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
|
Public Class frmPicZoom
Private MousePtOriginal As Point = New Point(0, 0)
Private MousePtLast As Point = New Point(0, 0)
Dim isMouseDown As Boolean = False
'rectangle de selection de la zone à zoomer
Private rectZoom As Rectangle
Private penRectZoom As Pen = New Pen(Color.Yellow, 2.0)
' Image active
Private currentImage As Image = Nothing
' Valeurs utilisées pour fixer le facteur de zoom actuel
' echelle en %
Private ZoomValue As Integer = 100
Private ZoomMaxi As Integer = 500
Private ZoomMini As Integer = 50
Private incZoom As Integer = 10
Private DisplayScaleValue As Integer
Public Sub New()
' Cet appel est requis par le Concepteur Windows Form.
InitializeComponent()
' Ajoutez une initialisation quelconque après l'appel InitializeComponent().
'2 Buttons btnZoomPlus et btnZoomMoins
Me.BtnZoomPlus.Dock = DockStyle.Top
Me.btnZoomMoins.Dock = DockStyle.Top
'2 NumericUpDowns pour dessiner un rectangle de zoom
'valeurs à personnaliser suivants vos besoins.....
Me.NumUpWidthRect.Minimum = 50.0
Me.NumUpWidthRect.Maximum = 500.0
Me.NumUpWidthRect.Value = 100.0
Me.NumUpWidthRect.Dock = DockStyle.Left
Me.NumUpHeighRect.Minimum = 50.0
Me.NumUpHeighRect.Maximum = 500.0
Me.NumUpHeighRect.Value = 100.0
Me.NumUpHeighRect.Dock = DockStyle.Right
'Panel1 qui contient le picturebox PicDrawingArea
Me.Panel1.AutoScroll = True
Me.Panel1.AutoScrollMinSize = New Size(1072, 768)
Me.Panel1.Dock = DockStyle.Fill
'PictureBox1
Me.PicDrawingArea.SizeMode = PictureBoxSizeMode.StretchImage
Me.PicDrawingArea.Dock = DockStyle.Fill
'Panel2 qui contient le picturebox PicDrawingArea2
Me.Panel2.AutoScroll = True
Me.Panel2.AutoScrollMinSize = New Size(1072, 768)
Me.Panel2.Dock = DockStyle.Fill
'PictureBox2
Me.PicDrawingArea.SizeMode = PictureBoxSizeMode.StretchImage
Me.PicDrawingArea.Dock = DockStyle.Fill
'INITIALISATION
currentImage = My.Resources.ZebrasThree
' rectangle de selection de la zone à zoomer
rectZoom = New Rectangle(0, 0, Me.NumUpWidthRect.Value, Me.NumUpHeighRect.Value)
' zoom initial 1
DisplayScaleValue = ZoomValue
End Sub
Private Sub BtnZoomPlus_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnZoomPlus.Click
DisplayScaleValue = DisplayScaleValue + incZoom
If DisplayScaleValue > ZoomMaxi Then
DisplayScaleValue = ZoomMaxi
End If
' ----- Force the image to redisplay.
PicDrawingArea.Invalidate()
Me.PicDrawingArea2.Invalidate()
End Sub
Private Sub btnZoomMoins_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnZoomMoins.Click
DisplayScaleValue = DisplayScaleValue - incZoom
If DisplayScaleValue < ZoomMini Then
DisplayScaleValue = ZoomMini
End If
' ----- Force the image to redisplay.
PicDrawingArea.Invalidate()
Me.PicDrawingArea2.Invalidate()
Me.PicDrawingArea2.Invalidate()
End Sub
Private Sub PicDrawingArea_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles PicDrawingArea.Click
Me.PicDrawingArea.Cursor = Cursors.Cross
Dim picPoint As Point = Me.PicDrawingArea.PointToClient(Control.MousePosition)
'Update rectZoom location
Me.rectZoom.Location = New Point(picPoint.X - Me.rectZoom.Width / 2, picPoint.Y - Me.rectZoom.Height / 2)
Me.PicDrawingArea.Invalidate()
Me.PicDrawingArea2.Invalidate()
Me.PicDrawingArea.Cursor = Cursors.Arrow
End Sub
Private Sub NumUpWidthRect_ValueChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles NumUpWidthRect.ValueChanged
rectZoom.Width = Me.NumUpWidthRect.Value
' ----- Force the image to redisplay.
Me.PicDrawingArea.Invalidate()
Me.PicDrawingArea2.Invalidate()
End Sub
Private Sub NumUpHeighRect_ValueChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles NumUpHeighRect.ValueChanged
rectZoom.Height = Me.NumUpHeighRect.Value
' ----- Force the image to redisplay.
Me.PicDrawingArea.Invalidate()
Me.PicDrawingArea2.Invalidate()
End Sub
Private Sub PicDrawingArea_Paint(ByVal sender As System.Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles PicDrawingArea.Paint
' ----- Refresh the drawing area.
If currentImage Is Nothing Then Return
' ----- Clear any existing content.
e.Graphics.Clear(Color.White)
' ----- Draw original image.
Dim rectImage As RectangleF = currentImage.GetBounds(GraphicsUnit.Display)
e.Graphics.DrawImage(currentImage, 0, 0, rectImage.Width, rectImage.Height)
' ----- Draw zoom selection image.
' ----- set rectSrc=rectZoom according to the user's request.
Dim rectSrc As RectangleF = rectZoom
' ----- Set Scale rectDest= rectZoom (PicDrawingArea2)
Dim rectDest As RectangleF = rectZoom
rectDest.Width = rectZoom.Width
rectDest.Height = rectZoom.Height
' ----- Draw the rectangle selection.
e.Graphics.DrawRectangle(penRectZoom, rectDest.X, rectDest.Y, rectDest.Width, rectDest.Height)
End Sub
Private Sub PicDrawingArea2_Paint(ByVal sender As System.Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles PicDrawingArea2.Paint
' ----- Refresh the drawing area.
If currentImage Is Nothing Then Return
' ----- Clear any existing content.
e.Graphics.Clear(Color.White)
' ----- Draw zoom selection image.
' ----- set rectSrc=rectZoom according to the user's request.
Dim rectSrc As RectangleF = rectZoom
' ----- Set Scale rectDest= rectZoom * DisplayScaleValue.
Dim rectDest As RectangleF = rectZoom
rectDest.Width = rectZoom.Width * DisplayScaleValue / 100
rectDest.Height = rectZoom.Height * DisplayScaleValue / 100
' ----- Draw selection image scaled.
e.Graphics.DrawImage(currentImage, rectDest, rectSrc, GraphicsUnit.Pixel)
' ----- Draw the rectangle selection.
e.Graphics.DrawRectangle(penRectZoom, rectDest.X, rectDest.Y, rectDest.Width, rectDest.Height)
End Sub
End Class |
