VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.UserControl ArmExcel 
   ClientHeight    =   8580
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   7035
   ScaleHeight     =   8580
   ScaleWidth      =   7035
   Begin Project1.ArmCombobox cbo_Language 
      Height          =   345
      Left            =   3960
      TabIndex        =   10
      Top             =   2040
      Width           =   2775
      _ExtentX        =   4895
      _ExtentY        =   609
   End
   Begin VB.CommandButton cmd_Export 
      Caption         =   "#Export"
      Height          =   495
      Left            =   3960
      TabIndex        =   7
      Tag             =   "cmd_print"
      Top             =   480
      Width           =   1335
   End
   Begin VB.CommandButton cmd_Cancel 
      Caption         =   "#Cancel"
      Height          =   495
      Left            =   5400
      TabIndex        =   6
      Tag             =   "cmd_cancel"
      Top             =   480
      Width           =   1335
   End
   Begin VB.CheckBox chk_SelRows 
      Caption         =   "#Selected rows only"
      Height          =   555
      Left            =   3960
      TabIndex        =   5
      Tag             =   "chk_SelRows"
      Top             =   1080
      Value           =   1  'Checked
      Width           =   2775
   End
   Begin VB.PictureBox pctItem 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      ForeColor       =   &H80000008&
      Height          =   585
      Left            =   3960
      ScaleHeight     =   555
      ScaleWidth      =   2745
      TabIndex        =   1
      Top             =   2880
      Width           =   2775
      Begin VB.PictureBox pct_Add 
         Appearance      =   0  'Flat
         BackColor       =   &H80000005&
         BorderStyle     =   0  'None
         ForeColor       =   &H80000008&
         Height          =   555
         Left            =   120
         ScaleHeight     =   555
         ScaleWidth      =   735
         TabIndex        =   3
         Top             =   15
         Width           =   735
      End
      Begin VB.PictureBox pct_Del 
         Appearance      =   0  'Flat
         BackColor       =   &H80000005&
         BorderStyle     =   0  'None
         ForeColor       =   &H80000008&
         Height          =   555
         Left            =   960
         ScaleHeight     =   555
         ScaleWidth      =   735
         TabIndex        =   2
         Top             =   15
         Width           =   735
      End
   End
   Begin MSComctlLib.ListView lv_Fields 
      Height          =   7935
      Left            =   0
      TabIndex        =   0
      Top             =   480
      Width           =   3855
      _ExtentX        =   6800
      _ExtentY        =   13996
      View            =   3
      LabelEdit       =   1
      LabelWrap       =   -1  'True
      HideSelection   =   0   'False
      HideColumnHeaders=   -1  'True
      Checkboxes      =   -1  'True
      FullRowSelect   =   -1  'True
      _Version        =   393217
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      BorderStyle     =   1
      Appearance      =   1
      NumItems        =   1
      BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         Object.Width           =   5997
      EndProperty
   End
   Begin MSComctlLib.ListView lv_Sel 
      Height          =   4935
      Left            =   3960
      TabIndex        =   4
      Top             =   3480
      Width           =   2775
      _ExtentX        =   4895
      _ExtentY        =   8705
      View            =   3
      LabelEdit       =   1
      Sorted          =   -1  'True
      LabelWrap       =   -1  'True
      HideSelection   =   0   'False
      HideColumnHeaders=   -1  'True
      FullRowSelect   =   -1  'True
      _Version        =   393217
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      BorderStyle     =   1
      Appearance      =   1
      NumItems        =   1
      BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         Object.Width           =   4410
      EndProperty
   End
   Begin VB.Label lbl_Language 
      Caption         =   "#Language"
      Height          =   255
      Left            =   3960
      TabIndex        =   11
      Tag             =   "lbl_Preselection"
      Top             =   1800
      Width           =   2775
   End
   Begin VB.Label lbl_select 
      Caption         =   "#SelectFields"
      Height          =   255
      Left            =   0
      TabIndex        =   9
      Tag             =   "lbl_select"
      Top             =   120
      Width           =   3855
   End
   Begin VB.Label lbl_Preselection 
      Caption         =   "#Preselection"
      Height          =   255
      Left            =   3960
      TabIndex        =   8
      Tag             =   "lbl_Preselection"
      Top             =   2640
      Width           =   2775
   End
End
Attribute VB_Name = "ArmExcel"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private mo_ExcelApp As Object    'Excel.Application
Private mo_Db As Object

'name of server when  creating internal connection
Private ms_Server As String
'name of database to connect
Private ms_Db As String
'user name when opening connection to sql server
Private ms_User As String
'user passwrod
Private ms_Pwd As String
'application name displayed in connection row in sql server manager
Private ms_App As String
'if component has created its own connection or got connected armdb instance
Private mb_InternalConnection As Boolean

Private ml_CurrentRow As Long
Private mo_Sheet As Object
Private mo_Fields As Collection
Private mo_Trace As Object
Private ms_FieldCaptionsRequest As String
Private ml_LocalID As Long

'cursor which contains dataset used by translating labels in reports
Private ml_LabelCursor As Long
'external request which will create label cursor
Private ms_LabelRequest As String
'name of field which contains label name in label cursor
Private ms_LabelNameField As String
'name of field which contains translated text
Private ms_LabelCaptionField As String
'request used to insert keys into temporary key table
Private ms_InsertTempKeyRequest As String
'request to create temporary table
Private ms_CreateTempTableRequest As String
'request to drop temporary table
Private ms_DropTempTableRequest As String
'number of key which are inserted into temporary key table in one go
Private ml_InsertTempKeyCount As Long
'array of keys
Private mv_MultiKey As Variant
'user id
Private ms_User_ID As String
'Language code
Private ms_Language_Code As String
'main request used to get records for report  - all data
'Private ms_Request As String
'main request used to get records for report  - multiselection
Private ms_MultiKeyRequest As String
'maximal number of preselections in one object
Private ml_MaxPreselections As Long
'requests to handle delete, insert and select preselection data
Private ms_PreSelRequest_Del As String
Private ms_PreSelRequest_Ins As String
Private ms_PreSelRequest_Sel As String

Private Const SEP = "ой"                  'standard armstrong separator

'array of messages translated send from framework or from SQL
Private mv_Messages As Variant
'array of special fields definitions
Private mv_SpecialFields As Variant
'flag if language combo is used or not
Private mb_UseLanguage As Boolean
'request for get languages
Private ms_Language_Request As String

Public Event ButtonPressed(as_Name As String)
Public Event BeforeRowExport(ByVal av_Fields As Variant, ByRef av_Data As Variant, ByVal as_Language_code As String)

'constants for grid system messages
Public Enum EXMsgType
  EXmtCREATEPRESEL = 0
  EXmtPRESELNAMEUSED = 1
  EXmtDELETEPRESEL = 2
End Enum

'constant enumeration for parameter type in LoadConstants method
Public Enum EXParamType
  EXptSQL
  EXptStatic
End Enum

'constant enumeration for constant type in LoadConstants method
Public Enum EXConstType
  EXctFields
  EXctControl
  EXctMessages
End Enum

Public Property Set ArmDb(ByRef lo_Db As Object)

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:ArmDb_Set")
#End If
  
  Set mo_Db = lo_Db
  Set cbo_Language.ArmDb = lo_Db

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:ArmDb_Set")
#End If
End Property

