Subversion Repositories projects.vncstarter

VERSION 5.00
Begin VB.UserControl jjShadeBox 
   Alignable       =   -1  'True
   Appearance      =   0  'Flat
   AutoRedraw      =   -1  'True
   ClientHeight    =   1410
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   1950
   ControlContainer=   -1  'True
   ScaleHeight     =   94
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   130
   ToolboxBitmap   =   "jjShadeBox.ctx":0000
   Begin VB.PictureBox pic1 
      Appearance      =   0  'Flat
      AutoRedraw      =   -1  'True
      BackColor       =   &H80000005&
      BorderStyle     =   0  'None
      ClipControls    =   0   'False
      ForeColor       =   &H80000008&
      Height          =   300
      Left            =   1320
      ScaleHeight     =   20
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   20
      TabIndex        =   0
      TabStop         =   0   'False
      Top             =   420
      Visible         =   0   'False
      Width           =   300
   End
End
Attribute VB_Name = "jjShadeBox"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

'***************************************************************************************************************
'Nytt i denne versjonen er at man kan velge en tekst i boksen i valgfri font, fontfarge, størrelse og alignment
'Feltene for dette er Font, Text, TextColor og TextAlign.
'***************************************************************************************************************


Private Type HSL
    Hue As Integer
    Saturation As Integer
    Luminance As Integer
End Type

Private Type RGB
    Red As Integer
    Green As Integer
    Blue As Integer
End Type

Private h As HSL
Private r As RGB

Public Enum jjFade
    jj_LeftRight
    jj_TopBottom
    jj_Triangel
End Enum

Public Enum jjTextAlign
    jj_Left
    jj_Right
    jj_Center
End Enum

'For Triangel-fargefyll
Private Type TRIANGEL_COLOR
    ColorTL As Long
    ColorTR As Long
    ColorBL As Long
    ColorBR As Long
End Type
'For Gradient-fargefyll
Private Type GRADIENT_COLOR
    ColorFrom As Long
    ColorTo As Long
End Type
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
Private Type GRADIENT_TRIANGLE
    Vertex1 As Long
    Vertex2 As Long
    Vertex3 As Long
End Type
Private Type TRIVERTEX
    x As Long
    y As Long
    Red As Integer
    Green As Integer
    Blue As Integer
    Alpha As Integer
End Type
Private Type GRADIENT_RECT
    UpperLeft As Long
    LowerRight As Long
End Type
Const GRADIENT_FILL_RECT_H As Long = &H0
Const GRADIENT_FILL_RECT_V  As Long = &H1
Const GRADIENT_FILL_TRIANGLE As Long = &H2
'Const SM_CXBORDER = 5
'Const SM_CYBORDER = 6
'Const SM_CXEDGE = 45
'Const SM_CYEDGE = 46

Private Const DT_CENTER = &H1
Private Const DT_RIGHT = &H2
Private Const DT_LEFT = &H0
Private Const DT_NOPREFIX = &H800
Private Const DT_WORDBREAK = &H10
Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long

Private Declare Function GradientFillTriangle Lib "msimg32" Alias "GradientFill" (ByVal hdc As Long, pVertex As TRIVERTEX, ByVal dwNumVertex As Long, pMesh As GRADIENT_TRIANGLE, ByVal dwNumMesh As Long, ByVal dwMode As Long) As Long
Private Declare Function GradientFill Lib "msimg32" (ByVal hdc As Long, pVertex As TRIVERTEX, ByVal dwNumVertex As Long, pMesh As GRADIENT_RECT, ByVal dwNumMesh As Long, ByVal dwMode As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long

'Private Declare Function UpdateWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
'Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long

Private Declare Sub OleTranslateColor Lib "oleaut32.dll" (ByVal clr As Long, ByVal hpal As Long, ByRef lpcolorref As Long)
Private Declare Function CreateRoundRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
'Private Declare Function FrameRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long, ByVal hBrush As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
'Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long

'Flytte til et punkt og tegne linjer
Private Type POINTAPI
    x As Long
    y As Long
End Type
Private Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, lpPoint As POINTAPI) As Long
Private Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function SetPixelV Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Const PS_SOLID = 0

'Default Property Values:
Const m_def_Text = ""
Const m_def_TextColor = 0
Const m_def_TextAlign = 2
Const m_def_StatusBar = 0
Const m_def_MakeRegionLines = 0
Const m_def_FadeDoublePoint = 50
Const m_def_BorderColor = 0
Const m_def_Border = 0
Const m_def_MakeRegion = 0
Const m_def_FadeDouble = 0
Const m_def_FadeType = 1
Const m_def_ColorA = vbWhite
Const m_def_ColorB = &HD78853 'Blå
Const m_def_TriColorTL = &HEDFEAB
Const m_def_TriColorTR = &HD78853
Const m_def_TriColorBL = &HD78853
Const m_def_TriColorBR = &HEDFEAB

'Property Variables:
Dim m_Text As String
Dim m_TextColor As OLE_COLOR
Dim m_TextAlign As Integer
Dim m_StatusBar As Boolean
Dim m_MakeRegionLines As Boolean
Dim m_FadeDoublePoint As Long
Dim m_BorderColor As OLE_COLOR
Dim m_Border As Boolean
Dim m_MakeRegion As Boolean
Dim m_FadeDouble As Boolean
Dim m_FadeType As Integer
Dim m_ColorA As OLE_COLOR
Dim m_ColorB As OLE_COLOR
Dim m_TriColorTL As OLE_COLOR
Dim m_TriColorTR As OLE_COLOR
Dim m_TriColorBL As OLE_COLOR
Dim m_TriColorBR As OLE_COLOR

