Discussion :

[KlausGunther]

Je développe une vaste DLL en Delphi 6 Peronal Eidition, avec des centaines de fonctions de support pour un langage externe.

Dans le cadre de ce développement, je rencontre depuis longtemps des problèmes aléatoires (en appparence !) avec le presse-papier. Une même opération peut se dérouler 10, 20, 30 fois sans erreur, puis, subitement, il y a une erreur NON CAPTABLE par TRY..EXCEPT disant que l'accès au presse-papier est impossible.

Récemment, j'ai pu cerner ce problème d'un peu plus près. Dans le cadre d'une fonction complexe conçue pour charger une imabe de n'importe quel format dans le presse-papier, j'ai ce problème à un endroit bien précis que j'ai pu identifier. Voici le priincipe:
- je commence, par sécurité, à "vider" le presse-papier. Cela marche bien.
- selon le format du fichier à charger, je le charge dans un objet Delphi approprié (TBitMap, TPngObject, TPicture etc). Sans problème.
- puis, j'affecte la bitmap de cet objet au presse-papier via la méthode ASSIGN. Sans problème. Je précise ici que j'ai conscience que seul un pointeur est copié à ce moment. La copie physique aura lieu lorsque l'objet d'origine est modifié ou supprimé.
- pour procoquer la copie réelle le modifie un des attributs de l'objet d'origine (HEIGHT pour un objet TBitMap, par exemple). Passe sans problème. Je sais que maintenant, la copie physique est initiée, mais elle aura lieu malheureusement de façon asynchrone.
- je libère l'objet intermédiaire (TBitMap, ...) par la méthode FREE. Sans problème.

Jusque là, on a l'impression que tout se passe bien. Pas d'anomalie de compilation, pas d'erreur en exécution.

Mais ça plante juste après, lorsque le programme appelant ma fonction veut interroger le presse-papier pour connaître les dimentions de la bitmap qu'il contient. A ce moment, il y a souvent un plantage lorsqu'il s'agit d'images de dimensions importantes (photos, ...). Accès refusé au presse-papier. Toute cette séquence pour se passer très bien dix fois ou plus, puis à la n-ième fois, il y a ce plantage.

Or, j'ai réussi à éliminer ce plantage en insérant une attente de 500 ms, juste avant l'interrogation du presse-papier concernant les dimensions qu'il contient.

Visiblement, la copie de la bitmap intermédiaire n'est pas terminée puisqu'à l"évidence, elle se fait de façon asynchrone. Et donc, ma question est: comment peut-on savoir si cette copie est terminée ? Le moment idéal (à mn point de vue) serait juste après avoir changé une des propriétés de l'objet intermédiaire et avant la libération de l'objet intermédiaire par FREE. Je pourrais alors retarder l'emploi de FREE jusqu'à la la fin de la copie physique et il n'y aura plus de problème.

Voici un extrait des étapes décrites ci-dessus, pour un fichier JPG, par exemple:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
var
  BitmapRaw : TBitmap;
  nom: string;
...
    // la variable nom est chargée par le chemin et le nom du fichier contenant l'image
    BitmapRaw := LoadGraphicsFile(nom);   // <======== fonction interne de la DLL trouvée sur le net (voir ci-dessous). Cette fonction marche parfaitement.
    clipboard.Assign(BitmapRaw);     // ici, seul un pointeur est copié
    BitmapRaw.Height := 1;     // ici, je provoque la copie physique
                    // <============ ici, attendre la fin du transfert, ou lancer une procédure call-back lors de la fin ?
    BitmapRaw.Free;      // libération de la ressource
    exit;
...

Les fonctions retournant les dimensions de la bitmap dans le presse-papier (parfaitement opérationnelles):

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
function GetClipboardPictureWidth:integer; stdcall; export;
var
  b:TBitmap;
begin
  result := 0;
  if Clipboard.HasFormat(CF_BITMAP) then begin
    b:=TBitmap.Create;
    try
      b.Assign(Clipboard);
      result := b.Width;
    finally
      b.Free;
    end;
  end;
end;
exports GetClipboardPictureWidth;
 
function GetClipboardPictureHeight:integer; stdcall; export;
var
  b:TBitmap;
begin
  result := 0;
  if Clipboard.HasFormat(CF_BITMAP) then begin
    b:=TBitmap.Create;
    try
      b.Assign(Clipboard);
      result := b.Height;
    finally
      b.Free;
    end;
  end;
end;
exports GetClipboardPictureHeight;