'set values for connection to sql server. If there is not connected armdb instance, create its own internal connection
Property Let ConnectString(as_Value As String)
Dim la_Params() As String

On Error GoTo ErrorHandler
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel: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 = "ArmExcel"
    End If
  Else
    ms_Server = ""
    ms_Db = ""
    ms_User = ""
    ms_Pwd = ""
  End If
  
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:ConnectString_Let")
#End If
  Exit Property
ErrorHandler:
#If CompDebug Then
  Call mo_Trace.WriteTraceError("ArmExcel:ConnectString_Let", "as_Value=" & as_Value)
#End If
End Property

Property Let CreateTempTableRequest(as_Value As String)
  
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:CreateTempTableRequest_Let")
#End If
  
  ms_CreateTempTableRequest = as_Value

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:CreateTempTableRequest_Let")
#End If
End Property

Property Get CreateTempTableRequest() As String
  
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:CreateTempTableRequest_Get")
#End If
  
  CreateTempTableRequest = ms_CreateTempTableRequest

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:CreateTempTableRequest_Get")
#End If
End Property

Property Let LocalID(al_value As Long)
  
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:LocalID_Let")
#End If
  
  ml_LocalID = al_value

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:LocalID_Let")
#End If
End Property

Property Get LocalID() As Long
  
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:LocalID_Get")
#End If
  
  LocalID = ml_LocalID

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:LocalID_Get")
#End If
End Property

Property Let DropTempTableRequest(as_Value As String)
  
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:DropTempTableRequest_Let")
#End If
  
  ms_DropTempTableRequest = as_Value

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:DropTempTableRequest_Let")
#End If
End Property

Property Get DropTempTableRequest() As String
  
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:DropTempTableRequest_Get")
#End If
  
  DropTempTableRequest = ms_DropTempTableRequest

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:DropTempTableRequest_Get")
#End If
End Property

'sql request which insert many temporary keys into temp table in one go
Property Let InsertTempKeyRequest(as_Value As String)
  
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:InsertTempKeyRequest_Let")
#End If
  
  ms_InsertTempKeyRequest = as_Value

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:InsertTempKeyRequest_Let")
#End If
End Property

Property Get InsertTempKeyRequest() As String
  
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:InsertTempKeyRequest_Get")
#End If
  
  InsertTempKeyRequest = ms_InsertTempKeyRequest

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:InsertTempKeyRequest_Get")
#End If
End Property

'number of keys inserted into temporary table in one go
Property Let InsertTempKeyCount(al_value As Long)
  
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:InsertTempKeyCount_Let")
#End If
  
  ml_InsertTempKeyCount = al_value

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:InsertTempKeyCount_Let")
#End If
End Property

Property Get InsertTempKeyCount() As Long
  
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:InsertTempKeyCount_Get")
#End If
  
  InsertTempKeyCount = ml_InsertTempKeyCount

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:InsertTempKeyCount_Get")
#End If
End Property

Property Let User_ID(as_Value As String)
  
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:User_ID_Let")
#End If
  
  ms_User_ID = as_Value

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:User_ID_Let")
#End If
End Property

Property Get User_ID() As String
  
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:User_ID_Get")
#End If
  
  User_ID = ms_User_ID

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:User_ID_Get")
#End If
End Property

Property Let Language_Code(as_Value As String)
  
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:Language_Code_Let")
#End If
  
  ms_Language_Code = as_Value

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:Language_Code_Let")
#End If
End Property

Property Get Language_Code() As String
  
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:Language_Code_Get")
#End If
  
  Language_Code = ms_Language_Code

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:Language_Code_Get")
#End If
End Property

Property Let Selected_Language_Code(as_Value As String)
'Dim lo_ComboItem As ComboItem

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:Selected_Language_Code_Let")
#End If
  
  Call cbo_Language.SearchItem(as_Value)
  
  'Set cbo_Language.SelectedItem = Nothing
  'cbo_Language.Text = ""
  
  'For Each lo_ComboItem In cbo_Language.ComboItems
  '  If StrComp(as_Value, lo_ComboItem.Tag, vbTextCompare) = 0 Then
  '    Set cbo_Language.SelectedItem = lo_ComboItem
  '    Exit For
  '  End If
  'Next

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:Selected_Language_Code_Let")
#End If
End Property

Property Get Selected_Language_Code() As String
  
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:Selected_Language_Code_Get")
#End If

  Selected_Language_Code = ""
  If Not (cbo_Language.SelectedItem Is Nothing) Then
    Selected_Language_Code = cbo_Language.SelectedItem.Key
  End If

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:Selected_Language_Code_Get")
#End If
End Property

Property Let Language_Request(as_Value As String)
  
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:Language_Request_Let")
#End If
  
  ms_Language_Request = as_Value

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:Language_Request_Let")
#End If
End Property

Property Get Language_Request() As String
  
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:Language_Request_Get")
#End If
  
  Language_Request = ms_Language_Request

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:Language_Request_Get")
#End If
End Property

Property Let UseLanguage(ab_Value As Boolean)
  
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:UseLanguage_Let")
#End If
  
  mb_UseLanguage = ab_Value
  cbo_Language.Visible = ab_Value
  lbl_Language.Visible = ab_Value

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:UseLanguage_Let")
#End If
End Property

Property Get UseLanguage() As Boolean
  
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:UseLanguage_Get")
#End If
  
  UseLanguage = mb_UseLanguage

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:UseLanguage_Get")
#End If
End Property

Property Let SelectedRowsOnly(ab_Value As Boolean)
  
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:SelectedRowsOnly_Let")
#End If
  
  chk_SelRows.value = IIf(ab_Value, 1, 0)

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:SelectedRowsOnly_Let")
#End If
End Property

Property Get SelectedRowsOnly() As Boolean
  
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:SelectedRowsOnly_Get")
#End If
  
  SelectedRowsOnly = chk_SelRows.value

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:SelectedRowsOnly_Get")
#End If
End Property

Property Let SelectedRowsOnlyEnabled(ab_Value As Boolean)
  
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:SelectedRowsOnlyEnabled_Let")
#End If
  
  chk_SelRows.Enabled = ab_Value

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:SelectedRowsOnlyEnabled_Let")
#End If
End Property

Property Get SelectedRowsOnlyEnabled() As Boolean
  
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:SelectedRowsOnlyEnabled_Get")
#End If
  
  SelectedRowsOnlyEnabled = chk_SelRows.Enabled

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:SelectedRowsOnlyEnabled_Get")
#End If
End Property

Property Let MultiKeyRequest(as_Value As String)
  
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:MultiKeyRequest_Let")
#End If
  
  ms_MultiKeyRequest = as_Value

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:MultiKeyRequest_Let")
#End If
End Property

Property Get MultiKeyRequest() As String
  
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:MultiKeyRequest_Get")
#End If
  
  MultiKeyRequest = ms_MultiKeyRequest

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:MultiKeyRequest_Get")
#End If
End Property

Property Let MaxPreselections(al_value As Long)
  
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:MaxPreselections_Let")
#End If
  
  ml_MaxPreselections = al_value

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:MaxPreselections_Let")
#End If
End Property

Property Get MaxPreselections() As Long
  
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:MaxPreselections_Get")
#End If
  
  MaxPreselections = ml_MaxPreselections

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:MaxPreselections_Get")
#End If
End Property

