http://www.mediafire.com/file/wvjr95zd0 ... xample.zip
Code: Select all
'' tiff lib example
'' read tiff file
'' coded by WQ1980 2017
#Ifdef __FB_WIN32__
#LibPath "lib/win32/"
#Inclib "tiff"
#Inclib "jpeg"
#Inclib "lzma"
#Inclib "z"
#Else
#LibPath "lib/linux32/"
#Inclib "tiff"
#Inclib "jpeg"
#Inclib "lzma"
#Inclib "z"
#EndIf
Type TIFF As Any
#define TIFFTAG_IMAGEWIDTH 256 ' image width in pixels
#define TIFFTAG_IMAGELENGTH 257 ' image height in pixels
'#define TIFFTAG_ORIENTATION 274
'#define TIFFTAG_XRESOLUTION 282
'#define TIFFTAG_YRESOLUTION 283
'#define TIFFTAG_BITSPERSAMPLE 258
Extern "C"
#Ifdef __FB_WIN32__
Declare Function TIFFOpenW Cdecl (ByVal file_name As Const WString Ptr, ByVal r As Const ZString Ptr) As TIFF Ptr
#Else
Declare Function TIFFOpen Cdecl (ByVal file_name As Const ZString Ptr, ByVal r As Const ZString Ptr) As TIFF Ptr
#EndIf
Declare Sub TIFFClose Cdecl (As TIFF Ptr)
Declare Sub _TIFFfree(buffer As UInteger Ptr)
Declare Function TIFFGetField Cdecl(As TIFF Ptr, As UInteger , As Integer Ptr) As Integer
Declare Function TIFFReadRGBAImage Cdecl (As TIFF Ptr, As UInteger, As UInteger, As UInteger Ptr, As Integer = 0) As UInteger
Declare Function _TIFFmalloc Cdecl (As UInteger) As UInteger Ptr
Declare Function TIFFSetWarningHandler Cdecl (As Any Ptr ) As Any Ptr
End Extern
Open Cons For Output As #2
Declare Function DummyHandl Cdecl (ByVal Warning As Const ZString Ptr, ByVal fmt As Const ZString Ptr, p As Any Ptr )As Integer
Function DummyHandl Cdecl (ByVal Warning As Const ZString Ptr, ByVal fmt As Const ZString Ptr, p As Any Ptr)As Integer
'?#2 *Warning, *fmt
Return 0
End Function
TIFFSetWarningHandler(0)
Dim As String filename = "fblogo-copy.tif"
ScreenRes 720, 700, 32
Dim As TIFF Ptr image
Dim As Integer width__, height__, imagesize, ot
#Ifdef __FB_WIN32__
Dim As WString*255 wss
wss=WStr(filename)
image=TIFFOpenW(wss, "r")
#Else
image=TIFFOpen(filename, "r")
#EndIf
TIFFGetField(image, TIFFTAG_IMAGEWIDTH, @width__)
TIFFGetField(image, TIFFTAG_IMAGELENGTH, @height__)
'TIFFGetField(image, TIFFTAG_BITSPERSAMPLE, @ot)
imagesize = height__ * width__ + 1
Dim As Any Ptr fb_img, pixels
Dim As Integer bypp, pitch
Dim As Integer Ptr raster
raster=_TIFFmalloc(imagesize * SizeOf(Integer))
fb_img= ImageCreate(width__, height__)
ImageInfo(fb_img, ,,bypp, pitch, pixels)
TIFFReadRGBAImage(image, width__, height__, raster, 0)
?#2, height__ , width__
For y As Integer= height__ - 1 To 0 Step -1
Dim As UByte Ptr row1 = pixels + y * pitch
For x As Integer=0 To width__- 1
Dim row As Integer Ptr = raster[(height__-y) * width__ + x]
row1[(x * bypp)] = (CUInt(row) Shr 16 And 255)
row1[(x * bypp) + 1] = (CUInt(row) Shr 8 And 255)
row1[(x * bypp) + 2] = (CUInt(row) And 255)
Next
Next
_TIFFfree(raster)
TIFFClose(image)
Put (0,0), fb_img
Sleep
ImageDestroy(fb_img)