VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.UserControl ToolbarControl 
   Alignable       =   -1  'True
   Appearance      =   0  'Flat
   BackColor       =   &H80000005&
   BackStyle       =   0  'Transparent
   ClientHeight    =   645
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   12120
   FillColor       =   &H00FFFFFF&
   ForeColor       =   &H00FFFFFF&
   MaskColor       =   &H00FFFFFF&
   ScaleHeight     =   645
   ScaleWidth      =   12120
   ToolboxBitmap   =   "ArmToolbar.ctx":0000
   Begin MSComctlLib.Toolbar Toolbar 
      Align           =   1  'Align Top
      Height          =   690
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   12120
      _ExtentX        =   21378
      _ExtentY        =   1217
      ButtonWidth     =   1402
      ButtonHeight    =   1058
      AllowCustomize  =   0   'False
      Appearance      =   1
      _Version        =   393216
      BorderStyle     =   1
      OLEDropMode     =   1
   End
   Begin MSComctlLib.ImageList mo_ilsIconLanguage 
      Left            =   6000
      Top             =   0
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      MaskColor       =   12632256
      _Version        =   393216
   End
   Begin MSComctlLib.ImageList mo_ilsIcon 
      Left            =   600
      Top             =   0
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      MaskColor       =   12632256
      _Version        =   393216
   End
   Begin MSComctlLib.ImageCombo mo_imgcboLanguage 
      Height          =   330
      Left            =   2160
      TabIndex        =   1
      Top             =   120
      Visible         =   0   'False
      Width           =   615
      _ExtentX        =   1085
      _ExtentY        =   582
      _Version        =   393216
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      Text            =   "ImageCombo"
   End
End
Attribute VB_Name = "ToolbarControl"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private ms_ToolbarString        As String  ' string for one toolbar AZZGjjHccIkkJIILOOMBB
Private ms_ButtonsString        As String  ' string for one toolbar AZZGjjHccIkkJIILOOMBB in design mode
Private ms_ToolbarInfoString    As String  ' string for one toolbar key e.g. 0010AAAABBBCCC1CCCFFGG®0020hhhjjj1EEEFFFRRR...
Private ms_Face                 As String  ' displayed face
Private ms_ToolbarKey           As String  ' displayed toolbarkey
Private ms_ApplicationName      As String  ' application name in database
Private mi_UserCode             As Integer ' user code in database
Private mo_colToolbarInfoString As New Collection  ' collection (create from ms_ToolbarInfoString) of toolbarkeys items, which have faces items e.g. mo_colToolbarInfoString.item("001").item("0") return ms_ToolbarString for toolbarkey="001" face = "0"
Private mo_colToolbar           As New clsIconInfoCollection  ' collection (create from ms_ToolbarString without languages prefix) of displayed icons in toolbar
'Private mo_colLanguage          As New clsIconInfoCollection  ' collection of language icons, if languages are defined in ToolbarString, only these languages, else all languages
Private mo_colLanguage          As clsIconInfoCollection  ' collection of language icons, if languages are defined in ToolbarString, only these languages, else all languages
'Private mo_colIcon              As New clsIconInfoCollection  ' collection of all toolbar icons, load from resource/dll file
Private mo_colIcon              As clsIconInfoCollection  ' collection of all toolbar icons, load from resource/dll file
Private mb_MaintenanceMode      As Boolean                    ' Toolbar for run-time (false) or toolbar for maintenance application (true)
Private ml_comboWidth           As Long     ' width of language combo dependent of translation existance

' languages variables
Private ms_LanguageDefault      As String  ' public property Language, default language for user and application(selected by loggin in aplication)
Private ms_LanguageMaster       As String  ' master language for application
Private ms_LanguageSelected     As String  ' selected language
Private ms_Languages            As String  ' all available languages in their DLL order

'Private ms_LanguageAvailable    As String  ' list of available languages
Private ms_LanguageAuthTrans    As String  ' list of languages for authorized translation

' special icon
Private ms_IconLanguageKey      As String  ' icon for language combo
Private ms_IconSpecial          As String  ' icon which change role if user has rights
Private ms_IconInvisible        As String  ' if user has no translation rights these icons are invisible
Private ms_IconImageListName    As String
Private ms_LangImageListName    As String
' toolbar info size, align ...
Private mi_Width As Integer

'Constants
Private Const ms_Delimiter         As String = "©"  ' delimiter for toolbar keys in ms_ToolbarInfoString
Private Const ms_DelimiterSub      As String = "®"  ' delimiter in Toolbar string for one ToolbarKey
Private Const ms_DelimiterLang     As String = "/"  ' delimiter in Toolbar string authorized translation languages and special icons
Private Const ms_DefaultLanguage   As String = "E"  ' default language for toolbar
Private Const ms_DefaultFace       As String = "0"  ' default face
Private Const ms_DefaultToolbarKey As String = "001"  ' default toolbar key
Private Const ms_UpperCharStart    As String = "A"  ' first upper char
Private Const ms_UpperCharEnd      As String = "Z"  ' last upper char
Private Const ms_LowerCharStart    As String = "a"  ' first lower char
Private Const ms_LowerCharEnd      As String = "z"  ' last lower char
Private Const ml_InternalError     As Long = 10000  ' number for internal error
Private Const ms_IconLangPrefix    As String = "L"  ' name prexif in icons collection for languages icons(image combo flag) in toolbar (no in language combo !!!)
Private Const CB_SHOWDROPDOWN = &H14F
Private Const KEY_PREFIX As String = "_"             ' JN key prefix: must be same as in InonInfo.Key

' Automatic Icons from table Security and connection parameters
Private mo_ArmDb As ArmDb
Private mb_Connected As Boolean ' status if ArmDB is connected or not
Private Const SEP = "®©"        ' standard armstrong separator

'Windows message constant to enable or disable redrawing of control
Private Const WM_SETREDRAW = &HB

' connect parameters
Private ms_Server As String
Private ms_Db As String
Private ms_User As String
Private ms_Pwd As String
Private ms_App As String
' component created the connection itself internally
Private mb_InternalConnection As Boolean
' contain settig if tooltips of toolbar should be displayed or not
Private mb_HideTips As Boolean

Public Event action(ByVal as_Role As String, as_Language As String)  ' user control event
Public Event RoleChanged(ByVal as_Role As String, as_Key As String)  ' user control event

Public Event MouseDown(Button As Integer, Shift As Integer, X As Single, y As Single)

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, _
  ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

