ThreedLabel.ctl

 VERSION 5.00
Begin VB.UserControl ThreedLabel
   AutoRedraw      =   -1  'True
   ClientHeight    =   255
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   1005
   ScaleHeight     =   255
   ScaleWidth      =   1005
   ToolboxBitmap   =   "ThreedLabel.ctx":0000
   Begin VB.Label Label1
      Caption         =   "ThreedLabel"
      Height          =   495
      Left            =   2400
      TabIndex        =   0
      Top             =   240
      Visible         =   0   'False
      Width           =   1215
   End
End
Attribute VB_Name = "ThreedLabel"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
'Programmed by Mahadevan.S
'If you have any comments or suggestions please
'email me at kaushik_s87@yahoo.com
'Enjoy!
'Default Property Values:
Const m_def_Shadow = 6
Const m_def_Xdiff = 10
Const m_def_Ydiff = 10
Const m_def_FC_Red = 255
Const m_def_FC_Green = 255
Const m_def_FC_Blue = 255
Const m_def_Direction = 1
'Property Variables:
Dim m_Shadow As Integer
Dim m_Xdiff As Integer
Dim m_Ydiff As Integer
Dim m_FC_Red As Integer
Dim m_FC_Green As Integer
Dim m_FC_Blue As Integer
Dim m_Direction As Integer
'Event Declarations:
Event Click() 'MappingInfo=UserControl,UserControl,-1,Click
Attribute Click.VB_Description = "Occurs when the user presses and then releases a mouse button over an object."
Event DblClick() 'MappingInfo=UserControl,UserControl,-1,DblClick
Attribute DblClick.VB_Description = "Occurs when the user presses and releases a mouse button and then presses and releases it again over an object."
Event KeyDown(KeyCode As Integer, Shift As Integer) 'MappingInfo=UserControl,UserControl,-1,KeyDown
Attribute KeyDown.VB_Description = "Occurs when the user presses a key while an object has the focus."
Event KeyPress(KeyAscii As Integer) 'MappingInfo=UserControl,UserControl,-1,KeyPress
Attribute KeyPress.VB_Description = "Occurs when the user presses and releases an ANSI key."
Event KeyUp(KeyCode As Integer, Shift As Integer) 'MappingInfo=UserControl,UserControl,-1,KeyUp
Attribute KeyUp.VB_Description = "Occurs when the user releases a key while an object has the focus."
Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=UserControl,UserControl,-1,MouseDown
Attribute MouseDown.VB_Description = "Occurs when the user presses the mouse button while an object has the focus."
Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=UserControl,UserControl,-1,MouseMove
Attribute MouseMove.VB_Description = "Occurs when the user moves the mouse."
Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=UserControl,UserControl,-1,MouseUp
Attribute MouseUp.VB_Description = "Occurs when the user releases the mouse button while an object has the focus."

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,BackColor
Public Property Get BackColor() As OLE_COLOR
Attribute BackColor.VB_Description = "Returns/sets the background color used to display text and graphics in an object."
    BackColor = UserControl.BackColor
End Property

Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
    UserControl.BackColor() = New_BackColor
    Create3DEffect m_Shadow, m_Xdiff, m_Ydiff, Label1.Caption, m_FC_Red, m_FC_Green, m_FC_Blue, m_Direction
    PropertyChanged "BackColor"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,Enabled
Public Property Get Enabled() As Boolean
Attribute Enabled.VB_Description = "Returns/sets a value that determines whether an object can respond to user-generated events."
    Enabled = UserControl.Enabled
End Property

Public Property Let Enabled(ByVal New_Enabled As Boolean)
    UserControl.Enabled() = New_Enabled
    Create3DEffect m_Shadow, m_Xdiff, m_Ydiff, Label1.Caption, m_FC_Red, m_FC_Green, m_FC_Blue, m_Direction
    PropertyChanged "Enabled"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,Font
Public Property Get Font() As Font
Attribute Font.VB_Description = "Returns a Font object."
Attribute Font.VB_UserMemId = -512
    Set Font = UserControl.Font