Property Let PreSelRequest_Sel(as_Value As String)
  
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:PreSelRequest_Sel_Let")
#End If
  
  ms_PreSelRequest_Sel = as_Value

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:PreSelRequest_Sel_Let")
#End If
End Property

Property Get PreSelRequest_Sel() As String
  
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:PreSelRequest_Sel_Get")
#End If
  
  PreSelRequest_Sel = ms_PreSelRequest_Sel

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:PreSelRequest_Sel_Get")
#End If
End Property

Property Let PreSelRequest_Ins(as_Value As String)
  
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:PreSelRequest_Ins_Let")
#End If
  
  ms_PreSelRequest_Ins = as_Value

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:PreSelRequest_Ins_Let")
#End If
End Property

Property Get PreSelRequest_Ins() As String
  
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:PreSelRequest_Ins_Get")
#End If
  
  PreSelRequest_Ins = ms_PreSelRequest_Ins

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:PreSelRequest_Sel_Get")
#End If
End Property

Property Let PreSelRequest_Del(as_Value As String)
  
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:PreSelRequest_Del_Let")
#End If
  
  ms_PreSelRequest_Del = as_Value

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:PreSelRequest_Del_Let")
#End If
End Property

Property Get PreSelRequest_Del() As String
  
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:PreSelRequest_Del_Get")
#End If
  
  PreSelRequest_Del = ms_PreSelRequest_Del

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:PreSelRequest_Del_Get")
#End If
End Property

'set array of key compatible to armgrid
Property Let MultiKey(av_Value As Variant)
  
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:MultiKey_Let")
#End If
  
  If IsArray(av_Value) Then
    mv_MultiKey = av_Value
  Else
    mv_MultiKey = Array(av_Value)
  End If

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:MultiKey_Let")
#End If
End Property

Property Get MultiKey() As Variant
  
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:MultiKey_Get")
#End If
  
  MultiKey = mv_MultiKey

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:MultiKey_Get")
#End If
End Property

'set array of key compatible to armgrid
Property Let SpecialFields(av_Value As Variant)
  
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:SpecialFields_Let")
#End If
  
  If IsArray(av_Value) Then
    mv_SpecialFields = av_Value
  Else
    mv_SpecialFields = Array(av_Value)
  End If

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:SpecialFields_Let")
#End If
End Property

Property Get SpecialFields() As Variant
  
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:SpecialFields_Get")
#End If
  
  SpecialFields = mv_SpecialFields

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:SpecialFields_Get")
#End If
End Property

Public Function Export() As Boolean
Dim lv_ColTitles As Variant
Dim ls_Titles As String
Dim lb_Result As Boolean
Dim ll_Cursor As Long

On Error GoTo ErrorHandler
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:Export")
#End If
  
  lb_Result = False
  ll_Cursor = 0
  Call SetMousePointer(False)
  ls_Titles = GetTitleSelection(SEP)
  If ls_Titles <> "" Then
    lv_ColTitles = Split(ls_Titles, SEP)
      
    If IsArray(lv_ColTitles) Then
      If ExportOpen(lv_ColTitles) Then
        'If chk_SelRows.Value Then
          'export only selected rows in grid
          If FillTempKeyTable Then
            ll_Cursor = OpenCursor(ms_MultiKeyRequest)
          End If
        'Else
        '  ll_Cursor = OpenCursor(ms_Request)
        'End If
        
        If ll_Cursor Then
          lb_Result = True
          ml_CurrentRow = 0
          Call mo_Db.First(ll_Cursor)
          Do While Not mo_Db.EOF(ll_Cursor)
            If Not ExportRow(ll_Cursor) Then
              lb_Result = False
              Exit Do
            End If
            Call mo_Db.Next(ll_Cursor)
          Loop
          Call CloseCursor(ll_Cursor)
        Else
          lb_Result = False
        End If
        ' moved here by JN because table is needed while exportRow
        'temporary table is not needed we can drop it here
        Call DropTempTable
      Else
        lb_Result = False
      End If
      Call ExportClose
    End If
  End If
  Export = lb_Result
  Call SetMousePointer(True)

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:Export")
#End If
  Exit Function
ErrorHandler:
  Call CloseCursor(ll_Cursor)
  Call ExportClose
  Call DropTempTable
  Call SetMousePointer(True)
  Export = False
#If CompDebug Then
  Call mo_Trace.WriteTraceError("ArmExcel:Export")
#End If
End Function

Public Function LoadLanguages() As Boolean
'Dim ll_Cursor As Long
'Dim lo_ComboItem As ComboItem

On Error GoTo ErrorHandler
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:LoadLanguages")
#End If

  cbo_Language.Request = ms_Language_Request
  Call cbo_Language.Load
  
  'll_Cursor = OpenCursor(ms_Language_Request)
  'While Not mo_Db.EOF(ll_Cursor)
  '  Set lo_ComboItem = cbo_Language.ComboItems.Add(, , CStr(mo_Db.GetFields(ll_Cursor, 1)))
  '  lo_ComboItem.Tag = CStr(mo_Db.GetFields(ll_Cursor, 0))
  '  Call mo_Db.Next(ll_Cursor)
  'Wend
  'Call CloseCursor(ll_Cursor)

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:LoadLanguages")
#End If
  Exit Function
ErrorHandler:
  'Call CloseCursor(ll_Cursor)
  LoadLanguages = False
#If CompDebug Then
  Call mo_Trace.WriteTraceError("ArmExcel:LoadLanguages")
#End If
End Function

Public Function LoadPreselections() As Boolean
    Dim ls_Name As String
    Dim lo_ListItem As ListItem
    Dim ll_Cursor As Long
    
On Error GoTo ErrorHandler
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:LoadPreselections")
#End If
  
  LoadPreselections = False
  
  ll_Cursor = 0
  Call DeletePreselections
  
  ll_Cursor = OpenCursor(ms_PreSelRequest_Sel)
  If ll_Cursor <> 0 Then
    Call mo_Db.First(ll_Cursor)
    Do While Not mo_Db.EOF(ll_Cursor)
      Set lo_ListItem = lv_Sel.ListItems.Add
      lo_ListItem.Selected = False
      lo_ListItem.Text = mo_Db.GetFields(ll_Cursor, 0)
      lo_ListItem.Tag = mo_Db.GetFields(ll_Cursor, 1)
      Call mo_Db.Next(ll_Cursor)
    Loop
    Call CloseCursor(ll_Cursor)
    LoadPreselections = True
  End If
  Set lv_Sel.SelectedItem = Nothing

  Call UpdateButtons

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:LoadPreselections")
#End If
  Exit Function
ErrorHandler:
  Call CloseCursor(ll_Cursor)
  LoadPreselections = False
#If CompDebug Then
  Call mo_Trace.WriteTraceError("ArmExcel:LoadPreselections")
#End If
End Function

'load constants and error messages
Public Function LoadConstants(au_ParamType As EXParamType, ByVal av_Param As Variant, au_ConstType As EXConstType) As Boolean
Dim lb_Result As Boolean
Dim ll_Index As Long
Dim la_Const() As String, la_Const1() As String
Dim lo_Field As ArmSelField

