~ubuntu-branches/ubuntu/precise/freeimage/precise

« back to all changes in this revision

Viewing changes to Wrapper/Delphi/src/FreeBitmap.pas

  • Committer: Package Import Robot
  • Author(s): Evan Broder, Evan Broder, Stefano Rivera
  • Date: 2011-12-06 14:31:21 UTC
  • mfrom: (1.1.3) (4.1.3 sid)
  • Revision ID: package-import@ubuntu.com-20111206143121-pzgzwxp0lr6m2szu
Tags: 3.15.1-1
[ Evan Broder ]
* QA upload.
* New upstream release (closes: 649541, LP: #898825, #898845)
  - Refreshed patches.
    + Abuse dh-autoreconf to generate Makefile.srcs and fipMakefile.srcs
      patches at build time
  - Update debian/freeimage-get-orig-source for the new version.
  - Add new build-dep libraw-dev.
  - Update patch to disable embedded libraries to deal with API changes
    in libpng, libmng, and libraw.
  - Make sure we install symlinks for libfreeimageplus.
  - Use (upstream-supported) CFLAGS instead of COMPILERFLAGS.
* Switch to source format 3.0 (quilt)
* Switch to dh(1) and debhelper compat 8
* Add missing misc:Depends.
* Include the upstream changelog.
* Update Debian standards version (no other changes needed).

[ Stefano Rivera ]
* Dropped README.source.
* Updated freeimage (3.9.5) fixes CVE-2011-1167, CVE-2011-0192,
  CVE-2010-2595
* Override lintian's embedded-library error for libtiff. It wasn't
  extricable.

Show diffs side-by-side

added added

removed removed

Lines of Context:
9
9
//
10
10
// Contributors:
11
11
// - Enzo Costantini (enzocostantini@libero.it)
 
12
// - Lorenzo Monti (LM)  lomo74@gmail.com
12
13
//
 
14
// Revision history
 
15
// When        Who   What
 
16
// ----------- ----- -----------------------------------------------------------
 
17
// 2010-07-14  LM    made RAD2010 compliant (unicode)
 
18
// 2011-03-04  JMB   modifications to run on 64 bits (Windows and linux) :
 
19
//                     - FreeImage_RotateClassic : deprecated function, call to DeprecationManager in 64 bits crashes freeimage.dll
 
20
//                     ==> FreeImage_RotateClassic : replaced by FreeImage_Rotate
 
21
//                   modifications to run on linux :
 
22
//                     - exclude windows specific functions by compilation directives
 
23
//                   some corrections in :
 
24
//                     - TFreeBitmap.DoChanging
 
25
//                     - TFreeBitmap.IsGrayScale
 
26
//                     - TFreeWinBitmap.CopyFromBitmap
 
27
//                     - TFreeMultiBitmap.Open
 
28
 
13
29
// This file is part of FreeImage 3
14
30
//
15
31
// COVERED CODE IS PROVIDED UNDER THIS LICENSE ON AN "AS IS" BASIS, WITHOUT WARRANTY
33
49
 
34
50
interface
35
51
 
 
52
{$I 'Version.inc'}
 
53
 
36
54
uses
37
 
  SysUtils, Classes, Windows, FreeImage;
 
55
  SysUtils, Classes,
 
56
{$IFDEF MSWINDOWS}
 
57
  Windows,
 
58
{$ENDIF}
 
59
  FreeImage;
38
60
 
39
61
type
40
62
  { TFreeObject }
53
75
 
54
76
    // getters & setters
55
77
    function GetCount: Cardinal;
56
 
    function GetDescription: string;
 
78
    function GetDescription: AnsiString;
57
79
    function GetID: Word;
58
 
    function GetKey: string;
 
80
    function GetKey: AnsiString;
59
81
    function GetLength: Cardinal;
60
82
    function GetTagType: FREE_IMAGE_MDTYPE;
61
83
    function GetValue: Pointer;
62
84
    procedure SetCount(const Value: Cardinal);
63
 
    procedure SetDescription(const Value: string);
 
85
    procedure SetDescription(const Value: AnsiString);
64
86
    procedure SetID(const Value: Word);
65
 
    procedure SetKey(const Value: string);
 
87
    procedure SetKey(const Value: AnsiString);
66
88
    procedure SetLength(const Value: Cardinal);
67
89
    procedure SetTagType(const Value: FREE_IMAGE_MDTYPE);
68
90
    procedure SetValue(const Value: Pointer);
74
96
    // methods
75
97
    function Clone: TFreeTag;
76
98
    function IsValid: Boolean; override;
77
 
    function ToString(Model: FREE_IMAGE_MDMODEL; Make: PChar = nil): string;
 
99
    function ToString(Model: FREE_IMAGE_MDMODEL; Make: PAnsiChar = nil): AnsiString; reintroduce;
78
100
 
79
101
    // properties
80
 
    property Key: string read GetKey write SetKey;
81
 
    property Description: string read GetDescription write SetDescription;
 
102
    property Key: AnsiString read GetKey write SetKey;
 
103
    property Description: AnsiString read GetDescription write SetDescription;
82
104
    property ID: Word read GetID write SetID;
83
105
    property TagType: FREE_IMAGE_MDTYPE read GetTagType write SetTagType;
84
106
    property Count: Cardinal read GetCount write SetCount;
116
138
    function CopySubImage(Left, Top, Right, Bottom: Integer; Dest: TFreeBitmap): Boolean;
117
139
    function PasteSubImage(Src: TFreeBitmap; Left, Top: Integer; Alpha: Integer = 256): Boolean;
118
140
    procedure Clear; virtual;
119
 
    function Load(const FileName: string; Flag: Integer = 0): Boolean;
120
 
    function LoadU(const FileName: WideString; Flag: Integer = 0): Boolean;
 
141
    function Load(const FileName: AnsiString; Flag: Integer = 0): Boolean;
 
142
    function LoadU(const FileName: {$IFDEF DELPHI2010}string{$ELSE}WideString{$ENDIF}; Flag: Integer = 0): Boolean;
121
143
    function LoadFromHandle(IO: PFreeImageIO; Handle: fi_handle; Flag: Integer = 0): Boolean;
122
144
    function LoadFromMemory(MemIO: TFreeMemoryIO; Flag: Integer = 0): Boolean;
123
145
    function LoadFromStream(Stream: TStream; Flag: Integer = 0): Boolean;
124
146
    // save functions
125
147
    function CanSave(fif: FREE_IMAGE_FORMAT): Boolean;
126
 
    function Save(const FileName: string; Flag: Integer = 0): Boolean;
127
 
    function SaveU(const FileName: WideString; Flag: Integer = 0): Boolean;
 
148
    function Save(const FileName: AnsiString; Flag: Integer = 0): Boolean;
 
149
    function SaveU(const FileName: {$IFDEF DELPHI2010}string{$ELSE}WideString{$ENDIF}; Flag: Integer = 0): Boolean;
128
150
    function SaveToHandle(fif: FREE_IMAGE_FORMAT; IO: PFreeImageIO; Handle: fi_handle; Flag: Integer = 0): Boolean;
129
151
    function SaveToMemory(fif: FREE_IMAGE_FORMAT; MemIO: TFreeMemoryIO; Flag: Integer = 0): Boolean;
130
152
    function SaveToStream(fif: FREE_IMAGE_FORMAT; Stream: TStream; Flag: Integer = 0): Boolean;
152
174
    // pixels access
153
175
    function AccessPixels: PByte;
154
176
    function GetScanLine(ScanLine: Integer): PByte;
155
 
    function GetPixelIndex(X, Y: Cardinal; var Value: PByte): Boolean;
156
 
    function GetPixelColor(X, Y: Cardinal; var Value: PRGBQUAD): Boolean;
157
 
    function SetPixelIndex(X, Y: Cardinal; Value: PByte): Boolean;
158
 
    function SetPixelColor(X, Y: Cardinal; Value: PRGBQUAD): Boolean;
 
177
    function GetPixelIndex(X, Y: Cardinal; var Value: Byte): Boolean;
 
178
    function GetPixelColor(X, Y: Cardinal; var Value: RGBQUAD): Boolean;
 
179
    function SetPixelIndex(X, Y: Cardinal; var Value: Byte): Boolean;
 
180
    function SetPixelColor(X, Y: Cardinal; var Value: RGBQUAD): Boolean;
159
181
    // convertion
160
182
    function ConvertToStandardType(ScaleLinear: Boolean): Boolean;
161
183
    function ConvertToType(ImageType: FREE_IMAGE_TYPE; ScaleLinear: Boolean): Boolean;
177
199
    function GetTransparencyTable: PByte;
178
200
    procedure SetTransparencyTable(Table: PByte; Count: Integer);
179
201
    function HasFileBkColor: Boolean;
180
 
    function GetFileBkColor(var BkColor: PRGBQuad): Boolean;
 
202
    function GetFileBkColor(var BkColor: RGBQUAD): Boolean;
181
203
    function SetFileBkColor(BkColor: PRGBQuad): Boolean;
182
204
    // channel processing routines
183
205
    function GetChannel(Bitmap: TFreeBitmap; Channel: FREE_IMAGE_COLOR_CHANNEL): Boolean;
203
225
    function FindFirstMetadata(Model: FREE_IMAGE_MDMODEL; var Tag: TFreeTag): PFIMETADATA;
204
226
    function FindNextMetadata(MDHandle: PFIMETADATA; var Tag: TFreeTag): Boolean;
205
227
    procedure FindCloseMetadata(MDHandle: PFIMETADATA);
206
 
    function SetMetadata(Model: FREE_IMAGE_MDMODEL; const Key: string; Tag: TFreeTag): Boolean;
207
 
    function GetMetadata(Model: FREE_IMAGE_MDMODEL; const Key: string; var Tag: TFreeTag): Boolean;
 
228
    function SetMetadata(Model: FREE_IMAGE_MDMODEL; const Key: AnsiString; Tag: TFreeTag): Boolean;
 
229
    function GetMetadata(Model: FREE_IMAGE_MDMODEL; const Key: AnsiString; var Tag: TFreeTag): Boolean;
208
230
    function GetMetadataCount(Model: FREE_IMAGE_MDMODEL): Cardinal;
209
231
 
210
232
    // properties
224
246
    destructor Destroy; override;
225
247
 
226
248
    procedure Clear; override;
 
249
{$IFDEF MSWINDOWS}
227
250
    function CopyToHandle: THandle;
228
251
    function CopyFromHandle(HMem: THandle): Boolean;
229
252
    function CopyFromBitmap(HBmp: HBITMAP): Boolean;
234
257
 
235
258
    procedure Draw(DC: HDC; Rect: TRect);
236
259
    procedure DrawEx(DC: HDC; Rect: TRect; UseFileBkg: Boolean = False; AppBkColor: PRGBQuad = nil; Bg: PFIBITMAP = nil);
 
260
{$ENDIF}
237
261
  end;
238
262
 
239
263
  { TFreeMemoryIO }
268
292
    destructor Destroy; override;
269
293
 
270
294
    // methods
271
 
    function Open(const FileName: string; CreateNew, ReadOnly: Boolean; Flags: Integer = 0): Boolean;
 
295
    function Open(const FileName: AnsiString; CreateNew, ReadOnly: Boolean; Flags: Integer = 0): Boolean;
272
296
    function Close(Flags: Integer = 0): Boolean;
273
297
    function GetPageCount: Integer;
274
298
    procedure AppendPage(Bitmap: TFreeBitmap);
720
744
  Result := FreeImage_GetColorType(FDib);
721
745
end;
722
746
 
723
 
function TFreeBitmap.GetFileBkColor(var BkColor: PRGBQuad): Boolean;
 
747
function TFreeBitmap.GetFileBkColor(var BkColor: RGBQUAD): Boolean;
724
748
begin
725
 
  Result := FreeImage_GetBackgroundColor(FDib, BkColor)
 
749
  Result := FreeImage_GetBackgroundColor(FDib, BkColor);
726
750
end;
727
751
 
728
752
function TFreeBitmap.GetHeight: Integer;
756
780
 
757
781
function TFreeBitmap.GetInfo: PBitmapInfo;
758
782
begin
759
 
  Result := FreeImage_GetInfo(FDib^)
 
783
  Result := FreeImage_GetInfo(FDib);
760
784
end;
761
785
 
762
786
function TFreeBitmap.GetInfoHeader: PBITMAPINFOHEADER;
770
794
end;
771
795
 
772
796
function TFreeBitmap.GetMetadata(Model: FREE_IMAGE_MDMODEL;
773
 
  const Key: string; var Tag: TFreeTag): Boolean;
 
797
  const Key: AnsiString; var Tag: TFreeTag): Boolean;