Fonction interne:

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
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
// Create TBitmap from BMP, JPG, WMF, EMF or GIF or TIF disk file.
// Could be easily extended to other image types.
FUNCTION LoadGraphicsFile(CONST Filename: STRING): TBitmap;
  VAR
    Extension: STRING;
{$IFDEF GIF}
    GIFImage : TGIFImage;
{$ENDIF}
    Icon : TIcon;
    JPEGImage: TJPEGImage;
    Metafile : TMetafile;
    pict: TPicture;
    img: TImage;
BEGIN
  RESULT := NIL; // In case anything goes wrong
  try
  IF   FileExists(Filename) THEN BEGIN
    Extension := UpperCase( COPY(Filename, LENGTH(Filename)-2, 3) );
 
    // Quick and dirty check that file type is OK
    ASSERT( (Extension = 'BMP') OR
        (Extension = 'EMF') OR
{$IFDEF GIF}
        (Extension = 'GIF') OR
{$ENDIF}
        (Extension = 'ICO') OR
        (Extension = 'JPG') OR
        (Extension = 'TIF') OR
        (Extension = 'WMF') );
 
    RESULT := TBitmap.Create;
 
    // BMP File -- no additional work to get TBitmap
    IF Extension = 'BMP' THEN BEGIN
      RESULT.LoadFromFile(Filename);
    END;
 
{$IFDEF GIF}
    // GIF File
    IF   Extension = 'GIF'
    THEN BEGIN
      GIFImage := TGIFImage.Create;
      TRY
        GIFImage.LoadFromFile(Filename);
        RESULT.Height := GIFImage.Height;
        RESULT.Width := GIFImage.Width;
        RESULT.PixelFormat := pf24bit;
        RESULT.Canvas.Draw(0,0, GIFImage)
      FINALLY
        GIFImage.Free
      END
    END;
{$ENDIF}
 
    // ICO File
    IF   Extension = 'ICO' THEN BEGIN
      if KGF_debug_mode=3 then begin
//       pict := TPicture.Create;
         img := GetBitmapFromIcon(FileName);
//showmessage('x1: '+inttostr(icon.Width));
         RESULT.Height := img.Height;
         RESULT.Width := img.Width;
         RESULT.PixelFormat := pf24bit;
//showmessage('retour 1');
         RESULT.Canvas.Draw(0,0, img.Picture.bitmap);
//showmessage('retour 2');
      end else begin
        Icon := TIcon.Create;
        TRY
          TRY
            Icon.LoadFromFile(Filename);
//showmessage('x2: '+inttostr(icon.Width));
            if IconTransparentColor<>-1 then RESULT.TransparentColor := TColor(IconTransparentColor);
            RESULT.Height := Icon.Height;
            RESULT.Width := Icon.Width;
            RESULT.PixelFormat := pf24bit; // avoid palette problems
            RESULT.Canvas.Draw(0,0, Icon)
          EXCEPT
            // Ignore problem icons, e.g., Stream read errors
          END;
        FINALLY
          Icon.Free
        END
      end;
    END;
 
    // JPG File
    IF   Extension = 'JPG'
    THEN BEGIN
      JPEGImage := TJPEGImage.Create;
      TRY
        JPEGImage.LoadFromFile(Filename);
        RESULT.Height := JPEGImage.Height;
        RESULT.Width := JPEGImage.Width;
        RESULT.PixelFormat := pf24bit;
        RESULT.Canvas.Draw(0,0, JPEGImage)
      FINALLY
        JPEGImage.Free
      END
    END;
 
    // TIF File
    IF   Extension = 'TIF' THEN BEGIN
      pict := TPicture.Create;
      pict.LoadFromFile(Filename);
      RESULT.Assign(pict);
{      RESULT.Height := pict.graphic.Height;
      RESULT.Width := pict.graphic.Width;
      RESULT.PixelFormat := pf24bit;
      RESULT.Canvas.Draw(0,0, pict.graphic);        }
      pict.free;
    END;
 
    // Windows Metafiles, WMF or EMF
    IF  (Extension = 'WMF') OR
        (Extension = 'EMF')
    THEN BEGIN
      Metafile := TMetafile.Create;
      TRY
        Metafile.LoadFromFile(Filename);
        RESULT.Height := Metafile.Height;
        RESULT.Width := Metafile.Width;
        RESULT.PixelFormat := pf24bit; // avoid palette problems
        RESULT.Canvas.Draw(0,0, Metafile)
      FINALLY
        Metafile.Free
      END
    END;
 
  END;
  finally
  end;
END {LoadGraphicsFile};

[KlausGunther]

Je pense avoir trouvé une solution à mon problème. Elle est certes empirique, mais je ne constate plus de problème d'accès au presse-papier. Cependant, je me demande si je ne tire pas avec des canons sur des moineaux.

