forked from synopse/mORMot
-
Notifications
You must be signed in to change notification settings - Fork 0
/
SynGdiPlus.pas
2902 lines (2700 loc) · 103 KB
/
SynGdiPlus.pas
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
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
/// GDI+ library API access
// - adds GIF, TIF, PNG and JPG pictures read/write support as standard TGraphic
// - make available most useful GDI+ drawing methods
// - allows Antialiased rending of any EMF file using GDI+
// - this unit is a part of the freeware Synopse framework,
// licensed under a MPL/GPL/LGPL tri-license; version 1.18
unit SynGdiPlus;
{
This file is part of Synopse framework.
Synopse framework. Copyright (C) 2018 Arnaud Bouchez
Synopse Informatique - https://synopse.info
*** BEGIN LICENSE BLOCK *****
Version: MPL 1.1/GPL 2.0/LGPL 2.1
The contents of this file are subject to the Mozilla Public License Version
1.1 (the "License"); you may not use this file except in compliance with
the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL
Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
for the specific language governing rights and limitations under the License.
The Original Code is Synopse framework.
The Initial Developer of the Original Code is Arnaud Bouchez.
Portions created by the Initial Developer are Copyright (C) 2018
the Initial Developer. All Rights Reserved.
Contributor(s):
- Pierre le Riche
- sllimr7139
Alternatively, the contents of this file may be used under the terms of
either the GNU General Public License Version 2 or later (the "GPL"), or
the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
in which case the provisions of the GPL or the LGPL are applicable instead
of those above. If you wish to allow use of your version of this file only
under the terms of either the GPL or the LGPL, and not to allow others to
use your version of this file under the terms of the MPL, indicate your
decision by deleting the provisions above and replace them with the notice
and other provisions required by the GPL or the LGPL. If you do not delete
the provisions above, a recipient may use your version of this file under
the terms of any one of the MPL, the GPL or the LGPL.
***** END LICENSE BLOCK *****
Version 1.6a
- first public release on https://synopse.info blog
Version 1.6b
- new TGDIPlusFull with most useful GDI+ primitives (ancestor TGDIPLus only
handles pictures)
- TGDIPlusFull loads dynamicaly the latest GDI+ version available on the system,
i.e. the 1.1 version bundled with Office 2003/2007 (all the other pascal
GDI+ units use static linking, therefore only link to the OS version, even
if a newer one if available within the Office folder)
- draw an EMF created from GDI commands into a GDI+ Antialiased canvas
(this unit can work without the GDI+ library, e.g. under Windows 98 or 2000,
but won't use new pictures format nor antialiasing)
Version 1.8
- small modifications to better handling Jpeg saving
Version 1.9
- small enhancements for framework Main Demo release (RectNotBiggerThan and
MaxPixelsForBiggestSide parameter in SaveAs function e.g.)
Version 1.10
- code modifications to compile with Delphi 6 compiler
Version 1.12
- added code for error handling, via new TGdipStatus enumeration type
- now GDI+ handles are stored using THandle instead of plain integer type
(in order to prepare a 64 bit version of the unit)
- fixed a problem in rendering bitmaps, e.g. as created in SQLite3Pages
- fixed a problem in rendering underlined text (GDI+ DrawDriverString doesn't
handle underlined or stroken out fonts as expected)
Version 1.13
- code modifications to compile with Delphi 5 compiler
- handle TCanvas.DrawCurve() method in TMetaFile enumeration
- suppress GDI+ library back thread which may hang up application when using
this unit in a DLL - manual hook and unhook is done at statup/shutdown
see http://mikevdm.com/BlogEntry/Key/GdiplusShutdown-Hangs-Mysteriously
Version 1.15
- unit now tested with Delphi XE2 (32 Bit)
- handle TIFF saving with diverse compression methods
Version 1.16
- made the TMetaFile rendering engine stronger to malformed EMF content
(e.g. when a EMR_SELECTOBJECT item refers to an out-of-range object)
- fixed TLockModeOption definition by adding a TLockModeOptions set - see
ticket b5a31dd269
Version 1.17
- new TGDIPlusFull.ForceUseDrawString property for properly handling
font fall-back if needed when drawing text (disabled by default), and
corresponding parameter in DrawEmfGdip() function
- added BitmapSetResolution optional parameter for SaveAs() functions
to specify the destination image DPI
Version 1.18
- ensure all created TBitmap are DIB (device-independent bitmap)
- added TSynPicture.CreateFromFile() constructor
- fixed ticket [ebbce6be8b] about Win64 initialization
- fixed ticket [84dae0a2da] about EMR_BITBLT, thanks to Pierre le Riche
- implemented clipping - ticket [ba90f15370] - thanks to Pierre le Riche
- TGDIPlusEnum.DrawText() now handles ETO_GLYPH_INDEX option
- fixed ticket [125fc8d280] about random crash in TSynPicture.LoadFromStream
- implemented multi-page support for TTiffImage - thanks sllimr7139 for
the patch!
- FPC / Lazarus compatibility - thanks Alf for the patch
}
{$I Synopse.inc} // define HASINLINE USETYPEINFO CPU32 CPU64 OWNNORMTOUPPER
interface
uses
{$ifdef MSWINDOWS}
Windows,
CommCtrl,
Messages,
{$endif}
{$ifdef FPC}
LCLType,
LCLIntf,
LResources,
SynFPCMetaFile,
{$endif}
Classes,
SysUtils,
{$ifdef ISDELPHIXE2}
VCL.Graphics,
{$else}
Graphics,
{$endif}
ActiveX;
{.$define USEENCODERS}
{ if defined, the GDI+ encoder list will be used - seems not necessary }
{.$define USEDPI}
{ if defined, the DrawAt() method is available, which respect dpi on drawing
- should not be useful on most applications }
{$define NOTSYNPICTUREREGISTER}
{ if NOT defined, the TSynPicture type is registered to handle PNG JPG TIF in TGraphic }
{$MINENUMSIZE 4}
type
{$ifdef DELPHI5OROLDER}
// Delphi 5 doesn't have those base types defined :(
PPointer = ^Pointer;
PPChar = ^PChar;
IntegerArray = array[0..$effffff] of Integer;
PIntegerArray = ^IntegerArray;
{$endif}
/// GDI+ line drawing smoothing types
TSmoothingMode = (
smDefault, smHighSpeed, smHighQuality, smNone, smAntiAlias);
/// GDI+ text rendering smoothing types
TTextRenderingHint = (
trhDefault, trhSingleBitPerPixelGridFit, trhSingleBitPerPixel,
trhAntiAliasGridFit, trhAntiAlias, trhClearTypeGridFit);
/// GDI+ available coordinates units
TUnit = (
uWorld, uDisplay, uPixel, uPoint, uInch, uDocument, uMillimeter, uGdi);
/// GDI+ types of conversion from EMF to EMF+
TEmfType = (
etEmf0, etEmf1, etEmf2, { for Delphi 5: no etEmfOnly=3 syntax }
etEmfOnly, etEmfPlusOnly, etEmfPlusDual);
/// GDI+ available filling modes
TFillMode = (
fmAlternate, fmWinding);
/// GDI+ lock mode for GdipFull.BitmapLockBits
TLockModeOption = (
lmRead, lmWrite, lmUserInputBuf);
/// GDI+ lock mode settings for GdipFull.BitmapLockBits
TLockModeOptions = set of TLockModeOption;
/// GDI+ error codes
TGdipStatus = (
stOk,
stGenericError,
stInvalidParameter,
stOutOfMemory,
stObjectBusy,
stInsufficientBuffer,
stNotImplemented,
stWin32Error,
stWrongState,
stAborted,
stFileNotFound,
stValueOverflow,
stAccessDenied,
stUnknownImageFormat,
stFontFamilyNotFound,
stFontStyleNotFound,
stNotTrueTypeFont,
stUnsupportedGdiplusVersion,
stGdiplusNotInitialized,
stPropertyNotFound,
stPropertyNotSupported);
PGdipRect = ^TGdipRect;
/// GDI+ integer coordinates rectangles
// - use width and height instead of right and bottom
TGdipRect = record
X, Y, Width, Height: Integer;
end;
PGdipRectF = ^TGdipRectF;
/// GDI+ floating point coordinates rectangles
// - use width and height instead of right and bottom
TGdipRectF = record
X, Y, Width, Height: Single;
end;
PGdipPointF = ^TGdipPointF;
/// GDI+ floating point coordinates for a point
TGdipPointF = record
X,Y: Single;
end;
PGdipPointFArray = ^TGdipPointFArray;
/// GDI+ floating point coordinates for an array of points
TGdipPointFArray = array[0..1000] of TGdipPointF;
/// data as retrieved by GdipFull.BitmapLockBits
TGdipBitmapData = record
Width: Cardinal;
Height: Cardinal;
Stride: Integer;
PixelFormat: Integer;
Scan0: Pointer;
Reserved: Cardinal;
end;
PGdipBitmapData = ^TGdipBitmapData;
type
/// an object wrapper to load dynamically a library
TSynLibrary = class
protected
fHandle: HMODULE;
/// helper to load all needed procedure entries from a dynamic library
// - return the HMODULE on success, i.e. if all procedure Names were found
// - procedure definitions must be defined in inherited, and pointer-aligned,
// i.e. the object must be bounded by {$A-} {$A+} compiler directives
class function Load(const aDllFileName: TFileName; Addr: PPointer;
Names: PPChar): HMODULE;
/// unload the library
procedure UnLoad;
public
/// return TRUE if the library and all procedures were found
function Exists: boolean;
end;
TGDIPlusHookProc = function(out token: THandle): Integer; stdcall;
TGDIPlusUnhookProc = procedure(token: THandle); stdcall;
{$A-} { all stdcall pointers in protected section below must be pointer-aligned }
/// handle picture related GDI+ library calls
TGDIPlus = class(TSynLibrary)
protected
Startup: function(var Token: THandle; var Input, Output): TGdipStatus; stdcall;
Shutdown: procedure(Token: THandle); stdcall;
DeleteGraphics: function(graphics: THandle): TGdipStatus; stdcall;
CreateFromHDC: function(hdc: HDC; out Graphics: THandle): TGdipStatus; stdcall;
LoadImageFromStream: function(stream: IStream; out image: THandle): TGdipStatus; stdcall;
LoadImageFromFile: function(filename: PWideChar; out image: THandle): TGdipStatus; stdcall;
DrawImageRect: function(graphics, image: THandle; x,y,width,height: integer): TGdipStatus; stdcall;
DrawImageRectRect: function(graphics, image: THandle; xd,yd,wd,hd, xs,ys,ws,hs: integer;
u: TUnit=uPixel; imageAttributes: integer=0; callback: Pointer=nil;
calldata: Pointer=nil): TGdipStatus; stdcall;
{$ifdef USEDPI}
DrawImage: function(graphics, image: THandle; x,y: integer): TGdipStatus; stdcall;
{$endif}
DisposeImage: function(image: THandle): TGdipStatus; stdcall;
GetImageRawFormat: function(image: THandle; var format: TGUID): TGdipStatus; stdcall;
GetImageWidth: function(image: THandle; var width: cardinal): TGdipStatus; stdcall;
GetImageHeight: function(image: THandle; var height: cardinal): TGdipStatus; stdcall;
SaveImageToStream: function(image: THandle; stream: IStream;
clsidEncoder: PGUID; encoderParams: pointer): TGdipStatus; stdcall;
{$ifdef USEENCODERS}
GetImageEncodersSize: function(out numEncoders: cardinal;
out size: cardinal): TGdipStatus; stdcall;
GetImageEncoders: function(numEncoders, size: cardinal;
encoders: pointer): TGdipStatus; stdcall;
{$endif}
CreateBitmapFromHBITMAP: function(hbm: HBITMAP; hpal: HPALETTE;
out bitmap: THandle): TGdipStatus; stdcall;
CreateBitmapFromGdiDib: function(bmi, bits: pointer; out bitmap: THandle): TGdipStatus; stdcall;
BitmapSetResolution: function(bitmap: THandle; XDPI,YDPI: single): TGdipStatus; stdcall;
GetFrameCount: function(image: THandle; dimensionID: PGUID; var count: UINT): TGdipStatus; stdcall;
SelectActiveFrame: function(image: THandle; dimensionID: PGUID; frameIndex: UINT): TGdipStatus; stdcall;
protected
fToken: THandle;
fStartupHook: record
Hook: TGDIPlusHookProc;
Unhook: TGDIPlusUnhookProc;
end;
fStartupHookToken: THandle;
{$ifdef USEENCODERS}
function GetEncoderClsid(format: PAnsiChar; out pClsid: TGUID): integer;
{$endif}
public
/// load the GDI+ library and all needed procedures
// - returns TRUE on success
// - library is loaded dynamically, therefore the executable is able
// to launch before Windows XP, but GDI + functions (e.g. GIF, PNG, TIFF
// and JPG pictures support) won't be available in such case
constructor Create(const aDllFileName: TFileName); reintroduce;
// Registers the .jpg .jpeg .gif .png .tif .tiff file extensions to the program
// - TPicture can now load such files
// - you can just launch Gdip.RegisterPictures to initialize the GDI+ library
procedure RegisterPictures;
/// draw the corresponding EMF metafile into a given device context
// - this default implementation uses GDI drawing only
// - use TGDIPlusFull overridden method for true GDI+ AntiAliaised drawing
procedure DrawAntiAliased(Source: TMetafile; Dest: HDC; R: TRect;
aSmoothing: TSmoothingMode=smAntiAlias;
aTextRendering: TTextRenderingHint=trhClearTypeGridFit); overload; virtual;
/// draw the corresponding EMF metafile into a bitmap created by the method
// - this default TGDIPlus implementation uses GDI drawing only
// - use a TGDIPlusFull instance for true GDI+ AntiAliaised drawing
// - you can specify a zoom factor by the ScaleX and ScaleY parameters in
// percent: e.g. 100 means 100%, i.e. no scaling
// - returned image is a DIB (device-independent bitmap)
function DrawAntiAliased(Source: TMetafile; ScaleX: integer=100; ScaleY: integer=100;
aSmoothing: TSmoothingMode=smAntiAlias;
aTextRendering: TTextRenderingHint=trhClearTypeGridFit): TBitmap; overload;
/// unload the GDI+ library
destructor Destroy; override;
end;
{$A+}
/// allowed types for image saving
TGDIPPictureType = ( gptGIF, gptPNG, gptJPG, gptBMP, gptTIF );
/// the optional TIFF compression levels
// - use e.g. ord(evCompressionCCITT4) to save a TIFF picture as CCITT4
TGDIPPEncoderValue = (
evColorTypeCMYK,
evColorTypeYCCK,
evCompressionLZW,
evCompressionCCITT3,
evCompressionCCITT4,
evCompressionRle,
evCompressionNone,
evScanMethodInterlaced,
evScanMethodNonInterlaced,
evVersionGif87,
evVersionGif89,
evRenderProgressive,
evRenderNonProgressive,
evTransformRotate90,
evTransformRotate180,
evTransformRotate270,
evTransformFlipHorizontal,
evTransformFlipVertical,
evMultiFrame,
evLastFrame,
evFlush,
evFrameDimensionTime,
evFrameDimensionResolution,
evFrameDimensionPage);
/// GIF, PNG, TIFF and JPG pictures support using GDI+ library
// - cf @http://msdn.microsoft.com/en-us/library/ms536393
// for available image formats
TSynPicture = class(TGraphic)
protected
fHasContent: boolean;
fHeight,
fWidth: cardinal;
fImage: THandle;
fStream: IStream;
fGlobal: THandle;
fGlobalLen: integer;
fAssignedFromBitmap: boolean;
function GetEmpty: Boolean; override;
function GetHeight: Integer; override;
function GetWidth: Integer; override;
procedure SetHeight(Value: Integer); override;
procedure SetWidth(Value: Integer); override;
{$ifndef FPC}
procedure Clear;
{$endif}
procedure fImageSet;
procedure BitmapSetResolution(DPI: single);
{$ifdef FPC}
function GetTransparent: Boolean; override;
procedure SetTransparent(Value: Boolean); override;
{$endif}
function SaveAsIStream(out Stream: IStream; Format: TGDIPPictureType;
CompressionQuality: integer=80; IfBitmapSetResolution: single=0): TGdipStatus;
public
constructor CreateFromFile(const FileName: string);
constructor CreateFromBuffer(Buffer: pointer; Len: integer);
destructor Destroy; override;
{$ifdef FPC}
procedure Clear; override;
{$endif}
procedure Assign(Source: TPersistent); override;
procedure Draw(ACanvas: TCanvas; const Rect: TRect); override;
{$ifdef USEDPI}
/// since method use dpi -> can drop content if drawing with different dpi
procedure DrawAt(ACanvas: TCanvas; X,Y: integer);
{$endif}
function LoadFromIStream(Stream: IStream): TGdipStatus;
procedure LoadFromStream(Stream: TStream); override;
procedure LoadFromFile(const FileName: string); override;
procedure LoadFromBuffer(Buffer: pointer; Len: integer);
procedure SaveToStream(Stream: TStream); override;
procedure SaveInternalToStream(Stream: TStream);
procedure LoadFromResourceName(Instance: THandle; const ResName: string);{$ifdef FPC} override;{$endif}
{$ifdef FPC}
procedure LoadFromClipboardFormat(FormatID: TClipboardFormat); override;
procedure SaveToClipboardFormat(FormatID: TClipboardFormat); override;
{$else}
procedure LoadFromClipboardFormat(AFormat: Word; AData: THandle;
APalette: HPALETTE); override;
procedure SaveToClipboardFormat(var AFormat: Word; var AData: THandle;
var APalette: HPALETTE); override;
{$endif}
/// save the picture into any GIF/PNG/JPG/TIFF format
// - CompressionQuality is used for gptJPG format saving
// and is expected to be from 0 to 100; for gptTIF format, use
// ord(TGDIPPEncoderValue) to define the parameter; by default, will use
// ord(evCompressionLZW) to save the TIFF picture with LZW - for gptTIF,
// only valid values are ord(evCompressionLZW), ord(evCompressionCCITT3),
// ord(evCompressionCCITT4), ord(evCompressionRle) and ord(evCompressionNone)
function SaveAs(Stream: TStream; Format: TGDIPPictureType;
CompressionQuality: integer=80; IfBitmapSetResolution: single=0): TGdipStatus;
/// create a bitmap from the corresponding picture
// - kind of returned image is DIB (device-independent bitmap)
function ToBitmap: TBitmap;
/// guess the picture type from its internal format
// - return gptBMP if no format is found
function GetImageFormat: TGDIPPictureType;
/// return TRUE if the supplied filename is a picture handled by
// TSynPicture
class function IsPicture(const FileName: TFileName): TGraphicClass;
/// calculate a TRect which fit the specified maximum pixel number
// - if any side of the picture is bigger than the specified pixel number,
// the TRect is sized down in order than the biggest size if this value
function RectNotBiggerThan(MaxPixelsForBiggestSide: Integer): TRect;
/// return the GDI+ native image handle
property NativeImage: THandle read fImage;
end;
/// sub class to handle .PNG file extension
TPngImage = class(TSynPicture)
end;
/// sub class to handle .JPG file extension
TJpegImage = class(TSynPicture)
protected
fCompressionQuality: integer;
public
constructor Create; override;
/// implements the saving feature
procedure SaveToStream(Stream: TStream); override;
/// the associated encoding quality (from 0 to 100)
// - set to 80 by default
property CompressionQuality: integer read fCompressionQuality write fCompressionQuality;
end;
/// sub class to handle .GIF file extension
TGifImage = class(TSynPicture)
end;
/// sub class to handle .TIF file extension
// - GDI+ seems not able to load all Tiff file formats, depending on the
// Windows version and third-party libraries installed
// - this overridden class implements multiple pages
TTiffImage = class(TSynPicture)
protected
fActivePage: integer;
procedure SelectPage(index: integer);
public
/// extract a page from the TIFF and assign it to a bitmap
procedure ExtractPage(index: integer; wBMP: TBitmap);
/// retrieve the number of pages in the TIFF file
function GetPageCount:integer;
/// multi-page
// - default Frame/Page Index is 0
property ActivePageIndex: integer read fActivePage write SelectPage;
end;
// Region combine mode (used by SetClipRegion, etc.)
TGDIPCombineMode = (cmReplace, cmIntersect, cmUnion, cmXor, cmExclude, cmComplement);
{$A-}
/// handle most GDI+ library calls
// - an instance of this object is initialized by this unit: you don't have
// to create a new instance
TGDIPlusFull = class(TGDIPlus)
protected
DrawLine: function(graphics, pen: THandle; x1,y1,x2,y2: integer): TGdipStatus; stdcall;
CreatePen: function(color: Cardinal; width: Single; units: TUnit; out pen: THandle): TGdipStatus; stdcall;
DeletePen: function(pen: THandle): TGdipStatus; stdcall;
Flush: function(graphics: THandle; intention: Integer=0): TGdipStatus; stdcall;
SetSmoothingMode: function(graphics: THandle; mode: TSmoothingMode): TGdipStatus; stdcall;
SetTextRenderingHint: function(graphics: THandle; mode: TTextRenderingHint): TGdipStatus; stdcall;
SetPenBrushFill: function(Pen, Brush: THandle): TGdipStatus; stdcall;
SetPenColor: function(Pen: THandle; Color: Cardinal): TGdipStatus; stdcall;
SetPenWidth: function(Pen: THandle; Width: Single): TGdipStatus; stdcall;
DeleteBrush: function(brush: THandle): TGdipStatus; stdcall;
CreateSolidFill: function(color: Cardinal; var brush: THandle): TGdipStatus; stdcall;
FillRectangle: function(graphics, brush: THandle; x, y, width, height: Integer): TGdipStatus; stdcall;
FillEllipse: function(graphics, brush: THandle; x, y, width, height: Integer): TGdipStatus; stdcall;
DrawEllipse: function(graphics, pen: THandle; x, y, width, height: Integer): TGdipStatus; stdcall;
DrawCurve: function(graphics, pen: THandle; Points: Pointer; Count: Integer): TGdipStatus; stdcall;
GraphicsClear: function(Graphics: THandle; Color: Cardinal): TGdipStatus; stdcall;
SetPageUnit: function(Graphics: THandle; units: TUnit): TGdipStatus; stdcall;
DrawRectangle: function(Graphics, Pen: THandle; X, Y, Width, Height: Integer): TGdipStatus; stdcall;
SetPenDashStyle: function(Pen: THandle; dashStyle: Integer): TGdipStatus; stdcall;
DrawPolygon: function(graphics, pen: THandle; points: pointer; count: integer): TGdipStatus; stdcall;
FillPolygon: function(graphics, brush: THandle; points: pointer; count: Integer; fillMode: TFillMode): TGdipStatus; stdcall;
SetWorldTransform: function(graphics, matrix: THandle): TGdipStatus; stdcall;
GetWorldTransform: function(graphics, matrix: THandle): TGdipStatus; stdcall;
CreateMatrix: function(out matrix: THandle): TGdipStatus; stdcall;
CreateMatrix2: function(m11,m12,m21,m22,dx,dy: Single; out matrix: THandle): TGdipStatus; stdcall;
DeleteMatrix: function(matrix: THandle): TGdipStatus; stdcall;
SetMatrixElements: function(matrix: THandle; m11,m12,m21,m22,dx,dy: Single): TGdipStatus; stdcall;
MultiplyMatrix: function(matrix, matrix2: THandle; order: Integer=0): TGdipStatus; stdcall;
ScaleMatrix: function(matrix: THandle; scaleX, scaleY: Single; order: integer=0): TGdipStatus; stdcall;
TranslateMatrix: function(matrix: THandle; offsetX, offsetY: Single; order: integer=0): TGdipStatus; stdcall;
DrawLines: function(Graphics, Pen: THandle; Points: Pointer; Count: Integer): TGdipStatus; stdcall;
RecordMetafile: function (DC: HDC; emfType: TEmfType; frameRect: PGdipRect;
frameUnit: TUnit; description: PWideChar; var out_metafile: THandle): TGdipStatus; stdcall;
RecordMetafileStream: function (strm: IStream; DC: HDC; emfType: TEmfType; const frameRect: TGdipRect;
frameUnit: TUnit; description: PWideChar; var out_metafile: THandle): TGdipStatus; stdcall;
PlayRecord: function(metafile: THandle; RecType, flags, RecSize: cardinal; Rec: Pointer): TGdipStatus; stdcall;
EnumerateMetaFile: function(graphics, metafile: THandle; Dest: PGdipRect;
callback, data: pointer; imageAttributes: integer=0): TGdipStatus; stdcall;
ResetWorldTransform: function(graphics: THandle): TGdipStatus; stdcall;
RotateTransform: function(graphics: THandle; angle: Single; order: Integer=0): TGdipStatus; stdcall;
TranslateTransform: function(graphics: THandle; dx,dy: Single; order: integer=0): TGdipStatus; stdcall;
CreateFromImage: function(image: THandle; out graphics: THandle): TGdipStatus; stdcall;
CreateFontFrom: function(aHDC: HDC; out font: THandle): TGdipStatus; stdcall;
DeleteFont: function(font: THandle): TGdipStatus; stdcall;
CreateFontFromLogfont: function(hdc: HDC; logfont: PLOGFONTW; out font: THandle): TGdipStatus; stdcall;
DrawString: function(graphics: THandle; text: PWideChar; length: integer; font: THandle;
Dest: PGdipRectF; format, brush: THandle): TGdipStatus; stdcall;
MeasureString: function(graphics: THandle; text: PWideChar; length: integer; font: THandle;
Dest: PGdipRectF; format: THandle; bound: PGdipRectF;
codepointsFitted, linesFilled: PInteger): TGdipStatus; stdcall;
DrawDriverString: function(graphics: THandle; text: PWideChar;
length: integer; font, brush: THandle; positions: PGdipPointFArray; flag: integer; matrix: THandle): TGdipStatus; stdcall;
CreatePath: function(brushmode: TFillMode; var path: THandle): TGdipStatus; stdcall;
DeletePath: function(path: THandle): TGdipStatus; stdcall;
DrawPath: function(graphics, pen, path: THandle): TGdipStatus; stdcall;
FillPath: function(graphics, brush, path: THandle): TGdipStatus; stdcall;
AddPathLine: function(path: THandle; X1,Y1,X2,Y2: integer): TGdipStatus; stdcall;
AddPathLines: function(path: THandle; Points: pointer; Count: integer): TGdipStatus; stdcall;
AddPathArc: function(path: THandle; X,Y,width,height: Integer; StartAndle, SweepAngle: single): TGdipStatus; stdcall;
AddPathCurve: function(path: THandle; Points: pointer; Count: integer): TGdipStatus; stdcall;
AddPathClosedCurve: function(): TGdipStatus; stdcall;
AddPathEllipse: function(path: THandle; X,Y,width,height: Integer): TGdipStatus; stdcall;
AddPathPolygon: function(path: THandle; Points: pointer; Count: integer): TGdipStatus; stdcall;
AddPathRectangle: function(path: THandle; X,Y,width,height: Integer): TGdipStatus; stdcall;
ClosePath: function(path: THandle): TGdipStatus; stdcall;
DrawArc: function(graphics, pen: THandle; X,Y,width,height: Integer; StartAndle, SweepAngle: single): TGdipStatus; stdcall;
DrawBezier: function(graphics, pen: THandle; X1,Y1,X2,Y2,X3,Y3,X4,Y4: Integer): TGdipStatus; stdcall;
DrawPie: function(graphics, pen: THandle; X,Y,width,height: Integer; StartAndle, SweepAngle: single): TGdipStatus; stdcall;
CreateBitmapFromScan0: function(width, height, stride, format: integer; scan0: PByte;
out bitmap: THandle): TGdipStatus; stdcall;
BitmapLockBits: function(Bitmap: THandle; const Rect: PGdipRect;
Flags: TLockModeOptions; Format: integer; out LockedBitmapData: TGdipBitmapData): TGdipStatus; stdcall;
BitmapUnlockBits: function(Bitmap: THandle; const LockedBitmapData: TGdipBitmapData): TGdipStatus; stdcall;
GetClip: function (graphics: THandle; Region: THandle): TGdipStatus; stdcall;
SetClipRegion: function(graphics: THandle; region: THandle; CombineMode: TGDIPCombineMode): TGdipStatus; stdcall;
SetClipRectI: function(graphics: THandle; X,Y,width,height: Integer; CombineMode: TGDIPCombineMode): TGdipStatus; stdcall;
ResetClip: function(graphics: THandle): TGdipStatus; stdcall;
CreateRegion: function(out Region: THandle): TGdipStatus; stdcall;
DeleteRegion: function(Region: THandle): TGdipStatus; stdcall;
protected
/// this function is available only with GDI+ version 1.1
fConvertToEmfPlus: function(graphics, image: THandle; var flag: BOOL;
emftype: TEmfType; description: PWideChar; var out_metafile: integer): TGdipStatus; stdcall;
fConvertToEmfPlusTested: Boolean;
fForceInternalConvertToEmfPlus: boolean;
fUseDrawString: boolean;
function getNativeConvertToEmfPlus: boolean;
public
/// load the GDI+ library and all needed procedures
// - returns TRUE on success
// - library is loaded dynamically, therefore the executable is able
// to launch before Windows XP, but GDI + functions (e.g. GIF, PNG, TIFF
// and JPG pictures support or AntiAliased drawing) won't be available
// - if no GdiPlus.dll file name is available, it will search the system
// for the most recent version of GDI+ (either GDIPLUS.DLL in the current
// directory, either the Office 2003 version, either the OS version - 1.1 is
// available only since Vista and Seven; XP only shipped with version 1.1)
constructor Create(aDllFileName: TFileName='');
/// draw the corresponding EMF metafile into a given device context
// - this overridden implementation handles GDI+ AntiAliased drawing
// - if GDI+ is not available, it will use default GDI32 function
procedure DrawAntiAliased(Source: TMetafile; Dest: HDC; R: TRect;
aSmoothing: TSmoothingMode=smAntiAlias;
aTextRendering: TTextRenderingHint=trhClearTypeGridFit); override;
/// convert a supplied EMF metafile into a EMF+ (i.e. GDI+ metafile)
// - i.e. allows antialiased drawing of the EMF metafile
// - if GDI+ is not available or conversion failed, return 0
// - return a metafile handle, to be released after use (e.g. with
// DrawImageRect) by DisposeImage()
function ConvertToEmfPlus(Source: TMetafile; Dest: HDC;
aSmoothing: TSmoothingMode=smAntiAlias;
aTextRendering: TTextRenderingHint=trhClearTypeGridFit): THandle;
/// internal method used for GDI32 metafile loading
function MetaFileToStream(Source: TMetafile): IStream;
/// return true if DrawAntiAliased() method will use native GDI+ conversion,
// i.e. if GDI+ installed version is 1.1
property NativeConvertToEmfPlus: boolean read getNativeConvertToEmfPlus;
/// can be set to true if to force DrawAntiAliased() method NOT to use
// native GDI+ 1.1 conversion, even if available
// - we found out that GDI+ 1.1 was not as good as our internal conversion
// function written in Delphi, e.g. for underlined fonts or font fallback
// - programs can set this property to true to avoid using GDI+ 1.1
property ForceInternalConvertToEmfPlus: boolean
read fForceInternalConvertToEmfPlus write fForceInternalConvertToEmfPlus;
/// if TRUE, text will be rendered using DrawString and not DrawDriverString
// if the content has some chars non within 0000-05ff Unicode BMP range
// - less accurate for individual character positioning (e.g. justification),
// but will handle UniScribe positioning and associated font fallback
// - is disable by default, and enabled only for chars >= $600
// - note that the GdipConvertToEmfPlus() GDI+ 1.1 method does not handle
// font fallback, so our internal conversion is more accurate thanks to
// this parameter
property ForceUseDrawString: boolean read fUseDrawString write fUseDrawString;
end;
{$A+}
const
/// the corresponding file extension for every saving format type
GDIPPictureExt: array [TGDIPPictureType] of TFileName =
('.gif','.png','.jpg','.bmp','.tif');
/// retrieve a ready to be displayed name of the supplied Graphic Class
function PictureName(Pic: TGraphicClass): string;
/// helper to save a specified graphic into GIF/PNG/JPG/TIFF format
// - CompressionQuality is only used for gptJPG format saving
// and is expected to be from 0 to 100
// - if MaxPixelsForBiggestSide is set to something else than 0, the resulting
// picture biggest side won't exceed this pixel number
// - this method is thread-safe (using GdipLock/GdipUnlock globals)
procedure SaveAs(Graphic: TPersistent; Stream: TStream;
Format: TGDIPPictureType; CompressionQuality: integer=80;
MaxPixelsForBiggestSide: cardinal=0; BitmapSetResolution: single=0); overload;
/// helper to save a specified graphic into GIF/PNG/JPG/TIFF format
// - CompressionQuality is only used for gptJPG format saving
// and is expected to be from 0 to 100
// - if MaxPixelsForBiggestSide is set to something else than 0, the resulting
// picture biggest side won't exceed this pixel number
// - this method is thread-safe (using GdipLock/GdipUnlock globals)
procedure SaveAs(Graphic: TPersistent; const FileName: TFileName;
Format: TGDIPPictureType; CompressionQuality: integer=80;
MaxPixelsForBiggestSide: cardinal=0; BitmapSetResolution: single=0); overload;
/// helper to save a specified graphic into GIF/PNG/JPG/TIFF format
// - CompressionQuality is only used for gptJPG format saving
// and is expected to be from 0 to 100
// - if MaxPixelsForBiggestSide is set to something else than 0, the resulting
// picture biggest side won't exceed this pixel number
// - this method is thread-safe (using GdipLock/GdipUnlock globals)
procedure SaveAsRawByteString(Graphic: TPersistent;
out DataRawByteString{$ifdef HASCODEPAGE}: RawByteString{$endif};
Format: TGDIPPictureType; CompressionQuality: integer=80;
MaxPixelsForBiggestSide: cardinal=0; BitmapSetResolution: single=0);
/// helper to save a specified TBitmap into GIF/PNG/JPG/TIFF format
// - CompressionQuality is only used for gptJPG format saving
// and is expected to be from 0 to 100
// - if MaxPixelsForBiggestSide is set to something else than 0, the resulting
// picture biggest side won't exceed this pixel number
// - this method is thread-safe (using GdipLock/GdipUnlock globals)
function BitmapToRawByteString(Bitmap: TBitmap;
out DataRawByteString{$ifdef HASCODEPAGE}: RawByteString{$endif};
Format: TGDIPPictureType; CompressionQuality: integer=80;
MaxPixelsForBiggestSide: cardinal=0; BitmapSetResolution: single=0): TGdipStatus;
/// helper to load a specified graphic from GIF/PNG/JPG/TIFF format content
// - this method is thread-safe (using GdipLock/GdipUnlock globals)
function LoadFromRawByteString(const Picture: {$ifdef HASCODEPAGE}RawByteString{$else}AnsiString{$endif}): TBitmap;
/// helper function to create a bitmap from any GIF/PNG/JPG/TIFF/EMF/WMF file
// - if file extension if .EMF, the file is drawn with a special antialiased
// GDI+ drawing method (if the global Gdip var is a TGDIPlusFull instance)
// - this method is thread-safe (using GdipLock/GdipUnlock globals)
function LoadFrom(const FileName: TFileName): TBitmap; overload;
/// helper function to create a bitmap from any EMF content
// - the file is drawn with a special antialiased
// GDI+ drawing method (if the global Gdip var is a TGDIPlusFull instance)
// - this method is thread-safe (using GdipLock/GdipUnlock globals)
function LoadFrom(const MetaFile: TMetaFile): TBitmap; overload;
/// recompress a JPEG binary in-place
// - no sizing is done, but a bitmap is created from the supplied JPEG, and
// re-compressed as JPEG using the specified quality
// - may be used to ensure a JPEG binary is a JPEG is a JPEG
// - this method is thread-safe (using GdipLock/GdipUnlock globals)
function JpegRecompress(const jpeg: {$ifdef HASCODEPAGE}RawByteString{$else}AnsiString{$endif};
quality: integer=80): {$ifdef HASCODEPAGE}RawByteString{$else}AnsiString{$endif};
/// draw the specified GDI TMetaFile (emf) using the GDI-plus antialiaised engine
// - by default, no font fall-back is implemented (for characters not included
// within the font glyphs), but you may force it via the corresponding parameter
// (used to set the TGDIPlusFull.ForceUseDrawString property)
// - this method is thread-safe (using GdipLock/GdipUnlock globals)
procedure DrawEmfGdip(aHDC: HDC; Source: TMetaFile; var R: TRect;
ForceInternalAntiAliased: boolean; ForceInternalAntiAliasedFontFallBack: boolean=false);
var
/// GDI+ library instance
// - only initialized at program startup if the NOTSYNPICTUREREGISTER is NOT
// defined (which is not the default)
// - Gdip.Exists return FALSE if the GDI+ library is not available in this
// operating system (e.g. on Windows 2000) nor the current executable folder
// - you can run ExpectGDIPlusFull to ensure you use GDI+ 1.1
Gdip: TGDIPlus = nil;
/// will set global Gdip instance from a TGDIPlusFull, if available
// - this GDI+ 1.1 version (i.e. gdiplus11.dll) allows proper TMetaFile
// antialiasing, as requested by LoadFrom and DrawEmfGdip functions
procedure ExpectGDIPlusFull(ForceInternalAntiAliased: boolean=true;
ForceInternalAntiAliasedFontFallBack: boolean=true);
/// test function
procedure GdipTest(const JpegFile: TFileName);
/// enter global critical section for safe use of SynGdiPlus from multiple threads
procedure GdipLock;
/// leave global critical section for safe use of SynGdiPlus from multiple threads
procedure GdipUnlock;
var
/// mutex used by GdipLock/GdipUnlock
GdipCS: TRTLCriticalSection;
implementation
{
// Common GDI+ color constants
const
aclAliceBlue = $FFF0F8FF;
aclAntiqueWhite = $FFFAEBD7;
aclAqua = $FF00FFFF;
aclAquamarine = $FF7FFFD4;
aclAzure = $FFF0FFFF;
aclBeige = $FFF5F5DC;
aclBisque = $FFFFE4C4;
aclBlack = $FF000000;
aclBlanchedAlmond = $FFFFEBCD;
aclBlue = $FF0000FF;
aclBlueViolet = $FF8A2BE2;
aclBrown = $FFA52A2A;
aclBurlyWood = $FFDEB887;
aclCadetBlue = $FF5F9EA0;
aclChartreuse = $FF7FFF00;
aclChocolate = $FFD2691E;
aclCoral = $FFFF7F50;
aclCornflowerBlue = $FF6495ED;
aclCornsilk = $FFFFF8DC;
aclCrimson = $FFDC143C;
aclCyan = $FF00FFFF;
aclDarkBlue = $FF00008B;
aclDarkCyan = $FF008B8B;
aclDarkGoldenrod = $FFB8860B;
aclDarkGray = $FFA9A9A9;
aclDarkGreen = $FF006400;
aclDarkKhaki = $FFBDB76B;
aclDarkMagenta = $FF8B008B;
aclDarkOliveGreen = $FF556B2F;
aclDarkOrange = $FFFF8C00;
aclDarkOrchid = $FF9932CC;
aclDarkRed = $FF8B0000;
aclDarkSalmon = $FFE9967A;
aclDarkSeaGreen = $FF8FBC8B;
aclDarkSlateBlue = $FF483D8B;
aclDarkSlateGray = $FF2F4F4F;
aclDarkTurquoise = $FF00CED1;
aclDarkViolet = $FF9400D3;
aclDeepPink = $FFFF1493;
aclDeepSkyBlue = $FF00BFFF;
aclDimGray = $FF696969;
aclDodgerBlue = $FF1E90FF;
aclFirebrick = $FFB22222;
aclFloralWhite = $FFFFFAF0;
aclForestGreen = $FF228B22;
aclFuchsia = $FFFF00FF;
aclGainsboro = $FFDCDCDC;
aclGhostWhite = $FFF8F8FF;
aclGold = $FFFFD700;
aclGoldenrod = $FFDAA520;
aclGray = $FF808080;
aclGreen = $FF008000;
aclGreenYellow = $FFADFF2F;
aclHoneydew = $FFF0FFF0;
aclHotPink = $FFFF69B4;
aclIndianRed = $FFCD5C5C;
aclIndigo = $FF4B0082;
aclIvory = $FFFFFFF0;
aclKhaki = $FFF0E68C;
aclLavender = $FFE6E6FA;
aclLavenderBlush = $FFFFF0F5;
aclLawnGreen = $FF7CFC00;
aclLemonChiffon = $FFFFFACD;
aclLightBlue = $FFADD8E6;
aclLightCoral = $FFF08080;
aclLightCyan = $FFE0FFFF;
aclLightGoldenrodYellow = $FFFAFAD2;
aclLightGray = $FFD3D3D3;
aclLightGreen = $FF90EE90;
aclLightPink = $FFFFB6C1;
aclLightSalmon = $FFFFA07A;
aclLightSeaGreen = $FF20B2AA;
aclLightSkyBlue = $FF87CEFA;
aclLightSlateGray = $FF778899;
aclLightSteelBlue = $FFB0C4DE;
aclLightYellow = $FFFFFFE0;
aclLime = $FF00FF00;
aclLimeGreen = $FF32CD32;
aclLinen = $FFFAF0E6;
aclMagenta = $FFFF00FF;
aclMaroon = $FF800000;
aclMediumAquamarine = $FF66CDAA;
aclMediumBlue = $FF0000CD;
aclMediumOrchid = $FFBA55D3;
aclMediumPurple = $FF9370DB;
aclMediumSeaGreen = $FF3CB371;
aclMediumSlateBlue = $FF7B68EE;
aclMediumSpringGreen = $FF00FA9A;
aclMediumTurquoise = $FF48D1CC;
aclMediumVioletRed = $FFC71585;
aclMidnightBlue = $FF191970;
aclMintCream = $FFF5FFFA;
aclMistyRose = $FFFFE4E1;
aclMoccasin = $FFFFE4B5;
aclNavajoWhite = $FFFFDEAD;
aclNavy = $FF000080;
aclOldLace = $FFFDF5E6;
aclOlive = $FF808000;
aclOliveDrab = $FF6B8E23;
aclOrange = $FFFFA500;
aclOrangeRed = $FFFF4500;
aclOrchid = $FFDA70D6;
aclPaleGoldenrod = $FFEEE8AA;
aclPaleGreen = $FF98FB98;
aclPaleTurquoise = $FFAFEEEE;
aclPaleVioletRed = $FFDB7093;
aclPapayaWhip = $FFFFEFD5;
aclPeachPuff = $FFFFDAB9;
aclPeru = $FFCD853F;
aclPink = $FFFFC0CB;
aclPlum = $FFDDA0DD;
aclPowderBlue = $FFB0E0E6;
aclPurple = $FF800080;
aclRed = $FFFF0000;
aclRosyBrown = $FFBC8F8F;
aclRoyalBlue = $FF4169E1;
aclSaddleBrown = $FF8B4513;
aclSalmon = $FFFA8072;
aclSandyBrown = $FFF4A460;
aclSeaGreen = $FF2E8B57;
aclSeaShell = $FFFFF5EE;
aclSienna = $FFA0522D;
aclSilver = $FFC0C0C0;
aclSkyBlue = $FF87CEEB;
aclSlateBlue = $FF6A5ACD;
aclSlateGray = $FF708090;
aclSnow = $FFFFFAFA;
aclSpringGreen = $FF00FF7F;
aclSteelBlue = $FF4682B4;
aclTan = $FFD2B48C;
aclTeal = $FF008080;
aclThistle = $FFD8BFD8;
aclTomato = $FFFF6347;
aclTransparent = $00FFFFFF;
aclTurquoise = $FF40E0D0;
aclViolet = $FFEE82EE;
aclWheat = $FFF5DEB3;
aclWhite = $FFFFFFFF;
aclWhiteSmoke = $FFF5F5F5;
aclYellow = $FFFFFF00;
aclYellowGreen = $FF9ACD32;
}
{ TSynLibrary }
function TSynLibrary.Exists: boolean;
begin
result := (self<>nil) and (fHandle<>0);
end;
function ProcLoad(H: HMODULE; Addr: PPointer; Names: PPChar): boolean;
begin
result := false;
if Names<>nil then
repeat
Addr^ := GetProcAddress(H,Names^);
if Addr^=nil then
exit;
inc(Addr);
inc(Names);
until Names^=nil;
result := true;
end;
class function TSynLibrary.Load(const aDllFileName: TFileName; Addr: PPointer;
Names: PPChar): HMODULE;
var H: HMODULE;
begin
result := 0;
H := SafeLoadLibrary(aDllFileName);
if (H<>0) and ProcLoad(H,Addr,Names) then
result := H;
end;
procedure TSynLibrary.UnLoad;
begin
if fHandle=0 then
exit;
FreeLibrary(fHandle);
fHandle := 0;
end;
{ TGDIPlus }
{$ifdef USEENCODERS}
type
ImageCodecInfo = record
Clsid : TGUID;
FormatID : TGUID;
CodecName : PWCHAR;
DllName : PWCHAR;
FormatDescription : PWCHAR;
FilenameExtension : PWCHAR;
MimeType : PWCHAR;
Flags : DWORD;
Version : DWORD;
SigCount : DWORD;
SigSize : DWORD;
SigPattern : PBYTE;
SigMask : PBYTE;
end;
TImageCodecInfo = ImageCodecInfo;
PImageCodecInfo = ^TImageCodecInfo;
TImageCodecInfoArray = array[byte] of TImageCodecInfo;
function StrWCompAnsi(Str1: PWord; Str2: PByte): integer;
asm // to avoid widestring usage + compatibility with Delphi 2009/2010/XE
if Str1<>Str2 then
if Str1<>nil then
if Str2<>nil then begin
if Str1^=Str2^ then
repeat
if Str1^=0 then break;
inc(Str1);
inc(Str2);
until Str1^<>Str2^;
result := Str1^-Str2^;
exit;
end else
result := 1 else // Str2=''
result := -1 else // Str1=''
result := 0; // Str1=Str2
end;
function TGDIPlus.GetEncoderClsid(format: PAnsiChar; out pClsid: TGUID): integer;
var num, size: cardinal;
ImageCodecInfo: AnsiString;
P: ^TImageCodecInfoArray;
begin