Discussion :

[Paul TOTH]

Bonjour,

Je vous propose une petite unité toute simple qui vous permet de lire dans un TBitmap tous les formats supportés par GDI+

https://github.com/tothpaul/Delphi/t...ter/GDIPBitmap

[Roland Chastain]

Bonjour Paul ! Merci pour le partage.

Je rencontre un problème en essayant de faire une démo. Voici mon code (d'après l'exemple fourni par tes soins) :

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
procedure TForm1.FormCreate(Sender: TObject);
var
  vBitmap: TBitMap;
  vStream: TFileStream;
begin
  vBitmap := TBitMap.create;
  vStream := TFileStream.Create('image.png');
  vBitmap.GDIPLoadFromStream(vStream):
  try
    Canvas.Draw(0, 0, vBitmap);
  finally
    vBitmap.Free;
    vStream.Free;
  end;
end;

[dcc32 Erreur] Unit1.pas(33): E2250 Aucune version surchargée de 'Create' ne peut être appelée avec ces arguments

C'est avec Delphi 10.2.

[Roland Chastain]

Bon, je suppose qu'il fallait lire

Code :

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

  vStream := TFileStream.Create('..\..\image.png', fmOpenRead);

L'exemple complet :

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
procedure TForm1.FormPaint(Sender: TObject);
var
  vBitmap: TBitmap;
  vStream: TFileStream;
begin
  vBitmap := TBitmap.create;
  vStream := TFileStream.Create('..\..\image.png', fmOpenRead);
  vBitmap.GDIPLoadFromStream(vStream);
  try
    Canvas.Draw(10, 10, vBitmap);
  finally
    vBitmap.Free;
    vStream.Free;
  end;
end;

[Roland Chastain]