774
798
begin
775
 
  Result := FreeImage_GetMetaData(Model, FDib, PChar(Key), Tag.FTag);
 
799
  Result := FreeImage_GetMetadata(Model, FDib, PAnsiChar(Key), Tag.FTag);
776
800
end;
777
801
 
778
802
function TFreeBitmap.GetMetadataCount(Model: FREE_IMAGE_MDMODEL): Cardinal;
791
815
end;
792
816
 
793
817
function TFreeBitmap.GetPixelColor(X, Y: Cardinal;
794
 
  var Value: PRGBQUAD): Boolean;
 
818
  var Value: RGBQUAD): Boolean;
795
819
begin
796
 
  Result := FreeImage_GetPixelColor(FDib, X, Y, Value)
 
820
  Result := FreeImage_GetPixelColor(FDib, X, Y, Value);
797
821
end;
798
822
 
799
823
function TFreeBitmap.GetPixelIndex(X, Y: Cardinal;
800
 
  var Value: PByte): Boolean;
 
824
  var Value: Byte): Boolean;
801
825
begin
802
 
  Result := FreeImage_GetPixelIndex(FDib, X, Y, Value)
 
826
  Result := FreeImage_GetPixelIndex(FDib, X, Y, Value);
803
827
end;
804
828
 
805
829
function TFreeBitmap.GetScanLine(ScanLine: Integer): PByte;
857
881
function TFreeBitmap.IsGrayScale: Boolean;
858
882
begin
859
883
  Result := (FreeImage_GetBPP(FDib) = 8)