On Error GoTo ErrorHandler
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:LoadConstants")
#End If
  
  lb_Result = False
  
  'load constants from SQL and save it to as_Param string
  If (au_ParamType = EXptSQL) Then
    'convert request to static parameter
    av_Param = GetSQLValue(av_Param)
  End If
 
  Select Case au_ConstType
    Case EXctFields
      Call ResetSelectionFields
      If IsArray(av_Param) Then
        If UBound(av_Param) = 1 Then
          la_Const = Split(av_Param(0), SEP)
          la_Const1 = Split(av_Param(1), SEP)
          If IsArray(la_Const) And IsArray(la_Const1) Then
            If UBound(la_Const) = UBound(la_Const1) Then
              For ll_Index = 0 To UBound(la_Const)
                Set lo_Field = New ArmSelField
                lo_Field.FieldName = la_Const(ll_Index)
                lo_Field.Caption = la_Const1(ll_Index)
                Call mo_Fields.Add(lo_Field)
                Set lo_Field = Nothing
              Next
              lb_Result = True
            End If
          End If
        End If
      End If
      Call DisplaySelectionFields
    Case EXctControl
      la_Const = Split(av_Param, SEP)
      If IsArray(la_Const) Then
        If UBound(la_Const) >= 0 Then lbl_select.Caption = la_Const(0)
        If UBound(la_Const) >= 1 Then cmd_Export.Caption = la_Const(1)
        If UBound(la_Const) >= 2 Then cmd_cancel.Caption = la_Const(2)
        If UBound(la_Const) >= 3 Then chk_SelRows.Caption = la_Const(3)
        If UBound(la_Const) >= 4 Then lbl_Preselection.Caption = la_Const(4)
        If UBound(la_Const) >= 5 Then lbl_Language.Caption = la_Const(5)
        lb_Result = True
      End If
    Case EXctMessages
      la_Const = Split(av_Param, SEP)
      If IsArray(la_Const) Then
        mv_Messages = la_Const
        lb_Result = True
      End If
  End Select
  LoadConstants = lb_Result

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:LoadConstants")
#End If
  Exit Function
ErrorHandler:
  LoadConstants = False
#If CompDebug Then
  Call mo_Trace.WriteTraceError("ArmExcel:LoadConstants", "au_ParamType=" & au_ParamType, _
  "au_ConstType=" & au_ConstType)
#End If
End Function

Private Function GetMessage(au_MsgType As EXMsgType, Optional as_Default As String = "") As String
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:GetMessage")
#End If

  GetMessage = as_Default
  If IsArray(mv_Messages) Then
    If au_MsgType <= UBound(mv_Messages) Then
      GetMessage = mv_Messages(au_MsgType)
    End If
  End If

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:GetMessage")
#End If
  Exit Function
ErrorHandler:
#If CompDebug Then
  Call mo_Trace.WriteTraceError("ArmExcel:GetMessage", "au_MsgType=" & au_MsgType, _
  "as_Default=" & as_Default)
#End If
End Function

Private Function CreateTempTable() As Boolean

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:CreateTempTable")
#End If
  
  CreateTempTable = ExecuteRequest(ms_CreateTempTableRequest)

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:CreateTempTable")
#End If
End Function

Private Function DropTempTable() As Boolean

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:DropTempTable")
#End If
  
  DropTempTable = ExecuteRequest(ms_DropTempTableRequest)

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:DropTempTable")
#End If
End Function

Private Function InsertTempKeys(ByRef al_Index As Long) As Boolean
Dim ll_KeyIndex As Long, ll_ColIndex As Long
Dim ls_TempRequest As String
Dim lv_Key As Variant

On Error GoTo ErrorHandler
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:InsertTempKeys")
#End If
  
  ls_TempRequest = ms_InsertTempKeyRequest
  ll_KeyIndex = 0
  Do While (ll_KeyIndex < ml_InsertTempKeyCount) And (al_Index <= UBound(mv_MultiKey))
  
    lv_Key = mv_MultiKey(al_Index)
    
    If IsArray(lv_Key) Then
      For ll_ColIndex = 0 To UBound(lv_Key)
        ls_TempRequest = Replace(ls_TempRequest, "$" & ll_KeyIndex & "$", Replace(lv_Key(ll_ColIndex), "'", "''"))
        ll_KeyIndex = ll_KeyIndex + 1
      Next
    Else
      ls_TempRequest = Replace(ls_TempRequest, "$" & ll_KeyIndex & "$", Replace(lv_Key, "'", "''"))
      ll_KeyIndex = ll_KeyIndex + 1
    End If
    al_Index = al_Index + 1
  Loop
  
  Do While ll_KeyIndex < ml_InsertTempKeyCount
    ls_TempRequest = Replace(ls_TempRequest, "$" & ll_KeyIndex & "$", "")
    ll_KeyIndex = ll_KeyIndex + 1
  Loop
  InsertTempKeys = ExecuteRequest(ls_TempRequest)

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:InsertTempKeys")
#End If
  Exit Function
ErrorHandler:
  InsertTempKeys = False
#If CompDebug Then
  Call mo_Trace.WriteTraceError("ArmExcel:InsertTempKeys")
#End If
End Function

Private Function FillTempKeyTable() As Boolean
Dim lb_Result As Boolean
Dim ll_RowIndex As Long

On Error GoTo ErrorHandler
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:FillTempKeyTable")
#End If
  
  lb_Result = False
  Call DropTempTable
  If CreateTempTable Then
    If IsArray(mv_MultiKey) Then
      ll_RowIndex = 0
      Do While ll_RowIndex <= UBound(mv_MultiKey)
        lb_Result = InsertTempKeys(ll_RowIndex)
        If Not lb_Result Then Exit Do
      Loop
    End If
  End If
  FillTempKeyTable = lb_Result

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:FillTempKeyTable")
#End If
  Exit Function
ErrorHandler:
  FillTempKeyTable = False
#If CompDebug Then
  Call mo_Trace.WriteTraceError("ArmExcel:FillTempKeyTable")
#End If
  Call DropTempTable
End Function

'Public Sub SetConstantRequest(as_Request As String, as_LabelNameField As String, as_LabelCaptionField As String)
'
'#If CompDebugEX Then
'  Call mo_Trace.WriteTraceProc(True, "ArmExcel:SetConstantRequest")
'#End If
'
'  ms_LabelRequest = as_Request
'  ms_LabelNameField = as_LabelNameField
'  ms_LabelCaptionField = as_LabelCaptionField
'
'#If CompDebugEX Then
'  Call mo_Trace.WriteTraceProc(False, "ArmExcel:SetConstantRequest")
'#End If
'End Sub

'Private Function TranslateText(ByVal ls_Text As String, Optional ByVal as_ScreenName As String = "Cap_Print")
'  If Left$(ls_Text, 1) = "#" Then
'    'TranslateText = GetLabel(as_ScreenName, Right(ls_Text, Len(ls_Text) - 1), ls_Text)
'  Else
'    TranslateText = ""
'  End If
'End Function
'
'Public Property Let FieldCaptionsRequest(as_Value As String)
'  ms_FieldCaptionsRequest = as_Value
'End Property

'Public Property Let SelectionFields(av_Value As Variant)
'Dim ls_Par() As String
'Dim ll_Index As Long
'Dim lo_Field As ArmSelField
'
'  If IsArray(av_Value) Then
'    For ll_Index = 0 To UBound(av_Value)
'      ls_Par = Split(av_Value(ll_Index), SEP)
'      If IsArray(ls_Par) Then
'        Set lo_Field = New ArmSelField
'        lo_Field.FieldName = ls_Par(0)
'        lo_Field.LabelName = ls_Par(1)
'        If UBound(ls_Par) >= 2 Then
'          lo_Field.Caption = ls_Par(2)
'        End If
'        If UBound(ls_Par) >= 3 Then
'          lo_Field.Checked = IIf(StrComp(ls_Par(3), "True", vbTextCompare) = 0, True, False)
'        End If
'        Call mo_Fields.Add(lo_Field)
'        Set lo_Field = Nothing
'      End If
'    Next
'  End If
'End Property

