VB 用Image控件装载图片后,如何截取?

Question

   由于要写一个比较大型的程序,界面上会有好多图标(50多个),如果全部弄成一个一个文件就显得不够专业,我看到有一些程序界面上的图标都放在一个BMP图片文件里面(每个图标的大小相同12x12),然后由程序去控制截取每个图片.   不知道VB能不能实现这样的效果,上次问了一个高手说是用Image控件装载图片后,进行截取.但是没有具体说怎么做,请各位老师指点.补充说明:
   例如下面就是一个BMP文件,里面有七个图标,我如何用程序进行截取每一个并按顺序进行编号,第一个是1,第二个是2,3,4,5,6.....供程序内部使用.

Answer 1

有个api可以对指定区域复制进粘贴板的 然后save

Answer 2

Option ExplicitPrivate m_Index As LongPrivate Sub Command1_Click()
    Set Image1.Picture = ImageList1.ListImages(m_Index + 1).Picture
    m_Index = (m_Index + 1) Mod 7
End SubPrivate Sub Form_Load()
    Dim pic As IPictureDisp, i As Long
    
    Picture1.BorderStyle = vbBSNone
    Picture1.ScaleMode = vbPixels
    Picture1.AutoRedraw = True
    Picture1.Move 0, 0, ScaleX(64, vbPixels, vbTwips), ScaleX(64, vbPixels, vbTwips)
    
    Set pic = LoadPicture("C:\1.bmp")
    Debug.Print pic.Width
    For i = 0 To 6
        Picture1.Cls
        Picture1.PaintPicture pic, 0, 0, , , i * 64, 0
        
        ImageList1.ListImages.Add , , Picture1.Image
    Next
    Picture1.Visible = False
    
    Call Command1_Click
End Sub

Answer 3

　　多谢Tiger_Zhao,你的方法我试过了,可以达到我的目的,还有一个问题要麻烦你一下.
　　问题是:能不能使截取的图标背景透明？
　　谢谢你．

Answer 4

创建一个 UserControl，命名为 TransparentImage，将 BackStyle 设为 0 - Transparent
'UserControl: TransparentImage
Public Property Get MaskColor() As OLE_COLOR
    MaskColor = UserControl.MaskColor
End PropertyPublic Property Let MaskColor(ByVal RHS As OLE_COLOR)
    UserControl.MaskColor = RHS
End PropertyPublic Property Get MaskPicture() As IPictureDisp
    Set Picture = UserControl.MaskPicture
End PropertyPublic Property Set MaskPicture(ByVal RHS As IPictureDisp)
    Set UserControl.MaskPicture = RHS
End PropertyPublic Property Get Picture() As IPictureDisp
    Set Picture = UserControl.Picture
End PropertyPublic Property Set Picture(ByVal RHS As IPictureDisp)
    Set UserControl.Picture = RHS
End Property
用 TransparentImage 代替 Image 控件
'Form
Private m_Index As LongPrivate Sub Command1_Click()
    '偷懒的做法 MaskPicture 和 Picture 是同一个图片，那么所有 MaskColor 的像素都是透明的。
    '标准的做法是 MaskPicture 用只有两色的图片，其中一种颜色等于 MaskColor，
    '这样即使 Picture 中有与 MaskColor 相同的颜色，
    '只要 MaskPicture 中对应像素不等于 MaskColor，照样可以显示。
    Set TransparentImage1.MaskPicture = ImageList1.ListImages(m_Index + 1).Picture
    Set TransparentImage1.Picture = ImageList1.ListImages(m_Index + 1).Picture
    m_Index = (m_Index + 1) Mod 7
End SubPrivate Sub Form_Load()
    Dim pic As IPictureDisp, i As Long    '指定 MaskPicture 对应的透明色
    TransparentImage1.MaskColor = vbWhite
    
    Picture1.BackColor = vbWhite
    Picture1.BorderStyle = vbBSNone
    Picture1.ScaleMode = vbPixels
    Picture1.AutoRedraw = True
    Picture1.Move 0, 0, ScaleX(64, vbPixels, vbTwips), ScaleX(64, vbPixels, vbTwips)
    
    Set pic = LoadPicture(App.Path & "\Icons.bmp")
    For i = 0 To 6
        Picture1.Cls
        Picture1.PaintPicture pic, 0, 0, , , i * 64, 0
        
        ImageList1.ListImages.Add , , Picture1.Image
    Next
    Picture1.Visible = False
    
    Call Command1_Click
End Sub

Answer 5

  这样子的话,截取的图标只能在TransparentImage1控件里面显示的时候是背景透明的,但是我想把这个图标作为MSFlexGrid单元格的背景图时就不能透明了,请指点.感谢!!

Answer 6

那就应该做成 ICO。
可以包含在资源文件中，用 Add-in: VB 6 Resource Editor 很方便的。
用 LoadResPicture() 代替 LoadPicture() 进行载入。

Answer 7

那是不是要保存成一个一个的ICO文件呢?

Answer 8

有什么关系？
ICO 打包在资源文件中，资源文件编译在 exe 中，最后只要发布一个 exe 就可以了。

Answer 9

    谢谢你耐心的帮我,我都有点不好意思再问了,说实话你上面说的做成ICO的方法我不太理解.
由于,程序做好后图标不是一直不变的,如果我将图打包在EXE里面的话,每次更换图标还要重新Build,不是很好的.
我的想法是能不能只通过一个BMP文件作为图标的来源进行截取,然后以透明背景显示在MSFlexGrid单元格里,有没有别的好办法?

Answer 10

没让你用程序转，而是先用其它工具做好 Ico 文件。
如果不愿意打包在 Exe 中，老老实实用 LoadPicture() 载入独立的 Ico 吧。

Answer 11

tiger_zhao果然是高手，还请您抽空看看我的关于属性页面的问题。真心向您请教，希望得到您的帮助。

Answer 12

'截取BMP文件里的包含的图标代码如下，只需要注意两点，一是坐标位置的计算，二是需要透明时，得使用GIF文件。
Private Sub Command1_Click()
    Dim i As Integer
    Dim srcPic As StdPicture
    Dim picWidth As Long, picHeight As Long, iconWidth As Long, iconHeight As Long
    
    Me.ScaleMode = vbPixels
    '调入图片文件
    Set srcPic = LoadPicture("d:\2008061300095783.jpg")
    picWidth = Me.ScaleX(srcPic.Width, vbHimetric)
    picHeight = Me.ScaleY(srcPic.Height, vbHimetric)
    iconWidth = picWidth \ 7 '因为有7个图标，故除以7
    iconHeight = picHeight
    '逐一显示图片文件里包括的7个图标
    For i = 0 To 6
        srcPic.Render Me.hDC, CLng(i * (iconWidth + 10)), CLng(10), CLng(iconWidth), _
            CLng(iconHeight), CLng(i * srcPic.Width / 7), CLng(srcPic.Height), CLng(srcPic.Width / 7), _
            -CLng(srcPic.Height), ByVal 0&
    Next
    '至于透明，用PS把JPG文件转换为GIF即可
End Sub

Answer 13

为了让图片持续显示，并演示透明效率，故代码作了以下修改：
背景资源位图，GIF格式：VB代码：Dim m_srcPic As StdPicturePrivate Sub Form_Load()
    Me.ScaleMode = vbPixels '此句不能省略
    Set m_srcPic = LoadPicture("e:\pic.gif") '调入图片文件
End SubPrivate Sub Form_Paint()
    Dim i As Integer    '逐一显示图片文件里包括的7个图标
    For i = 0 To 6
        displayIcon i, 48 * i, 10
    Next
    '至于透明，用PS把JPG文件转换为GIF即可
End SubSub displayIcon(ByVal Index As Integer, ByVal x As Long, ByVal y As Long) '根据序号显示图标
    Dim picWidth As Long, picHeight As Long, iconWidth As Long, iconHeight As Long
    
    picWidth = m_srcPic.Width
    picHeight = m_srcPic.Height
    iconWidth = ScaleX(picWidth, vbHimetric) \ 7 '因为有7个图标，故除以7
    iconHeight = ScaleY(picHeight, vbHimetric)
    m_srcPic.Render Me.hDC, CLng(x), CLng(y), CLng(iconWidth), CLng(iconHeight), _
        CLng((Index + 1) * picWidth \ 7), CLng(picHeight), CLng(picWidth \ 7), -CLng(picHeight), ByVal 0&
End Sub
代码运行时的效果：

Answer 14

感谢lyserver,你的方法我试了一下,似乎不行哦.

Answer 15

PictureClip控件绝对是不二之选，大多数的程序就是把所有图像合并为一张大图，使用的时候用PictureClip切割再引用，假设PictureClip把图像切成2行2列，然后用.GraphicCell(i)引用图像块，大概是从左到右，从上到下，2行2列就是切成四个图像，左上那个为.GraphicCell(0)类推，网上搜索一下就知道用法了。
或者把位图做成资源文件，不过还是用PictureClip控件好。