Active Desktop

[bjd4jc]

Has anyone ever used VB6 (or anything besides C) to add an item to active desktop?

I have found this article on msdn but can not figure out how to use it through VB.

http://msdn.microsoft.com/library/d.../programmersguide/shell_adv/activedesktop.asp

How can I go about implementing IActiveDesktop?

 

[bjd4jc]

Just in case some one stumbles upon this thread via search...

I found a Type Library that someone else had written and is located here:

http://www.msjogren.net/dotnet/eng/samples/vb6_adwallpaper.asp

License agreement is here:

http://www.msjogren.net/dotnet/eng/samples/license.txt

Here is a class I created to be able to use it from VBScript. I have not yet completely fine tuned it:

Private pcomp As COMPONENT
Private co As COMPONENTSOPT
Private arrFriendlyName() As Byte
Private arrSource() As Byte
Private ad As VBActiveDesktop.ActiveDesktop
Private mForce As Boolean
Private mlngTop As Long
Private mlngLeft As Long
Private mintPosition As Integer
Private mlngWidth As Long
Private mlngHeight As Long

Public Property Let Force(fForce As Boolean)
    mForce = fForce
End Property

Public Property Get Force() As Boolean
    Force = mForce
End Property

Public Property Let FriendlyName(strFriendlyName As String)
    Dim LCV As Long
    arrFriendlyName = strFriendlyName
    For LCV = LBound(arrFriendlyName) To UBound(arrFriendlyName)
        pcomp.wszFriendlyName(LCV) = arrFriendlyName(LCV)
    Next
End Property

Public Property Get FriendlyName() As String
    FriendlyName = arrFriendlyName
End Property

Public Property Let Source(strSource As String)
    Dim LCV As Long
    arrSource = strSource
    For LCV = LBound(arrSource) To UBound(arrSource)
        pcomp.wszSource(LCV) = arrSource(LCV)
    Next
End Property

Public Property Get Source() As String
    Source = arrSource
End Property

Public Property Let ComponentType(lngComponentType As Long)
    pcomp.iComponentType = lngComponentType '0=HTML Doc, 2="WEB SITE"
End Property

Public Property Get ComponentType() As Long
    ComponentType = pcomp.iComponentType
End Property

Public Sub CreateDesktopItem()
    pcomp.dwID = 0
    pcomp.fChecked = True
    pcomp.fDirty = False
    pcomp.fNoScroll = True
    pcomp.dwCurItemState = IS_NORMAL
    pcomp.dwSize = Len(pcomp)
    
    Select Case mintPosition
        Case 0 ' this is manual
            'don't do anything
        Case 1 'lower left hand corner
            mlngLeft = 0
            'must calculate the top
            mlngTop = Screen.Height - mlngHeight
            'mlngTop = 0
        Case 2 ' upper left hand corner
            'no calculations needed
            mlngLeft = 0
            mlngTop = 0
        Case 3 'Upper right hand corner
            'must calculate the left position
            mlngLeft = Screen.Width - mlngWidth
            mlngTop = 0
            
        Case 4 ' Lower right hand corner
            'must calculate the top and left positions
            mlngTop = Screen.Height - mlngHeight
            mlngLeft = Screen.Width - mlngWidth
    End Select
    
    pcomp.cpPos.dwHeight = mlngHeight
    pcomp.cpPos.dwWidth = mlngWidth
    pcomp.cpPos.iLeft = mlngLeft
    pcomp.cpPos.iTop = mlngTop
    pcomp.cpPos.fCanResize = False
    pcomp.fNoScroll = True
    
    co.dwSize = Len(co)
    Set ad = New VBActiveDesktop.ActiveDesktop
    ad.GetDesktopItemOptions co, 0&
    
    If (co.fActiveDesktop = 0) And fForce Then
      co.fActiveDesktop = 1
      ad.SetDesktopItemOptions co, 0&
    End If
  
    ad.AddDesktopItem pcomp, 0
    ad.ApplyChanges AD_APPLY_ALL
End Sub

Public Property Let Width(Value As Long)
    mlngWidth = Value
End Property

Public Property Get Width() As Long
    Width = mlngWidth
End Property

Public Property Let Height(Value As Long)
    mlngHeight = Value
End Property

Public Property Get Height() As Long
    Height = mlngHeight
End Property

Public Property Let Left(Value As Long)
    mlngLeft = Value
End Property

Public Property Get Left() As Long
    Left = mlngLeft
End Property

Public Property Let Top(Value As Long)
    mlngTop = Value
End Property

Public Property Get Top() As Long
    Top = mlngTop
End Property

Public Property Let Position(Value As Integer)
    Select Case Value
        Case 0, 1, 2, 3, 4
            mintPosition = Value
        Case Else
            mintPosition = 0
    End Select
End Property

Private Sub Class_Initialize()
    mintPosition = 4
    mlngHeight = 400
    mlngWidth = 400
    mlngTop = 0
    mlngLeft = 0
End Sub