Visual Basic, VB6, VB.NET, VB 2005, VB CodeS-SourceS

CodeS-SourceS est hébergé par Frontier.fr

Ce site au démarrage

begin process at 2012 02 16 05:50:39

Accueil Codes Tutoriels Forum Livres Emploi Services Connexion

Trouver un code source :

dans

[ Dernières recherches ]

Accueil >

UNE LOUPE EN 2 LIGNES DE CODE!!!

Information sur la source

Note :

8,50 / 10

Catégorie :API Classé sous :loupe, zoom, agrandir, stretchblt Niveau :Débutant Date de création :29/03/2006 Vu :8 300

Auteur : clementio

Ecrire un message privé

Site perso

Ce membre participe au partage de revenus publicitaires

Commentaire sur cette source (19)

Ajouter un commentaire et/ou une note

Description

Record à battre 2 lignes de code pour une loupe!!!

Bon, c'est sans compter les déclarations d'API mais c'est pas mal quand même...

Juste 3 API, un Timer (intervalle = 200), une PictureBox et c'est parti, facile non???

Source

Option Explicit
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function GetWindowDC Lib "user32" (ByVal HWnd As Long) 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 Type POINTAPI
X As Long
Y As Long
End Type
Dim Pt As POINTAPI
Private Sub Timer1_Timer()
GetCursorPos Pt
StretchBlt Picture1.hdc, 0, 0, Picture1.Width / Screen.TwipsPerPixelX, Picture1.Height / Screen.TwipsPerPixelY, GetWindowDC(0), Pt.X - 15, Pt.Y - 15, 30, 30, &HCC0020
End Sub

Option Explicit

Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function GetWindowDC Lib "user32" (ByVal HWnd As Long) 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 Type POINTAPI
    X As Long
    Y As Long
End Type

Dim Pt As POINTAPI

Private Sub Timer1_Timer()

   GetCursorPos Pt
   StretchBlt Picture1.hdc, 0, 0, Picture1.Width / Screen.TwipsPerPixelX, Picture1.Height / Screen.TwipsPerPixelY, GetWindowDC(0), Pt.X - 15, Pt.Y - 15, 30, 30, &HCC0020

End Sub

Sources du même auteur

DICO ACCORDS GUITARE

CLM'S GUITARE : DICO ACCORDS + ACCORDAGE

CLM'S EMERGENCY : REFROIDISSEUR DE CPU

CLM'S MESSENGER : AJOUT DE FONCTIONS À WINDOWS LIVE MESSENGE...

CLMOOGLE : MOTEUR DE RECHERCHE INTUITIF

Toutes les sources de clementio

Sources de la même categorie

.NET DEPENDENCY VIEWER : ARBRE DES DÉPENDANCES D'UN ASSEMBLY... par ShareVB

UTILITAIRE SKYDRIVE par MasterShadows

ROTATION RAPIDE D'IMAGE par trex70

ENUMERATION DES PORTS TCP ET IDENTIFCATION DU PROCESS (PID) ... par Renfield

MOUSE SPEED AND WEIGHT : RETOUR DE FORCE VIRTUEL ! par ScSami

Toutes les sources de la catégorie API

Sources en rapport avec celle ci

UTILISER LA CAMERA POUR DIRECTX par zulrigh

LOUPE - CAPTURES D'ÉCRANS par zozo14

TRIOCOLOR JEU DE DOMINOS EN COULEURS (VB6) par philbar71

LOUPE PICTURE BOX par rboubaker

IMAGE JPEG ET ZOOM par theboz

Commentaires et avis

Commentaire de Willi le 29/03/2006 16:01:29 administrateur CS

Tient, j'ai exactement le même code dans mes archives de codes sources.
Sinon un petit commentaire quand même pour 2 lignes :D

Commentaire de clementio le 29/03/2006 16:15:56 administrateur CS

Poutant je l'ai trouvé tout seul en combinant des API...

C'est simple, on récupère la position du curseur et on dessine en agrandi le rectangle autour de cette position dans une PictureBox...

Commentaire de EBArtSoft le 29/03/2006 20:39:40 administrateur CS

Ok defit relevé !

Deja je vire la picture box je mets scalemode en pixel puis je degare point api j'ajoute des ":" et me voila avec 1 seule "ligne de code" (selon ton principe) :p :

Option Explicit

Private Declare Function GetCursorPos Lib "user32" (lpPoint As Any) As Long
Private Declare Function GetWindowDC Lib "user32" (ByVal HWnd As Long) 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 Timer1_Timer()
Dim Pt(1) As Long: GetCursorPos Pt(0): StretchBlt Me.hdc, 0, 0, Me.ScaleWidth, Me.ScaleHeight, GetWindowDC(0), Pt(0) - 15, Pt(1) - 15, 30, 30, &HCC0020
End Sub

@+

Commentaire de clementio le 29/03/2006 20:52:52 administrateur CS

Lol

Eh ben en plus tu m'a appris un truc!!!!

Je ne savais pas que dans une décalaration d'API on pouvait remplacer le type attendu du paramètre par Any et utiliser l'API avec un tableau de valeurs. Merci pour l'info...

Pour ce qui est d'homologuer ton record, c'est quand même un peu facile les ":", non???

Enfin bref, on est là pour s'amuser et si d'autres on des solutions à proposer, ils sont les bienvenus!!!

Commentaire de EBArtSoft le 29/03/2006 20:57:02 administrateur CS

Oui lol mais c'est aussi facile que de ne pas compter les declaration de variable et d'api ! ;)

Et on pourrais encore aller plus loin en utilisant une tlb

@+

Commentaire de M4ndrax le 29/03/2006 21:00:37

sa a l'aires super mais moi j'ai vb.net et sa me di deja que :
le code
Option Explicit n'est pas déclarer donc je pense que cété juste une remarque mais par contre il me dit que Pt et Picture1.hdc ainsi que Screen.TwipsPerPixelX ne sont pas déclarer du moin les hdc... alors que si, alors peut tu remasteriser ton code pour vb.net plz

Commentaire de BruNews le 29/03/2006 21:26:38 administrateur CS

Alors on fait bien mumuse par ici ?

EB > ReleaseDC correspondant au GetWindowDC, il est caché où ???

Commentaire de clementio le 29/03/2006 21:38:08 administrateur CS

Eheheh, il faut bien de temps en temps...

Pour le .NET, c'est mort, autant VB je peux t'aider que .Net je connais absolument rien...

Mais peut-être que quelqu'un peut te le traduire et le déposer ici en commentaire, avis aux amateurs...

Commentaire de M4ndrax le 29/03/2006 22:15:15

Si quelqu'un pouvait retrenscire le code en .net sa serait geniale, merci d'avance.

Commentaire de mcs2006 le 29/03/2006 22:56:05

<M4ndrax> : Pour le .NET, dans la mesure de mes connaissances embryonnaires, je dirais :

- Oublier le 'Option Explicit' du VB6, en VB.NET c'est par défaut et ce n'est pas un mal (bien qu'on puisse le désactiver) et pas besoin de le déclarer dans le code.
- Oublier aussi les Screen.TwipsPerPixelX et Screen.TwipsPerPixelY. Dans la mesure de mes connaissances en VB.NET, par exemple, Picture1.Width suffit en VB.NET, pas besoin de Picture1.Width / Screen.TwipsPerPixelX. Bon, ça c'est encore à voir.
- pour les API's utilisées, traduction :
GetCursorPos = System.Windows.Forms.Cursor.Current.Position
GetWindowDC = System.Windows.Forms.Form.CreateGraphics.GetHdc
StretchBlt = System.Drawing.Graphics.DrawImage

Le reste, je te laisse le traduire. Peut-être même qu'il existe une fonction loupe intégrée dans le FrameWork ? Pour le coup, question nombre de lignes de code (y compris les déclarations) tu pourras faire mieux que <EBArtSoft> lol.

Commentaire de mcs2006 le 29/03/2006 22:58:26

Petit oubli : le "type" ANY n'existe plus en VB.NET. A remplacer par le vrai type des valeurs passées.

Commentaire de EBArtSoft le 29/03/2006 23:45:11 administrateur CS

BruNews> lol ouai de toute façon on s'en tape c'est du VB !
non non je deconne pour le coup on rajoute une api et une variable mais de toute façon avec des ":" ça tient encore sur une ligne :p

Commentaire de moustachu le 30/03/2006 08:31:15

Bonjour,

et en une ligne sans ":"

Private Sub Loupe
Shell magnify
End Sub

C'est bon, j'ai gagné, hein, dites ??!?

++
Moustachu

Commentaire de clementio le 30/03/2006 08:46:57 administrateur CS

eheheh....

Commentaire de zemetafyzik le 30/03/2006 19:24:06

Je sais que c'est pas un bug du programme, mais pourquoi quand je deplace le curseur sur les vidéos de winamp (meme sur pause) sa ne s'affiche pas ? et pourquoi ça affiche certaine infobulle, mais pas toutes ???

merci

Commentaire de clementio le 30/03/2006 19:50:15 administrateur CS

Le prog utilise l'API GetWindowDC qui renvoie le DC d'une fenêtre. C'est une zone contenant l'aperçu graphique d'une fenêtre.

Avec GetWindowDC(0) (le paramètre passé est zéro), on demande le DC "général". C'est-à-dire qu'au lieu de demander le DC d'une fenêtre particulière grâce à son handle, on obtient toute la partie visible à l'écran (un peu un genre d'Impr Ecran).

Mais le problème que tu constates est que certaines fenêtres (comme WinAmp en mode vidéo) n'imprime pas de zone visible dans le DC "général". C'est du au fait du rendu utilisé par WinAmp donc impossible de voir cette zone. C'est pareil pour les infos bulles.

Je ne sais pas si c'est très clair pour toi et je pense ne pas être trop loin de la vérité dans mon explication...

Commentaire de zemetafyzik le 30/03/2006 21:57:01

Merci
t'en fait pas pour la clarté, si je comprend pas tout maintenant je comprendrais plus tard, mais c'est deja plus clair ^^

Commentaire de Warny le 15/07/2009 10:29:53

Salut,
Sous windows (sauf vista avec aero) il y a deux principes pour dessiner :
- un principe lent, mais général, les programmes demandent à windows de dessiner sur la sortie écran standard. C'est ce que tu vois avec la loupe.
- un principe rapide qui consiste à écrire directement et au dernier moment en mémoire mais qui pose un problème de gestion de conflits, c'est le cas de winamp, de toutes les vidéos en général et de directX. Là, tu vois du noir avec la loupe, puisque l'image est apposée après la composition de windows.

PS: je considère personnelement que quand on sépare des instructions avec ":" ça fait toujours 2 lignes de code.

Commentaire de Hackdevil le 26/07/2011 23:49:41

Bonjour, j'essaye d'utiliser votre code en vb.net mais je n'y arrive pas :s
Le but pour moi est de créer un effet de loupe quand on passe la souris sur une image.
En gros, j'essaye de faire un jeu du genre où est Charlie et quand on passe la souris sur l'image, on cherche en zoom.
J'ai cherché de l'aide un peu partout mais je ne trouve quasi rien en vb.net.

J'ai essayer de retranscrire votre code vb 6 en vb.net, ça se lance mais il n'y a pas de loupe ni rien...
Je suis plutôt débutant donc ne soyez pas trop sévères ;)

Désolé de déterrer un topic mais votre source m'intéresse vraiment.

Le code :

Private Declare Function GetWindowDC Lib "user32" (ByVal HWnd As Long) 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

Dim PosX As Long
Dim PosY As Long

Private Sub PictureBox1_MouseEnter(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles PictureBox1.MouseEnter
        Timer1.Start()
End Sub

Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
        PosX = MousePosition.X
        PosY = MousePosition.Y
        StretchBlt(PictureBox1.CreateGraphics.GetHdc, 0, 0, PictureBox1.Width, PictureBox1.Height, GetWindowDC(0), MousePosition.X - 15, MousePosition.Y - 15, 30, 30, &HCC0020)
End Sub

Ajouter un commentaire

Discussions en rapport avec ce code source dans le forum

zoom photo... [ par Fabian123 ] Bonjour à toutes et tous!voilà, j'ai une petite question (je débute en vba...soyez indulgent!)j'ai associé une macro (que j'ai trouvé sur le net) à un agrandir une fenetre [ par Fabian123 ] Bonjour,je travaille sur visual basic express 2008 (la version gratuite)je découvre et donc je fait beaucoup d'erreurs!Voici ma question:j'ai une "For StretchBlt et objet Printer [ par electroremy ] Bonjour,je suis en train de terminer la version III de CiDess.je programme en VB5 SP3J'ai rencontré pas mal de déboirres pour dessiner et imprimer du Zoom et déplacement dans une picturebox [ par podolis ] Je suis ergonome logiciel junior mais je ne sais pas coder. Je viens de commencer le VB car je me suis aperçu que power point était très limiter. J'a Zoom sur coordonnées de la souris dans picutre box [ par podolis ] Je cherche à faire un zoom sur les coordonnées de ma souris (après un clique sur la picutrebox), pour le moment j'utilise ce code qui me permet juste Logiciel APi @ la Loupe 2008 [ par zavier666 ] Bonjour,après quelques jours de programmation, j'ai enfin terminé la version 2008 de mon logiciel APi @ la Loupe.Pour être dernier jus, je l'ai fait s Zoom sur fichier wmf [ par podolis ] Je fais un zoom sur une picturebox dans un panel avec des image au format WMF mais quand je zoom, je n'ai pa le niveau de détail max de mon image au f Listbox Zoom sur item [ par alihome ] Bonjour à tous,J'ai une listbox avec la propriétée View sur Largeicon, et une imagelist pour la listbox. Avec mon code je peux afficher toutes les ima agrandir les bouton ToolStrip [ par tamort ] bonjourcomment puis je agrandir la taille des boutons dans un ToolStrip dans le vb 2005merci d'avance move et zoom dans picturebox [ par podolis ] Voila j'arrive sans difficulté a zoomé et à déplacer une picturebox dans un Panel mais j'aimerais que lorsque que je déplace ma picture box et qu' apr

Nos sponsors

Derniers Blogs

GESTION D'EXCEPTION AVEC LES TASKS par richardc

DéMARRONS AVEC LES TASKS par richardc

SLIDE & DéMO TECHDAYS 2012 - FAST & FURIOUS XAML APPS par Vko

XNA IS DEAD! par richardc

TECHDAYS PARIS 2012 : WINDOWS SERVER "8" QUOI DE 9 ! par ROMELARD Fabrice

Forum

RE : PROBLèME VéRIFICATION MD5 DEPUIS UN ENCLENCHEMENT DE BOUTON. par LeFoureur

RE : BLOCAGE DE MON PROGRAMME par ucfoutu

RE : PROBLèME VéRIFICATION MD5 DEPUIS UN ENCLENCHEMENT DE BOUTON. par NHenry

RE : OUVRIR PLUSIEURS FICHIERS EXCEL EN MêME AVEC VB par ossama261988

Côté IT

Offres d'emploi

Formations Video

Appels d'offres

Finalisation site d-encheres au centime
Budget : 2 800€
Recherche expert webmarketing
Budget : 3 000€
Republication - fichier d-export de site OS commerce ver plateforme logistique-CDC disponible
Budget : 1 200€

Logiciels

DocTranslate (V3.1.0.0)
DOCTRANSLATE (V3.1.0.0)

DocTranslate est un traducteur de document Microsoft Word, PowerPoint et Excel. Il permet d'autom...

Cliquez pour télécharger DocTranslate
Tribler (2012)
TRIBLER (2012)

Tribler est un client pair à pair (P2P/Peer-to-Peer) open source avec la capacité de regarder des...

Cliquez pour télécharger Tribler
OneSwarm (2012)
ONESWARM (2012)

Le peer-to-peer qui protège votre vie privée, c'est OneSwarm. Ce logiciel de peer-to-peer crypté...

Cliquez pour télécharger OneSwarm
PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V8.4)
PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V8.4)

PONAMEDIA TV DEVIENS HELLLOOO FLASH LA TV SUR VOTRE ORDINATEUR. Toute une plateforme Multi...

Cliquez pour télécharger PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO
Academy System (17.2.1.0)
ACADEMY SYSTEM (17.2.1.0)

Logiciel de gestion des établissements. - élèves/étudiants (inscription, dossier, absence...) -...

Cliquez pour télécharger Academy System