lvbuttons.ctl

Address Book implemented in VB 6,can be use for storing person information

End Enum
Public Enum CustomCickConstants
    lv_cDefault = 0
    lv_cNorth = 1
    lv_cNorthEast = 2
    lv_cNorthWest = 3
    lv_cSouthEast = 4
    lv_cSouthWest = 5
    lv_cEast = 6
    lv_cSouth = 7
    lv_cWest = 8
End Enum
Public Enum GradientConstants       ' gradient directions
    lv_NoGradient = 0
    lv_Left2Right = 1
    lv_Right2Left = 2
    lv_Top2Bottom = 3
    lv_Bottom2Top = 4
End Enum
Public Enum CaptionEffectConstants  ' caption styles
    lv_Default = 0
    lv_Sunken = 1
    lv_Raised = 2
End Enum
Public Enum FontStyles
    lv_PlainStyle = 0
    lv_Bold = 2
    lv_Italic = 4
    lv_Underline = 8
    lv_BoldItalic = 2 Or 4
    lv_BoldUnderline = 2 Or 8
    lv_ItalicUnderline = 4 Or 8
    lv_BoldItalicUnderline = 2 Or 4 Or 8
End Enum

Public Enum BackStyleConstants      ' button styles
    lv_w95 = 0
    lv_w31 = 1
    lv_XP = 2
    lv_Java = 3
    lv_Flat = 4
    lv_hover = 5
    lv_Netscape = 6
    lv_Macintosh = 7
End Enum
Public Property Let ButtonStyle(Style As BackStyleConstants)
Attribute ButtonStyle.VB_Description = "Various operating system button styles"

' Sets the style of button to be displayed

If Style < 0 Or Style > 7 Then Exit Property
Dim lastStyle As Integer
lastStyle = myProps.bBackStyle
myProps.bBackStyle = Style
' no need to change shapes for custom buttons or round buttons that are not changing to/from Hover
If myProps.bShape < lv_Round3D Or _
   myProps.bShape < lv_CustomFlat And (myProps.bBackStyle = lv_hover Or lastStyle = lv_hover) Then CreateButtonRegion        ' re-create the button shape
CalculateBoundingRects False            ' recalculate the text/image bounding rectangles
GetGDIMetrics "BackColor"          ' cache base colors
RedrawButton
PropertyChanged "BackStyle"
End Property

Public Property Get ButtonStyle() As BackStyleConstants
ButtonStyle = myProps.bBackStyle
End Property
Public Property Let Mode(nMode As ButtonModeConstants)
Attribute Mode.VB_Description = "Command button, check box or option button mode"

' Sets the button function/mode

If nMode < lv_CommandButton Or nMode > lv_OptionButton Then Exit Property
If myProps.bMode = lv_OptionButton Then
    ' option buttons. Need to remove references if the Mode changed
    If nMode < lv_OptionButton Then Call ToggleOptionButtons(-1)
End If
If myProps.bMode < lv_OptionButton And nMode = lv_OptionButton Then
    Call ToggleOptionButtons(1) ' add this instance to optionbutton collection
End If
If nMode = lv_CommandButton And myProps.bMode > lv_CommandButton Then Me.Value = False
myProps.bMode = nMode
RedrawButton
PropertyChanged "Mode"
End Property
Public Property Get Mode() As ButtonModeConstants
Mode = myProps.bMode
End Property

Public Property Let Caption(sCaption As String)
Attribute Caption.VB_Description = "The caption of the button. Double pipe (||) is a line break."
Attribute Caption.VB_ProcData.VB_Invoke_PropertyPut = ";Appearance"
Attribute Caption.VB_UserMemId = -518
Attribute Caption.VB_MemberFlags = "200"

' Sets the button caption & hot key for the control

Dim I As Integer, J As Integer
' We look from right to left. VB uses this logic & so do I
I = InStrRev(sCaption, "&")
Do While I
    If Mid$(sCaption, I, 2) = "&&" Then
        I = InStrRev(I - 1, sCaption, "&")
    Else
        J = I + 1: I = 0
    End If
