|
Option Explicit
Private StartFaceId As Integer
Private Const SAppName = "FaceId Explorer"
Private Const SPreferencesSection = "Preferences"
Private Const SVisibilityKey = "Visible"
Private Const SRowIndexKey = "RowIndex"
Private Const SPositionKey = "Position"
Private Const STopKey = "Top"
Private Const SLeftKey = "Left"
Private Const SWidthKey = "Width"
Private Const SHeightKey = "Height"
Private Const SStartFaceIdKey = "StartFaceId"
Private Const SFaceIdCommandBarName = "FaceId Explorer"
Private Const BUTTON_ABOUT = 1
Private Const BUTTON_PREVIOUS = 2
Private Const BUTTON_NEXT = 3
Private Const BUTTON_FACEID = 4
Private Const FIRST_FACEID = 1
' FaceId_AddinInstall
'
' Microsoft Excel calls FaceId_AddinInstall while loading the addin.
Sub FaceId_AddinInstall()
AddinInitialize
End Sub
' FaceId_AddinUninstall
'
' Microsoft Excel calls FaceId_AddinUninstall while unloading the addin.
Sub FaceId_AddinUninstall()
AddinShutdown
End Sub
' Auto_Open
'
' Microsoft PowerPoint calls Auto_Open while loading the addin.
Sub Auto_Open()
AddinInitialize
End Sub
' Auto_Close
'
' Microsoft PowerPoint calls Auto_Close while unloading the addin.
Sub Auto_Close()
AddinShutdown
End Sub
' AddinInitialize
'
' This is the actual initialization routine of the FaceId Explorer
' addin. The host application dependent addin initialize function
' calls this function.
Sub AddinInitialize()
StartFaceId = FIRST_FACEID
CreateToolBar
SetPreviousButtonState
AssignFaceId
End Sub
' AddinShutdown
'
' This is the actual uninitialization routine of the FaceId Explorer
' addin. The host application dependent addin uninitialize function
' calls this function.
Sub AddinShutdown()
Dim Toolbar As CommandBar
On Error Resume Next
Set Toolbar = CommandBars(SFaceIdCommandBarName)
If Not (Toolbar Is Nothing) Then
With Toolbar
SaveSetting
SAppName, SPreferencesSection, _
SVisibilityKey, IIf(.Visible, "1", "0")
SaveSetting
SAppName, SPreferencesSection, _
SRowIndexKey, Trim(Str(.RowIndex))
SaveSetting
SAppName, SPreferencesSection, _
SPositionKey, Trim(Str(.Position))
SaveSetting
SAppName, SPreferencesSection, _
STopKey, Trim(Str(.Top))
SaveSetting
SAppName, SPreferencesSection, _
SLeftKey, Trim(Str(.Left))
SaveSetting
SAppName, SPreferencesSection, _
SWidthKey, Trim(Str(.Width))
SaveSetting
SAppName, SPreferencesSection, _
SHeightKey, Trim(Str(.Height))
SaveSetting
SAppName, SPreferencesSection, _
SStartFaceIdKey, Trim(Str(StartFaceId))
.Delete
End With
End If
End Sub
' CreateToolbar
'
' Creates a temporary non-customizable toolbar (commandbar). The
' FaceId buttons are tagged with a special value. This allows us
' to distinguish them from other buttons on the toolbar.
Sub CreateToolBar()
Dim Toolbar As CommandBar
Dim Button As CommandBarButton
Dim I As Integer
Dim Begin As Boolean
Dim TotalWidth As Integer
Dim WidthStr As String
Dim HostAppStr As String
On Error Resume Next
If Application.Name = "Microsoft PowerPoint" Then
HostAppStr = "FaceId.ppa!FaceIdExplorerModule."
ElseIf Application.Name = "Microsoft Excel" Then
HostAppStr = "FaceId.xla!FaceIdExplorerModule."
End If
CommandBars(SFaceIdCommandBarName).Delete
Set Toolbar = CommandBars.Add(Name:=SFaceIdCommandBarName,
Temporary:=True)
With Toolbar
.RowIndex = Val(GetSetting(SAppName,
SPreferencesSection, _
SRowIndexKey,
"-1"))
.Position = Val(GetSetting(SAppName,
SPreferencesSection, _
SPositionKey,
Str(msoBarFloating)))
.Top = Val(GetSetting(SAppName,
SPreferencesSection, _
STopKey,
"100"))
.Left = Val(GetSetting(SAppName,
SPreferencesSection, _
SLeftKey,
"100"))
WidthStr = GetSetting(SAppName,
SPreferencesSection, _
SWidthKey,
"")
.Height = Val(GetSetting(SAppName,
SPreferencesSection, _
SHeightKey,
"100"))
StartFaceId = Val(GetSetting(SAppName,
SPreferencesSection, _
SStartFaceIdKey, "1"))
If StartFaceId < FIRST_FACEID Then
StartFaceId =
FIRST_FACEID
End If
.Protection = msoBarNoCustomize
End With
Set Button = Toolbar.Controls.Add(Type:=msoControlButton)
With Button
.Caption = " About... "
.Style = msoButtonCaption
.Tag = BUTTON_ABOUT
.BeginGroup = True
.ToolTipText = "Show information
about the author"
.OnAction = HostAppStr + "AboutFaceIdExplorer"
End With
Set Button = Toolbar.Controls.Add(Type:=msoControlButton)
With Button
.Caption = " « Previous "
.Style = msoButtonCaption
.Tag = BUTTON_PREVIOUS
.Enabled = False
.BeginGroup = True
.ToolTipText = "Previous 100
FaceIds"
.OnAction = HostAppStr + "PreviousButtonClick"
End With
Set Button = Toolbar.Controls.Add(Type:=msoControlButton)
With Button
.Caption = " Next » "
.Style = msoButtonCaption
.Tag = BUTTON_NEXT
.ToolTipText = "Next 100 FaceIds"
.OnAction = HostAppStr + "NextButtonClick"
End With
Begin = True
TotalWidth = 0
For I = 1 To 100
Set Button =
Toolbar.Controls.Add(Type:=msoControlButton)
With Button
TotalWidth =
TotalWidth + .Width + 2
.Tag =
BUTTON_FACEID
.BeginGroup =
Begin
If Begin Then
Begin = False
End If
End With
Next
With Toolbar
.Visible = False
If Not (WidthStr = "") Then
.Width =
Val(WidthStr)
Else
.Width =
TotalWidth / 10
End If
.Visible = Val(GetSetting(SAppName,
SPreferencesSection, _
SVisibilityKey, "1"))
End With
End Sub
' AssignFaceId
'
' Updates the FaceIds of each FaceId button of our temporary
' non-customizable toolbar. The starting FaceId index is
' obtained from StartFaceId.
Sub AssignFaceId()
Dim Toolbar As CommandBar
Dim Button As CommandBarButton
Dim I As Integer
On Error Resume Next
Set Toolbar = CommandBars(SFaceIdCommandBarName)
I = StartFaceId
For Each Button In Toolbar.Controls
With Button
If .Tag =
BUTTON_FACEID Then
.FaceId = I
.ToolTipText = "FaceId: " + Str(I)
I = I + 1
End If
End With
Next
End Sub
' SetPreviousButtonState
'
' Enables or disables " « Previous " button appropriately. This
button
' is disabled if we are at the beginning of the FaceId list. The
' beginning of the list is indicated by FIRST_FACEID variable.
Sub SetPreviousButtonState()
Dim Toolbar As CommandBar
Dim Button As CommandBarButton
On Error Resume Next
Set Toolbar = CommandBars(SFaceIdCommandBarName)
For Each Button In Toolbar.Controls
With Button
If .Tag =
BUTTON_PREVIOUS Then
If StartFaceId = FIRST_FACEID Then
.Enabled = False
Else
.Enabled = True
End If
Exit For
End If
End With
Next
End Sub
' PreviousButtonClick
'
' When the "Previous" button is clicked, this function gets called.
' It decrements the starting FaceId by 100 (we display 100 FaceIds
' at a time) and updates the buttons.
Sub PreviousButtonClick()
StartFaceId = StartFaceId - 100
If StartFaceId < FIRST_FACEID Then
StartFaceId = FIRST_FACEID
End If
SetPreviousButtonState
AssignFaceId
End Sub
' NextButtonClick
'
' When the "Next" button is clicked, this function gets called.
' It increments the starting FaceId by 100 and updates the buttons.
Sub NextButtonClick()
StartFaceId = StartFaceId + 100
SetPreviousButtonState
AssignFaceId
End Sub
|
|