保存图片:
SavePicture Picture,strFileName
把Picture保存到指定位置的图片文件中StrFileName
注意:对于绘制的图片保存有两个要点:
1、AutoRedraw为真,这样才是持久图形,才会在内存中有映像,保存时就会提取它来保存。
2、可以picture和image ,picture是实际的图片。image则是映像画布的大小,不管是否占满PictureBox框,也会整个保存下来。
图像剪切
利用PictureClip控件进行剪切部分图片。
下例中注意:剪切的是本身的图片,而不是Picture1中的,Picture1只是为了演示“剪切区”,达到“即切即现”的效果。
Public x1 As Single, y1 As Single
Public x2 As Single, y2 As Single
Public xcolor As Long '异或色
Private Sub Form_Load()
xcolor = vbGreen
Picture1.ScaleMode = vbPixels '像素单位
Picture2.ScaleMode = vbPixels
Picture1.DrawMode = vbXorPen '异或方式,利用异或进行擦除
End Sub
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbLeftButton Then
x1 = X
y1 = Y
x2 = X
y2 = Y
End If
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbLeftButton Then
Picture1.Line (x1, y1)-(x2, y2), xcolor, B '第一次时画,后面相应为擦除
Picture1.Line (x1, y1)-(X, Y), xcolor, B
x2 = X
y2 = Y
End If
End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbLeftButton Then
Picture1.Line (x1, y1)-(X, Y), xcolor, B '对最后一个进行擦除
PictureClip1.ClipX = IIf(x1 < X, x1, X)
PictureClip1.ClipY = IIf(y1 < Y, y1, Y)
PictureClip1.ClipWidth = Abs(x1 - X)
PictureClip1.ClipHeight = Abs(y1 - Y)
Picture2.Picture = PictureClip1.Clip
End If
End Sub
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Index
Case 1
CommonDialog1.Filter = "JPG文件(*.jpg)|*.jpg"
CommonDialog1.ShowOpen
If CommonDialog1.FileName <> "" Then
Picture1.Picture = LoadPicture(CommonDialog1.FileName)
PictureClip1.Picture = Picture1.Picture '重要,否则出错
End If
Case 3
CommonDialog1.Filter = "JPG文件(*.jpg)|*.jpg"
CommonDialog1.ShowSave
If CommonDialog1.FileName <> "" Then
SavePicture Picture2.Image, CommonDialog1.FileName
End If
Case 5
End
End Select
End Sub
平铺图像:
Private Sub Command1_Click()
Dim i As Integer, j As Integer
Dim pWidth As Long, pHeight As Long
pWidth = Form1.ScaleX(Form1.Picture.Width, vbHimetric, vbPixels)
pHeight = Form1.ScaleY(Form1.Picture.Height, vbHimetric, vbPixels)
i = 0
j = 0
Do While (j * pHeight < ScaleHeight)
Do While (i * pWidth < ScaleWidth)
Form1.PaintPicture Form1.Picture, i * pWidth, j * pHeight
i = i + 1
Loop
i = 0
j = j + 1
Loop
End Sub
Private Sub Form_Load()
Form1.ScaleMode = vbPixels
End Sub