styler~1.ctl

近期下载过的用户: yueshan1020 孙江波 王洪贵 成长 林健 张见 chenhaocheng 胡云龙 yms sdfsd zhong 陈晨 lee 戴友情 [查看上载者韩悦的更多信息]

Private Sub UserControl_KeyPress(KeyAscii As Integer)
If bolEnabled = True Then
    RaiseEvent KeyPress(KeyAscii)
    
    If KeyAscii = 13 Then
        RaiseEvent Click
    End If

End If
End Sub

Private Sub UserControl_KeyUp(KeyCode As Integer, Shift As Integer)
If bolEnabled = True Then
    RaiseEvent KeyUp(KeyCode, Shift)
    
    If KeyCode = 32 Then
        bolMouseDown = False
        PaintControl
    End If

End If
End Sub

Private Sub UserControl_LostFocus()
If bolEnabled = True Then
    bolHasFocus = False
    PaintControl
End If
End Sub

Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If bolEnabled = True Then
    RaiseEvent MouseDown(Button, Shift, X, Y)
    
    If Button = 1 Then
        bolMouseDown = True
        PaintControl
    End If

End If
End Sub

Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If bolEnabled = True Then
    RaiseEvent MouseMove(Button, Shift, X, Y)
End If
End Sub

Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If bolEnabled = True Then
    RaiseEvent MouseUp(Button, Shift, X, Y)
    
    If Button = 1 Then
        bolMouseDown = False
        PaintControl
    End If

End If
End Sub

Private Sub UserControl_Paint()
UserControl.Cls
PaintControl
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
With PropBag
    Let Caption = .ReadProperty("Caption", "")
    Let CaptionDisableColor = .ReadProperty("CaptionDisableColor", RGB(212, 212, 212))
    Let IconDisableColor = .ReadProperty("IconDisableColor", RGB(212, 212, 212))
    Let CaptionEffectColor = .ReadProperty("CaptionEffectColor", RGB(200, 200, 200))
    Let CaptionEffect = .ReadProperty("CaptionEffect", 1)
    Let CaptionOffsetY = .ReadProperty("CaptionOffsetY", 0)
    Let CaptionOffsetX = .ReadProperty("CaptionOffsetX", 0)
    Let ShadowOffsetY = .ReadProperty("ShadowOffsetY", 2)
    Let ShadowOffsetX = .ReadProperty("ShadowOffsetX", 2)
    Let ForeColor = .ReadProperty("ForeColor", 0)
    Let Theme = .ReadProperty("Theme", 1)
    Let FocusDottedRect = .ReadProperty("FocusDottedRect", True)
    Let Enabled = .ReadProperty("Enabled", True)
    Set Font = .ReadProperty("Font", Ambient.Font)
    Set Icon = .ReadProperty("Icon", Nothing)
    Let IconTransparentColour = .ReadProperty("IconTransparentColour", RGB(255, 0, 255))
    Let RoundedValue = .ReadProperty("RoundedValue", 5)
    Let CaptionAlignment = .ReadProperty("CaptionAlignment", 5)
    Let IconAlignment = .ReadProperty("IconAlignment", [Left Justify])
End With

tmrCheck.Enabled = Ambient.UserMode
End Sub

Private Sub UserControl_Terminate()
tmrCheck.Enabled = False
bolMouseDown = False
bolMouseOver = False
bolHasFocus = False
UserControl.Cls
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
With PropBag
    .WriteProperty "Caption", strCaption, ""
    .WriteProperty "ForeColor", oleForeColor, 0
    .WriteProperty "CaptionDisableColor", CapDis, RGB(212, 212, 212)
    .WriteProperty "CaptionEffectColor", CEC, RGB(200, 200, 200)
    .WriteProperty "CaptionEffect", CTE, 1
    .WriteProperty "CaptionOffsetX", COX, 0
    .WriteProperty "CaptionOffsetY", COY, 0
    .WriteProperty "ShadowOffsetX", SOX, 2
    .WriteProperty "ShadowOffsetY", SOY, 2
    .WriteProperty "IconDisableColor", IcoDis, RGB(212, 212, 212)
    .WriteProperty "Theme", udtColorStyle, 1
    .WriteProperty "FocusDottedRect", bolFocusDottedRect, True
    .WriteProperty "Enabled", bolEnabled, True
    .WriteProperty "Font", fntFont, Ambient.Font
    .WriteProperty "Icon", picIcon, Nothing
    .WriteProperty "IconTransparentColour", IcoTransparent, RGB(255, 0, 255)
    .WriteProperty "RoundedValue", lonRoundValue, 5
    .WriteProperty "CaptionAlignment", udtCaptionAlign, 5
    .WriteProperty "IconAlignment", udtIconAlign, [Left Justify]
End With
End Sub

