00001: Attribute VB_Name = "SY_MG_Toolbar"
00002: Option Explicit
00003: Dim RsIn        As ADODB.Recordset
00004: Dim RsInJob     As ADODB.Recordset
00005: Dim RsOutJob    As ADODB.Recordset
00006: Dim FreezeID    As New Collection      'Замороженные сообщения
00007: Dim FreezeTime  As New Collection
00008: Dim UpQueryID   As New Collection      'Очередь на всплытие
00009: Dim UpQueryTime As New Collection
00010: Dim UpQueryBlock As Boolean
00011: '
00012: Public Sub SY_MGToolbar(Toolbar As MSComctlLib.Toolbar, BlinkTimer As VB.Timer, ToolBar_Timer As VB.Timer)
00013: Dim j As Integer, Ret As Integer
00014: '
00015: 'Это самый первый вход - перепрограммируем в нем таймер и удаляем устаревшие сообщения
00016: Static FirstStart As Integer
00017: If FirstStart Then
00018:     ToolBar_Timer.Interval = 10000
00019:     Ret = SPi("SY_MG_MessageDeleteSeans")
00020: End If
00021: '
00022: 'Кнопка входящих задач
00023: Set RsInJob = SPr("SY_MG_MessageReadToolbar", "@CurrentUser", CurrentUser, "@Sender", 0, "@Recipient", 1, "@JobsOnly", 1, "@JobsOnlyNotConfirmed", 1)
00024: If RsInJob.EOF Then
00025:     Toolbar.Buttons(3).Enabled = False
00026: Else
00027:     Toolbar.Buttons(3).Enabled = True
00028: End If
00029: RsInJob.Close
00030: '
00031: 'Кнопка исходящих задач
00032: Set RsOutJob = SPr("SY_MG_MessageReadToolbar", "@CurrentUser", CurrentUser, "@Sender", 1, "@Recipient", 0, "@JobsOnly", 1, "@JobsOnlyNotConfirmed", 1)
00033: If RsOutJob.EOF Then
00034:     Toolbar.Buttons(4).Enabled = False
00035: Else
00036:     Toolbar.Buttons(4).Enabled = True
00037: End If
00038: RsOutJob.Close
00039: '
00040: 'Кнопка отложенных сообщений
00041: If FreezeID.Count > 0 Then
00042:     For j = FreezeID.Count To 1 Step -1
00043:         If FreezeTime(j) < Now Then
00044:             'уже неактуально - удаляем его
00045:             FreezeID.Remove (j)
00046:             FreezeTime.Remove (j)
00047:         End If
00048:     Next j
00049:     If FreezeID.Count > 0 Then
00050:         'из оставшихся - первый на кнопке
00051:         Toolbar.Buttons(5).Enabled = True
00052:         Toolbar.Buttons(5).Tag = FreezeID(1)
00053:     End If
00054: Else
00055:     Toolbar.Buttons(5).Enabled = False
00056: End If
00057: '
00058: 'Кнопки входящих сообщений
00059: Set RsIn = SPr("SY_MG_MessageReadToolbar3", "@CurrentUser", CurrentUser)
00060: If RsIn.EOF Then
00061:     RsIn.Close
00062:     Exit Sub
00063: End If
00064: BlinkTimer.Enabled = False
00065: '
00066: 'Теперь перестроим ТоолБар
00067: Call ToolBar_Rebuild(RsIn, Toolbar)
00068: '
00069: RsIn.Close
00070: BlinkTimer.Enabled = True
00071: '
00072: 'Всплытие сообщений из входящей очереди
00073: If UpQueryID.Count > 0 Then
00074:     For j = UpQueryID.Count To 1 Step -1
00075:         If UpQueryTime(j) < Now Then
00076:             UpQueryBlock = True 'заблокировали очередь
00077:             'FCE.sCall Nothing, "SY_MGRead", 1, 1, UpQueryID(j)
00078:             Call SY_MG_QueryRemove(UpQueryID(j))
00079:             UpQueryBlock = True 'Разблокировали очередь
00080:         End If
00081:     Next j
00082: End If
00083: End Sub
00084: 
00085: Private Sub ToolBar_Rebuild(RsIn As ADODB.Recordset, Toolbar As MSComctlLib.Toolbar)
00086: Dim NewButton As MSComctlLib.Button, i As Integer, Str1 As String
00087: '
00088: 'На тулбаре пять постоянных кнопок + два разделителя - остальные кнопки чистим
00089: For i = Toolbar.Buttons.Count To 7 Step -1
00090:     Toolbar.Buttons.Remove (i)
00091: Next i
00092: '
00093: 'Добавляем из рекордсета
00094: i = 0
00095: Do While Not RsIn.EOF And i < 15
00096:     i = i + 1
00097:     Set NewButton = Toolbar.Buttons.Add(, "SY_MGRead" & RsIn("ID"), , tbrDefault)
00098:     NewButton.Tag = RsIn("ID")
00099:     Select Case RsIn("Priority")
00100:     Case 1
00101:         NewButton.Image = "MG_Blue"
00102:     Case 2
00103:         NewButton.Image = "MG_Blue"
00104:     Case 3
00105:         NewButton.Image = "MG_Red"
00106:     Case 4
00107:         NewButton.Image = "MG_Red"
00108:     End Select
00109:     '
00110:     Str1 = RsIn("ID") & ":" & RsIn("Получатель") & ":" & RsIn("Дата") & ":" & Left(RsIn("Текст сообщения"), 15) & "..."
00111:     If Len(Str1) > 50 Then
00112:         Str1 = Left(Str1, 50)
00113:     Else
00114:         Str1 = Str1 + Space(50 - Len(Str1))
00115:     End If
00116:     'Приоритет в 51 позиции
00117:     NewButton.ToolTipText = Str1 & RsIn("Priority")
00118:     '
00119:     'Добавим сообщение в очередь на всплытие
00120:     Call SY_MG_UpQueryAdd(RsIn("ID"), RsIn("Время всплытия"))
00121:     '
00122:     RsIn.MoveNext
00123: Loop
00124: End Sub
00125: Public Sub SY_MG_FreezeAdd(Number As Integer, Time1 As Integer)
00126: Dim j As Integer
00127: For j = 1 To FreezeID.Count
00128:     'если сообщение уже там, повторно добавлять не надо
00129:     If FreezeID(j) = Number Then Exit Sub
00130: Next j
00131: FreezeID.Add Number
00132: FreezeTime.Add DateAdd("n", Time1, Now)
00133: End Sub
00134: Private Sub SY_MG_UpQueryAdd(Number As Integer, Time1 As Integer)
00135: If UpQueryBlock Then Exit Sub
00136: Dim j As Integer
00137: For j = 1 To UpQueryID.Count
00138:     'если сообщение уже там, повторно добавлять не надо
00139:     If UpQueryID(j) = Number Then Exit For
00140: Next j
00141: UpQueryID.Add Number
00142: UpQueryTime.Add DateAdd("n", Time1, Now)
00143: End Sub
00144: Public Sub SY_MG_QueryRemove(Number As Integer)
00145: Dim j As Integer
00146: 'Сначала удаляем из отложенной очереди
00147: For j = 1 To FreezeID.Count
00148:     If FreezeID(j) = Number Then
00149:         FreezeID.Remove (j)
00150:         FreezeTime.Remove (j)
00151:         Exit Sub
00152:     End If
00153: Next j
00154: '
00155: 'Теперь удаляем из очереди на всплытие
00156: For j = 1 To UpQueryID.Count
00157:     If UpQueryID(j) = Number Then
00158:         UpQueryID.Remove (j)
00159:         UpQueryTime.Remove (j)
00160:         Exit Sub
00161:     End If
00162: Next j
00163: 'если не нашли, значит уже удалено раньше
00164: End Sub
00165: Public Sub SY_MGBlink(Toolbar As MSComctlLib.Toolbar)
00166: Dim i As Integer
00167: Static Count As Integer
00168: Count = Count + 1
00169: If Count > 100 Then Count = 1
00170: 'На тулбаре пять постоянных кнопок + два разделителя - остальные кнопки моргаем
00171: For i = Toolbar.Buttons.Count To 7 Step -1
00172:     Select Case Mid(Toolbar.Buttons(i).ToolTipText, 51, 1)
00173:     Case 2
00174:         If Count Mod 2 = 0 Then
00175:             Toolbar.Buttons(i).Image = "MG_Blue1"
00176:         Else
00177:             Toolbar.Buttons(i).Image = "MG_Blue"
00178:         End If
00179:     Case 4
00180:         If Count Mod 2 = 0 Then
00181:             Toolbar.Buttons(i).Image = "MG_Red1"
00182:         Else
00183:             Toolbar.Buttons(i).Image = "MG_Red"
00184:         End If
00185:     End Select
00186: Next i
00187: End Sub
00188: 
00189: Attribute VB_Name = "SY_MG_Common"
00190: Option Explicit
00191: 
00192: Public Function GetFileNameFromPath(Path As String)
00193: Dim TempFileName As String, i As Integer, j As Integer
00194: j = 1
00195: i = 1
00196: Do While (j > 0)
00197: j = InStr(i, Path, "\", vbTextCompare)
00198: If j > 0 Then i = j + 1
00199: Loop
00200: GetFileNameFromPath = Mid(Path, i, Len(Path) - i + 1)
00201: End Function
00202: 
00203: Attribute VB_Name = "SY_MG_Common"
00204: Option Explicit
00205: 
00206: Public Function GetFileNameFromPath(Path As String)
00207: Dim TempFileName As String, i As Integer, j As Integer
00208: j = 1
00209: i = 1
00210: Do While (j > 0)
00211: j = InStr(i, Path, "\", vbTextCompare)
00212: If j > 0 Then i = j + 1
00213: Loop
00214: GetFileNameFromPath = Mid(Path, i, Len(Path) - i + 1)
00215: End Function

< THANKS ME>