'Private Function TranslateFields()
'Dim ll_Cursor As Long
'Dim lo_Field As ArmSelField
'
'  ll_Cursor = OpenCursor(ms_FieldCaptionsRequest)
'  If ll_Cursor Then
'    For Each lo_Field In mo_Fields
'      If mo_Db.Find(ll_Cursor, ms_LabelNameField, lo_Field.LabelName, , 1) >= 0 Then
'        lo_Field.Caption = mo_Db.GetFields(ll_Cursor, ms_LabelCaptionField)
'      End If
'    Next
'    Call CloseCursor(ll_Cursor)
'  End If
'  Exit Function
'ErrorHandler:
'  Call CloseCursor(ll_Cursor)
'End Function

Private Function ResetSelectionFields() As Boolean

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:ResetSelectionFields")
#End If

  Call lv_Fields.ListItems.Clear
  ResetSelectionFields = DeleteCollection(mo_Fields)
  
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:ResetSelectionFields")
#End If
End Function

Private Function DisplaySelectionFields() As Boolean
Dim ll_Index As Long
Dim lo_Field As ArmSelField
Dim lo_ListItem As ListItem

On Error GoTo ErrorHandler
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:DisplaySelectionFields")
#End If
  
  Call lv_Fields.ListItems.Clear
  For Each lo_Field In mo_Fields
    Set lo_ListItem = lv_Fields.ListItems.Add
    lo_ListItem.Text = lo_Field.Caption
    lo_ListItem.Checked = lo_Field.Checked
    Set lo_ListItem.Tag = lo_Field
  Next
  DisplaySelectionFields = True

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:DisplaySelectionFields")
#End If
  Exit Function
ErrorHandler:
  DisplaySelectionFields = False
#If CompDebug Then
  Call mo_Trace.WriteTraceError("ArmExcel:DisplaySelectionFields")
#End If
End Function

Private Function ExportOpen(av_ColNames As Variant) As Boolean
Dim lb_Result As Boolean

On Error GoTo ErrorHandler
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:ExportOpen")
#End If
  
  lb_Result = False
  
  If NewExcelDocument Then
    mo_ExcelApp.ScreenUpdating = False
    mo_ExcelApp.Cursor = 2
    Set mo_Sheet = mo_ExcelApp.ActiveSheet
    If Not (mo_Sheet Is Nothing) Then
      If IsArray(av_ColNames) Then
        mo_Sheet.Range(mo_Sheet.cells(1, 1), mo_Sheet.cells(1, UBound(av_ColNames) + 1)) = av_ColNames
        lb_Result = True
      End If
    End If
  End If
  
  ExportOpen = lb_Result

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:ExportOpen")
#End If
  Exit Function
ErrorHandler:
  ExportOpen = False
#If CompDebug Then
  Call mo_Trace.WriteTraceError("ArmExcel:ExportOpen")
#End If
End Function

Private Function ExportRow(al_Cursor As Long)
Dim ll_Col As Long
Dim lv_Data As Variant, lv_Value As Variant

On Error GoTo ErrorHandler

  If mo_Db.FieldCount(al_Cursor) > 0 Then
  
    ReDim lv_Data(mo_Db.FieldCount(al_Cursor) - 1)
    
    For ll_Col = 0 To mo_Db.FieldCount(al_Cursor) - 1
      lv_Data(ll_Col) = Empty
      
      lv_Value = mo_Db.GetFields(al_Cursor, ll_Col)
      Select Case mo_Db.GetFieldType(al_Cursor, ll_Col)
      Case 129
          If ml_LocalID <> 0 Then
            lv_Data(ll_Col) = "'" & StrConv(StrConv(lv_Value, vbFromUnicode, 1033), vbUnicode, ml_LocalID)
          Else
            lv_Data(ll_Col) = "'" & lv_Value
          End If
      Case Else
          lv_Data(ll_Col) = lv_Value
      End Select
    Next
    
    
    RaiseEvent BeforeRowExport(mo_Db.Fields(al_Cursor), lv_Data, Selected_Language_Code)
    ExportRow = ExportArray(lv_Data)

  End If
  Exit Function
ErrorHandler:
  ExportRow = False
#If CompDebug Then
  Call mo_Trace.WriteTraceError("ArmExcel:ExportRow")
#End If
End Function

Private Function ExportArray(av_Data As Variant) As Boolean
Dim ll_Col As Long

On Error GoTo ErrorHandler
' fir task 299.3
'  mo_Sheet.Range(mo_Sheet.cells(ml_CurrentRow + 2, 1), _
'                 mo_Sheet.cells(ml_CurrentRow + 2, UBound(av_Data) + 1)) = av_Data
    For ll_Col = LBound(av_Data) To UBound(av_Data)
        mo_Sheet.cells(ml_CurrentRow + 2, ll_Col + 1) = av_Data(ll_Col)
    Next
' task 299.3 end
  ml_CurrentRow = ml_CurrentRow + 1
  ExportArray = True
  Exit Function
ErrorHandler:
  ExportArray = False
#If CompDebug Then
  Call mo_Trace.WriteTraceError("ArmExcel:ExportArray")
#End If
End Function


Private Function ExportClose() As Boolean

On Error GoTo ErrorHandler
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:ExportClose")
#End If
  
  ExportClose = False
  If Not (mo_ExcelApp Is Nothing) Then
    mo_ExcelApp.ScreenUpdating = True
    mo_ExcelApp.Cursor = -4143
    Set mo_Sheet = Nothing
    Set mo_ExcelApp = Nothing
    ExportClose = True
  End If

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:ExportClose")
#End If
  Exit Function
ErrorHandler:
  ExportClose = False
#If CompDebug Then
  Call mo_Trace.WriteTraceError("ArmExcel:ExportClose")
#End If
End Function

Private Function NewExcelDocument() As Boolean
Dim lo_WorkBook As Object
Dim lo_WorkSheet As Object

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:NewExcelDocument")
#End If
    
    NewExcelDocument = False
    
    On Error GoTo Err_NotLoaded
    
    Set mo_ExcelApp = GetObject(, "Excel.Application")
    
    If mo_ExcelApp Is Nothing Then
        Set mo_ExcelApp = CreateObject("Excel.Application")
    End If
    
    If mo_ExcelApp Is Nothing Then GoTo ErrorHandler
    
    On Error GoTo ErrorHandler
    
    Set lo_WorkBook = mo_ExcelApp.Workbooks.Add
    Set lo_WorkSheet = lo_WorkBook.Worksheets(1)
    mo_ExcelApp.Application.Visible = True
    lo_WorkSheet.Application.Visible = True

    NewExcelDocument = True

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:NewExcelDocument")
#End If
    Exit Function
    
Err_NotLoaded:
    If Err.Number = 429 Then
        Resume Next
    End If
    
ErrorHandler:
    Set mo_ExcelApp = Nothing
#If CompDebug Then
  Call mo_Trace.WriteTraceError("ArmExcel:NewExcelDocument")
