|
|
|
|
|
|
|
|
Dicas
|
|
|
Visual Basic (Imagem/Som/Multimídia)
|
|
 |
Título da Dica: Auto-ajuste de imagem no PictureBox
|
 |
|
|
|
Postada em 6/1/2003 por Spidey
Option Explicit
Private DX As New DirectX7
Private DDRAW As DirectDraw7
Private Primary As DirectDrawSurface7
Private SurfDesc As DDSURFACEDESC2
Private picBMP As DirectDrawSurface7
Private Clipper As DirectDrawClipper
Private Sub Form_Load()
On Error GoTo ErroInicio
Me.ScaleMode = 3
Set DDRAW = DX.DirectDrawCreate("")
DDRAW.SetCooperativeLevel Me.hWnd, DDSCL_NORMAL
SurfDesc.lFlags = DDSD_CAPS
SurfDesc.ddsCaps.lCaps = DDSCAPS_PRIMARYSURFACE
Set Primary = DDRAW.CreateSurface(SurfDesc)
SurfDesc.lFlags = DDSD_CAPS
SurfDesc.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN
Set picBMP = DDRAW.CreateSurfaceFromFile(App.Path & "\teste.bmp", SurfDesc)
Set Clipper = DDRAW.CreateClipper(0)
Clipper.SetHWnd Picture1.hWnd
Primary.SetClipper Clipper
Exit Sub
ErroInicio:
MsgBox "Erro de Inicialização", vbCritical, "ERROR!"
Unload Me
End Sub
Private Sub Picture1_Paint()
Dim destRect As RECT
Dim srcRect As RECT
DX.GetWindowRect Picture1.hWnd, destRect
picBMP.GetSurfaceDesc SurfDesc
srcRect.Right = SurfDesc.lWidth
srcRect.Bottom = SurfDesc.lHeight
Primary.Blt destRect, picBMP, srcRect, DDBLT_WAIT
End Sub
É necessário ativar a referência DirectX7 For Visual Basic Type Library
|
|
|
|
|
