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

 

  Dicas

  Visual Basic    (Miscelâneas)

Título da Dica:  Crie um efeito de lente de aumento com zoom de onde o mouse está
Postada em 15/1/2004 por PC            
'********************************************************************
'DESENHE no seu form o seguinte:
'1 picturebox,
'1 textbox,
'1 timer e,
'1 VScrollbar vertical
'********************************************************************
Option Explicit

Private Type POINTAPI
    x As Long
    y As Long
End Type
Private Declare Function GetParent Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function WindowFromPoint Lib "user32.dll" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Function GetCursorPos Lib "USER32" (lpPoint As POINTAPI) As Long
Private Declare Function ReleaseDC Lib "user32.dll" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function GetWindowDC Lib "USER32" (ByVal hwnd As Long) As Long
Private Declare Function GetDesktopWindow Lib "USER32" () As Long
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 Sub Form_Load()
  Me.Move 30, 30, 5775, 7390
  VScroll1.Value = 90
  Text1.Text = VScroll1.Value & "%"
  Me.AutoRedraw = True
End Sub
'***********************************************************************
Private Sub Form_Resize()
  Picture1.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight - 315
  Text1.Move 0, Me.ScaleHeight - 315, 765, 315
  VScroll1.Move 765, Me.ScaleHeight - 315, 195, 315
End Sub
'***********************************************************************
Private Sub Timer1_Timer()
Dim rv As Long, mXY As POINTAPI, magFCT As Single
Dim hWP As Long, hPP As Long, maxWIDTH As Long, maxHEIGHT As Long
Dim src_LEFT As Long, src_TOP As Long, src_WIDTH As Long, src_HEIGHT As Long
Dim dst_LEFT As Long, dst_TOP As Long, dst_WIDTH As Long, dst_HEIGHT As Long
Dim dst_centerX As Long, dst_centerY As Long
Dim src_HANDLE As Long, src_DC As Long
Dim meW As Long, meH As Long
    magFCT = 1 - (VScroll1.Value / 100)
    rv = GetCursorPos(mXY)
    hWP = WindowFromPoint(mXY.x, mXY.y)
    hPP = GetParent(hWP)
    If hPP = 0 Then hPP = hWP
    If hPP <> Me.hwnd Then
        dst_centerX = Picture1.ScaleWidth / 2
        dst_centerY = Picture1.ScaleHeight / 2
        dst_LEFT = 0
        dst_TOP = 0
        dst_WIDTH = Picture1.ScaleWidth / Screen.TwipsPerPixelX
        dst_HEIGHT = Picture1.ScaleHeight / Screen.TwipsPerPixelY
        meH = (Picture1.ScaleHeight / Screen.TwipsPerPixelX) * magFCT
        meW = (Picture1.ScaleWidth / Screen.TwipsPerPixelY) * magFCT
        src_LEFT = mXY.x - (meW / 2)
        src_TOP = mXY.y - (meH / 2)
        src_WIDTH = meW
        src_HEIGHT = meH
        maxWIDTH = Screen.Width / Screen.TwipsPerPixelX
        maxHEIGHT = Screen.Height / Screen.TwipsPerPixelY
        If src_LEFT < 0 Then
            dst_centerX = dst_centerX + (src_LEFT * (Screen.TwipsPerPixelX / magFCT))
            src_LEFT = 0
        ElseIf src_LEFT + src_WIDTH > maxWIDTH Then
            dst_centerX = dst_centerX + (src_LEFT + src_WIDTH - maxWIDTH) * (Screen.TwipsPerPixelX / magFCT)
            src_LEFT = src_LEFT - (src_LEFT + src_WIDTH - maxWIDTH)
        End If
        If src_TOP < 0 Then
            dst_centerY = dst_centerY + (src_TOP * (Screen.TwipsPerPixelY / magFCT))
            src_TOP = 0
        ElseIf src_TOP + src_HEIGHT > maxHEIGHT Then
            dst_centerY = dst_centerY + (src_TOP + src_HEIGHT - maxHEIGHT) * (Screen.TwipsPerPixelY / magFCT)
            src_TOP = src_TOP - (src_TOP + src_HEIGHT - maxHEIGHT)
        End If
        src_HANDLE = GetDesktopWindow()
        src_DC = GetWindowDC(src_HANDLE)
        StretchBlt Picture1.hdc, _
                   dst_LEFT, dst_TOP, dst_WIDTH, dst_HEIGHT, _
                   src_DC, _
                   src_LEFT, src_TOP, src_WIDTH, src_HEIGHT, vbSrcCopy
        rv = ReleaseDC(src_HANDLE, src_DC) ' release screen dc
        Picture1.Line (dst_centerX, dst_centerY - 300)-(dst_centerX, dst_centerY + 300)
        Picture1.Line (dst_centerX - 300, dst_centerY)-(dst_centerX + 300, dst_centerY)
    End If
    Me.Caption = "(x,y)=" & mXY.x * Screen.TwipsPerPixelX & "," & mXY.y * Screen.TwipsPerPixelY
End Sub
'******************************************************************************
Private Sub VScroll1_Change()
  Text1.Text = VScroll1.Value & "%"
End Sub
 


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