' Dll icons functions
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" _
   (ByVal lpLibFileName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Private Declare Function LoadStringFromDLL Lib "user32" Alias "LoadStringA" _
   (ByVal hInstance As Long, ByVal wID As Long, ByVal lpBuffer As String, _
    ByVal nBufferMax As Long) As Long
Private Declare Function LoadIconFromDLL Lib "user32" Alias "LoadIconA" (ByVal hInstance As Long, ByVal lpIconName As Long) As Long
Private Declare Function LoadBitmapFromDLL Lib "user32" Alias "LoadBitmapA" (ByVal hInstance As Long, ByVal lpBitmapName As Long) As Long
Private Type PictDesc
    cbSizeofStruct As Long
    picType As Long
    hImage As Long
    xExt As Long
    yExt As Long
End Type
Private Type Guid
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (lpPictDesc As PictDesc, riid As Guid, ByVal fPictureOwnsHandle As Long, ipic As IPicture) As Long

'Enabled property
Public Property Get Enabled() As Boolean

'#If CompDebugTV Then
'  Call mo_Trace.WriteTraceProc(True, "ArmTreeView:Enabled_Get")
'#End If
  
  Enabled = Toolbar.Enabled
'#If CompDebugTV Then
'  Call mo_Trace.WriteTraceProc(False, "ArmTreeView:Enabled_Get")
'#End If

End Property

Public Property Let Enabled(ByVal vNewValue As Boolean)

'#If CompDebugTV Then
'  Call mo_Trace.WriteTraceProc(True, "ArmTreeView:Enabled_Let")
'#End If
  
  Toolbar.Enabled = vNewValue
'#If CompDebugTV Then
'  Call mo_Trace.WriteTraceProc(False, "ArmTreeView:Enabled_Let")
'#End If

End Property


Public Property Get HideTips() As Boolean

  
  HideTips = mb_HideTips
End Property

Public Property Let HideTips(ByVal vNewValue As Boolean)

  
  mb_HideTips = vNewValue
End Property

Public Property Set ArmDb(ByVal lo_Db As ARMSYSCOMLib.ArmDb)

'#If CompDebugTV Then
'  Call mo_Trace.WriteTraceProc(True, "ArmToolbar:ArmDb_Set")
'#End If
  
  Set mo_ArmDb = lo_Db
  mb_Connected = Not (lo_Db Is Nothing)

'#If CompDebugTV Then
'  Call mo_Trace.WriteTraceProc(False, "ArmToolbar:ArmDb_Set")
'#End If

End Property

'set and get reference to ArmDB component (should be used for DBF access, because only one instance can access
'DBF file.
Public Property Get ArmDb() As ARMSYSCOMLib.ArmDb

'#If CompDebugTV Then
'  Call mo_Trace.WriteTraceProc(True, "ArmToolbar:ArmDb_Get")
'#End If
  
  Set ArmDb = mo_ArmDb

'#If CompDebugTV Then
'  Call mo_Trace.WriteTraceProc(False, "ArmToolbar:ArmDb_Get")
'#End If

End Property

Public Property Get IsConnected() As Boolean

On Error GoTo ErrorHandler
'#If CompDebugTV Then
'  Call mo_Trace.WriteTraceProc(True, "ArmToolbar:IsConnected_Get")
'#End If
  
  IsConnected = False
  If Not (mo_ArmDb Is Nothing) Then
    IsConnected = mo_ArmDb.IsConnected
  End If
'#If CompDebugTV Then
'  Call mo_Trace.WriteTraceProc(False, "ArmToolbar:IsConnected_Get")
'#End If
  Exit Property
ErrorHandler:
'#If CompDebug Then
'    Call mo_Trace.WriteTraceError("ArmToolbar:IsConnected_Get")
'#End If
  IsConnected = mb_Connected

End Property

' Connection parameters in case component shold create connection itself
Public Property Let ConnectString(as_Value As String)
Dim la_Params() As String

On Error GoTo ErrorHandler
'#If CompDebugTV Then
'  Call mo_Trace.WriteTraceProc(True, "ArmToolbar:ConnectString_Let")
'#End If
  
  If (as_Value <> "") Then
    la_Params = Split(as_Value, SEP, 5)
    ms_Server = la_Params(0)
    ms_Db = la_Params(1)
    ms_User = la_Params(2)
    ms_Pwd = la_Params(3)
    If UBound(la_Params) >= 4 Then
      ms_App = la_Params(4)
    Else
      ms_App = "ArmToolbar"
    End If
  Else
    ms_Server = ""
    ms_Db = ""
    ms_User = ""
    ms_Pwd = ""
  End If

'#If CompDebugTV Then
'  Call mo_Trace.WriteTraceProc(False, "ArmToolbar:ConnectString_Let")
'#End If
  Exit Property
ErrorHandler:
'  #If CompDebugTV Then
'    Call mo_Trace.WriteTraceError("ArmToolbar:ConnectString_Let", "as_Value=" & as_Value)
'  #End If

End Property

' Open conection and create own instance of ArmDB if it was not passed through property
Private Function OpenConnection(as_Server As String, as_Db As String, as_User As String, _
    as_Pwd As String, as_App As String) As Boolean
Dim lb_Result As Boolean

On Error GoTo ErrorHandler
'#If CompDebugTV Then
'  Call mo_Trace.WriteTraceProc(True, "ArmToolbar:OpenConnection")
'#End If
 
  lb_Result = False
  If IsConnected Then
    lb_Result = False
  Else
    mb_InternalConnection = True
    If mo_ArmDb Is Nothing Then
      Set mo_ArmDb = New ARMSYSCOMLib.ArmDb
    End If

    If (as_Server <> "") And (as_Db <> "") And (as_User <> "") Then
      lb_Result = mo_ArmDb.Connect(as_Server, as_Db, as_User, as_Pwd, as_App)
    End If
    mb_Connected = lb_Result
  End If
  OpenConnection = lb_Result
  
  Exit Function
ErrorHandler:
  OpenConnection = False

End Function

'close connection if connection was created with OpenConnection method and
Private Sub CloseConnection()

On Error GoTo ErrorHandler
'#If CompDebugTV Then
'  Call mo_Trace.WriteTraceProc(True, "ArmToolbar:CloseConnection")
'#End If
  
  If IsConnected Then
    Call mo_ArmDb.Disconnect
    mb_InternalConnection = False
  End If
  
'#If CompDebugTV Then
'  Call mo_Trace.WriteTraceProc(False, "ArmToolbar:CloseConnection")
'#End If
  Exit Sub
ErrorHandler:
'  #If CompDebugTV Then
'    Call mo_Trace.WriteTraceError("ArmToolbar:CloseConnection")
'  #End If

End Sub
 
' Name :        property Get MaintenanceMode
' Parameters:
' Description:  Return property mb_MaintenanceMode
' Return value: mb_MaintenanceMode

Public Property Get MaintenanceMode() As Boolean

  MaintenanceMode = mb_MaintenanceMode

End Property

' Name :        property Let MaintenanceMode
' Parameters:   ab_MaintenanceMode - false (run-time mode), true (maintenance mode)
' Description:  Setting of property mb_MaintenanceMode
' Return value:

Public Property Let MaintenanceMode(ab_MaintenanceMode As Boolean)
   
  mb_MaintenanceMode = ab_MaintenanceMode

End Property

' Name :        property Get Language
' Parameters:
' Description:  Return property language
' Return value: selected language for toolbar

Public Property Get Language() As String
   
  Language = ms_LanguageSelected

End Property

' Name :        property Let Language
' Parameters:   as_Language - selected language for toolbar
' Description:  Setting default and selected language for toolbar
' Return value:

Public Property Let Language(as_Language As String)
   
  ms_LanguageDefault = as_Language
  ms_LanguageSelected = as_Language

End Property

' Name :        property Get LanguageMaster
' Parameters:
' Description:  Return property LanguageMaster
' Return value: selected LanguageMaster for toolbar

Private Property Get LanguageMaster() As String
  
  LanguageMaster = ms_LanguageMaster

End Property

' Name :        property Let LanguageMaster
' Parameters:   as_LanguageMaster - set LanguageMaster
' Description:  Setting LanguageMaster for toolbar
' Return value:

Private Property Let LanguageMaster(as_LanguageMaster As String)
   
  ms_LanguageMaster = as_LanguageMaster
  If Language = "" Then
    Language = ms_LanguageMaster
  End If

End Property

' Name :        property Get LanguageAuthTrans
' Parameters:
' Description:  Return property LanguageAuthTrans
' Return value: selected LanguageAuthTrans for toolbar

Private Property Get LanguageAuthTrans() As String
  
  LanguageAuthTrans = ms_LanguageAuthTrans

End Property

' Name :        property Let LanguageAuthTrans
' Parameters:   as_LanguageAuthTrans - set LanguageAuthTrans
' Description:  Setting LanguageAuthTrans for toolbar
' Return value:

Private Property Let LanguageAuthTrans(as_LanguageAuthTrans As String)
  
  ms_LanguageAuthTrans = as_LanguageAuthTrans

End Property

' Name :        property Get IconLanguage
' Parameters:
' Description:  Return property IconLanguage
' Return value: selected IconLanguage for toolbar

Private Property Get IconLanguageKey() As String
  
  IconLanguageKey = ms_IconLanguageKey

End Property

' Name :        property Let IconLanguage
' Parameters:   as_IconLanguage - set IconLanguage
' Description:  Setting IconLanguage for toolbar
' Return value:

Private Property Let IconLanguageKey(as_IconLanguageKey As String)
  
  ms_IconLanguageKey = as_IconLanguageKey

End Property

' Name :        property Get IconSpecial
' Parameters:
' Description:  Return property IconSpecial
' Return value: selected IconSpecial for toolbar

Private Property Get IconSpecial() As String
  
  IconSpecial = ms_IconSpecial

End Property

' Name :        property Let IconSpecial
' Parameters:   as_IconSpecial - set IconSpecial
' Description:  Setting IconSpecial for toolbar
' Return value:

Private Property Let IconSpecial(as_IconSpecial As String)
  
  ms_IconSpecial = as_IconSpecial

End Property

' Name :        property Get IconInvisible
' Parameters:
' Description:  Return property IconInvisible
' Return value: selected IconInvisible for toolbar

Private Property Get IconInvisible() As String
  
  IconInvisible = ms_IconInvisible

End Property

' Name :        property Let IconInvisible
' Parameters:   as_IconInvisible - set IconInvisible
' Description:  Setting IconInvisible for toolbar
' Return value:

Private Property Let IconInvisible(as_IconInvisible As String)
  
  ms_IconInvisible = as_IconInvisible

End Property

' Name :        property Get ToolbarWidth
' Parameters:
' Description:  Return property Width
' Return value: Width for toolbar

Private Property Get ToolbarWidth() As Integer
  
  ToolbarWidth = mi_Width

End Property

' Name :        property Let ToolbarWidth
' Parameters:   as_IconInvisible - set Width
' Description:  Setting Width for toolbar
' Return value:

Private Property Let ToolbarWidth(ai_Width As Integer)
  
  mi_Width = ai_Width

End Property

' Name :        property Get Face
' Parameters:
' Description:  return property face
' Return value: ms_Face

Private Property Get Face() As String
  
  Face = ms_Face

End Property

Public Property Get Faces() As Collection

On Error GoTo ErrorHandler
  Set Faces = Nothing
  If ToolbarKey <> "" Then
    Set Faces = mo_colToolbarInfoString(ToolbarKey)
  End If
  Exit Property
ErrorHandler:
  Set Faces = Nothing
End Property

' Name :        property Let Face
' Parameters:   as_Face - setting face for toolbar
' Description:  Setting face for toolbar, if none, then default face
' Return value:

Private Property Let Face(as_face As String)
  
  If (as_face = "") Then
    ms_Face = ms_DefaultFace
  Else
    ms_Face = as_face
  End If

End Property

Public Property Let ButtonVisible(as_Role As String, ab_Visible As Boolean)
Dim lo_IconInfo As clsIconInfo

  On Error GoTo ErrorHandler
  Set lo_IconInfo = mo_colToolbar.ItemByRole(as_Role)
  If Not (lo_IconInfo Is Nothing) Then
    lo_IconInfo.Visible = ab_Visible
    Call ShowToolbar
  End If
ErrorHandler:
End Property

Public Property Get ButtonVisible(as_Role As String) As Boolean
Dim lo_IconInfo As clsIconInfo

  On Error GoTo ErrorHandler
  ButtonVisible = False
  Set lo_IconInfo = mo_colToolbar.ItemByRole(as_Role)
  If Not (lo_IconInfo Is Nothing) Then
    ButtonVisible = lo_IconInfo.Visible
  End If
ErrorHandler:
End Property

Public Property Let ButtonEnabled(as_Role As String, ab_Enabled As Boolean)
Dim lo_IconInfo As clsIconInfo

  On Error GoTo ErrorHandler
  Set lo_IconInfo = mo_colToolbar.ItemByRole(as_Role)
  If Not (lo_IconInfo Is Nothing) Then
    lo_IconInfo.Enabled = ab_Enabled
    Toolbar.Buttons(lo_IconInfo.Key).Enabled = ab_Enabled
  End If
ErrorHandler:
End Property

Public Property Get ButtonEnabled(as_Role As String) As Boolean
Dim lo_IconInfo As clsIconInfo

  On Error GoTo ErrorHandler
  ButtonEnabled = False
  Set lo_IconInfo = mo_colToolbar.ItemByRole(as_Role)
  If Not (lo_IconInfo Is Nothing) Then
    Debug.Assert (Toolbar.Buttons(lo_IconInfo.Key).Enabled = lo_IconInfo.Enabled)
    ButtonEnabled = Toolbar.Buttons(lo_IconInfo.Key).Enabled
  End If
ErrorHandler:
End Property

Public Property Let ButtonTooltip(as_Role As String, as_Text As String)
Dim lo_IconInfo As clsIconInfo

  On Error GoTo ErrorHandler
  Set lo_IconInfo = mo_colToolbar.ItemByRole(as_Role)
  If Not (lo_IconInfo Is Nothing) Then
    lo_IconInfo.Description = as_Text
    Toolbar.Buttons(lo_IconInfo.Key).ToolTipText = as_Text
  End If
ErrorHandler:
End Property

Public Property Get ButtonTooltip(as_Role As String) As String
On Error GoTo ErrorHandler

Dim lo_IconInfo As clsIconInfo

  ButtonTooltip = ""
  Set lo_IconInfo = mo_colToolbar.ItemByRole(as_Role)
  If Not (lo_IconInfo Is Nothing) Then
    ButtonTooltip = Toolbar.Buttons(lo_IconInfo.Key).ToolTipText
  End If
ErrorHandler:
End Property

Property Let Redraw(lb_Value As Boolean)

  Call SetRedraw(lb_Value)
End Property

' Name :        property Get ToolbarKey
' Parameters:
' Description:  return property ToolbarKey
' Return value: ms_ToolbarKey

Private Property Get ToolbarKey() As String
  
  ToolbarKey = ms_ToolbarKey

End Property

' Name :        property Let ToolbarKey
' Parameters:   as_ToolbarKey - setting ToolbarKey for toolbar
' Description:  Setting ToolbarKey for toolbar, if none, then default ToolbarKey
' Return value:

Public Property Let ToolbarKey(as_ToolbarKey As String)
  
  If (as_ToolbarKey = "") Then
    ms_ToolbarKey = ms_DefaultToolbarKey
  Else
    ms_ToolbarKey = as_ToolbarKey
  End If

End Property

' Name :        property Get ApplicationName
' Parameters:
' Description:  return property ApplicationName
' Return value: ms_ApplicationName

Private Property Get ApplicationName() As String
  
  ApplicationName = ms_ApplicationName

End Property

' Name :        property Let ApplicationName
' Parameters:   ab_ApplicationName - module name
' Description:  Setting of property ms_ApplicationName
' Return value:

Private Property Let ApplicationName(as_ApplicationName As String)
  
  ms_ApplicationName = as_ApplicationName

End Property

' Name :        property Get UserCode
' Parameters:
' Description:  return property UserCode
' Return value: mi_UserCode

Private Property Get UserCode() As Integer
  
  UserCode = mi_UserCode

End Property

' Name :        property Let UserCode
' Parameters:   ai_UserCode - user code
' Description:  Setting of property mi_UserCode
' Return value:

Private Property Let UserCode(ai_UserCode As Integer)
  
  mi_UserCode = ai_UserCode

End Property

' Name :        property Let ButtonsString
' Parameters:   as_ButtonsString - string for one toolbar with/without language prefix
' Description:  Setting ToolbarString for toolbar only in desing time.
'               Display toolbar (function ShowToolbar)
' Return value:

Public Property Let ButtonsString(ByVal as_ButtonsString As String)
Dim li_Width As Integer

  If Ambient.UserMode And Not MaintenanceMode Then
    'Err.Raise 382, , "Let/Set of Property ButtonsString not supported at run time."
  Else
    If MaintenanceMode Then
      Load_A_Com
      MaintenanceMode = True
    Else
      Load_A_Com
    End If

    If Not Ambient.UserMode Then
      li_Width = Width
      ms_ButtonsString = as_ButtonsString
      ToolbarString = as_ButtonsString
      Width = li_Width
    Else
      ToolbarString = as_ButtonsString
    End If
  End If

End Property

' Name :        property Get ButtonsString
' Parameters:
' Description:  return property ButtonsString
' Return value: ms_ButtonsString

Public Property Get ButtonsString() As String
Dim ls_ButtonsString As String
Dim lo_ToolbarItem As New clsIconInfo
Dim li_Position As Integer

  If Not (mo_colToolbar Is Nothing) Then
    For li_Position = Asc(ms_UpperCharStart) To Asc(ms_LowerCharEnd)
      Set lo_ToolbarItem = mo_colToolbar.ItemPosition(Chr(li_Position))
      If Not (lo_ToolbarItem Is Nothing) Then
        ls_ButtonsString = ls_ButtonsString + lo_ToolbarItem.Position + lo_ToolbarItem.Name + lo_ToolbarItem.Role
      End If
    Next
  End If
  ButtonsString = ls_ButtonsString

End Property

' Name :        property Get ToolbarString
' Parameters:
' Description:  return property ToolbarString
' Return value: ms_ToolbarString

Private Property Get ToolbarString() As String

  ToolbarString = ms_ToolbarString

End Property

' Name :        property Let ToolbarString
' Parameters:   as_ToolbarString - string for one toolbar with/without language prefix
' Description:  Setting ToolbarString for toolbar.
'               If exists language prefix sets selected language and available languages for toolbar/user
'               Fill mo_colToolbar collection for toolbar
'               Display toolbar (function ShowToolbar)
' Return value:

Private Property Let ToolbarString(ByVal as_ToolbarString As String)
Dim lo_arrToolbarString() As String
Dim ls_ToolbarString As String

On Error GoTo ErrorHandler:

  ms_ToolbarString = as_ToolbarString
  ls_ToolbarString = ms_ToolbarString

  Set mo_colToolbar = New clsIconInfoCollection

  While Len(ls_ToolbarString) > 2
    Call mo_colToolbar.Add(Mid(ls_ToolbarString, 2, 1), , "", Mid(ls_ToolbarString, 3, 1), Mid(ls_ToolbarString, 1, 1))        ' JN send parameter Description 21/05/2012
    ls_ToolbarString = right(ls_ToolbarString, Len(ls_ToolbarString) - 3)
  Wend

  If Not (ShowToolbar()) Then
    GoTo ErrorHandler
  End If

  Exit Property

ErrorHandler:
   
'   If Err.Number <> 0 Then
'      MsgBox "Error number: " + CStr(Err.Number) _
'       + Chr(13) + "Module: " + Err.Source + ", " + Name _
'       + Chr(13) + "Description:" + Err.Description, vbCritical
'   End If
   
End Property

' Name :        property Get ToolbarInfoString
' Parameters:
' Description:  return property ToolbarInfoString
' Return value: ms_ToolbarInfoString

Private Property Get ToolbarInfoString() As String

  ToolbarInfoString = ms_ToolbarInfoString

End Property

' Name :        property Let ToolbarInfoString
' Parameters:   as_ToolbarInfoString - string for toolbars with toolbar keys and faces
' Description:  Create mo_colToolbarInfoString collection for as_ToolbarString
'               Split string on substrings, which are delimited with ms_Delimiter (string for one toolbarkey)
'               Split every substring on substring, which are elimited with face number (string for one face) = ms_ToolbarString
'               Add every substring (ToolbarString in mo_colToolbarInfoString)
' Return value:
 
Private Property Let ToolbarInfoString(as_ToolbarInfoString As String)
Dim lo_arrToolbarInfoString() As String
Dim lo_arrToolbarFaceString() As String
Dim lo_arrToolbarFaceStringItem(0 To 3) As String
Dim lo_arrToolbarString() As String
Dim ls_ToolbarKey As String
Dim ls_face As String
Dim ls_ToolbarFaceString As String
Dim lo_colToolbarFaceString As Collection
Dim li_Index As Integer
Dim ls_LangString As String
Dim ls_ToolbarInfoStringItem As Variant
Dim ls_FaceKey As String
Dim ls_ToolbarFaceStringItem As Variant

  lo_arrToolbarInfoString = Split(as_ToolbarInfoString, ms_Delimiter, -1, vbTextCompare)

  For Each ls_ToolbarInfoStringItem In lo_arrToolbarInfoString
    ls_ToolbarKey = Mid(ls_ToolbarInfoStringItem, 1, 3)
    ls_ToolbarInfoStringItem = Mid(ls_ToolbarInfoStringItem, 4, Len(ls_ToolbarInfoStringItem))

    If (ls_ToolbarKey = ToolbarKey) Then

      Set lo_colToolbarFaceString = New Collection
      ms_ToolbarInfoString = ls_ToolbarInfoStringItem
      ls_ToolbarFaceString = Empty
      ls_FaceKey = Empty

      ls_LangString = Mid(ms_ToolbarInfoString, 1, InStr(ms_ToolbarInfoString, ms_DelimiterSub) - 1)
      If (Len(ls_LangString) > 1) And Not (InStr(2, ls_LangString, Mid(ls_LangString, 1, 1)) = 0) Then
        LanguageMaster = Mid(ls_LangString, 1, 1)
            
'            LoadIconLang Mid(ls_LangString, 2)
      Else
        Err.Raise ml_InternalError, , "Either master language isn't defined or no available language is defined"
      End If

      ls_ToolbarInfoStringItem = Mid(ms_ToolbarInfoString, InStr(ms_ToolbarInfoString, ms_DelimiterSub) + 1, Len(ms_ToolbarInfoString))

      li_Index = 0
      lo_arrToolbarFaceString = Split(ls_ToolbarInfoStringItem, ms_DelimiterSub, -1, vbTextCompare)
         
      For Each ls_ToolbarFaceStringItem In lo_arrToolbarFaceString
        If (li_Index Mod 3) = 0 Then
          ls_face = Mid(ls_ToolbarFaceStringItem, 1, 1)
          lo_arrToolbarFaceStringItem(0) = Mid(ls_ToolbarFaceStringItem, 2, Len(ls_ToolbarFaceStringItem) - 1)
          lo_arrToolbarFaceStringItem(3) = ls_face
        Else
          lo_arrToolbarFaceStringItem(li_Index Mod 3) = ls_ToolbarFaceStringItem
        End If
            
        If (li_Index Mod 3) = 2 Then
          lo_colToolbarFaceString.Add Item:=lo_arrToolbarFaceStringItem, Key:=ls_face
        End If

        li_Index = li_Index + 1
      Next
      mo_colToolbarInfoString.Add Item:=lo_colToolbarFaceString, Key:=ls_ToolbarKey
         
      Exit For
    End If

  Next

End Property

' Name :        function DisplayFace
' Parameters:   as_Face - face, whom toolbar have to be displayed
' Description:  Setting ToolbarString for entry face from mo_colToolbarInfoString collection.
'               Display toolbar.
' Return value: true/false (No error/ error)

Public Function DisplayFace(as_face As String) As Boolean

On Error GoTo ErrorHandler:

  'If mo_colToolbarInfoString.Count > 0 Then
  Face = as_face
  ToolbarWidth = mo_colToolbarInfoString.Item(ToolbarKey).Item(Face)(0)
  If Not (mo_colToolbarInfoString.Item(ToolbarKey).Item(Face)(1) = "") Then
    IconLanguageKey = KEY_PREFIX & Mid(mo_colToolbarInfoString.Item(ToolbarKey).Item(Face)(1), 1, 1)
    If Not (InStr(mo_colToolbarInfoString.Item(ToolbarKey).Item(Face)(1), ms_DelimiterLang) = 0) Then
      LanguageAuthTrans = Mid(mo_colToolbarInfoString.Item(ToolbarKey).Item(Face)(1), 2, InStr(mo_colToolbarInfoString.Item(ToolbarKey).Item(Face)(1), ms_DelimiterLang) - 2)
      IconSpecial = Mid(mo_colToolbarInfoString.Item(ToolbarKey).Item(Face)(1), InStr(mo_colToolbarInfoString.Item(ToolbarKey).Item(Face)(1), ms_DelimiterLang) + 1, 1)
      IconInvisible = Mid(mo_colToolbarInfoString.Item(ToolbarKey).Item(Face)(1), InStr(mo_colToolbarInfoString.Item(ToolbarKey).Item(Face)(1), ms_DelimiterLang) + 2, Len(mo_colToolbarInfoString.Item(ToolbarKey).Item(Face)(1)) - 3 - Len(LanguageAuthTrans))
    End If
  End If
  ToolbarString = mo_colToolbarInfoString.Item(ToolbarKey).Item(Face)(2)
   
  DisplayFace = True
  Exit Function

ErrorHandler:
   
'   If Err.Number <> 0 Then
'      MsgBox "Error number: " + CStr(Err.Number) _
'       + Chr(13) + "Module: " + Err.Source + ", " + Name _
'       + Chr(13) + "Description:" + Err.Description, vbCritical
'   End If
    
  DisplayFace = False

End Function

' Name :        function SetDBParameters
' Parameters:   ai_UserCode  - user code
'               as_ApplicationName - application name
'               as_ToolbarKey - toolbar key
' Description:  Select ToolbarInfoString from database.
'               Set ToolbarInfoString.
'               Set ToolbarKey.
' Return value: true/false (No error/ error)

Public Function SetDBParameters(ai_UserCode As Integer, as_ApplicationName As String, _
         as_ToolbarKey As String) As Boolean
Dim ll_HStmt As Long
Dim ls_Req As String
Dim ls_Action As String
         
On Error GoTo ErrorHandler:
        
  ' try to open connection if component is not connected
  If Not IsConnected Then
    If Not OpenConnection(ms_Server, ms_Db, ms_User, ms_Pwd, ms_App) Then
      Err.Raise ml_InternalError, , "Open connection failed."
    End If
  End If

  UserCode = ai_UserCode
  ApplicationName = as_ApplicationName
   
  ls_Req = "SELECT tbu.Toolbar_Info FROM Toolbars_Users tbu " _
         + "INNER JOIN Applications app ON (tbu.app_id = app.id) " _
         + "WHERE User_Code = " + CStr(UserCode) + " AND " _
              + " app_name = '" + ApplicationName + "' "
            
  ll_HStmt = mo_ArmDb.OpenSQL(ls_Req, -1)
  If ll_HStmt = 0 Then
    'debug.print "No rows"
    GoTo ErrorHandler
  ElseIf ll_HStmt > 1 Then
    'debug.print "Too many rows"
    GoTo ErrorHandler
  End If

  ToolbarKey = as_ToolbarKey
  ToolbarInfoString = mo_ArmDb.GetFieldsAt(ll_HStmt, 0, "Toolbar_Info")
      
  mo_ArmDb.Close ll_HStmt
  
  SetDBParameters = True
   
  Exit Function
   
ErrorHandler:
  mo_ArmDb.Close ll_HStmt
   
'   If Err.Number <> 0 Then
'      MsgBox "Error number: " + CStr(Err.Number) _
'       + Chr(13) + "Module: " + Err.Source + ", " + Name _
'       + Chr(13) + "Description:" + Err.Description, vbCritical
'   End If
    
   SetDBParameters = False

End Function

' Name :        function SetToolbarInfoStringParameters
' Parameters:   as_ToolbarInfoString  - ToolbarInfoString
'               as_ToolbarKey - toolbar key
' Description:  Set ToolbarInfoString.
'               Set ToolbarKey.
' Return value: true/false (No error/ error)

Public Function SetToolbarInfoStringParameters(as_ToolbarInfoString As String, _
                  as_ToolbarKey As String) As Boolean
         
On Error GoTo ErrorHandler:
        
  ToolbarKey = as_ToolbarKey
  ToolbarInfoString = as_ToolbarInfoString
      
  SetToolbarInfoStringParameters = True
   
  Exit Function
   
ErrorHandler:
  SetToolbarInfoStringParameters = False

End Function

' Name :        function ShowToolbar
' Parameters:
' Description:  Create and fill toolbar control.
'               Information for toolbar control are in mo_colToolbar.
' Return value: true/false (No error/ error)

Private Function ShowToolbar() As Boolean
Dim lo_IconInfoItem As clsIconInfo
Dim li_LastPosition As Integer
'Dim lo_imgIcon As ListImage
Dim lo_BtnIcon As MSComctlLib.Button
Dim lo_cboItem As ComboItem
Dim ls_ImageName As String
Dim li_Position As Integer
Dim lo_IconInfoLanguageItem As Variant
Dim li_LangPosition As Integer
Dim li_Index As Integer
Dim ls_LangString As String
    
On Error GoTo ErrorHandler:

  Call SetRedraw(False)
  Toolbar.Buttons.Clear
  mo_imgcboLanguage.ComboItems.Clear
  mo_imgcboLanguage.Visible = False

  If Not (mo_colToolbar.GetLastPosition = "") Then
    For li_Position = Asc(ms_UpperCharStart) To Asc(mo_colToolbar.GetLastPosition)
      If Not (mo_colToolbar.ItemPosition(Chr(li_Position)) Is Nothing) Then
              
        Set lo_IconInfoItem = mo_colToolbar.ItemPosition(Chr(li_Position))
        li_LangPosition = InStr(ms_Languages, ms_LanguageSelected)

        If (lo_IconInfoItem.Key = IconLanguageKey) Then
          ' JN reduce numbre of flags in combo begin
          ls_LangString = Mid(ms_ToolbarInfoString, 1, InStr(ms_ToolbarInfoString, ms_DelimiterSub) - 1)
          Debug.Assert (Len(ls_LangString) > 0)
          ' JN reduce number of flags in combo end

          For Each lo_IconInfoLanguageItem In mo_colLanguage.Items
              ' JN reduce numbre of flags in combo begin
              If Not (InStr(1, ls_LangString, lo_IconInfoLanguageItem.Name) = 0) Then
                ' JN reduce numbre of flags in combo end
                Set lo_cboItem = mo_imgcboLanguage.ComboItems.Add(, lo_IconInfoLanguageItem.Key, "", lo_IconInfoLanguageItem.Key)   ' JN send parameter Text 21/05/2012
                If (lo_IconInfoLanguageItem.Name = ms_LanguageSelected) Then
                  mo_imgcboLanguage.ComboItems(lo_IconInfoLanguageItem.Key).Selected = True
                End If
            End If
          Next
                               
          Set lo_BtnIcon = Toolbar.Buttons.Add(, lo_IconInfoItem.Key, "", tbrDefault, ms_IconLangPrefix + Language)     ' JN send parameter Caption 21/05/2012
                 
        ElseIf lo_IconInfoItem.Name = IconSpecial _
           And (InStr(LanguageAuthTrans, Language) = 0) And Not (Language = LanguageMaster) _
           And (Not (MaintenanceMode)) Then
          Set lo_BtnIcon = Toolbar.Buttons.Add(, lo_IconInfoItem.Key, "", tbrDefault, lo_IconInfoItem.Key)      ' JN send parameter Caption 21/05/2012
          lo_IconInfoItem.Enabled = False
        ElseIf Not (InStr(IconInvisible, lo_IconInfoItem.Name) = 0) _
           And Not (Language = LanguageMaster) _
           And Not (MaintenanceMode) Then
          Set lo_BtnIcon = Toolbar.Buttons.Add(, lo_IconInfoItem.Key, "", tbrDefault, lo_IconInfoItem.Key)      ' JN send parameter Caption 21/05/2012
          lo_IconInfoItem.Enabled = False
        Else
          Set lo_BtnIcon = Toolbar.Buttons.Add(, lo_IconInfoItem.Key, "", tbrDefault, lo_IconInfoItem.Key)      ' JN send parameter Caption 21/05/2012
          lo_IconInfoItem.Enabled = IIf(InStr(IconInvisible, lo_IconInfoItem.Name) <> 0, True, lo_IconInfoItem.Enabled)
        End If
        lo_BtnIcon.Enabled = lo_IconInfoItem.Enabled
              
        ' set Tooltip on language
        If Not mb_HideTips Then
            If lo_IconInfoItem.Description = "" Then
              lo_BtnIcon.ToolTipText = mo_colIcon.ItemByKey(lo_IconInfoItem.Key).DescriptionFromPosition(li_LangPosition)
              lo_BtnIcon.Description = lo_BtnIcon.ToolTipText
            Else
              lo_BtnIcon.ToolTipText = lo_IconInfoItem.Description
              lo_BtnIcon.Description = lo_BtnIcon.ToolTipText
            End If
        End If
              
        If MaintenanceMode Then
          lo_BtnIcon.ToolTipText = lo_BtnIcon.ToolTipText + " Role:" + lo_IconInfoItem.Role
          lo_BtnIcon.Caption = lo_IconInfoItem.Role
        End If
                      
      Else
        Set lo_BtnIcon = Toolbar.Buttons.Add(, , "", tbrPlaceholder)        ' JN send parameter Caption 21/05/2012
        lo_BtnIcon.Width = Toolbar.ButtonWidth
      End If
    Next
  End If
    
  If MaintenanceMode Then
    If Toolbar.ButtonWidth <= ToolbarWidth Then
      If Toolbar.Buttons.Count = 0 Then
        Set lo_BtnIcon = Toolbar.Buttons.Add(, , "", tbrPlaceholder)        ' JN send parameter Caption 21/05/2012
        lo_BtnIcon.Width = Toolbar.ButtonWidth
      End If
      While ((Toolbar.Buttons.Item(Toolbar.Buttons.Count).Left + 2 * Toolbar.ButtonWidth) <= ToolbarWidth)
        Set lo_BtnIcon = Toolbar.Buttons.Add(, , "", tbrPlaceholder)        ' JN send parameter Caption 21/05/2012
        lo_BtnIcon.Width = Toolbar.ButtonWidth
      Wend
    End If
  End If
    
  Select Case Toolbar.ALIGN
  Case vbAlignTop, vbAlignBottom
    If Width < ToolbarWidth Then Width = ToolbarWidth
  Case vbAlignLeft, vbAlignRight
    If Height < ToolbarWidth Then Height = ToolbarWidth
  End Select
   
  Call SetRedraw(True)
  ShowToolbar = True
  Exit Function
    
ErrorHandler:

'   If Err.Number <> 0 Then
'      MsgBox "Error number: " + CStr(Err.Number) _
'       + Chr(13) + "Module: " + Err.Source + ", " + Name _
'       + Chr(13) + "Description:" + Err.Description, vbCritical
'   End If
   
  Call SetRedraw(True)
  ShowToolbar = False

End Function

' Name :        function LoadIconFromFile
' Parameters:   li_IconIndex - index of icon
' Description:  Load picture from external file
' Return value: Picture

Private Function LoadIconFromFile(ByRef hInst As Long, ai_IconIndex As Integer) As Picture
Dim hIcon As Long

  hIcon = LoadIconFromDLL(hInst, ai_IconIndex)
  If hIcon = 0 Then
    Set LoadIconFromFile = Nothing
    Exit Function
  End If
    Dim oNewPic As Picture
    Dim tPicConv As PictDesc
    Dim IGuid As Guid
    
    With tPicConv
    .cbSizeofStruct = Len(tPicConv)
    .picType = vbPicTypeIcon
    .hImage = hIcon
    End With
   
   ' Fill in magic IPicture GUID {7BF80980-BF32-101A-8BBB-00AA00300CAB}
    With IGuid
        .Data1 = &H7BF80980
        .Data2 = &HBF32
        .Data3 = &H101A
        .Data4(0) = &H8B
        .Data4(1) = &HBB
        .Data4(2) = &H0
        .Data4(3) = &HAA
        .Data4(4) = &H0
        .Data4(5) = &H30
        .Data4(6) = &HC
        .Data4(7) = &HAB
    End With
    OleCreatePictureIndirect tPicConv, IGuid, True, oNewPic
    
    Set LoadIconFromFile = oNewPic
    Exit Function
End Function

' Name :        function LoadIconFromFile
' Parameters:   li_IconIndex - index of icon
' Description:  Load picture from external file
' Return value: Picture

Private Function LoadBitmapFromFile(ByRef hInst As Long, ai_BitmapIndex As Integer) As Picture
Dim hBitmap As Long

  hBitmap = LoadBitmapFromDLL(hInst, ai_BitmapIndex)
  If hBitmap = 0 Then
    Set LoadBitmapFromFile = Nothing
    Exit Function
  End If
    Dim oNewPic As Picture
    Dim tPicConv As PictDesc
    Dim IGuid As Guid
    
    With tPicConv
    .cbSizeofStruct = Len(tPicConv)
    .picType = vbPicTypeBitmap
    .hImage = hBitmap
    End With
   
   ' Fill in magic IPicture GUID {7BF80980-BF32-101A-8BBB-00AA00300CAB}
    With IGuid
        .Data1 = &H7BF80980
        .Data2 = &HBF32
        .Data3 = &H101A
        .Data4(0) = &H8B
        .Data4(1) = &HBB
        .Data4(2) = &H0
        .Data4(3) = &HAA
        .Data4(4) = &H0
        .Data4(5) = &H30
        .Data4(6) = &HC
        .Data4(7) = &HAB
    End With
    OleCreatePictureIndirect tPicConv, IGuid, True, oNewPic
    
    Set LoadBitmapFromFile = oNewPic
    Exit Function
End Function

' Name :        function LoadIcon
' Parameters:
' Description:  Fill mo_colIcon collection with all available icons for toolbar
' Return value: true/false (No error/ error)

Private Function LoadIcon() As Boolean
Dim hInst As Long
Dim ls_Res As String * 255
Dim ll_Index As Integer
Dim ll_result As Long
Dim ls_Hint As String
Dim lo_IconInfoItem As Variant
Dim lo_imgIcon As ListImage
Dim lo_auxPict As Picture
Dim lo_IconInfoLanguageItem As Variant

On Error GoTo ErrorHandler:
   
  hInst = LoadLibrary("c:\arm_apps\dll\A_icons.dll")
  If hInst = 0 Then
    LoadIcon = False
    Exit Function
  End If

  If Not (mo_colIcon Is Nothing) Then
    LoadIcon = True
    Exit Function
  End If

  Set mo_colIcon = New clsIconInfoCollection
  Set mo_colLanguage = New clsIconInfoCollection

  mo_ilsIcon.ListImages.Clear
  mo_ilsIconLanguage.ListImages.Clear

  ll_Index = 101
  Do While True
    ' load all toolbar icons
    ls_Res = Space(255)
    ll_result = LoadStringFromDLL(hInst, ll_Index, ls_Res, 255)
    If ll_result = 0 Then
      Exit Do
    End If
    
    ls_Hint = Left(ls_Res, ll_result)
    ls_Hint = RTrim(Mid(ls_Hint, 3))
    ls_Hint = Left(ls_Hint, Len(ls_Hint) - 1)
    mo_colIcon.Add Left(ls_Res, 1), ll_Index, ls_Hint, Mid(ls_Res, 2, 1)

    ll_Index = ll_Index + 1
  Loop
  
  
  ms_Languages = ""
  ll_Index = 201
  ml_comboWidth = 840   '   JN init language comboWidth to 900
  Do While True
    ' load all languages icons
    ls_Res = Space(255)
    ll_result = LoadStringFromDLL(hInst, ll_Index, ls_Res, 255)
    If ll_result = 0 Then
      Exit Do
    End If
    
    If ll_result > 2 Then
        ' looks like combo containt coutry description => make some space for it
        ml_comboWidth = 1900
    End If

    ls_Hint = Left(ls_Res, ll_result)
    Call mo_colLanguage.Add(Left(ls_Hint, 1), ll_Index, Mid(ls_Hint, 3))
    ' set availables languages
    ms_Languages = ms_Languages + Left(ls_Res, 1)

    ll_Index = ll_Index + 1
  Loop

  Set Toolbar.ImageList = Nothing
  Set mo_imgcboLanguage.ImageList = Nothing

  For Each lo_IconInfoItem In mo_colIcon.Items
    Set lo_imgIcon = mo_ilsIcon.ListImages.Add(, lo_IconInfoItem.Key, LoadIconFromFile(hInst, lo_IconInfoItem.Code))
  Next
   
  For Each lo_IconInfoLanguageItem In mo_colLanguage.Items
    Set lo_imgIcon = mo_ilsIcon.ListImages.Add(, ms_IconLangPrefix + lo_IconInfoLanguageItem.Name, LoadIconFromFile(hInst, lo_IconInfoLanguageItem.Code))
    Set lo_auxPict = LoadBitmapFromFile(hInst, lo_IconInfoLanguageItem.Code)    ' bitmap using the same ID
    If lo_auxPict Is Nothing Then
        Call mo_ilsIconLanguage.ListImages.Add(, lo_IconInfoLanguageItem.Key, lo_imgIcon.Picture)
    Else
        Call mo_ilsIconLanguage.ListImages.Add(, lo_IconInfoLanguageItem.Key, lo_auxPict)
    End If
  Next

  Set Toolbar.ImageList = mo_ilsIcon
  Set mo_imgcboLanguage.ImageList = mo_ilsIconLanguage

  LoadIcon = True
  Call FreeLibrary(hInst)

  Exit Function

ErrorHandler:

'  If Err.Number <> 0 Then
'     MsgBox "Error number: " + CStr(Err.Number) _
'      + Chr(13) + "Module: " + Err.Source + ", " + Name _
'      + Chr(13) + "Description:" + Err.Description, vbCritical
'  End If
   
  Call FreeLibrary(hInst)
  LoadIcon = False
End Function

' Name :        Function Load_A_COM
' Parameters:
' Description:  Load icons and languages.
'               Set default values.
' Return value:

Public Function Load_A_Com()
   
On Error GoTo ErrorHandler:
   
  LoadIcon
   
  Language = ms_DefaultLanguage
  ToolbarKey = ms_DefaultToolbarKey
  Face = ms_DefaultFace
  MaintenanceMode = False
  mb_InternalConnection = False
 
  Load_A_Com = True
   
  Exit Function
   
ErrorHandler:

'   If Err.Number <> 0 Then
'      MsgBox "Error number: " + CStr(Err.Number) _
'       + Chr(13) + "Module: " + Err.Source + ", " + Name _
'       + Chr(13) + "Description:" + Err.Description, vbCritical
'   End If
   
  Load_A_Com = False
   
End Function

' Name :        Function Unload_A_COM
' Parameters:
' Description:  Free and cleare all controls and collections.
' Return value:

Public Function Unload_A_Com() As Boolean

On Error GoTo ErrorHandler:

  If mb_InternalConnection Then
    Call CloseConnection
  End If
  Set mo_ArmDb = Nothing
   
  Set mo_colIcon = Nothing
  Set mo_colLanguage = Nothing
   
  Toolbar.Buttons.Clear
  mo_imgcboLanguage.ComboItems.Clear
  mo_imgcboLanguage.Visible = False
    
  Set Toolbar.ImageList = Nothing
  Set mo_imgcboLanguage.ImageList = Nothing
    
  mo_ilsIcon.ListImages.Clear
  mo_ilsIconLanguage.ListImages.Clear

  Set mo_colToolbarInfoString = Nothing
  Set mo_colToolbar = Nothing
   
  Unload_A_Com = True
   
  Exit Function
   
ErrorHandler:

'   If Err.Number <> 0 Then
'      MsgBox "Error number: " + CStr(Err.Number) _
'       + Chr(13) + "Module: " + Err.Source + ", " + Name _
'       + Chr(13) + "Description:" + Err.Description, vbCritical
'   End If
   
  Unload_A_Com = False

End Function

Private Sub mo_imgcboLanguage_Click()
   
  Language = Mid(mo_imgcboLanguage.SelectedItem.Key, 2, 1)       ' JN remove prefix from Key
  mo_imgcboLanguage.Visible = False
  ShowToolbar
  
  RaiseEvent action(mo_colToolbar.ItemByKey(IconLanguageKey).Role, Language)
End Sub

Private Sub mo_imgcboLanguage_Dropdown()
Dim lo_cboItem As Variant
   
  For Each lo_cboItem In mo_imgcboLanguage.ComboItems
    If Mid(lo_cboItem.Key, 2, 1) = Language Then        ' JN 21/05/2012 remove prefix from Key
      lo_cboItem.Selected = True
      mo_imgcboLanguage.SetFocus
      Exit For
    End If
  Next

End Sub

Private Sub mo_imgcboLanguage_LostFocus()
   
  mo_imgcboLanguage.Visible = False

End Sub

' Name :        event sub Toolbar_ButtonClick
' Parameters:   Button
' Description:  In run-time mode Raise event action with parameter Role for clicking button.
' Return value:

Private Sub Toolbar_ButtonClick(ByVal Button As MSComctlLib.Button)
Dim ls_Role As String
Dim ls_NewRole As String
   
   UserControl.SetFocus
   DoEvents
  If Not MaintenanceMode Then
    If (Button.Key = IconLanguageKey) Then
      With mo_imgcboLanguage
        .Width = ml_comboWidth
        .Top = Toolbar.Buttons(Button.Key).Top
        .Left = Toolbar.Buttons(Button.Key).Left
        .Visible = True
      End With
      Call SendMessage(mo_imgcboLanguage.hwnd, CB_SHOWDROPDOWN, True, ByVal 0&)

    Else
        ls_Role = mo_colToolbar.ItemByKey(Button.Key).Role
        RaiseEvent action(ls_Role, Language)
    End If
  Else
    If Not (mo_colToolbar.ItemByKey(Button.Key) Is Nothing) Then
      ls_NewRole = InputBox("Set new role for icon:", "Setting role", mo_colToolbar.ItemByKey(Button.Key).Role)
         
      If Len(ls_NewRole) = 1 Then
        If (Asc(ls_NewRole) >= Asc("A") And Asc(ls_NewRole) <= Asc("Z") Or _
            Asc(ls_NewRole) >= Asc("a") And Asc(ls_NewRole) <= Asc("z")) Then
           mo_colToolbar.ItemByKey(Button.Key).Role = ls_NewRole
           Button.Caption = ls_NewRole
           RaiseEvent RoleChanged(ls_NewRole, Button.Key)
        End If
      End If
    End If
  End If
      
End Sub

Public Function AddToolbarIcon(as_Name As String, as_x As Single _
               , Optional ab_SetDefaultRole As Boolean = True) As Boolean
Dim ls_Position As String
Dim lo_IconInfoItem As New clsIconInfo
Dim lo_btnButton As MSComctlLib.Button
Dim ls_Role As String
Dim li_PositionStart As Integer
Dim li_PositionEnd As Integer
Dim li_PositionLoop As Integer
Dim li_Width As Integer

On Error GoTo ErrorHandler:
          
  ' Add is allowed only in MaintenanceMode
  If Not MaintenanceMode Then
    AddToolbarIcon = False
    Exit Function
  End If
   
  For Each lo_btnButton In Toolbar.Buttons
    If (lo_btnButton.Left < as_x) And ((lo_btnButton.Left + lo_btnButton.Width) > as_x) Then
'      If (lo_btnButton.Style = tbrPlaceholder) Then
        If Asc(ms_UpperCharEnd) = (Asc(ms_UpperCharStart) + Fix(as_x / lo_btnButton.Width)) Then
          ls_Position = ms_LowerCharStart
        ElseIf Asc(ms_UpperCharStart) <= (Asc(ms_UpperCharStart) + Fix(as_x / lo_btnButton.Width)) _
               And (Asc(ms_UpperCharStart) + Fix(as_x / lo_btnButton.Width)) < Asc(ms_UpperCharEnd) Then
          ls_Position = Chr(Asc(ms_UpperCharStart) + Fix(as_x / lo_btnButton.Width))
        ElseIf Asc(ms_LowerCharStart) <= (Asc(ms_LowerCharStart) + Fix(as_x / lo_btnButton.Width)) _
               And (Asc(ms_LowerCharStart) + Fix(as_x / lo_btnButton.Width)) < Asc(ms_LowerCharEnd) Then
          ls_Position = Chr(Asc(ms_LowerCharStart) + Fix(as_x / lo_btnButton.Width))
        End If
      Exit For
'      End If
    End If
  Next

  If ls_Position = "" Then
    GoTo ErrorHandler:
  End If
   
'  If mo_colToolbar.ItemPosition(ls_Position) Is Nothing Then
  If Not (mo_colToolbar.ItemByKey(KEY_PREFIX & as_Name) Is Nothing) Then
    ls_Role = mo_colToolbar.ItemByKey(KEY_PREFIX & as_Name).Role
  End If
  If ab_SetDefaultRole Or ls_Role = "" Then
    ls_Role = mo_colIcon.ItemByKey(KEY_PREFIX & as_Name).Role
  End If

  ' special move of buttons
  If Not (mo_colToolbar.ItemByKey(KEY_PREFIX & as_Name) Is Nothing) Then
    ' DragDrop from toolbar self
    li_PositionStart = Asc(mo_colToolbar.ItemByKey(KEY_PREFIX & as_Name).Position)
    li_PositionEnd = Asc(ls_Position)
    If li_PositionStart = li_PositionEnd Then
      ' no move needed
      AddToolbarIcon = True
      Exit Function
    ElseIf mo_colToolbar.ItemPosition(Chr(li_PositionEnd)) Is Nothing Then
      ' drop on free space
      mo_colToolbar.ItemByKey(KEY_PREFIX & as_Name).Position = Chr(li_PositionEnd)
    ElseIf li_PositionStart < li_PositionEnd Then
      ' move right
      For li_PositionLoop = li_PositionStart + 1 To li_PositionEnd
        ' skip gap
        If Not ((li_PositionLoop > Asc(ms_UpperCharEnd)) And (li_PositionLoop < Asc(ms_LowerCharStart))) Then
          If Not (mo_colToolbar.ItemPosition(Chr(li_PositionLoop)) Is Nothing) Then
            mo_colToolbar.ItemPosition(Chr(li_PositionLoop)).Position = mo_colToolbar.GetPreviousPosition(mo_colToolbar.ItemPosition(Chr(li_PositionLoop)).Position)
          End If
        End If
      Next li_PositionLoop
      mo_colToolbar.ItemByKey(KEY_PREFIX & as_Name).Position = Chr(li_PositionEnd)
    Else
      ' move left
      
      ' find first free space
      For li_PositionLoop = li_PositionEnd To li_PositionStart - 1
        If mo_colToolbar.ItemPosition(Chr(li_PositionLoop)) Is Nothing Then
          ' move start position
          li_PositionStart = li_PositionLoop
          Exit For
        End If
      Next li_PositionLoop
      
      For li_PositionLoop = li_PositionStart - 1 To li_PositionEnd Step -1
        ' skip gap
        If Not ((li_PositionLoop > Asc(ms_UpperCharEnd)) And (li_PositionLoop < Asc(ms_LowerCharStart))) Then
          If Not (mo_colToolbar.ItemPosition(Chr(li_PositionLoop)) Is Nothing) Then
            mo_colToolbar.ItemPosition(Chr(li_PositionLoop)).Position = mo_colToolbar.GetNextPosition(mo_colToolbar.ItemPosition(Chr(li_PositionLoop)).Position)
          End If
        End If
      Next li_PositionLoop
      mo_colToolbar.ItemByKey(KEY_PREFIX & as_Name).Position = Chr(li_PositionEnd)
    End If
  Else
    ' DragDrop from outside
    If mo_colToolbar.ItemPosition(ls_Position) Is Nothing Then
      ' paste new button
      Call mo_colToolbar.Add(as_Name, , "", ls_Role, ls_Position)        ' JN send parameter Description 21/05/2012
    Else
      ' move buttons right
      li_Width = Asc(mo_colToolbar.GetLastPosition) - Asc(ms_UpperCharStart) + 1
      If mo_colToolbar.GetLastPosition > ms_LowerCharStart Then
        li_Width = li_Width - Asc(ms_LowerCharStart) + Asc(ms_UpperCharEnd)
      End If
      If ((li_Width + 1) * Toolbar.ButtonWidth) > Toolbar.Width Then
        ' no more space
        GoTo ErrorHandler:
      End If
      
      ' free space
      ' move buttons right
      For li_PositionLoop = Asc(mo_colToolbar.GetLastPosition) To Asc(ls_Position) Step -1
        ' skip gap
        If Not (li_PositionLoop > Asc(ms_UpperCharEnd)) And (li_PositionLoop < Asc(ms_LowerCharStart)) Then
          If Not (mo_colToolbar.ItemPosition(Chr(li_PositionLoop)) Is Nothing) Then
            mo_colToolbar.ItemPosition(Chr(li_PositionLoop)).Position = mo_colToolbar.GetNextPosition(mo_colToolbar.ItemPosition(Chr(li_PositionLoop)).Position)
          End If
        End If
      Next li_PositionLoop
      Call mo_colToolbar.Add(as_Name, , "", ls_Role, ls_Position)       ' JN send parameter Description 21/05/2012
    End If
  End If

  If Not (ShowToolbar()) Then
    GoTo ErrorHandler
  End If
   
  AddToolbarIcon = True
   
  Exit Function
   
ErrorHandler:

'  If Err.Number <> 0 Then
'    MsgBox "Error number: " + CStr(Err.Number) _
'     + Chr(13) + "Module: " + Err.Source + ", " + Name _
'     + Chr(13) + "Description:" + Err.Description, vbCritical
'  End If
   
  AddToolbarIcon = False

End Function

Public Function Remove(as_Name As String) As Boolean
   
On Error GoTo ErrorHandler:
             
  ' Remove is allowed only in MaintenanceMode
  If Not MaintenanceMode Then
    Remove = False
    Exit Function
  End If
             
  Remove = mo_colToolbar.Remove(as_Name)
   
  If Not (ShowToolbar()) Then
    GoTo ErrorHandler
  End If
   
  Exit Function
   
ErrorHandler:

'   If Err.Number <> 0 Then
'      MsgBox "Error number: " + CStr(Err.Number) _
'       + Chr(13) + "Module: " + Err.Source + ", " + Name _
'       + Chr(13) + "Description:" + Err.Description, vbCritical
'   End If
   
  Remove = False

End Function

Public Function HitTest(as_x As Single) As MSComctlLib.Button
Dim lo_btnButton As MSComctlLib.Button
   
On Error GoTo ErrorHandler:
          
  ' HitTest is allowed only in MaintenanceMode
  If Not MaintenanceMode Then
    Set HitTest = Nothing
    Exit Function
  End If
   
  For Each lo_btnButton In Toolbar.Buttons
    If (lo_btnButton.Left < as_x) And ((lo_btnButton.Left + lo_btnButton.Width) > as_x) Then
      If (lo_btnButton.Style = tbrDefault) Then
        Set HitTest = lo_btnButton
        Exit Function
      End If
    End If
  Next
   
  Set HitTest = Nothing
   
  Exit Function
   
ErrorHandler:

'   If Err.Number <> 0 Then
'      MsgBox "Error number: " + CStr(Err.Number) _
'       + Chr(13) + "Module: " + Err.Source + ", " + Name _
'       + Chr(13) + "Description:" + Err.Description, vbCritical
'   End If
   
 Set HitTest = Nothing

End Function

Private Sub Toolbar_MouseMove(Button As Integer, Shift As Integer, X As Single, y As Single)
Dim ls_Key As String

  If MaintenanceMode And Button = vbLeftButton Then
    RaiseEvent MouseDown(Button, Shift, X, y)
  End If

End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  ButtonsString = PropBag.ReadProperty("ButtonsString", "")
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  Call PropBag.WriteProperty("ButtonsString", ButtonsString, "")
End Sub

Private Sub UserControl_Resize()
   
  If Not MaintenanceMode Then
    Select Case UserControl.Extender.ALIGN
    Case vbAlignNone
      If Width < Height Then
        Toolbar.ALIGN = vbAlignRight
        Width = Toolbar.Width
      Else
        Toolbar.ALIGN = vbAlignTop
        Height = Toolbar.Height
      End If
    Case vbAlignTop
      Toolbar.ALIGN = vbAlignTop
      Height = Toolbar.Height
    Case vbAlignBottom
      Toolbar.ALIGN = vbAlignBottom
      Height = Toolbar.Height
    Case vbAlignLeft
      Toolbar.ALIGN = vbAlignLeft
      Width = Toolbar.Width
    Case vbAlignRight
      Toolbar.ALIGN = vbAlignRight
      Width = Toolbar.Width
    End Select
  Else
    ToolbarWidth = Toolbar.Width
    ShowToolbar
  End If

End Sub

Private Static Sub SetRedraw(lb_Enable As Boolean)
Dim li_Count As Integer
  
  If lb_Enable Then
    If li_Count > 0 Then li_Count = li_Count - 1
    If li_Count <= 0 Then
      'set back old state
      Call SendMessage(Toolbar.hwnd, WM_SETREDRAW, 1, 0)
      Call Toolbar.Refresh
    End If
  Else
    li_Count = li_Count + 1
    Call SendMessage(Toolbar.hwnd, WM_SETREDRAW, 0, 0)
  End If

End Sub

Public Function ShowPopup(ao_Menu As Menu, as_Role As String) As Boolean
Dim lo_BtnIcon As MSComctlLib.Button
Dim lo_IconInfo As clsIconInfo

On Error GoTo ErrorHandler
  ShowPopup = False
  Set lo_IconInfo = mo_colToolbar.ItemByRole(as_Role)
  Set lo_BtnIcon = Toolbar.Buttons(lo_IconInfo.Key)
  Call PopupMenu(ao_Menu, vbPopupMenuCenterAlign, lo_BtnIcon.Left + lo_BtnIcon.Width / 2, UserControl.Extender.Top + UserControl.Extender.Height)
  Exit Function
ErrorHandler:
  ShowPopup = False
End Function

