请问VB6中有没有 能够让 小图片自动填充 的图片显示控件
请问VB6中有没有 能够让 小图片自动填充 的图片显示控件 , 象 WINDOWS 桌面 壁纸 的(1)居中 (2)平铺 (3)拉伸 中的 第(2)种 平铺模式一样的。
[解决办法]
image控件是可以做到拉伸的效果(填充),picturebox控件可以做到平铺的效果。
[解决办法]
这个功能可以用GDI+实现,很容易的
[解决办法]
使用以下的例子前请先下载Gdiplus.tlb,并将其放置到C:\Windows\System32中
Gdiplus.tlb下载
- VB code
'使用Gdiplus.tlb,将其放到system32中,然后添加对其的引用'手动设置Form的AutoRedraw=True,ScaleMode=PixelsOption ExplicitDim lngGraphics As LongDim lngImageHandle As LongDim lngTextureBrush As LongDim gpP As GpStatusDim lngPen1 As LongDim lngToken As LongDim GpInput As GdiplusStartupInputPrivate Sub Command1_Click() Dim intP As Integer gpP = GdipCreateFromHDC(Me.hDC, lngGraphics) '创建绘图区域设备场景 gpP = GdipLoadImageFromFile(App.Path & "\启动.png", lngImageHandle) '读取图片到内存 gpP = GdipDrawImage(lngGraphics, lngImageHandle, 0, 0) '等大小绘制 gpP = GdipDrawImageRect(lngGraphics, lngImageHandle, 200, 0, 300, 300) '在指定的区域内绘制(放大或缩小) gpP = GdipDrawImageRectRectI(lngGraphics, lngImageHandle, 550, 0, 400, 400, 20, 20, 80, 80, UnitPixel) '在400*400的区域内显示图片部分区域 gpP = GdipCreateTexture(lngImageHandle, WrapModeTile, lngTextureBrush) '设置一定排列方式的刷子 平铺方式 gpP = GdipFillRectangle(lngGraphics, lngTextureBrush, 0, 300, 400, 300) '在指定区域内按指定的格式绘制图片 If lngGraphics <> 0 Then GdipDeleteGraphics lngGraphics If lngImageHandle <> 0 Then GdipDisposeImage lngImageHandle If lngTextureBrush <> 0 Then GdipDeleteBrush lngTextureBrush Me.RefreshEnd SubPrivate Sub Form_Load() Dim bolP As Boolean With Me .Caption = "GDIPlus范例" .Width = 960 * 15 .Height = 720 * 15 .Left = (Screen.Width - .Width) * 0.5 .Top = (Screen.Height - .Height) * 0.5 End With GpInput.GdiplusVersion = 1 If lngToken = 0 Then bolP = (GdiplusStartup(lngToken, GpInput) = Ok)End Sub
[解决办法]
[解决办法]
使用下面函数可以在任意可显示图片的控件或窗口中按比例缩放
Private Sub PaintPhoto(xPic As IPictureDisp, Optional TxForm As Object = Nothing)
Dim r As Double, RP As Double
Dim W As Long, H As Long
Dim x As Long, y As Long
Dim X1 As Long, Y1 As Long
Dim X0 As Long, Y0 As Long
If xPic Is Nothing Then Exit Sub
x = xPic.Width
y = xPic.Height
If TxForm Is Nothing Then
X1 = Width
Y1 = Height
Else
X1 = TxForm.Width
Y1 = TxForm.Height
End If
r = y / x
RP = Y1 / X1
If r > RP Then
H = Y1 ' picPhoto.Height
W = H / r
Y0 = 0
X0 = (X1 - W) / 2
Else
W = X1 'picPhoto.Width '- picPhoto.ScaleWidth
H = W * r
X0 = 0
Y0 = (Y1 - H) / 2
End If
If Not TxForm Is Nothing Then
TxForm.Picture = Nothing
TxForm.PaintPicture xPic, X0, Y0, W, H ', 0, 0, X, Y
End If
End Sub