vbAccelerator - Contents of code file: frmDemo.frmVERSION 5.00
Begin VB.Form frmFadeRectDemo
Caption = "vbAccelerator FadeRect Sample"
ClientHeight = 3945
ClientLeft = 3540
ClientTop = 3885
ClientWidth = 5460
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "frmDemo.frx":0000
LinkTopic = "Form1"
ScaleHeight = 3945
ScaleWidth = 5460
Begin VB.CheckBox chkForceFadeEffect
Caption = "&Force Fade Effect"
Enabled = 0 'False
Height = 255
Left = 120
TabIndex = 2
Top = 3300
Width = 4215
End
Begin VB.CommandButton Command1
Caption = "Click Me!"
Height = 555
Left = 1860
TabIndex = 0
Top = 2460
Width = 1515
End
Begin VB.Label lblInfo
Caption = $"frmDemo.frx":1272
Height = 1035
Left = 180
TabIndex = 1
Top = 120
Width = 5175
End
Begin VB.Image imgPicture
Height = 975
Left = 1200
Picture = "frmDemo.frx":138B
Top = 1440
Width = 2880
End
End
Attribute VB_Name = "frmFadeRectDemo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Type POINTAPI
x As Long
y As Long
End Type
Private Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long,
lpPoint As POINTAPI) As Long
Private m_cFade As fFadeRect
Private Sub chkForceFadeEffect_Click()
m_cFade.ForceFade = (chkForceFadeEffect.value = vbChecked)
End Sub
Private Sub Command1_Click()
Dim tP As POINTAPI
Dim lW As Long
Dim lH As Long
' By default, we fade from the desktop. ClientToScreen is the easiest way
' to determine where an item is on screen (VB gets confused about the
' difference between non-client areas and custom scaling...)
tP.x = Me.ScaleX(imgPicture.left, Me.ScaleMode, vbPixels)
tP.y = Me.ScaleY(imgPicture.top, Me.ScaleMode, vbPixels)
ClientToScreen Me.hwnd, tP
lW = Me.ScaleX(imgPicture.Width, Me.ScaleMode, vbPixels)
lH = Me.ScaleY((Command1.top + Command1.Height - imgPicture.top),
Me.ScaleMode, vbPixels)
' start the fader:
' Do this to make it very slow so you can see what happens:
'm_cFade.FadeStepSize = 1
m_cFade.FadeRect tP.x, tP.y, tP.x, tP.y, lW, lH
' fade out will continue after I've unloaded:
Unload Me
End Sub
Private Sub Form_Load()
Set m_cFade = New fFadeRect
chkForceFadeEffect.Enabled = Not (m_cFade.FadeEffectsSelected)
End Sub
|
|