Loop
' if found, we use the next character as a hot key
If J Then AccessKeys = Mid$(sCaption, J, 1)
myProps.bCaption = sCaption                     ' cache the caption
CalculateBoundingRects False                          ' recalculate button text/image bounding rects
RedrawButton
PropertyChanged "Caption"
End Property
Public Property Get Caption() As String
Caption = myProps.bCaption
End Property

Public Property Let CaptionAlign(nAlign As AlignmentConstants)
Attribute CaptionAlign.VB_Description = "Horizontal alignment of caption on the button."
Attribute CaptionAlign.VB_ProcData.VB_Invoke_PropertyPut = ";Appearance"

' Caption options: Left, Right or Center Justified

If nAlign < vbLeftJustify Or nAlign > vbCenter Then Exit Property
If myImage.Align > lv_RightOfCaption And nAlign < vbCenter And (myImage.SourceSize.X + myImage.SourceSize.Y) > 0 Then
    ' also prevent left/right justifying captions when image is centered in caption
    If UserControl.Ambient.UserMode = False Then
        ' if not in user mode, then explain whey it is prevented
        MsgBox "When button images are aligned top/bottom center, " & vbCrLf & "button captions can only be center aligned", vbOKOnly + vbInformation
    End If
    Exit Property
End If
myProps.bCaptionAlign = nAlign
CalculateBoundingRects False              ' recalculate text/image bounding rects
RedrawButton
PropertyChanged "CapAlign"
End Property
Public Property Get CaptionAlign() As AlignmentConstants
CaptionAlign = myProps.bCaptionAlign
End Property

Public Property Let CaptionStyle(nStyle As CaptionEffectConstants)
Attribute CaptionStyle.VB_Description = "Flat, Embossed or Engraved effects"

' Sets the style, raised/sunken or flat (default)

If nStyle < lv_Default Or nStyle > lv_Raised Then Exit Property
myProps.bCaptionStyle = nStyle
PropertyChanged "CapStyle"
If Len(myProps.bCaption) Then
    CalculateBoundingRects False
    RedrawButton
End If
End Property
Public Property Get CaptionStyle() As CaptionEffectConstants
CaptionStyle = myProps.bCaptionStyle
End Property

Public Property Let CustomClick(nOpt As CustomCickConstants)
Attribute CustomClick.VB_Description = "Custom shaped buttons only. Moves the button vs the traditional click effect."
If nOpt < lv_cDefault Or nOpt > lv_cWest Then Exit Property
If Not Ambient.UserMode And myProps.bShape < lv_CustomFlat And nOpt > lv_cDefault Then
    MsgBox "This property has no effect unless the Button Shape is a custom shape.", vbInformation + vbOKOnly
End If
myProps.bCustomClick = nOpt
PropertyChanged "CustomClick"
End Property
Public Property Get CustomClick() As CustomCickConstants
CustomClick = myProps.bCustomClick
End Property

Public Property Let ButtonShape(nShape As ButtonStyleConstants)
Attribute ButtonShape.VB_Description = "Rectangular or various diagonal shapes"
Attribute ButtonShape.VB_ProcData.VB_Invoke_PropertyPut = ";Appearance"

' Sets the button's shape (rectangular, diagonal, or circular)

If nShape < lv_Rectangular Or nShape > lv_Custom3DBorder Then Exit Property
If nShape > lv_RoundFlat Then   ' custom shapes
    If Me.Picture Is Nothing Or myImage.Type = CI_ICON Then
        If Not Ambient.UserMode Then MsgBox "The Picture Property must be assigned first and must be a bitmap or JPEG.", vbInformation + vbOKOnly
        Exit Property
    Else
        If Me.PictureSize <> lv_Fill_ScaleUpDown Then
            DelayDrawing True
            Me.PictureSize = lv_Fill_ScaleUpDown
            bNoRefresh = False
        End If
    End If
End If
myProps.bShape = nShape
If myProps.bCaptionAlign <> vbCenter Then myProps.bCaptionAlign = vbCenter
Call UserControl_Resize
myProps.bCaptionAlign = Me.CaptionAlign
DelayDrawing False
PropertyChanged "Shape"
End Property
Public Property Get ButtonShape() As ButtonStyleConstants
ButtonShape = myProps.bShape
End Property

