VB备忘录（16）图像处理

保存图片：

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,Y As Single)

    If Button = vbLeftButton Then
        Picture1.Line (x1,y1)-(x2,y2),xcolor,B '第一次时画，后面相应为擦除
        Picture1.Line (x1,y1)-(X,Y),B
        x2 = X
        y2 = Y
    End If
End Sub

Private Sub Picture1_MouseUp(Button As Integer,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,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

（编辑：李大同）

【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容!