保持图片和图片框一致的方法

最新推荐文章于 2026-02-15 00:58:46 发布

原创最新推荐文章于 2026-02-15 00:58:46 发布 · 1.4k 阅读

0 ·

本内容遵循CC 4.0 BY-SA版权协议

标签

#integer #command #string #function #vb

本文介绍了解决VB中Picture控件无法自动调整图片大小的问题。通过使用自定义函数和GDI+库，实现图片按比例填充PictureBox，确保图片完整显示且不失真。

众所周知，VB的picture控件没有Stretch属性，加载在picture中的图片往往不是比picture小，就是比picture大，图片比picture小时不能充满整个picture，比picture大时图片不能完全显示。很不方便，下面的代码可以解决这个问题，给你带来方便。

'模块代码:

Option Explicit
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Type BITMAP
        bmType As Long
        bmWidth As Long
        bmHeight As Long
        bmWidthBytes As Long
        bmPlanes As Integer
        bmBitsPixel As Integer
        bmBits As Long
End Type
Dim bm As BITMAP
Dim hBmp As Long

Public Sub SameToPicture(ByRef pic As PictureBox, ByVal Ifilename As String)
pic.Picture = LoadPicture(Ifilename)
hBmp = pic.Picture.Handle
GetObject hBmp, LenB(bm), bm
pic.Width = bm.bmWidth * Screen.TwipsPerPixelX
pic.Height = bm.bmHeight * Screen.TwipsPerPixelY
End Sub

Public Sub SameToPic(ByRef pic As PictureBox, ByVal Ifilename As String)
pic.Picture = LoadPicture(Ifilename)
pic.PaintPicture pic.Picture, 0, 0, pic.Width, pic.Height, 0, 0
End Sub
'窗体代码:

Private Sub Command1_Click()
SameToPicture Picture1, App.Path & "/" & "124.jpg"
Picture1.Move 0, 0
End Sub

Private Sub Command2_Click()
SameToPic Picture1, App.Path & "/" & "124.jpg"
Picture1.Move 0, 0
End Sub