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
| unit UHandyGdi;
{ simplification de unité GdipApi.pas par Zutatous}
{ 13/02/2010}
interface
uses
Windows, SysUtils, Graphics;
procedure LoadImgPlus(const Filename:Widestring;AOut:TBitmap);
procedure SaveImgPlus(const Filename:Widestring;AInp:TBitmap;AFormat:string='.bmp');
implementation
type
DebugEventLevel = (
DebugEventLevelFatal,
DebugEventLevelWarning
);
TDebugEventLevel = DebugEventLevel;
DebugEventProc = procedure(level: DebugEventLevel; message: PChar); stdcall;
GdiplusStartupInput = packed record
GdiplusVersion : Cardinal;
DebugEventCallback : DebugEventProc;
SuppressBackgroundThread: BOOL;
SuppressExternalCodecs : BOOL;
end;
TGdiplusStartupInput = GdiplusStartupInput;
PGdiplusStartupInput = ^TGdiplusStartupInput;
GPIMAGE =Pointer;
GPBITMAP =Pointer;
GPGRAPHICS =Pointer;
EncoderParameter = packed record
Guid : TGUID;
NumberOfValues : ULONG;
Type_ : ULONG;
Value : Pointer;
end;
TEncoderParameter = EncoderParameter;
PEncoderParameter = ^TEncoderParameter;
EncoderParameters = packed record
Count : UINT;
Parameter : array[0..0] of TEncoderParameter;
end;
TEncoderParameters = EncoderParameters;
PEncoderParameters = ^TEncoderParameters;
var
StartupInput: TGDIPlusStartupInput;
gdiplusToken: ULONG;
const BmpEncoder :TGuid = '{557CF400-1A04-11D3-9A73-0000F81EF32E}';
const JpegEncoder :TGuid = '{557CF401-1A04-11D3-9A73-0000F81EF32E}';
const GifEncoder :TGuid = '{557CF402-1A04-11D3-9A73-0000F81EF32E}';
const TifEncoder :TGuid = '{557CF405-1A04-11D3-9A73-0000F81EF32E}';
const PngEncoder :TGuid = '{557CF406-1A04-11D3-9A73-0000F81EF32E}';
const QualityParam :TGuid = '{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}';
function GdipCreateBitmapFromFile(filename: PWCHAR;
out bitmap: Pointer): byte;stdcall;external 'Gdiplus.dll' ;
function GdipGetImageWidth(image: GPIMAGE;
var width: UINT): byte; stdcall;external 'Gdiplus.dll' ;
function GdipGetImageHeight(image: GPIMAGE;
var height: UINT): byte; stdcall;external 'Gdiplus.dll' ;
function GdipCreateFromHDC(hdc: HDC;
out graphics: GPGRAPHICS): byte; stdcall;external 'Gdiplus.dll' ;
function GdipDrawImage(graphics: GPGRAPHICS; image: GPIMAGE; x: Single;
y: Single): byte; stdcall;external 'Gdiplus.dll' ;
function GdipDeleteGraphics(graphics: GPGRAPHICS): byte; stdcall;
external 'Gdiplus.dll' ;
function GdipDisposeImage(image: GPIMAGE): byte; stdcall;
external 'Gdiplus.dll' ;
function GdipCreateBitmapFromHBITMAP(hbm: HBITMAP; hpal: HPALETTE;
out bitmap: GPBITMAP): byte; stdcall;external 'Gdiplus.dll' ;
function GdipSaveImageToFile(image: GPIMAGE;
filename: PWCHAR;
clsidEncoder: PGUID;
encoderParams: PEncoderParameters): byte; stdcall; external 'Gdiplus.dll' ;
function GdiplusStartup(out token: ULONG; input: PGdiplusStartupInput;
output: Pointer): Byte; stdcall;external 'Gdiplus.dll' ;
procedure GdiplusShutdown(token: ULONG); stdcall;external 'Gdiplus.dll' ;
procedure LoadImgPlus(const Filename:Widestring;AOut:TBitmap);
var
H,W:cardinal;
Pimg,dc:Pointer;
begin
if not Assigned(AOut) then Exit;
if GdipCreateBitmapFromFile(PWidechar(Filename), Pimg)= 0 then
begin
GdipGetImageHeight(Pimg,H);
GdipGetImageWidth(Pimg,W);
AOut.Height :=H;
AOut.Width :=W;
GdipCreateFromHDC(AOut.Canvas.Handle,dc);
GdipDrawImage(dc,Pimg,0,0);
GdipDeleteGraphics(dc);
GdipDisposeImage(Pimg);
end;
end;
procedure SaveImgPlus(const Filename:Widestring;AInp:TBitmap;AFormat:string);
var
Pimg : Pointer;
SaveFormat : TGuid;
S : Widestring;
W : EncoderParameters;
CompressRate:integer;
begin
if not Assigned(AInp) then Exit;
AFormat :=LowerCase(AFormat);
if AFormat = '.bmp' then
SaveFormat := BmpEncoder
else if AFormat = '.jpg' then
SaveFormat := JpegEncoder
else if AFormat = '.png' then
SaveFormat := PngEncoder
else if AFormat = '.tif' then
SaveFormat := TifEncoder
else if AFormat = '.gif' then
SaveFormat := GifEncoder
else
raise Exception.Create('Format non valide '+AFormat);
S:= ChangeFileExt(Filename,AFormat);
if GdipCreateBitmapFromHBITMAP(AInp.Handle,AInp.Palette,Pimg )= 0 then
begin
if AFormat = '.jpg' then
with W.Parameter[0] do
begin
W.Count :=1;
CompressRate := 80;
Guid := QualityParam;
NumberOfValues := 1;
Type_ :=4;
Value :=@CompressRate;
GdipSaveImageToFile(Pimg,PWideChar(S),@SaveFormat,@W);
end
else GdipSaveImageToFile(Pimg,PWideChar(S),@SaveFormat,nil);
GdipDisposeImage(Pimg);
end;
end;
initialization
StartupInput.DebugEventCallback := nil;
StartupInput.SuppressBackgroundThread := False;
StartupInput.SuppressExternalCodecs := False;
StartupInput.GdiplusVersion := 1;
GdiplusStartup(gdiplusToken, @StartupInput, nil);
finalization
GdiplusShutdown(gdiplusToken);
end. |
