home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / jpegvu / jpegvb3.bas < prev    next >
Encoding:
BASIC Source File  |  1996-09-13  |  3.8 KB  |  95 lines
  1. 'Attribute VB_Name = "JPEGBASIC"
  2. Type BITMAPINFOHEADER '40 bytes
  3.         biSize As Long
  4.         biwidth As Long
  5.         biheight As Long
  6.         biPlanes As Integer
  7.         biBitCount As Integer
  8.         biCompression As Long
  9.         biSizeImage As Long
  10.         biXPelsPerMeter As Long
  11.         biYPelsPerMeter As Long
  12.         biClrUsed As Long
  13.         biClrImportant As Long
  14. End Type
  15.  
  16. Type BITMAPINFO   'Varies
  17.         bmiHeader As BITMAPINFOHEADER
  18.         bmiColors As String * 256 ' Array length is arbitrary; may be changed
  19. End Type
  20.  
  21. Declare Function rfile Lib "c:\windows\system\imglib16.dll" Alias "ReadFileIntoDIB" (ByVal st As String) As Long
  22. Declare Function BITMHead Lib "c:\windows\system\Dibinfo.dll" (ByVal ldib As Long, lpinfo As BITMAPINFO) As Long
  23. Declare Sub DIBFree Lib "c:\windows\system\imglib16.dll" (ByVal ldib As Long)
  24. Declare Function CreateDIBitmap Lib "GDI" (ByVal hDC As Integer, lpInfoHeader As BITMAPINFOHEADER, ByVal dwUsage As Long, ByVal lpInitBits As Long, lpInitInfo As BITMAPINFO, ByVal wUsage As Integer) As Integer
  25. Declare Function DeleteObject Lib "GDI" (ByVal hDC As Integer) As Integer
  26. Declare Function CreateCompatibleDC Lib "GDI" (ByVal hDC As Integer) As Integer
  27. Declare Function DeleteDC Lib "GDI" (ByVal hDC As Integer) As Integer
  28. Declare Function StretchBlt% Lib "GDI" (ByVal hDC%, ByVal x%, ByVal y%, ByVal nWidth%, ByVal nHeight%, ByVal hSrcDC%, ByVal XSrc%, ByVal YSrc%, ByVal nSrcWidth%, ByVal nSrcHeight%, ByVal dwrop&)
  29. Declare Function SelectObject% Lib "GDI" (ByVal hDC%, ByVal x%)
  30.  
  31.  
  32. Global Const CBM_INIT = &H4&
  33. Global bih As BITMAPINFOHEADER
  34. Global bi As BITMAPINFO
  35. Global ldib As Long
  36. Global lbits As Long
  37. Global nam$
  38. Global jpegnum
  39.  
  40. Sub displayjpeg ()
  41.  
  42. nam$ = "c:\vb\kimdog.jpg"
  43.  
  44. 'main DLL, imglib.dll takes JPEG file nam$, decodes it and stores it as
  45. 'a Device Independent Bitmap ie a DIB
  46.   ldib = rfile(nam$)
  47.  
  48. 'second DLL,dibinfo.dll extracts the BITMAPINFO from the DIB
  49. 'that is the size of the image x and y number of colours etc
  50.    lbits = BITMHead(ldib, bi)
  51. 'lbits = 4445
  52. 'print on screen DIB diagnostic information
  53.    ' Form1.Picture1.CurrentX = 0
  54.     'Form1.Picture1.CurrentY = 0
  55.     form1.Picture1.Print "dib "; ldib
  56.     form1.Picture1.Print "return "; lbits
  57.  
  58. 'extract a subset of image info, the BITMAPHEADERINFO
  59. 'from the BITMAPINFO
  60.     LSet bih = bi.bmiHeader
  61.  
  62. 'print on screen the JPEG image information
  63.     form1.Picture2.CurrentX = 0
  64.     form1.Picture2.CurrentY = 0
  65.     form1.Picture2.Print "size  "; bih.biSize
  66.     form1.Picture2.Print "width  "; bih.biwidth
  67.     form1.Picture2.Print "height  "; bih.biheight
  68.     form1.Picture2.Print "number planes"; bih.biPlanes
  69.     form1.Picture2.Print "bits/colour  "; bih.biBitCount
  70.     form1.Picture2.Print "compression  "; bih.biCompression
  71.     form1.Picture2.Print "bit size image  "; bih.biSizeImage
  72.     form1.Picture2.Print "x pixels/metre  "; bih.biXPelsPerMeter
  73.     form1.Picture2.Print "y pixels/metre  "; bih.biYPelsPerMeter
  74.     form1.Picture2.Print "colours used  "; bih.biClrUsed
  75.     form1.Picture2.Print "colour important  "; bih.biClrImportant
  76.  
  77. 'go through process of displaying image on Form1
  78.     du% = CreateDIBitmap(form1.hDC, bih, CBM_INIT, lbits, bi, 0)
  79.     DIBFree (ldib) 'free up DIB memory ready for next JPEG image
  80.     hm% = CreateCompatibleDC(form1.hDC)
  81.     holdmap% = SelectObject(hm%, du%)
  82.     src& = &HCC0020 ' constant needed for Stretchblit
  83.     'main display Windows API function
  84.     m% = StretchBlt%(form1.hDC, 90, 30, 400, 300, hm%, 0, 0, bih.biwidth, bih.biheight, src&)
  85.     dummy% = SelectObject(hm%, holdmap%)
  86.     dummy% = DeleteObject(du%)
  87.     dummy% = DeleteDC(hm%)
  88.     
  89.     form1.Picture3.Print du% 'diagnostics
  90.     form1.Picture3.Print holdmap% 'diagnostics
  91.     form1.Picture3.Print m% 'diagnostics
  92.  
  93. End Sub
  94.  
  95.