860
 
            and (FreeImage_GetColorType(FDib) = FIC_PALETTE); 
 
884
// modif JMB NOVAXEL
 
885
//      FIC_PALETTE isn't enough to tell the bitmap is grayscale
 
886
//            and (FreeImage_GetColorType(FDib) = FIC_PALETTE);
 
887
            and ((FreeImage_GetColorType(FDib) = FIC_MINISBLACK) or
 
888
                        (FreeImage_GetColorType(FDib) = FIC_MINISWHITE));
 
889
// end of modif JMB NOVAXEL
861
890
end;
862
891
 
863
892
function TFreeBitmap.IsTransparent: Boolean;
870
899
  Result := FDib <> nil
871
900
end;
872
901
 
873
 
function TFreeBitmap.Load(const FileName: string; Flag: Integer): Boolean;
 
902
function TFreeBitmap.Load(const FileName: AnsiString; Flag: Integer): Boolean;
874
903
var
875
904
  fif: FREE_IMAGE_FORMAT;
876
905
begin
877
906
 
878
907
  // check the file signature and get its format
879
 
  fif := FreeImage_GetFileType(PChar(Filename), 0);
 
908
  fif := FreeImage_GetFileType(PAnsiChar(Filename), 0);
880
909
  if fif = FIF_UNKNOWN then
881
910
    // no signature?
882
911
    // try to guess the file format from the file extention
883
 
    fif := FreeImage_GetFIFFromFilename(PChar(FileName));
 
912
    fif := FreeImage_GetFIFFromFilename(PAnsiChar(FileName));
884
913
 
885
914
    // check that the plugin has reading capabilities ...
886
915
    if (fif <> FIF_UNKNOWN) and FreeImage_FIFSupportsReading(FIF) then
890
919
        FreeImage_Unload(dib);
891
920
 
892
921
      // load the file
893
 
      FDib := FreeImage_Load(fif, PChar(FileName), Flag);
 
922
      FDib := FreeImage_Load(fif, PAnsiChar(FileName), Flag);
894
923
 
895
924
      Change;
896
925
      Result := IsValid;
969
998
  end;
970
999
end;
971
1000
 
972
 
function TFreeBitmap.LoadU(const FileName: WideString;
 
1001
function TFreeBitmap.LoadU(const FileName: {$IFDEF DELPHI2010}string{$ELSE}WideString{$ENDIF};
973
1002
  Flag: Integer): Boolean;
974
1003
var
975
1004
  fif: FREE_IMAGE_FORMAT;
1232
1261
    Bpp := FreeImage_GetBPP(FDib);
1233
1262
    if Bpp in [1, 8, 24, 32] then
1234
1263
    begin
1235
 
      Rotated := FreeImage_RotateClassic(FDib, Angle);
 
1264
// modif JMB : FreeImage_RotateClassic : deprecated function, call to DeprecationManager in 64 bits crash freeimage.dll
 
1265
      //Rotated := FreeImage_RotateClassic(FDib, Angle);
 
1266
      Rotated := FreeImage_Rotate(FDib, Angle, nil);
 
1267
// end of modif JMB
 
1268
      //Rotated := FreeImage_Rotate(FDib, Angle);
1236
1269
      Result := Replace(Rotated);
1237
1270
    end
1238
1271
  end;
1254
1287
  end;
1255
1288
end;
1256
1289
 
1257
 
function TFreeBitmap.Save(const FileName: string; Flag: Integer): Boolean;
 
1290
function TFreeBitmap.Save(const FileName: AnsiString; Flag: Integer): Boolean;
1258
1291
var
1259
1292
  fif: FREE_IMAGE_FORMAT;
1260
1293
begin
1261
1294
  Result := False;
1262
1295
 
1263
1296
  // try to guess the file format from the file extension
1264
 
  fif := FreeImage_GetFIFFromFilename(PChar(Filename));
 
1297
  fif := FreeImage_GetFIFFromFilename(PAnsiChar(Filename));
1265
1298
  if CanSave(fif) then
1266
 
    Result := FreeImage_Save(fif, FDib, PChar(FileName), Flag);
 
1299
    Result := FreeImage_Save(fif, FDib, PAnsiChar(FileName), Flag);
1267
1300
end;
1268
1301
 
1269
1302
function TFreeBitmap.SaveToHandle(fif: FREE_IMAGE_FORMAT; IO: PFreeImageIO;
1303
1336
  end;
1304
1337
end;
1305
1338
 
1306
 
function TFreeBitmap.SaveU(const FileName: WideString;
 
1339
function TFreeBitmap.SaveU(const FileName: {$IFDEF DELPHI2010}string{$ELSE}WideString{$ENDIF};
1307
1340
  Flag: Integer): Boolean;
1308
1341
var
1309
1342
  fif: FREE_IMAGE_FORMAT;
1349
1382
end;
1350
1383
 
1351
1384
function TFreeBitmap.SetMetadata(Model: FREE_IMAGE_MDMODEL;
1352
 
  const Key: string; Tag: TFreeTag): Boolean;
 
1385
  const Key: AnsiString; Tag: TFreeTag): Boolean;
1353
1386
begin
1354
 
  Result := FreeImage_SetMetadata(Model, FDib, PChar(Key), Tag.Tag);
 
1387
  Result := FreeImage_SetMetadata(Model, FDib, PAnsiChar(Key), Tag.Tag);
1355
1388
end;
1356
1389
 
1357
1390
function TFreeBitmap.SetPixelColor(X, Y: Cardinal;
1358
 
  Value: PRGBQUAD): Boolean;
 
1391
  var Value: RGBQUAD): Boolean;
1359
1392
begin
1360
1393
  Result := FreeImage_SetPixelColor(FDib, X, Y, Value);
1361
1394
  Change;
1362
1395
end;
1363
1396
 
1364
 
function TFreeBitmap.SetPixelIndex(X, Y: Cardinal; Value: PByte): Boolean;
 
1397
function TFreeBitmap.SetPixelIndex(X, Y: Cardinal; var Value: Byte): Boolean;
1365
1398
begin
1366
1399
  Result := FreeImage_SetPixelIndex(FDib, X, Y, Value);
1367
1400
  Change;
1391
1424
        Pal.rgbBlue := I;
1392
1425
        Pal.rgbGreen := I;
1393
1426
        Pal.rgbRed := I;
1394
 
        Inc(Pal, SizeOf(RGBQUAD));
 
1427
        Inc(Pal);//, SizeOf(RGBQUAD));
1395
1428
      end;
1396
1429
    end;
1397
1430
  end;
1455
1488
end;
1456
1489
 
1457
1490
{ TFreeWinBitmap }
1458
 
 
 
1491
{$IFDEF MSWINDOWS}
1459
1492
function TFreeWinBitmap.CaptureWindow(ApplicationWindow,
1460
1493
  SelectedWindow: HWND): Boolean;
1461
1494
var
1531
1564
 
1532
1565
  Result := True;
1533
1566
end;
 
1567
{$ENDIF}
1534
1568
 
1535
1569
procedure TFreeWinBitmap.Clear;
1536
1570
begin
1538
1572
  inherited;
1539
1573
end;
1540
1574
 
 
1575
{$IFDEF MSWINDOWS}
1541
1576
function TFreeWinBitmap.CopyFromBitmap(HBmp: HBITMAP): Boolean;
1542
1577
var
1543
1578
  bm: BITMAP;
1544
1579
  DC: HDC;
1545
1580
  Success: Integer;
 
1581
// modif NOVAXEL
 
1582
  nColors : integer;
 
1583
  bmih: PBitmapInfoHeader;
 
1584
// end of modif NOVAXEL
1546
1585
begin
1547
1586
  Result := False;
1548
1587
 
1554
1593
    // create the image
1555
1594
    SetSize(FIT_BITMAP, bm.bmWidth, bm.bmHeight, bm.bmBitsPixel);
1556
1595
 
 
1596
// modif NOVAXEL
 
1597
    // GetDIBits clears the biClrUsed and biClrImportant BITMAPINFO properties.
 
1598
    // So for the Palettized bitmaps, we need to save the count of colors and
 
1599
    // to restore it after the call to GetDIBits
 
1600
    nColors := GetColorsUsed;
 
1601
// end of modif NOVAXEL
1557
1602
    // create the device context for the bitmap
1558
1603
    DC := GetDC(0);
1559
1604
 
1563
1608
                         0,                        // first scan line
1564
1609
                         FreeImage_GetHeight(Dib), // number of scan lines to copy
1565
1610
                         FreeImage_GetBits(Dib),   // array for bitmap bits
1566
 
                         FreeImage_GetInfo(Dib^)^, // bitmap data buffer
 
1611
                         FreeImage_GetInfo(Dib)^,  // bitmap data buffer
1567
1612
                         DIB_RGB_COLORS            // RGB
1568
1613
    );