'Kontrollens bredde og høyde
Dim ucWidth As Long
Dim ucHeight As Long
Dim xDif As Long
Dim yDif As Long
Dim WResize As Boolean

'Event Declarations:
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 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."
Event Resize() 'MappingInfo=UserControl,UserControl,-1,Resize
Attribute Resize.VB_Description = "Occurs when a form is first displayed or the size of an object changes."
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."
Attribute Click.VB_MemberFlags = "200"


Private Function HSLtoRGB(ByVal Hue As Integer, ByVal Saturation As Integer, ByVal Luminance As Integer) As RGB
    Dim pHue As Single
    Dim pSat As Single
    Dim pLum As Single
    Dim retval As RGB
    Dim pRed As Single
    Dim pGreen As Single
    Dim pBlue As Single
    Dim temp2 As Single
    Dim temp3() As Single
    Dim temp1 As Single
    Dim n As Integer

   ReDim temp3(0 To 2)
   
   pHue = Hue / 239
   pSat = Saturation / 239
   pLum = Luminance / 239

   If pSat = 0 Then
      pRed = pLum!
      pGreen = pLum
      pBlue = pLum
   Else
      If pLum < 0.5 Then
         temp2 = pLum * (1 + pSat)
      Else
         temp2 = pLum + pSat - pLum * pSat
      End If
      temp1! = 2 * pLum! - temp2!
   
      temp3(0) = pHue + 1 / 3
      temp3(1) = pHue
      temp3(2) = pHue - 1 / 3
      
      For n = 0 To 2
         If temp3(n) < 0 Then temp3(n) = temp3(n) + 1
         If temp3(n) > 1 Then temp3(n) = temp3(n) - 1
      
         If 6 * temp3(n) < 1 Then
            temp3(n) = temp1 + (temp2 - temp1) * 6 * temp3(n)
         Else
            If 2 * temp3(n) < 1 Then
               temp3(n) = temp2
            Else
               If 3 * temp3(n%) < 2 Then
                  temp3(n%) = temp1 + (temp2 - temp1) _
                        * ((2 / 3) - temp3(n%)) * 6
               Else
                  temp3(n%) = temp1
                End If
             End If
          End If
       Next n%

       pRed = temp3(0)
       pGreen = temp3(1)
       pBlue = temp3(2)
    End If

    retval.Red = Int(pRed * 255)
    retval.Green = Int(pGreen * 255)
    retval.Blue = Int(pBlue * 255)
    
    HSLtoRGB = retval
End Function




Private Function RGBtoHSL(ByVal Red As Integer, ByVal Green As Integer, ByVal Blue As Integer) As HSL
    Dim pRed As Single
    Dim pGreen As Single
    Dim pBlue As Single
    Dim retval As HSL
    Dim pMax As Single
    Dim pMin As Single
    Dim pLum As Single
    Dim pSat As Single
    Dim pHue As Single
    
    pRed = Red / 255
    pGreen = Green / 255
    pBlue = Blue / 255
   
    If pRed > pGreen Then
       If pRed > pBlue Then
          pMax = pRed
       Else
          pMax = pBlue
       End If
    ElseIf pGreen > pBlue Then
        pMax = pGreen
    Else
        pMax = pBlue
    End If

    If pRed < pGreen Then
        If pRed < pBlue Then
            pMin = pRed
        Else
            pMin = pBlue
        End If
    ElseIf pGreen < pBlue Then
        pMin = pGreen
    Else
        pMin = pBlue
    End If

    pLum = (pMax + pMin) / 2
   
    If pMax = pMin Then
        pSat = 0
        pHue = 0
    Else
        If pLum < 0.5 Then
            pSat = (pMax - pMin) / (pMax + pMin)
        Else
            pSat = (pMax - pMin) / (2 - pMax - pMin)
        End If
        
        Select Case pMax!
        Case pRed
            pHue = (pGreen - pBlue) / (pMax - pMin)
        Case pGreen
            pHue = 2 + (pBlue - pRed) / (pMax - pMin)
        Case pBlue
            pHue = 4 + (pRed - pGreen) / (pMax - pMin)
        End Select
    End If

    retval.Hue = pHue * 239 \ 6
    If retval.Hue < 0 Then retval.Hue = retval.Hue + 240
    
    retval.Saturation = Int(pSat * 239)
    retval.Luminance = Int(pLum * 239)
    
    RGBtoHSL = retval
End Function


