Zoom sur curseur

Télécharger le projet
Commenter

Description

Ce code permet de réaliser un zoom comme la loupe Windows. C'est à dire voir les alentours du curseur en plus ou moins gros. Tout cela reste biensûr en avant afin de pouvoir s'en servir partout... Le code est simple mise à part la fonction StretchBlt un peu compliquée dans ses paramètres.

Source / Exemple : 


'Pour que ça fonctionne, il faut une form (form1), 2 boutons (command5 et comand6)
'une Picturebox (Zoom) et un Timer (timer1) réglé sur interval = 1

'Déclaration de fonction pour récupérer les coordonnées de la souris
Private Declare Function GetCursorPos Lib "user32" (lpPoint As coord) As Long

'Définition du format de la variable
Private Type coord
        x As Long
        y As Long
End Type

'Déclaration de la fonction toujours dessus
Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

Const ScrCopy = &HCC0020 'Constante pour la copie
'Déclaration de l'utilisation de StretchBlt , fonction de copie d'image , Librairie gdi32.dll
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
                                         
'Zoom avant
Private Sub Command5_Click()
n = 1
If Form1.Tag < 0 Then n = 0
Form1.Tag = Form1.Tag + n
End Sub

'Zoom arrière
Private Sub Command6_Click()
n = 1
If Form1.Tag < 2 Then n = 0 'pour ne pas aller trop loin dans le zoom
Form1.Tag = Form1.Tag - n
End Sub

Private Sub Form_Load()
SetWindowPos hWnd, -1, 0, 0, 0, 0, &H10 Or &H40 Or &H2 Or &H1 'Définition du toujours dessus
Form_Resize
End Sub

Private Sub Form_Resize()
'Cadrage de l'image Zoom sur la form
Zoom.Width = Form1.ScaleWidth
Zoom.Height = Form1.ScaleHeight
End Sub

Private Sub Timer1_Timer()
Dim sour As coord

'Appel des coordonnées du curseur
Call GetCursorPos(sour)

'Extraction de l'image
l = StretchBlt(Zoom.hdc, 0, 0, Zoom.ScaleWidth, Zoom.ScaleHeight, _
            Form1.hdc, sour.x - (Zoom.ScaleWidth / (Form1.Tag * 2) + Form1.Left / 15), sour.y - (Zoom.ScaleHeight / (Form1.Tag * 2) + Form1.Top / 15 + 23), _
            Zoom.Width / Form1.Tag, Zoom.Height / Form1.Tag, ScrCopy)

End Sub

Conclusion :


Vous allez peut être dire que c'est nul car windows le fait déjà mais là, on peut la contrôler via VB...

Vos commentaires m'intéressent, c'est ma première source sur VBFrance, donc si la présentation peu être améliorée pour une meilleure compréhension je suis preneur !!!
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.