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

相关文章

Format[$] ( expr [ , fmt ] ) format 返回变体型 format$ 强制返回为文本 --------------------------...
VB6或者ASP 格式化时间为 MM/dd/yyyy 格式,竟然没有好的办法, Format 或者FormatDateTime 竟然结果和...
在项目中添加如下代码:新建窗口来显示异常信息。 Namespace My ‘全局错误处理,新的解决方案直接...
转了这一篇文章,原来一直想用C#做k3的插件开发,vb没有C#用的爽呀,这篇文章写与2011年,看来我以前没...
Sub 分列() ‘以空格为分隔符,连续空格只算1个。对所选中的单元格进行处理 Dim m As Range, t...
  窗体代码 1 Private Sub Text1_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integ...