VB 让picturebox 图片拉伸和平铺

拉伸:

Picture1.PaintPicture   LoadPicture( "a.jpg "),0,0,Picture1.Width,Picture1.Height

‘’--------------------------------------------------------------------------------------------------------------------------------------------------

平铺:


方法一:
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控件

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

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

余额充值