Public Property Set Picture(xPic As StdPicture)
Attribute Picture.VB_Description = "The image used to display on the button."

' Sets the button image which to display
Set myImage.Image = xPic
If myImage.Size = 0 Then myImage.Size = 16
GetGDIMetrics "Picture"
If myProps.bShape > lv_RoundFlat Then   ' custom shapes
    If xPic Is Nothing Then
        Me.ButtonShape = lv_Rectangular
    Else
        If myImage.Type = CI_ICON Then
            Me.ButtonShape = lv_Rectangular
            If Not Ambient.UserMode Then MsgBox "Icons cannot be used for custom buttons. Only use bitmaps or JPEGs." & vbCrLf & "Button was changed to Rectangular shaped.", vbInformation + vbOKOnly
        End If
    End If
    Call UserControl_Resize
Else
    CalculateBoundingRects True              ' recalculate button's text/image bounding rects
    RedrawButton
End If
PropertyChanged "Image"
End Property
Public Property Get Picture() As StdPicture
Set Picture = myImage.Image
End Property

Public Property Let PictureAlign(ImgAlign As ImagePlacementConstants)
Attribute PictureAlign.VB_Description = "Alignment of the button image in relation to the caption and/or button."

' Image alignment options for button (6 different positions)

If ImgAlign < lv_LeftEdge Or ImgAlign > lv_BottomCenter Then Exit Property
myImage.Align = ImgAlign
If ImgAlign = lv_BottomCenter Or ImgAlign = lv_TopCenter Then CaptionAlign = vbCenter
CalculateBoundingRects False             ' recalculate button's text/image bounding rects
RedrawButton
PropertyChanged "ImgAlign"
End Property
Public Property Get PictureAlign() As ImagePlacementConstants
PictureAlign = myImage.Align
End Property

Public Property Let Enabled(bEnabled As Boolean)
Attribute Enabled.VB_Description = "Determines if events are fired for this button."
Attribute Enabled.VB_ProcData.VB_Invoke_PropertyPut = ";Behavior"
Attribute Enabled.VB_UserMemId = -514

' Enables or disables the button

If bEnabled = UserControl.Enabled Then Exit Property
UserControl.Enabled = bEnabled
If myProps.bBackStyle = 3 And myProps.bMode = lv_CommandButton And _
    myProps.bShape < lv_Round3D Then
    ' java disabled does not have the lower-left/upper-right pixels
    DelayDrawing True
    CreateButtonRegion
    CalculateBoundingRects False
    DelayDrawing False
Else
    RedrawButton
End If
PropertyChanged "Enabled"
End Property
Public Property Get Enabled() As Boolean
Enabled = UserControl.Enabled
End Property

Public Property Let ShowFocusRect(bShow As Boolean)
Attribute ShowFocusRect.VB_Description = "Allows or prevents a focus rectangle from being displayed. In design mode, this may always be displayed for button set as Default."
Attribute ShowFocusRect.VB_ProcData.VB_Invoke_PropertyPut = ";Appearance"

' Shows/hides the focus rectangle when button comes into focus

myProps.bShowFocus = bShow
If ((myProps.bStatus And 1) = 1) Then
    ' if currently has the focus, then we take it off
    If Ambient.UserMode Then
        myProps.bStatus = myProps.bStatus And Not 1
        RedrawButton
    Else
        ' however, we don't if it is the default button
        MsgBox "The focus rectangle may appear on default buttons ONLY while in design mode, " & vbCrLf & _
            "but will not appear when the form is running.", vbInformation + vbOKOnly
    End If
Else
    RedrawButton
End If
PropertyChanged "Focus"
End Property
Public Property Get ShowFocusRect() As Boolean
ShowFocusRect = myProps.bShowFocus
End Property

Public Property Let Value(bValue As Boolean)
Attribute Value.VB_Description = "Applicable to only check box or option button modes: True or False"
Attribute Value.VB_UserMemId = 0

' For option button & check box modes

If myProps.bMode = lv_CommandButton And bValue = True Then
    ' TRUE values for command buttons not allowed
    If Not UserControl.Ambient.UserMode Then
        MsgBox "This property is not applicable for command button modes.", vbInformation + vbOKOnly
    End If
    Exit Property