End Property

Public Property Set Font(ByVal New_Font As Font)
    Set UserControl.Font = New_Font
    Create3DEffect m_Shadow, m_Xdiff, m_Ydiff, Label1.Caption, m_FC_Red, m_FC_Green, m_FC_Blue, m_Direction
    PropertyChanged "Font"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,BorderStyle
Public Property Get BorderStyle() As Integer
Attribute BorderStyle.VB_Description = "Returns/sets the border style for an object."
    BorderStyle = UserControl.BorderStyle
End Property

Public Property Let BorderStyle(ByVal New_BorderStyle As Integer)
    UserControl.BorderStyle() = New_BorderStyle
    Create3DEffect m_Shadow, m_Xdiff, m_Ydiff, Label1.Caption, m_FC_Red, m_FC_Green, m_FC_Blue, m_Direction
    PropertyChanged "BorderStyle"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,Refresh
Public Sub Refresh()
Attribute Refresh.VB_Description = "Forces a complete repaint of a object."
    UserControl.Refresh
    Create3DEffect m_Shadow, m_Xdiff, m_Ydiff, Label1.Caption, m_FC_Red, m_FC_Green, m_FC_Blue, m_Direction
End Sub

Private Sub Label1_Change()
Create3DEffect m_Shadow, m_Xdiff, m_Ydiff, Label1.Caption, m_FC_Red, m_FC_Green, m_FC_Blue, m_Direction
End Sub


Private Sub UserControl_Click()
    RaiseEvent Click
End Sub

Private Sub UserControl_DblClick()
    RaiseEvent DblClick
End Sub

Private Sub UserControl_Initialize()
Create3DEffect 6, 10, 10, Label1.Caption, 255, 255, 255, 1
End Sub

Private Sub UserControl_KeyDown(KeyCode As Integer, Shift As Integer)
    RaiseEvent KeyDown(KeyCode, Shift)
End Sub

Private Sub UserControl_KeyPress(KeyAscii As Integer)
    RaiseEvent KeyPress(KeyAscii)
End Sub

Private Sub UserControl_KeyUp(KeyCode As Integer, Shift As Integer)
    RaiseEvent KeyUp(KeyCode, Shift)
End Sub

Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    RaiseEvent MouseDown(Button, Shift, X, Y)
End Sub

Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    RaiseEvent MouseMove(Button, Shift, X, Y)
End Sub

Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    RaiseEvent MouseUp(Button, Shift, X, Y)
End Sub

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,hWnd
Public Property Get hWnd() As Long
Attribute hWnd.VB_Description = "Returns a handle (from Microsoft Windows) to an object's window."
    hWnd = UserControl.hWnd
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,Picture
Public Property Get Picture() As Picture
Attribute Picture.VB_Description = "Returns/sets a graphic to be displayed in a control."
    Set Picture = UserControl.Picture
    Create3DEffect m_Shadow, m_Xdiff, m_Ydiff, Label1.Caption, m_FC_Red, m_FC_Green, m_FC_Blue, m_Direction
End Property

Public Property Set Picture(ByVal New_Picture As Picture)
    Set UserControl.Picture = New_Picture
    Create3DEffect m_Shadow, m_Xdiff, m_Ydiff, Label1.Caption, m_FC_Red, m_FC_Green, m_FC_Blue, m_Direction
    PropertyChanged "Picture"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=0
Public Function Generate3DFx() As Boolean
Create3DEffect m_Shadow, m_Xdiff, m_Ydiff, Label1.Caption, m_FC_Red, m_FC_Green, m_FC_Blue, m_Direction
End Function

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=7,0,0,6
Public Property Get Shadow() As Integer
    Shadow = m_Shadow
End Property

Public Property Let Shadow(ByVal New_Shadow As Integer)
    m_Shadow = New_Shadow
    Create3DEffect m_Shadow, m_Xdiff, m_Ydiff, Label1.Caption, m_FC_Red, m_FC_Green, m_FC_Blue, m_Direction
    PropertyChanged "Shadow"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=7,0,0,10