Private Sub FadeGradient(Farge As GRADIENT_COLOR, LeftRight As Boolean, X1 As Long, Y1 As Long, X2 As Long, Y2 As Long)
    On Error GoTo PROC_ERR
    
    Dim gRect As GRADIENT_RECT
    Dim Vert(1) As TRIVERTEX
    Dim f As Integer
    Dim rgbRed(1) As Long, rgbGreen(1) As Long, rgbBlue(1) As Long
    Dim rHex(1) As String, gHex(1) As String, bHex(1) As String
    Dim Retning As Long
    
    For f = 0 To 1
        Select Case f
            Case Is = 0
                'Konverter FraFargen til RGB
                rgbRed(f) = Farge.ColorFrom Mod 256
                rgbGreen(f) = ((Farge.ColorFrom And &HFF00FF00) / 256)
                rgbBlue(f) = (Farge.ColorFrom And &HFF0000) / 65536
               
            Case Is = 1
                'Konverter TilFargen til RGB
                rgbRed(f) = Farge.ColorTo Mod 256
                rgbGreen(f) = ((Farge.ColorTo And &HFF00FF00) / 256)
                rgbBlue(f) = (Farge.ColorTo And &HFF0000) / 65536
        End Select
    
        'Gang RGB sin verdi med 256 for å tilpasse maksverdien til GradientFill sin maksverdi som er 65280
        rgbRed(f) = rgbRed(f) * 256
        rgbGreen(f) = rgbGreen(f) * 256
        rgbBlue(f) = rgbBlue(f) * 256
        
        'Konverter de nye verdiene til Hex verdier
        rHex(f) = "&h" & Hex(rgbRed(f))
        gHex(f) = "&h" & Hex(rgbGreen(f))
        bHex(f) = "&h" & Hex(rgbBlue(f))
    Next f
    
    'Fra-farge
    Vert(0).x = X1
    Vert(0).y = Y1
    Vert(0).Red = rHex(0)
    Vert(0).Green = gHex(0)
    Vert(0).Blue = bHex(0)
    Vert(0).Alpha = 0&
    
    'Til-farge
    Vert(1).x = X2
    Vert(1).y = Y2
    Vert(1).Red = rHex(1)
    Vert(1).Green = gHex(1)
    Vert(1).Blue = bHex(1)
    Vert(1).Alpha = 0&
    
    'Rektangelets ytterpunkter
    gRect.UpperLeft = 0
    gRect.LowerRight = 1
    
    
    'Retning på fading
    If LeftRight = False Then
        Retning = GRADIENT_FILL_RECT_V
    Else
        Retning = GRADIENT_FILL_RECT_H
    End If
    
    
    'API
    GradientFill pic1.hdc, Vert(0), 2, gRect, 1, Retning
    pic1.Refresh
    
PROC_EXIT:
    Exit Sub

PROC_ERR:
    If Err.Number = 91 Then GoTo PROC_EXIT
End Sub

Private Sub FadeTriangel(Farge As TRIANGEL_COLOR, jRect As RECT)
    On Error GoTo PROC_ERR
    
    Dim Vert(3) As TRIVERTEX
    Dim Tri(3) As GRADIENT_TRIANGLE
    Dim f As Integer
    Dim rgbRed(3) As Long, rgbGreen(3) As Long, rgbBlue(3) As Long
    Dim rHex(3) As String, gHex(3) As String, bHex(3) As String
    
    For f = 0 To 3
        Select Case f
            Case Is = 0
                'Konverter til RGB
                rgbRed(f) = Farge.ColorTL Mod 256
                rgbGreen(f) = ((Farge.ColorTL And &HFF00FF00) / 256)
                rgbBlue(f) = (Farge.ColorTL And &HFF0000) / 65536
               
            Case Is = 1
                'Konverter til RGB
                rgbRed(f) = Farge.ColorTR Mod 256
                rgbGreen(f) = ((Farge.ColorTR And &HFF00FF00) / 256)
                rgbBlue(f) = (Farge.ColorTR And &HFF0000) / 65536
                
            Case Is = 2
                'Konverter til RGB
                rgbRed(f) = Farge.ColorBR Mod 256
                rgbGreen(f) = ((Farge.ColorBR And &HFF00FF00) / 256)
                rgbBlue(f) = (Farge.ColorBR And &HFF0000) / 65536
            
            Case Is = 3
                'Konverter til RGB
                rgbRed(f) = Farge.ColorBL Mod 256
                rgbGreen(f) = ((Farge.ColorBL And &HFF00FF00) / 256)
                rgbBlue(f) = (Farge.ColorBL And &HFF0000) / 65536
        End Select
    
        'Gang RGB sin verdi med 256 for å tilpasse maksverdien til GradientFillTriangle sin maksverdi som er 65280
        rgbRed(f) = rgbRed(f) * 256
        rgbGreen(f) = rgbGreen(f) * 256
        rgbBlue(f) = rgbBlue(f) * 256
        
        'Konverter de nye verdiene til Hex verdier
        rHex(f) = "&h" & Hex(rgbRed(f))
        gHex(f) = "&h" & Hex(rgbGreen(f))
        bHex(f) = "&h" & Hex(rgbBlue(f))
    Next f
    

    'Venstre øverst
    Vert(0).x = jRect.Left
    Vert(0).y = jRect.Top
    Vert(0).Red = rHex(0)
    Vert(0).Green = gHex(0)
    Vert(0).Blue = bHex(0)
    Vert(0).Alpha = 0&
    
    'Høyre øverst
    Vert(1).x = jRect.Right
    Vert(1).y = jRect.Top
    Vert(1).Red = rHex(1)
    Vert(1).Green = gHex(1)
    Vert(1).Blue = bHex(1)
    Vert(1).Alpha = 0&
    
    'Høyre nederst
    Vert(2).x = jRect.Right
    Vert(2).y = jRect.Bottom
    Vert(2).Red = rHex(2)
    Vert(2).Green = gHex(2)
    Vert(2).Blue = bHex(2)
    Vert(2).Alpha = 0&

    'Venstre nederst
    Vert(3).x = jRect.Left
    Vert(3).y = jRect.Bottom
    Vert(3).Red = rHex(3)
    Vert(3).Green = gHex(3)
    Vert(3).Blue = bHex(3)
    Vert(3).Alpha = 0&
    
    
    
    Tri(0).Vertex1 = 0
    Tri(0).Vertex2 = 1
    Tri(0).Vertex3 = 2
    
    Tri(1).Vertex1 = 0
    Tri(1).Vertex2 = 2
    Tri(1).Vertex3 = 3
    
    Tri(2).Vertex1 = 1
    Tri(2).Vertex2 = 2
    Tri(2).Vertex3 = 3
    
    Tri(3).Vertex1 = 0
    Tri(3).Vertex2 = 1
    Tri(3).Vertex3 = 3
    
    'API
    GradientFillTriangle pic1.hdc, Vert(0), 4, Tri(0), 4, GRADIENT_FILL_TRIANGLE
    pic1.Refresh
    