Private Sub UserControl_InitProperties()
Let Caption = Ambient.DisplayName
Let ForeColor = 0
Let Theme = 1
Let FocusDottedRect = True
Let Enabled = True
Set Font = Ambient.Font
Set Icon = Nothing
Let IconTransparentColour = RGB(255, 0, 255)
Let RoundedValue = 5
Let CaptionAlignment = 5
Let CaptionOffsetX = 0
Let CaptionOffsetY = 0
Let ShadowOffsetX = 2
Let ShadowOffsetY = 2
Let CaptionEffectColor = vbWhite
Let CaptionEffect = 1
Let IconAlignment = [Left Justify]
Let CaptionDisableColor = RGB(212, 212, 212)
Let IconDisableColor = RGB(212, 212, 212)
tmrCheck.Enabled = Ambient.UserMode
End Sub



'Invert a color; get the opposite color for another color (i.e: white = black).
Private Function InvertColor(ByVal RValue As Integer, ByVal GValue As Integer, ByVal BValue As Integer) As Long
Dim intR As Integer, intG As Integer, intB As Integer

intR = Abs(255 - RValue)
intG = Abs(255 - GValue)
intB = Abs(255 - BValue)

InvertColor = RGB(intR, intG, intB)
End Function


Private Sub LongToRGB(ByRef RValue As Integer, ByRef GValue As Integer, ByRef BValue As Integer, ByVal ColorValue As Long)
Dim intR As Integer, intG As Integer, intB As Integer

intR = ColorValue Mod 256
intG = ((ColorValue And &HFF00) / 256&) Mod 256&
intB = (ColorValue And &HFF0000) / 65536

RValue = intR
GValue = intG
BValue = intB
End Sub


Private Function LightenColor(ByVal RValue As Integer, ByVal GValue As Integer, ByVal BValue As Integer, Optional ByVal OffSet As Long = 1) As Long
Dim intR As Integer, intG As Integer, intB As Integer

intR = Abs(RValue + OffSet)
intG = Abs(GValue + OffSet)
intB = Abs(BValue + OffSet)

LightenColor = RGB(intR, intG, intB)
End Function


Private Function DarkenColor(ByVal RValue As Integer, ByVal GValue As Integer, ByVal BValue As Integer, Optional ByVal OffSet As Long = 1) As Long
Dim intR As Integer, intG As Integer, intB As Integer

intR = Abs(RValue - OffSet)
intG = Abs(GValue - OffSet)
intB = Abs(BValue - OffSet)

DarkenColor = RGB(intR, intG, intB)
End Function


Private Sub ReplaceColor(PictureObject As PictureBox, ColorValue As Long, ReplaceWith As Long)
Dim lonSW As Long, lonSH As Long
Dim lonLoopW As Long, lonLoopH As Long

PictureObject.ScaleMode = vbPixels
lonSW = PictureObject.ScaleWidth
lonSH = PictureObject.ScaleHeight

For lonLoopW = 0 To lonSW
    
    For lonLoopH = 0 To lonSH
        
        If PictureObject.Point(lonLoopW, lonLoopH) = ColorValue Then
            PictureObject.PSet (lonLoopW, lonLoopH), ReplaceWith
        End If
    
    Next lonLoopH

Next lonLoopW
End Sub
Private Sub CreatePictureMask(nPictureBoxname As PictureBox, nTraansparentColor As OLE_COLOR, nMaskColor)
nPictureBoxname.AutoSize = True
Dim X As Long, Y As Long
Dim SW As Long, SH As Long
SH = nPictureBoxname.ScaleHeight
SW = nPictureBoxname.ScaleWidth

For X = 0 To SW
    For Y = 0 To SH
        If nPictureBoxname.Point(X, Y) = nTraansparentColor Then
        Else
            nPictureBoxname.PSet (X, Y), nMaskColor
        End If
    Next
Next
End Sub
Private Function LongToSignedShort(ByVal Unsigned As Long) As Integer
If Unsigned < 32768 Then
    LongToSignedShort = CInt(Unsigned)
Else
    LongToSignedShort = CInt(Unsigned - &H10000)
End If
End Function

Private Sub DefineRect(ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long)
SetRect udtRect, X1, Y1, X2, Y2
End Sub

Private Sub DrawGradientTwoColour(ByVal hDC As Long, Direction As GRADIENT_DIRECT, ByVal StartColor As Long, ByVal EndColor As Long)
Dim udtVert(1) As TRIVERTEX, udtGRect As GRADIENT_RECT
With udtVert(0)
    .X = udtRect.Left
    .Y = udtRect.Top
    .Red = LongToSignedShort(CLng((StartColor And &HFF&) * 256))
    .Green = LongToSignedShort(CLng(((StartColor And &HFF00&) \ &H100&) * 256))
    .Blue = LongToSignedShort(CLng(((StartColor And &HFF0000) \ &H10000) * 256))
    .Alpha = 0&
End With

