Discussion :

[TZRman]

Bonjour,

J'ai développé une application en VB6 qui fonctionne sans problème sous Windows XP.
Elle fonctionne également sous Windows 7, à l'exception de l'impression des documents que je réalise à partir d'une copie d'écran de l'interface.
J'utilise donc le presse-papier et mon problème se situe à la récupération de l'image placée dans ce dernier. (en effet lorsque je fais un ctrl+V sous paint, je récupère bien l'image Copier préalablement).

Voici le code:

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
 
Public myPicture1 As StdPicture
[...]
Dim DebutX, DebutY As Single
 
[...]
 
'** Configuration de l'impression
Printer.ColorMode = 2       'en couleur
Printer.ScaleMode = 6       'en millimètres
Printer.Orientation = 1     'En portrait
Printer.PrintQuality = 300  'résolution en dpi
 
[...]
Clipboard.Clear 'vide le presse-papier
Call keybd_event(VK_SNAPSHOT, 1&, 0&, 0&) 'met la fenêtre dans le presse-papier
DoEvents
Set myPicture1 = Clipboard.GetData() 
 
'** Mise en page de la feuille à imprimer
DebutX = (Printer.ScaleWidth - F_FICHETECH_UP.ScaleWidth) / 2 'début sur largeur pour l'impression
DebutY = (Printer.ScaleHeight - F_FICHETECH_UP.ScaleHeight - F_FICHETECH_DOWN.ScaleHeight) / 2 'début sur hauteur pour l'impression
Printer.PaintPicture myPicture1, DebutX, DebutY, Int(F_FICHETECH_UP.ScaleWidth), Int(F_FICHETECH_UP.ScaleHeight)
 
[...]
 
'** Impression
Printer.EndDoc

J'ai également essayé de passer par une picturebox dans laquelle je plaçais l'image temporairement, mais il me renvoie la même erreur ligne 13 - Erreur 481 image incorrecte. En approfondissant un peu, je me rends compte que mypicture1 = 0, ce qui génère une erreur dans Printer.paintpicture.

Ma question est : Quelqu'un a t il une idée pour que mypicture1 ne soit pas égal à 0 ?

[ProgElecT]

Salut

Comment faire pour copier l'écran ou la fenêtre active dans le Presse-papiers à partir de Visual Basic
Suivant la version de Windows, le deuxième paramètre (bScan) de la fonction keybd_event n'est pas le même, pour que cela fonctionne quelque soit cette version de Windows il faut donc appliquer les recommandations prescrites par le support Microsoft

[TZRman]

Suivant la version de Windows, le deuxième paramètre (bScan) de la fonction keybd_event n'est pas le même, pour que cela fonctionne quelque soit cette version de Windows il faut donc appliquer les recommandations prescrites par le support Microsoft

Merci de votreréponse, cependant le lien que vous m'indiquez précise en effet une différence pour les dwMajorVersion > 4, mais :
- Windows XP = 5
- Windows VISTA et SEVEN = 6
Dans mes deux cas d'utilisation je dois utiliser la même méthode.

J'ai vérifier ma syntaxe et re-modifié pour passer par une picturebox comme dans l'exemple, mais cela ne fonctionne toujours pas. Auriez vous une autre idée?

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
 
Public myPicture1 As StdPicture
[...]
Dim DebutX, DebutY As Single
 
[...]
 
'** Configuration de l'impression
Printer.ColorMode = 2       'en couleur
Printer.ScaleMode = 6       'en millimètres
Printer.Orientation = 1     'En portrait
Printer.PrintQuality = 300  'résolution en dpi
 
[...]
Clipboard.Clear 'vide le presse-papier
Call keybd_event(VK_SNAPSHOT, 1&, 0&, 0&) 'met la fenêtre dans le presse-papier
DoEvents
F_FICHETECH_UP.Picture1.Picture = Clipboard.GetData() 
 
'** Mise en page de la feuille à imprimer
DebutX = (Printer.ScaleWidth - F_FICHETECH_UP.ScaleWidth) / 2 'début sur largeur pour l'impression
DebutY = (Printer.ScaleHeight - F_FICHETECH_UP.ScaleHeight - F_FICHETECH_DOWN.ScaleHeight) / 2 'début sur hauteur pour l'impression
Printer.PaintPicture F_FICHETECH_UP.Picture1.Picture, DebutX, DebutY, Int(F_FICHETECH_UP.ScaleWidth), Int(F_FICHETECH_UP.ScaleHeight)
 
[...]
 
'** Impression
Printer.EndDoc

[ProgElecT]

Est ce que l'image est affichée dans le PictureBox ?

Motif de l'édit:
A savoir que:
Pour un PictureBox le ScaleMode est VBTwips par défaut
Pour un StdPicture le ScaleMode est vbHimetric (non modifiable)
Pour une imprimante, a vérifier (Me.Caption = Printer.ScaleMode)
Donc il faut manipuler ces différentes unités d'un objet à l'autre avec la fonction ScaleX() et ScaleY() et/ou en mettant tous les objets dans la même unité.

[TZRman]

Est ce que l'image est affichée dans le PictureBox ?

Non, c'est pour cela que le problème vient du Clipboard.getData, mais je ne vois que très peu de paramètres ou problème pouvant influer sur cette méthode...
J'ai pourtant bien l'image dans le presse papier (je peux la récupérer en faisant un coller dans PAINT.

Motif de l'édit:
A savoir que:
Pour un PictureBox le ScaleMode est VBTwips par défaut
Pour un StdPicture le ScaleMode est vbHimetric (non modifiable)
Pour une imprimante, a vérifier (Me.Caption = Printer.ScaleMode)
Donc il faut manipuler ces différentes unités d'un objet à l'autre avec la fonction ScaleX() et ScaleY() et/ou en mettant tous les objets dans la même unité.

Mes picturebox sont configurées en millimètres.
Printer.scalemode en millimètre (voir ligne 10)
Pour le test que j'ai réalisé en stdpicture, les millimètres et les vbhimetric devaient se mélanger.

[ProgElecT]

Voici le code légèrement modifié de l'exemple du lien que je t'ai proposé dans ma première réponse (3 CommandButtons et un PictureBox)

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
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
Option Explicit
 
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal _
   bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
 
Private Declare Function GetVersionExA Lib "kernel32" _
      (lpVersionInformation As OSVERSIONINFO) As Integer
 
Private Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128
End Type
 
Private Const KEYEVENTF_KEYUP = &H2
Private Const VK_SNAPSHOT = &H2C
Private Const VK_MENU = &H12
 
Dim blnAboveVer4 As Boolean
 
Private Sub Command1_Click()
    If blnAboveVer4 Then
        keybd_event VK_SNAPSHOT, 0, 0, 0
    Else
        keybd_event VK_SNAPSHOT, 1, 0, 0
    End If
End Sub
 
Private Sub Command2_Click()
    If blnAboveVer4 Then
        keybd_event VK_SNAPSHOT, 1, 0, 0
    Else
        keybd_event VK_MENU, 0, 0, 0
        keybd_event VK_SNAPSHOT, 0, 0, 0
        keybd_event VK_SNAPSHOT, 0, KEYEVENTF_KEYUP, 0
        keybd_event VK_MENU, 0, KEYEVENTF_KEYUP, 0
    End If
End Sub
 
Private Sub Command3_Click()
    ' Load the captured image into a PictureBox and print it
    'Picture1.Picture = Clipboard.GetData()
   'Picture1.PaintPicture Clipboard.GetData(), 0, 0
Dim myPicture1 As New StdPicture, Border As Integer, Echel As Single
Set myPicture1 = Clipboard.GetData()
 
Border = Picture1.Width - Picture1.ScaleWidth
Picture1.Cls
Picture1.Height = (ScaleY(myPicture1.Height, vbHimetric, vbPixels) / 1.5) + Border
Echel = 1 '1.25
Picture1.Width = (ScaleX(myPicture1.Width, vbHimetric, vbPixels) / Echel) + Border
Picture1.PaintPicture myPicture1, 0, 0, ScaleX(myPicture1.Width, vbHimetric, vbPixels) / Echel, _
                                        ScaleY(myPicture1.Height, vbHimetric, vbPixels) / Echel, _
                                        0, 0, _
                                        ScaleX(myPicture1.Width, vbHimetric, vbPixels), _
                                        ScaleY(myPicture1.Height, vbHimetric, vbPixels), _
                                        vbSrcCopy
 
 
Dim DifH As Integer, DifW As Integer, OldPrinterScaleMode As Integer, OldPrinterSens As Integer
OldPrinterScaleMode = Printer.ScaleMode
OldPrinterSens = Printer.Orientation
Printer.ScaleMode = vbMillimeters
If myPicture1.Width > myPicture1.Height Then
    Printer.Orientation = vbPRORLandscape
    Else
    Printer.Orientation = vbPRORPortrait
End If
 
DifW = ScaleX(myPicture1.Width, vbHimetric, Printer.ScaleMode) - Printer.ScaleWidth
DifH = ScaleY(myPicture1.Height, vbHimetric, Printer.ScaleMode) - Printer.ScaleHeight
 
    'Printer.PaintPicture Picture1.Picture, 0, 0
    'Printer.EndDoc
Printer.Orientation = OldPrinterSens
Printer.ScaleMode = OldPrinterScaleMode
End Sub
 
Private Sub Form_Load()
Me.AutoRedraw = True
Me.ScaleMode = vbPixels
Picture1.ScaleMode = vbPixels
 
    Dim osinfo As OSVERSIONINFO
    Dim retvalue As Integer
 
    osinfo.dwOSVersionInfoSize = 148
    osinfo.szCSDVersion = Space$(128)
    retvalue = GetVersionExA(osinfo)
    If osinfo.dwMajorVersion > 4 Then blnAboveVer4 = True
 
    'Picture1.Visible = False
    Command1.Caption = "Print Screen"
    Command2.Caption = "Alt+Print Screen"
    Command3.Caption = "Print Image"
End Sub

La partie sortie impression n'est pas encore finit, mais le code permet de voir la capture en cliquand bouton 1 ou 2 puis bouton 3.
Que ce passe t il sur ton ordinateur, moi je suis sous windows integral 64, session administrateur.

[ProgElecT]

Je vais m'absenter, je te met le code du bouton 3, la sortie impression fonctionne correctement sur mon ordinateur.

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
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
Private Sub Command3_Click()
    ' Load the captured image into a PictureBox and print it
    'Picture1.Picture = Clipboard.GetData()
   'Picture1.PaintPicture Clipboard.GetData(), 0, 0
Dim myPicture1 As New StdPicture, Border As Integer, Echel As Single
Set myPicture1 = Clipboard.GetData()
 
Border = Picture1.Width - Picture1.ScaleWidth
Picture1.Cls
Echel = 1 '1.25
Picture1.Height = (ScaleY(myPicture1.Height, vbHimetric, vbPixels) / Echel) + Border
Picture1.Width = (ScaleX(myPicture1.Width, vbHimetric, vbPixels) / Echel) + Border
Me.Width = ScaleX(Picture1.Left + Picture1.Width + Picture1.Left, Me.ScaleMode, vbTwips)
Me.Height = ScaleY(Picture1.Top + Picture1.Height + Picture1.Left + 30, Me.ScaleMode, vbTwips)
 
Picture1.PaintPicture myPicture1, 0, 0, ScaleX(myPicture1.Width, vbHimetric, vbPixels) / Echel, _
                                        ScaleY(myPicture1.Height, vbHimetric, vbPixels) / Echel, _
                                        0, 0, _
                                        ScaleX(myPicture1.Width, vbHimetric, vbPixels), _
                                        ScaleY(myPicture1.Height, vbHimetric, vbPixels), _
                                        vbSrcCopy
 
 
Dim DifH As Integer, DifW As Integer, OldPrinterScaleMode As Integer, OldPrinterSens As Integer
Dim DblMarge As Integer
 
OldPrinterScaleMode = Printer.ScaleMode
OldPrinterSens = Printer.Orientation
Printer.ScaleMode = vbMillimeters
DblMarge = 30 'mm marge haute + marge basse de l'imprimante
If myPicture1.Width > myPicture1.Height Then
    Printer.Orientation = vbPRORLandscape
    Else
    Printer.Orientation = vbPRORPortrait
End If
 
DifW = ScaleX(myPicture1.Width, vbHimetric, Printer.ScaleMode) - Printer.ScaleWidth
DifH = ScaleY(myPicture1.Height, vbHimetric, Printer.ScaleMode) - Printer.ScaleHeight
 
If DifW > DifH Then
    Echel = ScaleX(myPicture1.Width, vbHimetric, Printer.ScaleMode) / (Printer.ScaleWidth + DblMarge)
    Else
    Echel = ScaleY(myPicture1.Height, vbHimetric, Printer.ScaleMode) / (Printer.ScaleHeight + DblMarge)
End If
 
If ScaleX(myPicture1.Width, vbHimetric, Printer.ScaleMode) < (Printer.ScaleWidth + DblMarge) _
    And ScaleY(myPicture1.Height, vbHimetric, Printer.ScaleMode) < (Printer.ScaleHeight + DblMarge) Then
    Echel = 1
End If
 
Printer.PaintPicture myPicture1, 0, 0, ScaleX(myPicture1.Width, vbHimetric, vbPixels) / Echel, _
                                        ScaleY(myPicture1.Height, vbHimetric, vbPixels) / Echel, _
                                        0, 0, _
                                        ScaleX(myPicture1.Width, vbHimetric, vbPixels), _
                                        ScaleY(myPicture1.Height, vbHimetric, vbPixels), _
                                        vbSrcCopy
Printer.EndDoc
Printer.Orientation = OldPrinterSens
Printer.ScaleMode = OldPrinterScaleMode
End Sub

[TZRman]

Merci Beaucoup, ça Fonctionne.
Je regarderais demain plus en détails le code pour voir où cela clochait.

Je vais intégrer cela à mon applis.

Merci encore

[ProgElecT]

Bien
Si tu as un problème pour comprendre le code (non commenté), post dans cette discussion, je tacherai d'expliquer les différentes étapes.

[TZRman]

Bien
Si tu as un problème pour comprendre le code (non commenté), post dans cette discussion, je tacherai d'expliquer les différentes étapes.

Je n'ai pas de problème pour comprendre le code, mais lorsque je l'intègre à mon appli, même erreur.
En cherchant, la seule différence, est que j'utilise mon code dans un module et non pas dans le code de la feuille sur laquelle je travaille...
Ma routine est bien définie comme public, mais GetData dans les lignes:

Code :

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

Set myPicture1 = Clipboard.GetData()

ou

Code :

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

F_FICHETECH_UP.Picture1.Picture = Clipboard.GetData()

Ne renvoie rien s'il est situé dans un module...
Et ce problème n'apparait que lorsque je lance l'appli sous Windows seven...

[ProgElecT]

Salut

Théoriquement, ce qui peut être fait avec un PictureBox est possible sur l'imprimante mise à part les droits d'utilisation de cette imprimante.

Ne renvoie rien s'il est situé dans un module...
Et ce problème n'apparait que lorsque je lance l'appli sous Windows seven...

Cela m'a interloqué, j'ai modifié le bout de projet pour voir, le code du Form1

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
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
Option Explicit
 
Private Sub Command1_Click()
CopieEcran
End Sub
Private Sub Command2_Click()
CopieForm
End Sub
 
Private Sub Command3_Click()
    ' Load the captured image into a PictureBox and print it
    'Picture1.Picture = Clipboard.GetData()
   'Picture1.PaintPicture Clipboard.GetData(), 0, 0
Dim Border As Integer, Echel As Single
'Set myPicture1 = Clipboard.GetData()
DessinImage
Border = Picture1.Width - Picture1.ScaleWidth
Picture1.Cls
Echel = 1 '1.25
Picture1.Height = (ScaleY(myPicture1.Height, vbHimetric, vbPixels) / Echel) + Border
Picture1.Width = (ScaleX(myPicture1.Width, vbHimetric, vbPixels) / Echel) + Border
Me.Width = ScaleX(Picture1.Left + Picture1.Width + Picture1.Left, Me.ScaleMode, vbTwips)
Me.Height = ScaleY(Picture1.Top + Picture1.Height + Picture1.Left + 30, Me.ScaleMode, vbTwips)
 
Picture1.PaintPicture myPicture1, 0, 0, ScaleX(myPicture1.Width, vbHimetric, vbPixels) / Echel, _
                                        ScaleY(myPicture1.Height, vbHimetric, vbPixels) / Echel, _
                                        0, 0, _
                                        ScaleX(myPicture1.Width, vbHimetric, vbPixels), _
                                        ScaleY(myPicture1.Height, vbHimetric, vbPixels), _
                                        vbSrcCopy
 
Exit Sub '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
 
Dim DifH As Integer, DifW As Integer, OldPrinterScaleMode As Integer, OldPrinterSens As Integer
Dim DblMarge As Integer
 
OldPrinterScaleMode = Printer.ScaleMode
OldPrinterSens = Printer.Orientation
Printer.ScaleMode = vbMillimeters
DblMarge = 30 'mm marge haute + marge basse de l'imprimante
If myPicture1.Width > myPicture1.Height Then
    Printer.Orientation = vbPRORLandscape
    Else
    Printer.Orientation = vbPRORPortrait
End If
 
DifW = ScaleX(myPicture1.Width, vbHimetric, Printer.ScaleMode) - Printer.ScaleWidth
DifH = ScaleY(myPicture1.Height, vbHimetric, Printer.ScaleMode) - Printer.ScaleHeight
 
If DifW > DifH Then
    Echel = ScaleX(myPicture1.Width, vbHimetric, Printer.ScaleMode) / (Printer.ScaleWidth + DblMarge)
    Else
    Echel = ScaleY(myPicture1.Height, vbHimetric, Printer.ScaleMode) / (Printer.ScaleHeight + DblMarge)
End If
 
If ScaleX(myPicture1.Width, vbHimetric, Printer.ScaleMode) < (Printer.ScaleWidth + DblMarge) _
    And ScaleY(myPicture1.Height, vbHimetric, Printer.ScaleMode) < (Printer.ScaleHeight + DblMarge) Then
    Echel = 1
End If
 
Printer.PaintPicture myPicture1, 0, 0, ScaleX(myPicture1.Width, vbHimetric, vbPixels) / Echel, _
                                        ScaleY(myPicture1.Height, vbHimetric, vbPixels) / Echel, _
                                        0, 0, _
                                        ScaleX(myPicture1.Width, vbHimetric, vbPixels), _
                                        ScaleY(myPicture1.Height, vbHimetric, vbPixels), _
                                        vbSrcCopy
Printer.EndDoc
Printer.Orientation = OldPrinterSens
Printer.ScaleMode = OldPrinterScaleMode
End Sub
 
Private Sub Form_Load()
Me.AutoRedraw = True
Me.ScaleMode = vbPixels
Picture1.ScaleMode = vbPixels
 
 
    'Picture1.Visible = False
    Command1.Caption = "Print Screen"
    Command2.Caption = "Alt+Print Screen"
    Command3.Caption = "Print Image"
End Sub

le code du module.BAS

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
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
Option Explicit
 
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal _
   bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
 
Private Declare Function GetVersionExA Lib "kernel32" _
      (lpVersionInformation As OSVERSIONINFO) As Integer
 
Private Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128
End Type
 
Private Const KEYEVENTF_KEYUP = &H2
Private Const VK_SNAPSHOT = &H2C
Private Const VK_MENU = &H12
 
Dim blnAboveVer4 As Boolean
 
Public myPicture1 As New StdPicture
Public Sub CopieEcran()
    If blnAboveVer4 Then
        keybd_event VK_SNAPSHOT, 0, 0, 0
    Else
        keybd_event VK_SNAPSHOT, 1, 0, 0
    End If
End Sub
Public Sub CopieForm()
    If blnAboveVer4 Then
        keybd_event VK_SNAPSHOT, 1, 0, 0
    Else
        keybd_event VK_MENU, 0, 0, 0
        keybd_event VK_SNAPSHOT, 0, 0, 0
        keybd_event VK_SNAPSHOT, 0, KEYEVENTF_KEYUP, 0
        keybd_event VK_MENU, 0, KEYEVENTF_KEYUP, 0
    End If
End Sub
Public Sub DessinImage()
Set myPicture1 = Clipboard.GetData()
End Sub
Private Sub Main()
VERSIONINFO
Form1.Show
End Sub
Private Sub VERSIONINFO()
    Dim osinfo As OSVERSIONINFO
    Dim retvalue As Integer
 
    osinfo.dwOSVersionInfoSize = 148
    osinfo.szCSDVersion = Space$(128)
    retvalue = GetVersionExA(osinfo)
    If osinfo.dwMajorVersion > 4 Then blnAboveVer4 = True
End Sub

tout fonctionne
Bon courage pour la suite ........

[TZRman]

Je me sens un peu bête.
J'étais sur le point de m'arracher les cheveux...

Sous Windows XP aucun problème et sous Windows Seven bug...
Et en débogage, tout fonctionne...

Il semble que sous Windows 7, la manipulation nécessite des pauses avant de récupérer de l'information à l'intérieur. J'avais bien remarqué et utilisé les "Doevents" après la copie d'écran, mais cela ne suffisait pas.

J'ai donc ajouté

Code :

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

Application.Wait Now + TimeValue("00:00:01")

Avant la méthode GetData, et là miracle ça fonctionne sous Windows 7.