Hallo,
einfach neues Project -> ActiveX Control.
Zu der Userform welchen wir den Namen XPCaptionFrame geben, noch ein Modul mit den Namen clsDrawGDI.
Danach folgenden Source Code 
'Das Modul clsDrawGDI
Option Explicit
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 SetBkColor Lib "gdi32" (ByVal hDC As Long, ByVal crColor As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hDC As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function CreateBitmap Lib "gdi32" (ByVal nWidth As Long, ByVal nHeight As Long, ByVal nPlanes As Long, ByVal nBitCount As Long, lpBits As Any) As Long
Private Declare Function GetBkColor Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function GetTextColor Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function SelectPalette Lib "gdi32" (ByVal hDC As Long, ByVal hPalette As Long, ByVal bForceBackground As Long) As Long
Private Declare Function RealizePalette Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hDC As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function CreateHalftonePalette Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function SetTextColor Lib "gdi32" (ByVal hDC As Long, ByVal crColor As Long) As Long
Private Declare Function OleTranslateColor Lib "oleaut32.dll" (ByVal lOleColor As Long, ByVal lHPalette As Long, lColorRef As Long) As Long
Private Const DSna = &H220326
Public Function convertPixelsToTwipsX(ByVal lngPixels As Long) As Long
convertPixelsToTwipsX = lngPixels \* 15
End Function
Public Function convertPixelsToTwipsY(ByVal lngPixels As Long) As Long
convertPixelsToTwipsY = lngPixels \* 15
End Function
Public Function convertTwipstToPixelsX(ByVal lngTwips As Long) As Long
convertTwipstToPixelsX = lngTwips / 15
End Function
Public Function convertTwipstToPixelsY(ByVal lngTwips As Long) As Long
convertTwipstToPixelsY = lngTwips / 15
End Function
Public Sub PaintTransparentPicture(ByVal hDCDest As Long, ByVal picSource As Picture, ByVal xDest As Long, ByVal yDest As Long, ByVal Width As Long, ByVal Height As Long, Optional ByVal xSrc As Long = 0, Optional ByVal ySrc As Long = 0, Optional ByVal clrMask As OLE\_COLOR = 16711935, Optional ByVal hPal As Long = 0)
Dim hdcSrc As Long
Dim hbmMemSrcOld As Long
Dim hDCScreen As Long
Dim hPalOld As Long
Dim m\_hpalHalftone As Long
If Not picSource Is Nothing Then
If picSource.Type = vbPicTypeBitmap Then
hDCScreen = GetDC(0&:wink:
m\_hpalHalftone = CreateHalftonePalette(hDCScreen)
If hPal = 0 Then hPal = m\_hpalHalftone
hdcSrc = CreateCompatibleDC(hDCScreen)
hbmMemSrcOld = SelectObject(hdcSrc, picSource.Handle)
hPalOld = SelectPalette(hdcSrc, hPal, True)
RealizePalette hdcSrc
PaintTransparentDC hDCDest, xDest, yDest, Width, Height, hdcSrc, xSrc, ySrc, clrMask, hPal
SelectObject hdcSrc, hbmMemSrcOld
SelectPalette hdcSrc, hPalOld, True
RealizePalette hdcSrc
DeleteDC hdcSrc
ReleaseDC 0&, hDCScreen
DeleteObject m\_hpalHalftone
End If
End If
End Sub
Private Sub PaintTransparentDC(ByVal hDCDest As Long, ByVal xDest As Long, ByVal yDest As Long, ByVal Width As Long, ByVal Height As Long, ByVal hdcSrc As Long, Optional ByVal xSrc As Long = 0, Optional ByVal ySrc As Long = 0, Optional ByVal clrMask As OLE\_COLOR = 16711935, Optional ByVal hPal As Long = 0)
Dim hdcMask As Long
Dim hdcColor As Long
Dim hbmMask As Long
Dim hbmColor As Long
Dim hbmColorOld As Long
Dim hbmMaskOld As Long
Dim hPalOld As Long
Dim hDCScreen As Long
Dim hdcScnBuffer As Long
Dim hbmScnBuffer As Long
Dim hbmScnBufferOld As Long
Dim hPalBufferOld As Long
Dim lMaskColor As Long
Dim m\_hpalHalftone As Long
hDCScreen = GetDC(0&:wink:
If hPal = 0 Then
hPal = m\_hpalHalftone
End If
OleTranslateColor clrMask, hPal, lMaskColor
hbmScnBuffer = CreateCompatibleBitmap(hDCScreen, Width, Height)
hdcScnBuffer = CreateCompatibleDC(hDCScreen)
hbmScnBufferOld = SelectObject(hdcScnBuffer, hbmScnBuffer)
hPalBufferOld = SelectPalette(hdcScnBuffer, hPal, True)
RealizePalette hdcScnBuffer
BitBlt hdcScnBuffer, 0, 0, Width, Height, hDCDest, xDest, yDest, vbSrcCopy
hbmColor = CreateCompatibleBitmap(hDCScreen, Width, Height)
hbmMask = CreateBitmap(Width, Height, 1, 1, ByVal 0&:wink:
hdcColor = CreateCompatibleDC(hDCScreen)
hbmColorOld = SelectObject(hdcColor, hbmColor)
hPalOld = SelectPalette(hdcColor, hPal, True)
RealizePalette hdcColor
SetBkColor hdcColor, GetBkColor(hdcSrc)
SetTextColor hdcColor, GetTextColor(hdcSrc)
BitBlt hdcColor, 0, 0, Width, Height, hdcSrc, xSrc, ySrc, vbSrcCopy
hdcMask = CreateCompatibleDC(hDCScreen)
hbmMaskOld = SelectObject(hdcMask, hbmMask)
SetBkColor hdcColor, lMaskColor
SetTextColor hdcColor, vbWhite
BitBlt hdcMask, 0, 0, Width, Height, hdcColor, 0, 0, vbSrcCopy
SetTextColor hdcColor, vbBlack
SetBkColor hdcColor, vbWhite
BitBlt hdcColor, 0, 0, Width, Height, hdcMask, 0, 0, DSna
BitBlt hdcScnBuffer, 0, 0, Width, Height, hdcMask, 0, 0, vbSrcAnd
BitBlt hdcScnBuffer, 0, 0, Width, Height, hdcColor, 0, 0, vbSrcPaint
BitBlt hDCDest, xDest, yDest, Width, Height, hdcScnBuffer, 0, 0, vbSrcCopy
DeleteObject SelectObject(hdcColor, hbmColorOld)
SelectPalette hdcColor, hPalOld, True
RealizePalette hdcColor
DeleteDC hdcColor
DeleteObject SelectObject(hdcScnBuffer, hbmScnBufferOld)
SelectPalette hdcScnBuffer, hPalBufferOld, True
RealizePalette hdcScnBuffer
DeleteDC hdcScnBuffer
DeleteObject SelectObject(hdcMask, hbmMaskOld)
DeleteDC hdcMask
ReleaseDC 0&, hDCScreen
End Sub
'Das UserControl XPCaptionFrame
Option Explicit
Private Const cnstLngTop As Long = 0
Private Const cnstLngLeft As Long = 50
Private Const cnstColMask As Long = 16711935
Private Const cnstColBackColorText As Long = &HC68F5E
Private Const cnstColForeColor As Long = 16777215
Private Const cnstColBackColorControl As Long = &HE0F0F0
Private Const cnstColBackColorFrame As Long = 16446961
Private Const cnstColBorderColor As Long = &HC68F5E
Private Const cnstColBorderShadow As Long = &HCBBA99
Private Const cnstColBorderShadow2 As Long = &HDECDBF
Private Const cnstIntBorder As Integer = 2
Private Const cnstblnTriangleTopBottom As Boolean = False
Private Const cnstIntAlignment As Integer = 0
Public Event Click()
Public Event MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Public Enum enumBorderSupFrame
borderFrameNormal = 0
borderFrameShadow
borderFrameShadowLight
borderFrameNoBorder
End Enum
Public Enum enumAlignmentSupFrame
alignmentFrameTopLeft = 0
alignmentFrameTopRight
alignmentFrameBottomLeft
alignmentFrameBottomRight
End Enum
Private colBorderColor As OLE\_COLOR
Private colBorderShadow As OLE\_COLOR
Private colBorderShadow2 As OLE\_COLOR
Private colBackColorText As OLE\_COLOR
Private colForeColor As OLE\_COLOR
Private colBackColorFrame As OLE\_COLOR
Private colBackColorControl As OLE\_COLOR
Private colMask As OLE\_COLOR
Private fntText As StdFont
Private intBorder As enumBorderSupFrame
Private intAlignment As enumAlignmentSupFrame
Private strCaption As String
Private blnTriangleTopBottom As Boolean
Private picNormal As StdPicture
Private objGDI As clsDrawGDI
Public Sub Repaint()
Dim intY As Integer, intX As Integer
Dim lngWidth As Long, lngHeight As Long, lngTop As Long
Dim lngPictureLeft As Long
Dim lngBorderTop As Long
On Local Error Resume Next
UserControl.Cls
UserControl.BackColor = colBackColorFrame
lngWidth = UserControl.TextWidth(strCaption) + UserControl.TextWidth("M")
lngHeight = UserControl.TextHeight(strCaption)
If Not picNormal Is Nothing Then
lngWidth = lngWidth + objGDI.convertPixelsToTwipsX(16)
End If
If intAlignment = enumAlignmentSupFrame.alignmentFrameTopLeft Or \_
intAlignment = enumAlignmentSupFrame.alignmentFrameTopRight Then
lngTop = cnstLngTop
Else
lngTop = ScaleHeight - lngHeight
End If
If (Not blnTriangleTopBottom And (intAlignment = alignmentFrameTopLeft Or intAlignment = alignmentFrameTopRight)) Or \_
(blnTriangleTopBottom And (intAlignment = alignmentFrameBottomLeft Or intAlignment = alignmentFrameBottomRight)) Then
Line (0, lngTop)-(ScaleWidth, lngTop + lngHeight), colBackColorControl, BF
End If
If blnTriangleTopBottom Then
intX = lngWidth + UserControl.TextHeight("A")
Else
intX = lngWidth
End If
For intY = lngTop To lngTop + lngHeight
If blnTriangleTopBottom Then
intX = intX - 1
Else
intX = intX + 1
End If
Select Case intAlignment
Case enumAlignmentSupFrame.alignmentFrameTopLeft, enumAlignmentSupFrame.alignmentFrameBottomLeft
Line (0, intY)-(intX, intY), colBackColorText
Case enumAlignmentSupFrame.alignmentFrameTopRight, enumAlignmentSupFrame.alignmentFrameBottomRight
Line (ScaleWidth, intY)-(ScaleWidth - intX, intY), colBackColorText
End Select
Next intY
Select Case intAlignment
Case enumAlignmentSupFrame.alignmentFrameTopLeft
lngPictureLeft = 0
If picNormal Is Nothing Then
UserControl.CurrentX = UserControl.TextWidth("M")
Else
UserControl.CurrentX = lngPictureLeft + objGDI.convertPixelsToTwipsX(17)
End If
UserControl.CurrentY = lngTop
Case enumAlignmentSupFrame.alignmentFrameTopRight
lngPictureLeft = objGDI.convertTwipstToPixelsX(UserControl.ScaleWidth) - 17
UserControl.CurrentX = UserControl.ScaleWidth - lngWidth
UserControl.CurrentY = lngTop
Case enumAlignmentSupFrame.alignmentFrameBottomLeft
lngPictureLeft = 0
If picNormal Is Nothing Then
UserControl.CurrentX = UserControl.TextWidth("M")
Else
UserControl.CurrentX = cnstLngLeft + objGDI.convertPixelsToTwipsX(17)
End If
UserControl.CurrentY = lngTop
Case enumAlignmentSupFrame.alignmentFrameBottomRight
lngPictureLeft = objGDI.convertTwipstToPixelsY(UserControl.ScaleWidth) - 17
UserControl.CurrentX = UserControl.ScaleWidth - lngWidth
UserControl.CurrentY = lngTop
End Select
UserControl.ForeColor = TextColor
UserControl.Print strCaption
objGDI.PaintTransparentPicture UserControl.hDC, picNormal, lngPictureLeft, objGDI.convertTwipstToPixelsY(lngTop), objGDI.convertTwipstToPixelsX(UserControl.TextHeight("A")), objGDI.convertTwipstToPixelsX(UserControl.TextHeight("A")), , , colMask
If intAlignment = alignmentFrameTopLeft Or intAlignment = alignmentFrameTopRight Then
If blnTriangleTopBottom Then
lngBorderTop = 0
Else
lngBorderTop = lngHeight + 1
End If
If intBorder = borderFrameNormal Then 'Dibuja todo el borde
Line (0, lngBorderTop)-(UserControl.ScaleWidth - 15, UserControl.ScaleHeight - 15), colBorderColor, B
ElseIf intBorder = borderFrameShadow Or intBorder = borderFrameShadowLight Then
Line (0, lngBorderTop)-(UserControl.ScaleWidth - 45, UserControl.ScaleHeight - 45), colBorderColor, B
Line (30, UserControl.ScaleHeight - 15)-(UserControl.ScaleWidth - 30, UserControl.ScaleHeight - 15), \_
IIf(intBorder = borderFrameShadowLight, colBorderShadow2, colBorderShadow)
Line (15, UserControl.ScaleHeight - 30)-(UserControl.ScaleWidth - 15, UserControl.ScaleHeight - 30), \_
colBorderShadow2
Line (UserControl.ScaleWidth - 30, lngBorderTop)-(UserControl.ScaleWidth - 30, UserControl.ScaleHeight), \_
IIf(intBorder = borderFrameShadowLight, colBorderShadow2, colBorderShadow)
Line (UserControl.ScaleWidth - 15, lngBorderTop + 15)-(UserControl.ScaleWidth - 15, UserControl.ScaleHeight), \_
colBorderShadow
End If
Else
If blnTriangleTopBottom Then
lngBorderTop = 0
Else
lngBorderTop = lngHeight + 1
End If
If intBorder = borderFrameNormal Then
Line (0, 0)-(UserControl.ScaleWidth - 15, UserControl.ScaleHeight - lngHeight), colBorderColor, B
ElseIf intBorder = borderFrameShadow Or intBorder = borderFrameShadowLight Then
Line (0, 30)-(UserControl.ScaleWidth - 45, UserControl.ScaleHeight - lngHeight), colBorderColor, B
Line (30, 30)-(UserControl.ScaleWidth - 30, 30), \_
IIf(intBorder = borderFrameShadowLight, colBorderShadow2, colBorderShadow)
Line (15, 15)-(UserControl.ScaleWidth - 15, 15), \_
colBorderShadow2
Line (UserControl.ScaleWidth - 30, 0)-(UserControl.ScaleWidth - 30, UserControl.ScaleHeight - lngHeight), \_
IIf(intBorder = borderFrameShadowLight, colBorderShadow2, colBorderShadow)
Line (UserControl.ScaleWidth - 15, 15)-(UserControl.ScaleWidth - 15, UserControl.ScaleHeight - lngHeight), \_
colBorderShadow
End If
End If
End Sub
Public Sub Hex2RGB(ByVal strHexColor As String, ByRef bytRed As Byte, ByRef bytGreen As Byte, ByRef bytBlue As Byte)
Dim HexColor As String
Dim intIndex As Byte
On Error Resume Next
strHexColor = Right((strHexColor), 6)
For intIndex = 1 To (6 - Len(strHexColor))
HexColor = HexColor & "0"
Next intIndex
HexColor = HexColor & strHexColor
bytRed = CByte("&H" & Right(HexColor, 2))
bytGreen = CByte("&H" & Mid(HexColor, 3, 2))
bytBlue = CByte("&H" & Left(HexColor, 2))
End Sub
Private Function adjustRGB(ByVal colInitial As OLE\_COLOR, ByVal blnDec As Boolean, ByVal intTimes As Integer) As OLE\_COLOR
Dim R As Byte, G As Byte, B As Byte, iR As Long, iG As Long, iB As Long, intI As Integer
On Local Error Resume Next
Hex2RGB CStr(Hex(colInitial)), R, G, B
iR = CInt(R)
iG = CInt(G)
iB = CInt(B)
For intI = 1 To intTimes
If blnDec Then
iR = decRGB(iR, transformRGB(iR))
iG = decRGB(iG, transformRGB(iG))
iB = decRGB(iB, transformRGB(iB))
Else
iR = incRGB(iR, transformRGB(iR))
iG = incRGB(iG, transformRGB(iG))
iB = incRGB(iB, transformRGB(iB))
End If
Next intI
adjustRGB = RGB(iR, iG, iB)
End Function
Private Function normalizeByte(ByVal lngValue As Long) As Long
normalizeByte = lngValue
If normalizeByte 255 Then
normalizeByte = 255
End If
End Function
Private Function decRGB(ByVal lngValue As Long, lngValueDec As Long) As Long
decRGB = normalizeByte(lngValue - lngValueDec)
End Function
Private Function incRGB(ByVal lngValue As Long, ByVal lngValueInc As Long) As Long
incRGB = normalizeByte(lngValue + lngValueInc)
End Function
Private Function transformRGB(lngValue As Long)
transformRGB = 76 - Int((lngValue + 32) / 64) \* 19
End Function
Public Property Get Caption() As String
Caption = Trim(strCaption)
End Property
Public Property Let Caption(ByVal strNewCaption As String)
strNewCaption = Trim(strNewCaption) & " "
strCaption = strNewCaption
Repaint
PropertyChanged
End Property
Public Property Get CaptionHeight() As Integer
CaptionHeight = UserControl.TextHeight("A")
End Property
Public Property Get Enabled() As Boolean
Enabled = UserControl.Enabled
End Property
Public Property Let Enabled(ByVal blnNewEnabled As Boolean)
UserControl.Enabled = blnNewEnabled
PropertyChanged "Enabled"
UserControl.Refresh
End Property
Public Property Get BorderColor() As OLE\_COLOR
BorderColor = colBorderColor
End Property
Public Property Let BorderColor(ByVal colNewBorderColor As OLE\_COLOR)
colBorderColor = colNewBorderColor
colBorderShadow = adjustRGB(colBorderColor, False, 2)
colBorderShadow2 = adjustRGB(colBorderColor, False, 3)
Repaint
PropertyChanged
End Property
Public Property Get BackColorFrame() As OLE\_COLOR
BackColorFrame = colBackColorFrame
End Property
Public Property Let BackColorFrame(ByVal colNewBackColorFrame As OLE\_COLOR)
colBackColorFrame = colNewBackColorFrame
Repaint
PropertyChanged
End Property
Public Property Get BackColorControl() As OLE\_COLOR
BackColorControl = colBackColorControl
End Property
Public Property Let BackColorControl(ByVal colNewBackColorControl As OLE\_COLOR)
colBackColorControl = colNewBackColorControl
Repaint
PropertyChanged
End Property
Public Property Get PictureMask() As OLE\_COLOR
PictureMask = colMask
End Property
Public Property Let PictureMask(ByVal colNewMaskColor As OLE\_COLOR)
colMask = colNewMaskColor
Repaint
PropertyChanged
End Property
Public Property Get TextColor() As OLE\_COLOR
TextColor = colForeColor
End Property
Public Property Let TextColor(ByVal colNewTextColor As OLE\_COLOR)
colForeColor = colNewTextColor
Repaint
PropertyChanged
End Property
Public Property Get TriangleTopBottom() As Boolean
TriangleTopBottom = blnTriangleTopBottom
End Property
Public Property Let TriangleTopBottom(ByVal blnNewTriangleTopBottom As Boolean)
blnTriangleTopBottom = blnNewTriangleTopBottom
Repaint
PropertyChanged
End Property
Public Property Get Font() As Font
Set Font = UserControl.Font
End Property
Public Property Set Font(ByVal fntNewFontText As Font)
Set fntText = fntNewFontText
Set UserControl.Font = fntText
Repaint
PropertyChanged
End Property
Public Property Get BackColorText() As OLE\_COLOR
BackColorText = colBackColorText
End Property
Public Property Let BackColorText(ByVal colNewBackColorText As OLE\_COLOR)
colBackColorText = colNewBackColorText
Repaint
PropertyChanged
End Property
Public Property Get Border() As enumBorderSupFrame
Border = intBorder
End Property
Public Property Let Border(ByVal intNewBorder As enumBorderSupFrame)
intBorder = intNewBorder
Repaint
PropertyChanged
End Property
Public Property Get Alignment() As enumAlignmentSupFrame
Alignment = intAlignment
End Property
Public Property Let Alignment(ByVal intNewAlignment As enumAlignmentSupFrame)
intAlignment = intNewAlignment
Repaint
PropertyChanged
End Property
Public Property Get BorderShadow() As OLE\_COLOR
BorderShadow = colBorderShadow
End Property
Public Property Let BorderShadow(ByVal colNewBorderShadow As OLE\_COLOR)
colBorderShadow = colNewBorderShadow
Repaint
PropertyChanged
End Property
Public Property Get BorderShadow2() As OLE\_COLOR
BorderShadow2 = colBorderShadow2
End Property
Public Property Let BorderShadow2(ByVal colNewBorderShadow2 As OLE\_COLOR)
colBorderShadow2 = colNewBorderShadow2
Repaint
PropertyChanged
End Property
Public Property Get PictureNormal() As StdPicture
Set PictureNormal = picNormal
End Property
Public Property Set PictureNormal(ByVal picNewPicture As StdPicture)
Set picNormal = picNewPicture
Repaint
PropertyChanged
End Property
Private Sub UserControl\_EnterFocus()
UserControl.Refresh
End Sub
Private Sub UserControl\_Initialize()
Set objGDI = New clsDrawGDI
End Sub
Private Sub UserControl\_Paint()
Repaint
End Sub
Private Sub UserControl\_ReadProperties(PropBag As PropertyBag)
On Error Resume Next
Set Font = PropBag.ReadProperty("FontText", Ambient.Font)
strCaption = PropBag.ReadProperty("Caption", UserControl.Name)
UserControl.Enabled = PropBag.ReadProperty("Enabled", True)
colBorderColor = PropBag.ReadProperty("BorderColor", cnstColBorderColor)
colBackColorFrame = PropBag.ReadProperty("BackColorFrame", cnstColBackColorFrame)
colBackColorControl = PropBag.ReadProperty("BackColorControl", cnstColBackColorControl)
TextColor = PropBag.ReadProperty("TextColor", cnstColForeColor)
colBackColorText = PropBag.ReadProperty("BackColorText", cnstColBackColorText)
intBorder = PropBag.ReadProperty("Border", cnstIntBorder)
intAlignment = PropBag.ReadProperty("Alignment", cnstIntAlignment)
colBorderShadow = PropBag.ReadProperty("BorderShadow", cnstColBorderShadow)
colBorderShadow2 = PropBag.ReadProperty("BorderShadow2", cnstColBorderShadow2)
blnTriangleTopBottom = PropBag.ReadProperty("TriangleTopBottom", cnstblnTriangleTopBottom)
Set picNormal = PropBag.ReadProperty("Picture", Nothing)
colMask = PropBag.ReadProperty("ColorMask", cnstColMask)
Repaint
End Sub
Private Sub UserControl\_Resize()
Repaint
End Sub
Private Sub UserControl\_Show()
UserControl.Refresh
End Sub
Private Sub UserControl\_Terminate()
Set objGDI = Nothing
End Sub
Private Sub UserControl\_WriteProperties(PropBag As PropertyBag)
PropBag.WriteProperty "Caption", Caption, UserControl.Name
PropBag.WriteProperty "Enabled", UserControl.Enabled, True
PropBag.WriteProperty "BorderColor", colBorderColor, cnstColBorderColor
PropBag.WriteProperty "BackColorFrame", colBackColorFrame, cnstColBackColorFrame
PropBag.WriteProperty "BackColorControl", colBackColorControl, cnstColBackColorControl
PropBag.WriteProperty "TextColor", colForeColor, cnstColForeColor
PropBag.WriteProperty "FontText", Font
PropBag.WriteProperty "BackColorText", colBackColorText, cnstColBackColorText
PropBag.WriteProperty "Border", intBorder, cnstIntBorder
PropBag.WriteProperty "Alignment", intAlignment, cnstIntAlignment
PropBag.WriteProperty "BorderShadow", colBorderShadow, cnstColBorderShadow
PropBag.WriteProperty "BorderShadow2", colBorderShadow2, cnstColBorderShadow2
PropBag.WriteProperty "TriangleTopBottom", TriangleTopBottom, cnstblnTriangleTopBottom
PropBag.WriteProperty "Picture", PictureNormal, Nothing
PropBag.WriteProperty "ColorMask", colMask, cnstColMask
End Sub
Private Sub UserControl\_InitProperties()
On Error Resume Next
strCaption = UserControl.Name
colBorderColor = cnstColBorderColor
colBackColorControl = cnstColBackColorControl
colBackColorFrame = cnstColBackColorFrame
colForeColor = cnstColForeColor
colBackColorText = cnstColBackColorText
Set Font = Ambient.Font
intBorder = cnstIntBorder
intAlignment = cnstIntAlignment
colBorderShadow = cnstColBorderShadow
colBorderShadow2 = cnstColBorderShadow2
blnTriangleTopBottom = cnstblnTriangleTopBottom
colMask = cnstColMask
Set picNormal = Nothing
End Sub
Private Sub UserControl\_Click()
RaiseEvent Click
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
MfG Alex