home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Chip 1999 June
/
Chip_1999-06_cd.bin
/
zkuste
/
VBasic
/
Data
/
Priklady
/
phatform.bas
< prev
next >
Wrap
BASIC Source File
|
1999-03-12
|
6KB
|
212 lines
Attribute VB_Name = "Module1"
Option Explicit
' Data type used by FillRect
Type RECT
Left As Integer
Top As Integer
Right As Integer
Bottom As Integer
End Type
' API Functions used to create solid brush and draw brush on form
Declare Function CreateSolidBrush Lib "GDI" (ByVal crColor As Long) As Integer
Declare Function FillRect Lib "User" (ByVal hDC As Integer, lpRect As RECT, ByVal hBrush As Integer) As Integer
Declare Function DeleteObject Lib "GDI" (ByVal hObject As Integer) As Integer
Dim hBrush%
Sub formdither(vForm As Form)
'This code works best when called in the paint event
Dim intLoop As Integer
On Error Resume Next
With vForm
.DrawStyle = vbInsideSolid
.DrawMode = vbCopyPen
.ScaleMode = vbPixels
.DrawWidth = 2
.ScaleHeight = 256
End With
For intLoop = 0 To 255
vForm.Line (0, intLoop)-(Screen.Width, intLoop - 1), RGB(0, 0, 255 - intLoop), B
Next intLoop
End Sub
Sub formfadeblue(Theform As Form)
'Example: formfadeblue Me
Dim hBrush%
Dim FormHeight%, red%, StepInterval%, x%, RetVal%, OldMode%
Dim FillArea As RECT
OldMode = Theform.ScaleMode
Theform.ScaleMode = 3 'Pixel
FormHeight = Theform.ScaleHeight
' Divide the form into 63 regions
StepInterval = FormHeight \ 63
red = 255
FillArea.Left = 0
FillArea.Right = Theform.ScaleWidth
FillArea.Top = 0
FillArea.Bottom = StepInterval
For x = 1 To 63
hBrush% = CreateSolidBrush(RGB(0, 0, red))
RetVal% = FillRect(Theform.hDC, FillArea, hBrush)
RetVal% = DeleteObject(hBrush)
red = red - 4
FillArea.Top = FillArea.Bottom
FillArea.Bottom = FillArea.Bottom + StepInterval
Next
' Fill the remainder of the form with black
FillArea.Bottom = FillArea.Bottom + 63
hBrush% = CreateSolidBrush(RGB(0, 0, 0))
RetVal% = FillRect(Theform.hDC, FillArea, hBrush)
RetVal% = DeleteObject(hBrush)
Theform.ScaleMode = OldMode
End Sub
Sub formfadeleet(Theform As Form)
'Example: put formfadeleet Me in Form_Paint
Dim w, B, i, y
Theform.BackColor = &H0&
Theform.DrawStyle = 6
Theform.DrawMode = 13
Theform.DrawWidth = 2
Theform.ScaleMode = 3
Theform.ScaleHeight = (256 * 2)
For w = 255 To 0 Step -1
Theform.Line (0, B)-(Theform.Width, B + 2), RGB(w + 3, w, w * 3), BF
B = B + 2
Next w
For i = 255 To 0 Step -1
Theform.Line (0, 0)-(Theform.Width, y + 2), RGB(i + 3, i, i * 3), BF
y = y + 2
Next i
End Sub
Sub formfadephat(Theform As Form)
'Example: put formfadephat Me in Form_Paint
Dim a, B
Theform.ScaleHeight = (256 * 2)
For a = 255 To 0 Step -1
Theform.Line (0, B)-(Theform.Width, B + 2), RGB(a + 3, a, a * 3), BF
B = B + 2
Next a
End Sub
Sub formfadepurple(Theform As Form)
'Example: formfadepurple Me
Dim hBrush%
Dim FormHeight%, red%, StepInterval%, x%, RetVal%, OldMode%
Dim FillArea As RECT
OldMode = Theform.ScaleMode
Theform.ScaleMode = 3 'Pixel
FormHeight = Theform.ScaleHeight
' Divide the form into 63 regions
StepInterval = FormHeight \ 63
red = 255
FillArea.Left = 0
FillArea.Right = Theform.ScaleWidth
FillArea.Top = 0
FillArea.Bottom = StepInterval
For x = 1 To 63
hBrush% = CreateSolidBrush(RGB(red, 0, red))
RetVal% = FillRect(Theform.hDC, FillArea, hBrush)
RetVal% = DeleteObject(hBrush)
red = red - 4
FillArea.Top = FillArea.Bottom
FillArea.Bottom = FillArea.Bottom + StepInterval
Next
' Fill the remainder of the form with black
FillArea.Bottom = FillArea.Bottom + 63
hBrush% = CreateSolidBrush(RGB(0, 0, 0))
RetVal% = FillRect(Theform.hDC, FillArea, hBrush)
RetVal% = DeleteObject(hBrush)
Theform.ScaleMode = OldMode
End Sub
Sub formfadered(Theform As Form)
' Example formfadered Me
Dim FormHeight%, Blue%, StepInterval%, x%, RetVal%, OldMode%
Dim FillArea As RECT
OldMode = Theform.ScaleMode
Theform.ScaleMode = 3 'Pixel
FormHeight = Theform.ScaleHeight
' Divide the form into 63 regions
StepInterval = FormHeight \ 63
Blue = 255
FillArea.Left = 0
FillArea.Right = Theform.ScaleWidth
FillArea.Top = 0
FillArea.Bottom = StepInterval
For x = 1 To 63
hBrush% = CreateSolidBrush(RGB(Blue, 0, 0))
RetVal% = FillRect(Theform.hDC, FillArea, hBrush)
RetVal% = DeleteObject(hBrush)
Blue = Blue - 4
FillArea.Top = FillArea.Bottom
FillArea.Bottom = FillArea.Bottom + StepInterval
Next
' Fill the remainder of the form with black
FillArea.Bottom = FillArea.Bottom + 63
hBrush% = CreateSolidBrush(RGB(0, 0, 0))
RetVal% = FillRect(Theform.hDC, FillArea, hBrush)
RetVal% = DeleteObject(hBrush)
Theform.ScaleMode = OldMode
End Sub
Sub formfadeteel(Theform As Form)
'Example: formfadeteel Me
Dim hBrush%
Dim FormHeight%, red%, StepInterval%, x%, RetVal%, OldMode%
Dim FillArea As RECT
OldMode = Theform.ScaleMode
Theform.ScaleMode = 3 'Pixel
FormHeight = Theform.ScaleHeight
' Divide the form into 63 regions
StepInterval = FormHeight \ 63
red = 255
FillArea.Left = 0
FillArea.Right = Theform.ScaleWidth
FillArea.Top = 0
FillArea.Bottom = StepInterval
For x = 1 To 63
hBrush% = CreateSolidBrush(RGB(0, red, red))
RetVal% = FillRect(Theform.hDC, FillArea, hBrush)
RetVal% = DeleteObject(hBrush)
red = red - 4
FillArea.Top = FillArea.Bottom
FillArea.Bottom = FillArea.Bottom + StepInterval
Next
' Fill the remainder of the form with black
FillArea.Bottom = FillArea.Bottom + 63
hBrush% = CreateSolidBrush(RGB(0, 0, 0))
RetVal% = FillRect(Theform.hDC, FillArea, hBrush)
RetVal% = DeleteObject(hBrush)
Theform.ScaleMode = OldMode
End Sub