Voici ce que j'ai fait:
- j'ai ajouté un TBitMap temporaire, et un boolean, initialement positionné à false.
- à l'endroit stratégique de mon code ci-dessus, je crée la bitmap temporaire
- puis j'insère une boucle while qui tourne tant que mon boolean reste à false
- dans cette boucle, j'introduis un block TRY..EXCEPT..END
- dans la partie TRY, j'assigne le presse-papier à la bitmap temporaire, puis je mets le boolean à true et je supprime la bitmap temporaire et j'attends 10 ms.
Tant que le presse-papier n'est pas disponible, la clause EXCEPT sera activée. Là, je ne fais rien.

Voici ce que ça donne:

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
var
  BitmapRaw : TBitmap;
  img1: TBitMap;         // <=========== ma bitmap temporaire
  ok: boolean;            // <=========== mon boolean
  nom: string;
...
    // la variable nom est chargée par le chemin et le nom du fichier contenant l'image
    BitmapRaw := LoadGraphicsFile(nom);   // <======== fonction interne de la DLL trouvée sur le net (voir ci-dessous). Cette fonction marche parfaitement.
    clipboard.Assign(BitmapRaw);     // ici, seul un pointeur est copié
    BitmapRaw.Height := 1;     // ici, je provoque la copie physique
                    // <============ ici, attendre la fin du transfert, ou lancer une procédure call-back lors de la fin ?
                    // début de l'insertion
    ok := false;
    img1 := TBitmap.Create;
    while not ok do begin
      try
        img1.Assign(ClipBoard);
        ok := true;
        img1.Free;
        delay(100);
      except
      end;
    end;
                    // fin de l'insertion
    BitmapRaw.Free;      // libération de la ressource
    exit;
...

avec la fonction Delay:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
procedure Delay(AMSecs: Cardinal);
var
  iStop : cardinal;
begin
  iStop := GetTickCount + AMsecs;
  while GetTickCount < iStop do
  begin
    Application.ProcessMessages;
    sleep(1);
  end
end;

N'y a-t-il pas une méthode plus sérieuse, plus "Delphi", pour faire cela ?

[Andnotor]

Tu peux inscrire ton app pour qu'elle soit notifiée des modifications apportées au presse-papier.

En fonction de l'OS :

• XP : SetClipboardViewer puis gérer WM_CHANGECBCHAIN et WM_DRAWCLIPBOARD. Ces messages sont synchrones (envoyés par SendMessage).
• Vista+ : AddClipboardFormatListener puis WM_CLIPBOARDUPDATE. Ce message est asynchrone.

Je précise ici que j'ai conscience que seul un pointeur est copié à ce moment. La copie physique aura lieu lorsque l'objet d'origine est modifié ou supprimé.

En es-tu vraiment sûr ?
Si on regarde l'implémentation de TClipboard.Assign, on constate qu'il y a bien une copie immédiate du bitmap.

[Paul TOTH]

- puis, j'affecte la bitmap de cet objet au presse-papier via la méthode ASSIGN. Sans problème. Je précise ici que j'ai conscience que seul un pointeur est copié à ce moment. La copie physique aura lieu lorsque l'objet d'origine est modifié ou supprimé.

d'où vient cette affirmation ?!

[KlausGunther]

Per exemple, en lisant ceci:
http://docs.embarcadero.com/products...ap_Assign.html
Certes, c'est le sens opposé - quelque chose vers un TBitmap. Cette page dit:

Assign copies the bitmap image contained in Source to the bitmap object. If Source is not a bitmap, Assign calls the inherited Assign method, which can copy an image from any class that knows how to copy to a TBitmap object. If the bitmap needs to be changed, the actual bitmap image is copied before the changes are made (copy on write).

Pourquoi ce serait différent dans l'autre sens ? C'est d'ailleurs le même comportement que lors de l'affectation d'une variable string dans une autre - la copie physique a lieu lorsque la variable source est modifiée, pas avant.

D'autre part, c'est ce que je constate, lors de mes tests. Sans cet "ajout", il y a un plantage au bout de quelques appels à la fonction qui charge une bitmap dans le presse-papier, en disant qu'il est impossible d'ouvrir le presse-papier.

Or, j'ai pris soin de vérifier: aucun programme interactif n'est en fonction, j'ai arrêté tout sauf le coeur de Windows, et le problème reste identique. Le seul programme qui pourrait bloquer le presse-papier, c'est justement le mien. Et je n'utilise pas de threads multiples. Donc, normalement, tout doit être "prêt" à la sortie d'une API, si tout était synchrone.

