Discussion :

[Asdorve]

Bonjour,

J'affiche une image dans un contrôle Image que j'agrandi au format de la Form.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
 
Form6.pctViewer.Stretch = True
Form6.pctViewer = LoadPicture(Path)

Par contre, l'image est adaptée à la taille du contrôle, ce qui fait que selon la taille d'origine je perds les proportions.
Y-a-t-il une astuce pour afficher l'image et garder les proportions?

Merci

[ProgElecT]

Salut
??
Pourquoi pas un PictureBox avec les propretés
- .AutoSize = True
- .AutoRedraw = True

[Asdorve]

Mais avec AutoSize, je ne pourrais pas avoir l'image en plein écran, si?

[ProgElecT]

Exemple: sur un Form, un CommdButton, un PictureBox (PictCharger) et un CommonDialog1, mise aux dimensions maximum et centrage

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
Option Explicit
 
Private Sub Form_Load()
Me.AutoRedraw = True: Me.ScaleMode = vbPixels: Me.Move 0, 0, Screen.Width, Screen.Height
PictCharger.AutoSize = True: PictCharger.ScaleMode = vbPixels
PictCharger.AutoRedraw = True: PictCharger.Visible = False
Command1.Move 15, 15, 73, 25: Command1.Caption = "Go"
Command1.Move 15, 15, 73, 25: Command1.Caption = "Go"
End Sub
'--------------------------------------------------------------------------------------------
Private Sub Command1_Click()
Dim EchelAff As Single
Dim H As Integer, L As Integer
Dim DecalLeft As Integer, DecalTop As Integer
 
CommonDialog1.ShowOpen
If CommonDialog1.FileName = "" Then Exit Sub
PictCharger.Picture = LoadPicture(CommonDialog1.FileName)
 
'une nouvelle image a ete chargée
If PictCharger.Width > Me.ScaleWidth Or PictCharger.Height > Me.ScaleHeight Then
    'l'image a au moins une dimension PictChargerla résolution du Form
    If PictCharger.Width - Me.ScaleWidth > PictCharger.Height - Me.ScaleHeight Then
        EchelAff = PictCharger.Height / Me.ScaleHeight 'la plus grosse différence est en hauteur
        Else
        EchelAff = PictCharger.Width / Me.ScaleWidth 'la plus grosse différence est en largeur
    End If
    Else
    EchelAff = 1 'l'image n'a aucune dimension dépassant la résolution du Form
 End If
 L = PictCharger.Width / EchelAff
 H = PictCharger.Height / EchelAff
 Me.Picture = LoadPicture("") 'effacement
 DecalLeft = CInt((Me.ScaleWidth - L) / 2): DecalTop = CInt((Me.ScaleHeight - H) / 2)
 Me.PaintPicture PictCharger.Image, DecalLeft, DecalTop, L, H, _
       0, 0, PictCharger.Width, PictCharger.Height, vbSrcCopy
End Sub

Le dessin est fait sur le fond du Form, PictCharger n'est là que comme buffer et si le fichier image en cour de chargement et corrompu,
l'image de la dernière réussite n'est pas perdu

[Asdorve]

Merci beaucoup. C'est sympa et ça fonctionne.

A bientôt,

Xav