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};