Or, ce n'est pas le cas. A l'évidence, pour clipboard.Assign(BitmapRaw); , l'opération n'est pas terminée lorsque mon code reprend ma main, puisqu'il passe plusieurs fois par la clause EXCEPT avant de réussir.

Ces éléments m'ont fait déduire que seul le pointeur est copié, et la copie physique a lieu lorsque la bitmap d'origine est modifiée ou supprimée. C'est ce que je déclenche par la ligne BitmapRaw.Height := 1; .

Est-ce que je suis complètement à côté de la plaque ? Si oui, alors comment expliquer ce comportement, alors que mon "astuce" résoud le problème ?

[Paul TOTH]

Pourquoi ce serait différent dans l'autre sens ? C'est d'ailleurs le même comportement que lors de l'affectation d'une variable string dans une autre - la copie physique a lieu lorsque la variable source est modifiée, pas avant.

non c'est valable quand on assigne TBitmap à un autre, alors qu'ici c'est entre un TBitmap et le Clipboard

pour les strings c'est encore autre chose car elles contiennent un compteur de référence que ne possède pas TBitmap (c'est un partage de ressource, TBitmapData si mon souvenir est bon)

D'autre part, c'est ce que je constate, lors de mes tests. Sans cet "ajout", il y a un plantage au bout de quelques appels à la fonction qui charge une bitmap dans le presse-papier, en disant qu'il est impossible d'ouvrir le presse-papier.

Or, j'ai pris soin de vérifier: aucun programme interactif n'est en fonction, j'ai arrêté tout sauf le coeur de Windows, et le problème reste identique. Le seul programme qui pourrait bloquer le presse-papier, c'est justement le mien. Et je n'utilise pas de threads multiples. Donc, normalement, tout doit être "prêt" à la sortie d'une API, si tout était synchrone.

Or, ce n'est pas le cas. A l'évidence, pour clipboard.Assign(BitmapRaw); , l'opération n'est pas terminée lorsque mon code reprend ma main, puisqu'il passe plusieurs fois par la clause EXCEPT avant de réussir.

Ces éléments m'ont fait déduire que seul le pointeur est copié, et la copie physique a lieu lorsque la bitmap d'origine est modifiée ou supprimée. C'est ce que je déclenche par la ligne BitmapRaw.Height := 1; .

Est-ce que je suis complètement à côté de la plaque ? Si oui, alors comment expliquer ce comportement, alors que mon "astuce" résoud le problème ?

alors je ne sais pas ce qu'il se passe, mais ce n'est clairement pas un problème de copie asynchrone du bitmap

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
 
procedure TClipboard.Assign(Source: TPersistent);
begin
  if Source is TPicture then
    AssignPicture(TPicture(Source))
  else if Source is TGraphic then
    AssignGraphic(TGraphic(Source)) // c'est ça qui est appelé
  else inherited Assign(Source);
end;
 
procedure TClipboard.AssignGraphic(Source: TGraphic);
var
  Data: THandle;
  Format: Word;
  Palette: HPALETTE;
begin
  Open;
  try
    Adding;
    Palette := 0;
    Source.SaveToClipboardFormat(Format, Data, Palette); // on a une sauvegarde dans Data
    SetClipboardData(Format, Data); // qui est envoyé au Clipboard
    if Palette <> 0 then SetClipboardData(CF_PALETTE, Palette); // et éventuellement la palette
  finally
    Close;
  end;
end;

à ce moment là tu peux même quitter ton application, le presse-papier contiendra toujours le bitmap.

par contre, BitmapRaw.Height := 1 va libérer le bitmap, s'il est très gros, il va libérer de la mémoire, c'est peut-être tout simplement une saturation de la mémoire GDI (sous quel Windows d'ailleurs ?)

[KlausGunther]

sous quel Windows d'ailleurs ?

W10 avec Fall Update + toutes les mises à jour automatiques, 8Go mémoire centrale. Rien d'autre ne tourne, sauf mon programme, l'anti-virus et le pare-feu. J'avais même arrêté Firefox, on ne sait jamais...

Alors, je sèche. Je ne comprends pas. Sans mpn petit ajout, au 3ème, 4ème ou 5ème appel, j'ai ce blocage du presse-papier, quelque soit l'image que je veux traiter. En général, il s'agit de photos qui pèsent entre 3 et 5 Mo. Mais avec mon petit rajout, tout passe bien. Tant mieux, d'ailleurs... pour moi, techniquement, le problème est résolu. Mais j'ai comme une impression d'inachevé parce que je ne comprends pas...