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