AGRANDIR OU RÉTRÉCIR UNE IMAGE

Signaler
-
Messages postés
575
Date d'inscription
dimanche 23 décembre 2001
Statut
Membre
Dernière intervention
23 octobre 2012
-
Cette discussion concerne un article du site. Pour la consulter dans son contexte d'origine, cliquez sur le lien ci-dessous.

https://codes-sources.commentcamarche.net/source/567-agrandir-ou-retrecir-une-image

Messages postés
575
Date d'inscription
dimanche 23 décembre 2001
Statut
Membre
Dernière intervention
23 octobre 2012

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 ...
pourrais tu nous en faire part
Il y a beaucoup plus simple et rapide dans le fonctionnement

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 ?