home *** CD-ROM | disk | FTP | other *** search
/ Chip 1999 June / Chip_1999-06_cd.bin / zkuste / VBasic / Data / Priklady / phatform.bas < prev    next >
BASIC Source File  |  1999-03-12  |  6KB  |  212 lines
  1. Attribute VB_Name = "Module1"
  2. Option Explicit
  3.  
  4. '  Data type used by FillRect
  5. Type RECT
  6.     Left As Integer
  7.     Top As Integer
  8.     Right As Integer
  9.     Bottom As Integer
  10. End Type
  11.  
  12. '  API Functions used to create solid brush and draw brush on form
  13. Declare Function CreateSolidBrush Lib "GDI" (ByVal crColor As Long) As Integer
  14. Declare Function FillRect Lib "User" (ByVal hDC As Integer, lpRect As RECT, ByVal hBrush As Integer) As Integer
  15. Declare Function DeleteObject Lib "GDI" (ByVal hObject As Integer) As Integer
  16.  
  17. Dim hBrush%
  18.  
  19.  
  20. Sub formdither(vForm As Form)
  21.   'This code works best when called in the paint event
  22.   Dim intLoop As Integer
  23.  
  24.   On Error Resume Next
  25.  
  26.   With vForm
  27.     .DrawStyle = vbInsideSolid
  28.     .DrawMode = vbCopyPen
  29.     .ScaleMode = vbPixels
  30.     .DrawWidth = 2
  31.     .ScaleHeight = 256
  32.   End With
  33.  
  34.   For intLoop = 0 To 255
  35.     vForm.Line (0, intLoop)-(Screen.Width, intLoop - 1), RGB(0, 0, 255 - intLoop), B
  36.   Next intLoop
  37. End Sub
  38.  
  39. Sub formfadeblue(Theform As Form)
  40.  
  41. 'Example: formfadeblue Me
  42.  
  43. Dim hBrush%
  44.     Dim FormHeight%, red%, StepInterval%, x%, RetVal%, OldMode%
  45.     Dim FillArea As RECT
  46.     OldMode = Theform.ScaleMode
  47.     Theform.ScaleMode = 3  'Pixel
  48.     FormHeight = Theform.ScaleHeight
  49. ' Divide the form into 63 regions
  50.     StepInterval = FormHeight \ 63
  51.     red = 255
  52.     FillArea.Left = 0
  53.     FillArea.Right = Theform.ScaleWidth
  54.     FillArea.Top = 0
  55.     FillArea.Bottom = StepInterval
  56.     For x = 1 To 63
  57.        hBrush% = CreateSolidBrush(RGB(0, 0, red))
  58.     
  59.         RetVal% = FillRect(Theform.hDC, FillArea, hBrush)
  60.         RetVal% = DeleteObject(hBrush)
  61.         red = red - 4
  62.         FillArea.Top = FillArea.Bottom
  63.         FillArea.Bottom = FillArea.Bottom + StepInterval
  64.     Next
  65. ' Fill the remainder of the form with black
  66.     FillArea.Bottom = FillArea.Bottom + 63
  67.     hBrush% = CreateSolidBrush(RGB(0, 0, 0))
  68.     RetVal% = FillRect(Theform.hDC, FillArea, hBrush)
  69.     RetVal% = DeleteObject(hBrush)
  70.     Theform.ScaleMode = OldMode
  71. End Sub
  72.  
  73. Sub formfadeleet(Theform As Form)
  74.  
  75. 'Example: put formfadeleet Me in Form_Paint
  76.  
  77. Dim w, B, i, y
  78. Theform.BackColor = &H0&
  79. Theform.DrawStyle = 6
  80. Theform.DrawMode = 13
  81.  
  82. Theform.DrawWidth = 2
  83. Theform.ScaleMode = 3
  84. Theform.ScaleHeight = (256 * 2)
  85. For w = 255 To 0 Step -1
  86. Theform.Line (0, B)-(Theform.Width, B + 2), RGB(w + 3, w, w * 3), BF
  87.  
  88. B = B + 2
  89. Next w
  90.  
  91. For i = 255 To 0 Step -1
  92. Theform.Line (0, 0)-(Theform.Width, y + 2), RGB(i + 3, i, i * 3), BF
  93. y = y + 2
  94. Next i
  95. End Sub
  96.  
  97. Sub formfadephat(Theform As Form)
  98.  
  99. 'Example: put formfadephat Me in Form_Paint
  100.  
  101. Dim a, B
  102. Theform.ScaleHeight = (256 * 2)
  103. For a = 255 To 0 Step -1
  104. Theform.Line (0, B)-(Theform.Width, B + 2), RGB(a + 3, a, a * 3), BF
  105. B = B + 2
  106. Next a
  107. End Sub
  108.  
  109. Sub formfadepurple(Theform As Form)
  110.  
  111. 'Example: formfadepurple Me
  112.  
  113. Dim hBrush%
  114.     Dim FormHeight%, red%, StepInterval%, x%, RetVal%, OldMode%
  115.     Dim FillArea As RECT
  116.     OldMode = Theform.ScaleMode
  117.     Theform.ScaleMode = 3  'Pixel
  118.     FormHeight = Theform.ScaleHeight
  119. ' Divide the form into 63 regions
  120.     StepInterval = FormHeight \ 63
  121.     red = 255
  122.     FillArea.Left = 0
  123.     FillArea.Right = Theform.ScaleWidth
  124.     FillArea.Top = 0
  125.     FillArea.Bottom = StepInterval
  126.     For x = 1 To 63
  127.    
  128.          hBrush% = CreateSolidBrush(RGB(red, 0, red))
  129.         RetVal% = FillRect(Theform.hDC, FillArea, hBrush)
  130.         RetVal% = DeleteObject(hBrush)
  131.         red = red - 4
  132.         FillArea.Top = FillArea.Bottom
  133.         FillArea.Bottom = FillArea.Bottom + StepInterval
  134.     Next
  135. ' Fill the remainder of the form with black
  136.     FillArea.Bottom = FillArea.Bottom + 63
  137.     hBrush% = CreateSolidBrush(RGB(0, 0, 0))
  138.     RetVal% = FillRect(Theform.hDC, FillArea, hBrush)
  139.     RetVal% = DeleteObject(hBrush)
  140.     Theform.ScaleMode = OldMode
  141.  
  142. End Sub
  143.  
  144. Sub formfadered(Theform As Form)
  145.     
  146. ' Example formfadered Me
  147.  
  148.     Dim FormHeight%, Blue%, StepInterval%, x%, RetVal%, OldMode%
  149.     Dim FillArea As RECT
  150.     OldMode = Theform.ScaleMode
  151.     Theform.ScaleMode = 3  'Pixel
  152.     FormHeight = Theform.ScaleHeight
  153. ' Divide the form into 63 regions
  154.     StepInterval = FormHeight \ 63
  155.     Blue = 255
  156.     FillArea.Left = 0
  157.     FillArea.Right = Theform.ScaleWidth
  158.     FillArea.Top = 0
  159.     FillArea.Bottom = StepInterval
  160.     For x = 1 To 63
  161.         hBrush% = CreateSolidBrush(RGB(Blue, 0, 0))
  162.         RetVal% = FillRect(Theform.hDC, FillArea, hBrush)
  163.         RetVal% = DeleteObject(hBrush)
  164.         Blue = Blue - 4
  165.         FillArea.Top = FillArea.Bottom
  166.         FillArea.Bottom = FillArea.Bottom + StepInterval
  167.     Next
  168. ' Fill the remainder of the form with black
  169.     FillArea.Bottom = FillArea.Bottom + 63
  170.     hBrush% = CreateSolidBrush(RGB(0, 0, 0))
  171.     RetVal% = FillRect(Theform.hDC, FillArea, hBrush)
  172.     RetVal% = DeleteObject(hBrush)
  173.     Theform.ScaleMode = OldMode
  174. End Sub
  175.  
  176. Sub formfadeteel(Theform As Form)
  177.  
  178. 'Example: formfadeteel Me
  179.  
  180. Dim hBrush%
  181.     Dim FormHeight%, red%, StepInterval%, x%, RetVal%, OldMode%
  182.     Dim FillArea As RECT
  183.     OldMode = Theform.ScaleMode
  184.     Theform.ScaleMode = 3  'Pixel
  185.     FormHeight = Theform.ScaleHeight
  186. ' Divide the form into 63 regions
  187.     StepInterval = FormHeight \ 63
  188.     red = 255
  189.     FillArea.Left = 0
  190.     FillArea.Right = Theform.ScaleWidth
  191.     FillArea.Top = 0
  192.     FillArea.Bottom = StepInterval
  193.     For x = 1 To 63
  194.    
  195.          hBrush% = CreateSolidBrush(RGB(0, red, red))
  196.         RetVal% = FillRect(Theform.hDC, FillArea, hBrush)
  197.         RetVal% = DeleteObject(hBrush)
  198.         red = red - 4
  199.         FillArea.Top = FillArea.Bottom
  200.         FillArea.Bottom = FillArea.Bottom + StepInterval
  201.     Next
  202. ' Fill the remainder of the form with black
  203.     FillArea.Bottom = FillArea.Bottom + 63
  204.     hBrush% = CreateSolidBrush(RGB(0, 0, 0))
  205.     RetVal% = FillRect(Theform.hDC, FillArea, hBrush)
  206.     RetVal% = DeleteObject(hBrush)
  207.     Theform.ScaleMode = OldMode
  208.  
  209.  
  210. End Sub
  211.  
  212.