#End If
End Function

Private Function SavePreselection() As Boolean
Dim ls_Name As String
Dim lo_ListItem As ListItem
Dim ll_Idx As Long
    
On Error GoTo ErrorHandler
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:SavePreselection")
#End If
  
  SavePreselection = False
  ls_Name = InputBox(GetMessage(EXmtCREATEPRESEL, "#Enter the name of the preselection (only 15 chars) :"))
  ls_Name = UCase(Left(ls_Name, 15))
  
  For Each lo_ListItem In lv_Sel.ListItems
      If StrComp(lo_ListItem.Text, ls_Name, vbTextCompare) = 0 Then
          MsgBox GetMessage(EXmtPRESELNAMEUSED, "#This name is already used, please choose another")
          ls_Name = ""
          Exit For
      End If
  Next
  If ls_Name <> "" Then
    Set lo_ListItem = lv_Sel.ListItems.Add
    lo_ListItem.Text = ls_Name
    lo_ListItem.Tag = GetCurrentSelection(SEP)
    Set lv_Sel.SelectedItem = lo_ListItem
    If ExecuteRequest(ms_PreSelRequest_Ins) Then
      SavePreselection = True
    Else
      'if not succes remove preselection from list
      Call lv_Sel.ListItems.Remove(lo_ListItem.Index)
    End If
  End If
  Set lo_ListItem = Nothing
  Call UpdateButtons

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:SavePreselection")
#End If
  Exit Function
ErrorHandler:
  SavePreselection = False
#If CompDebug Then
  Call mo_Trace.WriteTraceError("ArmExcel:SavePreselection")
#End If
End Function

Private Sub UpdateButtons()
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:UpdateButtons")
#End If
  
  pct_Add.Visible = lv_Sel.ListItems.Count < ml_MaxPreselections

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:UpdateButtons")
#End If
End Sub

Private Function DeleteCurrentPreselection() As Boolean
Dim lo_ListItem As ListItem
    
On Error GoTo ErrorHandler
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:DeleteCurrentPreselection")
#End If
    DeleteCurrentPreselection = False
    Set lo_ListItem = lv_Sel.SelectedItem
    If Not (lo_ListItem Is Nothing) Then
      If MsgBox(GetMessage(EXmtDELETEPRESEL, "#Are you sure to delete this item : ") & lo_ListItem.Text, vbYesNo) = vbYes Then
        If ExecuteRequest(ms_PreSelRequest_Del) Then
          Call lv_Sel.ListItems.Remove(lo_ListItem.Index)
          Call UpdateButtons
          Set lo_ListItem = Nothing
          Set lv_Sel.SelectedItem = Nothing
          DeleteCurrentPreselection = True
        End If
      End If
    End If
    
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:DeleteCurrentPreselection")
#End If
  Exit Function
ErrorHandler:
  DeleteCurrentPreselection = False
#If CompDebug Then
  Call mo_Trace.WriteTraceError("ArmExcel:DeleteCurrentPreselection")
#End If
End Function

Private Function GetCurrentSelection(as_SEP As String) As String
Dim lo_SelField As ArmSelField
Dim ls_Sel As String

On Error GoTo ErrorHandler
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:GetCurrentSelection")
#End If
    
    ls_Sel = ""
    For Each lo_SelField In mo_Fields
        If lo_SelField.Checked Then
          If ls_Sel <> "" Then ls_Sel = ls_Sel & as_SEP
          ls_Sel = ls_Sel & lo_SelField.FieldName
        End If
    Next
    GetCurrentSelection = ls_Sel
    
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:GetCurrentSelection")
#End If
  Exit Function
ErrorHandler:
  GetCurrentSelection = ""
#If CompDebug Then
  Call mo_Trace.WriteTraceError("ArmExcel:GetCurrentSelection")
#End If
End Function

Private Function GetTitleSelection(as_SEP As String) As String
Dim lo_SelField As ArmSelField
Dim ls_Sel As String

On Error GoTo ErrorHandler
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:GetTitleSelection")
#End If
    
    ls_Sel = ""
    For Each lo_SelField In mo_Fields
        If lo_SelField.Checked Then
          If ls_Sel <> "" Then ls_Sel = ls_Sel & as_SEP
          ls_Sel = ls_Sel & lo_SelField.Caption
        End If
    Next
    GetTitleSelection = ls_Sel
    
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:GetTitleSelection")
#End If
  Exit Function
ErrorHandler:
  GetTitleSelection = ""
#If CompDebug Then
  Call mo_Trace.WriteTraceError("ArmExcel:GetTitleSelection")
#End If
End Function

Private Function ClearPreSelection() As Boolean
Dim lo_ListItem As ListItem
    
On Error GoTo ErrorHandler
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:ClearPreSelection")
#End If
  
  For Each lo_ListItem In lv_Fields.ListItems
    lo_ListItem.Checked = False
    lo_ListItem.Tag.Checked = False
  Next lo_ListItem
  ClearPreSelection = True

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:ClearPreSelection")
#End If
  Exit Function
ErrorHandler:
  ClearPreSelection = False
#If CompDebug Then
  Call mo_Trace.WriteTraceError("ArmExcel:ClearPreSelection")
#End If
End Function

Private Function LoadCurrentPreselection() As Boolean
Dim la_Fields() As String
Dim lo_ListItem As ListItem
Dim ll_Index As Long

On Error GoTo ErrorHandler
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:LoadCurrentPreselection")
#End If
  
  LoadCurrentPreselection = False
  If ClearPreSelection Then
    If Not (lv_Sel.SelectedItem Is Nothing) Then
      la_Fields = Split(lv_Sel.SelectedItem.Tag, SEP)
      If IsArray(la_Fields) Then
        For ll_Index = 0 To UBound(la_Fields)
          For Each lo_ListItem In lv_Fields.ListItems
            If StrComp(la_Fields(ll_Index), lo_ListItem.Tag.FieldName, vbTextCompare) = 0 Then
              lo_ListItem.Checked = True
              lo_ListItem.Tag.Checked = True
              Exit For
            End If
          Next lo_ListItem
        Next ll_Index
        LoadCurrentPreselection = True
      End If
    End If
  End If
  
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:LoadCurrentPreselection")
#End If
  Exit Function
ErrorHandler:
  LoadCurrentPreselection = False
#If CompDebug Then
  Call mo_Trace.WriteTraceError("ArmExcel:LoadCurrentPreselection")
#End If
End Function

Private Sub DeletePreselections()
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:DeletePreselections")
#End If
  
  Call lv_Sel.ListItems.Clear

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:DeletePreselections")
#End If
End Sub

Public Sub Load_A_Com()

On Error GoTo ErrorHandler
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:Load_A_Com")
#End If

  pct_Add.Picture = LoadResPicture(117, vbResIcon)
  pct_Del.Picture = LoadResPicture(103, vbResIcon)
  Set mo_Fields = New Collection
  MaxPreselections = 10
  mv_Messages = Empty
  mv_SpecialFields = Empty
  Call cbo_Language.Load_A_Com
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:Load_A_Com")
#End If
  Exit Sub
ErrorHandler:
#If CompDebug Then
  Call mo_Trace.WriteTraceError("ArmExcel:Load_A_Com")
#End If
End Sub

Public Sub Unload_A_Com()
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:Unload_A_Com")
#End If
  
  Call cbo_Language.Unload_A_Com
  pct_Add.Picture = Nothing
  pct_Del.Picture = Nothing
  Set mo_Fields = Nothing

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:Unload_A_Com")
#End If
End Sub

Public Function IsConnected() As Boolean
Dim lb_Result As Boolean

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:IsConnected")
#End If
  
  IsConnected = False
  If Not mo_Db Is Nothing Then
    IsConnected = mo_Db.IsConnected
  End If

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:IsConnected")
#End If
End Function


Private Sub cmd_Cancel_Click()
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:cmd_Cancel_Click")
#End If
  
  RaiseEvent ButtonPressed(cmd_cancel.Name)

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:cmd_Cancel_Click")
#End If
End Sub

Private Sub cmd_Export_Click()
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:cmd_Export_Click")
#End If
  
  RaiseEvent ButtonPressed(cmd_Export.Name)

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:cmd_Export_Click")
#End If
End Sub

Private Sub lv_Fields_ItemCheck(ByVal Item As MSComctlLib.ListItem)
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:lv_Fields_ItemCheck")
#End If
  
  If Not (Item Is Nothing) Then
    Item.Tag.Checked = Item.Checked
    Set lv_Sel.SelectedItem = Nothing
  End If

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:lv_Fields_ItemCheck")
#End If
End Sub

Private Sub lv_Sel_ItemClick(ByVal Item As MSComctlLib.ListItem)
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:lv_Sel_ItemClick")
#End If
  
  Call LoadCurrentPreselection

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:lv_Sel_ItemClick")
#End If
End Sub

Private Sub pct_Add_Click()
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:pct_Add_Click")
#End If
  
  RaiseEvent ButtonPressed(pct_Add.Name)
  Call SavePreselection

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:pct_Add_Click")
#End If
End Sub

Private Sub pct_Del_Click()
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:pct_Del_Click")
#End If
  
  RaiseEvent ButtonPressed(pct_Del.Name)
  Call DeleteCurrentPreselection

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:pct_Del_Click")
#End If
End Sub

Private Sub UserControl_Resize()

On Error GoTo ErrorHandler
#If CompDebugEX Then
  If Not (mo_Trace Is Nothing) Then Call mo_Trace.WriteTraceProc(True, "ArmExcel:UserControl_Resize")
#End If
  
  If UserControl.Height > lv_Fields.Top Then
    lv_Fields.Height = UserControl.Height - lv_Fields.Top
  End If
  If UserControl.Height > lv_Sel.Top Then
    lv_Sel.Height = UserControl.Height - lv_Sel.Top
  End If

#If CompDebugEX Then
  If Not (mo_Trace Is Nothing) Then Call mo_Trace.WriteTraceProc(False, "ArmExcel:UserControl_Resize")
#End If
  Exit Sub
ErrorHandler:
#If CompDebug Then
  If Not (mo_Trace Is Nothing) Then Call mo_Trace.WriteTraceError("ArmExcel:UserControl_Resize")
#End If
End Sub

'open request and return single value from first row and first field of result set
Private Function GetSQLValue(ByVal as_Request As String) As Variant
Dim ll_Cursor As Long
Dim lv_Value As Variant
Dim ll_Index As Long

On Error GoTo ErrorHandler
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:GetSQLValue")
#End If
  
  lv_Value = Empty
  
  ll_Cursor = OpenCursor(as_Request)
  If ll_Cursor <> 0 Then
    If (mo_Db.RowCount(ll_Cursor) > 0) And (mo_Db.FieldCount(ll_Cursor) > 0) Then
      If mo_Db.RowCount(ll_Cursor) = 1 Then
        lv_Value = mo_Db.GetFields(ll_Cursor, 0)
      Else
        ReDim lv_Value(mo_Db.RowCount(ll_Cursor) - 1)
        For ll_Index = 0 To mo_Db.RowCount(ll_Cursor) - 1
          lv_Value(ll_Index) = mo_Db.GetFieldsAt(ll_Cursor, ll_Index, 0)
        Next
      End If
    End If
    Call CloseCursor(ll_Cursor)
  End If
  GetSQLValue = lv_Value
  
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:GetSQLValue")
#End If
  Exit Function
ErrorHandler:
  Call CloseCursor(ll_Cursor)
  GetSQLValue = Empty
#If CompDebug Then
  Call mo_Trace.WriteTraceError("ArmExcel:GetSQLValue", "as_Request=" & as_Request, _
  "IsConnected=" & IsConnected, "ll_Cursor=" & ll_Cursor)
#End If
End Function

'open cursor with request as_Request and return cursor
Private Function OpenCursor(ByVal as_Request As String) As Long
Dim ll_Index As Long
Dim ls_Value As String
  
On Error GoTo ErrorHandler
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:OpenCursor")
#End If
  
  Call SetMousePointer(False)
  OpenCursor = 0
  If Not IsConnected Then
    If Not OpenConnection(ms_Server, ms_Db, ms_User, ms_Pwd, ms_App) Then
#If CompDebug Then
        Call mo_Trace.WriteTraceSQLError(mo_Db, "ArmExcel:OpenCursor", "ms_Server=" & ms_Server, _
          "ms_Db=" & ms_Db, "ms_User=" & ms_User, "ms_Pwd=" & ms_Pwd)
#End If
    End If
  End If
  
  as_Request = ReplaceRequest(as_Request)
  OpenCursor = mo_Db.OpenSQL(as_Request)
  If OpenCursor = 0 Then
#If CompDebug Then
      Call mo_Trace.WriteTraceSQLError(mo_Db, "ArmExcel:OpenCursor", "as_Request=" & as_Request)
#End If
  End If
  Call SetMousePointer(True)

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:OpenCursor")
#End If
  Exit Function
ErrorHandler:
  Call SetMousePointer(True)
#If CompDebug Then
  Call mo_Trace.WriteTraceError("ArmExcel:OpenCursor", "as_Request=" & as_Request)
#End If
End Function

Private Function CloseCursor(ByRef al_Cursor As Long) As Boolean

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:CloseCursor")
#End If
  
  If al_Cursor Then
    Call mo_Db.Close(al_Cursor)
    al_Cursor = 0
  End If

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:CloseCursor")
#End If
End Function

'check selected fields if they contain some of the special fields
Private Function SelectedContainSpecial(av_FieldsDef As Variant) As Boolean
Dim ll_Index As Long
Dim lo_SelField As ArmSelField
Dim la_Fields() As String
Dim lb_Found As Boolean

On Error GoTo ErrorHandler
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:SelectedContainSpecial")
#End If

  lb_Found = False
  la_Fields = Split(av_FieldsDef(0), SEP)
  For ll_Index = 0 To UBound(la_Fields)
    For Each lo_SelField In mo_Fields
      If StrComp(lo_SelField.FieldName, la_Fields(ll_Index), vbTextCompare) = 0 Then
        lb_Found = lo_SelField.Checked
        Exit For
      End If
    Next lo_SelField
    If lb_Found Then Exit For
  Next ll_Index
  SelectedContainSpecial = lb_Found
  
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:SelectedContainSpecial")
#End If
  Exit Function
ErrorHandler:
  SelectedContainSpecial = False
#If CompDebug Then
  Call mo_Trace.WriteTraceError("ArmExcel:SelectedContainSpecial")
#End If
End Function

