From 3f39b9c03785e6f1014cc53fefc95c5e070a82fc Mon Sep 17 00:00:00 2001 From: drmoisan <54180981+drmoisan@users.noreply.github.com> Date: Mon, 20 Jun 2022 13:22:25 -0700 Subject: [PATCH 1/2] Latest version --- Models/DataModel_ToDoTree.vb | 37 +- Models/Flags.vb | 286 +++++++++++++ Models/ToDoItem.vb | 196 ++++++++- Models/TreeNodeOfT.vb | 8 + Models/cIDList.vb | 6 +- .../TaskMasterRibbon.Designer.vb | 31 +- .../TaskMasterRibbon.resx | 0 .../TaskMasterRibbon.vb | 33 +- TaskMaster.vbproj | 7 +- ThisAddIn.vb | 394 +++++++++--------- 10 files changed, 771 insertions(+), 227 deletions(-) create mode 100644 Models/Flags.vb rename TaskMasterRibbon.Designer.vb => Ribbons/TaskMasterRibbon.Designer.vb (85%) rename TaskMasterRibbon.resx => Ribbons/TaskMasterRibbon.resx (100%) rename TaskMasterRibbon.vb => Ribbons/TaskMasterRibbon.vb (60%) diff --git a/Models/DataModel_ToDoTree.vb b/Models/DataModel_ToDoTree.vb index 7f2d8301c..66ca54cf3 100644 --- a/Models/DataModel_ToDoTree.vb +++ b/Models/DataModel_ToDoTree.vb @@ -137,6 +137,9 @@ Public Class DataModel_ToDoTree Else strSeed = Parent.Value.ToDoID & "00" End If + If IDList.UsedIDList.Contains(Child.Value.ToDoID) Then + IDList.UsedIDList.Remove(Child.Value.ToDoID) + End If Child.Value.ToDoID = IDList.GetNextAvailableToDoID(strSeed) If Child.Children.Count > 0 Then ReNumberChildrenIDs(Child.Children, IDList) @@ -165,7 +168,10 @@ Public Class DataModel_ToDoTree If IDList.UsedIDList.Contains(Children(i).Value.ToDoID) Then IDList.UsedIDList.Remove(Children(i).Value.ToDoID) Next i For i = 0 To max - Children(i).Value.ToDoID = IDList.GetNextAvailableToDoID(strParentID & "00") + Dim NextID As String = IDList.GetNextAvailableToDoID(strParentID & "00") + 'Dim LevelChange As Boolean = (Children(i).Value.ToDoID.Length = NextID.Length) + Children(i).Value.ToDoID = NextID + 'Children(i).Value.VisibleTreeState = 67 'Children(i).Value.ToDoID = Children(i).Value.ToDoID If Children(i).Children.Count > 0 Then ReNumberChildrenIDs(Children(i).Children, IDList) Next @@ -219,6 +225,35 @@ Public Class DataModel_ToDoTree Return ListObjects End Function + + Private Function IsHeader(TagContext As String) As String + If InStr(TagContext, "@PROJECTS", CompareMethod.Text) Then + Return True + ElseIf InStr(TagContext, "HEADER", CompareMethod.Text) Then + Return True + ElseIf InStr(TagContext, "DELIVERABLE", CompareMethod.Text) Then + Return True + ElseIf InStr(TagContext, "@PROGRAMS", CompareMethod.Text) Then + Return True + Else + Return False + End If + End Function + + Public Sub HideEmptyHeadersInView() + Dim action As Action(Of TreeNode(Of ToDoItem)) = Sub(node) + If node.ChildCount = 0 Then + If IsHeader(node.Value.TagContext) Then + node.Value.ActiveBranch = False + End If + End If + End Sub + + For Each node As TreeNode(Of ToDoItem) In ListOfToDoTree + node.Traverse(action) + Next + End Sub + Private Function CompareItemsByToDoID(ByVal objItemLeft As Object, ByVal objItemRight As Object) Dim ToDoIDLeft As String = Globals.ThisAddIn.CustomFieldID_GetValue(objItemLeft, "ToDoID") Dim ToDoIDRight As String = Globals.ThisAddIn.CustomFieldID_GetValue(objItemRight, "ToDoID") diff --git a/Models/Flags.vb b/Models/Flags.vb new file mode 100644 index 000000000..a456cf417 --- /dev/null +++ b/Models/Flags.vb @@ -0,0 +1,286 @@ +Public Class Flags + Private _People As String = "" + Public _Projects As String = "" + Public _Topics As String = "" + Public Context As String = "" + Public KB As String = "" + Public Other As String = "" + Public Today As Boolean = False + Public Bullpin As Boolean = False + + Public Sub New(ByRef strCats_All As String, Optional DeleteSearchSubString As Boolean = False) + Splitter(strCats_All, DeleteSearchSubString) + End Sub + + Public Property Projects(Optional IncludePrefix As Boolean = False) As String + Get + Dim Prefix As String = "Tag PROJECT " + Dim strReturn As String = _Projects + + If IncludePrefix = False Then + strReturn = SubStr_w_Delimeter(strReturn, Prefix, ", ", DeleteSearchSubString:=True) + End If + Return strReturn + End Get + + Set(value As String) + Dim Prefix As String = "Tag PROJECT " + + Dim strReturn As String = "" + If value = "" Then + strReturn = "" + ElseIf Left(value, Prefix.Length) <> Prefix Then + Dim strTmp() As String = value.Split(", ") + For i As Integer = LBound(strTmp) To UBound(strTmp) + strReturn = strReturn & ", " & Prefix & Trim(strTmp(i)) + Next + If strReturn.Length > 2 Then + strReturn = Right(strReturn, strReturn.Length - 2) + End If + Else + strReturn = value + End If + _Projects = strReturn + End Set + End Property + + Public Property Topics(Optional IncludePrefix As Boolean = False) As String + Get + Dim Prefix As String = "Tag TOPIC " + Dim strReturn As String = _Topics + + If IncludePrefix = False Then + strReturn = SubStr_w_Delimeter(strReturn, Prefix, ", ", DeleteSearchSubString:=True) + End If + Return strReturn + End Get + + Set(value As String) + Dim Prefix As String = "Tag TOPIC " + + Dim strReturn As String = "" + If value = "" Then + strReturn = "" + ElseIf Left(value, Prefix.Length) <> Prefix Then + Dim strTmp() As String = value.Split(", ") + For i As Integer = LBound(strTmp) To UBound(strTmp) + strReturn = strReturn & ", " & Prefix & Trim(strTmp(i)) + Next + If strReturn.Length > 2 Then + strReturn = Right(strReturn, strReturn.Length - 2) + End If + Else + strReturn = value + End If + _Topics = strReturn + End Set + End Property + + Public Property People(Optional IncludePrefix As Boolean = False) As String + Get + Dim Prefix As String = "Tag PPL " + Dim strReturn As String = _People + + If IncludePrefix = False Then + strReturn = SubStr_w_Delimeter(strReturn, Prefix, ", ", DeleteSearchSubString:=True) + End If + Return strReturn + End Get + + Set(value As String) + Dim Prefix As String = "Tag PPL " + + Dim strReturn As String = "" + If value = "" Then + strReturn = "" + ElseIf Left(value, Prefix.Length) <> Prefix Then + Dim strTmp() As String = value.Split(", ") + For i As Integer = LBound(strTmp) To UBound(strTmp) + strReturn = strReturn & ", " & Prefix & Trim(strTmp(i)) + Next + If strReturn.Length > 2 Then + strReturn = Right(strReturn, strReturn.Length - 2) + End If + Else + strReturn = value + End If + _People = strReturn + End Set + End Property + + Public Function Combine() As String + Dim strTmp As String = "" + If _People.Length > 0 Then + strTmp = strTmp & ", " & _People + End If + + If _Projects.Length > 0 Then + strTmp = strTmp & ", " & _Projects + End If + + If _Topics.Length > 0 Then + strTmp = strTmp & ", " & _Topics + End If + + If Context.Length > 0 Then + strTmp = strTmp & ", " & Context + End If + + If KB.Length > 0 Then + strTmp = strTmp & ", " & KB + End If + + If Today = True Then + strTmp = strTmp & ", " & "Tag A Top Priority Today" + End If + + If Bullpin = True Then + strTmp = strTmp & ", " & "Tag Bullpin Priorities" + End If + + If strTmp.Length > 2 Then + strTmp = Right(strTmp, strTmp.Length - 2) + End If + + Return strTmp + End Function + + Public Sub Splitter(ByRef strCats_All As String, Optional DeleteSearchSubString As Boolean = False) + _People = SubStr_w_Delimeter(strCats_All, AddWildcards("Tag PPL "), ", ", DeleteSearchSubString:=DeleteSearchSubString) + Other = SubStr_w_Delimeter(strCats_All, AddWildcards("Tag PPL "), ", ", True) + + _Projects = SubStr_w_Delimeter(strCats_All, AddWildcards("Tag PROJECT "), ", ", DeleteSearchSubString:=DeleteSearchSubString) + Other = SubStr_w_Delimeter(Other, AddWildcards("Tag PROJECT "), ", ", True) + + Dim strTemp As String = SubStr_w_Delimeter(strCats_All, AddWildcards("Tag Bullpin Priorities"), ", ", DeleteSearchSubString:=False) + Other = SubStr_w_Delimeter(Other, AddWildcards("Tag Bullpin Priorities"), ", ", True) + If strTemp <> "" Then + Bullpin = True + Else + Bullpin = False + End If + + strTemp = SubStr_w_Delimeter(strCats_All, AddWildcards("Tag A Top Priority Today"), ", ", DeleteSearchSubString:=False) + Other = SubStr_w_Delimeter(Other, AddWildcards("Tag A Top Priority Today"), ", ", True) + If strTemp <> "" Then + Today = True + Else + Today = False + End If + + _Topics = SubStr_w_Delimeter(strCats_All, AddWildcards("Tag TOPIC "), ", ", DeleteSearchSubString:=DeleteSearchSubString) + Other = SubStr_w_Delimeter(Other, AddWildcards("Tag TOPIC "), ", ", True) + + KB = SubStr_w_Delimeter(strCats_All, AddWildcards("Tag KB "), ", ", DeleteSearchSubString:=DeleteSearchSubString) + Other = SubStr_w_Delimeter(Other, AddWildcards("Tag KB "), ", ", True) + + Context = Other + + End Sub + + Public Function AddWildcards(ByVal strOriginal As String, Optional b_Leading As Boolean = True, + Optional b_Trailing As Boolean = True, Optional charWC As String = "*") As String + + Dim strTemp As String + strTemp = strOriginal + If b_Leading Then strTemp = charWC & strTemp + If b_Trailing Then strTemp = strTemp & charWC + + AddWildcards = strTemp + + End Function + + Public Function SubStr_w_Delimeter(strMainString As String, strSubString As String, strDelimiter As String, Optional bNotSearchStr As Boolean = False, Optional DeleteSearchSubString As Boolean = False) As String + Dim varTempStrAry As Object + Dim varFiltStrAry As Object + Dim strTempStr As String + Dim i As Integer + + varTempStrAry = strMainString.Split(strDelimiter) + varFiltStrAry = SearchArry4Str(varTempStrAry, strSubString, bNotSearchStr, DeleteSearchSubString:=DeleteSearchSubString) + strTempStr = Condense_Variant_To_Str(varFiltStrAry) + + SubStr_w_Delimeter = strTempStr + + End Function + + Public Function SearchArry4Str(ByRef varStrArry As Object, Optional SearchStr$ = "", Optional bNotSearchStr As Boolean = False, Optional DeleteSearchSubString As Boolean = False) As Object + Dim m_Find As String + Dim m_Wildcard As Boolean + + Dim strCats() As String + Dim i As Integer + Dim intFoundCt As Integer + Dim boolFound As Boolean + Dim strTemp As String + Dim strSearchNoWC As String + + If Len(Trim$(SearchStr)) <> 0 Then + + m_Find = SearchStr + + m_Find = LCase$(m_Find) 'Make lower case + m_Find = Replace(m_Find, "%", "*") 'Standardize characters used as wildcards + m_Wildcard = (InStr(m_Find, "*")) 'Determine if wildcards are present in search string + intFoundCt = 0 + strSearchNoWC = Replace(SearchStr, "*", "") 'Remove wildcards from the string + + For i = LBound(varStrArry) To UBound(varStrArry) 'Loop through the array to find substring + boolFound = False + If varStrArry(i) <> "" Then 'Skip over blank entries + If m_Wildcard Then + If bNotSearchStr = False Then + boolFound = (LCase$(varStrArry(i)) Like m_Find) + Else + boolFound = Not (LCase$(varStrArry(i)) Like m_Find) + End If + Else + If bNotSearchStr = False Then + boolFound = (LCase$(varStrArry(i)) = m_Find) + Else + boolFound = Not (LCase$(varStrArry(i)) = m_Find) + End If + End If + End If + + If boolFound Then + boolFound = False + intFoundCt = intFoundCt + 1 + ReDim Preserve strCats(intFoundCt) + strTemp = varStrArry(i) + If DeleteSearchSubString Then strTemp = Replace(strTemp, strSearchNoWC, "", , , vbTextCompare) + strCats(intFoundCt) = strTemp + End If + Next i + + If intFoundCt = 0 Then + SearchArry4Str = "" + Else + SearchArry4Str = strCats + End If + + Else + SearchArry4Str = varStrArry + End If + + + End Function + + Public Function Condense_Variant_To_Str(varAry As Object) As String + Dim strTempStr As String = "" + Dim i As Integer + + If IsArray(varAry) Then + For i = 1 To UBound(varAry) + strTempStr = strTempStr & ", " & varAry(i) + Next i + If strTempStr <> "" Then strTempStr = Right(strTempStr, Len(strTempStr) - 2) + Else + strTempStr = varAry + End If + + Condense_Variant_To_Str = strTempStr + + End Function + +End Class diff --git a/Models/ToDoItem.vb b/Models/ToDoItem.vb index 511526801..3dfb7d84f 100644 --- a/Models/ToDoItem.vb +++ b/Models/ToDoItem.vb @@ -31,6 +31,11 @@ Public Class ToDoItem Private _StartDate As Date Private _Complete As Boolean Private _KB As String = "" + Private _ActiveBranch As Boolean = False + Private _ExpandChildren As String = "" + Private _ExpandChildrenState As String = "" + Private _EC2 As Boolean + Private _VisibleTreeState As Integer Public Sub New(OlMail As Outlook.MailItem) OlObject = OlMail @@ -45,6 +50,10 @@ Public Class ToDoItem _TagPeople = CustomField("TagPeople") _TagTopic = CustomField("TagTopic") _KB = CustomField("KBF") + _ActiveBranch = CustomField("AB", OlUserPropertyType.olYesNo) + _EC2 = CustomField("EC2", OlUserPropertyType.olYesNo) + _ExpandChildren = CustomField("EC") + _ExpandChildrenState = CustomField("EcState") _Priority = OlMail.Importance _TaskCreateDate = OlMail.CreationTime _StartDate = OlMail.TaskStartDate @@ -60,6 +69,10 @@ Public Class ToDoItem _TagPeople = CustomField("TagPeople") _TagTopic = CustomField("TagTopic") _KB = CustomField("KBF") + _ActiveBranch = CustomField("AB", OlUserPropertyType.olYesNo) + _EC2 = CustomField("EC2", OlUserPropertyType.olYesNo) + _ExpandChildren = CustomField("EC") + _ExpandChildrenState = CustomField("EcState") _Priority = OlTask.Importance _TaskCreateDate = OlTask.CreationTime _StartDate = OlTask.StartDate @@ -79,6 +92,10 @@ Public Class ToDoItem _TagPeople = CustomField("TagPeople") _TagTopic = CustomField("TagTopic") _KB = CustomField("KBF") + _ActiveBranch = CustomField("AB", OlUserPropertyType.olYesNo) + _EC2 = CustomField("EC2", OlUserPropertyType.olYesNo) + _ExpandChildren = CustomField("EC") + _ExpandChildrenState = CustomField("EcState") _Priority = OlMail.Importance _TaskCreateDate = OlMail.CreationTime _StartDate = OlMail.TaskStartDate @@ -95,6 +112,10 @@ Public Class ToDoItem _TagPeople = CustomField("TagPeople") _TagTopic = CustomField("TagTopic") _KB = CustomField("KBF") + _ActiveBranch = CustomField("AB", OlUserPropertyType.olYesNo) + _EC2 = CustomField("EC2", OlUserPropertyType.olYesNo) + _ExpandChildren = CustomField("EC") + _ExpandChildrenState = CustomField("EcState") _Priority = OlTask.Importance _TaskCreateDate = OlTask.CreationTime _StartDate = OlTask.StartDate @@ -236,9 +257,14 @@ Public Class ToDoItem End If End Get Set(value As String) - _TagPeople = value + If Not OlObject Is Nothing Then + _TagPeople = value CustomField("TagPeople") = value + Dim Flg As Flags = New Flags(OlObject.Categories) + Flg.People = value + OlObject.Categories = Flg.Combine() + OlObject.Save End If End Set End Property @@ -259,6 +285,10 @@ Public Class ToDoItem _TagProject = value If Not OlObject Is Nothing Then CustomField("TagProject") = value + Dim Flg As Flags = New Flags(OlObject.Categories) + Flg.Projects = value + OlObject.Categories = Flg.Combine() + OlObject.Save End If End Set End Property @@ -319,6 +349,10 @@ Public Class ToDoItem _TagTopic = value If Not OlObject Is Nothing Then CustomField("TagTopic") = value + Dim Flg As Flags = New Flags(OlObject.Categories) + Flg.Topics = value + OlObject.Categories = Flg.Combine() + OlObject.Save End If End Set End Property @@ -360,6 +394,144 @@ Public Class ToDoItem End If End Set End Property + '_VisibleTreeState + Public Property VisibleTreeStateLVL(ByVal Lvl As Integer) As Boolean + Get + Return ((Math.Pow(2, Lvl - 1) & VisibleTreeState) > 0) + End Get + Set(value As Boolean) + If value = True Then + VisibleTreeState = VisibleTreeState Or Math.Pow(2, Lvl - 1) + Else + VisibleTreeState = VisibleTreeState - (VisibleTreeState And Math.Pow(2, Lvl - 1)) + End If + End Set + End Property + Public Property VisibleTreeState As Integer + Get + If _VisibleTreeState <> 0 Then + Return _VisibleTreeState + ElseIf OlObject Is Nothing Then + Return -1 + Else + Dim objProperty As Outlook.UserProperty = OlObject.UserProperties.Find("VTS") + If objProperty Is Nothing Then + CustomField("VTS", OlUserPropertyType.olInteger) = 63 'Binary 111111 for 6 levels + _VisibleTreeState = 63 + Else + _VisibleTreeState = CustomField("VTS", OlUserPropertyType.olInteger) + End If + Return _VisibleTreeState + + End If + End Get + Set(intVTS As Integer) + If Not OlObject Is Nothing Then + _VisibleTreeState = intVTS + CustomField("VTS", OlUserPropertyType.olInteger) = intVTS + End If + End Set + End Property + + Public Property ActiveBranch As Boolean + Get + If _ActiveBranch = True Then + Return True + ElseIf OlObject Is Nothing Then + Return False + Else + If CustomFieldExists("AB") Then + _ActiveBranch = CustomField("AB", OlUserPropertyType.olYesNo) + Else + CustomField("AB", OlUserPropertyType.olYesNo) = True + _ActiveBranch = True + End If + + Return _ActiveBranch + End If + End Get + Set(blActive As Boolean) + _ActiveBranch = blActive + If Not OlObject Is Nothing Then + CustomField("AB", OlUserPropertyType.olYesNo) = blActive + End If + End Set + End Property + + Public ReadOnly Property EC2 As Boolean + Get + If CustomFieldExists("EC2") Then + _EC2 = CustomField("EC2") + + If _EC2 = True Then + If ExpandChildren = "+" Then + ExpandChildren = "-" + End If + Else + If ExpandChildren = "-" Then + ExpandChildren = "+" + End If + End If + End If + Return _EC2 + End Get + End Property + + Public Property EC_Change As Boolean + Get + If ExpandChildren.Length = 0 Then + ExpandChildren = "-" + End If + + If ExpandChildrenState = ExpandChildren Then + Return False + Else + Return True + End If + End Get + Set(blValue As Boolean) + If blValue = False Then + ExpandChildrenState = ExpandChildren + End If + End Set + End Property + Public Property ExpandChildren As String + Get + If _ExpandChildren.Length <> 0 Then + Return _ExpandChildren + ElseIf OlObject Is Nothing Then + Return "" + Else + _ExpandChildren = CustomField("EC") + Return _ExpandChildren + End If + End Get + Set(strState As String) + _ExpandChildren = strState + If Not OlObject Is Nothing Then + CustomField("EC") = strState + End If + End Set + End Property + + Public Property ExpandChildrenState As String + Get + If _ExpandChildrenState.Length <> 0 Then + Return _ExpandChildrenState + ElseIf OlObject Is Nothing Then + Return "" + Else + _ExpandChildrenState = CustomField("EcState") + Return _ExpandChildrenState + End If + End Get + Set(strState As String) + _ExpandChildrenState = strState + If Not OlObject Is Nothing Then + CustomField("EcState") = strState + End If + End Set + End Property Public Sub SplitID() Dim strField As String = "" @@ -437,15 +609,33 @@ Public Class ToDoItem Public ReadOnly Property InFolder() As String Get - Return OlObject.Parent.FolderPath + Dim prefix As String = Globals.ThisAddIn._OlNS.DefaultStore.GetRootFolder.FolderPath & "\" + Return Replace(OlObject.Parent.FolderPath, prefix, "") End Get End Property + Public ReadOnly Property CustomFieldExists(FieldName As String) As Boolean + Get + Dim objProperty As Outlook.UserProperty = OlObject.UserProperties.Find(FieldName) + If objProperty Is Nothing Then + Return False + Else + Return True + End If + End Get + End Property Public Property CustomField(FieldName As String, Optional ByVal OlFieldType As Outlook.OlUserPropertyType = Outlook.OlUserPropertyType.olText) Get Dim objProperty As Outlook.UserProperty = OlObject.UserProperties.Find(FieldName) If objProperty Is Nothing Then - Return "" + If OlFieldType = OlUserPropertyType.olInteger Then + Return 0 + ElseIf OlFieldType = OlUserPropertyType.olYesNo Then + Return False + Else + Return "" + End If + Else If IsArray(objProperty.Value) Then Return FlattenArry(objProperty.Value) diff --git a/Models/TreeNodeOfT.vb b/Models/TreeNodeOfT.vb index 97f857b3d..f59927f4b 100644 --- a/Models/TreeNodeOfT.vb +++ b/Models/TreeNodeOfT.vb @@ -112,6 +112,14 @@ Public Class TreeNode(Of T) Next End Sub + Public Sub Traverse(ByVal action As Action(Of TreeNode(Of T))) + action(Me) + + For Each child In _children + child.Traverse(action) + Next + End Sub + Public Function FindByDelegate(comparator As Func(Of T, String, Boolean), StringToCompare As String) Dim node As TreeNode(Of T) diff --git a/Models/cIDList.vb b/Models/cIDList.vb index 332289ca5..f888b869b 100644 --- a/Models/cIDList.vb +++ b/Models/cIDList.vb @@ -126,7 +126,8 @@ Public Class cIDList Dim maxBase As Integer Dim i As Integer - chars = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖØÙÚÛÜÝÞßàáâãäåæçèéêëìíîïðñòóôõöøùúûüýþÿŒœŠšŸŽžƒ" + 'chars = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖØÙÚÛÜÝÞßàáâãäåæçèéêëìíîïðñòóôõöøùúûüýþÿŒœŠšŸŽžƒ" + chars = "0123456789aAáÁàÀâÂäÄãÃåÅæÆbBcCçÇdDðÐeEéÉèÈêÊëËfFƒgGhHIIíÍìÌîÎïÏjJkKlLmMnNñÑoOóÓòÒôÔöÖõÕøØœŒpPqQrRsSšŠßtTþÞuUúÚùÙûÛüÜvVwWxXyYýÝÿŸzZžŽ" maxBase = Len(chars) ' check if we can convert to this base @@ -158,7 +159,8 @@ Public Class cIDList Dim intLoc As Integer Dim lngTmp As BigInteger - chars = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖØÙÚÛÜÝÞßàáâãäåæçèéêëìíîïðñòóôõöøùúûüýþÿŒœŠšŸŽžƒ" + 'chars = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖØÙÚÛÜÝÞßàáâãäåæçèéêëìíîïðñòóôõöøùúûüýþÿŒœŠšŸŽžƒ" + chars = "0123456789aAáÁàÀâÂäÄãÃåÅæÆbBcCçÇdDðÐeEéÉèÈêÊëËfFƒgGhHIIíÍìÌîÎïÏjJkKlLmMnNñÑoOóÓòÒôÔöÖõÕøØœŒpPqQrRsSšŠßtTþÞuUúÚùÙûÛüÜvVwWxXyYýÝÿŸzZžŽ" lngTmp = 0 For i = 1 To Len(strBase) diff --git a/TaskMasterRibbon.Designer.vb b/Ribbons/TaskMasterRibbon.Designer.vb similarity index 85% rename from TaskMasterRibbon.Designer.vb rename to Ribbons/TaskMasterRibbon.Designer.vb index 9112db403..4bda2bc89 100644 --- a/TaskMasterRibbon.Designer.vb +++ b/Ribbons/TaskMasterRibbon.Designer.vb @@ -53,6 +53,8 @@ Me.Btn_TreeListView = Me.Factory.CreateRibbonButton Me.BTN_Hook = Me.Factory.CreateRibbonButton Me.BTN_FlagTask = Me.Factory.CreateRibbonButton + Me.Menu1 = Me.Factory.CreateRibbonMenu + Me.btnHideHeadersNoChildren = Me.Factory.CreateRibbonButton Me.Tab1.SuspendLayout() Me.Group1.SuspendLayout() Me.SuspendLayout() @@ -67,11 +69,11 @@ ' 'Group1 ' - Me.Group1.Items.Add(Me.TaskMenu) Me.Group1.Items.Add(Me.Btn_TreeListView) - Me.Group1.Items.Add(Me.BTN_Hook) Me.Group1.Items.Add(Me.BTN_FlagTask) - Me.Group1.Label = "Group1" + Me.Group1.Items.Add(Me.Menu1) + Me.Group1.Items.Add(Me.TaskMenu) + Me.Group1.Label = "Task Master" Me.Group1.Name = "Group1" ' 'TaskMenu @@ -82,9 +84,10 @@ Me.TaskMenu.Items.Add(Me.btn_SplitToDoID) Me.TaskMenu.Items.Add(Me.but_Dictionary) Me.TaskMenu.Items.Add(Me.but_CompressIDs) + Me.TaskMenu.Items.Add(Me.BTN_Hook) Me.TaskMenu.Items.Add(Me.Button1) Me.TaskMenu.ItemSize = Microsoft.Office.Core.RibbonControlSize.RibbonControlSizeLarge - Me.TaskMenu.Label = "Menu1" + Me.TaskMenu.Label = "Utilities" Me.TaskMenu.Name = "TaskMenu" Me.TaskMenu.ShowImage = True ' @@ -151,6 +154,24 @@ Me.BTN_FlagTask.OfficeImageId = "FlagMessage" Me.BTN_FlagTask.ShowImage = True ' + 'Menu1 + ' + Me.Menu1.ControlSize = Microsoft.Office.Core.RibbonControlSize.RibbonControlSizeLarge + Me.Menu1.Items.Add(Me.btnHideHeadersNoChildren) + Me.Menu1.ItemSize = Microsoft.Office.Core.RibbonControlSize.RibbonControlSizeLarge + Me.Menu1.Label = "View" + Me.Menu1.Name = "Menu1" + Me.Menu1.OfficeImageId = "FindDialog" + Me.Menu1.ShowImage = True + ' + 'btnHideHeadersNoChildren + ' + Me.btnHideHeadersNoChildren.ControlSize = Microsoft.Office.Core.RibbonControlSize.RibbonControlSizeLarge + Me.btnHideHeadersNoChildren.Label = "Hide Empty Headers" + Me.btnHideHeadersNoChildren.Name = "btnHideHeadersNoChildren" + Me.btnHideHeadersNoChildren.OfficeImageId = "ReviewShowOrHideComment" + Me.btnHideHeadersNoChildren.ShowImage = True + ' 'TaskMasterRibbon ' Me.Name = "TaskMasterRibbon" @@ -175,6 +196,8 @@ Friend WithEvents Button1 As Microsoft.Office.Tools.Ribbon.RibbonButton Friend WithEvents BTN_Hook As Microsoft.Office.Tools.Ribbon.RibbonButton Friend WithEvents BTN_FlagTask As Microsoft.Office.Tools.Ribbon.RibbonButton + Friend WithEvents Menu1 As Microsoft.Office.Tools.Ribbon.RibbonMenu + Friend WithEvents btnHideHeadersNoChildren As Microsoft.Office.Tools.Ribbon.RibbonButton End Class Partial Class ThisRibbonCollection diff --git a/TaskMasterRibbon.resx b/Ribbons/TaskMasterRibbon.resx similarity index 100% rename from TaskMasterRibbon.resx rename to Ribbons/TaskMasterRibbon.resx diff --git a/TaskMasterRibbon.vb b/Ribbons/TaskMasterRibbon.vb similarity index 60% rename from TaskMasterRibbon.vb rename to Ribbons/TaskMasterRibbon.vb index 1deeca320..1af053b64 100644 --- a/TaskMasterRibbon.vb +++ b/Ribbons/TaskMasterRibbon.vb @@ -6,6 +6,7 @@ Public Class TaskMasterRibbon Private Sub btn_RefreshMax_Click(sender As Object, e As RibbonControlEventArgs) Handles btn_RefreshMax.Click Globals.ThisAddIn.RefreshIDList() + MsgBox("ID Refresh Complete") End Sub Private Sub btn_SplitToDoID_Click(sender As Object, e As RibbonControlEventArgs) Handles btn_SplitToDoID.Click @@ -21,34 +22,12 @@ Public Class TaskMasterRibbon Private Sub but_Dictionary_Click(sender As Object, e As RibbonControlEventArgs) Handles but_Dictionary.Click Dim projinfoview As ProjectInfoWindow = New ProjectInfoWindow(Globals.ThisAddIn.ProjInfo) projinfoview.Show() - 'Original Function - 'Dim strMsg As StringBuilder = New StringBuilder - 'Dim strKey As String - 'Dim i As Integer = 0 - 'Dim reversedict As SortedDictionary(Of String, String) = New SortedDictionary(Of String, String) - 'For Each strKey In Globals.ThisAddIn.ProjDict.ProjectDictionary.Keys - ' Try - ' reversedict.Add(Globals.ThisAddIn.ProjDict.ProjectDictionary(strKey), strKey) - ' Catch - ' MsgBox("Can't add:" + Globals.ThisAddIn.ProjDict.ProjectDictionary(strKey) + ", " + strKey) - ' Err.Clear() - ' End Try - 'Next - 'For Each strKey In reversedict.Keys - ' strMsg.AppendLine(i & " " & strKey & " " & reversedict(strKey)) - ' i += 1 - 'Next - 'i = CInt(InputBox(strMsg.ToString())) - 'Dim strKeyToDelete As String = reversedict.Keys(i) - 'Dim response As MsgBoxResult = MsgBox("Delete key: " & strKeyToDelete & "?", vbYesNo) - 'If response = vbYes Then - ' Globals.ThisAddIn.ProjDict.ProjectDictionary.Remove(strKeyToDelete) - ' Globals.ThisAddIn.SaveDict() - 'End If + End Sub Private Sub but_CompressIDs_Click(sender As Object, e As RibbonControlEventArgs) Handles but_CompressIDs.Click Globals.ThisAddIn.CompressToDoIDs() + MsgBox("ID Compression Complete") End Sub Private Sub Button1_Click(sender As Object, e As RibbonControlEventArgs) Handles Button1.Click @@ -68,4 +47,10 @@ Public Class TaskMasterRibbon MsgBox("Hooked Events") End If End Sub + + Private Sub btnHideHeadersNoChildren_Click(sender As Object, e As RibbonControlEventArgs) Handles btnHideHeadersNoChildren.Click + Dim DMtmp = New DataModel_ToDoTree(New List(Of TreeNode(Of ToDoItem))) + DMtmp.LoadTree(DataModel_ToDoTree.LoadOptions.vbLoadInView) + DMtmp.HideEmptyHeadersInView() + End Sub End Class diff --git a/TaskMaster.vbproj b/TaskMaster.vbproj index 7b6e2af94..fd67a3f89 100644 --- a/TaskMaster.vbproj +++ b/TaskMaster.vbproj @@ -214,6 +214,7 @@ + @@ -238,10 +239,10 @@ Form - + TaskMasterRibbon.vb - + Component @@ -250,7 +251,7 @@ ProjectInfoWindow.vb - + TaskMasterRibbon.vb diff --git a/ThisAddIn.vb b/ThisAddIn.vb index b847c629b..8251aec65 100644 --- a/ThisAddIn.vb +++ b/ThisAddIn.vb @@ -16,6 +16,7 @@ Public Class ThisAddIn Public WithEvents OlInboxItems As Outlook.Items Private WithEvents OlReminders As Outlook.Reminders Public _OlNS As Outlook.NameSpace + 'Private WithEvents OlExplorer As Outlook.Explorer Private ribTM As TaskMasterRibbon Dim FileName_ProjectList As String @@ -25,55 +26,30 @@ Public Class ThisAddIn 'Public ProjDict As ProjectList Public ProjInfo As ProjectInfo Public WithEvents IDList As cIDList + Public DM_CurView As DataModel_ToDoTree Private Sub ThisAddIn_Startup() Handles Me.Startup _OlNS = Application.GetNamespace("MAPI") + + 'OlExplorer = Application.ActiveExplorer OlToDoItems = Application.GetNamespace("MAPI").GetDefaultFolder(OlDefaultFolders.olFolderToDo).Items OlInboxItems = Application.GetNamespace("MAPI").GetDefaultFolder(OlDefaultFolders.olFolderInbox).Items OlReminders = Application.Reminders - 'ToDoPST_HookEvents() - - 'FileName_ProjectList = Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.LocalApplicationData), AppDataFolder, "ProjectList.bin") - 'If File.Exists(FileName_ProjectList) Then - ' Dim TestFileStream As Stream = File.OpenRead(FileName_ProjectList) - ' Dim deserializer As New BinaryFormatter - ' ProjDict = CType(deserializer.Deserialize(TestFileStream), ProjectList) - ' 'ProjDict = CType(deserializer.Deserialize(TestFileStream), ToDoProjectInfo) - ' TestFileStream.Close() - ' 'Dim ProjDict2 As ToDoProjectInfo = New ToDoProjectInfo(ProjDict.ProjectDictionary) - ' 'ProjDict2.Save(Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.LocalApplicationData), AppDataFolder, "ProjectList2.bin")) - - 'Else - ' ProjDict = New ProjectList(New Dictionary(Of String, String)) - ' 'ProjDict = New ToDoProjectInfo(New Dictionary(Of String, String)) - 'End If FileName_ProjInfo = Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.LocalApplicationData), AppDataFolder, "ProjInfo.bin") If File.Exists(FileName_ProjInfo) Then Dim TestFileStream As Stream = File.OpenRead(FileName_ProjInfo) Dim deserializer As New BinaryFormatter - 'Dim ProjInfo2 As ProjectInfo2 = CType(deserializer.Deserialize(TestFileStream), ProjectInfo2) ProjInfo = CType(deserializer.Deserialize(TestFileStream), ProjectInfo) TestFileStream.Close() - 'ProjInfo = New ProjectInfo + ProjInfo.pFileName = FileName_ProjInfo ProjInfo.Sort() - 'TestProjectInfo() - 'Dim ProjInfo2 As New ProjectInfo2 - 'For Each pi As ProjectInfoEntry In ProjInfo2 - ' ProjInfo.Add(pi) - 'Next - 'ProjInfo.Save(FileName_ProjInfo) + Else ProjInfo = New ProjectInfo - 'For Each key In ProjDict.ProjectDictionary.Keys - ' ProjInfo.Add(New ProjectInfoEntry(key, ProjDict.ProjectDictionary(key), "")) - 'Next - 'ProjInfo.Save(FileName_ProjInfo) - 'Dim fmPI As ProjectInfoWindow = New ProjectInfoWindow(ProjInfo) - 'fmPI.ShowDialog() ProjInfo.Save(FileName_ProjInfo) End If @@ -89,14 +65,14 @@ Public Class ThisAddIn IDList = New cIDList(New List(Of String)) IDList.RePopulate() IDList.Save(FileName_IDList) - 'Save_IDList() + End If Access_Ribbons_By_Explorer() End Sub Public Sub Events_Hook() - Debug_OutputNsStores() + 'Debug_OutputNsStores() OlToDoItems = Application.GetNamespace("MAPI").GetDefaultFolder(OlDefaultFolders.olFolderToDo).Items OlInboxItems = Application.GetNamespace("MAPI").GetDefaultFolder(OlDefaultFolders.olFolderInbox).Items OlReminders = Application.Reminders @@ -432,6 +408,8 @@ Public Class ThisAddIn GetItemsInView_ToDo = OlItems End Function + + Public Function IsChild(strParent As String, strChild As String) As Integer Dim i As Integer = 0 Dim count As Integer = 0 @@ -651,6 +629,14 @@ Public Class ThisAddIn Private blItemChangeRunning As Boolean = False + 'Public Sub HideEmptyHeaders() + ' Dim DMtmp = New DataModel_ToDoTree(New List(Of TreeNode(Of ToDoItem))) + ' DMtmp.LoadTree(DataModel_ToDoTree.LoadOptions.vbLoadInView) + ' For Each node As TreeNode(Of ToDoItem) In DMtmp.ListOfToDoTree + + ' Next + 'End Sub + Private Sub OlToDoItems_ItemChange(Item As Object) Handles OlToDoItems.ItemChange @@ -658,186 +644,184 @@ Public Class ThisAddIn 'blItemChangeRunning = True Dim todo As ToDoItem = New ToDoItem(Item, OnDemand:=True) - Dim objProperty_ToDoID As Outlook.UserProperty = Item.UserProperties.Find("ToDoID") - Dim objProperty_Project As Outlook.UserProperty = Item.UserProperties.Find("TagProject") - Dim strToDoID As String = "" - Dim strToDoID_root As String = "" - Dim strProject As String = "" - Dim strProjectToDo As String = "" - - - 'AUTOCODE ToDoID based on Project - 'Check to see if the project exists before attempting to autocode the id - If Not objProperty_Project Is Nothing Then - - 'Get Project Name - strProject = todo.TagProject - - 'Code the Program name - If ProjInfo.Contains_ProjectName(strProject) Then - 'Dim strProgram = ProjInfo.Find_ByProjectName(strProject).First().ProgramName - Dim strProgram = ProjInfo.Programs_ByProjectNames(strProject) - If todo.TagProgram <> strProgram Then - todo.TagProgram = strProgram + Dim objProperty_ToDoID As Outlook.UserProperty = Item.UserProperties.Find("ToDoID") + Dim objProperty_Project As Outlook.UserProperty = Item.UserProperties.Find("TagProject") + Dim strToDoID As String = "" + Dim strToDoID_root As String = "" + Dim strProject As String = "" + Dim strProjectToDo As String = "" + + + Dim blTmp As Boolean = todo.EC2 'This reads the button and keeps the other field in sync if there is a change + 'Check to see if change was in the EC + If todo.EC_Change Then + Dim strEC As String = todo.ExpandChildren + Dim strChFilter As String = "@SQL=" & Chr(34) & "http://schemas.microsoft.com/mapi/string/{00020329-0000-0000-C000-000000000046}/ToDoID" & Chr(34) & " like '" & todo.ToDoID & "%'" + Dim OlChildren As Outlook.Items = OlToDoItems.Restrict(strChFilter) + + 'Identify the tree depth of the current ToDoID (Length of ToDoID / 2) + Dim intLVL As Integer = CInt(Math.Truncate(todo.ToDoID.Length / 2)) + Dim objItem As Object + For Each objItem In OlChildren + Dim todoTmp As ToDoItem = New ToDoItem(objItem, OnDemand:=True) + + 'Set the toggle for that level to + or - for all descendants on the binary number + If todoTmp.ToDoID <> todo.ToDoID Then + 'Added if statement to correct for the fact that Restrict is not case sensitive + If Left(todoTmp.ToDoID, todo.ToDoID.Length) = todo.ToDoID Then + If strEC = "-" Then + todoTmp.VisibleTreeStateLVL(intLVL + 1) = True + ElseIf strEC = "+" Then + todoTmp.VisibleTreeStateLVL(intLVL + 1) = False + End If + 'Check to see if visible + Dim VisibleMask As Integer = CInt(Math.Pow(2, todoTmp.ToDoID.Length / 2) - 1) + Dim blnewAB = ((todoTmp.VisibleTreeState And VisibleMask) = VisibleMask) + If blnewAB <> todoTmp.ActiveBranch Then + todoTmp.ActiveBranch = blnewAB + End If End If End If - 'Check to see whether there is an existing ID - If Not objProperty_ToDoID Is Nothing Then - strToDoID = objProperty_ToDoID.Value + Next + todo.EC_Change = False + End If - 'Don't autocode branches that existed to another project previously - If strToDoID.Length <> 0 And strToDoID.Length <= 4 Then + 'AUTOCODE ToDoID based on Project + 'Check to see if the project exists before attempting to autocode the id + If Not objProperty_Project Is Nothing Then - ''Get Project Name - 'strProject = todo.TagProject + 'Get Project Name + strProject = todo.TagProject - 'If IsArray(objProperty_Project.Value) Then - ' strProject = FlattenArry(objProperty_Project.Value) - 'Else - ' strProject = objProperty_Project.Value - 'End If + 'Code the Program name + If ProjInfo.Contains_ProjectName(strProject) Then + Dim strProgram = ProjInfo.Programs_ByProjectNames(strProject) + If todo.TagProgram <> strProgram Then + todo.TagProgram = strProgram + End If + End If - 'Check to see if the Project name returned a value before attempting to autocode - If strProject.Length <> 0 Then + 'Check to see whether there is an existing ID + If Not objProperty_ToDoID Is Nothing Then + strToDoID = objProperty_ToDoID.Value - 'Check to ensure it is in the dictionary before autocoding - If ProjInfo.Contains_ProjectName(strProject) Then - 'If ProjDict.ProjectDictionary.ContainsKey(strProject) Then - 'strProjectToDo = ProjDict.ProjectDictionary(strProject) + 'Don't autocode branches that existed in another project previously + If strToDoID.Length <> 0 And strToDoID.Length <= 4 Then + If strProject.Length <> 0 Then - If strToDoID.Length = 2 Then - ' Change the Item's todoid to be a node of the project - If todo.TagContext <> "@PROJECTS" Then - strProjectToDo = ProjInfo.Find_ByProjectName(strProject).First().ProjectID - 'todo.TagProgram = ProjInfo.Find_ByProjectName(strProject).First().ProgramName - todo.ToDoID = IDList.GetNextAvailableToDoID(strProjectToDo & "00") - 'strToDoID = IDList.GetNextAvailableToDoID(strProjectToDo & "00") - 'CustomFieldID_Set("ToDoID", Value:=strToDoID, SpecificItem:=Item) - IDList.Save(FileName_IDList) - 'Split_ToDoID(objItem:=Item) - todo.SplitID() - End If + 'Check to ensure it is in the dictionary before autocoding + If ProjInfo.Contains_ProjectName(strProject) Then + + If strToDoID.Length = 2 Then + ' Change the Item's todoid to be a node of the project + If todo.TagContext <> "@PROJECTS" Then + strProjectToDo = ProjInfo.Find_ByProjectName(strProject).First().ProjectID + todo.ToDoID = IDList.GetNextAvailableToDoID(strProjectToDo & "00") + IDList.Save(FileName_IDList) + todo.SplitID() End If + End If - Else 'If it is not in the dictionary, see if this is a project we should add - If strToDoID.Length = 4 Then - Dim response As MsgBoxResult = MsgBox("Add Project " & strProject & " to the Master List?", vbYesNo) - If response = vbYes Then - 'ProjDict.ProjectDictionary.Add(strProject, strToDoID) - 'SaveDict() - Dim strProgram As String = InputBox("What is the program name for " & strProject & "?", DefaultResponse:="") - ProjInfo.Add(New ProjectInfoEntry(strProject, strToDoID, strProgram)) - ProjInfo.Save() - End If + Else 'If it is not in the dictionary, see if this is a project we should add + If strToDoID.Length = 4 Then + Dim response As MsgBoxResult = MsgBox("Add Project " & strProject & " to the Master List?", vbYesNo) + If response = vbYes Then + Dim strProgram As String = InputBox("What is the program name for " & strProject & "?", DefaultResponse:="") + ProjInfo.Add(New ProjectInfoEntry(strProject, strToDoID, strProgram)) + ProjInfo.Save() End If End If End If - - ElseIf strToDoID.Length = 0 Then - strProject = todo.TagProject - 'If IsArray(objProperty_Project.Value) Then - ' strProject = FlattenArry(objProperty_Project.Value) - 'Else - ' strProject = objProperty_Project.Value - 'End If - If ProjInfo.Contains_ProjectName(strProject) Then - strProjectToDo = ProjInfo.Find_ByProjectName(strProject).First().ProjectID - todo.TagProgram = ProjInfo.Find_ByProjectName(strProject).First().ProgramName - 'If ProjDict.ProjectDictionary.ContainsKey(strProject) Then - 'strProjectToDo = ProjDict.ProjectDictionary(strProject) - todo.ToDoID = IDList.GetNextAvailableToDoID(strProjectToDo & "00") - 'strToDoID = IDList.GetNextAvailableToDoID(strProjectToDo & "00") - 'CustomFieldID_Set("ToDoID", Value:=strToDoID, SpecificItem:=Item) - IDList.Save(FileName_IDList) - 'Split_ToDoID(objItem:=Item) - todo.SplitID() - End If - - End If - Else 'In this case, the project name exists but the todo id does not - 'Get Project Name - If IsArray(objProperty_Project.Value) Then - strProject = FlattenArry(objProperty_Project.Value) - Else - strProject = objProperty_Project.Value End If - 'If the project name is in our dictionary, autoadd the ToDoID to this item - If strProject.Length <> 0 Then - 'If ProjDict.ProjectDictionary.ContainsKey(strProject) Then - If ProjInfo.Contains_ProjectName(strProject) Then - 'strProjectToDo = ProjDict.ProjectDictionary(strProject) - strProjectToDo = ProjInfo.Find_ByProjectName(strProject).First().ProjectID - 'Add the next ToDoID available in that branch - todo.ToDoID = IDList.GetNextAvailableToDoID(strProjectToDo & "00") - todo.TagProgram = ProjInfo.Find_ByProjectName(strProject).First().ProgramName - 'strToDoID = IDList.GetNextAvailableToDoID(strProjectToDo & "00") - 'CustomFieldID_Set("ToDoID", Value:=strToDoID, SpecificItem:=Item) - IDList.Save(FileName_IDList) - 'Split_ToDoID(objItem:=Item) - todo.SplitID() - '***NEED CODE HERE*** - '***NEED CODE HERE*** - '***NEED CODE HERE*** - End If + ElseIf strToDoID.Length = 0 Then + strProject = todo.TagProject + If ProjInfo.Contains_ProjectName(strProject) Then + strProjectToDo = ProjInfo.Find_ByProjectName(strProject).First().ProjectID + todo.TagProgram = ProjInfo.Find_ByProjectName(strProject).First().ProgramName + todo.ToDoID = IDList.GetNextAvailableToDoID(strProjectToDo & "00") + IDList.Save(FileName_IDList) + todo.SplitID() End If - End If + End If + Else 'In this case, the project name exists but the todo id does not + 'Get Project Name + If IsArray(objProperty_Project.Value) Then + strProject = FlattenArry(objProperty_Project.Value) + Else + strProject = objProperty_Project.Value + End If - End If - - 'If OlToDoItem_IsMarkedComplete(Item) Then - 'Check to see if todo was just marked complete - 'If So, adjust Kan Ban fields and categories - If todo.Complete Then - If InStr(Item.Categories, "Tag KB Completed") = False Then - Dim strCats As String = Replace(Replace(Item.Categories, "Tag KB Backlog", ""), ",,", ",") - strCats = Replace(Replace(strCats, "Tag KB InProgress", ""), ",,", ",") - strCats = Replace(Replace(strCats, "Tag KB Planned", ""), ",,", ",") - While Left(strCats, 1) = "," - strCats = Right(strCats, strCats.Length - 1) - End While - If strCats.Length > 0 Then - strCats += ", Tag KB Completed" - Else - strCats += "Tag KB Completed" + 'If the project name is in our dictionary, autoadd the ToDoID to this item + If strProject.Length <> 0 Then + 'If ProjDict.ProjectDictionary.ContainsKey(strProject) Then + If ProjInfo.Contains_ProjectName(strProject) Then + strProjectToDo = ProjInfo.Find_ByProjectName(strProject).First().ProjectID + 'Add the next ToDoID available in that branch + todo.ToDoID = IDList.GetNextAvailableToDoID(strProjectToDo & "00") + todo.TagProgram = ProjInfo.Find_ByProjectName(strProject).First().ProgramName + IDList.Save(FileName_IDList) + todo.SplitID() End If - Item.Categories = strCats - Item.Save - todo.KB = "Completed" End If - ElseIf todo.KB = "Completed" Then - Dim strCats As String = Item.Categories + End If - 'Strip Completed from categories - If InStr(strCats, "Tag KB Completed") = True Then - strCats = Replace(Replace(strCats, "Tag KB Completed", ""), ",,", ",") - End If - Dim strReplace As String = "" - Dim strKB As String = "" - If InStr(strCats, "Tag A Top Priority Today") = True Then - strReplace = "Tag KB InProgress" - strKB = "InProgress" - ElseIf InStr(strCats, "Tag Bullpin Priorities") = True Then - strReplace = "Tag KB Planned" - strKB = "Planned" - Else - strReplace = "Tag KB Backlog" - strKB = "Backlog" - End If + End If + + 'If OlToDoItem_IsMarkedComplete(Item) Then + 'Check to see if todo was just marked complete + 'If So, adjust Kan Ban fields and categories + If todo.Complete Then + If InStr(Item.Categories, "Tag KB Completed") = False Then + Dim strCats As String = Replace(Replace(Item.Categories, "Tag KB Backlog", ""), ",,", ",") + strCats = Replace(Replace(strCats, "Tag KB InProgress", ""), ",,", ",") + strCats = Replace(Replace(strCats, "Tag KB Planned", ""), ",,", ",") + While Left(strCats, 1) = "," + strCats = Right(strCats, strCats.Length - 1) + End While If strCats.Length > 0 Then - strCats += ", " & strReplace + strCats += ", Tag KB Completed" Else - strCats = strReplace + strCats += "Tag KB Completed" End If Item.Categories = strCats Item.Save - todo.KB = strKB + todo.KB = "Completed" + End If + ElseIf todo.KB = "Completed" Then + Dim strCats As String = Item.Categories + 'Strip Completed from categories + If InStr(strCats, "Tag KB Completed") = True Then + strCats = Replace(Replace(strCats, "Tag KB Completed", ""), ",,", ",") End If + Dim strReplace As String = "" + Dim strKB As String = "" + + If InStr(strCats, "Tag A Top Priority Today") = True Then + strReplace = "Tag KB InProgress" + strKB = "InProgress" + ElseIf InStr(strCats, "Tag Bullpin Priorities") = True Then + strReplace = "Tag KB Planned" + strKB = "Planned" + Else + strReplace = "Tag KB Backlog" + strKB = "Backlog" + End If + If strCats.Length > 0 Then + strCats += ", " & strReplace + Else + strCats = strReplace + End If + Item.Categories = strCats + Item.Save + todo.KB = strKB + + End If 'blItemChangeRunning = False 'End If @@ -878,11 +862,28 @@ Public Class ThisAddIn Private Sub OlToDoItems_ItemAdd(Item As Object) Handles OlToDoItems.ItemAdd - Dim strToDoID As String = CustomFieldID_GetValue(Item, "ToDoID") - If strToDoID.Length = 0 Then - strToDoID = IDList.GetMaxToDoID - CustomFieldID_Set(Item, "ToDoID") + + Dim todo As ToDoItem = New ToDoItem(Item, OnDemand:=True) + If todo.ToDoID.Length = 0 Then + If todo.TagProject.Length <> 0 Then + If ProjInfo.Contains_ProjectName(todo.TagProject) Then + Dim strProjectToDo As String = ProjInfo.Find_ByProjectName(todo.TagProject).First().ProjectID + 'Add the next ToDoID available in that branch + todo.ToDoID = IDList.GetNextAvailableToDoID(strProjectToDo & "00") + todo.TagProgram = ProjInfo.Find_ByProjectName(todo.TagProject).First().ProgramName + IDList.Save(FileName_IDList) + todo.SplitID() + End If + Else + todo.ToDoID = IDList.GetMaxToDoID + End If End If + todo.VisibleTreeState = 63 + 'Dim strToDoID As String = CustomFieldID_GetValue(Item, "ToDoID") + 'If strToDoID.Length = 0 Then + ' strToDoID = IDList.GetMaxToDoID + ' CustomFieldID_Set("ToDoID", Value:=strToDoID, SpecificItem:=Item) + 'End If End Sub @@ -897,9 +898,11 @@ Public Class ThisAddIn j = j + 1 If Item.CustomField("NewID") <> "Done" Then Dim strToDoID As String = Item.ToDoID - Dim strToDoIDnew As String = FixToDoID(strToDoID) - Item.ToDoID = strToDoIDnew - Item.CustomField("NewID") = "Done" + If strToDoID.Length > 0 Then + Dim strToDoIDnew As String = FixToDoID(strToDoID) + Item.ToDoID = strToDoIDnew + Item.CustomField("NewID") = "Done" + End If End If If j = 40 Then j = 0 @@ -912,10 +915,13 @@ Public Class ThisAddIn End Sub Private Function FixToDoID(strToDoID As String) As String - Dim charsorig As String = "0123456789AaÁáÀàÂâÄäÃãÅåÆæBbCcÇçDdÐðEeÉéÈèÊêËëFfƒGgHhIiÍíÌìÎîÏïJjKkLlMmNnÑñOoÓóÒòÔôÖöÕõØøŒœPpQqRrSsŠšßTtÞþUuÚúÙùÛûÜüVvWwXxYyÝýÿŸZzŽž" - Dim charsnew As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖØÙÚÛÜÝÞßàáâãäåæçèéêëìíîïðñòóôõöøùúûüýþÿŒœŠšŸŽžƒ" + 'Dim charsorig As String = "0123456789AaÁáÀàÂâÄäÃãÅåÆæBbCcÇçDdÐðEeÉéÈèÊêËëFfƒGgHhIiÍíÌìÎîÏïJjKkLlMmNnÑñOoÓóÒòÔôÖöÕõØøŒœPpQqRrSsŠšßTtÞþUuÚúÙùÛûÜüVvWwXxYyÝýÿŸZzŽž" + 'Dim charsnew As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖØÙÚÛÜÝÞßàáâãäåæçèéêëìíîïðñòóôõöøùúûüýþÿŒœŠšŸŽžƒ" '"0123456789AaÁáÀàÂâÄäÃãÅåÆæBbCcÇçDdÐðEeÉéÈèÊêËëFfƒGgHhIiÍíÌìÎîÏïJjKkLlMmNnÑñOoÓóÒòÔôÖöÕõØøŒœPpQqRrSsŠšßTtÞþUuÚúÙùÛûÜüVvWwXxYyÝýÿŸZzŽž" '"0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖØÙÚÛÜÝÞßàáâãäåæçèéêëìíîïðñòóôõöøùúûüýþÿŒœŠšŸŽžƒ" + Dim charsorig As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖØÙÚÛÜÝÞßàáâãäåæçèéêëìíîïðñòóôõöøùúûüýþÿŒœŠšŸŽžƒ" + Dim charsnew As String = "0123456789aAáÁàÀâÂäÄãÃåÅæÆbBcCçÇdDðÐeEéÉèÈêÊëËfFƒgGhHIIíÍìÌîÎïÏjJkKlLmMnNñÑoOóÓòÒôÔöÖõÕøØœŒpPqQrRsSšŠßtTþÞuUúÚùÙûÛüÜvVwWxXyYýÝÿŸzZžŽ" + Dim c As Char = "A" Dim strBuild As String = "" @@ -987,6 +993,14 @@ Public Class ThisAddIn End If End Sub + 'Private Sub OlExplorer_ViewSwitch() Handles OlExplorer.ViewSwitch + ' If OlExplorer.CurrentFolder.Name = "To-Do List" Or OlExplorer.CurrentFolder.Name = "Tasks" Then + ' Debug.Print(OlExplorer.CurrentFolder.Name) + ' DM_CurView = New DataModel_ToDoTree(New List(Of TreeNode(Of ToDoItem))) + ' DM_CurView.LoadTree(DataModel_ToDoTree.LoadOptions.vbLoadInView) + + ' End If + 'End Sub End Class Public Class Conditions From ac9c86b9c72e23c7d5351dcc0e7eafb541a5179e Mon Sep 17 00:00:00 2001 From: Dan Moisan Date: Mon, 20 Jun 2022 15:34:10 -0700 Subject: [PATCH 2/2] Created Extension Method for ObjectListView to autoscale colums to container --- Modules/olvExtension.vb | 18 ++++++++++++++++++ TaskMaster.sln | 14 ++------------ TaskMaster.vbproj | 12 ++++-------- packages.config | 2 -- 4 files changed, 24 insertions(+), 22 deletions(-) create mode 100644 Modules/olvExtension.vb diff --git a/Modules/olvExtension.vb b/Modules/olvExtension.vb new file mode 100644 index 000000000..9ed5c8b31 --- /dev/null +++ b/Modules/olvExtension.vb @@ -0,0 +1,18 @@ +Imports System.Runtime.CompilerServices +Imports BrightIdeasSoftware + +Friend Module OlvExtension + + Public Sub AutoScaleColumnsToContainer(ByVal olv As ObjectListView) + Dim containerwidth As Integer = olv.Width + Dim colswidth = 0 + For Each c As OLVColumn In olv.Columns + colswidth += c.Width + Next + If colswidth <> 0 Then + For Each c As OLVColumn In olv.Columns + c.Width = CInt(Math.Round(CDbl(c.Width) * CDbl(containerwidth) / CDbl(colswidth))) + Next + End If + End Sub +End Module diff --git a/TaskMaster.sln b/TaskMaster.sln index 71f9d1f0d..a58d9b32c 100644 --- a/TaskMaster.sln +++ b/TaskMaster.sln @@ -1,7 +1,7 @@  Microsoft Visual Studio Solution File, Format Version 12.00 -# Visual Studio Version 16 -VisualStudioVersion = 16.0.29806.167 +# Visual Studio Version 17 +VisualStudioVersion = 17.2.32602.215 MinimumVisualStudioVersion = 10.0.40219.1 Project("{F184B08F-C81C-45F6-A57F-5ABD9991F28F}") = "TaskMaster", "TaskMaster.vbproj", "{752A10ED-36F8-4AF1-A528-6240AA89F041}" EndProject @@ -13,8 +13,6 @@ Project("{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC}") = "ListViewPrinter2012", "..\O EndProject Project("{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC}") = "SparkleLibrary2012", "..\ObjectListViewDemo\SparkleLibrary\SparkleLibrary2012.csproj", "{D63F9786-B608-4085-AF08-D909448B0426}" EndProject -Project("{778DAE3C-4631-46EA-AA77-85C1314464D9}") = "CodeToTestInAConsoleApp", "..\CodeToTestInAConsoleApp\CodeToTestInAConsoleApp.vbproj", "{9254FE67-D312-47B0-962F-E16287A2ECE0}" -EndProject Global GlobalSection(SolutionConfigurationPlatforms) = preSolution Debug|Any CPU = Debug|Any CPU @@ -63,14 +61,6 @@ Global {D63F9786-B608-4085-AF08-D909448B0426}.Release|Any CPU.Build.0 = Release|Any CPU {D63F9786-B608-4085-AF08-D909448B0426}.Release|x86.ActiveCfg = Release|Any CPU {D63F9786-B608-4085-AF08-D909448B0426}.Release|x86.Build.0 = Release|Any CPU - {9254FE67-D312-47B0-962F-E16287A2ECE0}.Debug|Any CPU.ActiveCfg = Debug|Any CPU - {9254FE67-D312-47B0-962F-E16287A2ECE0}.Debug|Any CPU.Build.0 = Debug|Any CPU - {9254FE67-D312-47B0-962F-E16287A2ECE0}.Debug|x86.ActiveCfg = Debug|Any CPU - {9254FE67-D312-47B0-962F-E16287A2ECE0}.Debug|x86.Build.0 = Debug|Any CPU - {9254FE67-D312-47B0-962F-E16287A2ECE0}.Release|Any CPU.ActiveCfg = Release|Any CPU - {9254FE67-D312-47B0-962F-E16287A2ECE0}.Release|Any CPU.Build.0 = Release|Any CPU - {9254FE67-D312-47B0-962F-E16287A2ECE0}.Release|x86.ActiveCfg = Release|Any CPU - {9254FE67-D312-47B0-962F-E16287A2ECE0}.Release|x86.Build.0 = Release|Any CPU EndGlobalSection GlobalSection(SolutionProperties) = preSolution HideSolutionNode = FALSE diff --git a/TaskMaster.vbproj b/TaskMaster.vbproj index fd67a3f89..5387142b5 100644 --- a/TaskMaster.vbproj +++ b/TaskMaster.vbproj @@ -136,12 +136,6 @@ --> - - packages\Deedle.2.3.0\lib\net45\Deedle.dll - - - packages\FSharp.Core.4.5.2\lib\net45\FSharp.Core.dll - @@ -216,6 +210,7 @@ + @@ -320,10 +315,11 @@ true - TaskMaster_TemporaryKey.pfx + + - 91CF4C6DBCE9AF478234324E367ABCDF0F79A9EA + BEAD7788F7A6A4B03DF44BF81A95E5C636B80B28 diff --git a/packages.config b/packages.config index a6ce912c0..8f682d340 100644 --- a/packages.config +++ b/packages.config @@ -1,6 +1,4 @@  - - \ No newline at end of file