重庆分公司,新征程启航
为企业提供网站建设、域名注册、服务器等服务
'添加模块一个模块声明如下APIPublic Declare Function GdiTransparentBlt Lib "gdi32" (ByVal hdc1 As Long, ByVal x1 As Long, ByVal y1 As Long, ByVal W1 As Long, ByVal H1 As Long, ByVal Hdc2 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal W2 As Long, ByVal H2 As Long, ByVal Color As Long) As Long'hdc1 要绘图目标句柄'x1图片显示的横坐标位置'y1图片显示的纵坐标位置'w1图片缩放比例宽度'h1图片缩放比例高度'hdc2要绘制透明色的图片或控件(这里指picture)'x2一般这里填0(图片左上角起始坐标)'y2一般这里填0(图片左上角起始坐标)'w2图片宽度'h2图片高度'color绘制颜色(RGB(255,255,255)为透明色)'picture控件属性设置成visible=falseautosize=trueautoredraw=trueborderstyle=0窗体autoredraw=true简单例子Private Sub Form_Load()GdiTransparentBlt form1.hDC, 0, 0, form1.picture1.Width, form1.picture1.Height, form1.picture1.hDC, 0, 0, form1.picture1.Width, form1.picture1.Height, RGB(255, 255, 255) '画图End Sub
创新互联为企业级客户提高一站式互联网+设计服务,主要包括成都网站设计、网站建设、成都app软件开发、重庆小程序开发、宣传片制作、LOGO设计等,帮助客户快速提升营销能力和企业形象,创新互联各部门都有经验丰富的经验,可以确保每一个作品的质量和创作周期,同时每年都有很多新员工加入,为我们带来大量新的创意。
Imports System.Drawing.Imaging
Public Class Form1
Dim imageName As String = "C:\Documents and Settings\...\1126.jpg "
Dim i As Image = Image.FromFile(imageName)
Dim g As Graphics = Graphics.FromImage(i) '此处从背景图创建Greaphics
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
'划线
Dim BluePen As New Pen(Color.Blue, 5)
BluePen.DashStyle = Drawing2D.DashStyle.Solid
g.DrawLine(BluePen, 100.0F, 170, 500.0F, 170)
g.Dispose()
PictureBox1.Image = i
End Sub
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
'退出
Me.Close()
End Sub
Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
'存盘
i.Save( "C:\testimage.jpg ", ImageFormat.Jpeg)
i.Dispose()
End Sub
Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
PictureBox1.Image = i
End Sub
End Class
Dim bmp As New Bitmap("打开图片的路径")
bmp.Save("保存图片的路径")
Dim t As New TextBox()
Dim p As New PictureBox
p.Image = bmp 'picture等支持image的控件。
t.CreateGraphics.DrawImage(bmp, New Point) '文本控件。
Me.BackgroundImage = bmp '窗体
Dim bitmap1 As New Bitmap("D:\image\0183.jpg")‘panel1.backgroundimage
Dim bitmap2 As New Bitmap(294, 294)’保存图,也就是绘制的大小。
Dim rect1 As New Rectangle(New Point, bitmap2.Size)‘昨天的问题,这里似乎写错了,当然也不算错,只是把新图(小图)扩展成原图大小(大图),这里改正为新图的原大小。
Dim rect2 As New Rectangle(New Point(6, 6), bitmap2.Size)
Dim g As Graphics = Graphics.FromImage(bitmap2)
e.Graphics.DrawImage(bitmap1, rect1, rect2, GraphicsUnit.Pixel)
g.DrawImage(bitmap1, rect1, rect2, GraphicsUnit.Pixel)
bitmap2.Save("d:\a.png", Drawing.Imaging.ImageFormat.Png)
将你所绘制的东西线绘制到一个Bitmap上,然后使用Graphics.FromImage把这个Bitmap显示出来,最后调用Bitmap的Save方法,把图像保存为本地文件。
这样,你保存的文件和你绘制的东西就是一致的。
可以把所有画的线都保存在一个列表中,画的时候全部画出即可。如下:
Public Class Form1
Class Line '直线类
Public Point1, Point2 As Point '成员,直线的两个端点
Sub New(p1 As Point, p2 As Point) '构造方法
Point1 = p1
Point2 = p2
End Sub
Public Sub Draw(g As Graphics) '绘制方法
g.DrawLine(Pens.Black, Point1, Point2)
End Sub
End Class
Private Lines As New List(Of Line) '列表用于保存所有画下的直线
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
BackColor = Color.White
DoubleBuffered = True '开启双缓冲可有效避免闪烁
End Sub
Private Sub Form1_MouseDown(sender As Object, e As MouseEventArgs) Handles Me.MouseDown
Lines.Add(New Line(e.Location, e.Location)) '在直线列表中添加直线
End Sub
Private Sub Form1_MouseMove(sender As Object, e As MouseEventArgs) Handles Me.MouseMove
If e.Button Windows.Forms.MouseButtons.Left Then Return '左键未按下
'鼠标拖动时改变列表最后一条直线(也即当前直线的第二个端点)
Lines(Lines.Count - 1).Point2 = e.Location
Refresh() '刷新窗体
End Sub
'在Form的Paint事件中绘制所有直线,每次Form1重绘时都会触发Paint事件
'PS: 也可以通过重写OnPaint方法来达到类似的效果
Private Sub Form1_Paint(sender As Object, e As PaintEventArgs) Handles Me.Paint
e.Graphics.SmoothingMode = Drawing2D.SmoothingMode.AntiAlias '开启抗锯齿
For Each l In Lines '遍历所有直线
l.Draw(e.Graphics) '调用绘制方法,传入的参数可以理解为画布
Next
End Sub
End Class
运行效果: