1. Accueil
  2. Visual Basic / VB.NET
  3. Sources Visual Basic / VB.NET
  4. Sources Graphique
  5. Agrandir ou rétrécir une image

Agrandir ou rétrécir une image

0/5 (4 avis)

Vue 18 538 fois - Téléchargée 967 fois

Télécharger le projet
Commenter

Description

Pour ceux qui veulent pas télécharger le Zip ou qui n'ont pas WinZip :(( voici le code commenté...

Crée un nouveau projet avec un form, 2 picturebox (Picture1 & Picture2), un bouton (Command1) & une TextBox (txtRate)...

Source / Exemple : 


Private Sub Command1_Click()
'On vérifie que le taux est valable...
If txtRate = "" Or txtRate = "0" Or Not IsNumeric(txtRate) Then Exit Sub Else MsgBox "Le taux entré est incorrect": Picture2.Cls

'On convertit txtRate en Double pour conserver la virgule
Resize Picture1, Picture2, CDbl(txtRate)
End Sub

'Cette fonction copie le contenu d'une premiere PictureBox
'pixel par pixel et la copie, rétrécie ou agrandie, dans
'une seconde PictureBox...

'Pour agrandir, le taux est inférieur à 1
'Pour rétrécir, le taux est supérieur à 1
'Pour garder la taille, le taux est égal à 1...

Sub Resize(Image1 As PictureBox, Image2 As PictureBox, rate As Double)
Image2.Cls
For Y = 0 To Image1.ScaleHeight Step rate * 10
    For X = 0 To Image1.ScaleWidth Step rate * 10
        c = Image1.Point(X, Y)
        Image2.PSet (X / rate, Y / rate), c
        DoEvents
    Next
    DoEvents
Next
End Sub

Conclusion :


Tu as le mode d'emploi, tu n'as plus qu'à adapter le code à tes besoins...

>>>Djedj
Télécharger le projet

Codes Sources

A voir également

Ajouter un commentaire Commentaires
cs_aKheNathOn Messages postés 575 Date d'inscription dimanche 23 décembre 2001 Statut Membre Dernière intervention 23 octobre 2012
14 juil. 2002 à 00:37
oui , la solution c'est :

Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Integer, ByVal X As _
Integer, ByVal Y As Integer, ByVal nWidth As Integer, ByVal nHeight As _
Integer, ByVal hSrcDC As Integer, ByVal XSrc As Integer, ByVal YSrc As _
Integer, ByVal dwRop As Long) As Integer

Const SRCCOPY = &HCC0020
Public Taux As Double
Public Function capture_ecran() As String
On Error GoTo Trap
Dim Ret As Long
Dim ScreenHDC As Long
' GET SCREEN
ScreenHDC = GetDC(0&)
Shoot.Picture1.Picture = LoadPicture(Empty)
Shoot.Result.Picture = LoadPicture(Empty)
Shoot.Picture1.Height = Screen.Height
Shoot.Picture1.Width = Screen.Width

Ret = BitBlt(Shoot.Picture1.hDC, 0, 0, _
Screen.Width Screen.TwipsPerPixelX, _
Screen.Height Screen.TwipsPerPixelY, _
ScreenHDC, 0, 0, SRCCOPY)
' RESIZE SCREEN
Shoot.Result.Height = Taux * Screen.Height
Shoot.Result.Width = Taux * Screen.Width
Shoot.Result.PaintPicture Shoot.Picture1.Image, 0, 0, Shoot.Result.Width, Shoot.Result.Height, 0, 0, Shoot.Picture1.Width, Shoot.Picture1.Height
' Save Picture
SavePicture Shoot.Result.Image, App.Path & "
esult.bmp"
' Get Buffer Picture
Dim PF As Long
PF = FreeFile()
Open App.Path & "
esult.bmp" For Binary Access Read As #PF
capture_ecran = Space(LOF(PF))
Get #PF, 1, capture_ecran ' Transfert du Fichier dans la Variable
Close #PF ' capture_ecran
' Delete Temps
'Kill App.Path & "
esult.bmp"
Debug.Print "Capture get IT OK !"
Exit Function
Trap:
MsgBox "Erreur : " & vbCrLf & Err.Description, vbCritical + vbOKOnly, "Erreur " & Err.Number
MsgBox "Taux : " & Taux & vbCrLf & "ScreenHDC : " & ScreenHDC & vbCrLf & "Screen Copy :" & SRCCOPY & vbCrLf & "Screen Mode Pixel : " & Screen.TwipsPerPixelX & vbCrLf & "Screen : " & Screen.Width & "x" & Screen.Height, vbInformation + vbOKOnly, "DEBUG ..."
Err.Clear
Exit Function
End Function

Par contre , je suis désolé , mais ce code n'a pas l'air d'être valable sur tous les os , pour capturer l'écran , mais pour changer la taillé la methode est nikel , et casi instantanée avec 800*600 Bits ...
rene
2 août 2001 à 11:39
pourrais tu nous en faire part
David
7 mai 2001 à 17:48
Il y a beaucoup plus simple et rapide dans le fonctionnement
The @rchivist
24 avril 2001 à 16:38
Ton code épatte par la simplicité, mais pour une image de taille en twips de 5000 x 7000 c'est long, très long : une solution ? ou les API ?
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.