Subversion Repositories projects.vncstarter

Rev

Blame | Last modification | View Log

VERSION 5.00
Begin VB.UserControl jjShadeForm 
   Appearance      =   0  'Flat
   BackColor       =   &H80000005&
   CanGetFocus     =   0   'False
   ClientHeight    =   435
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   435
   ClipControls    =   0   'False
   HasDC           =   0   'False
   InvisibleAtRuntime=   -1  'True
   Picture         =   "jjShadeForm.ctx":0000
   ScaleHeight     =   29
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   29
   ToolboxBitmap   =   "jjShadeForm.ctx":0A3A
   Begin VB.Timer tmr1 
      Enabled         =   0   'False
      Interval        =   1
      Left            =   60
      Top             =   135
   End
End
Attribute VB_Name = "jjShadeForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Public Enum jjDestinasjon
    jj_Form
    jj_PictureBox
End Enum

Public Enum jjFadeType
    jj_LeftRight
    jj_TopBottom
    jj_Triangel
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
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 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 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_BorderColor = 0
Const m_def_Border = 0
Const m_def_MakeRegion = 0
Const m_def_FadeDouble = 0
Const m_def_Destinasjon = 0
Const m_def_FadeType = 0
Const m_def_ColorA = vbWhite
Const m_def_ColorB = vbYellow
Const m_def_TriColorTL = &HC0E0FF
Const m_def_TriColorTR = &HC0FFFF
Const m_def_TriColorBL = &H80C0FF
Const m_def_TriColorBR = &H80FFFF
Const m_def_FadeEnabled = 0
'Property Variables:
Dim m_BorderColor As OLE_COLOR
Dim m_Border As Boolean
Dim m_MakeRegion As Boolean
Dim m_FadeDouble As Boolean
Dim m_BoxName As PictureBox
Dim m_Destinasjon As Long
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
Dim m_FadeEnabled As Boolean

Dim ExtWidth As Long
Dim ExtHeight As Long


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
    If m_Destinasjon = jj_Form Then
        GradientFill Extender.Parent.hdc, Vert(0), 2, gRect, 1, Retning
        Extender.Parent.Refresh
        
    ElseIf m_Destinasjon = jj_PictureBox Then
        GradientFill m_BoxName.hdc, Vert(0), 2, gRect, 1, Retning
        m_BoxName.Refresh
    End If
    
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
    If m_Destinasjon = jj_Form Then
        GradientFillTriangle Extender.Parent.hdc, Vert(0), 4, Tri(0), 4, GRADIENT_FILL_TRIANGLE
        Extender.Parent.Refresh
    ElseIf m_Destinasjon = jj_PictureBox Then
        GradientFillTriangle m_BoxName.hdc, Vert(0), 4, Tri(0), 4, GRADIENT_FILL_TRIANGLE
        m_BoxName.Refresh
    End If
    
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 jjFadeType
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 jjFadeType)
    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

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=0,0,0,0
Public Property Get FadeEnabled() As Boolean
Attribute FadeEnabled.VB_Description = "Slår fading av/på."
    FadeEnabled = m_FadeEnabled
End Property

Public Property Let FadeEnabled(ByVal New_FadeEnabled As Boolean)
    m_FadeEnabled = New_FadeEnabled
    PropertyChanged "FadeEnabled"
    
    Call Fade
End Property

Private Sub tmr1_Timer()
    tmr1.Enabled = False
    Call Fade
End Sub

'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_FadeEnabled = m_def_FadeEnabled
    m_Destinasjon = m_def_Destinasjon
    m_FadeDouble = m_def_FadeDouble
    m_MakeRegion = m_def_MakeRegion
    m_Border = m_def_Border
    m_BorderColor = m_def_BorderColor
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_FadeEnabled = PropBag.ReadProperty("FadeEnabled", m_def_FadeEnabled)
    m_Destinasjon = PropBag.ReadProperty("Destinasjon", m_def_Destinasjon)
    Set m_BoxName = PropBag.ReadProperty("BoxName", Nothing)
    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)
End Sub

Private Sub UserControl_Resize()
    UserControl.Width = 435
    UserControl.Height = 435
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("FadeEnabled", m_FadeEnabled, m_def_FadeEnabled)
    Call PropBag.WriteProperty("Destinasjon", m_Destinasjon, m_def_Destinasjon)
    Call PropBag.WriteProperty("BoxName", m_BoxName, Nothing)
    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)
End Sub

Private Sub ShadeGradient(LeftRight As Boolean)
    On Error GoTo PROC_ERR
    
    Dim Farger As GRADIENT_COLOR
    
    'Form
    If m_Destinasjon = jj_Form Then
        ExtWidth = Extender.Parent.ScaleX(Extender.Parent.ScaleWidth, Extender.Parent.ScaleMode, vbPixels)
        ExtHeight = Extender.Parent.ScaleY(Extender.Parent.ScaleHeight, Extender.Parent.ScaleMode, vbPixels)
    
    'PicturBox
    ElseIf m_Destinasjon = jj_PictureBox Then
        ExtWidth = m_BoxName.ScaleX(m_BoxName.ScaleWidth, m_BoxName.ScaleMode, vbPixels)
        ExtHeight = m_BoxName.ScaleY(m_BoxName.ScaleHeight, m_BoxName.ScaleMode, vbPixels)
    End If
    
    
    'FadeFarge
    Farger.ColorFrom = TranslateColor(m_ColorA)
    Farger.ColorTo = TranslateColor(m_ColorB)
    
    
    'EnkelFade
    If m_FadeDouble = False Then
        Call FadeGradient(Farger, LeftRight, 0, 0, ExtWidth, ExtHeight)
    
    'DobbelFade
    Else
        'ToppBunn
        If LeftRight = False Then
            Call FadeGradient(Farger, LeftRight, 0, 0, ExtWidth, ExtHeight / 2)
            Farger.ColorTo = TranslateColor(m_ColorA)
            Farger.ColorFrom = TranslateColor(m_ColorB)
            Call FadeGradient(Farger, LeftRight, 0, ExtHeight / 2, ExtWidth, ExtHeight)
        
        'VentreHøyre
        Else
            Call FadeGradient(Farger, LeftRight, 0, 0, ExtWidth / 2, ExtHeight)
            Farger.ColorTo = TranslateColor(m_ColorA)
            Farger.ColorFrom = TranslateColor(m_ColorB)
            Call FadeGradient(Farger, LeftRight, ExtWidth / 2, 0, ExtWidth, ExtHeight)
        End If
    End If
    