Public Property Get Xdiff() As Integer
    Xdiff = m_Xdiff
End Property

Public Property Let Xdiff(ByVal New_Xdiff As Integer)
    m_Xdiff = New_Xdiff
    Create3DEffect m_Shadow, m_Xdiff, m_Ydiff, Label1.Caption, m_FC_Red, m_FC_Green, m_FC_Blue, m_Direction
    PropertyChanged "Xdiff"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=7,0,0,10
Public Property Get Ydiff() As Integer
    Ydiff = m_Ydiff
End Property

Public Property Let Ydiff(ByVal New_Ydiff As Integer)
    m_Ydiff = New_Ydiff
    Create3DEffect m_Shadow, m_Xdiff, m_Ydiff, Label1.Caption, m_FC_Red, m_FC_Green, m_FC_Blue, m_Direction
    PropertyChanged "Ydiff"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=7,0,0,255
Public Property Get FC_Red() As Integer
    FC_Red = m_FC_Red
End Property

Public Property Let FC_Red(ByVal New_FC_Red As Integer)
    m_FC_Red = New_FC_Red
    Create3DEffect m_Shadow, m_Xdiff, m_Ydiff, Label1.Caption, m_FC_Red, m_FC_Green, m_FC_Blue, m_Direction
    PropertyChanged "FC_Red"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=7,0,0,255
Public Property Get FC_Green() As Integer
    FC_Green = m_FC_Green
End Property

Public Property Let FC_Green(ByVal New_FC_Green As Integer)
    m_FC_Green = New_FC_Green
    Create3DEffect m_Shadow, m_Xdiff, m_Ydiff, Label1.Caption, m_FC_Red, m_FC_Green, m_FC_Blue, m_Direction
    PropertyChanged "FC_Green"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=7,0,0,255
Public Property Get FC_Blue() As Integer
    FC_Blue = m_FC_Blue
End Property

Public Property Let FC_Blue(ByVal New_FC_Blue As Integer)
    m_FC_Blue = New_FC_Blue
    Create3DEffect m_Shadow, m_Xdiff, m_Ydiff, Label1.Caption, m_FC_Red, m_FC_Green, m_FC_Blue, m_Direction
    PropertyChanged "FC_Blue"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=7,0,0,1
Public Property Get Direction() As Integer
    Direction = m_Direction
End Property

Public Property Let Direction(ByVal New_Direction As Integer)
    m_Direction = New_Direction
    Create3DEffect m_Shadow, m_Xdiff, m_Ydiff, Label1.Caption, m_FC_Red, m_FC_Green, m_FC_Blue, m_Direction
    PropertyChanged "Direction"
End Property
Public Property Get Caption() As String
Caption = Label1.Caption
End Property
Public Property Let Caption(ByVal New_Caption As String)
Label1.Caption = New_Caption
Create3DEffect m_Shadow, m_Xdiff, m_Ydiff, Label1.Caption, m_FC_Red, m_FC_Green, m_FC_Blue, m_Direction
PropertyChanged "Caption"
End Property
'Initialize Properties for User Control
Private Sub UserControl_InitProperties()
    Set UserControl.Font = Ambient.Font
    m_Shadow = m_def_Shadow
    m_Xdiff = m_def_Xdiff
    m_Ydiff = m_def_Ydiff
    m_FC_Red = m_def_FC_Red
    m_FC_Green = m_def_FC_Green
    m_FC_Blue = m_def_FC_Blue
    m_Direction = m_def_Direction
End Sub

