Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Développement Développement Visual Basic Utilisation de PaintPicture

Utilisation de PaintPicture

5 réponses
Avatar
Daniel AUBRY
Bonjour à tous,

j'ai un soucis pour utiliser PaintPicture sur une partie d'une image.
Mon but est de découper une partie d'image.

A l'aide de la souris, je trace un rextangle sur une image,
je récupère ses coordonnées pour dimensionner une
image temporaire.
Je PaintPicture dans l'image temporaire,
je redimensionne l'image d'origine
je PaintPicture l'image temporaire dans l'image d'origine.
Seulement il y a un loup dans les coordonnées ....

Dany

Si ca vous dit :

une form nommée Form1
un Label nommé Decoupeur
un PictureBox nommé SupportImage
un PictureBox nommé ImageTempo


Dim G_SELECT_TOP As Single
Dim G_SELECT_LEFT As Single
Dim G_SELECT_HEIGHT As Single
Dim G_SELECT_WIDTH As Single


Private Sub DisplaySelect()
Dim x1 As Single, x2 As Single
Dim y1 As Single, y2 As Single
Dim s As String

Call GetLatestSelection(x1, y1, x2, y2)

ImageTempo.Cls
ImageTempo.Width = x2 - x1
ImageTempo.Height = y2 - y1
ImageTempo.PaintPicture SupportImage.Image, x1, y1, x2 - x1, y2 - y1

SupportImage.Cls
SupportImage.Width = x2 - x1
SupportImage.Height = y2 - y1

SupportImage.PaintPicture ImageTempo.Image, 0, 0, ImageTempo.Width,
ImageTempo.Height
End Sub


Private Sub GetLatestSelection(ByRef x1 As Single, ByRef y1 As Single, ByRef
x2 As Single, ByRef y2 As Single)
x1 = G_SELECT_LEFT
y1 = G_SELECT_TOP
x2 = G_SELECT_LEFT + G_SELECT_WIDTH
y2 = G_SELECT_TOP + G_SELECT_HEIGHT
End Sub


Private Sub Form_Load()
Decoupeur.Visible = False
Decoupeur.Height = 1
Decoupeur.Width = 1
End Sub


Private Sub SupportImage_MouseDown(Button As Integer, Shift As Integer, X As
Single, Y As Single)
Decoupeur.Top = Y
Decoupeur.Left = X
Decoupeur.Height = 1
Decoupeur.Width = 1
Decoupeur.Visible = True
End Sub


Private Sub SupportImage_MouseMove(Button As Integer, Shift As Integer, X As
Single, Y As Single)
Dim dX As Single
Dim dy As Single

If Button = 1 Then ' left click
dy = Y - Decoupeur.Top

If dy < 0 Then
dy = 0
End If

Decoupeur.Height = dy
dX = X - Decoupeur.Left

If dX < 0 Then
dX = 0
End If

Decoupeur.Width = dX
End If
End Sub


Private Sub SupportImage_MouseUp(Button As Integer, Shift As Integer, X As
Single, Y As Single)
G_SELECT_TOP = Decoupeur.Top
G_SELECT_LEFT = Decoupeur.Left
G_SELECT_HEIGHT = Decoupeur.Height
G_SELECT_WIDTH = Decoupeur.Width
Decoupeur.Visible = False

Call DisplaySelect
End Sub
Signaler un problème avec ce contenu

5 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
Jean-Marc
"Daniel AUBRY" a écrit dans le message de
news:428edbd5$0$10279$
Bonjour à tous,

j'ai un soucis pour utiliser PaintPicture sur une partie d'une image.
Mon but est de découper une partie d'image.

A l'aide de la souris, je trace un rextangle sur une image,
je récupère ses coordonnées pour dimensionner une
image temporaire.
Je PaintPicture dans l'image temporaire,
je redimensionne l'image d'origine
je PaintPicture l'image temporaire dans l'image d'origine.
Seulement il y a un loup dans les coordonnées ....



<snip le code>

Hello,

pour que ça marche, juste une ligne à modifier:
Le premier Paintpicture de DisplaySelect() qui devient:

ImageTempo.PaintPicture SupportImage.Image, 0, 0, x2 - x1, y2 - y1, x1, y1,
x2 - x1, y2 - y1

Et le tour est joué. (Il y a moyen de simplifier tout ça, mais le principe
est ok)

--
Jean-marc
"There are only 10 kind of people
those who understand binary and those who don't."
Avatar
Daniel AUBRY
Super !!!

je te remercie vivement.

Si tu as des propositions pour simplifier je suis Ok, bien sur.

Dany
"Jean-Marc" a écrit dans le message de news:
428eea4a$0$26069$
"Daniel AUBRY" a écrit dans le message de
news:428edbd5$0$10279$
Bonjour à tous,

j'ai un soucis pour utiliser PaintPicture sur une partie d'une image.
Mon but est de découper une partie d'image.

A l'aide de la souris, je trace un rextangle sur une image,
je récupère ses coordonnées pour dimensionner une
image temporaire.
Je PaintPicture dans l'image temporaire,
je redimensionne l'image d'origine
je PaintPicture l'image temporaire dans l'image d'origine.
Seulement il y a un loup dans les coordonnées ....



<snip le code>

Hello,

pour que ça marche, juste une ligne à modifier:
Le premier Paintpicture de DisplaySelect() qui devient:

ImageTempo.PaintPicture SupportImage.Image, 0, 0, x2 - x1, y2 - y1, x1,
y1,
x2 - x1, y2 - y1

Et le tour est joué. (Il y a moyen de simplifier tout ça, mais le principe
est ok)

--
Jean-marc
"There are only 10 kind of people
those who understand binary and those who don't."




Avatar
Daniel AUBRY
Et pendant que j'y suis :
pour que cela soit d'un aspect assez pro, j'aimerais
que le cadre tracé change le ton de la partie qu'il recouvre.
A la manière d'ACDsee.

Dany
"Jean-Marc" a écrit dans le message de news:
428eea4a$0$26069$
"Daniel AUBRY" a écrit dans le message de
news:428edbd5$0$10279$
Bonjour à tous,

j'ai un soucis pour utiliser PaintPicture sur une partie d'une image.
Mon but est de découper une partie d'image.

A l'aide de la souris, je trace un rextangle sur une image,
je récupère ses coordonnées pour dimensionner une
image temporaire.
Je PaintPicture dans l'image temporaire,
je redimensionne l'image d'origine
je PaintPicture l'image temporaire dans l'image d'origine.
Seulement il y a un loup dans les coordonnées ....



<snip le code>

Hello,

pour que ça marche, juste une ligne à modifier:
Le premier Paintpicture de DisplaySelect() qui devient:

ImageTempo.PaintPicture SupportImage.Image, 0, 0, x2 - x1, y2 - y1, x1,
y1,
x2 - x1, y2 - y1

Et le tour est joué. (Il y a moyen de simplifier tout ça, mais le principe
est ok)

--
Jean-marc
"There are only 10 kind of people
those who understand binary and those who don't."




Avatar
Jean-Marc
"Daniel AUBRY" a écrit dans le message de
news:428ef1ca$0$10465$
Super !!!

je te remercie vivement.

Si tu as des propositions pour simplifier je suis Ok, bien sur.



Essentiellement, la simplification consiste à ne calculer
qu'une seule fois dx et dy dans DisplaySelect(), ça allège
le code et le rend plus aisé à lire mais c'est tout.

Dim dx As Single
Dim dy As Single

dx = x2 - x1
dy = y2 - y1

puis remplacer tous les x2-x1 par dx et idem pour les y.

J'utliserais un controle Shape comme Decoupeur au lieu d'un label car
tu peux plus aisément jouer sur la couleur de bordure, le style de bordure,
etc.

Pour ce qui est de changer le ton de l'intérieur de la sélection,
c'est possible. J'ai fait un truc qui marche mais c'est si lent
que ce n'est pas réellement utilisable :-))

Il y a surement des experts des API graphiques qui peuvent répondre.Je
connais très
peu ces API.

--
Jean-marc
"There are only 10 kind of people
those who understand binary and those who don't."
Avatar
Daniel AUBRY
Merci.

Dany
"Jean-Marc" a écrit dans le message de news:
428f07bb$0$8215$
"Daniel AUBRY" a écrit dans le message de
news:428ef1ca$0$10465$
Super !!!

je te remercie vivement.

Si tu as des propositions pour simplifier je suis Ok, bien sur.



Essentiellement, la simplification consiste à ne calculer
qu'une seule fois dx et dy dans DisplaySelect(), ça allège
le code et le rend plus aisé à lire mais c'est tout.

Dim dx As Single
Dim dy As Single

dx = x2 - x1
dy = y2 - y1

puis remplacer tous les x2-x1 par dx et idem pour les y.

J'utliserais un controle Shape comme Decoupeur au lieu d'un label car
tu peux plus aisément jouer sur la couleur de bordure, le style de
bordure,
etc.

Pour ce qui est de changer le ton de l'intérieur de la sélection,
c'est possible. J'ai fait un truc qui marche mais c'est si lent
que ce n'est pas réellement utilisable :-))

Il y a surement des experts des API graphiques qui peuvent répondre.Je
connais très
peu ces API.

--
Jean-marc
"There are only 10 kind of people
those who understand binary and those who don't."