PROC_EXIT:
    Exit Sub

PROC_ERR:
    If Err.Number = 91 Then GoTo PROC_EXIT
End Sub

Private Function TranslateColor(aColor As OLE_COLOR) As Long
    Dim newcolor As Long
    OleTranslateColor aColor, UserControl.Palette, newcolor
    TranslateColor = newcolor
End Function

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=7,0,0,0
Public Property Get FadeType() As jjFade
Attribute FadeType.VB_Description = "Velg graderingstype, Topp-bunn, Venstre-høyre eller Triangel som er en firkant med valgfri farge i hvert hjørne."
    FadeType = m_FadeType
End Property

Public Property Let FadeType(ByVal New_FadeType As jjFade)
    m_FadeType = New_FadeType
    PropertyChanged "FadeType"
    
    Call Fade
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=10,0,0,0
Public Property Get ColorA() As OLE_COLOR
Attribute ColorA.VB_Description = "Fra farge på vanlig gradering."
    ColorA = m_ColorA
End Property

Public Property Let ColorA(ByVal New_ColorA As OLE_COLOR)
    m_ColorA = New_ColorA
    PropertyChanged "ColorA"
    
    Call Fade
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=10,0,0,0
Public Property Get ColorB() As OLE_COLOR
Attribute ColorB.VB_Description = "Til farge på vanlig gradering."
    ColorB = m_ColorB
End Property

Public Property Let ColorB(ByVal New_ColorB As OLE_COLOR)
    m_ColorB = New_ColorB
    PropertyChanged "ColorB"
    
    Call Fade
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=10,0,0,0
Public Property Get TriColorTL() As OLE_COLOR
Attribute TriColorTL.VB_Description = "Farge til Triangelgradering, topp-venstre."
    TriColorTL = m_TriColorTL
End Property

Public Property Let TriColorTL(ByVal New_TriColorTL As OLE_COLOR)
    m_TriColorTL = New_TriColorTL
    PropertyChanged "TriColorTL"
    
    Call Fade
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=10,0,0,0
Public Property Get TriColorTR() As OLE_COLOR
Attribute TriColorTR.VB_Description = "Farge til Triangelgradering, topp-høyre."
    TriColorTR = m_TriColorTR
End Property

Public Property Let TriColorTR(ByVal New_TriColorTR As OLE_COLOR)
    m_TriColorTR = New_TriColorTR
    PropertyChanged "TriColorTR"
    
    Call Fade
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=10,0,0,0
Public Property Get TriColorBL() As OLE_COLOR
Attribute TriColorBL.VB_Description = "Farge til Triangelgradering, bunn-venstre."
    TriColorBL = m_TriColorBL
End Property

Public Property Let TriColorBL(ByVal New_TriColorBL As OLE_COLOR)
    m_TriColorBL = New_TriColorBL
    PropertyChanged "TriColorBL"
    
    Call Fade
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=10,0,0,0
Public Property Get TriColorBR() As OLE_COLOR
Attribute TriColorBR.VB_Description = "Farge til Triangelgradering, bunn-høyre."
    TriColorBR = m_TriColorBR
End Property

Public Property Let TriColorBR(ByVal New_TriColorBR As OLE_COLOR)
    m_TriColorBR = New_TriColorBR
    PropertyChanged "TriColorBR"
    
    Call Fade
End Property


'Initialize Properties for User Control
Private Sub UserControl_InitProperties()
    m_FadeType = m_def_FadeType
    m_ColorA = m_def_ColorA
    m_ColorB = m_def_ColorB
    m_TriColorTL = m_def_TriColorTL
    m_TriColorTR = m_def_TriColorTR
    m_TriColorBL = m_def_TriColorBL
    m_TriColorBR = m_def_TriColorBR
    m_FadeDouble = m_def_FadeDouble
    m_MakeRegion = m_def_MakeRegion
    m_Border = m_def_Border
    m_BorderColor = m_def_BorderColor
    m_FadeDoublePoint = m_def_FadeDoublePoint
    m_MakeRegionLines = m_def_MakeRegionLines
    m_StatusBar = m_def_StatusBar
    Set UserControl.Font = Ambient.Font
    m_Text = m_def_Text
    m_TextColor = m_def_TextColor
    m_TextAlign = m_def_TextAlign
End Sub

'Load property values from storage
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    m_FadeType = PropBag.ReadProperty("FadeType", m_def_FadeType)
    m_ColorA = PropBag.ReadProperty("ColorA", m_def_ColorA)
    m_ColorB = PropBag.ReadProperty("ColorB", m_def_ColorB)
    m_TriColorTL = PropBag.ReadProperty("TriColorTL", m_def_TriColorTL)
    m_TriColorTR = PropBag.ReadProperty("TriColorTR", m_def_TriColorTR)
    m_TriColorBL = PropBag.ReadProperty("TriColorBL", m_def_TriColorBL)
    m_TriColorBR = PropBag.ReadProperty("TriColorBR", m_def_TriColorBR)
    m_FadeDouble = PropBag.ReadProperty("FadeDouble", m_def_FadeDouble)
    m_MakeRegion = PropBag.ReadProperty("MakeRegion", m_def_MakeRegion)
    m_Border = PropBag.ReadProperty("Border", m_def_Border)
    m_BorderColor = PropBag.ReadProperty("BorderColor", m_def_BorderColor)
    UserControl.Enabled = PropBag.ReadProperty("Enabled", True)
    m_FadeDoublePoint = PropBag.ReadProperty("FadeDoublePoint", m_def_FadeDoublePoint)
    m_MakeRegionLines = PropBag.ReadProperty("MakeRegionLines", m_def_MakeRegionLines)
    m_StatusBar = PropBag.ReadProperty("StatusBar", m_def_StatusBar)
    UserControl.MousePointer = PropBag.ReadProperty("MousePointer", 0)
    Set UserControl.Font = PropBag.ReadProperty("Font", Ambient.Font)
    m_Text = PropBag.ReadProperty("Text", m_def_Text)
    m_TextColor = PropBag.ReadProperty("TextColor", m_def_TextColor)
    m_TextAlign = PropBag.ReadProperty("TextAlign", m_def_TextAlign)
End Sub

Private Sub UserControl_Resize()
    RaiseEvent Resize
    'Bredden og høyden på knappen legges i disse
    ucWidth = UserControl.ScaleWidth
    ucHeight = UserControl.ScaleHeight
    pic1.Width = ucWidth
    pic1.Height = ucHeight
        
    Call Fade
End Sub

'Write property values to storage
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    Call PropBag.WriteProperty("FadeType", m_FadeType, m_def_FadeType)
    Call PropBag.WriteProperty("ColorA", m_ColorA, m_def_ColorA)
    Call PropBag.WriteProperty("ColorB", m_ColorB, m_def_ColorB)
    Call PropBag.WriteProperty("TriColorTL", m_TriColorTL, m_def_TriColorTL)
    Call PropBag.WriteProperty("TriColorTR", m_TriColorTR, m_def_TriColorTR)
    Call PropBag.WriteProperty("TriColorBL", m_TriColorBL, m_def_TriColorBL)
    Call PropBag.WriteProperty("TriColorBR", m_TriColorBR, m_def_TriColorBR)
    Call PropBag.WriteProperty("FadeDouble", m_FadeDouble, m_def_FadeDouble)
    Call PropBag.WriteProperty("MakeRegion", m_MakeRegion, m_def_MakeRegion)
    Call PropBag.WriteProperty("Border", m_Border, m_def_Border)
    Call PropBag.WriteProperty("BorderColor", m_BorderColor, m_def_BorderColor)
    Call PropBag.WriteProperty("Enabled", UserControl.Enabled, True)
    Call PropBag.WriteProperty("FadeDoublePoint", m_FadeDoublePoint, m_def_FadeDoublePoint)
    Call PropBag.WriteProperty("MakeRegionLines", m_MakeRegionLines, m_def_MakeRegionLines)
    Call PropBag.WriteProperty("StatusBar", m_StatusBar, m_def_StatusBar)
    Call PropBag.WriteProperty("MousePointer", UserControl.MousePointer, 0)
    Call PropBag.WriteProperty("Font", UserControl.Font, Ambient.Font)
    Call PropBag.WriteProperty("Text", m_Text, m_def_Text)
    Call PropBag.WriteProperty("TextColor", m_TextColor, m_def_TextColor)
    Call PropBag.WriteProperty("TextAlign", m_TextAlign, m_def_TextAlign)
End Sub

Private Sub FadeGradientInit(LeftRight As Boolean)
    On Error GoTo PROC_ERR
    
    Dim Farger As GRADIENT_COLOR
    
    'FadeFarge
    Farger.ColorFrom = TranslateColor(m_ColorA)
    Farger.ColorTo = TranslateColor(m_ColorB)
    
    
    'EnkelFade
    If m_FadeDouble = False Then
        Call FadeGradient(Farger, LeftRight, 0, 0, ucWidth, ucHeight)
    
    'DobbelFade
    Else
        'ToppBunn
        If LeftRight = False Then
            Call FadeGradient(Farger, LeftRight, 0, 0, ucWidth, Prosent2(m_FadeDoublePoint, ucHeight))
            Farger.ColorTo = TranslateColor(m_ColorA)
            Farger.ColorFrom = TranslateColor(m_ColorB)
            Call FadeGradient(Farger, LeftRight, 0, Prosent2(m_FadeDoublePoint, ucHeight), ucWidth, ucHeight)
            
'            Farger.ColorFrom = Lys(30, TranslateColor(m_ColorA))
'            Farger.ColorTo = Lys(-10, TranslateColor(m_ColorA))
'            Call FadeGradient(Farger, LeftRight, 0, 0, ucWidth, ucHeight / 2)
'            Farger.ColorFrom = Lys(-30, TranslateColor(m_ColorA))
'            Farger.ColorTo = Lys(50, TranslateColor(m_ColorA))
'            Call FadeGradient(Farger, LeftRight, 0, ucHeight / 2, ucWidth, ucHeight)
        
        'VentreHøyre
        Else
            Call FadeGradient(Farger, LeftRight, 0, 0, Prosent2(m_FadeDoublePoint, ucWidth), ucHeight)
            Farger.ColorTo = TranslateColor(m_ColorA)
            Farger.ColorFrom = TranslateColor(m_ColorB)
            Call FadeGradient(Farger, LeftRight, Prosent2(m_FadeDoublePoint, ucWidth), 0, ucWidth, ucHeight)
        End If
    End If
    
PROC_EXIT:
    Exit Sub

PROC_ERR:
    If Err.Number = 91 Then GoTo PROC_EXIT
End Sub

Private Sub FadeTriangelInit()
    On Error GoTo PROC_ERR
    
    Dim TriFarger As TRIANGEL_COLOR
    Dim rct As RECT
    
    TriFarger.ColorTL = TranslateColor(m_TriColorTL)
    TriFarger.ColorTR = TranslateColor(m_TriColorTR)
    TriFarger.ColorBL = TranslateColor(m_TriColorBL)
    TriFarger.ColorBR = TranslateColor(m_TriColorBR)
    
    rct.Left = 0
    rct.Top = 0
    rct.Right = ucWidth
    rct.Bottom = ucHeight
    
    Call FadeTriangel(TriFarger, rct)
    
PROC_EXIT:
    Exit Sub

PROC_ERR:
    If Err.Number = 91 Then GoTo PROC_EXIT
End Sub

Private Sub Fade()
    On Error Resume Next
    
    Dim hRgn As Long
    Dim hPen As Long
    Dim pnt As POINTAPI
    Dim RammeFarge As Long
    Dim TempHdc As Long
    Dim y As Integer
    Dim TextJust As Integer, TextJust2 As Integer
    Dim rc As RECT, Align As Long
    
    TempHdc = pic1.hdc
    Set pic1.Font = UserControl.Font
    
    'Utfør valgt fading
    If FadeType = jj_LeftRight Then
        Call FadeGradientInit(True)
        
    ElseIf FadeType = jj_TopBottom Then
        Call FadeGradientInit(False)
        
    ElseIf FadeType = jj_Triangel Then
        Call FadeTriangelInit
    End If
    
    
    'Tegn ramme om dette er valgt
    If m_MakeRegion = False Then
        If m_Border = True Then
            SetWindowRgn UserControl.hwnd, 0, True
            RammeFarge = TranslateColor(m_BorderColor)
            hPen = CreatePen(PS_SOLID, 1, RammeFarge)
            SelectObject TempHdc, hPen
            MoveToEx TempHdc, 0, 0, pnt
            LineTo TempHdc, ucWidth - 1, 0
            LineTo TempHdc, ucWidth - 1, ucHeight - 1
            LineTo TempHdc, 0, ucHeight - 1
            LineTo TempHdc, 0, 0
            DeleteObject hPen
            pic1.Refresh
        End If
    End If
    
    
    'Tegn Drageikon om den skal fremtre som en statusbar
    If m_StatusBar = True Then
        If Parent.WindowState = vbNormal Then
            hPen = CreatePen(PS_SOLID, 2, vbWhite)
            SelectObject TempHdc, hPen
            MoveToEx TempHdc, ucWidth - 2, ucHeight - 2, pnt
            LineTo TempHdc, ucWidth - 3, ucHeight - 3
            
            MoveToEx TempHdc, ucWidth - 6, ucHeight - 2, pnt
            LineTo TempHdc, ucWidth - 7, ucHeight - 3
            
            MoveToEx TempHdc, ucWidth - 10, ucHeight - 2, pnt
            LineTo TempHdc, ucWidth - 11, ucHeight - 3
            
            MoveToEx TempHdc, ucWidth - 2, ucHeight - 6, pnt
            LineTo TempHdc, ucWidth - 3, ucHeight - 7
            
            MoveToEx TempHdc, ucWidth - 6, ucHeight - 6, pnt
            LineTo TempHdc, ucWidth - 7, ucHeight - 7
            
            MoveToEx TempHdc, ucWidth - 2, ucHeight - 10, pnt
            LineTo TempHdc, ucWidth - 3, ucHeight - 11
            DeleteObject hPen
            
            
            hPen = CreatePen(PS_SOLID, 2, Lys(-20, TranslateColor(m_ColorB)))
            SelectObject TempHdc, hPen
            MoveToEx TempHdc, ucWidth - 3, ucHeight - 3, pnt
            LineTo TempHdc, ucWidth - 4, ucHeight - 4
            
            MoveToEx TempHdc, ucWidth - 7, ucHeight - 3, pnt
            LineTo TempHdc, ucWidth - 8, ucHeight - 4
            
            MoveToEx TempHdc, ucWidth - 11, ucHeight - 3, pnt
            LineTo TempHdc, ucWidth - 12, ucHeight - 4
            
            MoveToEx TempHdc, ucWidth - 3, ucHeight - 7, pnt
            LineTo TempHdc, ucWidth - 4, ucHeight - 8
            
            MoveToEx TempHdc, ucWidth - 7, ucHeight - 7, pnt
            LineTo TempHdc, ucWidth - 8, ucHeight - 8
            
            MoveToEx TempHdc, ucWidth - 3, ucHeight - 11, pnt
            LineTo TempHdc, ucWidth - 4, ucHeight - 12
            DeleteObject hPen
        End If
    End If
    
    
    'Lag region om dette er valgt
    If m_MakeRegion = True Then
        'Lag region
        hRgn = CreateRoundRectRgn(2, 0, ucWidth - 1, ucHeight, 5, 5)
        SetWindowRgn UserControl.hwnd, hRgn, True
        DeleteObject hRgn
        y = 2
    Else
        SetWindowRgn UserControl.hwnd, 0, True
        y = 1
    End If
    
    
    'Lag topp/bunnlinje om dette er valgt
    If m_MakeRegionLines = True Then
        'Toppstrek
        hPen = CreatePen(PS_SOLID, 1, Lys(-20, TranslateColor(m_ColorA)))
        SelectObject TempHdc, hPen
        MoveToEx TempHdc, 0, 0, pnt
        LineTo TempHdc, ucWidth, 0
        DeleteObject hPen
        
        'Bunnstrek
        hPen = CreatePen(PS_SOLID, 1, Lys(-50, TranslateColor(m_ColorB)))
        SelectObject TempHdc, hPen
        MoveToEx TempHdc, 0, ucHeight - y, pnt
        LineTo TempHdc, ucWidth, ucHeight - y
        DeleteObject hPen
        pic1.Refresh
    End If
    
    
    'Tegn teksten vanlig eller disabled
    If m_Text <> "" Then
        TextJust = 3
        If m_MakeRegion = True Then TextJust = 6
        If m_StatusBar = True Then TextJust2 = 12
        rc.Left = TextJust
        rc.Right = ucWidth - TextJust - TextJust2
        rc.Top = 3
        rc.Bottom = ucHeight - 3
        
        Select Case m_TextAlign
            Case Is = 0 'Left
                Align = DT_LEFT
                
            Case Is = 1 'Right
                Align = DT_RIGHT
                
            Case Is = 2 'Center
                Align = DT_CENTER
        End Select
        
        If UserControl.Enabled = True Then
            SetTextColor TempHdc, TranslateColor(m_TextColor)
        Else
            SetTextColor TempHdc, TranslateColor(vbGrayText)
        End If
        DrawText TempHdc, m_Text, -1, rc, DT_WORDBREAK Or DT_NOPREFIX Or Align
    End If
    
    
    'Kopier tempbildet over til kontrollen
    BitBlt UserControl.hdc, 0, 0, ucWidth, ucHeight, pic1.hdc, 0, 0, vbSrcCopy
    UserControl.Refresh
    
    'Nullstill tempboksen for å spare GDI ressurser
    Set pic1 = Nothing
End Sub

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=17
Public Function Refreshing() As AmbientProperties
    Call Fade
End Function

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=0,0,0,0
Public Property Get FadeDouble() As Boolean
Attribute FadeDouble.VB_Description = "Deler området i to og fader motsatt på siste del. Gjelder når FadeType er satt til 1 eller 2."
    FadeDouble = m_FadeDouble
End Property

Public Property Let FadeDouble(ByVal New_FadeDouble As Boolean)
    m_FadeDouble = New_FadeDouble
    PropertyChanged "FadeDouble"
    Call Fade
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=0,0,0,0
Public Property Get MakeRegion() As Boolean
Attribute MakeRegion.VB_Description = "Lager avrundede hjørner."
    MakeRegion = m_MakeRegion
End Property

Public Property Let MakeRegion(ByVal New_MakeRegion As Boolean)
    m_MakeRegion = New_MakeRegion
    PropertyChanged "MakeRegion"
    
    Call Fade
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=0,0,0,0
Public Property Get Border() As Boolean
Attribute Border.VB_Description = "Om destinasjon er en PictureBox kan det tegnes en tynn ramme på denne. Velg BorderColor for farge på rammen."
    Border = m_Border
End Property

Public Property Let Border(ByVal New_Border As Boolean)
    m_Border = New_Border
    PropertyChanged "Border"
    Call Fade
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=10,0,0,0
Public Property Get BorderColor() As OLE_COLOR
Attribute BorderColor.VB_Description = "Farge på rammen om Border er satt til True."
    BorderColor = m_BorderColor
End Property

Public Property Let BorderColor(ByVal New_BorderColor As OLE_COLOR)
    m_BorderColor = New_BorderColor
    PropertyChanged "BorderColor"
    Call Fade
End Property


Private Sub UserControl_Click()
    RaiseEvent Click
End Sub


'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,hDC
Public Property Get hdc() As Long
Attribute hdc.VB_Description = "Returns a handle (from Microsoft Windows) to the object's device context."
    hdc = UserControl.hdc
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,Enabled
Public Property Get Enabled() As Boolean
    Enabled = UserControl.Enabled
End Property

Public Property Let Enabled(ByVal New_Enabled As Boolean)
    UserControl.Enabled() = New_Enabled
    PropertyChanged "Enabled"
    
    Call Fade
End Property


Private Function Lys(Verdi As Long, Farge As Long) As Long
    Dim lrgb As Long
    Dim pr As Long
    
    'Gjør long om til RGB som lagres i r
    Call LongToRGB(Farge)
    
    'legg RGB inn i HSL
    h = RGBtoHSL(r.Red, r.Green, r.Blue)
        
    'Juster lystyrken i HSL
    If Verdi >= 0 Then
        pr = Prosent2(Verdi, 239 - h.Luminance)
        If pr + h.Luminance > 239 Then pr = 239
        h.Luminance = h.Luminance + pr
    
    ElseIf Verdi < 0 Then
        pr = Prosent2(Abs(Verdi), CLng(h.Luminance))
        If h.Luminance - pr < 0 Then pr = 0
        h.Luminance = h.Luminance - pr
    End If
    
    'Legg inn den nye HSL i RGB som lagres i r
    r = HSLtoRGB(h.Hue, h.Saturation, h.Luminance)
    
    'Gjør RGB om til long
    lrgb = RGB(r.Red, r.Green, r.Blue)
    
    'Returverdi
    Lys = lrgb
End Function
Private Function Prosent2(Prosent As Long, MaksVerdi As Long, Optional Desimal As Boolean) As Long
    'Returnerer verdien av gitt Prosent i forhold til gitt MaksVerdi
    '---------------------------------------------------------------
    'Prosent    = en verdi fra 0 til 100
    'MaksVerdi  = tallet det skal finnes en prosentverdi av
    'Desimal    = Settes til true om det ønskes en desimal på returverdien
    'Returvariabelen til Prosent2 må endres fra Long til String før denne virker.
    
    On Error Resume Next
    
    Dim DesFormat As String
    Dim Pros As Long
    
    DesFormat = "#0"
    If Desimal = True Then DesFormat = "#0.0"
    
    Pros = (MaksVerdi * Prosent) / 100
    Prosent2 = Format(Pros, DesFormat)
End Function
Private Function Prosent(Verdi As Long, Maks As Long, Optional Desimal As Boolean) As Long
    On Error Resume Next
    'Returnerer i prosent Verdi i forhold til Maks
    
    Dim Pros As Double
    Dim DesFormat As String
    
    DesFormat = "#0"
    If Desimal = True Then DesFormat = "#0.0"
    
    Pros = (Maks - Verdi) / Maks * 100
    Prosent = Format(100 - (Pros), DesFormat)
