Private Declare Function SetWindowLong Lib "user32" _
    Alias "SetWindowLongA" _
   (ByVal hwnd As Long, _
    ByVal nIndex As Long, _
    ByVal dwNewLong As Long) As Long
 
Private Declare Function GetWindowLong Lib "user32" _
    Alias "GetWindowLongA" _
   (ByVal hwnd As Long, ByVal nIndex As Long) As Long
 
Public Enum enumBStyle
   Kein
   Fest_Einfach
End Enum
 
Private tmpStdStyle As Long
Private tmpBorder As Boolean
Private tmpGradFColor As Long
Private tmpGradTColor As Long
Private tmpGradient As Boolean
 
Private Const GWL_STYLE = (-16)
Private Const WS_VSCROLL = &H200000
 
Private Sub UserControl_Initialize()
    tmpStdStyle = GetWindowLong(UserControl.hwnd, GWL_STYLE)
    SetWindowLong UserControl.hwnd, GWL_STYLE, tmpStdStyle Or WS_VSCROLL
End Sub
 
Public Property Get BorderStyle() As enumBStyle
    BorderStyle = UserControl.BorderStyle
End Property
 
Public Property Let BorderStyle(ByVal vNewValue As enumBStyle)
    UserControl.BorderStyle = vNewValue
    PropertyChanged "BorderStyle"
End Property
 
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
   With PropBag
      UserControl.BorderStyle = .ReadProperty("BorderStyle", 0)
      Set Font = .ReadProperty("Font", Ambient.Font)
      UserControl.BackColor = .ReadProperty("BackColor", vbWhite)
      UserControl.ForeColor = .ReadProperty("ForeColor", vbBlack)
      tmpGradFColor = .ReadProperty("GradientFromColor", vbWhite)
      tmpGradTColor = .ReadProperty("GradientToColor", vbWhite)
      tmpGradient = .ReadProperty("Gradient", False)
   End With
End Sub
 
Private Sub UserControl_Resize()
   ZeichneGradient
End Sub
 
Private Sub UserControl_Show()
   ZeichneGradient
End Sub
 
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    With PropBag
       .WriteProperty "BorderStyle", UserControl.BorderStyle
       .WriteProperty "Font", Font, Ambient.Font
       .WriteProperty "BackColor", UserControl.BackColor
       .WriteProperty "ForeColor", UserControl.ForeColor
       .WriteProperty "GradientFromColor", tmpGradFColor
       .WriteProperty "GradientToColor", tmpGradTColor
       .WriteProperty "Gradient", tmpGradient
    End With
End Sub
 
Public Property Set Font(ByVal New_Font As Font)
  Set UserControl.Font = New_Font
  PropertyChanged "Font"
End Property
 
Public Property Get Font() As Font
  Set Font = UserControl.Font
End Property
 
Public Property Get BackColor() As OLE_COLOR
   BackColor = UserControl.BackColor
End Property
 
Public Property Let BackColor(ByVal vNewValue As OLE_COLOR)
   UserControl.BackColor = vNewValue
   PropertyChanged "BackColor"
End Property
 
Public Property Get ForeColor() As OLE_COLOR
   ForeColor = UserControl.ForeColor
End Property
 
Public Property Let ForeColor(ByVal vNewValue As OLE_COLOR)
   UserControl.ForeColor = vNewValue
   PropertyChanged "ForeColor"
End Property
 
Public Property Get Gradient() As Boolean
   Gradient = tmpGradient
End Property
 
Public Property Let Gradient(ByVal vValue As Boolean)
  tmpGradient = vValue
  PropertyChanged "Gradient"
  If Not vValue Then
      With UserControl
         .AutoRedraw = True
         .Cls
         .AutoRedraw = False
      End With
      Exit Property
  End If
  ZeichneGradient
End Property
 
Public Property Get GradientFromColor() As OLE_COLOR
   GradientFromColor = tmpGradFColor
End Property
 
Public Property Let GradientFromColor(ByVal vNewValue As OLE_COLOR)
   tmpGradFColor = vNewValue
   ZeichneGradient
   PropertyChanged "GradientFromColor"
End Property
 
Public Property Get GradientToColor() As OLE_COLOR
   GradientToColor = tmpGradTColor
End Property
 
Public Property Let GradientToColor(ByVal vNewValue As OLE_COLOR)
   tmpGradTColor = vNewValue
   ZeichneGradient
   PropertyChanged "GradientToColor"
End Property
 
Private Sub ZeichneGradient()
  If Not tmpGradient Then
      UserControl.Cls
      Exit Sub
  End If
  Dim bvf As Long, gvf As Long, rvf As Long
  Dim bzf As Long, gzf As Long, rzf As Long
  Dim Rs As Single, Gs As Single, Bs As Single
  Dim yp As Long
  Dim TempScaleMode As Byte
  Dim TempAutoRedraw As Boolean
  Dim tmpscaleheight As Long
 
 
  VonFarbe = tmpGradFColor
  Zufarbe = tmpGradTColor
 
  ' RGB-Farbanteile "VonFarbe"
  bvf = Int(VonFarbe / (256 ^ 2))
  VonFarbe = VonFarbe - (bvf * (256 ^ 2))
  gvf = Int(VonFarbe / (256 ^ 1))
  VonFarbe = VonFarbe - (gvf * (256 ^ 1))
  rvf = Int(VonFarbe / (256 ^ 0))
 
  ' RGB-Farbanteile "ZuFarbe"
  bzf = Int(Zufarbe / (256 ^ 2))
  Zufarbe = Zufarbe - (bzf * (256 ^ 2))
  gzf = Int(Zufarbe / (256 ^ 1))
  Zufarbe = Zufarbe - (gzf * (256 ^ 1))
  rzf = Int(Zufarbe / (256 ^ 0))
  With UserControl
    ' Die alten Werte temporär speichern
    TempScaleMode = .ScaleMode
    TempAutoRedraw = .AutoRedraw
    tmpscaleheight = .ScaleHeight
    .ScaleMode = 3      'Pixel
    .AutoRedraw = True
    Rs = (rzf - rvf) / .ScaleHeight
    Gs = (gzf - gvf) / .ScaleHeight
    Bs = (bzf - bvf) / .ScaleHeight
    For yp = 0 To .ScaleHeight
       UserControl.Line (0, yp)-(.ScaleWidth, yp), _
       RGB(rvf + Rs * yp, gvf + Gs * yp, bvf + Bs * yp)
    Next
    ' Die alten Werte wiederherstellen
    .ScaleMode = TempScaleMode
    .AutoRedraw = TempAutoRedraw
    .ScaleHeight = tmpscaleheight
  End With
End Sub