- A+
vb.net使用GDI+绘图+放大+缩小+平移，放大缩小平移后无无错位。网上我可以说没有几个有参考价值，对于新手来说，就要看全代码才能有所突破。下面整个例子，先上图瞅瞅
原理就是把数据用笔画在纸上，在移动，在缩放，上源码。
新建一个VB项目，在窗口上放上面图上的控件，画图是在PictureBox1控件上实现
新建一个直线类 hLine，如下
Public Class hLine
Public stPoint As Point '起始点
Public endPoint As Point '结束点
Public Sub New(ByVal point1 As Point, ByVal point2 As Point) '构造函数
stPoint = point1
endPoint = point2
End Sub
End Class
复制新建一个圆弧类 hACR，如下
Public Class hACR
Public XYPoint As Point '圆心
Public XYRR As Single 'R半径
Public stAngle As Single '起始角
Public ENDAngle As Single '终止角
Public Sub New(ByVal point1 As Point, ByVal HRR As Single, ByVal SAngle As Single, ByVal EAngle As Single) '构造函数
XYPoint = point1
XYRR = HRR
stAngle = SAngle
ENDAngle = EAngle
End Sub
End Class
复制在窗口Form1下加入下面代码
Imports System.Drawing.Drawing2D
Public Class Form1
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
'启动事件
AddHandler PictureBox1.MouseWheel, AddressOf this_MouseWheel
AddHandler PictureBox1.MouseMove, AddressOf this_MouseMove
AddHandler PictureBox1.MouseDown, AddressOf thiS_MouseDown
End Sub
Public point As New Point()， startPoint As Point, endPoint As Point， centre As Point
Public ARClst As New ArrayList() '存储圆弧的数组
Public linelst As New ArrayList() '存储线的数组
Private IsMove As Boolean = False '控制平移的变量
Private IsZoomIn As Boolean = False '是否缩小
Private imgRect As New Point() '平移坐标
'鼠标按下时坐标
Private MouseDownP As New Point()
'放大倍数
Private zoom As Single = 1
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
'第1条直线
Dim stPoint As Point '结束点
Dim escPoint As Point '结束点
stPoint.X = 0
stPoint.Y = 0
escPoint.X = 100
escPoint.Y = 50
'第2条直线坐标
Dim A As Point '结束点
Dim B As Point '结束点
A.X = 100
A.Y = 50
B.X = 200
B.Y = 300
'把坐标加入直线数组
Dim line As New hLine(stPoint, escPoint)
linelst.Add(line)
Dim line1 As New hLine(A, B)
linelst.Add(line1)
'圆弧参数
Dim arcPoint As Point '圆心
Dim R1 As Single 'RR
Dim J1 As Single '起始角
Dim J2 As Single '终止角
arcPoint.X = -100
arcPoint.Y = -50
R1 = 100
J1 = 0
J2 = 180
'把圆弧参数加入圆弧数组
Dim ACR As New hACR(arcPoint, R1， J1, J2)
ARClst.Add(ACR)
Dim ACR1 As New hACR(arcPoint, R1 + 50， J1, J2 + 45)
ARClst.Add(ACR1)
DrawImg() '绘图
End Sub
' 放大事件
Private Sub this_MouseWheel(ByVal sender As Object, ByVal e As MouseEventArgs)
IsZoomIn = True
If e.Delta > 1 Then '上滚放大
If zoom < 100 Then ' 最大放大100倍
zoom += 0.1
End If
Else '下滚缩小
zoom -= 0.1
If zoom <= 0 Then '最小缩小0.1倍
zoom = 0.1
End If
End If
TextBox1.Text = zoom '放大倍数
Refresh()
DrawImg()
' MsgBox("放大")
End Sub
'平移事件
Private Sub this_MouseMove(ByVal sender As Object, ByVal e As MouseEventArgs)
If e.Button = MouseButtons.Middle Then
'计算移动后的坐标
PictureBox1.Cursor = Cursors.SizeAll
imgRect.X += e.X - MouseDownP.X
imgRect.Y += e.Y - MouseDownP.Y
MouseDownP.X = e.X
MouseDownP.Y = e.Y
Refresh()
TextBox2.Text = e.X '新x坐标
TextBox3.Text = e.Y '新y坐标
IsMove = True
DrawImg()
PictureBox1.Cursor = Cursors.Default
End If
End Sub
'鼠标点事件
Private Sub thiS_MouseDown(ByVal sender As Object, ByVal e As MouseEventArgs)
If e.Button = MouseButtons.Middle Then
MouseDownP = New Point(e.X, e.Y)
End If
If e.Button = MouseButtons.Right Then
IsMove = False
IsZoomIn = True
zoom = 1
DrawImg()
End If
End Sub
Private Sub DrawImg()
Using g As Graphics = PictureBox1.CreateGraphics()
'重绘背景
g.FillRectangle(New SolidBrush(Color.White), 0, 0, PictureBox1.Width, PictureBox1.Height) '达到去重效果
Dim pen As New Pen(Color.Red, 1)
centre.X = PictureBox1.Width \ 2
centre.Y = PictureBox1.Height \ 2
g.TranslateTransform(centre.X, centre.Y) '设置画布中心为坐标
'中心线
' Dim points1 As Point = New Point(centre.X, 0)
' Dim points2 As Point = New Point(centre.X, centre.Y * 2)
' g.DrawLine(pen, points1, points2)
If IsZoomIn = True Then
g.CompositingQuality = System.Drawing.Drawing2D.CompositingQuality.HighQuality
g.SmoothingMode = System.Drawing.Drawing2D.SmoothingMode.HighQuality
g.InterpolationMode = System.Drawing.Drawing2D.InterpolationMode.HighQualityBicubic
g.ScaleTransform(zoom, zoom, MatrixOrder.Append) '放大缩小,
End If
If IsMove = True Then
g.TranslateTransform(imgRect.X, imgRect.Y) '平移
End If
'循环画圆弧
For i As Integer = 0 To ARClst.Count - 1
Dim arcpt As hACR = DirectCast(ARClst(i), hACR)
Dim RRX As Single, RRY As Single, RRR As Single, RRS As Single, RRE As Single
RRX = arcpt.XYPoint.X
RRY = arcpt.XYPoint.Y
RRR = arcpt.XYRR '半径
RRS = arcpt.stAngle '起始角
RRE = arcpt.ENDAngle '终止角
g.DrawArc(pen, RRX, RRY, RRR, RRR, RRS, RRE)
Next i
'循环画直线
For i As Integer = 0 To linelst.Count - 1
Dim tempLine As hLine = DirectCast(linelst(i), hLine)
Dim STPT1 As Point, STPT2 As Point
STPT1 = tempLine.stPoint
STPT2 = tempLine.endPoint
g.DrawLine(pen, STPT1, STPT2)
Next i
'绘制文字
Dim drawFont As New Font("Arial", 16)
Dim drawBrush As New SolidBrush(Color.Black)
'设置字符串的格式
Dim drawFormat As New StringFormat()
drawFormat.FormatFlags = StringFormatFlags.DisplayFormatControl '从左到右顺序显示
g.DrawString("huojibk.com", drawFont, drawBrush, 0, 0, drawFormat)
g.Dispose() '释放资源
End Using
End Sub
End Class
复制赶快新建一个项目试试吧！完整项目下载：
https://download.csdn.net/download/qq_15957211/87775969
