In this example we will load a 1-bit tiff with group 4 compression: www.catenary.com/howto/ibit.tif and display it in a VB picture box.
' ............................... Data Type Definitions ............................. Type imgdes ibuff As Long stx As Long sty As Long endx As Long endy As Long buffwidth As Long palette As Long colors As Long imgtype As Long bmh As Long hBitmap As Long End Type Type TiffData ByteOrder As Long width As Long Length As Long BitsPSample As Long comp As Long SamplesPPixel As Long PhotoInt As Long PlanarCfg As Long vbitcount As Long End Type ' ............................... Function Declarations............................. Declare Function tiffinfofrombuffer Lib "VIC32.DLL" (ByRef bytearray_firstelement As Byte, tdat As TiffData) As Long Declare Function loadtiffrombuffer Lib "VIC32.DLL" (ByRef bytearray_firstelement As Byte, desimg As imgdes) As Long Declare Sub freeimage Lib "VIC32.DLL" (image As imgdes) Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long Public Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" _ (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, _ ByVal sProxyBypass As String, ByVal lFlags As Long) As Long Public Declare Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" _ (ByVal hOpen As Long, ByVal sUrl As String, ByVal sHeaders As String, _ ByVal lLength As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long Public Declare Function InternetReadFile Lib "wininet.dll" _ (ByVal hfile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, _ ByRef lNumberOfBytesRead As Long) As Integer Public Declare Function InternetReadBinaryFile Lib "wininet.dll" Alias "InternetReadFile" _ (ByVal hfile As Long, ByRef bytearray_firstelement As Byte, ByVal lNumBytesToRead As Long, _ ByRef lNumberOfBytesRead As Long) As Integer Public Declare Function InternetCloseHandle Lib "wininet.dll" _ (ByVal hInet As Long) As Integer Public Declare Function HttpQueryInfo Lib "wininet.dll" Alias "HttpQueryInfoA" (ByVal hOpen As Long, ByVal infotype As Long, _ ByVal buffer As String, ByRef bufferlength As Long, ByVal Index As Long) As Long Global Const NO_ERROR = 0 ' No error Public Const INTERNET_FLAG_RELOAD = &H80000000 Public Const INTERNET_OPEN_TYPE_PRECONFIG = 0 ' ............................... The Function ............................. Private Sub mnuinet_Click() Dim hOpen As Long Dim hOpenUrl As Long Dim rcode As Long Dim retval As Long Dim filesize As Long Dim byteArray() As Byte Dim tdat As TiffData Dim timage As imgdes Dim bufflen As Long Dim databuff As String * 8 Dim bytesread As Long Dim hMemDC As Long Dim hOldBitmap As Long Const SRCCOPY = &HCC0020 bufflen = Len(databuff) hOpen = InternetOpen("Victor Library Sample", INTERNET_OPEN_TYPE_PRECONFIG, 0, 0, 0) hOpenUrl = InternetOpenUrl(hOpen, "http://www.catenary.com/howto/1bit.tif", 0, 0, INTERNET_FLAG_RELOAD, 0) If (hOpenUrl > 0) Then retval = HttpQueryInfo(hOpenUrl, 5, databuff, bufflen, 0) 'HTTP_QUERY_CONTENT_LENGTH (5) Retrieves the size of the resource, in bytes. If (retval > 0) Then filesize = databuff ReDim byteArray(filesize + 1) As Byte ' Allocate space to hold the tiff file in memory retval = InternetReadBinaryFile(hOpenUrl, byteArray(0), filesize, bytesread) If (retval > 0) Then rcode = tiffinfofrombuffer(byteArray(0), tdat) If (rcode = NO_ERROR) Then rcode = allocimage(timage, tdat.width, tdat.length, tdat.vbitcount) If (rcode = NO_ERROR) Then rcode = loadtiffrombuffer(byteArray(0), timage) End If End If End If End If InternetCloseHandle (hOpenUrl) End If If hOpen <> 0 Then InternetCloseHandle (hOpen) ' Use Picture1, a picture box control, to display the tiff image hMemDC = CreateCompatibleDC(Picture1.hdc) hOldBitmap = SelectObject(hMemDC, timage.hBitmap) Picture1.width = tdat.width Picture1.height = tdat.length rcode = BitBlt(Picture1.hdc, 0, 0, tdat.width, tdat.length, hMemDC, 0, 0, SRCCOPY) Picture1.Refresh ' Not shown here, but do clean up when you're done. End Sub
Victor Image Processing Library homepage | Victor Product Summary | more source code