frmdemo.frm

实现闪烁的标题栏

'owner-drawn item.
If chkOD.Value = 0 Then
    chkOD.Caption = "0 - Invisible"
Else
    chkOD.Caption = "1 - Visible"
End If
prp.Value(prp.Selected) = chkOD.Caption

End Sub

Private Sub cmdAdd_Click()

prp.Add txtName.Text, txtValue.Text, False, Val(Trim$(cmdAdd.Tag))

End Sub

Private Sub cmdFill_Click()

'Fill our property list with demo values.

prp.Add "Excalibur PropertyList Control", , , ExPropPropertyHeader

prp.HoldDraw = True

prp.Add "(About)", "", True, ExPropBrowseButton
prp.Add "(Name)", "cmdFill", , ExPropStringValue
prp.Add "Appearance", "1 - 3D", , ExPropCustomValue
prp.Add "BackColor", vbButtonFace, , ExPropOleColor
prp.Add "Cancel", "False", , ExPropBoolValue
prp.Add "Caption", "Load ExPropertyList", , ExPropStringValue
prp.Add "Default", "False", , ExPropBoolValue
prp.Add "DisabledPicture", "(None)", , ExPropBrowseButton
prp.Add "DownPicture", "(None)", , ExPropBrowseButton
prp.Add "DragIcon", "(None)", , ExPropBrowseButton
prp.Add "DragMode", "0 - Manual", , ExPropCustomValue
prp.Add "Enabled", "True", , ExPropBoolValue
prp.Add "Font", "MS Sans Serif", , ExPropBrowseButton
prp.Add "Height", "17", , ExPropNumericValue
prp.Add "HelpContextID", "0", , ExPropStringValue
prp.Add "Index", "0", , ExPropNumericValue
prp.Add "Left", "8", , ExPropNumericValue
prp.Add "MaskColor", &HC0C0C0, , ExPropOleColor
prp.Add "MouseIcon", "(None)", , ExPropBrowseButton
prp.Add "MousePointer", "0 - Default", , ExPropCustomValue
prp.Add "OLEDropMode", "0 - None", , ExPropCustomValue
prp.Add "Picture", "(None)", , ExPropBrowseButton
prp.Add "RightToLeft", "False", , ExPropBoolValue
prp.Add "Style", "0 - Standard", , ExPropCustomValue
prp.Add "TabIndex", "6", , ExPropNumericValue
prp.Add "TabStop", "True", , ExPropBoolValue
prp.Add "Tag", "", , ExPropStringValue
prp.Add "ToolTipText", "", , ExPropStringValue
prp.Add "Top", "224", , ExPropNumericValue
prp.Add "UseMaskColor", "False", , ExPropBoolValue
prp.Add "Visible", "1 - Visible", , ExPropOwnerDraw
prp.Add "WhatsThisHelpID", "0", , ExPropNumericValue
prp.Add "Width", "145", , ExPropNumericValue

prp.HoldDraw = False

End Sub

Private Sub Form_Load()

'Set the owner-draw sink or the property
'list will not process correctly when
'we have owner-drawn items!
'You don't need to do this unless you
'plan to use at least one owner-drawn
'property.
prp.SetOwnerDrawSink Me

End Sub

Private Sub IPropOwnerDrawSink_PropCommitPending(sPropListName As String)

'Here we commit any pending values in
'owner-drawn items, if any. Set the
'Value property of the control to do
'this. The ValueChanged event will
'still fire.

End Sub

Private Sub IPropOwnerDrawSink_PropDrawItem(sPropListName As String, ByVal nIndex As Integer, ByVal bDrawActive As Boolean, ByVal DrawDC As Long, ByVal rctLeft As Long, ByVal rctTop As Long, ByVal rctRight As Long, ByVal rctBottom As Long)

'This method is called when an owner-drawn
'list item needs to be painted.
'The device context in DrawDC already has
'the required font and text color selected
'into it.
'NOTE: We must draw both the left and
'right columns. It is possible to draw over
'the center line separating the columns
'if need be.

'The only owner-drawn item we have is the
' Visible property, so we don't need to
' check for index...

Dim nMidPt As Long
Dim rct As RECT 'General-purpose RECT
Dim hBr As Long 'Handle to a brush
Dim CaptionToDraw As String, ValueToDraw As String

CaptionToDraw = prp.Item(nIndex)
ValueToDraw = prp.Value(nIndex)

rct.Left = rctLeft - 2
rct.Top = rctTop - 1
rct.Bottom = rctBottom - 1
'This is where the line in between columns sits
nMidPt = (prp.LongestItem \ Screen.TwipsPerPixelX) + 2
rct.Right = nMidPt - 1

'===========
'Draw the first column
'===========
If bDrawActive Then
    'Draw selected state
    hBr = CreateSolidBrush(GetSysColor(COLOR_HIGHLIGHT))
    FillRect DrawDC, rct, hBr
    DeleteObject hBr
    SetTextColor DrawDC, GetSysColor(COLOR_HIGHLIGHTTEXT)
    rct.Left = rct.Left + 2
    rct.Top = rct.Top + 1
    BitBlt DrawDC, rct.Left, rct.Top, 16, 13, picOD.hdc, 0, 1, vbSrcCopy
    rct.Left = rct.Left + 17
    DrawText DrawDC, CaptionToDraw, Len(CaptionToDraw), rct, DT_SINGLELINE Or DT_VCENTER