1569
1614
 
1570
1615
    ReleaseDC(0, DC);
 
1616
// modif NOVAXEL
 
1617
    // as seen above, wr restore the properties which have been cleared by GetDIBits
 
1618
    bmih := GetInfoHeader;
 
1619
    bmih.biClrUsed := nColors;
 
1620
    bmih.biClrImportant := nColors;
 
1621
// end of modif NOVAXEL
1571
1622
 
1572
1623
    if Success = 0 then
1573
1624
      raise Exception.Create('Error: GetDIBits failed')
1656
1707
                           FreeImage_GetInfoHeader(Dib)^,
1657
1708
                           CBM_INIT,
1658
1709
                           PAnsiChar(FreeImage_GetBits(Dib)),
1659
 
                           FreeImage_GetInfo(Dib^)^,
 
1710
                           FreeImage_GetInfo(Dib)^,
1660
1711
                           DIB_RGB_COLORS);
1661
1712
    ReleaseDC(0,DC);
1662
1713
  end;
1723
1774
    GlobalUnlock(Result);
1724
1775
  end;
1725
1776
end;
 
1777
{$ENDIF}
1726
1778
 
1727
1779
constructor TFreeWinBitmap.Create(ImageType: FREE_IMAGE_TYPE; Width,
1728
1780
  Height, Bpp: Integer);
1740
1792
  inherited;
1741
1793
end;
1742
1794
 
 
1795
{$IFDEF MSWINDOWS}
1743
1796
procedure TFreeWinBitmap.Draw(DC: HDC; Rect: TRect);
1744
1797
begin
1745
1798
  DrawEx(DC, Rect);
1801
1854
  StretchDIBits(DC, Rect.Left, Rect.Top,
1802
1855
    Rect.Right - Rect.Left, Rect.Bottom - Rect.Top,
1803
1856
    0, 0, FreeImage_GetWidth(FDisplayDib), FreeImage_GetHeight(FDisplayDib),
1804
 
    FreeImage_GetBits(FDisplayDib), FreeImage_GetInfo(FDisplayDib^)^, DIB_RGB_COLORS, SRCCOPY);
 
1857
    FreeImage_GetBits(FDisplayDib), FreeImage_GetInfo(FDisplayDib)^, DIB_RGB_COLORS, SRCCOPY);
1805
1858
end;
1806
1859
 
1807
1860
function TFreeWinBitmap.PasteFromClipBoard: Boolean;
1819
1872
  end;
1820
1873
  CloseClipboard;
1821
1874
end;
 
1875
{$ENDIF}
1822
1876
 
1823
1877
{ TFreeMultiBitmap }
1824
1878
 
