Subversion Repositories projects.vncstarter

VERSION 5.00
Begin VB.UserControl jjProgress 
   Alignable       =   -1  'True
   Appearance      =   0  'Flat
   AutoRedraw      =   -1  'True
   ClientHeight    =   300
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   3330
   ClipControls    =   0   'False
   ScaleHeight     =   20
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   222
   ToolboxBitmap   =   "jjProgress.ctx":0000
   Begin VB.PictureBox picGraf 
      Appearance      =   0  'Flat
      AutoRedraw      =   -1  'True
      BackColor       =   &H80000005&
      BorderStyle     =   0  'None
      ClipControls    =   0   'False
      DrawWidth       =   2
      FillStyle       =   0  'Solid
      ForeColor       =   &H80000008&
      Height          =   300
      Left            =   0
      ScaleHeight     =   20
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   31
      TabIndex        =   0
      TabStop         =   0   'False
      Top             =   0
      Visible         =   0   'False
      Width           =   465
   End
End
Attribute VB_Name = "jjProgress"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

'Kontrollens bredde og høyde
Dim ucWidth As Long
Dim ucHeight As Long

Public Enum jjStyle
    Standard = 0
    Flat = 1
    Forløp = 2
    Rør = 3
    XP = 4
    Mac81 = 5
End Enum

Public Enum jjForløp
    jjHorisontal = 0
    jjVertical = 1
End Enum

Public Enum jjViewPercent
    jjFalse = 0
    jjTrue = 1
End Enum

'Default Property Values:
Const m_def_ForeColor = 0
Const m_def_ColorA = vbWhite
Const m_def_ColorB = &HD78853
Const m_def_MaxValue = 100
Const m_def_Style = 0
Const m_def_Border = 1
Const m_def_BorderColor = 0
Const m_def_BackColor = vbWhite
Const m_def_ViewPercent = 0
Const m_def_Value = 0

'Property Variables:
Dim m_ForeColor As OLE_COLOR
Dim m_ColorA As OLE_COLOR
Dim m_ColorB As OLE_COLOR
Dim m_MaxValue As Long
Dim m_Style As Integer
Dim m_Border As Boolean
Dim m_BorderColor As OLE_COLOR
Dim m_BackColor As OLE_COLOR
Dim m_ViewPercent As Integer
Dim m_Value As Long


'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 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 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
Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor 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 Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function RoundRect Lib "gdi32" (ByVal hdc As Long, 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 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

'Event Declarations:
Event Resize() 'MappingInfo=UserControl,UserControl,-1,Resize
Event Click() 'MappingInfo=UserControl,UserControl,-1,Click
Event DblClick() 'MappingInfo=UserControl,UserControl,-1,DblClick
Event MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) 'MappingInfo=UserControl,UserControl,-1,MouseDown
Event MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) 'MappingInfo=UserControl,UserControl,-1,MouseMove
Event MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) 'MappingInfo=UserControl,UserControl,-1,MouseUp



Private Function TranslateColor(aColor As OLE_COLOR) As Long
    Dim newcolor As Long
    OleTranslateColor aColor, UserControl.Palette, newcolor
    TranslateColor = newcolor
End Function
Private Function Prosent(Verdi As Long, Maks As Long) As Long
    'Returnerer prosent av Verdi i forhold til Maks
    On Error Resume Next
    Dim Pros As Double
    
    Pros = (Maks - Verdi) / Maks * 100
    Prosent = 100 - Pros
End Function

Private Sub Graf()
    'Gjør et kall på denne prosedyren, er evhengig av en PictureBox(picGraf)
    Dim Til As Long
    Dim ProsentVerdi As String
    Dim TempHdc As Long
    Dim hRgn As Long
    Dim hPen As Long
    Dim hBrush As Long
    Dim pnt As POINTAPI
    Static SjekkTil As Long
    
    Til = Prosent(m_Value, m_MaxValue)
    
    'Sjekk at det er kommet ny til verdi, avbryt om den er lik
    If Til > 0 Then 'Denne linjen er med for at den skal tegnes i design-modus også
        If SjekkTil = Til Then
            Exit Sub
        End If
    End If
    SjekkTil = Til
    
    ProsentVerdi = Til & "%"    'For visning av prosent
    Til = Til * ucWidth / 100   'Antall piksler av kontrollens lengde som skal merkes
    
    picGraf.Cls
    TempHdc = picGraf.hdc
    SetWindowRgn UserControl.hwnd, 0, True  'Fjern en evt. region
    
    
    'Tegn bakgrunn på stiler <= 3
    If Style <= Rør Then
        hBrush = CreateSolidBrush(m_BackColor)
        hPen = CreatePen(PS_SOLID, 1, m_BackColor)
        SelectObject TempHdc, hBrush
        SelectObject TempHdc, hPen
        Rectangle TempHdc, 0, 0, ucWidth, ucHeight
        DeleteObject hPen
        DeleteObject hBrush
    End If
    
        
    'Tegn progress i valgt stil
    If Style = Standard Then
        Call ProgressStandard(Til)
    
    ElseIf Style = Flat Then
        Call ProgressForlop(Til)
        
    ElseIf Style = Forløp Then
        Call ProgressForlop(Til)
        
    ElseIf Style = Rør Then
        Call ProgressRor(Til)
    
    ElseIf Style = XP Then
        Call ProgressXP(Til)
        
    ElseIf Style = Mac81 Then
        Call ProgressMac81(Til)
    End If
    
    
    
    'Vis prosent i midten på stiler <= 3
    If Style <= Rør Then
        If ViewPercent = jjTrue Then
            picGraf.CurrentX = ucWidth / 2 - Len(ProsentVerdi) / 0.3
            picGraf.CurrentY = ucHeight / 2 - picGraf.TextHeight("ProsentVerdi") / 2
            SetTextColor TempHdc, m_ForeColor
            picGraf.Print ProsentVerdi
        End If
    End If
    
    
    'Tegn ramme på stiler <= 3
    If Style <= Rør Then
        If m_Border = True Then
            hPen = CreatePen(PS_SOLID, 1, m_BorderColor)
            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
        End If
    End If
    
    'Refresh tempbildet
    picGraf.Refresh
    'Kopier tempbildet over til kontrollen
    BitBlt UserControl.hdc, 0, 0, ucWidth, ucHeight, picGraf.hdc, 0, 0, vbSrcCopy
    'Refresh kontrollen
    UserControl.Refresh
    
    Set picGraf = Nothing
End Sub

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 picGraf.hdc, Vert(0), 2, gRect, 1, Retning
    picGraf.Refresh
    
PROC_EXIT:
    Exit Sub

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


Private Sub FadeGradientInit(Vanlig As Boolean, Lengde As Long)
    On Error GoTo PROC_ERR
    
    Dim Farger As GRADIENT_COLOR
    Dim r As Long
    
    If m_Border = True Then r = 1
    
    'FadeFarge
    Farger.ColorFrom = TranslateColor(m_ColorA)
    Farger.ColorTo = TranslateColor(m_ColorB)
    
    'Rør
    If Vanlig = False Then
        Call FadeGradient(Farger, Vanlig, r, r, Lengde - r, Prosent2(50, ucHeight))
        Farger.ColorTo = TranslateColor(m_ColorA)
        Farger.ColorFrom = TranslateColor(m_ColorB)
        Call FadeGradient(Farger, Vanlig, r, Prosent2(50, ucHeight), Lengde - r, ucHeight - r)
        
    'Forløp og flat
    ElseIf Vanlig = True Then
        If Style = Flat Then
            Farger.ColorFrom = TranslateColor(m_ColorA)
            Farger.ColorTo = TranslateColor(m_ColorA)
            Call FadeGradient(Farger, Vanlig, r, r, Lengde - r, ucHeight - r)
            
        ElseIf Style = Forløp Then
            Call FadeGradient(Farger, Vanlig, r, r, Lengde - r, ucHeight - r)
        End If
    End If
    
    
PROC_EXIT:
    Exit Sub

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


Private Sub ProgressMac81(Lengde As Long)
    On Error GoTo PROC_ERR
    
    Dim Farger As GRADIENT_COLOR
    Dim r As Long
    Dim TempHdc As Long
    Dim hBrush As Long
    Dim hPen As Long
    Dim pnt As POINTAPI
    Dim ProsentVerdi As String
    
    TempHdc = picGraf.hdc
        
    'Skyggestreker, venstre/topp
    hPen = CreatePen(PS_SOLID, 1, RGB(170, 170, 170))
    SelectObject TempHdc, hPen
    MoveToEx TempHdc, 0, ucHeight - 2, pnt
    LineTo TempHdc, 0, 0
    LineTo TempHdc, ucWidth - 1, 0
    DeleteObject hPen
    'høyre/bunn
    hPen = CreatePen(PS_SOLID, 1, vbWhite)
    SelectObject TempHdc, hPen
    MoveToEx TempHdc, ucWidth - 1, 1, pnt
    LineTo TempHdc, ucWidth - 1, ucHeight - 1
    LineTo TempHdc, 0, ucHeight - 1
    DeleteObject hPen
    'Sort innerramme
    hPen = CreatePen(PS_SOLID, 1, vbBlack)
    hBrush = CreateSolidBrush(m_BackColor)
    SelectObject TempHdc, hPen
    SelectObject TempHdc, hBrush
    Rectangle TempHdc, 1, 1, ucWidth - 1, ucHeight - 1
    DeleteObject hPen
    DeleteObject hBrush
    'InnerSkyggestreker, venstre/topp
    hPen = CreatePen(PS_SOLID, 1, RGB(136, 136, 136))
    SelectObject TempHdc, hPen
    MoveToEx TempHdc, 2, ucHeight - 3, pnt
    LineTo TempHdc, 2, 2
    LineTo TempHdc, ucWidth - 2, 2
    DeleteObject hPen
    'InnerSkyggestreker, høyre/bunn
    hPen = CreatePen(PS_SOLID, 1, RGB(221, 221, 221))
    SelectObject TempHdc, hPen
    MoveToEx TempHdc, ucWidth - 3, 3, pnt
    LineTo TempHdc, ucWidth - 3, ucHeight - 3
    LineTo TempHdc, 3, ucHeight - 3
    DeleteObject hPen
    
    
    'Fading
    'Fade grenser
    If Lengde < 2 Then Lengde = 2
    If Lengde > ucWidth - 3 Then Lengde = ucWidth - 3
    'Fade øverste halvdel
    Farger.ColorFrom = TranslateColor(m_ColorA)
    Farger.ColorTo = TranslateColor(vbWhite)
    Call FadeGradient(Farger, False, 2, 2, Lengde, Prosent2(50, ucHeight))
    'Fade nederste halvdel
    Farger.ColorFrom = TranslateColor(vbWhite)
    Farger.ColorTo = TranslateColor(m_ColorA)
    Call FadeGradient(Farger, False, 2, Prosent2(50, ucHeight), Lengde, ucHeight - 2)
    
    
    'Mørk innerstrek høyre/bunn/venstre
    hPen = CreatePen(PS_SOLID, 1, RGB(40, 40, 40))
    SelectObject TempHdc, hPen
    MoveToEx TempHdc, Lengde - 1, 3, pnt
    LineTo TempHdc, Lengde - 1, ucHeight - 3
    LineTo TempHdc, 2, ucHeight - 3
    LineTo TempHdc, 2, 2
    DeleteObject hPen

    
    'Endestrek1
    hPen = CreatePen(PS_SOLID, 1, vbBlack)
    SelectObject TempHdc, hPen
    MoveToEx TempHdc, Lengde, 2, pnt
    LineTo TempHdc, Lengde, ucHeight - 2
    DeleteObject hPen
    If Lengde > 2 And Lengde < ucWidth - 3 Then
        'Endestrek2
        hPen = CreatePen(PS_SOLID, 1, RGB(85, 85, 85))
        SelectObject TempHdc, hPen
        MoveToEx TempHdc, Lengde + 1, 2, pnt
        LineTo TempHdc, Lengde + 1, ucHeight - 2
        DeleteObject hPen
        'Endestrek3
        hPen = CreatePen(PS_SOLID, 1, RGB(136, 136, 136))
        SelectObject TempHdc, hPen
        MoveToEx TempHdc, Lengde + 2, 2, pnt
        LineTo TempHdc, Lengde + 2, ucHeight - 2
        DeleteObject hPen
    End If
    
    
    'Vis prosentverdi
    If ViewPercent = jjTrue Then
        hPen = CreatePen(PS_SOLID, 1, RGB(104, 104, 104))
        hBrush = CreateSolidBrush(RGB(236, 233, 216))
        SelectObject TempHdc, hPen
        SelectObject TempHdc, hBrush
        Rectangle TempHdc, ucWidth / 2 - 15, 3, (ucWidth / 2) + 20, ucHeight - 4
        DeleteObject hPen
        DeleteObject hBrush
        
        'høyrestrek
        hPen = CreatePen(PS_SOLID, 1, RGB(190, 190, 190))
        SelectObject TempHdc, hPen
        MoveToEx TempHdc, (ucWidth / 2) + 21, 4, pnt
        LineTo TempHdc, (ucWidth / 2) + 21, ucHeight - 3
        DeleteObject hPen
        'bunnstrek
        hPen = CreatePen(PS_SOLID, 1, RGB(190, 190, 190))
        SelectObject TempHdc, hPen
        MoveToEx TempHdc, ucWidth \ 2 - 14, ucHeight - 4, pnt
        LineTo TempHdc, (ucWidth \ 2) + 21, ucHeight - 4
        DeleteObject hPen
        
        'Vis verdien
        ProsentVerdi = Prosent(Lengde, ucWidth)
        picGraf.CurrentX = ucWidth / 2 - Len(ProsentVerdi) / 0.3
        picGraf.CurrentY = ucHeight / 2 - picGraf.TextHeight("ProsentVerdi") / 2
        SetTextColor TempHdc, m_ForeColor
        picGraf.Print ProsentVerdi & "%"
    End If
    
PROC_EXIT:
    Exit Sub

PROC_ERR:
    If Err.Number = 91 Then GoTo PROC_EXIT
End Sub
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 Sub UserControl_ReadProperties(PropBag As PropertyBag)
    m_Value = PropBag.ReadProperty("Value", m_def_Value)
    m_ViewPercent = PropBag.ReadProperty("ViewPercent", m_def_ViewPercent)
    m_BackColor = PropBag.ReadProperty("BackColor", m_def_BackColor)
    m_ForeColor = PropBag.ReadProperty("ForeColor", m_def_ForeColor)
    m_ColorA = PropBag.ReadProperty("ColorA", m_def_ColorA)
    m_ColorB = PropBag.ReadProperty("ColorB", m_def_ColorB)
    m_MaxValue = PropBag.ReadProperty("MaxValue", m_def_MaxValue)
    m_Style = PropBag.ReadProperty("Style", m_def_Style)
    m_Border = PropBag.ReadProperty("Border", m_def_Border)
    m_BorderColor = PropBag.ReadProperty("BorderColor", m_def_BorderColor)
End Sub

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

'Initialize Properties for User Control
Private Sub UserControl_InitProperties()
    m_Value = m_def_Value
    m_ViewPercent = m_def_ViewPercent
    m_BackColor = m_def_BackColor
    m_ForeColor = m_def_ForeColor
    m_ColorA = m_def_ColorA
    m_ColorB = m_def_ColorB
    m_MaxValue = m_def_MaxValue
    m_Style = m_def_Style
    m_Border = m_def_Border
    m_BorderColor = m_def_BorderColor
End Sub

'Write property values to storage
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    Call PropBag.WriteProperty("Value", m_Value, m_def_Value)
    Call PropBag.WriteProperty("ViewPercent", m_ViewPercent, m_def_ViewPercent)
    Call PropBag.WriteProperty("BackColor", m_BackColor, m_def_BackColor)
    Call PropBag.WriteProperty("ForeColor", m_ForeColor, m_def_ForeColor)
    Call PropBag.WriteProperty("ColorA", m_ColorA, m_def_ColorA)
    Call PropBag.WriteProperty("ColorB", m_ColorB, m_def_ColorB)
    Call PropBag.WriteProperty("MaxValue", m_MaxValue, m_def_MaxValue)
    Call PropBag.WriteProperty("Style", m_Style, m_def_Style)
    Call PropBag.WriteProperty("Border", m_Border, m_def_Border)
    Call PropBag.WriteProperty("BorderColor", m_BorderColor, m_def_BorderColor)
