home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / wecjvb10 / wecj.bas < prev    next >
Encoding:
BASIC Source File  |  1995-10-23  |  4.2 KB  |  136 lines
  1. Declare Function ECJ_Decode% Lib "WECJLIB.DLL" (ByVal Filen$, ByVal attrib%, ByVal ECJMessage&, ByVal ECJCallback&)
  2. Declare Function MakeDIBPalette% Lib "WECJDIB.DLL" (ByVal lpBmi&)
  3. Declare Function DibXY& Lib "WECJDIB.DLL" (ByVal lpBmi&, ByVal X%, ByVal Y%)
  4. Declare Function DibXSize% Lib "WECJDIB.DLL" (ByVal lpBmi&)
  5. Declare Function DibYSize% Lib "WECJDIB.DLL" (ByVal lpBmi&)
  6.  
  7. Declare Function DeleteObject% Lib "GDI" (ByVal hObject%)
  8. Declare Function SetDIBitsToDevice% Lib "GDI" (ByVal hDC%, ByVal X%, ByVal Y%, ByVal dX%, ByVal dY%, ByVal SrcX%, ByVal SrcY%, ByVal Scan%, ByVal NumScans%, ByVal Bits&, ByVal BitsInfo&, ByVal wUsage%)
  9. Declare Function StretchDIBits% Lib "GDI" (ByVal hDC%, ByVal X%, ByVal Y%, ByVal dX%, ByVal dY%, ByVal SrcX%, ByVal SrcY%, ByVal wSrcWidth%, ByVal wSrcHeight%, ByVal lpbits&, ByVal lpBitsInfo&, ByVal wUsage%, ByVal dwRop&)
  10. Declare Function SetStretchBltMode% Lib "GDI" (ByVal hDC%, ByVal nStretchMode%)
  11.  
  12. Declare Function SelectPalette% Lib "User" (ByVal hDC%, ByVal hPalette%, ByVal bForceBackground%)
  13. Declare Function RealizePalette% Lib "User" (ByVal hDC%)
  14. Declare Function GetSystemMetrics% Lib "User" (ByVal nIndex%)
  15.  
  16. Declare Function GlobalLock& Lib "Kernel" (ByVal hMem%)
  17. Declare Function GlobalUnlock% Lib "Kernel" (ByVal hMem%)
  18.  
  19. Global Const SM_CYCAPTION = 4
  20. Global Const SM_CYMENU = 15
  21. Global Const SM_CXFRAME = 32
  22. Global Const SM_CYFRAME = 33
  23.  
  24. Global Const SRCCOPY = &HCC0020
  25. Global Const STRETCH_DELETESCANS = 3
  26.  
  27. Global Const OFN_HIDEREADONLY = &H4&
  28.  
  29. Global Const ECJ_HALF_SIZE = 1
  30. Global Const ECJ_AUTO_SIZE = 2
  31. Global Const ECJ_GRAY_ONLY = 4
  32. Global Const ECJ_2_PASS = 8
  33. Global Const ECJ_DITHER = 16
  34. Global Const ECJ_24_BITS = 32
  35. Global Const ECJ_4_SIZE = 64
  36. Global Const ECJ_8_SIZE = 128
  37.  
  38. Global attributes As Integer
  39. Global hDib As Integer
  40. Global hPalette As Integer
  41. Global holdpal As Integer
  42. Global filename As String * 80
  43.  
  44. Global maxX As Integer
  45. Global maxY As Integer
  46. Global ExtraX As Integer
  47. Global ExtraY As Integer
  48.  
  49.  
  50. Function Paint_DIB (ByVal hDC%, ByVal hDib%)
  51.  
  52. Dim lpbmih As Long
  53. Dim wx As Integer
  54. Dim wy As Integer
  55. Dim lpbits As Long
  56.  
  57.     If (hDib > 0) Then
  58.     lpbmih = GlobalLock(hDib)
  59.     If (hPalette > 0) Then
  60.         dum% = SelectPalette(hDC, holdpal, False)
  61.         dum% = DeleteObject(hPalette)
  62.     End If
  63.     hPalette = MakeDIBPalette(lpbmih)
  64.     holdpal = SelectPalette(hDC, hPalette, False)
  65.     dum% = RealizePalette(hDC)
  66.     wx = DibXSize(lpbmih)
  67.     wy = DibYSize(lpbmih)
  68.     lpbits = DibXY(lpbmih, 0, 0)
  69.     dum% = SetDIBitsToDevice(hDC, 0, 0, wx, wy, 0, 0, 0, wy, lpbits, lpbmih, DIB_RGB_COLORS)
  70.     dum% = GlobalUnlock(hDib)
  71.    End If
  72. End Function
  73.  
  74. Function Paint_DIBStretch (ByVal hDC%, ByVal hDib%)
  75. Dim lpbmih As Long
  76. Dim wx As Integer
  77. Dim wy As Integer
  78. Dim dwx As Integer
  79. Dim dwy As Integer
  80. Dim lpbits As Long
  81.  
  82.     If (hDib > 0) Then
  83.     lpbmih = GlobalLock(hDib)
  84.     If (hPalette > 0) Then
  85.         dum% = SelectPalette(hDC, holdpal, False)
  86.         dum% = DeleteObject(hPalette)
  87.     End If
  88.     hPalette = MakeDIBPalette(lpbmih)
  89.     holdpal = SelectPalette(hDC, hPalette, False)
  90.     dum% = RealizePalette(hDC)
  91.     wx = DibXSize(lpbmih)
  92.     wy = DibYSize(lpbmih)
  93.     dwx = Int(Form1.ScaleWidth)
  94.     dwy = Int(Form1.ScaleHeight)
  95.     lpbits = DibXY(lpbmih, 0, 0)
  96.     dum% = StretchDIBits(hDC, 0, 0, dwx, dwy, 0, 0, wx, wy, lpbits, lpbmih, DIB_RGB_COLORS, SRCCOPY)
  97.     dum% = GlobalUnlock(hDib)
  98.    End If
  99.  
  100. End Function
  101.  
  102. Sub ScaleForm (ByVal hDib%)
  103.  
  104. Dim nYsize As Integer
  105. Dim nXsize As Integer
  106. Dim wx As Integer
  107. Dim wy As Integer
  108. Dim rx As Single
  109. Dim ry As Single
  110.  
  111.     If (hDib > 0) Then
  112.     lpbmih = GlobalLock(hDib)
  113.     wx = DibXSize(lpbmih)
  114.     wy = DibYSize(lpbmih)
  115.     If ((wx > maxX) Or (wy > maxY)) Then
  116.         ry = wy / maxY
  117.         rx = wx / maxX
  118.         If (ry > rx) Then
  119.         nYsize = Int(wy / ry)
  120.         nXsize = Int(wx / ry)
  121.         Form1.Height = Screen.TwipsPerPixelY * (nYsize + ExtraX)
  122.         Form1.Width = Screen.TwipsPerPixelX * (nXsize + ExtraY)
  123.          Else
  124.         nYsize = Int(wy / rx)
  125.         nXsize = Int(wx / rx)
  126.         Form1.Height = Screen.TwipsPerPixelY * (nYsize + ExtraX)
  127.         Form1.Width = Screen.TwipsPerPixelX * (nXsize + ExtraY)
  128.         End If
  129.     Else
  130.         Form1.Height = Screen.TwipsPerPixelY * (wy + ExtraY)
  131.         Form1.Width = Screen.TwipsPerPixelX * (wx + ExtraX)
  132.     End If
  133.    End If
  134. End Sub
  135.  
  136.