PROC_EXIT:
    Exit Sub

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

Private Sub ShadeTriangel()
    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
    
    If m_Destinasjon = jj_Form Then
        rct.Right = Extender.Parent.ScaleX(Extender.Parent.ScaleWidth, Extender.Parent.ScaleMode, vbPixels)
        rct.Bottom = Extender.Parent.ScaleY(Extender.Parent.ScaleHeight, Extender.Parent.ScaleMode, vbPixels)
    ElseIf m_Destinasjon = jj_PictureBox Then
        rct.Right = m_BoxName.ScaleX(m_BoxName.ScaleWidth, m_BoxName.ScaleMode, vbPixels)
        rct.Bottom = m_BoxName.ScaleY(m_BoxName.ScaleHeight, m_BoxName.ScaleMode, vbPixels)
    End If
    
    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
    
    'Clear destinasjonen om Enabled blir satt til False
    If m_FadeEnabled = False Then
        If m_Destinasjon = jj_Form Then
            Extender.Parent.Cls
        ElseIf m_Destinasjon = jj_PictureBox Then
            m_BoxName.Cls
        End If
        
    'Start valgt fading om enabled er satt til True
    Else
        If FadeType = jj_LeftRight Then
            Call ShadeGradient(True)
            
        ElseIf FadeType = jj_TopBottom Then
            Call ShadeGradient(False)
            
        ElseIf FadeType = jj_Triangel Then
            Call ShadeTriangel
        End If
    End If
    
    
    'Tegn ramme om dette er valgt, ikke på form eller om region er valgt
    If m_MakeRegion = False Then
        If m_Border = True Then
            If m_Destinasjon = jj_PictureBox Then
                SetWindowRgn m_BoxName.hwnd, 0, True
                RammeFarge = TranslateColor(m_BorderColor)
                hPen = CreatePen(PS_SOLID, 1, RammeFarge)
                SelectObject m_BoxName.hdc, hPen
                MoveToEx m_BoxName.hdc, 0, 0, pnt
                LineTo m_BoxName.hdc, ExtWidth - 1, 0
                LineTo m_BoxName.hdc, ExtWidth - 1, ExtHeight - 1
                LineTo m_BoxName.hdc, 0, ExtHeight - 1
                LineTo m_BoxName.hdc, 0, 0
                DeleteObject hPen
                m_BoxName.Refresh
            End If
        End If
    End If
    
    
    'Lag region om dette er valgt, bare på PictureBox
    If m_MakeRegion = True Then
        If m_Destinasjon = jj_PictureBox Then
            'Toppstrek
            hPen = CreatePen(PS_SOLID, 1, RGB(149, 183, 244))
            SelectObject m_BoxName.hdc, hPen
            MoveToEx m_BoxName.hdc, 0, 0, pnt
            LineTo m_BoxName.hdc, ExtWidth, 0
            DeleteObject hPen
            
            'Bunnstrek
            hPen = CreatePen(PS_SOLID, 1, RGB(49, 86, 147))
            SelectObject m_BoxName.hdc, hPen
            MoveToEx m_BoxName.hdc, 0, ExtHeight - 2, pnt
            LineTo m_BoxName.hdc, ExtWidth, ExtHeight - 2
            DeleteObject hPen
            m_BoxName.Refresh
            
            'Lag region
            hRgn = CreateRoundRectRgn(2, 0, ExtWidth - 1, ExtHeight, 5, 5)
            SetWindowRgn m_BoxName.hwnd, hRgn, True
            DeleteObject hRgn
        End If
    End If
End Sub

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=17
Public Function Refreshing() As AmbientProperties
    tmr1.Enabled = True
End Function

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=8,0,0,0
Public Property Get Destinasjon() As jjDestinasjon
Attribute Destinasjon.VB_Description = "Settes til Form eller PicturBox, velges PictureBox må BoxName settes i formens Load prosedyre."
    Destinasjon = m_Destinasjon
End Property

Public Property Let Destinasjon(ByVal New_Destinasjon As jjDestinasjon)
    m_Destinasjon = New_Destinasjon
    PropertyChanged "Destinasjon"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=22,0,0,0
Public Property Get BoxName() As PictureBox
    Set BoxName = m_BoxName
End Property

Public Property Set BoxName(ByVal New_BoxName As PictureBox)
    Set m_BoxName = New_BoxName
    PropertyChanged "BoxName"
    tmr1.Enabled = True
End Property

'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 bare jj_Gradient."
    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 avrundet region om det er valgt PictureBox"
    MakeRegion = m_MakeRegion
End Property

Public Property Let MakeRegion(ByVal New_MakeRegion As Boolean)
    m_MakeRegion = New_MakeRegion
    PropertyChanged "MakeRegion"
    
    tmr1.Enabled = True
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"
    
    tmr1.Enabled = True
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"
    
    tmr1.Enabled = True
End Property