End Sub

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=8,0,0,0
Public Property Get Value() As Long
Attribute Value.VB_Description = "Verdi som skal vises"
    Value = m_Value
End Property

Public Property Let Value(ByVal New_Value As Long)
    If New_Value < 0 Then New_Value = 0
    If New_Value > m_MaxValue Then New_Value = m_MaxValue
    
    m_Value = New_Value
    PropertyChanged "Value"
    
    Call Graf
End Property


'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=7,0,0,0
Public Property Get ViewPercent() As jjViewPercent
Attribute ViewPercent.VB_Description = "Settes til True om forløpet skal vises i prosent  på midten."
    ViewPercent = m_ViewPercent
End Property

Public Property Let ViewPercent(ByVal New_ViewPercent As jjViewPercent)
    m_ViewPercent = New_ViewPercent
    PropertyChanged "ViewPercent"
    
    Call Graf
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


Private Sub UserControl_Click()
    RaiseEvent Click
End Sub

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)
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!
'MemberInfo=10,0,0,0
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 = m_BackColor
End Property

Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
    m_BackColor = TranslateColor(New_BackColor)
    PropertyChanged "BackColor"
    
    Call Graf
End Property


Private Sub ProgressStandard(Lengde As Long)
    Dim TempHdc As Long
    Dim f As Integer
    Dim hBrush As Long
    Dim hPen As Long
    Dim BlockW As Integer
    
    BlockW = ucHeight \ 3 'Bredden på hvert segment er 1/3 i forhold til høyden på kontrollen
    TempHdc = picGraf.hdc
    
    hBrush = CreateSolidBrush(m_ColorB)
    hPen = CreatePen(PS_SOLID, 1, m_ColorA)
    SelectObject TempHdc, hBrush
    SelectObject TempHdc, hPen
    For f = 2 To Lengde Step BlockW + 1
        Rectangle TempHdc, f, 2, f + BlockW, ucHeight - 2
    Next f
    DeleteObject hPen
    DeleteObject hBrush