'replace all special field placeholders by its values acording property SpecialFields
Private Function ReplaceSpecialFields(ab_Selected As Boolean, al_Index As Long, av_FieldsDef As Variant, ByVal as_Request As String) As String

On Error GoTo ErrorHandler
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:ReplaceSpecialFields")
#End If
  
  If ab_Selected Then
    If UBound(av_FieldsDef) >= 1 Then as_Request = Replace(as_Request, "$SpecialTable" & al_Index & "$", av_FieldsDef(1), , , vbTextCompare)
    If UBound(av_FieldsDef) >= 2 Then as_Request = Replace(as_Request, "$SpecialJoin" & al_Index & "$", av_FieldsDef(2), , , vbTextCompare)
    If UBound(av_FieldsDef) >= 3 Then as_Request = Replace(as_Request, "$SpecialWhere" & al_Index & "$", av_FieldsDef(3), , , vbTextCompare)
  Else
    as_Request = Replace(as_Request, "$SpecialTable" & al_Index & "$", "", , , vbTextCompare)
    as_Request = Replace(as_Request, "$SpecialJoin" & al_Index & "$", "", , , vbTextCompare)
    as_Request = Replace(as_Request, "$SpecialWhere" & al_Index & "$", "", , , vbTextCompare)
  End If
  ReplaceSpecialFields = as_Request
  
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:ReplaceSpecialFields")
#End If
  Exit Function
ErrorHandler:
  ReplaceSpecialFields = as_Request
#If CompDebug Then
  Call mo_Trace.WriteTraceError("ArmExcel:ReplaceSpecialFields", "al_Index=" & al_Index, "as_Request=" & as_Request)
#End If
End Function

'replace all field placeholders by its values acording checklist
Private Function ReplaceRequest(ByVal as_Request As String) As String
Dim ll_Index As Long
Dim ls_Language_Code As String
  
On Error GoTo ErrorHandler
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:ReplaceRequest")
#End If
  
  If Not (lv_Sel.SelectedItem Is Nothing) Then
    as_Request = Replace(as_Request, "$PreSelName$", Replace(lv_Sel.SelectedItem.Text, "'", "''"), , , vbTextCompare)
  End If
  as_Request = Replace(as_Request, "$PreSelFields$", Replace(GetCurrentSelection(SEP), "'", "''"), , , vbTextCompare)
  as_Request = Replace(as_Request, "$SelectFields$", Replace(GetCurrentSelection(","), "'", "''"), , , vbTextCompare)
  
  If IsArray(mv_SpecialFields) Then
    For ll_Index = 0 To UBound(mv_SpecialFields)
      as_Request = ReplaceSpecialFields(SelectedContainSpecial(mv_SpecialFields(ll_Index)), _
        ll_Index + 1, mv_SpecialFields(ll_Index), as_Request)
    Next
  End If
  
  'replace placeholder for current time
  as_Request = Replace(as_Request, "$NOW()$", Format(Now, "yyyy-mm-dd"), , , vbTextCompare)
  as_Request = Replace(as_Request, "$User_ID$", Replace(ms_User_ID, "'", "''"), , , vbTextCompare)
  
  ls_Language_Code = Selected_Language_Code
  If mb_UseLanguage And (ls_Language_Code <> "") Then
    as_Request = Replace(as_Request, "$Language_Code$", Replace(ls_Language_Code, "'", "''"), , , vbTextCompare)
  Else
    as_Request = Replace(as_Request, "$Language_Code$", Replace(ls_Language_Code, "'", "''"), , , vbTextCompare)
  End If
  
  ReplaceRequest = as_Request

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:ReplaceRequest")
#End If
  Exit Function
ErrorHandler:
  ReplaceRequest = as_Request
#If CompDebug Then
  Call mo_Trace.WriteTraceError("ArmExcel:ReplaceRequest", "as_Request=" & as_Request)
#End If
End Function

'execute SQL request on server
Private Function ExecuteRequest(ByVal as_Request As String) As Boolean
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:ExecuteRequest")
#End If
  
  as_Request = ReplaceRequest(as_Request)
  ExecuteRequest = mo_Db.ExecuteSQL(as_Request)
  If Not ExecuteRequest Then
#If CompDebug Then
    Call mo_Trace.WriteTraceSQLError(mo_Db, "ArmExcel:ExecuteRequest", "as_Request=" & as_Request)
#End If
  End If

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:ExecuteRequest")
#End If
End Function

Private Function DeleteCollection(lo_Collection As Collection) As Boolean

On Error GoTo ErrorHandler
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:DeleteCollection")
#End If
  
  If Not (lo_Collection Is Nothing) Then
    While lo_Collection.Count > 0
      Call lo_Collection.Remove(1)
    Wend
  End If
  DeleteCollection = True

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:DeleteCollection")
#End If
  Exit Function
ErrorHandler:
  DeleteCollection = False
#If CompDebug Then
  Call mo_Trace.WriteTraceError("ArmExcel:DeleteCollection")
#End If
End Function

'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 CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:OpenConnection")
#End If

  lb_Result = False
  If Not IsConnected Then
    mb_InternalConnection = True
    If mo_Db Is Nothing Then
      Set mo_Db = CreateObject("ARMSYSCOM.ArmDb")
    End If

    If (as_Server <> "") And (as_Db <> "") And (as_User <> "") Then
        If mo_Db.Connect(as_Server, as_Db, as_User, as_Pwd, as_App) Then
          lb_Result = mo_Db.IsConnected
        Else
#If CompDebug Then
          Call mo_Trace.WriteTraceSQLError(mo_Db, "ArmExcel:OpenConnectionn")
#End If
        End If
    End If
  End If
  OpenConnection = lb_Result

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:OpenConnection")
#End If
  Exit Function
ErrorHandler:
  OpenConnection = False
#If CompDebug Then
  Call mo_Trace.WriteTraceError("ArmExcel:OpenConnection", "as_Server=" & as_Server, _
  "as_Db=" & as_Db, "as_User=" & as_User)
#End If
End Function

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

On Error GoTo ErrorHandler
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:CloseConnection")
#End If
 
  If IsConnected Then
    Call mo_Db.Disconnect
    mb_InternalConnection = False
  End If

#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:CloseConnection")
#End If
  Exit Sub
ErrorHandler:
#If CompDebug Then
  Call mo_Trace.WriteTraceError("ArmExcel:CloseConnection")
#End If
End Sub

'**************************************************************************************************************
'turn of on mouse pointer sand hour glass, use counter
Private Static Sub SetMousePointer(lb_Enable As Boolean)
Dim li_Count As Integer
Dim li_OldPointer As Integer

On Error GoTo ErrorHandler
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(True, "ArmExcel:SetMousePointer")
#End If
  
  If lb_Enable Then
    If li_Count > 0 Then li_Count = li_Count - 1
    If li_Count <= 0 Then
      'set back old state
      Screen.MousePointer = li_OldPointer
    End If
  Else
    li_Count = li_Count + 1
    'remember state of pointer before first change
    If li_Count = 1 Then li_OldPointer = Screen.MousePointer
    Screen.MousePointer = vbHourglass
  End If
#If CompDebugEX Then
  Call mo_Trace.WriteTraceProc(False, "ArmExcel:SetMousePointer")
#End If
  Exit Sub
ErrorHandler:
#If CompDebug Then
  Call mo_Trace.WriteTraceError("ArmExcel:SetMousePointer")
#End If
End Sub