End Function
Private Sub LongToRGB(LongColor As Long)
    'Selvstendig funksjon
    'Konverterer lang fargeverdi til RGB verdiene
    On Error Resume Next
    
    r.Red = LongColor Mod 256
    r.Green = ((LongColor And &HFF00FF00) / 256)
    r.Blue = (LongColor And &HFF0000) / 65536
End Sub
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=7,0,0,50
Public Property Get FadeDoublePoint() As Integer
Attribute FadeDoublePoint.VB_Description = "Tast et tall mellom 10-90 for å plassere delingseffekten om FadeDouble=True."
    FadeDoublePoint = m_FadeDoublePoint
End Property

Public Property Let FadeDoublePoint(ByVal New_FadeDoublePoint As Integer)
    If New_FadeDoublePoint < 10 Then New_FadeDoublePoint = 10
    If New_FadeDoublePoint > 90 Then New_FadeDoublePoint = 90
    
    m_FadeDoublePoint = New_FadeDoublePoint
    PropertyChanged "FadeDoublePoint"
    
    Call Fade
End Property

Private Sub UserControl_DblClick()
    RaiseEvent DblClick
End Sub

Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    RaiseEvent MouseDown(Button, Shift, x, y)
    
    Dim rc As RECT
    Dim pnt As POINTAPI
    
    'For endring av vindus size
    If Button = vbLeftButton Then
        If m_StatusBar = True Then
            If Parent.WindowState = vbNormal Then
                If UserControl.Extender.Align = 2 Then
                    If x > ucWidth - 13 And y > ucHeight - 13 Then
                        'Finn vindusstørrelse og musepos.
                        GetWindowRect UserControl.Parent.hwnd, rc
                        GetCursorPos pnt
                        
                        'Finn diff mellom vinduets høyre/bunn pos og musepos.
                        xDif = rc.Right - pnt.x
                        yDif = rc.Bottom - pnt.y
                        
                        WResize = True
                    End If
                End If
            End If
        End If
    End If
End Sub

Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    RaiseEvent MouseMove(Button, Shift, x, y)
    
    Dim rc As RECT
    Dim pnt As POINTAPI
    
    'Skifte til resize musemarkørom musen er over resize merket
    If m_StatusBar = True Then
        If Parent.WindowState = vbNormal Then
            If x > ucWidth - 13 And y > ucHeight - 13 Then
                MousePointer = 8
            Else
                MousePointer = 0
            End If
        End If
    End If
    
    'Mulighet for å resize winduet kontrollen står i
    If WResize = True Then
        MousePointer = 8
        GetWindowRect UserControl.Parent.hwnd, rc
        GetCursorPos pnt
        MoveWindow UserControl.Parent.hwnd, rc.Left, rc.Top, pnt.x - rc.Left + xDif, pnt.y - rc.Top + yDif, 1
    End If
End Sub

Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    RaiseEvent MouseUp(Button, Shift, x, y)
    
    WResize = False
End Sub


'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=0,0,0,True
Public Property Get MakeRegionLines() As Boolean
Attribute MakeRegionLines.VB_Description = "Tegner en pyntelinje på topp og i bunn."
    MakeRegionLines = m_MakeRegionLines
End Property

Public Property Let MakeRegionLines(ByVal New_MakeRegionLines As Boolean)
    m_MakeRegionLines = New_MakeRegionLines
    PropertyChanged "MakeRegionLines"
    Call Fade
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=0,0,0,0
Public Property Get StatusBar() As Boolean
Attribute StatusBar.VB_Description = "Settes til True for å få StatusBar ikon i høyre hjørne. Gjelder bare om Align=2."
    StatusBar = m_StatusBar
End Property

Public Property Let StatusBar(ByVal New_StatusBar As Boolean)
    m_StatusBar = New_StatusBar
    'Man skal ikke kunne resize uten at controllen er alignet til bunn
    If UserControl.Extender.Align <> 2 Then m_StatusBar = False
    PropertyChanged "StatusBar"
    
    Call Fade
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,MousePointer
Public Property Get MousePointer() As Integer
Attribute MousePointer.VB_Description = "Returns/sets the type of mouse pointer displayed when over part of an object."
Attribute MousePointer.VB_MemberFlags = "40"
    MousePointer = UserControl.MousePointer
End Property

Public Property Let MousePointer(ByVal New_MousePointer As Integer)
    UserControl.MousePointer() = New_MousePointer
    PropertyChanged "MousePointer"
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
    PropertyChanged "Font"
    
    Call Fade
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=13,0,0,
Public Property Get Text() As String
Attribute Text.VB_Description = "Valgfri tekst."
    Text = m_Text
End Property

Public Property Let Text(ByVal New_Text As String)
    m_Text = New_Text
    PropertyChanged "Text"
    
    Call Fade
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=10,0,0,0
Public Property Get TextColor() As OLE_COLOR
Attribute TextColor.VB_Description = "Tekstfarge."
    TextColor = m_TextColor
End Property

Public Property Let TextColor(ByVal New_TextColor As OLE_COLOR)
    m_TextColor = New_TextColor
    PropertyChanged "TextColor"
    
    Call Fade
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=7,0,0,0
Public Property Get TextAlign() As jjTextAlign
Attribute TextAlign.VB_Description = "Plassering av tekst."
    TextAlign = m_TextAlign
End Property

Public Property Let TextAlign(ByVal New_TextAlign As jjTextAlign)
    m_TextAlign = New_TextAlign
    PropertyChanged "TextAlign"
    
    Call Fade
End Property