End Sub
Private Sub ProgressXP(Lengde As Long)
    Dim TempHdc As Long
    Dim f As Long
    Dim hBrush As Long
    Dim hPen As Long
    Dim BlockW As Integer
    Dim hRgn As Long
    Dim pnt As POINTAPI
    Dim Farger As GRADIENT_COLOR
    Dim ProsentVerdi As String
    
    BlockW = 6
    TempHdc = picGraf.hdc
    
    'Progress blokker fadet
    For f = 4 To Lengde Step BlockW + 2
        Farger.ColorFrom = TranslateColor(m_ColorA)
        Farger.ColorTo = TranslateColor(m_ColorB)
        Call FadeGradient(Farger, False, f, 2, f + BlockW, ucHeight - 4)
    Next f
    
    
    'Skyggestreker, topp1
    hPen = CreatePen(PS_SOLID, 1, RGB(190, 190, 190))
    SelectObject TempHdc, hPen
    MoveToEx TempHdc, 0, 1, pnt
    LineTo TempHdc, ucWidth, 1
    DeleteObject hPen
    'topp2
    hPen = CreatePen(PS_SOLID, 1, RGB(239, 239, 239))
    SelectObject TempHdc, hPen
    MoveToEx TempHdc, 0, 2, pnt
    LineTo TempHdc, ucWidth, 2
    DeleteObject hPen
    'Bunn
    hPen = CreatePen(PS_SOLID, 1, RGB(239, 239, 239))
    SelectObject TempHdc, hPen
    MoveToEx TempHdc, 0, ucHeight - 3, pnt
    LineTo TempHdc, ucWidth, ucHeight - 3
    DeleteObject hPen
    'venstre1
    hPen = CreatePen(PS_SOLID, 1, RGB(190, 190, 190))
    SelectObject TempHdc, hPen
    MoveToEx TempHdc, 1, 1, pnt
    LineTo TempHdc, 1, ucHeight - 3
    DeleteObject hPen
    'venstre2
    hPen = CreatePen(PS_SOLID, 1, RGB(239, 239, 239))
    SelectObject TempHdc, hPen
    MoveToEx TempHdc, 2, 1, pnt
    LineTo TempHdc, 2, ucHeight - 3
    DeleteObject hPen
    'høyre
    hPen = CreatePen(PS_SOLID, 1, RGB(239, 239, 239))
    SelectObject TempHdc, hPen
    MoveToEx TempHdc, ucWidth - 3, 1, pnt
    LineTo TempHdc, ucWidth - 3, ucHeight - 3
    DeleteObject hPen
    
    
    'Vis prosentverdi
    If ViewPercent = jjTrue Then
        hPen = CreatePen(PS_SOLID, 1, RGB(104, 104, 104))
        hBrush = CreateSolidBrush(RGB(236, 233, 216))
        SelectObject TempHdc, hPen
        SelectObject TempHdc, hBrush
        Rectangle TempHdc, ucWidth / 2 - 15, 3, (ucWidth / 2) + 20, ucHeight - 4
        DeleteObject hPen
        DeleteObject hBrush
        
        'høyrestrek
        hPen = CreatePen(PS_SOLID, 1, RGB(190, 190, 190))
        SelectObject TempHdc, hPen
        MoveToEx TempHdc, (ucWidth / 2) + 21, 4, pnt
        LineTo TempHdc, (ucWidth / 2) + 21, ucHeight - 3
        DeleteObject hPen
        'bunnstrek
        hPen = CreatePen(PS_SOLID, 1, RGB(190, 190, 190))
        SelectObject TempHdc, hPen
        MoveToEx TempHdc, ucWidth \ 2 - 14, ucHeight - 4, pnt
        LineTo TempHdc, (ucWidth \ 2) + 21, ucHeight - 4
        DeleteObject hPen
        
        'Vis verdien
        ProsentVerdi = Prosent(Lengde, ucWidth)
        picGraf.CurrentX = ucWidth / 2 - Len(ProsentVerdi) / 0.3
        picGraf.CurrentY = ucHeight / 2 - picGraf.TextHeight("ProsentVerdi") / 2
        SetTextColor TempHdc, m_ForeColor
        picGraf.Print ProsentVerdi & "%"
    End If
        
    
    'Lag region
    hRgn = CreateRoundRectRgn(0, 0, ucWidth, ucHeight, 5, 5)
    hBrush = CreateSolidBrush(RGB(104, 104, 104))
    FrameRgn TempHdc, hRgn, hBrush, 1, 1
    SetWindowRgn UserControl.hwnd, hRgn, True
    DeleteObject hRgn
    DeleteObject hBrush
End Sub
Private Sub ProgressRor(Lengde As Long)
    Call FadeGradientInit(False, Lengde)
End Sub

Private Sub ProgressForlop(Lengde As Long)
    Call FadeGradientInit(True, Lengde)
End Sub
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=10,0,0,0
Public Property Get ForeColor() As OLE_COLOR
Attribute ForeColor.VB_Description = "Farge på teksten om ViewPercent er satt til True."
    ForeColor = m_ForeColor
End Property

Public Property Let ForeColor(ByVal New_ForeColor As OLE_COLOR)
    m_ForeColor = TranslateColor(New_ForeColor)
    PropertyChanged "ForeColor"
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 (gradering)"
    ColorA = m_ColorA
End Property

Public Property Let ColorA(ByVal New_ColorA As OLE_COLOR)
    m_ColorA = TranslateColor(New_ColorA)
    PropertyChanged "ColorA"
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 (gradering)"
    ColorB = m_ColorB
End Property

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

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=8,0,0,0
Public Property Get MaxValue() As Long
Attribute MaxValue.VB_Description = "Maks verdi."
    MaxValue = m_MaxValue
End Property

Public Property Let MaxValue(ByVal New_MaxValue As Long)
    m_MaxValue = New_MaxValue
    PropertyChanged "MaxValue"
    
    Call Graf
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=7,0,0,0
Public Property Get Style() As jjStyle
    Style = m_Style
End Property

Public Property Let Style(ByVal New_Style As jjStyle)
    m_Style = New_Style
    PropertyChanged "Style"
    
    Call Graf
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 = "Skal det tegnes ramme settes denne til True."
    Border = m_Border
End Property

Public Property Let Border(ByVal New_Border As Boolean)
    m_Border = New_Border
    PropertyChanged "Border"
    
    Call Graf
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å ramme om Border er satt til True."
    BorderColor = m_BorderColor
End Property

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