'Load property values from storage
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    UserControl.BackColor = PropBag.ReadProperty("BackColor", &H8000000F)
    UserControl.Enabled = PropBag.ReadProperty("Enabled", True)
    Set UserControl.Font = PropBag.ReadProperty("Font", Ambient.Font)
    UserControl.BorderStyle = PropBag.ReadProperty("BorderStyle", 0)
    Set Picture = PropBag.ReadProperty("Picture", Nothing)
    Label1.Caption = PropBag.ReadProperty("Caption", "ThreedLabel")
    m_Shadow = PropBag.ReadProperty("Shadow", m_def_Shadow)
    m_Xdiff = PropBag.ReadProperty("Xdiff", m_def_Xdiff)
    m_Ydiff = PropBag.ReadProperty("Ydiff", m_def_Ydiff)
    m_FC_Red = PropBag.ReadProperty("FC_Red", m_def_FC_Red)
    m_FC_Green = PropBag.ReadProperty("FC_Green", m_def_FC_Green)
    m_FC_Blue = PropBag.ReadProperty("FC_Blue", m_def_FC_Blue)
    m_Direction = PropBag.ReadProperty("Direction", m_def_Direction)
End Sub

Private Sub UserControl_Resize()
    Create3DEffect m_Shadow, m_Xdiff, m_Ydiff, Label1.Caption, m_FC_Red, m_FC_Green, m_FC_Blue, m_Direction
End Sub

Private Sub UserControl_Show()
    Create3DEffect m_Shadow, m_Xdiff, m_Ydiff, Label1.Caption, m_FC_Red, m_FC_Green, m_FC_Blue, m_Direction
End Sub

Private Sub UserControl_Terminate()
    Create3DEffect m_Shadow, m_Xdiff, m_Ydiff, Label1.Caption, m_FC_Red, m_FC_Green, m_FC_Blue, m_Direction
End Sub

'Write property values to storage
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    Call PropBag.WriteProperty("BackColor", UserControl.BackColor, &H8000000F)
    Call PropBag.WriteProperty("Enabled", UserControl.Enabled, True)
    Call PropBag.WriteProperty("Font", UserControl.Font, Ambient.Font)
    Call PropBag.WriteProperty("BorderStyle", UserControl.BorderStyle, 0)
    Call PropBag.WriteProperty("Caption", Label1.Caption, "ThreedLabel")
    Call PropBag.WriteProperty("Picture", Picture, Nothing)
    Call PropBag.WriteProperty("Shadow", m_Shadow, m_def_Shadow)
    Call PropBag.WriteProperty("Xdiff", m_Xdiff, m_def_Xdiff)
    Call PropBag.WriteProperty("Ydiff", m_Ydiff, m_def_Ydiff)
    Call PropBag.WriteProperty("FC_Red", m_FC_Red, m_def_FC_Red)
    Call PropBag.WriteProperty("FC_Green", m_FC_Green, m_def_FC_Green)
    Call PropBag.WriteProperty("FC_Blue", m_FC_Blue, m_def_FC_Blue)
    Call PropBag.WriteProperty("Direction", m_Direction, m_def_Direction)
End Sub

Private Function Create3DEffect(Shadow As Integer, Xdiff As Integer, Ydiff As Integer, StrText As String, r As Integer, g As Integer, b As Integer, Direction As Integer)
On Error GoTo hell:
Dim I As Integer
Dim X As Integer, Y As Integer
Dim Red As Integer, Blue As Integer, Green As Integer
UserControl.Cls
Red = 0: Green = 0: Blue = 0
For I = 0 To Shadow
  Red = Red + (r / Shadow)
  Green = Green + (g / Shadow)
  Blue = Blue + (b / Shadow)
  UserControl.ForeColor = RGB(Red, Green, Blue)
  UserControl.Print StrText
  UserControl.CurrentX = X: UserControl.CurrentY = Y
  Select Case Direction
   Case 1:
    X = X + Xdiff
    Y = Y + Ydiff
   Case 2:
    X = X - Xdiff
    Y = Y + Ydiff
   Case 3:
    X = X + Xdiff
    Y = Y - Ydiff
   Case 4:
    X = X - Xdiff
    Y = Y - Ydiff
  End Select
Next
Exit Function
hell:
End Function

Project Homepage: