vb 让图片平铺到PictureBox控件里,这里提供2种方法

方法一:
Private   Sub   Form_Click()
        Dim   高数量   As   Long,   宽数量   As   Long
        Dim   X   As   Long,   Y   As   Long
        Picture2.BorderStyle   =   0
        Picture2.Picture   =   LoadPicture( "C:/1.BMP ")
        Picture2.AutoSize   =   True
        宽数量   =   Int(Picture1.Width   /   Picture2.Width)
        If   宽数量   *   Picture2.Width   <   Picture1.Width   Then
              宽数量   =   宽数量   +   1
        End   If
        高数量   =   Picture1.Height   /   Picture2.Height
        If   高数量   *   Picture2.Height   <   Picture1.Height   Then
              高数量   =   高数量   +   1
        End   If
       
        For   Y   =   0   To   高数量
              For   X   =   0   To   宽数量
                    Picture1.PaintPicture   Picture2.Picture,   _
                                                                X   *   Picture2.Width,   Y   *   Picture2.Height
              Next   X
        Next   Y
End   Sub
方法二:
Option   Explicit

Private   Declare   Function   StretchBlt   Lib   "gdi32 "   (ByVal   hdc   As   Long,   ByVal   X   As   Long,   ByVal   Y   As   Long,   ByVal   nWidth   As   Long,   ByVal   nHeight   As   Long,   ByVal   hSrcDC   As   Long,   ByVal   xSrc   As   Long,   ByVal   ySrc   As   Long,   ByVal   nSrcWidth   As   Long,   ByVal   nSrcHeight   As   Long,   ByVal   dwRop   As   Long)   As   Long
Private   Declare   Function   BitBlt   Lib   "gdi32 "   (ByVal   hDestDC   As   Long,   ByVal   X   As   Long,   ByVal   Y   As   Long,   ByVal   nWidth   As   Long,   ByVal   nHeight   As   Long,   ByVal   hSrcDC   As   Long,   ByVal   xSrc   As   Long,   ByVal   ySrc   As   Long,   ByVal   dwRop   As   Long)   As   Long
Private   Const   SRCCOPY   =   &HCC0020
Private   Const   SRCAND   =   &H8800C6
Private   Const   SRCERASE   =   &H440328
Private   Const   SRCINVERT   =   &H660046
Private   Const   SRCPAINT   =   &HEE0086

Private   Sub   Form_Paint()
        Dim   W   As   Single,   H1   As   Single,   W1   As   Single,   H   As   Single
        Dim   pic   As   Picture
        '先清空窗体上原有图片背景
        Cls
   
        '如果出现异常错误,转向错误处理语句
        On   Error   GoTo   ErrorPic
        picFrom.AutoRedraw   =   True
        picFrom.AutoSize   =   True
        picFrom.Visible   =   False
        picFrom.Picture   =   LoadPicture( "E:/背景/素材/bkic007.gif ")
   
        '下面将图片排满整个窗体
        W   =   0
        H1   =   picFrom.ScaleHeight   /   15
        W1   =   picFrom.ScaleWidth   /   15
        While   W   <   ScaleWidth
                H   =   0
                While   H   <   ScaleHeight
'                         Me.hdc   ,   W,   H,   picFrom.Width,   picFrom.Height,   picFrom.hdc,   0,   0,   picFrom.Width,   picFrom.Height,   SRCCOPY
                        BitBlt   Me.hdc,   W,   H,   picFrom.Width,   picFrom.Height,   picFrom.hdc,   0,   0,   SRCCOPY
                        H   =   H   +   H1
                Wend
                W   =   W   +   W1
        Wend
        Exit   Sub
ErrorPic:
        MsgBox   Err.Description,   vbCritical
End   Sub

picFrom是一个picturebox控件
  • 0
    点赞
  • 4
    收藏
    觉得还不错? 一键收藏
  • 打赏
    打赏
  • 0
    评论

“相关推荐”对你有帮助么?

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包

打赏作者

蓝图

你的鼓励将是我创作的最大动力

¥1 ¥2 ¥4 ¥6 ¥10 ¥20
扫码支付:¥1
获取中
扫码支付

您的余额不足,请更换扫码支付或充值

打赏作者

实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值