1895
1949
  Result := FreeImage_MovePage(FMPage, Target, Source);
1896
1950
end;
1897
1951
 
1898
 
function TFreeMultiBitmap.Open(const FileName: string; CreateNew,
 
1952
function TFreeMultiBitmap.Open(const FileName: AnsiString; CreateNew,
1899
1953
  ReadOnly: Boolean; Flags: Integer): Boolean;
1900
1954
var
1901
1955
  fif: FREE_IMAGE_FORMAT;
1902
1956
begin
1903
1957
  Result := False;
1904
1958
 
1905
 
  // try to guess the file format from the filename
1906
 
  fif := FreeImage_GetFIFFromFilename(PChar(FileName));
 
1959
// modif NOVAXEL
 
1960
// In order to try to get the file format even if the extension is not standard,
 
1961
// we check first the file signature
 
1962
  fif := FreeImage_GetFileType(PAnsiChar(Filename), 0);
 
1963
  if fif = FIF_UNKNOWN then
 
1964
    // no signature?
 
1965
// end of modif NOVAXEL
 
1966
        // try to guess the file format from the filename
 
1967
        fif := FreeImage_GetFIFFromFilename(PAnsiChar(FileName));
1907
1968
 
1908
1969
  // check for supported file types
1909
1970
  if (fif <> FIF_UNKNOWN) and (not fif in [FIF_TIFF, FIF_ICO, FIF_GIF]) then
1910
1971
    Exit;
1911
1972
 
1912
1973
  // open the stream
1913
 
  FMPage := FreeImage_OpenMultiBitmap(fif, PChar(FileName), CreateNew, ReadOnly, FMemoryCache, Flags);
 
1974
  FMPage := FreeImage_OpenMultiBitmap(fif, PAnsiChar(FileName), CreateNew, ReadOnly, FMemoryCache, Flags);
1914
1975
 
1915
1976
  Result := FMPage <> nil;  
1916
1977
end;
2020
2081
  Result := FreeImage_GetTagCount(FTag);
2021
2082
end;
2022
2083
 
2023
 
function TFreeTag.GetDescription: string;
 
2084
function TFreeTag.GetDescription: AnsiString;
2024
2085
begin
2025
2086
  Result := '';
2026
2087
  if not IsValid then Exit;
2036
2097
  Result := FreeImage_GetTagID(FTag);
2037
2098
end;
2038
2099
 
2039
 
function TFreeTag.GetKey: string;
 
2100
function TFreeTag.GetKey: AnsiString;
2040
2101
begin
2041
2102
  Result := '';
2042
2103
  if not IsValid then Exit;
2079
2140
    FreeImage_SetTagCount(FTag, Value);
2080
2141
end;
2081
2142
 
2082
 
procedure TFreeTag.SetDescription(const Value: string);
 
2143
procedure TFreeTag.SetDescription(const Value: AnsiString);
2083
2144
begin
2084
2145
  if IsValid then
2085
 
    FreeImage_SetTagDescription(FTag, PChar(Value));
 
2146
    FreeImage_SetTagDescription(FTag, PAnsiChar(Value));
2086
2147
end;
2087
2148
 
2088
2149
procedure TFreeTag.SetID(const Value: Word);
2091
2152
    FreeImage_SetTagID(FTag, Value);
2092
2153
end;
2093
2154
 
2094
 
procedure TFreeTag.SetKey(const Value: string);
 
2155
procedure TFreeTag.SetKey(const Value: AnsiString);
2095
2156
begin
2096
2157
  if IsValid then
2097
 
    FreeImage_SetTagKey(FTag, PChar(Value));
 
2158
    FreeImage_SetTagKey(FTag, PAnsiChar(Value));
2098
2159
end;
2099
2160
 
2100
2161
procedure TFreeTag.SetLength(const Value: Cardinal);
2115
2176
    FreeImage_SetTagValue(FTag, Value);
2116
2177
end;
2117
2178
 
2118
 
function TFreeTag.ToString(Model: FREE_IMAGE_MDMODEL; Make: PChar): string;
 
2179
function TFreeTag.ToString(Model: FREE_IMAGE_MDMODEL; Make: PAnsiChar): AnsiString;
2119
2180
begin
2120
2181
  Result := FreeImage_TagToString(Model, FTag, Make);
2121
2182
end;