Else
    'Not selected, but give it some
    'individuality with a blue color
    'and a small image.
    rct.Left = rct.Left + 2
    rct.Top = rct.Top + 1
    BitBlt DrawDC, rct.Left, rct.Top, 16, 13, picOD.hdc, 0, 1, vbSrcCopy
    rct.Left = rct.Left + 17
    SetTextColor DrawDC, vbBlue
    DrawText DrawDC, CaptionToDraw, Len(CaptionToDraw), rct, DT_SINGLELINE Or DT_VCENTER
End If

'===========
'Draw the second column
'===========
rct.Left = nMidPt + 4
rct.Right = rct.Left + 16
rct.Bottom = rct.Bottom - 1
If ValueToDraw = "1 - Visible" Then
    DrawFrameControl DrawDC, rct, DFC_BUTTON, DFCS_BUTTONCHECK Or _
        DFCS_CHECKED
Else
    DrawFrameControl DrawDC, rct, DFC_BUTTON, DFCS_BUTTONCHECK 'Or _
        DFCS_CHECKED
End If
rct.Left = rct.Right + 3
rct.Right = rctRight
SetTextColor DrawDC, vbRed
DrawText DrawDC, ValueToDraw, Len(ValueToDraw), rct, DT_SINGLELINE Or DT_VCENTER

End Sub

Private Sub IPropOwnerDrawSink_PropHideCtrls(sPropListName As String)

'The property list wants us to hide any
'controls that we may be using for
'owner-drawn items.
chkOD.Visible = False

End Sub

Private Sub IPropOwnerDrawSink_PropPlaceCtrl(sPropListName As String, ByVal nIndex As Integer, ByVal rctLeft As Long, ByVal rctTop As Long, ByVal rctWidth As Long, ByVal rctHeight As Long)

'The property list tells us exactly where to
'put a control if we want one for this
'owner-drawn item. Make it visible at this
'time as well.
chkOD.Caption = prp.Value(nIndex)
If chkOD.Caption = "1 - Visible" Then
    chkOD.Value = 1
Else
    chkOD.Value = 0
End If
chkOD.Move rctLeft, rctTop, rctWidth, rctHeight
chkOD.Visible = True

End Sub

Private Sub prp_Browse(ByVal Name As String, ByVal Index As Integer, FillWith As String)

dlg.Flags = cdlOFNHideReadOnly Or cdlOFNFileMustExist Or _
    cdlCFBoth

If Index = 1 Then 'About
    Dim sMsg As String
    sMsg = "ExPropertyList 1.0 Demo Application." & vbCrLf
    MsgBox sMsg, vbInformation
ElseIf Index = 7 Or Index = 8 Or Index = 9 _
Or Index = 19 Or Index = 22 Then 'All picture properties
    dlg.filename = ""
    dlg.ShowOpen
    If Len(dlg.filename) > 0 Then
        FillWith = "(Bitmap)" 'Although could be icon, etc.
    Else
        FillWith = "(None)"
    End If
ElseIf Index = 13 Then 'Bring up Font dialog
    dlg.FontName = prp.Value(12)
    dlg.ShowFont
    FillWith = dlg.FontName
End If

End Sub

Private Sub prp_DblClick()

'Change the owner-drawn item?
If prp.ItemType(prp.Selected) = ExPropOwnerDraw Then
    chkOD.Value = Abs(Not -chkOD.Value)
End If

End Sub

Private Sub prp_MouseUp(Button As Integer, Shift As Integer, x As Single, Y As Single)

If x > prp.LongestItem + 45 Then
    'Clicked in the second column
    prp_DblClick
End If

End Sub

Private Sub prp_NeedData(ByVal Index As Integer, ListItems() As String)

If Index = 3 Then 'Appearance
    ReDim ListItems(1) As String
    ListItems(0) = "0 - Flat"
    ListItems(1) = "1 - 3D"
ElseIf Index = 11 Then 'DragMode
    ReDim ListItems(1) As String
    ListItems(0) = "0 - Manual"
    ListItems(1) = "1 - Automatic"
ElseIf Index = 20 Then 'MousePointer
    ReDim ListItems(16)
    ListItems(0) = "0 - Default"
    ListItems(1) = "1 - Arrow"
    ListItems(2) = "2 - Cross"
    ListItems(3) = "3 - I-Beam"
    ListItems(4) = "4 - Icon"
    ListItems(5) = "5 - Size"
    ListItems(6) = "6 - Size NE SW"
    ListItems(7) = "7 - Size N S"
    ListItems(8) = "8 - Size NW SE"
    ListItems(9) = "9 - Size W E"
    ListItems(10) = "10 - Up Arrow"
    ListItems(11) = "11 - Hourglass"
    ListItems(12) = "12 - No Drop"
    ListItems(13) = "13 - Arrow and Hourglass"
    ListItems(14) = "14 - Arrow and Question"
    ListItems(15) = "15 - Size All"
    ListItems(16) = "99 - Custom"
ElseIf Index = 21 Then 'OLEDropMode
    ReDim ListItems(1)
    ListItems(0) = "0 - None"
    ListItems(1) = "1 - Manual"
ElseIf Index = 24 Then 'Style
    ReDim ListItems(1)
    ListItems(0) = "0 - Standard"
    ListItems(1) = "1 - Graphical"
End If

End Sub

Private Sub prp_SelChange(ByVal OldSel As Integer, ByVal NewSel As Integer)

'Demo of the SelChange event...
lbl.Caption = "Selection changed, OldSel = " & OldSel & _
    ", NewSel = " & NewSel & "."

End Sub

Private Sub prp_ValueChanged(ByVal Name As String, ByVal Index As Integer, ByVal NewValue As String, Cancel As Boolean)

'Demo of the ValueChanged event - it works... <g>
lbl.Caption = "Property " & Index & " ('" & Name & "') changed to '" & NewValue & "'."

End Sub