|
|
|
|
|
|
|
|
Dicas
|
|
|
Visual Basic (ActiveX/Controles/DLL)
|
|
 |
Título da Dica: Zoom em Picture box
|
 |
|
|
|
Postada em 18/4/2006 por Geronimo
Para testar desenhe 2 pictureboxes, 1 commandbutton e 1 textbox num form vazio e cole o seguinte código:
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 hStretchMode As Long) As Long
Const STRETCHMODE = vbPaletteModeNone
Private Sub Form_Load()
Picture1.BorderStyle = 0
Picture1.AutoRedraw = True
Picture2.AutoRedraw = True
Picture1.AutoSize = True
' Troque para a sua imagem
Picture1.Picture = LoadPicture("C:imagem.gif")
Command1.Caption = "Redimensiona"
Text1.Text = "100"
End Sub
Sub Redimensiona(picOrigem As PictureBox, picDestino As PictureBox, NWidth As Long, NHeight As Long)
Dim OrigWdt As Long
Dim OrigHgt As Long
OrigWdt = picOrigem.Width / Screen.TwipsPerPixelX
OrigHgt = picOrigem.Height / Screen.TwipsPerPixelY
SetStretchBltMode picDestino.hdc, STRETCHMODE
StretchBlt picDestino.hdc, 0, 0, NWidth, NHeight, picOrigem.hdc, 0, 0, OrigWdt, OrigHgt, vbSrcCopy
picDestino.Refresh
End Sub
Private Sub Command1_Click()
Dim NX As Long
Dim NY As Long
Dim P As Integer
Dim PW As Long
Dim PH As Long
' Pega o fator do zoom (em porcentagem)
P = Val(Text1)
If P < 1 Then Exit Sub
' Converte os valores de himetric pra pixel
PW = ScaleX(Picture1.Picture.Width, vbHimetric, vbPixels)
PH = ScaleX(Picture1.Picture.Height, vbHimetric, vbPixels)
' Calcula o tamanho
NX = (PW * P) / 100
NY = (PH * P) / 100
' Zera a imagem destino
Set Picture2.Picture = LoadPicture("")
' Copia
Redimensiona Picture1, Picture2, NX, NY
End Sub
|
|
|
|
|
