方法1-用Image控件模拟窗体背景图片: Private Sub Form_Load() With Image1 .Stretch = True '图片自动缩放 .Picture = LoadPicture(C:\WINDOWS\Web\Wallpaper\风景01.jpg) '加载图片 .ZOrder 1 '置后显示,避免遮住其他轻量控件(如image和label控件) End With End Sub ' Private Sub Form_Resize() '在窗体缩放时图片随之缩放 Image1.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight End Sub
方法2-纯代码设置Form1.Picture: Private Declare Function GetDC Lib user32 (ByVal hwnd As Long) As Long Private Declare Function ReleaseDC Lib user32 (ByVal hwnd As Long, ByVal hdc As Long) As Long Private Declare Function CreateCompatibleDC Lib gdi32 (ByVal hdc As Long) As Long Private Declare Function CreateCompatibleBitmap Lib gdi32 (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long Private Declare Function SelectObject Lib gdi32 (ByVal hdc As Long, ByVal hObject As Long) As Long Private Declare Function DeleteObject Lib gdi32 (ByVal hObject As Long) As Long Private Declare Function DeleteDC Lib gdi32 (ByVal hdc As Long) As Long Private Declare Function OleCreatePictureIndirect Lib olepro32.dll (PicDesc As PicBmp, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long 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 SetStretchBltMode Lib gdi32 (ByVal hdc As Long, ByVal nStretchMode As Long) As Long Private Const HALFTONE = 4
Private Type GUID Data1 As Long Data2 As Integer Data3 As Integer Data4(7) As Byte End Type Private Type PicBmp Size As Long Type As Long hBmp As Long hPal As Long Reserved As Long End Type Const HIMETRIC_PER_PIXEL = 96 / 2540
Dim oBackPic As StdPicture
Private Function StretchPicture(oPic As StdPicture, lWidth As Long, lHeight As Long) As StdPicture Dim hdc As Long, hDCmem As Long, HDCmemSrc As Long Dim hBmp As Long, hBmpPrev As Long, hBmpPrevSrc As Long Dim lWidthSrc As Long, lHeightSrc As Long lWidthSrc = oPic.Width * HIMETRIC_PER_PIXEL lHeightSrc = oPic.Height * HIMETRIC_PER_PIXEL hdc = GetDC(0) hDCmem = CreateCompatibleDC(hdc) HDCmemSrc = CreateCompatibleDC(hdc) hBmp = CreateCompatibleBitmap(hdc, lWidth, lHeight) hBmpPrev = SelectObject(hDCmem, hBmp) hBmpPrevSrc = SelectObject(HDCmemSrc, oPic.Handle) SetStretchBltMode hDCmem, HALFTONE StretchBlt hDCmem, 0, 0, lWidth, lHeight, HDCmemSrc, 0, 0, lWidthSrc, lHeightSrc, vbSrcCopy hBmp = SelectObject(hDCmem, hBmp) DeleteDC hDCmem DeleteDC HDCmemSrc ReleaseDC 0, hdc
Dim pic As PicBmp Dim IPic As IPicture Dim IID_IDispatch As GUID
With IID_IDispatch .Data1 = &H20400 .Data4(0) = &HC0 .Data4(7) = &H46 End With
With pic .Size = Len(pic) .Type = vbPicTypeBitmap .hBmp = hBmp .hPal = 0 End With OleCreatePictureIndirect pic, IID_IDispatch, 1, IPic Set StretchPicture = IPic End Function '' Private Sub Form_Load() Set oBackPic = LoadPicture(C:\WINDOWS\Web\Wallpaper\风景01.jpg) End Sub
Private Sub Form_Resize() With Me .Picture = StretchPicture(oBackPic, .ScaleX(.ScaleWidth, .ScaleMode, vbPixels), .ScaleY(.ScaleHeight, .ScaleMode, vbPixels)) End With End Sub
Private Sub Form_Unload(Cancel As Integer) Set oBackPic = LoadPicture() End Sub