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控件
已标记关键词 清除标记
©️2020 CSDN 皮肤主题: 大白 设计师:CSDN官方博客 返回首页