Pourquoi (c'est vraiment une question) ne pas "cacher" la variable de type TFileStream dans la méthode GDIPLoadFromStream (quitte à changer le nom de la méthode) ?

[Cirec]

Bonjour,

voici un code très sympathique et utile, merci pour ce partage

en testant un peu je me suis rendu compte qu'en chargeant un png on conservait le canal alpha
mais en chargeant un bmp 32bit on perdait le canal alpha !!!

alors bien sûr on peut charger le bitmap directement mais GDIPlus s'en sort très bien avec les bitmap32 et devrait pouvoir gérer cela.

à part cela et le petit oublis signalé par Roland rien à dire à part Bravo et Merci

Cordialement,

@+

[Paul TOTH]

Pourquoi (c'est vraiment une question) ne pas "cacher" la variable de type TFileStream dans la méthode GDIPLoadFromStream (quitte à changer le nom de la méthode) ?

Hello, tu voudrais une méthode LoadFromFile ? mais en fait le Stream est plus générique, tu peux utiliser un TResourceStream, un TCeQueTuVeuxStream

sur un autre forum on me faisait remarquer que Delphi savait déjà lire les PNG et JPG...c'est pas faux mais en fait j'ai fait cette unité pour le format TIF...le fait que le même code supporte les autres format est secondaire

[Cirec]

Hello, tu voudrais une méthode LoadFromFile ? mais en fait le Stream est plus générique, tu peux utiliser un TResourceStream, un TCeQueTuVeuxStream

sur un autre forum on me faisait remarquer que Delphi savait déjà lire les PNG et JPG...c'est pas faux mais en fait j'ai fait cette unité pour le format TIF...le fait que le même code supporte les autres format est secondaire

effectivement vu sous cet angle

je trouvais dommage que l'on ne puisse pas l'utiliser avec un D7 du coup
j'ai fait une petite modif,ajout au code pour le rendre compatible de D7 à Tokyo
mais comme je sais pas si tu es OK avec ça et si ça intéresse quelqu'un j'attends avant de poster

Cordialement,
@+

[Paul TOTH]

effectivement vu sous cet angle

je trouvais dommage que l'on ne puisse pas l'utiliser avec un D7 du coup
j'ai fait une petite modif,ajout au code pour le rendre compatible de D7 à Tokyo
mais comme je sais pas si tu es OK avec ça et si ça intéresse quelqu'un j'attends avant de poster

Cordialement,
@+

il est vrai que j'ai un peu laissé tomber la compatibilité D5,6,7 depuis quelques temps, et ça ne se justifie pas toujours

le plus important ici c'est la partie déclaration GDI+, le record TGpBitmap est là pour faire joli mais n'est en rien nécessaire...quand on class helper, on peut sans problème le remplacer par une simple fonction utilitaire

je viens de publier une version qui fonctionne sous D6...je ne m'explique juste pas une chose, pourquoi GdipDisposeImage réclame un paramètre "var" et non plus "const" ? l'erreur serait-elle dans la version Tokyo ? en tout cas j'avais un plantage sous D6 mais pas sous Tokyo...bizarre.

[Cirec]

chez moi je n'ai que D7 d'installé en ancienne version et il accepte const !?

sinon j'avais opté pour une approche différente qui permet de conserver le code initiale

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
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
unit Execute.GDIPBitmap;
 
{
   GDI+ LoadFromStream helper for TBitmap (c)2017 Execute SARL
   http://www.execute.fr
 
}
 
interface
 
uses
  Windows,
  ActiveX,
  Classes,
  Graphics;
 
type
{$if Compilerversion >= 20.0} // les class helper existent depuis D2009
  TBitmapHelper = class helper for TBitmap
  public
    function GDIPLoadFromFile(const FileName: string): Boolean;
    function GDIPLoadFromStream(Stream: TStream): Boolean; // Loads BMP, JPG, PNG and TIF
  end;
{$else}
  TBitmap = class(Graphics.TBitmap)
  public
    function GDIPLoadFromFile(const FileName: string): Boolean;
    function GDIPLoadFromStream(Stream: TStream): Boolean; // Loads BMP, JPG, PNG and TIF
  end;
{$ifend}
 
implementation
 
const
  GDIP = 'gdiplus.dll';
 
type
  TGdiplusStartupInput = packed record
    GdiplusVersion          : Cardinal;       // Must be 1
    DebugEventCallback      : Pointer;        // Ignored on free builds
    SuppressBackgroundThread: BOOL;           // FALSE unless you're prepared to call
                                              // the hook/unhook functions properly
    SuppressExternalCodecs  : BOOL;           // FALSE unless you want GDI+ only to use
  end;
 
  TStatus = (
    Ok,
    GenericError,
    InvalidParameter,
    OutOfMemory,
    ObjectBusy,
    InsufficientBuffer,
    NotImplemented,
    Win32Error,
    WrongState,
    Aborted,
    FileNotFound,
    ValueOverflow,
    AccessDenied,
    UnknownImageFormat,
    FontFamilyNotFound,
    FontStyleNotFound,
    NotTrueTypeFont,
    UnsupportedGdiPlusVersion,
    GdiplusNotInitialized,
    PropertyNotFound,
    PropertyNotSupported,
    ProfileNotFound
  );
 
  ARGB = Cardinal;
 
{$if Compilerversion >= 20.0}
  TGpBitmap = record
  private
    Handle: Pointer;
  public
    function CreateFromStream(stream: IStream): TStatus; inline;
    function GetHBitmap(var aHandle: HBitmap; Background: ARGB): TStatus; inline;
    function Free: TStatus; inline;
  end;
 
{$else}
 
  TGpBitmap = class
  private
    Handle: Pointer;
  public
    destructor Destroy; override;
    function CreateFromStream(stream: IStream): TStatus;
    function GetHBitmap(var aHandle: HBitmap; Background: ARGB): TStatus;
  end;
{$ifend}
 
 
 
function GdiplusStartup(out token: ULONG; const input: TGdiplusStartupInput; output: Pointer): TStatus; stdcall; external GDIP;
function GdipCreateBitmapFromStream(stream: IStream; out image: Pointer): TStatus; stdcall; external GDIP;
function GdipCreateHBITMAPFromBitmap(const Bitmap: Pointer; var Handle: HBitmap; Background: ARGB): TStatus; stdcall; external GDIP;
function GdipDisposeImage(const Image: Pointer): TStatus; stdcall; external GDIP;
 
 
var
  GdiplusToken: ULONG = 0;
 
function InitGDIPlus: Boolean;
var
  StartupInput: TGdiplusStartupInput;
begin
  if GdiplusToken = 0 then
  begin
    FillChar(StartupInput, SizeOf(StartupInput), 0);
    StartupInput.GdiplusVersion := 1;
    Result := GdiplusStartup(GdiplusToken, StartupInput, nil) = TStatus(Ok);
  end else begin
    Result := True;
  end;
end;
 
{ TGpBitmap }
 
function TGpBitmap.CreateFromStream(stream: IStream): TStatus;
begin
  Result := GdipCreateBitmapFromStream(stream, Handle);
end;
 
function TGpBitmap.GetHBitmap(var aHandle: HBitmap; Background: ARGB): TStatus;
begin
  Result := GdipCreateHBITMAPFromBitmap(Handle, aHandle, Background);
end;
 
{$if Compilerversion >= 20.0}
function TGpBitmap.Free: TStatus;
begin
  Result := GdipDisposeImage(Handle);
end;
 
{$else}
destructor TGpBitmap.Destroy;
begin
  GdipDisposeImage(Handle);
  inherited;
end;
{$ifend}
 
{ TBitmapHelper }
{$if Compilerversion >= 20.0}
function TBitmapHelper.GDIPLoadFromFile(const FileName: string): Boolean;
{$else}
function TBitmap.GDIPLoadFromFile(const FileName: string): Boolean;
{$ifend}
const
  fmOpenRead = 0;
var
  FS: TFileStream;
begin
  FS := TFileStream.Create(FileName, fmOpenRead);
  try
    Result := GDIPLoadFromStream(FS);
  finally
    FS.Free;
  end;
end;
 
{$if Compilerversion >= 20.0}
function TBitmapHelper.GDIPLoadFromStream(Stream: TStream): Boolean;
{$else}
function TBitmap.GDIPLoadFromStream(Stream: TStream): Boolean;
{$ifend}
var
  Bitmap : TGpBitmap;
  HBmp   : HBitmap;
begin
  Result := False;
  if not InitGDIPlus then
    Exit;
{$if Compilerversion < 20.0}
  Bitmap := TGpBitmap.Create;
{$ifend}
  if Bitmap.CreateFromStream(TStreamAdapter.Create(Stream)) = TStatus(Ok) then
  begin
    if Bitmap.GetHBitmap(HBmp, $FFFFFFFF) = TStatus(Ok) then
    begin
      Handle := HBmp;
      Result := True;
    end;
    Bitmap.Free;
  end;
end;
 
end.

ce code fonctionne de D7 à Tokyo ...
mais est ce que ça fonctionne sous D6 ?

pare contre avec "var" ça plante sous D7 il accepte "const" ou rien
tokyo en revanche accepte les 3 sans broncher
d'ailleurs dans l'unité "GdipApi.pas" de progdigy ils l'ont déclaré simplement:
function GdipDisposeImage(image: GPIMAGE): GPSTATUS; stdcall; .

Cordialement,
@+