vb6.0中Picture控件
如何让一张大于picture控件的图形在picture控件中完整的显示出来?我试过了autoredraw和autosize的设置,都不管用
[解决办法]
image控件可以先设stretch为true,再设大小
[解决办法]
缩小显示不就OK了?
[解决办法]
Option Explicit
'Form1上添加1个图片框picture1,1个命令按钮command1
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 Const SRCCOPY = &HCC0020 ' (DWORD) dest = source
Private Sub Form_Load()
Me.Picture = LoadPicture("F:\资料\My Pictures\hehua5.jpg") '加入窗体背景图
Picture1.Visible = True
Picture1.AutoRedraw = True
Me.AutoRedraw = True
Me.ScaleMode = 3
Picture1.ScaleMode = 3
End Sub
Private Sub Command1_Click()
Dim Rtn As Long
Dim hDC1 As Long, hDC2 As Long
hDC1 = Picture1.hdc
hDC2 = Me.hdc
Rtn = SetStretchBltMode(hDC1, HALFTONE)
Rtn = StretchBlt(hDC1, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight, hDC2, 0, 0, Me.ScaleWidth, Me.ScaleHeight, SRCCOPY)
Picture1.Refresh
End Sub
Option Explicit
Function Min(ByVal v1 As Variant, ByVal v2 As Variant) As Variant
Min = IIf(v1 < v2, v1, v2)
End Function
Private Sub Command1_Click()
Dim pic As IPictureDisp
Dim dblZoom As Double
Set pic = LoadPicture("C:\WINDOWS\Web\Wallpaper\Bliss.bmp")
dblZoom = Min(Picture1.ScaleWidth / pic.Width, Picture1.ScaleHeight / pic.Height)
Picture1.PaintPicture pic, 0, 0, pic.Width * dblZoom, pic.Height * dblZoom
End Sub
Private Sub Form_Load()
Picture1.ScaleMode = vbPixels
End Sub