With udtVert(1)
    .X = udtRect.Right
    .Y = udtRect.Bottom
    .Red = LongToSignedShort(CLng((EndColor And &HFF&) * 256))
    .Green = LongToSignedShort(CLng(((EndColor And &HFF00&) \ &H100&) * 256))
    .Blue = LongToSignedShort(CLng(((EndColor And &HFF0000) \ &H10000) * 256))
    .Alpha = 0&
End With

udtGRect.UpperLeft = 0
udtGRect.LowerRight = 1

GradientFillRect hDC, udtVert(0), 2, udtGRect, 1, Direction
End Sub

Public Function DrawGradientFourColour(ObjectHDC As Long, Left As Long, Top As Long, Width As Long, Height As Long, TopLeftColour As Long, TopRightColour As Long, BottomLeftColour As Long, BottomRightColour As Long)
    Dim bi24BitInfo     As BITMAPINFO
    Dim bBytes()        As Byte
    Dim LeftGrads()     As cRGB
    Dim RightGrads()    As cRGB
    Dim MiddleGrads()   As cRGB
    Dim TopLeft         As cRGB
    Dim TopRight        As cRGB
    Dim BottomLeft      As cRGB
    Dim BottomRight     As cRGB
    Dim iLoop           As Long
    Dim bytesWidth      As Long
    
    With TopLeft
        .Red = Red(TopLeftColour)
        .Green = Green(TopLeftColour)
        .Blue = Blue(TopLeftColour)
    End With
    
    With TopRight
        .Red = Red(TopRightColour)
        .Green = Green(TopRightColour)
        .Blue = Blue(TopRightColour)
    End With
    
    With BottomLeft
        .Red = Red(BottomLeftColour)
        .Green = Green(BottomLeftColour)
        .Blue = Blue(BottomLeftColour)
    End With
    
    With BottomRight
        .Red = Red(BottomRightColour)
        .Green = Green(BottomRightColour)
        .Blue = Blue(BottomRightColour)
    End With
    
    GradateColours LeftGrads, Height, TopLeft, BottomLeft
    GradateColours RightGrads, Height, TopRight, BottomRight
    
    With bi24BitInfo.bmiHeader
        .biBitCount = 24
        .biCompression = BI_RGB
        .biPlanes = 1
        .biSize = Len(bi24BitInfo.bmiHeader)
        .biWidth = Width
        .biHeight = 1
    End With
    
    ReDim bBytes(1 To bi24BitInfo.bmiHeader.biWidth * bi24BitInfo.bmiHeader.biHeight * 3) As Byte
    
    bytesWidth = (Width) * 3
    
    For iLoop = 0 To Height - 1
        GradateColours MiddleGrads, Width, LeftGrads(iLoop), RightGrads(iLoop)
        CopyMemory bBytes(1), MiddleGrads(0), bytesWidth
        SetDIBitsToDevice ObjectHDC, Left, Top + iLoop, bi24BitInfo.bmiHeader.biWidth, bi24BitInfo.bmiHeader.biHeight, 0, 0, 0, bi24BitInfo.bmiHeader.biHeight, bBytes(1), bi24BitInfo, DIB_RGB_COLORS
    Next iLoop
    
    
End Function

Private Function GradateColours(cResults() As cRGB, Length As Long, Colour1 As cRGB, Colour2 As cRGB)
    Dim fromR   As Integer
    Dim toR     As Integer
    Dim fromG   As Integer
    Dim toG     As Integer
    Dim fromB   As Integer
    Dim toB     As Integer
    Dim stepR   As Single
    Dim stepG   As Single
    Dim stepB   As Single
    Dim iLoop   As Long
    
    ReDim cResults(0 To Length)
    
    fromR = Colour1.Red
    fromG = Colour1.Green
    fromB = Colour1.Blue
    
    toR = Colour2.Red
    toG = Colour2.Green
    toB = Colour2.Blue
    
    stepR = Divide(toR - fromR, Length)
    stepG = Divide(toG - fromG, Length)
    stepB = Divide(toB - fromB, Length)
    
    For iLoop = 0 To Length
        cResults(iLoop).Red = fromR + (stepR * iLoop)
        cResults(iLoop).Green = fromG + (stepG * iLoop)
        cResults(iLoop).Blue = fromB + (stepB * iLoop)
    Next iLoop
End Function
Private Function Blue(Colour As Long) As Long
    Blue = (Colour And &HFF0000) / &H10000
End Function

Private Function Green(Colour As Long) As Long
    Green = (Colour And &HFF00&) / &H100
End Function

Private Function Red(Colour As Long) As Long
    Red = (Colour And &HFF&)
End Function

Private Function Divide(Numerator, Denominator) As Single
    If Numerator = 0 Or Denominator = 0 Then
        Divide = 0
    Else
        Divide = Numerator / Denominator
    End If
End Function
Public Sub About()
Attribute About.VB_UserMemId = -552
FrmAbout.Show
End Sub