USUÁRIO:      SENHA:        SALVAR LOGIN ?    Adicione o VBWEB na sua lista de favoritos   Fale conosco 

 

  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
 


CyberWEB Network Ltda.    © Copyright 2000-2024   -   Todos os direitos reservados.
Powered by HostingZone - A melhor hospedagem para seu site
Topo da página