VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.1#0"; "mscomctl.ocx"
Begin VB.UserControl SfbRefPro 
   ClientHeight    =   13605
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   15360
   ScaleHeight     =   13605
   ScaleWidth      =   15360
   Begin Project1.ToolbarControl tlb_RP_Tasks 
      Height          =   690
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   12855
      _ExtentX        =   22675
      _ExtentY        =   1217
      ButtonsString   =   "AAABBBCCCDAAEFE"
   End
   Begin VB.Frame fra_RP_Record 
      Height          =   9135
      Left            =   180
      TabIndex        =   27
      Top             =   1050
      Visible         =   0   'False
      Width           =   12975
      Begin MSComctlLib.TabStrip tbs_RP_Products 
         Height          =   375
         Left            =   120
         TabIndex        =   20
         Top             =   5490
         Width           =   12720
         _ExtentX        =   22437
         _ExtentY        =   661
         _Version        =   393216
         BeginProperty Tabs {1EFB6598-857C-11D1-B16A-00C0F0283628} 
            NumTabs         =   4
            BeginProperty Tab1 {1EFB659A-857C-11D1-B16A-00C0F0283628} 
               Caption         =   "Product by codes"
               ImageVarType    =   2
            EndProperty
            BeginProperty Tab2 {1EFB659A-857C-11D1-B16A-00C0F0283628} 
               Caption         =   "Products free text"
               ImageVarType    =   2
            EndProperty
            BeginProperty Tab3 {1EFB659A-857C-11D1-B16A-00C0F0283628} 
               Caption         =   "Documents"
               ImageVarType    =   2
            EndProperty
            BeginProperty Tab4 {1EFB659A-857C-11D1-B16A-00C0F0283628} 
               Caption         =   "Customers"
               ImageVarType    =   2
            EndProperty
         EndProperty
      End
      Begin VB.Frame fra_RP_FreeText_Sub 
         Height          =   5295
         Left            =   7080
         TabIndex        =   32
         Top             =   2040
         Visible         =   0   'False
         Width           =   10230
         Begin Project1.ArmGrid grd_RP_FreeTextStored 
            Height          =   4920
            Left            =   120
            TabIndex        =   3
            Tag             =   "grd_RP_FreeTextStoredConst"
            Top             =   270
            Width           =   12495
            _ExtentX        =   22040
            _ExtentY        =   8678
         End
      End
      Begin VB.Frame fra_RP_Document 
         Height          =   3255
         Left            =   120
         TabIndex        =   31
         Top             =   5760
         Visible         =   0   'False
         Width           =   12735
         Begin Project1.ToolbarControl tlb_RP_DocumentTasks 
            Height          =   2655
            Left            =   11880
            TabIndex        =   26
            Top             =   240
            Width           =   690
            _ExtentX        =   1217
            _ExtentY        =   4683
         End
         Begin Project1.ArmGrid grd_RP_Documents 
            Height          =   2880
            Left            =   120
            TabIndex        =   23
            Tag             =   "grd_RP_DocumentsConst"
            Top             =   240
            Width           =   11655
            _ExtentX        =   20558
            _ExtentY        =   5080
         End
      End
      Begin VB.Frame fra_RP_Document_Sub 
         Height          =   5610
         Left            =   240
         TabIndex        =   33
         Top             =   120
         Visible         =   0   'False
         Width           =   12975
         Begin VB.Frame fra_RP_SelectFile 
            Caption         =   "#Select file"
            Height          =   3570
            Left            =   120
            TabIndex        =   49
            Tag             =   "fra_RP_SelectFile"
            Top             =   1665
            Width           =   7320
            Begin VB.TextBox txt_RP_DocumentPath 
               Height          =   375
               Left            =   1680
               TabIndex        =   51
               Top             =   240
               Width           =   5500
            End
            Begin VB.FileListBox fil_Full 
               Height          =   2625
               Left            =   3620
               TabIndex        =   9
               Top             =   780
               Width           =   3450
            End
            Begin VB.DirListBox dir_Full 
               Height          =   2340
               Left            =   120
               TabIndex        =   10
               Top             =   1095
               Width           =   3450
            End
            Begin VB.DriveListBox drv_Full 
               Height          =   315
               Left            =   120
               TabIndex        =   8
               Top             =   780
               Width           =   3450
            End
            Begin VB.Label lbl_Label 
               Caption         =   "#Document Path"
               BeginProperty Font 
                  Name            =   "Arial"
                  Size            =   8.25
                  Charset         =   0
                  Weight          =   700
                  Underline       =   0   'False
                  Italic          =   0   'False
                  Strikethrough   =   0   'False
               EndProperty
               Height          =   255
               Index           =   8
               Left            =   120
               TabIndex        =   50
               Tag             =   "lbl_RP_DocumentPath"
               Top             =   360
               Width           =   1575
            End
         End
         Begin VB.CheckBox chk_RPD_internet_Flag 
            Caption         =   "#Internet Flag"
            Height          =   255
            Left            =   5400
            TabIndex        =   94
            Tag             =   "chk_RP_InternetFlag"
            Top             =   1320
            Width           =   2055
         End
         Begin Project1.ArmCombobox cbo_RP_DocumentClass 
            Height          =   345
            Left            =   9300
            TabIndex        =   60
            Top             =   1230
            Width           =   3015
            _ExtentX        =   5318
            _ExtentY        =   609
         End
         Begin Project1.ArmCombobox cbo_RP_DocumentCategory 
            Height          =   345
            Left            =   2280
            TabIndex        =   58
            Top             =   1200
            Width           =   3015
            _ExtentX        =   5318
            _ExtentY        =   609
         End
         Begin VB.TextBox txt_RP_DocumentTitle 
            Height          =   375
            Left            =   2280
            TabIndex        =   4
            Top             =   240
            Width           =   7500
         End
         Begin Project1.ArmCombobox cbo_RP_DocumentType 
            Height          =   345
            Left            =   2280
            TabIndex        =   6
            Top             =   720
            Width           =   10335
            _ExtentX        =   18230
            _ExtentY        =   609
         End
         Begin Project1.ArmCombobox cbo_RPD_Cat 
            Height          =   345
            Left            =   9300
            TabIndex        =   100
            Top             =   1680
            Width           =   3015
            _ExtentX        =   5318
            _ExtentY        =   609
         End
         Begin Project1.ArmCheckView cvw_RP_RecommendedArea 
            Height          =   2000
            Left            =   9300
            TabIndex        =   102
            Top             =   2720
            Width           =   3600
            _ExtentX        =   6350
            _ExtentY        =   3519
         End
         Begin Project1.ArmCombobox cbo_DocLang 
            Height          =   345
            Left            =   9300
            TabIndex        =   104
            Top             =   2130
            Width           =   3015
            _ExtentX        =   5318
            _ExtentY        =   609
         End
         Begin VB.Label lbl_Label 
            Caption         =   "#Language"
            BeginProperty Font 
               Name            =   "Arial"
               Size            =   8.25
               Charset         =   0
               Weight          =   400
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   255
            Index           =   22
            Left            =   7455
            TabIndex        =   105
            Tag             =   "lbl_DocLang"
            Top             =   2250
            Width           =   1830
         End
         Begin VB.Label lbl_Label 
            Caption         =   "#Recomended area"
            BeginProperty Font 
               Name            =   "Arial"
               Size            =   8.25
               Charset         =   0
               Weight          =   400
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   255
            Index           =   14
            Left            =   7455
            TabIndex        =   103
            Tag             =   "lbl_RP_RecommendedArea"
            Top             =   2730
            Width           =   1845
         End
         Begin VB.Label lbl_Label 
            Caption         =   "#Category indicator"
            BeginProperty Font 
               Name            =   "Arial"
               Size            =   8.25
               Charset         =   0
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   255
            Index           =   23
            Left            =   7455
            TabIndex        =   101
            Tag             =   "lbl_RPD_Cat"
            Top             =   1800
            Width           =   1830
         End
         Begin VB.Label lbl_Label 
            Caption         =   "#Document class"
            BeginProperty Font 
               Name            =   "Arial"
               Size            =   8.25
               Charset         =   0
               Weight          =   400
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   255
            Index           =   20
            Left            =   7455
            TabIndex        =   59
            Tag             =   "lbl_RP_DocumentClass"
            Top             =   1320
            Width           =   1845
         End
         Begin VB.Label lbl_Label 
            Caption         =   "#Document category"
            BeginProperty Font 
               Name            =   "Arial"
               Size            =   8.25
               Charset         =   0
               Weight          =   400
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   255
            Index           =   19
            Left            =   120
            TabIndex        =   57
            Tag             =   "lbl_RP_DocumentCategory"
            Top             =   1320
            Width           =   2055
         End
         Begin VB.Label lbl_Label 
            Caption         =   "#Document title"
            BeginProperty Font 
               Name            =   "Arial"
               Size            =   8.25
               Charset         =   0
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   255
            Index           =   9
            Left            =   120
            TabIndex        =   48
            Tag             =   "lbl_RP_DocumentTitle"
            Top             =   360
            Width           =   1575
         End
         Begin VB.Label lbl_Label 
            Caption         =   "#Document type"
            BeginProperty Font 
               Name            =   "Arial"
               Size            =   8.25
               Charset         =   0
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   255
            Index           =   10
            Left            =   120
            TabIndex        =   47
            Tag             =   "lbl_RP_DocumentType"
            Top             =   840
            Width           =   1455
         End
      End
      Begin VB.Frame fra_RP_Customers 
         Height          =   3255
         Left            =   120
         TabIndex        =   52
         Top             =   5760
         Visible         =   0   'False
         Width           =   12735
         Begin Project1.ToolbarControl tlb_RP_CustomersTasks 
            Height          =   1455
            Left            =   11880
            TabIndex        =   54
            Top             =   220
            Width           =   690
            _ExtentX        =   1217
            _ExtentY        =   2566
         End
         Begin Project1.ArmGrid grd_RP_Customers 
            Height          =   2880
            Left            =   120
            TabIndex        =   53
            Tag             =   "grd_RP_CustomersConst"
            Top             =   240
            Width           =   11655
            _ExtentX        =   20558
            _ExtentY        =   5080
         End
      End
      Begin VB.Frame fra_RP_Product 
         Height          =   3255
         Left            =   120
         TabIndex        =   28
         Top             =   5760
         Width           =   12735
         Begin Project1.ToolbarControl tlb_RP_ProductTasks 
            Height          =   1695
            Left            =   11880
            TabIndex        =   24
            Top             =   240
            Width           =   690
            _ExtentX        =   1217
            _ExtentY        =   2990
         End
         Begin Project1.ArmGrid grd_RP_Products 
            Height          =   2880
            Left            =   120
            TabIndex        =   21
            Tag             =   "grd_RP_ProductsConst"
            Top             =   240
            Width           =   11655
            _ExtentX        =   20558
            _ExtentY        =   5080
         End
      End
      Begin VB.Frame fra_RP_FreeText 
         Height          =   3255
         Left            =   120
         TabIndex        =   30
         Top             =   5760
         Visible         =   0   'False
         Width           =   12735
         Begin Project1.ToolbarControl tlb_RP_FreeTextTasks 
            Height          =   1695
            Left            =   11880
            TabIndex        =   25
            Top             =   240
            Width           =   690
            _ExtentX        =   1217
            _ExtentY        =   2990
         End
         Begin Project1.ArmGrid grd_RP_FreeText 
            Height          =   2880
            Left            =   120
            TabIndex        =   22
            Tag             =   "grd_RP_FreeTextConst"
            Top             =   240
            Width           =   11655
            _ExtentX        =   20558
            _ExtentY        =   5080
         End
      End
      Begin VB.Frame fra_RP_Detail 
         BorderStyle     =   0  'None
         Height          =   5100
         Left            =   105
         TabIndex        =   34
         Top             =   120
         Width           =   12735
         Begin VB.CheckBox chk_RP_RestrictedInternet 
            Caption         =   "#Restricted Internet"
            Height          =   255
            Left            =   4545
            TabIndex        =   99
            Tag             =   "chk_RP_RestrictedInternet"
            Top             =   4035
            Width           =   2055
         End
         Begin VB.TextBox txt_Creator 
            BackColor       =   &H8000000F&
            Enabled         =   0   'False
            Height          =   375
            Left            =   8490
            TabIndex        =   97
            Top             =   2250
            Width           =   4215
         End
         Begin VB.TextBox txt_last_upd 
            BackColor       =   &H8000000F&
            Enabled         =   0   'False
            Height          =   375
            Left            =   8490
            TabIndex        =   95
            Top             =   2670
            Width           =   4215
         End
         Begin VB.CommandButton btn_uncheckAll 
            Caption         =   "#Uncheck all"
            Height          =   375
            Left            =   5640
            TabIndex        =   68
            Tag             =   "btn_uncheckAll"
            Top             =   2775
            Width           =   1215
         End
         Begin Project1.ArmCheckView cvw_RP_RPExcludedCountries 
            Height          =   975
            Left            =   1920
            TabIndex        =   66
            Top             =   2295
            Width           =   3615
            _ExtentX        =   6376
            _ExtentY        =   1720
         End
         Begin VB.CommandButton btn_checkAll 
            Caption         =   "#Check all"
            Height          =   375
            Left            =   5640
            TabIndex        =   67
            Tag             =   "btn_checkAll"
            Top             =   2295
            Width           =   1215
         End
         Begin VB.TextBox txt_Spare3 
            Height          =   375
            Left            =   120
            TabIndex        =   64
            Top             =   4830
            Visible         =   0   'False
            Width           =   1455
         End
         Begin VB.TextBox txt_Spare2 
            Height          =   375
            Left            =   90
            TabIndex        =   63
            Top             =   4800
            Visible         =   0   'False
            Width           =   1455
         End
         Begin VB.TextBox txt_Spare1 
            Height          =   375
            Left            =   150
            TabIndex        =   62
            Top             =   4845
            Visible         =   0   'False
            Width           =   1455
         End
         Begin VB.TextBox txt_Spareint2 
            Height          =   375
            Left            =   240
            TabIndex        =   61
            Top             =   4875
            Visible         =   0   'False
            Width           =   1455
         End
         Begin VB.TextBox txt_RP_Town 
            Height          =   375
            Left            =   8490
            TabIndex        =   55
            Top             =   3480
            Width           =   4215
         End
         Begin VB.CheckBox chk_RP_InternetFlag 
            Caption         =   "#Internet Flag"
            Height          =   255
            Left            =   4545
            TabIndex        =   17
            Tag             =   "chk_RP_InternetFlag"
            Top             =   3735
            Width           =   2055
         End
         Begin Project1.A_calocx cal_RP_InstallDate 
            Height          =   375
            Left            =   1920
            TabIndex        =   13
            Top             =   3330
            Width           =   1815
            _ExtentX        =   3201
            _ExtentY        =   661
         End
         Begin VB.TextBox txt_RP_CustomerInfo 
            Height          =   690
            Left            =   1920
            MultiLine       =   -1  'True
            ScrollBars      =   2  'Vertical
            TabIndex        =   18
            Text            =   "SfbRefPro.ctx":0000
            Top             =   4365
            Width           =   4935
         End
         Begin VB.TextBox txt_RP_ConstructYear 
            Height          =   345
            Left            =   5760
            TabIndex        =   14
            Top             =   3330
            Width           =   1095
         End
         Begin VB.TextBox txt_RP_Contractor 
            Height          =   375
            Left            =   8565
            TabIndex        =   12
            Top             =   1695
            Visible         =   0   'False
            Width           =   4215
         End
         Begin VB.TextBox txt_RP_Text 
            Height          =   1095
            Left            =   1920
            MultiLine       =   -1  'True
            ScrollBars      =   2  'Vertical
            TabIndex        =   7
            Text            =   "SfbRefPro.ctx":0017
            Top             =   1080
            Width           =   10815
         End
         Begin VB.TextBox txt_RP_Internet_Desc 
            Height          =   375
            Left            =   1920
            TabIndex        =   5
            Top             =   600
            Width           =   10815
         End
         Begin VB.TextBox txt_RP_Desc 
            Height          =   375
            Left            =   1920
            TabIndex        =   2
            Top             =   120
            Width           =   10815
         End
         Begin VB.TextBox txt_RP_Surface 
            Height          =   375
            Left            =   1920
            TabIndex        =   16
            Top             =   3915
            Width           =   1815
         End
         Begin Project1.ArmCombobox cbo_RP_MarketSeg 
            Height          =   345
            Left            =   8850
            TabIndex        =   19
            Top             =   3930
            Width           =   3855
            _ExtentX        =   6800
            _ExtentY        =   609
         End
         Begin Project1.ArmCombobox cbo_RP_Country 
            Height          =   345
            Left            =   8490
            TabIndex        =   15
            Top             =   3090
            Width           =   4215
            _ExtentX        =   7435
            _ExtentY        =   609
         End
         Begin VB.TextBox txt_RP_Architect 
            Height          =   375
            Left            =   1920
            TabIndex        =   11
            Top             =   2055
            Visible         =   0   'False
            Width           =   4935
         End
         Begin VB.Label lbl_Label 
            Caption         =   "#Creator"
            BeginProperty Font 
               Name            =   "Arial"
               Size            =   8.25
               Charset         =   0
               Weight          =   400
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   255
            Index           =   2
            Left            =   6930
            TabIndex        =   98
            Tag             =   "lbl_creator"
            Top             =   2370
            Width           =   1575
         End
         Begin VB.Label lbl_Label 
            Caption         =   "#Updator"
            BeginProperty Font 
               Name            =   "Arial"
               Size            =   8.25
               Charset         =   0
               Weight          =   400
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   255
            Index           =   1
            Left            =   6930
            TabIndex        =   96
            Tag             =   "lbl_last_upd"
            Top             =   2790
            Width           =   1575
         End
         Begin VB.Label lbl_Label 
            Caption         =   "#Excluded countries"
            BeginProperty Font 
               Name            =   "Arial"
               Size            =   8.25
               Charset         =   0
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   255
            Index           =   21
            Left            =   0
            TabIndex        =   65
            Tag             =   "lbl_RP_Excluded_countries"
            Top             =   2295
            Width           =   1935
         End
         Begin VB.Label lbl_Label 
            Caption         =   "#Town"
            BeginProperty Font 
               Name            =   "Arial"
               Size            =   8.25
               Charset         =   0
               Weight          =   400
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   255
            Index           =   18
            Left            =   6930
            TabIndex        =   56
            Tag             =   "lbl_RP_Town"
            Top             =   3600
            Width           =   1575
         End
         Begin VB.Label lbl_Label 
            Caption         =   "#SQM"
            Height          =   255
            Index           =   16
            Left            =   3840
            TabIndex        =   46
            Tag             =   "lbl_RP_Surface_Unit"
            Top             =   4005
            Width           =   855
         End
         Begin VB.Label lbl_Label 
            Caption         =   "#Country"
            BeginProperty Font 
               Name            =   "Arial"
               Size            =   8.25
               Charset         =   0
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   255
            Index           =   5
            Left            =   6930
            TabIndex        =   45
            Tag             =   "lbl_RP_Country"
            Top             =   3210
            Width           =   1575
         End
         Begin VB.Label lbl_Label 
            Caption         =   "#Market segmentation"
            BeginProperty Font 
               Name            =   "Arial"
               Size            =   8.25
               Charset         =   0
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   255
            Index           =   13
            Left            =   6930
            TabIndex        =   44
            Tag             =   "lbl_RP_MarketSeg"
            Top             =   3930
            Width           =   1935
         End
         Begin VB.Label lbl_Label 
            Caption         =   "#Customer Info"
            BeginProperty Font 
               Name            =   "Arial"
               Size            =   8.25
               Charset         =   0
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   255
            Index           =   6
            Left            =   0
            TabIndex        =   43
            Tag             =   "lbl_RP_CustomerInfo"
            Top             =   4365
            Width           =   1935
         End
         Begin VB.Label lbl_Label 
            Caption         =   "#Size"
            BeginProperty Font 
               Name            =   "Arial"
               Size            =   8.25
               Charset         =   0
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   255
            Index           =   15
            Left            =   0
            TabIndex        =   42
            Tag             =   "lbl_RP_Surface"
            Top             =   4035
            Width           =   1935
         End
         Begin VB.Label lbl_Label 
            Caption         =   "#Construct year"
            BeginProperty Font 
               Name            =   "Arial"
               Size            =   8.25
               Charset         =   0
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   255
            Index           =   3
            Left            =   4200
            TabIndex        =   41
            Tag             =   "lbl_RP_ConstructYear"
            Top             =   3405
            Width           =   1575
         End
         Begin VB.Label lbl_Label 
            Caption         =   "#Install date"
            BeginProperty Font 
               Name            =   "Arial"
               Size            =   8.25
               Charset         =   0
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   255
            Index           =   11
            Left            =   0
            TabIndex        =   40
            Tag             =   "lbl_RP_InstallDate"
            Top             =   3405
            Width           =   1935
         End
         Begin VB.Label lbl_Label 
            Caption         =   "#Contractor"
            BeginProperty Font 
               Name            =   "Arial"
               Size            =   8.25
               Charset         =   0
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   255
            Index           =   4
            Left            =   7080
            TabIndex        =   39
            Tag             =   "lbl_RP_Contractor"
            Top             =   1950
            Visible         =   0   'False
            Width           =   1575
         End
         Begin VB.Label lbl_Label 
            Caption         =   "#Architect"
            BeginProperty Font 
               Name            =   "Arial"
               Size            =   8.25
               Charset         =   0
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   105
            Index           =   0
            Left            =   0
            TabIndex        =   38
            Tag             =   "lbl_RP_Architect"
            Top             =   2175
            Visible         =   0   'False
            Width           =   1935
         End
         Begin VB.Label lbl_Label 
            Caption         =   "#Memo"
            BeginProperty Font 
               Name            =   "Arial"
               Size            =   8.25
               Charset         =   0
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   255
            Index           =   17
            Left            =   0
            TabIndex        =   37
            Tag             =   "lbl_RP_Text"
            Top             =   1080
            Width           =   1935
         End
         Begin VB.Label lbl_Label 
            Caption         =   "#Internet description"
            BeginProperty Font 
               Name            =   "Arial"
               Size            =   8.25
               Charset         =   0
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   255
            Index           =   12
            Left            =   0
            TabIndex        =   36
            Tag             =   "lbl_RP_Internet_Desc"
            Top             =   720
            Width           =   1935
         End
         Begin VB.Label lbl_Label 
            Caption         =   "#Description"
            BeginProperty Font 
               Name            =   "Arial"
               Size            =   8.25
               Charset         =   0
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   255
            Index           =   7
            Left            =   0
            TabIndex        =   35
            Tag             =   "lbl_RP_Desc"
            Top             =   240
            Width           =   1935
         End
      End
   End
   Begin VB.Frame fra_RP_Main 
      Height          =   9135
      Left            =   120
      TabIndex        =   29
      Top             =   975
      Width           =   12975
      Begin VB.Frame fra_InternetFlag 
         Caption         =   "#Internet flag"
         Height          =   735
         Left            =   120
         TabIndex        =   88
         Tag             =   "fra_InternetFlag"
         Top             =   4440
         Width           =   3855
         Begin VB.OptionButton opt_inernet 
            Caption         =   "#No"
            Height          =   255
            Index           =   2
            Left            =   2520
            TabIndex        =   91
            Tag             =   "opt_IntFlagNo"
            Top             =   360
            Width           =   1095
         End
         Begin VB.OptionButton opt_inernet 
            Caption         =   "#Yes"
            Height          =   255
            Index           =   1
            Left            =   1200
            TabIndex        =   90
            Tag             =   "opt_IntFlagYes"
            Top             =   360
            Width           =   1095
         End
         Begin VB.OptionButton opt_inernet 
            Caption         =   "#All"
            Height          =   255
            Index           =   0
            Left            =   120
            TabIndex        =   89
            Tag             =   "opt_IntFlagAll"
            Top             =   360
            Value           =   -1  'True
            Width           =   975
         End
      End
      Begin VB.Frame fra_FiltersField 
         Caption         =   "#Filter"
         Height          =   1995
         Index           =   1
         Left            =   120
         TabIndex        =   74
         Tag             =   "fra_FiltersField"
         Top             =   2340
         Width           =   3855
         Begin VB.OptionButton opt_fieldC 
            Caption         =   "#Town"
            Height          =   285
            Index           =   1
            Left            =   240
            TabIndex        =   87
            Tag             =   "opt_fieldTown"
            Top             =   600
            Width           =   3405
         End
         Begin VB.OptionButton opt_fieldC 
            Caption         =   "#Description"
            Height          =   285
            Index           =   0
            Left            =   240
            TabIndex        =   86
            Tag             =   "opt_fieldDescription"
            Top             =   240
            Value           =   -1  'True
            Width           =   3405
         End
         Begin VB.Frame fra_Like 
            Height          =   915
            Index           =   1
            Left            =   60
            TabIndex        =   75
            Top             =   960
            Width           =   3705
            Begin VB.TextBox txt_LikeStr 
               Height          =   345
               Left            =   60
               MaxLength       =   40
               TabIndex        =   79
               Top             =   480
               Width           =   3555
            End
            Begin VB.OptionButton opt_Like 
               Height          =   255
               Index           =   0
               Left            =   120
               TabIndex        =   78
               Tag             =   "Like®©True®©??"
               Top             =   180
               Value           =   -1  'True
               Width           =   195
            End
            Begin VB.OptionButton opt_Like 
               Height          =   255
               Index           =   1
               Left            =   1200
               TabIndex        =   77
               Tag             =   "Like®©False®©??"
               Top             =   180
               Width           =   255
            End
            Begin VB.OptionButton opt_Like 
               Height          =   255
               Index           =   2
               Left            =   2280
               TabIndex        =   76
               Tag             =   "Like®©False®©??"
               Top             =   180
               Width           =   255
            End
            Begin VB.Label lbl_Like 
               AutoSize        =   -1  'True
               Caption         =   "xxx"
               ForeColor       =   &H000000FF&
               Height          =   195
               Index           =   8
               Left            =   1680
               TabIndex        =   82
               Top             =   180
               Width           =   225
            End
            Begin VB.Label lbl_Like 
               AutoSize        =   -1  'True
               Caption         =   "xxx      xxx"
               Height          =   195
               Index           =   11
               Left            =   1440
               TabIndex        =   85
               Top             =   180
               Width           =   720
            End
            Begin VB.Label lbl_Like 
               AutoSize        =   -1  'True
               Caption         =   "xxx"
               ForeColor       =   &H000000FF&
               Height          =   195
               Index           =   6
               Left            =   2970
               TabIndex        =   84
               Top             =   180
               Width           =   225
            End
            Begin VB.Label lbl_Like 
               AutoSize        =   -1  'True
               Caption         =   "xxxxxx"
               Height          =   195
               Index           =   7
               Left            =   2520
               TabIndex        =   83
               Top             =   180
               Width           =   450
            End
            Begin VB.Label lbl_Like 
               AutoSize        =   -1  'True
               Caption         =   "xxx"
               ForeColor       =   &H000000FF&
               Height          =   195
               Index           =   9
               Left            =   360
               TabIndex        =   81
               Top             =   180
               Width           =   225
            End
            Begin VB.Label lbl_Like 
               AutoSize        =   -1  'True
               Caption         =   "xxxxxx"
               Height          =   195
               Index           =   10
               Left            =   600
               TabIndex        =   80
               Top             =   180
               Width           =   450
            End
         End
      End
      Begin VB.Frame fra_FiltersCountry 
         Caption         =   "#Country"
         Height          =   825
         Index           =   1
         Left            =   120
         TabIndex        =   72
         Tag             =   "fra_FiltersCountry"
         Top             =   1440
         Width           =   3855
         Begin Project1.ArmCombobox cbo_FiltersCountry 
            Height          =   345
            Left            =   60
            TabIndex        =   73
            Tag             =   "CT_code"
            Top             =   330
            Width           =   3735
            _ExtentX        =   6588
            _ExtentY        =   609
         End
      End
      Begin VB.Frame fra_FiltersDate 
         Caption         =   "#Date"
         Height          =   1125
         Left            =   120
         TabIndex        =   69
         Tag             =   "fra_FiltersDate"
         Top             =   240
         Width           =   3855
         Begin VB.OptionButton opt_FiltersDate 
            Caption         =   "#All"
            Height          =   255
            Index           =   0
            Left            =   120
            TabIndex        =   71
            Tag             =   "optFiltersDate_All"
            Top             =   240
            Value           =   -1  'True
            Width           =   1455
         End
         Begin VB.OptionButton opt_FiltersDate 
            Caption         =   "#Between"
            Height          =   255
            Index           =   1
            Left            =   1800
            TabIndex        =   70
            Tag             =   "optFiltersDate_Between"
            Top             =   240
            Width           =   1455
         End
         Begin Project1.A_calocx cal_filtersMax 
            Height          =   375
            Left            =   1965
            TabIndex        =   92
            Top             =   600
            Visible         =   0   'False
            Width           =   1815
            _ExtentX        =   3201
            _ExtentY        =   661
         End
         Begin Project1.A_calocx cal_FiltersMin 
            Height          =   375
            Left            =   60
            TabIndex        =   93
            Top             =   600
            Visible         =   0   'False
            Width           =   1815
            _ExtentX        =   3201
            _ExtentY        =   661
         End
      End
      Begin Project1.ArmGrid grd_RP_Main 
         Height          =   8775
         Left            =   4200
         TabIndex        =   1
         Tag             =   "grd_RP_MainConst"
         Top             =   360
         Width           =   7935
         _ExtentX        =   13996
         _ExtentY        =   15478
      End
   End
End
Attribute VB_Name = "SfbRefPro"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

'what is new
'2.7.1 : Support for multilanguage User Interface (JN)

'p615 add RPD_Cat combo + Recommended area check view at document level
Private Declare Function LockWindowUpdate Lib "user32" (ByVal hwnd As Long) As Long

' JN 17.6.2010
Private Declare Function CreateCompatibleDC Lib "GDI32.dll" (ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "GDI32.dll" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function SelectObject Lib "GDI32.dll" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "GDI32.dll" (ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "GDI32.dll" (ByVal hdc As Long) As Long
Private Declare Function BitBlt Lib "GDI32.dll" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function GetDIBits Lib "GDI32.dll" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, ByRef lpBits As Any, ByRef lpBI As BitmapInfo, ByVal wUsage As Long) As Long
Private Declare Function CreateDIBSection Lib "GDI32.dll" (ByVal hdc As Long, ByRef pBitmapInfo As BitmapInfo, ByVal un As Long, ByVal lplpVoid As Long, ByVal Handle As Long, ByVal dw As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32.dll" () As Long
Private Declare Function GetDC Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32.dll" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function GetObject Lib "GDI32.dll" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, ByRef lpObject As Any) As Long
Private Declare Function SetStretchBltMode Lib "GDI32.dll" (ByVal hdc As Long, ByVal nStretchMode As Long) As Long
Private Declare Function StretchBlt Lib "GDI32.dll" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Private Declare Function CreateBitmap Lib "GDI32.dll" (ByVal nWidth As Long, ByVal nHeight As Long, ByVal nPlanes As Long, ByVal nBitCount As Long, ByRef lpBits As Any) As Long
Private Declare Function SetTextColor Lib "GDI32.dll" (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Function SetBkColor Lib "GDI32.dll" (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Function CreateHalftonePalette Lib "GDI32.dll" (ByVal hdc As Long) As Long
Private Declare Function GetPaletteEntries Lib "GDI32.dll" (ByVal hPalette As Long, ByVal wStartIndex As Long, ByVal wNumEntries As Long, ByRef lpPaletteEntries As PaletteEntry) As Long
Private Declare Function CreatePalette Lib "GDI32.dll" (ByRef lpLogPalette As LogPalette8) As Long
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (ByRef PicDesc As Any, ByRef RefIID As Guid, ByVal fPictureOwnsHandle As Long, ByRef ipic As IPicture) As Long
Private Declare Function GetObjectType Lib "GDI32.dll" (ByVal hGDIObj As Long) As Long
Private Declare Function GetIconInfo Lib "user32.dll" (ByVal hIcon As Long, ByRef piconinfo As ICONINFO) As Long
Private Declare Function GetMetaFileBitsEx Lib "GDI32.dll" (ByVal hMF As Long, ByVal nSize As Long, ByRef lpvData As Any) As Long
Private Declare Function SetWinMetaFileBits Lib "GDI32.dll" (ByVal cbBuffer As Long, ByRef lpbBuffer As Byte, ByVal hDCRef As Long, lpMFP As MetaFilePict) As Long
Private Declare Function GetEnhMetaFileHeader Lib "GDI32.dll" (ByVal hEMF As Long, ByVal cbBuffer As Long, ByRef lpEMH As EnhMetaHeader) As Long
Private Declare Function DeleteEnhMetaFile Lib "GDI32.dll" (ByVal hEMF As Long) As Long
Private Declare Function DeleteMetaFile Lib "GDI32.dll" (ByVal hMF As Long) As Long
Private Declare Function DestroyIcon Lib "user32.dll" (ByVal hIcon As Long) As Long

Private Declare Function CreateEnhMetaFile Lib "GDI32.dll" Alias "CreateEnhMetaFileA" (ByVal hDCRef As Long, ByVal lpFileName As String, ByRef lpRect As Any, ByVal lpDescription As String) As Long
Private Declare Function CloseEnhMetaFile Lib "GDI32.dll" (ByVal hdc As Long) As Long
Private Declare Function PlayMetaFile Lib "GDI32.dll" (ByVal hdc As Long, ByVal hMF As Long) As Long
Private Declare Function GetDeviceCaps Lib "GDI32.dll" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function CreateIC Lib "GDI32.dll" Alias "CreateICA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, ByRef lpInitData As Any) As Long
Private Declare Function MulDiv Lib "Kernel32.dll" (ByVal nNumber As Long, ByVal nNumerator As Long, ByVal nDenominator As Long) As Long

Private Declare Function CreateStreamOnHGlobal Lib "OLE32.dll" (ByVal hGlobal As Long, ByVal fDeleteOnRelease As Long, ByRef ppStm As Any) As Long
Private Declare Function OleLoadPicture Lib "olepro32.dll" (ByRef pStream As Any, ByVal lSize As Long, ByVal fRunMode As Long, ByRef riid As Guid, ByRef ppvObj As Any) As Long
Private Declare Function GlobalAlloc Lib "Kernel32.dll" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalFree Lib "Kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Function GlobalLock Lib "Kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "Kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Sub RtlMoveMemory Lib "Kernel32.dll" (ByRef Destination As Any, ByRef Source As Any, ByVal length As Long)

Private Const LOGPIXELSX As Long = 88 ' Logical pixels/inch in X
Private Const LOGPIXELSY As Long = 90 ' Logical pixels/inch in Y

Private Type BitmapInfoHeader ' 40 bytes
    biSize As Long
    biWidth As Long
    biHeight As Long
    biPlanes As Integer
    biBitCount As Integer
    biCompression As Long
    biSizeImage As Long
    biXPelsPerMeter As Long
    biYPelsPerMeter As Long
    biClrUsed As Long
    biClrImportant As Long
End Type

Private Type BitmapInfo
    bmiHeader As BitmapInfoHeader
    bmiColors(255) As Long
End Type

Private Type Bitmap ' 24 bytes
    bmType As Long
    bmWidth As Long
    bmHeight As Long
    bmWidthBytes As Long
    bmPlanes As Integer
    bmBitsPixel As Integer
    bmBits As Long
End Type

Private Type PaletteEntry
    peRed As Byte
    peGreen As Byte
    peBlue As Byte
    peFlags As Byte
End Type

Private Type LogPalette8
    palVersion As Integer
    palNumEntries As Integer
    palPalEntry(0 To 255) As PaletteEntry
End Type

Public Enum enCopyBMPMode
    cbmSame = &H0
    cbmDDB = &H1
    cbmDIB = &H2
End Enum

Public Enum enCopyBMPStretchMode
    cbsmBlackOnWhite = &H1
    cbsmWhiteOnBlack = &H2
    cbsmColourOnColour = &H3
    cbsmHalftone = &H4
End Enum

Public Enum enCopyBMPFlags
    cbfUseDefaultPalette = &H1  ' Use the default halftone palette rather than existing or user-specified ones
    cbfReturnPalette = &H2      ' Return HPALETTE object back to caller (in inoutPalette parameter)
    cbfDestroyUserPalette = &H4 ' Destroy the input palette after use
    cbfUseHalftoneDither = &H8  ' Use halftone dither when mapping palette (overrides stretch mode)
End Enum


Private Type PictDescGeneirc
    pdgSize As Long
    pdcPicType As Long
    pdcHandle As Long
    pdcExtraA As Long ' xExt for metafile, hPal for Bitmap
    pdcExtraB As Long ' yExt for metafile
End Type

Private Type Guid
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type

Private Type ICONINFO
    fIcon As Long
    xHotspot As Long
    yHotspot As Long
    hbmMask As Long
    hbmColor As Long
End Type

Private Type MetaFilePict
    mm As Long
    xExt As Long
    yExt As Long
    hMF As Long
End Type

Private Type RectL
    Left As Long
    Top As Long
    right As Long
    bottom As Long
End Type

Private Type SizeL
    cx As Long
    cy As Long
End Type

Private Type EnhMetaHeader
    iType As Long
    nSize As Long
    rclBounds As RectL
    rclFrame As RectL
    dSignature As Long
    nVersion As Long
    nBytes As Long
    nRecords As Long
    nHandles As Integer
    sReserved As Integer
    nDescription As Long
    offDescription As Long
    nPalEntries As Long
    szlDevice As SizeL
    szlMillimeters As SizeL
End Type

Private Const OBJ_BITMAP As Long = &H7
Private Const OBJ_METAFILE As Long = &H9
Private Const OBJ_ENHMETAFILE As Long = &HD

Private Const PICTYPE_BITMAP As Long = &H1
Private Const PICTYPE_METAFILE As Long = &H2
Private Const PICTYPE_ICON As Long = &H3
Private Const PICTYPE_ENHMETAFILE As Long = &H4
Private Const GMEM_MOVEABLE As Long = &H2

Private Const S_OK As Long = &H0


Private Const DIB_RGB_COLORS As Long = &H0
Private Const BI_RGB As Long = &H0
Private Const BI_BITFIELDS As Long = &H3




Public Event quit()
Private Const MSG_WARNING As Long = 1
Private Const MSG_ERROR As Long = 2
Private Const MSG_INFO As Long = 3

Private Const CL_COLOR_ENABLED As Long = &H80000005
Private Const CL_COLOR_DISABLED As Long = &H8000000F

Private Const SEP As String = "®©"
Private Const SEP1 As String = "®"
Private Const SEP2 As String = "©"

Private Const C_TEMPDIR As String = "\Download\" ' temporary directory relative to executable

Private Const RP_GRCODE As Long = 2
Private Const RP_GRCODE_CATEGORY As Long = 6
Private Const RP_GRCODE_CLASS As Long = 7

Private Const C_MASTER_EXPANDED_ICON As String = "MINUS"
Private Const C_MASTER_COLAPSED_ICON As String = "PLUS"
Private Const C_MASTER_NO_DETAIL_ICON As String = "CLEAR"

Private ms_LanguageCode As String           ' Language code
Private ms_LanguageSubCode As String        ' Language sub code of language dependend items

Private ml_CurrRPiConcurrency As Long       ' iconcurreny of actual edited record RP_Reference_Project
Private ml_CurrRPcode As Long               ' code of actual edited record RP_Reference_Project
Private ml_CurrLIiConcurrency As Long       ' iconcurreny of actual edited record RP_LangInfo
Private ml_CurrRPDcode As Long
Private ml_CurrRPDiConcurrency As Long
Private mb_LoadingData As Boolean
Private mb_InitializedByLoad As Boolean
Private ms_MKS_Code As String
Private mb_TabGridLoaded(3) As Boolean
Private ml_UserCode As Long
Private ms_UserName As String                   ' user name for creator/last_upd
Private me_RPActiveScr As ArrRPScr
Private me_RPActiveSubScr As ArrRPSubScr
Private me_PROldActiveSubScr As ArrRPSubScr
Private mo_FSO As Object
Private mc_Cursor As Long
Private mb_HaveIntFlagRight As Boolean
Private ms_Area As String
Private ms_DocumentTitle As String
Private ml_Image() As Long

Private mt_CstValues As Type_CstValues          ' Structure which contains constants value 27.8.2008
Private ms_ConnectString As String              ' connect string required by ShowLink mw 27.8.2008

Private Enum ArrRPScr
    RPMain
    RPDtl
    RPAdd
    RPEdit
    RPRem
End Enum

Private Enum ArrRPSubScr
    RPSubProdMain
    RPSubProdAdd
    RPSubFreeMain
    RPSubFreeAdd
    RPSubDocMain
    RPSubDocAdd
    RPSubDocUpd
    RPSubCustMain
    RPSubCustAdd
End Enum

#If LIVE Then
    Dim mo_Db As Object
#Else
    Private mo_Db As ARMSYSCOMLib.ArmDb         ' ArmSysCom Library object
#End If


Private Enum ArmErr
    DBCnxFailed = vbObjectError + 1             ' Unable to connect to the database
    CPTAlreadyInitialized = vbObjectError + 2   ' We try to initialize a component that is already initialized
    CPTNotInitialized = vbObjectError + 3       ' We try to use or free that is not initialized yet
    InvalidArgument = vbObjectError + 4
    PropertyNotSet = vbObjectError + 5
    SQLFailure = vbObjectError + 6               ' A SQL runtime error has occured : syntax wrong....
    SQLBadRowAffectedCount = vbObjectError + 7   ' A SQL request has not affected the expected rowcount (ex: one Update do nothing)
    SQLBadRowExpectedCount = vbObjectError + 8   ' A SQL request does not return the expected rowcount : select an item return nothing...
    DrivingError = vbObjectError + 9
    CompFncFailed = vbObjectError + 10           ' when component function fail
    GridLoadFailed = vbObjectError + 11          ' load function failed ... bad sql
End Enum

Private Const SIFYB_RP_ERROR_MESSAGE = 2300


Private Enum ArmCusErr
    DuplicityDetected = vbObjectError + 2301                ' detected row with same unique id
End Enum


Private Enum ErrMsg
    ErrMsgNone = 0
    ErrMsgMandatoryAreEmpty = SIFYB_RP_ERROR_MESSAGE + 1
    WarMsgDoYouRemove = SIFYB_RP_ERROR_MESSAGE + 2
    ErrMsgIConcurency = SIFYB_RP_ERROR_MESSAGE + 3
    WarMsgSelectRow = SIFYB_RP_ERROR_MESSAGE + 4
    ErrMsgNumericRequired = SIFYB_RP_ERROR_MESSAGE + 5
    WarMsgItemExists = SIFYB_RP_ERROR_MESSAGE + 6
    ErrMsgAtLeastOneItemChecked = SIFYB_RP_ERROR_MESSAGE + 7
    ErrMsgFileDoesntExists = SIFYB_RP_ERROR_MESSAGE + 8
    ErrMsgNoPrimaryImageSelected = SIFYB_RP_ERROR_MESSAGE + 9
    ErrMsgTooManyPrimaryImageSelected = SIFYB_RP_ERROR_MESSAGE + 10
    ErrNotEnoughRights = SIFYB_RP_ERROR_MESSAGE + 11
    ErrMsgInvalidArea = SIFYB_RP_ERROR_MESSAGE + 12
    ErrMsgDroppeddArea = SIFYB_RP_ERROR_MESSAGE + 13
    ErrMsgInvalidResizeFormat = SIFYB_RP_ERROR_MESSAGE + 14         ' 22.6.2010 JN
End Enum


' User code used in logs
Public Property Let U_Code(ByVal al_UserCode As Long)
    ml_UserCode = al_UserCode
End Property

' User code used in logs
Public Property Get U_Code() As Long
    U_Code = ml_UserCode
End Property

' Set ConnectString mw 27.8.2008
Public Property Let ConnectString(ByVal as_ConnectString As String)
    ms_ConnectString = as_ConnectString
End Property

' Set Employees Movement screen
' ae_Screen (ArrEmpMovScr)
Private Property Let RPActiveScreen(ByVal ae_Screen As ArrRPScr)
On Error GoTo errHandler
    me_RPActiveScr = ae_Screen
    
    Select Case ae_Screen
        Case RPAdd, RPEdit
            tlb_RP_Tasks.DisplayFace "1" ' record screen (add, edit): validate, restore, exit
            Call tlb_RP_DocumentTasks.DisplayFace("0")          ' JN 15.6.2010
            fra_RP_Record.Visible = True
            fra_RP_Detail.Visible = True
            fra_RP_Main.Visible = False
        Case RPDtl
            tlb_RP_Tasks.DisplayFace "4" ' record screen (detail): exit
            Call tlb_RP_DocumentTasks.DisplayFace("1")          ' JN 15.6.2010
            fra_RP_Record.Visible = True
            fra_RP_Detail.Visible = True
            fra_RP_Main.Visible = False
        Case RPRem
            tlb_RP_Tasks.DisplayFace "2" ' record screen (remove): validate, exit
            Call tlb_RP_DocumentTasks.DisplayFace("1")          ' JN 15.6.2010
            fra_RP_Record.Visible = True
            fra_RP_Detail.Visible = True
            fra_RP_Main.Visible = False
        Case RPMain
            mb_TabGridLoaded(0) = False
            mb_TabGridLoaded(1) = False
            mb_TabGridLoaded(2) = False
            mb_TabGridLoaded(3) = False
            If mc_Cursor <> 0 Then
                mo_Db.Close mc_Cursor
                mc_Cursor = 0
            End If
            tlb_RP_Tasks.DisplayFace "0" ' main screen: add, update, del, lang, refresh, exit
            fra_RP_Main.Visible = True
            fra_RP_Record.Visible = False
    End Select
    
    tlb_RP_DocumentTasks.Visible = (ae_Screen = RPEdit Or ae_Screen = RPDtl Or ae_Screen = RPRem) ' And ms_LanguageCode = ms_LanguageSubCode
    tlb_RP_FreeTextTasks.Visible = ae_Screen = RPEdit And ms_LanguageCode = ms_LanguageSubCode
    tlb_RP_ProductTasks.Visible = ae_Screen = RPEdit And ms_LanguageCode = ms_LanguageSubCode
    tlb_RP_CustomersTasks.Visible = ae_Screen = RPEdit And ms_LanguageCode = ms_LanguageSubCode
    
    'grd_RP_Documents.Width = IIf(ae_Screen = RPEdit And ms_LanguageCode = ms_LanguageSubCode, 11655, 12495)
    grd_RP_Documents.Width = IIf(ae_Screen = RPEdit Or ae_Screen = RPDtl Or ae_Screen = RPRem, 11655, 12495)
    grd_RP_FreeText.Width = IIf(ae_Screen = RPEdit And ms_LanguageCode = ms_LanguageSubCode, 11655, 12495)
    grd_RP_Products.Width = IIf(ae_Screen = RPEdit And ms_LanguageCode = ms_LanguageSubCode, 11655, 12495)
    grd_RP_Customers.Width = IIf(ae_Screen = RPEdit And ms_LanguageCode = ms_LanguageSubCode, 11655, 12495)
    
    
    'grd_RP_Documents.Columns("RPD_Title").Width = IIf(ae_Screen = RPEdit And ms_LanguageCode = ms_LanguageSubCode, 10100, 10900)
'    grd_RP_Documents.Columns("RPD_Title").Width = IIf(ae_Screen = RPEdit, 9300, 10100)
    grd_RP_Documents.Columns("RPD_Title").Width = IIf(ae_Screen = RPEdit, 8000, 8000)
    grd_RP_FreeText.Columns("Product_URL").Width = IIf(ae_Screen = RPEdit And ms_LanguageCode = ms_LanguageSubCode, 4000, 7900)
    grd_RP_Products.Columns("BI_MKT_desc").Width = IIf(ae_Screen = RPEdit And ms_LanguageCode = ms_LanguageSubCode, 4100, 4900)
    grd_RP_Customers.Columns("CCU_desc").Width = IIf(ae_Screen = RPEdit And ms_LanguageCode = ms_LanguageSubCode, 3000, 4000)
   
    
     
    Select Case ae_Screen
        
        Case RPEdit, RPDtl, RPRem
             Select Case RPActiveSubScreen
                  Case RPSubCustAdd, RPSubCustMain
                     If Not mb_TabGridLoaded(3) Then
                        grd_RP_Customers.MasterDetailRequest = "EXEC RP_Customer_lst_detailReq '$CCU_capkey$', " & grd_RP_Main.SelectedKey(0)(0) & ", 'E'"
                         grd_RP_Customers.Load "EXEC RP_Customer_lst " & grd_RP_Main.SelectedKey(0)(0) & ", 'E'", False
                         mb_TabGridLoaded(3) = True
                     End If
                  Case RPSubDocAdd, RPSubDocMain, RPSubDocUpd
                     If Not mb_TabGridLoaded(2) Then
                         grd_RP_Documents.Load "RP_Document_lst " & grd_RP_Main.SelectedKey(0)(0) & ", " & RP_GRCODE & ", " & RP_GRCODE_CATEGORY & ", " & RP_GRCODE_CLASS & ", '" & ms_LanguageSubCode & "'", False
                         mb_TabGridLoaded(2) = True
                     End If
                  Case RPSubFreeAdd, RPSubFreeMain
                     If Not mb_TabGridLoaded(1) Then
                         grd_RP_FreeText.Load "RP_Product_Link_lst " & grd_RP_Main.SelectedKey(0)(0) & ", 'E'", False
                         mb_TabGridLoaded(1) = True
                     End If
                  Case RPSubDocAdd, RPSubProdAdd, RPSubProdMain
                     If Not mb_TabGridLoaded(0) Then
                         grd_RP_Products.Load "RP_BI_Marketing_Link_lst " & grd_RP_Main.SelectedKey(0)(0) & ", 'E'", False
                         mb_TabGridLoaded(0) = True
                     End If
            End Select
    End Select
    SetControlsState ae_Screen
        
    Exit Property
errHandler:
     Call ErrorHandler("SfbProRef.RPActiveScreen")
End Property

Private Property Get RPActiveScreen() As ArrRPScr
On Error GoTo errHandler
    RPActiveScreen = me_RPActiveScr
    Exit Property
errHandler:
     Call ErrorHandler("SfbProRef.RPActiveScreen")
End Property


' Set Employees Movement screen
' ae_Screen (ArrEmpMovScr)
Private Property Let RPActiveSubScreen(ByVal ae_Screen As ArrRPSubScr)
On Error GoTo errHandler
    me_RPActiveSubScr = ae_Screen
    
    Select Case ae_Screen
        Case RPSubDocMain
            If Not (RPActiveScreen = RPDtl Or RPActiveScreen = RPRem) Then
                tlb_RP_Tasks.DisplayFace "1"
            End If
            fra_RP_Document_Sub.Visible = False
            fra_RP_Document.Visible = True
            fra_RP_FreeText.Visible = False
            fra_RP_Product.Visible = False
            fra_RP_Customers.Visible = False
            fra_RP_Detail.Visible = True
        Case RPSubDocAdd
            tlb_RP_Tasks.DisplayFace "3" ' sub record screen (doc add): validate, exit
            ClearForm UserControl.Controls, fra_RP_Document_Sub, Array(cbo_RP_DocumentType)
            
            fra_RP_Document_Sub.Visible = True
            fra_RP_SelectFile.Visible = True
            cbo_RP_DocumentType.Enabled = ms_LanguageSubCode = "E"
            cbo_RP_DocumentCategory.Enabled = ms_LanguageSubCode = "E"
            cbo_RP_DocumentClass.Enabled = ms_LanguageSubCode = "E"
            cbo_RPD_Cat.Enabled = ms_LanguageSubCode = "E"
            cbo_DocLang.Enabled = ms_LanguageSubCode = "E"
            fra_RP_Detail.Visible = False
        
        Case RPSubDocUpd
            tlb_RP_Tasks.DisplayFace "3" ' sub record screen (doc upd): validate, exit
            fra_RP_Document_Sub.Visible = True
            fra_RP_SelectFile.Visible = False
            cbo_RP_DocumentType.Enabled = ms_LanguageSubCode = "E"
            cbo_RP_DocumentCategory.Enabled = ms_LanguageSubCode = "E"
            cbo_RP_DocumentClass.Enabled = ms_LanguageSubCode = "E"
            cbo_RPD_Cat.Enabled = ms_LanguageSubCode = "E"
            cbo_DocLang.Enabled = ms_LanguageSubCode = "E"
            fra_RP_Detail.Visible = False
            
        Case RPSubFreeMain
            If Not (RPActiveScreen = RPDtl Or RPActiveScreen = RPRem) Then
                tlb_RP_Tasks.DisplayFace "1"
            End If
            fra_RP_FreeText_Sub.Visible = False
            fra_RP_Document.Visible = False
            fra_RP_FreeText.Visible = True
            fra_RP_Product.Visible = False
            fra_RP_Customers.Visible = False
            fra_RP_Detail.Visible = True
        
        Case RPSubFreeAdd
            grd_RP_FreeTextStored.Load "RP_Product_lst  'E'", False
            tlb_RP_Tasks.DisplayFace "3" ' sub record screen (prod free add): validate, exit
            fra_RP_FreeText_Sub.Visible = True
            fra_RP_Detail.Visible = False
        Case RPSubProdMain
            If Not (RPActiveScreen = RPDtl Or RPActiveScreen = RPRem) Then
                tlb_RP_Tasks.DisplayFace "1"
            End If
            fra_RP_Document.Visible = False
            fra_RP_FreeText.Visible = False
            fra_RP_Product.Visible = True
            fra_RP_Customers.Visible = False
            fra_RP_Detail.Visible = True
        Case RPSubProdAdd
'            grd_RP_BIMarketing.Load "exec BI_Marketing_RP_lst 'E', " & SqlStr(txt_RP_CodesFrom.Text, True) & ", " & SqlStr(txt_RP_CodesTo.Text, True), False
            tlb_RP_Tasks.DisplayFace "3" ' sub record screen (prod codes add): validate, exit
            fra_RP_Detail.Visible = True
        Case RPSubCustMain
            If Not (RPActiveScreen = RPDtl Or RPActiveScreen = RPRem) Then
                tlb_RP_Tasks.DisplayFace "1"
            End If
            'fra_RP_Customers_Sub.Visible = False
            fra_RP_Document.Visible = False
            fra_RP_FreeText.Visible = False
            fra_RP_Product.Visible = False
            fra_RP_Customers.Visible = True
            fra_RP_Detail.Visible = True
        Case RPSubCustAdd
            ShowLink ("Add")
            ae_Screen = RPSubCustMain
            RPActiveSubScreen = RPSubCustMain
            fra_RP_Document.Visible = False
            fra_RP_FreeText.Visible = False
            fra_RP_Product.Visible = False
            fra_RP_Customers.Visible = True
        End Select
    
    
    
    ' loads data to sub grids
    
    Select Case ae_Screen
         Case RPSubDocAdd, RPSubDocMain, RPSubDocUpd
            If Not mb_TabGridLoaded(2) Then
                grd_RP_Documents.Load "RP_Document_lst " & grd_RP_Main.SelectedKey(0)(0) & ", " & RP_GRCODE & ", " & RP_GRCODE_CATEGORY & ", " & RP_GRCODE_CLASS & ", '" & ms_LanguageSubCode & "'", False
                mb_TabGridLoaded(2) = True
            End If
         Case RPSubFreeAdd, RPSubFreeMain
            If Not mb_TabGridLoaded(1) Then
                grd_RP_FreeText.Load "RP_Product_Link_lst " & grd_RP_Main.SelectedKey(0)(0) & ", 'E'", False
                mb_TabGridLoaded(1) = True
            End If
         Case RPSubDocAdd, RPSubProdAdd, RPSubProdMain
            If Not mb_TabGridLoaded(0) Then
                grd_RP_Products.Load "RP_BI_Marketing_Link_lst " & grd_RP_Main.SelectedKey(0)(0) & ", 'E'", False
                mb_TabGridLoaded(0) = True
            End If
         Case RPSubCustMain
            If Not mb_TabGridLoaded(3) Then
                grd_RP_Customers.MasterDetailRequest = "EXEC RP_Customer_lst_detailReq '$CCU_capkey$', " & grd_RP_Main.SelectedKey(0)(0) & ", 'E'"
                grd_RP_Customers.Load "RP_Customer_lst " & grd_RP_Main.SelectedKey(0)(0) & ", 'E'", False
                mb_TabGridLoaded(3) = True
            End If
   End Select
    
    
    tlb_RP_DocumentTasks.Visible = (RPActiveScreen = RPEdit Or RPActiveScreen = RPDtl Or RPActiveScreen = RPRem) And ae_Screen = RPSubDocMain ' And ms_LanguageCode = ms_LanguageSubCode
    tlb_RP_FreeTextTasks.Visible = RPActiveScreen = RPEdit And ae_Screen = RPSubFreeMain And ms_LanguageCode = ms_LanguageSubCode
    tlb_RP_ProductTasks.Visible = RPActiveScreen = RPEdit And ae_Screen = RPSubProdMain And ms_LanguageCode = ms_LanguageSubCode
    tlb_RP_CustomersTasks.Visible = RPActiveScreen = RPEdit And ae_Screen = RPSubCustMain And ms_LanguageCode = ms_LanguageSubCode
    
    'grd_RP_Documents.Width = IIf(RPActiveScreen = RPEdit And ae_Screen = RPSubDocMain And ms_LanguageCode = ms_LanguageSubCode, 11655, 12495)
    grd_RP_Documents.Width = IIf((RPActiveScreen = RPEdit Or RPActiveScreen = RPDtl Or RPActiveScreen = RPRem) And ae_Screen = RPSubDocMain, 11655, 12495)
    grd_RP_FreeText.Width = IIf(RPActiveScreen = RPEdit And ae_Screen = RPSubFreeMain And ms_LanguageCode = ms_LanguageSubCode, 11655, 12495)
    grd_RP_Products.Width = IIf(RPActiveScreen = RPEdit And ae_Screen = RPSubProdMain And ms_LanguageCode = ms_LanguageSubCode, 11655, 12495)
    grd_RP_Customers.Width = IIf(RPActiveScreen = RPEdit And ae_Screen = RPSubCustMain And ms_LanguageCode = ms_LanguageSubCode, 11655, 12495)
    
    'grd_RP_Documents.Columns("RPD_Title").Width = IIf(RPActiveScreen = RPEdit And ae_Screen = RPSubDocMain And ms_LanguageCode = ms_LanguageSubCode, 10100, 10900)
'    grd_RP_Documents.Columns("RPD_Title").Width = IIf(RPActiveScreen = RPEdit And ae_Screen = RPSubDocMain, 9300, 10100)
    grd_RP_Documents.Columns("RPD_Title").Width = IIf(RPActiveScreen = RPEdit And ae_Screen = RPSubDocMain, 8000, 8000)
    grd_RP_FreeText.Columns("Product_URL").Width = IIf(RPActiveScreen = RPEdit And ae_Screen = RPSubFreeMain And ms_LanguageCode = ms_LanguageSubCode, 4000, 7900)
    grd_RP_Products.Columns("BI_MKT_desc").Width = IIf(RPActiveScreen = RPEdit And ae_Screen = RPSubProdMain And ms_LanguageCode = ms_LanguageSubCode, 4100, 4900)
    grd_RP_Customers.Columns("CCU_desc").Width = IIf(RPActiveScreen = RPEdit And ae_Screen = RPSubCustMain And ms_LanguageCode = ms_LanguageSubCode, 3000, 4000)
     
    SetControlsSubState ae_Screen
        
    Exit Property
errHandler:
     Call ErrorHandler("SfbProRef.RPActiveSubScreen")
End Property

Private Property Get RPActiveSubScreen() As ArrRPSubScr
On Error GoTo errHandler
    RPActiveSubScreen = me_RPActiveSubScr
    Exit Property
errHandler:
     Call ErrorHandler("SfbProRef.RPActiveSubScreen")
End Property





' database controler property
' Params:
' ao_db (ARMSYSCOMLib.ArmDb) - ArmSysCom instance
#If LIVE Then
Public Property Set ArmDb(ByRef ao_DB As Object)
#Else
Public Property Set ArmDb(ByRef ao_DB As ARMSYSCOMLib.ArmDb)
#End If

On Error GoTo errHandler
    If Not mo_Db Is Nothing Then Err.Raise ArmErr.CPTAlreadyInitialized
    If ao_DB Is Nothing Then Err.Raise ArmErr.InvalidArgument
    
    Set mo_Db = ao_DB
    
    Exit Property
errHandler:
    Call ErrorHandler("ArmDb(Set)")
End Property


Public Property Let Language_Code(ByVal as_newValue As String)
On Error GoTo errHandler
    ms_LanguageCode = as_newValue
    cal_RP_InstallDate.Language = as_newValue
    tlb_RP_Tasks.Language = as_newValue
    tlb_RP_DocumentTasks.Language = as_newValue
    tlb_RP_FreeTextTasks.Language = as_newValue
    tlb_RP_ProductTasks.Language = as_newValue
    tlb_RP_CustomersTasks.Language = as_newValue
    cal_filtersMax.Language = as_newValue
    cal_FiltersMin.Language = as_newValue

    If mb_InitializedByLoad Then
        LoadLabels mo_Db, UserControl.Controls, "ref_pro", ms_LanguageCode
    End If
    
    Exit Property
errHandler:
     Call ErrorHandler("RP.Language_Code")
End Property

Private Function LoadToolbars() As Boolean
On Error GoTo errHandler
    
    Const CL_REQUEST_TB As String = "SELECT Toolbar_Info FROM Toolbars_Users WHERE User_Code=$user_id$ AND App_Id=$App_Id$"
    Dim lc_Toolbar As Long
    Dim ls_ToolbarRequest As String, ls_ToolbarInfo As String

    ls_ToolbarRequest = Replace(CL_REQUEST_TB, "$user_id$", 0)
    ls_ToolbarRequest = Replace(ls_ToolbarRequest, "$App_Id$", 1)
    lc_Toolbar = OpenSQLSafe(mo_Db, ls_ToolbarRequest)
    ls_ToolbarInfo = mo_Db.GetFields(lc_Toolbar, "Toolbar_info")
    
    ' init toolbar
    Call tlb_RP_Tasks.Load_A_Com
    Call tlb_RP_Tasks.SetToolbarInfoStringParameters(ls_ToolbarInfo, "084")
    Call tlb_RP_Tasks.DisplayFace("0")
    
    Call tlb_RP_ProductTasks.Load_A_Com
    Call tlb_RP_ProductTasks.SetToolbarInfoStringParameters(ls_ToolbarInfo, "085")
    Call tlb_RP_ProductTasks.DisplayFace("0")
    
    Call tlb_RP_FreeTextTasks.Load_A_Com
    Call tlb_RP_FreeTextTasks.SetToolbarInfoStringParameters(ls_ToolbarInfo, "086")
    Call tlb_RP_FreeTextTasks.DisplayFace("0")
      
    Call tlb_RP_DocumentTasks.Load_A_Com
    Call tlb_RP_DocumentTasks.SetToolbarInfoStringParameters(ls_ToolbarInfo, "087")
    Call tlb_RP_DocumentTasks.DisplayFace("0")
    
    Call tlb_RP_CustomersTasks.Load_A_Com
    Call tlb_RP_CustomersTasks.SetToolbarInfoStringParameters(ls_ToolbarInfo, "099")
    Call tlb_RP_CustomersTasks.DisplayFace("0")
    
    Call mo_Db.Close(lc_Toolbar)
    LoadToolbars = True
    Exit Function
errHandler:
    Call mo_Db.Close(lc_Toolbar)
    LoadToolbars = False
    Call ErrorHandler("LoadToolbars()")
End Function



Public Function Load_A_Com()
    On Error GoTo errHandler
Load_A_Com = False
    
    Call Resize
    
    mb_HaveIntFlagRight = GetRights()
    
    mc_Cursor = 0
    mb_LoadingData = False
    ms_LanguageSubCode = ms_LanguageCode
    me_RPActiveSubScr = RPSubProdMain
    mb_TabGridLoaded(0) = False
    mb_TabGridLoaded(1) = False
    mb_TabGridLoaded(2) = False
    mb_TabGridLoaded(3) = False
    
    Set mo_FSO = CreateObject("Scripting.FileSystemObject")
    
    ' init textboxes
    
    txt_RP_ConstructYear.MaxLength = 4
    txt_RP_Contractor.MaxLength = 50
    txt_RP_Architect.MaxLength = 50
    txt_RP_Desc.MaxLength = 99 ' must be one less because we add # for untranslated text
    txt_RP_Internet_Desc.MaxLength = 99 ' must be one less because we add # for untranslated text
    txt_RP_CustomerInfo.MaxLength = 999 ' must be one less because we add # for untranslated text
    txt_RP_Text.MaxLength = 999 ' must be one less because we add # for untranslated text
    txt_RP_Surface.MaxLength = 20
    txt_RP_DocumentTitle.MaxLength = 500
    txt_RP_Town.MaxLength = 40
    txt_spare1.MaxLength = 40
    txt_spare2.MaxLength = 40
    txt_spare3.MaxLength = 40
    txt_Spareint2.MaxLength = 20
    
    
    ' init calendar
    cal_RP_InstallDate.reinit_cal
    cal_RP_InstallDate.date_courte = Format(Now, "dd\/mm\/yyyy")
    
    cal_FiltersMin.Limited_as_embedded = 1
    cal_FiltersMin.Zorder
    cal_FiltersMin.reinit_cal
    cal_FiltersMin.date_courte = Format(Now, "dd\/mm\/yyyy")
    
    cal_filtersMax.Limited_as_embedded = 1
    cal_filtersMax.Zorder
    cal_filtersMax.reinit_cal
    cal_filtersMax.date_courte = Format(Now, "dd\/mm\/yyyy")
    
    Call LoadToolbars

    grd_RP_Main.Load_A_Com
    grd_RP_Main.Title = "#Project references"
    Set grd_RP_Main.ArmDb = mo_Db
    grd_RP_Main.MultiSelect = False
    grd_RP_Main.SetColumns (Array( _
        Join(Array("RP_code", 0, 1, "RP_code", "#Code"), SEP), _
        Join(Array("RP_InternetDesc", 2900, 0, "RP_InternetDesc", "#Internet Description"), SEP), _
        Join(Array("RP_Construct_Year", 700, 0, "RP_Construct_Year", "#Constuct Year"), SEP), _
        Join(Array("CT_Desc", 1700, 0, "CT_Desc", "#Country"), SEP), _
        Join(Array("MKS_desc", 1300, 0, "MKS_desc", "#Market Segmentation"), SEP), _
        Join(Array("RP_Town", 700, 0, "RP_Town", "#Town"), SEP), _
        Join(Array("CREATOR", 1200, 0, "RP_Creator", "#Creator"), SEP), _
        Join(Array("LAST_UPD", 1200, 0, "RP_Last_Upd", "#Last upadator"), SEP), _
        Join(Array("IFLAG", 200, 0, "Internet_Flag", "#Internet"), SEP) _
        ))
    
    grd_RP_Products.Load_A_Com
    grd_RP_Products.Title = "#Products by Codes"
    Set grd_RP_Products.ArmDb = mo_Db
    grd_RP_Products.MultiSelect = False
    grd_RP_Products.SetColumns (Array( _
        Join(Array("BI_MKT_Code", 1000, 1, "BI_MKT_Code", "#Short Code"), SEP), _
        Join(Array("CG_desc", 3000, 0, "CG_desc", "#Category"), SEP), _
        Join(Array("BI_MKT_desc", 7900, 0, "BI_MKT_desc", "#Description"), SEP), _
        Join(Array("SH_Desc", 1900, 0, "SH_Desc", "#Shape"), SEP), _
        Join(Array("Shape_Used", 1000, 0, "Shape_Used", "#Included", "BITMAP"), SEP)))
    
'    grd_RP_Products.SetColumns (Array( _
'        Join(Array("BI_MKT_Code", 1000, 1, "BI_MKT_Code", "#Short Code"), SEP), _
'        Join(Array("CG_desc", 3000, 0, "CG_desc", "#Category"), SEP), _
'        Join(Array("BI_MKT_desc", 7900, 0, "BI_MKT_desc", "#Description"), SEP), _
'        Join(Array("SH_Desc", 1900, 0, "SH_Desc", "#Shape"), SEP), _
'        Join(Array("Shape_Used", 1100, 0, "Shape_Used", "#Included"), SEP)))
    
    grd_RP_FreeText.Load_A_Com
    grd_RP_FreeText.Title = "#Products by Free Text"
    Set grd_RP_FreeText.ArmDb = mo_Db
    grd_RP_FreeText.MultiSelect = False
    grd_RP_FreeText.SetColumns (Array( _
        Join(Array("RPP_code", 0, 1, "RPP_code", "#Code"), SEP), _
        Join(Array("Product_Desc", 4000, 0, "Product_Desc", "#Description"), SEP), _
        Join(Array("Product_URL", 7900, 0, "Product_URL", "#URL"), SEP)))
        
'p615 add RPD_cat + doc Lang
    grd_RP_Documents.Load_A_Com
    grd_RP_Documents.Title = "#Documents"
    Set grd_RP_Documents.ArmDb = mo_Db
    grd_RP_Documents.MultiSelect = False
    grd_RP_Documents.SetColumns (Array( _
        Join(Array("RPD_Code", 0, 1, "RPD_Code", "#Code"), SEP), _
        Join(Array("RF_desc", 1000, 0, "RF_desc", "#Type"), SEP), _
        Join(Array("RPD_Title", 8000, 0, "RPD_Title", "#Document title"), SEP), _
        Join(Array("RPD_Sequence", 700, 0, "RPD_Sequence", "#Primary"), SEP), _
        Join(Array("IConcurrency", 0, 0, "IConcurrency", "#IConcurrency"), SEP), _
        Join(Array("RPD_type", 0, 0, "RPD_type", "#code"), SEP), _
        Join(Array("RPD_category", 0, 0, "RPD_category", "#code_category"), SEP), _
        Join(Array("RF_desc_category", 0, 0, "RF_desc_category", "#Category"), SEP), _
        Join(Array("RPD_class", 0, 0, "RPD_class", "#code_class"), SEP), _
        Join(Array("RF_desc_class", 0, 0, "RF_desc_class", "#Class"), SEP), _
        Join(Array("IFLAG", 0, 0, "Internet_Flag", "#IF"), SEP), _
        Join(Array("RPD_Cat", 0, 0, "RPD_Cat", "#Code_indicator"), SEP), _
        Join(Array("RPD_Cat_desc", 0, 0, "RPD_Cat_desc", "#Indicator_desc"), SEP), _
        Join(Array("DocLang", 0, 0, "DocLang", "#Language"), SEP), _
        Join(Array("DocLang_Desc", 1000, 0, "DocLang_Desc", "#Language"), SEP), _
        Join(Array("RPD_Code_small", 0, 0, "RPD_Code_small", "#RPD_Code_small"), SEP) _
        ))

    grd_RP_Customers.Load_A_Com
    grd_RP_Customers.Title = "#Customers"
    Set grd_RP_Customers.ArmDb = mo_Db
    grd_RP_Customers.MultiSelect = False
    grd_RP_Customers.FreeSelect = True
    grd_RP_Customers.SetColumns (Array( _
        Join(Array("CCU_capkey", 0, 1, "CCU_capkey", "#CapKey"), SEP), _
        Join(Array("CCU_desc", 1400, 0, "CCU_desc", "#Desc"), SEP), _
        Join(Array("CPR_code", 0, 1, "CPR_code", "#CPR_Code"), SEP), _
        Join(Array("CPR_desc", 1200, 0, "CPR_desc", "#Project Role"), SEP), _
        Join(Array("CCU_zip", 900, 0, "CCU_zip", "#Zip"), SEP), _
        Join(Array("CCU_town", 1500, 0, "CCU_town", "#Town"), SEP), _
        Join(Array("CCU_tel", 1500, 0, "CCU_tel", "#Tel"), SEP), _
        Join(Array("CT_desc", 1500, 0, "CT_desc", "#Country"), SEP), _
        Join(Array("MasterDetail", 250, 0, "", "", "BITMAP"), SEP), _
        Join(Array("isMaster", 0, 0, "isMaster", "#isMaster"), SEP), _
        Join(Array("detailCount", 0, 0, "detailCount", "#detailCount"), SEP), _
        Join(Array("CTA_desc", 1300, 0, "CTA_Desc", "#Attribute"), SEP)))
    
    grd_RP_Customers.RequestLoadDetails = False
    grd_RP_Customers.MasterDetailSetting = Join(Array("isMaster", "MasterDetail", "detailCount", "1", "0", RGB(255, 255, 255), RGB(230, 230, 230), C_MASTER_EXPANDED_ICON, C_MASTER_COLAPSED_ICON, C_MASTER_NO_DETAIL_ICON), SEP)

'    grd_RP_BIMarketing.Load_A_Com
'    grd_RP_BIMarketing.Title = "#BI Marketing Products"
'    Set grd_RP_BIMarketing.ArmDb = mo_Db
'    grd_RP_BIMarketing.MultiSelect = False
'    grd_RP_BIMarketing.SetColumns (Array( _
'        Join(Array("CG_desc", 2000, 0, "CG_desc", "#Category"), SEP), _
'        Join(Array("BM_desc", 1500, 0, "BM_desc", "#Base material"), SEP), _
'        Join(Array("PF_desc", 1500, 0, "PF_desc", "#Product families"), SEP), _
'        Join(Array("BI_MKT_Code", 1000, 1, "BI_MKT_Code", "#Short Code"), SEP), _
'        Join(Array("BI_MKT_desc", 5900, 0, "BI_MKT_desc", "#Description"), SEP), _
'        Join(Array("SH_Desc", 0, 0, "SH_Desc", "#Shape"), SEP) _
'        ))
    
    
    
    grd_RP_FreeTextStored.Load_A_Com
    grd_RP_FreeTextStored.Title = "#Stored Products by Free Text"
    Set grd_RP_FreeTextStored.ArmDb = mo_Db
    grd_RP_FreeTextStored.MultiSelect = False
    grd_RP_FreeTextStored.SetColumns (Array( _
        Join(Array("RPP_code", 0, 1, "RPP_code", "#Code"), SEP), _
        Join(Array("Product_Desc", 4000, 0, "Product_Desc", "#Description"), SEP), _
        Join(Array("Product_URL", 7900, 0, "Product_URL", "#URL"), SEP)))
    
    
    ' init document type combo box
    Set cbo_RP_DocumentType.ArmDb = mo_Db
    cbo_RP_DocumentType.Load_A_Com
    cbo_RP_DocumentType.FirstBlankItem = False
    cbo_RP_DocumentType.Request = "A_Referencies_ML_RP_cbo  " & RP_GRCODE & ", 'E'"
    
    ' init document category combo box
    Set cbo_RP_DocumentCategory.ArmDb = mo_Db
    cbo_RP_DocumentCategory.Load_A_Com
    cbo_RP_DocumentCategory.FirstBlankItem = True
    cbo_RP_DocumentCategory.Request = "A_Referencies_ML_RP_cbo  " & RP_GRCODE_CATEGORY & ", 'E'"
    
    ' init document class combo box
    Set cbo_RP_DocumentClass.ArmDb = mo_Db
    cbo_RP_DocumentClass.Load_A_Com
    cbo_RP_DocumentClass.FirstBlankItem = True
    cbo_RP_DocumentClass.Request = "A_Referencies_ML_RP_cbo  " & RP_GRCODE_CLASS & ", 'E'"
    
'P615 init document category indicator + document language
    Set cbo_RPD_Cat.ArmDb = mo_Db
    cbo_RPD_Cat.Load_A_Com
'    cbo_RPD_Cat.FirstBlankItem = True
    cbo_RPD_Cat.Request = "A_Referencies_ML_RP_cbo  " & "211, 'E'"
' Load Array for knowing if Image or not
    
    Call ImageArray
    
    Set cbo_DocLang.ArmDb = mo_Db
    cbo_DocLang.Load_A_Com
    cbo_DocLang.FirstBlankItem = True
'    cbo_DocLang.Request = "Language_cbo"
    cbo_DocLang.Request = "Media_Language_cbo"
'p615 end

    ' init market segmentation combo box
    Set cbo_RP_MarketSeg.ArmDb = mo_Db
    cbo_RP_MarketSeg.Load_A_Com
    cbo_RP_MarketSeg.FirstBlankItem = False
    cbo_RP_MarketSeg.Request = "Market_Segmentation_cbo 'E'"
    
    
    ' init country combo box
    Set cbo_RP_Country.ArmDb = mo_Db
    cbo_RP_Country.Load_A_Com
    cbo_RP_Country.FirstBlankItem = False
    cbo_RP_Country.Request = "Countries_RP_cbo 'E'"
    
    
    ' init recommended area check view
    Set cvw_RP_RecommendedArea.ArmDb = mo_Db
    cvw_RP_RecommendedArea.Load_A_Com
    cvw_RP_RecommendedArea.RoleCount = 2
    cvw_RP_RecommendedArea.Driven_By = "test"
    cvw_RP_RecommendedArea.Common_List_Load = True
    cvw_RP_RecommendedArea.Type_Of_Key = tkDependant
'    cvw_RP_RecommendedArea.Calling_Key_Fields = "MKSCode®©LangCode®©RPCode®©ZUCode"
'    cvw_RP_RecommendedArea.Calling_Key_Fields = "RPDCode®©LangCode®©RPCode®©ZUCode"
    cvw_RP_RecommendedArea.Calling_Key_Fields = "RPDCode®©LangCode®©RPCode®©ZUCode®©MKSCode"
    cvw_RP_RecommendedArea.Calling_Key_Values = "®©E®©®©" & ml_UserCode & "®©"
    cvw_RP_RecommendedArea.Link_Key_Fields = "RA_code"
    cvw_RP_RecommendedArea.ComboVisible = False
'P615 avant
'    If Not cvw_RP_RecommendedArea.SetRoleList(Array( _
'    Array("MAIN", "VIEW", "", "", "Main view", "RA_code®©RA_desc", "RA_desc", "3500", "RA_code", "exec RP_MKS_RA_Link_lst '$LangCode$', '$MKSCode$', $RPCode$", "exec RP_MKS_RA_Link_ins $RPCode$, '$MKSCode$', '$RA_code$', '$LangCode$', $ZUCode$", "exec RP_MKS_RA_Link_del $RPCode$, '$MKSCode$', '$RA_code$'", True, 2, False, True, 0, 1), _
'    Array("CHEC", "EDIT", "", "", "#Specifier", "RA_code®©RA_desc", "RA_desc", "3500", "RA_code", "exec Recommended_Area_RP_lst '$LangCode$', '$MKSCode$'", "exec RP_MKS_RA_Link_ins $RPCode$, '$MKSCode$', '$RA_code$', '$LangCode$', $ZUCode$", "exec RP_MKS_RA_Link_del $RPCode$, '$MKSCode$', '$RA_code$'", False, 2, False, True, 1, 1) _
'    )) Then

'P615
'    If Not cvw_RP_RecommendedArea.SetRoleList(Array( _
'    Array("MAIN", "VIEW", "", "", "Main view", "RA_code®©RA_desc", "RA_desc", "3500", "RA_code", "exec RP_Document_RA_Link_lst '$LangCode$', '$RPDCode$', $RPCode$", "exec RP_Document_RA_Link_ins $RPCode$, '$RPDCode$', '$RA_code$', $ZUCode$", "exec RP_Document_RA_Link_del $RPCode$, '$RPDCode$', '$RA_code$'", True, 2, False, True, 0, 1), _
'    Array("CHEC", "EDIT", "", "", "#Specifier", "RA_code®©RA_desc", "RA_desc", "3500", "RA_code", "exec Recommended_Area_t_lst '$LangCode$'", "exec RP_Document_RA_Link_ins $RPCode$, '$RPDCode$', '$RA_code$', $ZUCode$", "exec RP_Document_RA_Link_del $RPCode$, '$RPDCode$', '$RA_code$'", False, 2, False, True, 1, 1) _
'    )) Then
    If Not cvw_RP_RecommendedArea.SetRoleList(Array( _
    Array("MAIN", "VIEW", "", "", "Main view", "RA_code®©RA_desc®©drop_flag", "RA_desc", "3500", "RA_code", "exec RP_Document_RA_Link_lst '$LangCode$', '$RPDCode$', $RPCode$", "exec RP_Document_RA_Link_ins $RPCode$, '$RPDCode$', '$RA_code$', $ZUCode$", "exec RP_Document_RA_Link_del $RPCode$, '$RPDCode$', '$RA_code$'", True, 2, False, True, 0, 1), _
    Array("CHEC", "EDIT", "", "", "#Specifier", "RA_code®©RA_desc®©drop_flag", "RA_desc", "3500", "RA_code", "exec Recommended_Area_RP_lst '$LangCode$', '$MKSCode$'", "exec RP_Document_RA_Link_ins $RPCode$, '$RPDCode$', '$RA_code$', $ZUCode$", "exec RP_Document_RA_Link_del $RPCode$, '$RPDCode$', '$RA_code$'", False, 2, False, True, 1, 1) _
    )) Then

        Err.Raise CompFncFailed, "cvw_RP_RecommendedArea.SetRoleList", "Setting CheckView parameters failed."
    End If
    
    cvw_RP_RecommendedArea.Synchronize_View = True
    cvw_RP_RecommendedArea.SetVisibleList "CHEC"
    cvw_RP_RecommendedArea.LoadList
    
    Set cvw_RP_RPExcludedCountries.ArmDb = mo_Db
    cvw_RP_RPExcludedCountries.Load_A_Com
    cvw_RP_RPExcludedCountries.RoleCount = 2
    cvw_RP_RPExcludedCountries.Driven_By = "Reference_Project"
    cvw_RP_RPExcludedCountries.Common_List_Load = True
    cvw_RP_RPExcludedCountries.Type_Of_Key = tkDependant
    cvw_RP_RPExcludedCountries.Calling_Key_Fields = "RP_Code®©Language_Code"
    cvw_RP_RPExcludedCountries.Calling_Key_Values = "®©E"
    cvw_RP_RPExcludedCountries.Link_Key_Fields = "CT_Code"
    cvw_RP_RPExcludedCountries.ComboVisible = False
    If Not cvw_RP_RPExcludedCountries.SetRoleList(Array( _
    Array("MAIN", "VIEW", "", "", "Main view", "CT_Code®©CT_desc", "CT_desc", "3200", "CT_Code", "exec RP_ExCountries_lst $RP_Code$,'$Language_Code$'", "exec RP_ExCountries_ins $RP_Code$, '$CT_Code$'," & ml_UserCode, "exec RP_ExCountries_del $RP_Code$, '$CT_Code$'", True, 2, False, True, 0, 1), _
    Array("CHEC", "EDIT", "", "", "#Edit", "CT_Code®©CT_desc", "CT_desc", "3200", "CT_Code", "exec Ref_Zip_Countries_lst '$Language_Code$'", "exec RP_ExCountries_ins $RP_Code$, '$CT_Code$'," & ml_UserCode, "exec RP_ExCountries_del $RP_Code$, '$CT_Code$'", False, 2, False, True, 1, 1) _
    )) Then
        Err.Raise CompFncFailed, "cvw_RP_RPExcludedCountries.SetRoleList", "Setting CheckView parameters failed."
    End If
    
    cvw_RP_RPExcludedCountries.Synchronize_View = True
    cvw_RP_RPExcludedCountries.SetVisibleList "CHEC"
    cvw_RP_RPExcludedCountries.LoadList
    
    Set cbo_FiltersCountry.ArmDb = mo_Db
    Call cbo_FiltersCountry.Load_A_Com
    cbo_FiltersCountry.FirstBlankItem = True
    cbo_FiltersCountry.Request = "EXEC RP_Countries_cbo '" & ms_LanguageCode & "'"

    ms_UserName = GetUserName(ml_UserCode)
    Call Init_control
        
    LoadLabels mo_Db, UserControl.Controls, "ref_pro", ms_LanguageCode
    
    ' for export excell functionality
    Call Init_UserInfo(mo_Db, prg.LoginName)

    ' loads data to grid
    LoadGrid
    
    mb_InitializedByLoad = True
    Load_A_Com = True
   
    
    Exit Function
errHandler:
    Call ErrorHandler("SfbRefPro.Load_A_Com")
End Function

Private Sub Init_control()
On Error GoTo errHandler
    Dim ll_margin As Long
    ll_margin = 60
    
    ' set control size
    Call grd_RP_Main.Move(fra_FiltersDate.Left + fra_FiltersDate.Width + ll_margin, fra_FiltersDate.Top, fra_RP_Main.Width - (fra_FiltersDate.Left + fra_FiltersDate.Width + 2 * ll_margin))
    Call fra_RP_Record.Move(tlb_RP_Tasks.Left, tlb_RP_Tasks.Top + tlb_RP_Tasks.Height + ll_margin)
    Exit Sub
errHandler:
    Call ErrorHandler("SfbRefPro.Init_Control")
End Sub

' unload variables, uninitialize component
Public Sub Unload_A_Com()
On Error GoTo errHandler
    
    grd_RP_Main.Unload_A_Com
    grd_RP_Documents.Unload_A_Com
    grd_RP_FreeText.Unload_A_Com
    grd_RP_Products.Unload_A_Com
'    grd_RP_BIMarketing.Unload_A_Com
    grd_RP_FreeTextStored.Unload_A_Com
    grd_RP_Customers.Unload_A_Com
    
    cbo_RP_Country.Unload_A_Com
    cbo_RP_MarketSeg.Unload_A_Com
    cbo_RP_DocumentType.Unload_A_Com
    tlb_RP_Tasks.Unload_A_Com
    tlb_RP_DocumentTasks.Unload_A_Com
    tlb_RP_FreeTextTasks.Unload_A_Com
    tlb_RP_ProductTasks.Unload_A_Com
    tlb_RP_CustomersTasks.Unload_A_Com
    cvw_RP_RecommendedArea.Unload_A_Com
    cvw_RP_RPExcludedCountries.Unload_A_Com
    Call cbo_FiltersCountry.Unload_A_Com
    
    If mc_Cursor <> 0 Then
        mo_Db.Close mc_Cursor
        mc_Cursor = 0
    End If
    Set mo_FSO = Nothing
    Set mo_Db = Nothing
    
    Exit Sub
errHandler:
     Call ErrorHandler("SfbProRef.Unload_A_COM")
End Sub



' Sets controls state
Private Sub SetControlsState(ByVal ae_Screen As ArrRPScr)
On Error GoTo errHandler
    txt_RP_Architect.BackColor = IIf(ae_Screen = RPDtl Or ae_Screen = RPRem Or Not ms_LanguageCode = ms_LanguageSubCode, CL_COLOR_DISABLED, CL_COLOR_ENABLED)
    txt_RP_ConstructYear.BackColor = IIf(ae_Screen = RPDtl Or ae_Screen = RPRem Or Not ms_LanguageCode = ms_LanguageSubCode, CL_COLOR_DISABLED, CL_COLOR_ENABLED)
    txt_RP_Contractor.BackColor = IIf(ae_Screen = RPDtl Or ae_Screen = RPRem Or Not ms_LanguageCode = ms_LanguageSubCode, CL_COLOR_DISABLED, CL_COLOR_ENABLED)
    txt_RP_CustomerInfo.BackColor = IIf(ae_Screen = RPDtl Or ae_Screen = RPRem, CL_COLOR_DISABLED, CL_COLOR_ENABLED)
    txt_RP_Desc.BackColor = IIf(ae_Screen = RPDtl Or ae_Screen = RPRem, CL_COLOR_DISABLED, CL_COLOR_ENABLED)
    txt_RP_Internet_Desc.BackColor = IIf(ae_Screen = RPDtl Or ae_Screen = RPRem, CL_COLOR_DISABLED, CL_COLOR_ENABLED)
    txt_RP_Surface.BackColor = IIf(ae_Screen = RPDtl Or ae_Screen = RPRem Or Not ms_LanguageCode = ms_LanguageSubCode, CL_COLOR_DISABLED, CL_COLOR_ENABLED)
    txt_RP_Text.BackColor = IIf(ae_Screen = RPDtl Or ae_Screen = RPRem, CL_COLOR_DISABLED, CL_COLOR_ENABLED)
    txt_RP_Town.BackColor = IIf(ae_Screen = RPDtl Or ae_Screen = RPRem, CL_COLOR_DISABLED, CL_COLOR_ENABLED)
    txt_spare1.BackColor = IIf(ae_Screen = RPDtl Or ae_Screen = RPRem, CL_COLOR_DISABLED, CL_COLOR_ENABLED)
    txt_spare2.BackColor = IIf(ae_Screen = RPDtl Or ae_Screen = RPRem, CL_COLOR_DISABLED, CL_COLOR_ENABLED)
    txt_spare3.BackColor = IIf(ae_Screen = RPDtl Or ae_Screen = RPRem, CL_COLOR_DISABLED, CL_COLOR_ENABLED)
    txt_Spareint2.BackColor = IIf(ae_Screen = RPDtl Or ae_Screen = RPRem, CL_COLOR_DISABLED, CL_COLOR_ENABLED)
    
    txt_RP_Architect.Enabled = (ae_Screen = RPAdd Or ae_Screen = RPEdit) And ms_LanguageCode = ms_LanguageSubCode
    txt_RP_ConstructYear.Enabled = (ae_Screen = RPAdd Or ae_Screen = RPEdit) And ms_LanguageCode = ms_LanguageSubCode
    txt_RP_Contractor.Enabled = (ae_Screen = RPAdd Or ae_Screen = RPEdit) And ms_LanguageCode = ms_LanguageSubCode
    txt_RP_CustomerInfo.Enabled = ae_Screen = RPAdd Or ae_Screen = RPEdit
    txt_RP_Desc.Enabled = ae_Screen = RPAdd Or ae_Screen = RPEdit
    txt_RP_Internet_Desc.Enabled = ae_Screen = RPAdd Or ae_Screen = RPEdit
    txt_RP_Surface.Enabled = (ae_Screen = RPAdd Or ae_Screen = RPEdit) And ms_LanguageCode = ms_LanguageSubCode
    txt_RP_Text.Enabled = ae_Screen = RPAdd Or ae_Screen = RPEdit
'    txt_RP_Town.Enabled = (ae_Screen = RPAdd Or ae_Screen = RPEdit) And ms_LanguageCode = ms_LanguageSubCode
    txt_spare1.Enabled = (ae_Screen = RPAdd Or ae_Screen = RPEdit) And ms_LanguageCode = ms_LanguageSubCode
    txt_spare2.Enabled = (ae_Screen = RPAdd Or ae_Screen = RPEdit) And ms_LanguageCode = ms_LanguageSubCode
    txt_spare3.Enabled = (ae_Screen = RPAdd Or ae_Screen = RPEdit) And ms_LanguageCode = ms_LanguageSubCode
    txt_Spareint2.Enabled = (ae_Screen = RPAdd Or ae_Screen = RPEdit) And ms_LanguageCode = ms_LanguageSubCode
    
    cvw_RP_RecommendedArea.SetVisibleList IIf(ae_Screen = RPDtl Or ae_Screen = RPRem Or Not ms_LanguageCode = ms_LanguageSubCode, "MAIN", "CHEC")
    cvw_RP_RPExcludedCountries.SetVisibleList IIf(ae_Screen = RPDtl Or ae_Screen = RPRem Or Not ms_LanguageCode = ms_LanguageSubCode, "MAIN", "CHEC")
    
    chk_RP_InternetFlag.Enabled = mb_HaveIntFlagRight And (ae_Screen = RPAdd Or ae_Screen = RPEdit) And ms_LanguageCode = ms_LanguageSubCode
    chk_RP_RestrictedInternet.Enabled = (ae_Screen = RPAdd Or ae_Screen = RPEdit) And ms_LanguageCode = ms_LanguageSubCode

    cbo_RP_Country.Enabled = (ae_Screen = RPAdd Or ae_Screen = RPEdit) And ms_LanguageCode = ms_LanguageSubCode
    cbo_RP_MarketSeg.Enabled = (ae_Screen = RPAdd Or ae_Screen = RPEdit) And ms_LanguageCode = ms_LanguageSubCode
    
    cal_RP_InstallDate.Enabled = (ae_Screen = RPAdd Or ae_Screen = RPEdit) And ms_LanguageCode = ms_LanguageSubCode
    
    

    
    tbs_RP_Products.Visible = ae_Screen = RPDtl Or ae_Screen = RPEdit Or ae_Screen = RPRem
    fra_RP_Document.Visible = (ae_Screen = RPDtl Or ae_Screen = RPEdit Or ae_Screen = RPRem) And (RPActiveSubScreen = RPSubDocMain Or RPActiveSubScreen = RPSubDocAdd Or RPActiveSubScreen = RPSubDocUpd)
    fra_RP_FreeText.Visible = (ae_Screen = RPDtl Or ae_Screen = RPEdit Or ae_Screen = RPRem) And (RPActiveSubScreen = RPSubFreeMain Or RPActiveSubScreen = RPSubFreeAdd)
    fra_RP_Product.Visible = (ae_Screen = RPDtl Or ae_Screen = RPEdit Or ae_Screen = RPRem) And (RPActiveSubScreen = RPSubProdMain Or RPActiveSubScreen = RPSubProdAdd)
    fra_RP_Customers.Visible = (ae_Screen = RPDtl Or ae_Screen = RPEdit Or ae_Screen = RPRem) And (RPActiveSubScreen = RPSubCustMain Or RPActiveSubScreen = RPSubCustAdd)
    
    btn_checkAll.Visible = (ae_Screen = RPAdd Or ae_Screen = RPEdit)
    btn_uncheckAll.Visible = (ae_Screen = RPAdd Or ae_Screen = RPEdit)
    
    Exit Sub
errHandler:
     Call ErrorHandler("SfbRefPro.SetControlsState")
End Sub

' Sets controls state
Private Sub SetControlsSubState(ByVal ae_Screen As ArrRPScr)
On Error GoTo errHandler
    Select Case ae_Screen
        Case RPSubDocMain, RPSubFreeMain, RPSubProdMain, RPSubCustMain
            SetControlsState IIf(RPActiveScreen = RPDtl Or RPActiveScreen = RPRem, RPDtl, RPEdit)
        Case RPSubDocAdd, RPSubFreeAdd, RPSubProdAdd, RPSubDocUpd, RPSubCustAdd
            SetControlsState RPDtl
        
    End Select
    
    tbs_RP_Products.Enabled = ae_Screen = RPSubDocMain Or ae_Screen = RPSubProdMain Or ae_Screen = RPSubFreeMain Or ae_Screen = RPSubCustMain
    
    
    
    
    Exit Sub
errHandler:
     Call ErrorHandler("SfbRefPro.SetControlsSubState")
End Sub


Private Function HasContainer(ByRef aControl As Control, ByRef aContainer As Object) As Boolean
    HasContainer = False
    Dim lControl As Control
 
    Set lControl = aControl
    While Not (lControl Is Nothing)
        On Error GoTo NotFound
        If lControl.Container Is aContainer Then
            Set lControl = Nothing
            HasContainer = True
            Exit Function
        End If
        Set lControl = lControl.Container
    Wend
 
NotFound:
    Set lControl = Nothing
    HasContainer = False
End Function
 
Private Function IsSub(ByVal av_Name As Object, ByRef aav_Names As Variant)
On Error GoTo errHandler
    IsSub = False
    
    Dim ll_Idx As Long
    For ll_Idx = LBound(aav_Names) To UBound(aav_Names)
    
        If av_Name Is aav_Names(ll_Idx) Then
            IsSub = True
            Exit Function
        End If
    Next ll_Idx
    Exit Function
errHandler:
    Call ErrorHandler("SfbRefPro.IsSub")
End Function
 
' Apply default value on a screen
Private Sub ClearForm(ByRef aControls As Variant, ByRef aContainer As Object, Optional ByRef aav_Except As Variant)
 
    'mb_internal = True
 
    Dim lIdx As Long, lCount As Long, lControl As Object
    lCount = aControls.Count - 1
    For lIdx = 0 To lCount
        Dim lb_Process As Boolean
        lb_Process = True
        Set lControl = aControls.Item(lIdx)
        If Not IsMissing(aav_Except) Then
            If IsSub(lControl, aav_Except) Then
                lb_Process = False
            End If
        End If
        If HasContainer(lControl, aContainer) And lb_Process Then
            Select Case UCase(TypeName(lControl))
                Case "TEXTBOX"
                    lControl.Text = ""
                Case "ARMCOMBOBOX"
                    Set lControl.SelectedItem = Nothing
                Case "A_CALOCX"
                    lControl.reinit_cal
                Case "CHECKBOX"
                    lControl.Value = vbUnchecked
                Case "ARMCHECKVIEW"
                    lControl.UnCheckAll lControl.GetVisibleList
                    Dim ll_Idx As Long
                    For ll_Idx = 1 To lControl.RoleCount
                        lControl.RoleList(ll_Idx).ClearList
                    Next
                    lControl.SetVisibleList lControl.GetVisibleList
                    
                Case "FRAME", "LABEL", "TOOLBARCONTROL", "PICTUREBOX", "COMMANDBUTTON"
 
                Case "ARMGRID"
                    lControl.ClearGrid
                Case "LISTBOX"
                    lControl.ListIndex = -1
                Case "OPTIONBUTTON"
                    Dim lValues As Variant
                    lValues = Split(lControl.Tag, SEP)
                    lControl.Value = lValues(1)
                Case "TABSTRIP", "DRIVELISTBOX", "DIRLISTBOX", "FILELISTBOX"
 
                Case Else
                    Debug.Print "ClearForm " & UCase(TypeName(lControl))
            End Select
        End If
 
        Set lControl = Nothing
    Next
 
   ' mb_internal = False
End Sub

' Cancels typing of record
Private Sub RPCancel(ByVal ab_checkPrimImage As Boolean)
On Error GoTo errHandler
    Dim le_Msg As ErrMsg
    If ab_checkPrimImage Then
        le_Msg = ValidateDocuments()
        Select Case le_Msg
            Case ErrMsgNoPrimaryImageSelected
                If grd_RP_Documents.Rows > 1 Then
                    ASC_SendMessage ms_LanguageCode, ErrMsgNoPrimaryImageSelected, "#No primary image selected."
                    Exit Sub
                Else
                    ' make sequence to primary image
                    Call RPUpdateSequence(ml_CurrRPcode, grd_RP_Documents.Data(0, "RPD_code"))
                End If
            Case ErrMsgTooManyPrimaryImageSelected
                ASC_SendMessage ms_LanguageCode, ErrMsgTooManyPrimaryImageSelected, "#Too many primary images selected."
                Exit Sub
        End Select
    End If
    
    ' we can leave the screen
    RPActiveScreen = RPMain
    Exit Sub
errHandler:
     Call ErrorHandler("SfbProRef.RPCancel")
End Sub

' Cancels adding of new product by code
Private Sub RPProductCancel()
On Error GoTo errHandler
    RPActiveSubScreen = RPSubProdMain
    Exit Sub
errHandler:
     Call ErrorHandler("SfbProRef.RPProductCancel")
End Sub


' Cancels typing of new document
Private Sub RPDocumentCancel()
On Error GoTo errHandler
    RPActiveSubScreen = RPSubDocMain
    Exit Sub
errHandler:
     Call ErrorHandler("SfbProRef.RPDocumentCancel")
End Sub

' Cancels typing of new document
Private Sub RPFreeTextCancel()
On Error GoTo errHandler
    RPActiveSubScreen = RPSubFreeMain
    Exit Sub
errHandler:
     Call ErrorHandler("SfbProRef.RPFreeTextCancel")
End Sub

' Cancels typing of new document
Private Sub RPCustomerCancel()
On Error GoTo errHandler
    RPActiveSubScreen = RPSubCustMain
    Exit Sub
errHandler:
     Call ErrorHandler("SfbProRef.RPCustomerCancel")
End Sub

Private Sub RPDefaultValues()
On Error GoTo errHandler
    mb_LoadingData = True
    
    cvw_RP_RPExcludedCountries.Calling_Key_Values = 0 & "®©E"
    cvw_RP_RPExcludedCountries.LoadEditLists
    cvw_RP_RPExcludedCountries.LoadList
    
    Txt_Creator.Text = ms_UserName
    txt_last_upd.Text = ms_UserName
    
    mb_LoadingData = False
    Exit Sub
errHandler:
    mb_LoadingData = False
    
    Call ErrorHandler("SfbRefPro.RPDefaultValues")
End Sub

' loads data to form by entered key
Private Sub RPLoadToForm(ByVal al_Key As Long)
On Error GoTo errHandler
    
    mb_LoadingData = True
    
    If mc_Cursor = 0 Then
        mc_Cursor = OpenSQLSafe(mo_Db, "exec RP_Reference_Project_sel " & al_Key & ", 'E', '" & ms_LanguageSubCode & "'", 1)
    End If
    
    ' store id and iconcurrency couter for update
    ml_CurrRPcode = mo_Db.GetFields(mc_Cursor, "RP_code")
    ml_CurrRPiConcurrency = mo_Db.GetFields(mc_Cursor, "RPIConcurrency")
    ml_CurrLIiConcurrency = mo_Db.GetFields(mc_Cursor, "LIIConcurrency")
   
    'loads data to armcheckviews
'P615
'    cvw_RP_RecommendedArea.Calling_Key_Values = mo_Db.GetFields(mc_Cursor, "MKS_Code") & "®©E®©" & al_Key & "®©" & ml_UserCode
'    cvw_RP_RecommendedArea.Calling_Key_Values = ml_CurrRPDcode & "®©E®©" & al_Key & "®©" & ml_UserCode
    cvw_RP_RecommendedArea.Calling_Key_Values = ml_CurrRPDcode & "®©E®©" & al_Key & "®©" & ml_UserCode & "®©" & mo_Db.GetFields(mc_Cursor, "MKS_Code")
    cvw_RP_RecommendedArea.LoadEditLists
    cvw_RP_RecommendedArea.LoadList
    
    cvw_RP_RPExcludedCountries.Calling_Key_Values = al_Key & "®©E"
    cvw_RP_RPExcludedCountries.LoadEditLists
    cvw_RP_RPExcludedCountries.LoadList

    ' setup calendar
    cal_RP_InstallDate.reinit_cal
    cal_RP_InstallDate.date_courte = Format(mo_Db.GetFields(mc_Cursor, "RP_Install_Date"), "dd\/mm\/yyyy")
    
    ' setup combo boxes
    SetComboBoxText cbo_RP_Country, mo_Db.GetFields(mc_Cursor, "CT_code"), mo_Db.GetFields(mc_Cursor, "CT_desc")
    SetComboBoxText cbo_RP_MarketSeg, mo_Db.GetFields(mc_Cursor, "MKS_Code"), mo_Db.GetFields(mc_Cursor, "MKS_desc")
    ms_MKS_Code = cbo_RP_MarketSeg.SelectedItem.Key
    ' setup textboxes
    txt_RP_Architect.Text = mo_Db.GetFields(mc_Cursor, "RP_Architect")
    txt_RP_ConstructYear.Text = mo_Db.GetFields(mc_Cursor, "RP_Construct_Year")
    txt_RP_Contractor.Text = mo_Db.GetFields(mc_Cursor, "RP_Contractor")
    txt_RP_CustomerInfo.Text = mo_Db.GetFields(mc_Cursor, "RP_Custom_Info")
    txt_RP_Desc.Text = mo_Db.GetFields(mc_Cursor, "RP_Desc")
    txt_RP_Internet_Desc.Text = mo_Db.GetFields(mc_Cursor, "RP_InternetDesc")
    txt_RP_Text.Text = mo_Db.GetFields(mc_Cursor, "RP_Text")
    txt_RP_Surface.Text = mo_Db.GetFields(mc_Cursor, "RP_Surface")
    txt_RP_Town.Text = mo_Db.GetFields(mc_Cursor, "RP_Town")
    txt_spare1.Text = mo_Db.GetFields(mc_Cursor, "Spare1")
    txt_spare2.Text = mo_Db.GetFields(mc_Cursor, "Spare2")
    txt_spare3.Text = mo_Db.GetFields(mc_Cursor, "Spare3")
    txt_Spareint2.Text = mo_Db.GetFields(mc_Cursor, "Spareint2")
    Txt_Creator.Text = mo_Db.GetFields(mc_Cursor, "RP_Creator")
    txt_last_upd.Text = mo_Db.GetFields(mc_Cursor, "RP_Last_Upd")
    
    ' setup checkboxes
    
    chk_RP_InternetFlag.Value = IIf(mo_Db.GetFields(mc_Cursor, "Internet_Flag") = "X", vbChecked, vbUnchecked)
    chk_RP_RestrictedInternet.Value = IIf(mo_Db.GetFields(mc_Cursor, "Spareint1") = 1, vbChecked, vbUnchecked)
    
   
   
    ' loads data to sub grids
    
    Select Case RPActiveSubScreen
         Case RPSubDocAdd, RPSubDocMain, RPSubDocUpd
            If Not mb_TabGridLoaded(2) Then
                grd_RP_Documents.Load "RP_Document_lst " & ml_CurrRPcode & ", " & RP_GRCODE & ", " & RP_GRCODE_CATEGORY & ", " & RP_GRCODE_CLASS & ", '" & ms_LanguageSubCode & "'", False
                mb_TabGridLoaded(2) = True
            End If
         Case RPSubFreeAdd, RPSubFreeMain
            If Not mb_TabGridLoaded(1) Then
                grd_RP_FreeText.Load "RP_Product_Link_lst " & ml_CurrRPcode & ", 'E'", False
                mb_TabGridLoaded(1) = True
            End If
         Case RPSubDocAdd, RPSubProdAdd, RPSubProdMain
            If Not mb_TabGridLoaded(0) Then
                grd_RP_Products.Load "RP_BI_Marketing_Link_lst " & ml_CurrRPcode & ", 'E'", False
                mb_TabGridLoaded(0) = True
            End If
         Case RPSubCustMain, RPSubCustAdd
            If Not mb_TabGridLoaded(3) Then
                grd_RP_Customers.MasterDetailRequest = "EXEC RP_Customer_lst_detailReq '$CCU_capkey$', " & grd_RP_Main.SelectedKey(0)(0) & ", 'E'"
                grd_RP_Customers.Load "EXEC RP_Customer_lst " & grd_RP_Main.SelectedKey(0)(0) & ", 'E'", False
                mb_TabGridLoaded(3) = True
            End If
         
    End Select
    
'P615
'    cvw_RP_RecommendedArea.Calling_Key_Values = CStr(cbo_RP_MarketSeg.SelectedItem.Key) & "®©E®©" & ml_CurrRPcode & "®©" & ml_UserCode
'    cvw_RP_RecommendedArea.Calling_Key_Values = ml_CurrRPDcode & "®©E®©" & ml_CurrRPcode & "®©" & ml_UserCode
    cvw_RP_RecommendedArea.Calling_Key_Values = ml_CurrRPDcode & "®©E®©" & ml_CurrRPcode & "®©" & ml_UserCode & "®©" & cbo_RP_MarketSeg.SelectedItem.Key
    cvw_RP_RecommendedArea.LoadEditLists
    cvw_RP_RecommendedArea.LoadList
    
    mb_LoadingData = False
    
    Exit Sub
errHandler:
    mb_LoadingData = False
    
    Call ErrorHandler("SfbRefPro.RPLoadToForm")
End Sub


' loads data to form by current line
Private Sub RPLoadToSubForm(ByVal ae_SubScreen As ArrRPSubScr)
On Error GoTo errHandler
    Select Case ae_SubScreen
         Case RPSubDocUpd
            
            ' store id for update
            ml_CurrRPDcode = grd_RP_Documents.CurrentLine("RPD_code")
            ml_CurrRPDiConcurrency = grd_RP_Documents.CurrentLine("iConcurrency")
            
            ' init combo boxes
            cbo_RP_DocumentType.Clear
            cbo_RP_DocumentCategory.Clear
            cbo_RP_DocumentClass.Clear
            cbo_RPD_Cat.Clear 'P615
            cbo_DocLang.Clear 'P615

            ' setup combo boxes
            SetComboBoxText cbo_RP_DocumentType, grd_RP_Documents.CurrentLine("RPD_type"), grd_RP_Documents.CurrentLine("RF_desc")
            SetComboBoxText cbo_RP_DocumentCategory, grd_RP_Documents.CurrentLine("RPD_category"), grd_RP_Documents.CurrentLine("RF_desc_category")
            SetComboBoxText cbo_RP_DocumentClass, grd_RP_Documents.CurrentLine("RPD_class"), grd_RP_Documents.CurrentLine("RF_desc_class")
            SetComboBoxText cbo_RPD_Cat, grd_RP_Documents.CurrentLine("RPD_Cat"), grd_RP_Documents.CurrentLine("RPD_Cat_desc")
            SetComboBoxText cbo_DocLang, grd_RP_Documents.CurrentLine("DocLang"), grd_RP_Documents.CurrentLine("DocLang_Desc")
            
            ' internet flag
            chk_RPD_internet_Flag.Value = IIf(grd_RP_Documents.CurrentLine("IFLAG") = "X", 1, 0)

            
            ' setup textboxes
            txt_RP_DocumentTitle = grd_RP_Documents.CurrentLine("RPD_Title")
            txt_RP_DocumentTitle.SetFocus
            
            If cbo_RP_DocumentType.SelectedItem Is Nothing Then
                fil_Full.Pattern = "*.*"
            Else
                fil_Full.Pattern = "*." & cbo_RP_DocumentType.Text
            End If
              
              
        End Select
    Exit Sub
errHandler:
    Call ErrorHandler("SfbRefPro.RPLoadToSubForm")
End Sub


Private Function RPSaveNew() As Long
On Error GoTo errHandler
    Dim lb_TranOpened As Boolean
    
    
    lb_TranOpened = False
    
    RPSaveNew = 0
    
    
    ' retrieve new id
    Dim ls_ID As String
    ls_ID = mo_Db.SQLNextID("RP_REF_PRO")
    If ls_ID = "" Then
        Err.Raise vbObjectError + 514, Err.Source, "SQLNextID failed for Reference Project"
    End If
    
    ml_CurrRPcode = ls_ID
    
    Dim ls_SQL1 As String
    Dim ls_SQL2 As String
    Dim ls_SQL3 As String
    
    ASC_BeginTransaction mo_Db, "RP_SAVE_NEW"
    lb_TranOpened = True
    
    ' construct insert for RP_Reference_Project table
    ls_SQL1 = "RP_Reference_Project_ins $Code$, $LangCode$, $Architect$, $Contractor$, $InstallDate$, $ConstructYear$, $CTCode$, $Surface$, $Town$, $Spare1$, $Spare2$, $Spare3$, $Spareint1$, $Spareint2$, $InternetFlag$, $ZUCode$"
    
    ls_SQL1 = Replace(ls_SQL1, "$Code$", ls_ID)
    ls_SQL1 = Replace(ls_SQL1, "$LangCode$", "'E'")
    ls_SQL1 = Replace(ls_SQL1, "$Architect$", SQLStr(txt_RP_Architect.Text))
    ls_SQL1 = Replace(ls_SQL1, "$Contractor$", SQLStr(txt_RP_Contractor.Text))
    ls_SQL1 = Replace(ls_SQL1, "$InstallDate$", SQLDateTime(cal_RP_InstallDate.date_dt))
    ls_SQL1 = Replace(ls_SQL1, "$ConstructYear$", txt_RP_ConstructYear.Text)
    ls_SQL1 = Replace(ls_SQL1, "$CTCode$", SQLStr(cbo_RP_Country.SelectedItem.Key))
    ls_SQL1 = Replace(ls_SQL1, "$Surface$", SQLStr(txt_RP_Surface.Text))
    ls_SQL1 = Replace(ls_SQL1, "$InternetFlag$", IIf(chk_RP_InternetFlag.Value = 1, "'X'", "''"))
    ls_SQL1 = Replace(ls_SQL1, "$ZUCode$", ml_UserCode)
    ls_SQL1 = Replace(ls_SQL1, "$Town$", SQLStr(txt_RP_Town.Text))
    ls_SQL1 = Replace(ls_SQL1, "$Spare1$", SQLStr(txt_spare1.Text))
    ls_SQL1 = Replace(ls_SQL1, "$Spare2$", SQLStr(txt_spare2.Text))
    ls_SQL1 = Replace(ls_SQL1, "$Spare3$", SQLStr(txt_spare3.Text))
    ls_SQL1 = Replace(ls_SQL1, "$Spareint1$", IIf(chk_RP_RestrictedInternet.Value = vbChecked, "1", "0"))
    
    If txt_Spareint2.Text = "" Then
        ls_SQL1 = Replace(ls_SQL1, "$Spareint2$", "Null")
    Else
        ls_SQL1 = Replace(ls_SQL1, "$Spareint2$", SqlDbl(CDbl(txt_Spareint2.Text)))
    End If
    
    ExecuteSQLSafe mo_Db, ls_SQL1, 1
    
    ' construct insert for RP_LangInfo table
      
    ls_SQL2 = "RP_LangInfo_ins $Code$, $Desc$, $InternetDesc$, $Text$, $CustomInfo$, $Town$, $ZUCode$"
    
    ls_SQL2 = Replace(ls_SQL2, "$Code$", ls_ID, , , vbTextCompare)
    ls_SQL2 = Replace(ls_SQL2, "$Desc$", SQLStr(txt_RP_Desc.Text), , , vbTextCompare)
    ls_SQL2 = Replace(ls_SQL2, "$InternetDesc$", SQLStr(txt_RP_Internet_Desc.Text), , , vbTextCompare)
    ls_SQL2 = Replace(ls_SQL2, "$Text$", SQLStr(txt_RP_Text.Text), , , vbTextCompare)
    ls_SQL2 = Replace(ls_SQL2, "$CustomInfo$", SQLStr(txt_RP_CustomerInfo.Text), , , vbTextCompare)
    ls_SQL2 = Replace(ls_SQL2, "$Town$", SQLStr(txt_RP_Town.Text), , , vbTextCompare)
    ls_SQL2 = Replace(ls_SQL2, "$ZUCode$", ml_UserCode, , , vbTextCompare)
    
    
    ExecuteSQLSafe mo_Db, ls_SQL2
    
    cvw_RP_RecommendedArea.Calling_Key_Values = CStr(cbo_RP_MarketSeg.SelectedItem.Key) & "®©E®©" & ls_ID & "®©" & ml_UserCode
    ms_MKS_Code = cbo_RP_MarketSeg.SelectedItem.Key
    
'P615 Market segm ...
    ls_SQL3 = "exec RP_MKS_RA_Link_ins $RPCode$, '$MKSCode$', null, 'E', $ZUCode$"
    
    ls_SQL3 = Replace(ls_SQL3, "$RPCode$", ml_CurrRPcode)
    ls_SQL3 = Replace(ls_SQL3, "$ZUCode$", ml_UserCode)
    ls_SQL3 = Replace(ls_SQL3, "$MKSCode$", cbo_RP_MarketSeg.SelectedItem.Key)
    
    ExecuteSQLSafe mo_Db, ls_SQL3
    
    cvw_RP_RPExcludedCountries.Calling_Key_Values = ls_ID & "®©E"
    
    If Not cvw_RP_RPExcludedCountries.SaveList Then
        Err.Raise CompFncFailed, "SaveList", "List of excluded countries cannot be saved."
    End If
    
    ASC_CommitTransaction mo_Db, "RP_SAVE_NEW"
    lb_TranOpened = False
    
    RPSaveNew = ls_ID
    Exit Function
errHandler:
    If lb_TranOpened Then
    ASC_RollBackTransaction mo_Db, "RP_SAVE_NEW"
    End If
    Call ErrorHandler("SfbRefPro.RPSaveNew")
End Function


' Update record in database
' Params:
'
Private Function RPUpdate() As Long
On Error GoTo errHandler
    
    Dim lb_TranOpened As Boolean
    lb_TranOpened = False
    
    RPUpdate = 0
    
    Dim ls_SQL As String
    Dim ls_SQL1 As String
    Dim ls_SQL2 As String
    Dim ls_SQL3 As String
    
    ' construct update for RP_Reference_Project table
    ls_SQL1 = "RP_Reference_Project_upd $Code$, $LangCode$, $Architect$, $Contractor$, $InstallDate$, $ConstructYear$, $CTCode$, $Surface$, $Town$, $Spare1$, $Spare2$, $Spare3$, $Spareint1$, $Spareint2$, $InternetFlag$, $ZUCode$, $IConcurreny$"
    
    ls_SQL1 = Replace(ls_SQL1, "$Code$", ml_CurrRPcode)
    ls_SQL1 = Replace(ls_SQL1, "$LangCode$", "'E'")
    ls_SQL1 = Replace(ls_SQL1, "$Architect$", SQLStr(txt_RP_Architect.Text))
    ls_SQL1 = Replace(ls_SQL1, "$Contractor$", SQLStr(txt_RP_Contractor.Text))
    ls_SQL1 = Replace(ls_SQL1, "$InstallDate$", SQLDateTime(cal_RP_InstallDate.date_dt))
    ls_SQL1 = Replace(ls_SQL1, "$ConstructYear$", SQLStr(txt_RP_ConstructYear.Text))
    ls_SQL1 = Replace(ls_SQL1, "$CTCode$", SQLStr(cbo_RP_Country.SelectedItem.Key))
    ls_SQL1 = Replace(ls_SQL1, "$Surface$", SQLStr(txt_RP_Surface.Text))
    ls_SQL1 = Replace(ls_SQL1, "$InternetFlag$", IIf(chk_RP_InternetFlag.Value = vbChecked, "'X'", "''"))
    ls_SQL1 = Replace(ls_SQL1, "$ZUCode$", ml_UserCode)
    ls_SQL1 = Replace(ls_SQL1, "$IConcurreny$", ml_CurrRPiConcurrency)
    ls_SQL1 = Replace(ls_SQL1, "$Town$", SQLStr(txt_RP_Town.Text))
    ls_SQL1 = Replace(ls_SQL1, "$Spare1$", SQLStr(txt_spare1.Text))
    ls_SQL1 = Replace(ls_SQL1, "$Spare2$", SQLStr(txt_spare2.Text))
    ls_SQL1 = Replace(ls_SQL1, "$Spare3$", SQLStr(txt_spare3.Text))
    ls_SQL1 = Replace(ls_SQL1, "$Spareint1$", IIf(chk_RP_RestrictedInternet.Value = vbChecked, "1", "0"))
    
    If txt_Spareint2.Text = "" Then
        ls_SQL1 = Replace(ls_SQL1, "$Spareint2$", "Null")
    Else
        ls_SQL1 = Replace(ls_SQL1, "$Spareint2$", SqlDbl(CDbl(txt_Spareint2.Text)))
    End If
        
    ' construct update for RP_LangInfo table
    ls_SQL2 = "RP_LangInfo_upd $Code$, $LangCode$, $Desc$, $InternetDesc$, $Text$, $CustomInfo$, $Town$, $ZUCode$, $IConcurreny$"
    
    ls_SQL2 = Replace(ls_SQL2, "$Code$", ml_CurrRPcode, , , vbTextCompare)
    ls_SQL2 = Replace(ls_SQL2, "$LangCode$", SQLStr(ms_LanguageSubCode), , , vbTextCompare)
    ls_SQL2 = Replace(ls_SQL2, "$Desc$", SQLStr(txt_RP_Desc.Text), , , vbTextCompare)
    ls_SQL2 = Replace(ls_SQL2, "$InternetDesc$", SQLStr(txt_RP_Internet_Desc.Text), , , vbTextCompare)
    ls_SQL2 = Replace(ls_SQL2, "$Text$", SQLStr(txt_RP_Text.Text), , , vbTextCompare)
    ls_SQL2 = Replace(ls_SQL2, "$CustomInfo$", SQLStr(txt_RP_CustomerInfo.Text), , , vbTextCompare)
    ls_SQL2 = Replace(ls_SQL2, "$Town$", SQLStr(txt_RP_Town.Text), , , vbTextCompare)
    ls_SQL2 = Replace(ls_SQL2, "$ZUCode$", ml_UserCode, , , vbTextCompare)
    ls_SQL2 = Replace(ls_SQL2, "$IConcurreny$", ml_CurrLIiConcurrency, , , vbTextCompare)

    ASC_BeginTransaction mo_Db, "RP_UPDATE"
    lb_TranOpened = True
    
    ExecuteSQLSafe mo_Db, ls_SQL1, 1
    ExecuteSQLSafe mo_Db, ls_SQL2, 1
    
'P615 replace RP_MKS_RA_Link_del by RP_document_RA_Link_del
    'delete all recomended are in case user change market segment, checkview cannot remember
    'recommended areas for previous selected market segment and will not delete automatically
'    If StrComp(cbo_RP_MarketSeg.SelectedItem.Key, ms_MKS_Code) <> 0 Then
''      ls_SQL3 = "exec RP_MKS_RA_Link_del $RP_Code$,$MKS_Code$,$RA_Code$"
'      ls_SQL3 = "exec RP_Document_RA_Link_del $RP_Code$,$RPD_Code$,$RA_Code$"
'      ls_SQL3 = Replace(ls_SQL3, "$RP_Code$", ml_CurrRPcode)
'      ls_SQL3 = Replace(ls_SQL3, "$RPD_Code$", "NULL")
'      ls_SQL3 = Replace(ls_SQL3, "$RA_Code$", "NULL")
'      Call ExecuteSQLSafe(mo_Db, ls_SQL3)
'    End If
    
'P615
'    If Not cvw_RP_RecommendedArea.SaveList Then
'        Err.Raise CompFncFailed, "SaveList", "List of recommended area cannot be saved."
'    End If
    If ms_MKS_Code <> cbo_RP_MarketSeg.SelectedItem.Key Then
        ls_SQL = "exec RP_MKS_RA_Link_del $RP_Code$,$MKS_Code$,null"
        
        ls_SQL = Replace(ls_SQL, "$RP_Code$", ml_CurrRPcode)
        ls_SQL = Replace(ls_SQL, "$MKS_Code$", ms_MKS_Code)
        
        ExecuteSQLSafe mo_Db, ls_SQL
        
        ls_SQL = "exec RP_MKS_RA_Link_ins $RPCode$, '$MKSCode$', null, 'E', $ZUCode$"
        
        ls_SQL = Replace(ls_SQL, "$RPCode$", ml_CurrRPcode)
        ls_SQL = Replace(ls_SQL, "$ZUCode$", ml_UserCode)
        ls_SQL = Replace(ls_SQL, "$MKSCode$", cbo_RP_MarketSeg.SelectedItem.Key)
        
        ExecuteSQLSafe mo_Db, ls_SQL
    End If
    
    If Not cvw_RP_RPExcludedCountries.SaveList Then
        Err.Raise CompFncFailed, "SaveList", "List of excluded contries cannot be saved."
    End If

    
    ASC_CommitTransaction mo_Db, "RP_UPDATE"
    lb_TranOpened = False

    RPUpdate = ml_CurrRPcode
    
    Exit Function
errHandler:
    If lb_TranOpened Then
    ASC_RollBackTransaction mo_Db, "RP_UPDATE"
    End If
    
    RPUpdate = 0
    Call ErrorHandler("SfbRefPro.RPUpdate")
End Function

' Validate form (check for empty required fields etc.)
Private Function ValidateForm() As ErrMsg
On Error GoTo errHandler
    

    If cal_RP_InstallDate.date_dt = 0 Then
        ValidateForm = ErrMsgMandatoryAreEmpty
        cal_RP_InstallDate.SetFocus
        Exit Function
    End If
     
    Select Case RPActiveScreen
    
        Case RPAdd, RPEdit
            
            If txt_RP_Desc.Text = "" Then
                ValidateForm = ErrMsgMandatoryAreEmpty
                txt_RP_Desc.SetFocus
                Exit Function
            End If
            If txt_RP_Internet_Desc.Text = "" Then
                ValidateForm = ErrMsgMandatoryAreEmpty
                txt_RP_Internet_Desc.SetFocus
                Exit Function
            End If
            If txt_RP_Text.Text = "" Then
                ValidateForm = ErrMsgMandatoryAreEmpty
                txt_RP_Text.SetFocus
                Exit Function
            End If
            ' these fields are now disabled (task 503)
            'If txt_RP_Architect.Text = "" Then
            '    ValidateForm = ErrMsgMandatoryAreEmpty
            '    txt_RP_Architect.SetFocus
            '    Exit Function
            'End If
            'If txt_RP_Contractor.Text = "" Then
            '    ValidateForm = ErrMsgMandatoryAreEmpty
            '    txt_RP_Contractor.SetFocus
            '    Exit Function
            'End If
            If cbo_RP_Country.SelectedItem Is Nothing Then
                ValidateForm = ErrMsgMandatoryAreEmpty
                cbo_RP_Country.SetFocus
                Exit Function
            End If
            If cbo_RP_MarketSeg.SelectedItem Is Nothing Then
                ValidateForm = ErrMsgMandatoryAreEmpty
                cbo_RP_MarketSeg.SetFocus
                Exit Function
            End If
            If txt_RP_ConstructYear.Text = "" Then
                ValidateForm = ErrMsgMandatoryAreEmpty
                txt_RP_ConstructYear.SetFocus
                Exit Function
            End If
            If txt_RP_CustomerInfo.Text = "" Then
                ValidateForm = ErrMsgMandatoryAreEmpty
                txt_RP_CustomerInfo.SetFocus
                Exit Function
            End If
            If txt_RP_Surface.Text = "" Then
                ValidateForm = ErrMsgMandatoryAreEmpty
                txt_RP_Surface.SetFocus
                Exit Function
            End If
                        
            If Not txt_Spareint2.Text = "" And Not isNumeric(txt_Spareint2.Text) Then
                ValidateForm = ErrMsgMandatoryAreEmpty
                txt_Spareint2.SetFocus
                Exit Function
            End If
'P615
'            If cvw_RP_RecommendedArea.CheckedCount("CHEC") = 0 Then
'                ValidateForm = ErrMsgAtLeastOneItemChecked
'                cvw_RP_RecommendedArea.SetFocus
'                Exit Function
'            End If
            
            If Not isNumeric(txt_RP_Surface.Text) And Not txt_RP_Surface.Text = "" Then
                ValidateForm = ErrMsgNumericRequired
                txt_RP_Surface.SetFocus
                Exit Function
            End If
            
            If Not isNumeric(txt_RP_ConstructYear.Text) And Not txt_RP_ConstructYear.Text = "" Then
                ValidateForm = ErrMsgNumericRequired
                txt_RP_ConstructYear.SetFocus
                Exit Function
            End If
            
            If RPActiveScreen <> RPAdd Then
                If Not (CheckMarket) Then
                    ValidateForm = ErrMsgInvalidArea
                    cbo_RP_MarketSeg.SetFocus
                    Exit Function
                End If
            End If
            
            ' additional chceck when update
            If RPActiveScreen = RPEdit Then
                ' check if there is at least one doc
                Dim lb_errRet As ErrMsg
                
                lb_errRet = ValidateDocuments()
                If lb_errRet <> ErrMsgNone Then
                    ValidateForm = lb_errRet
                    Exit Function
                End If
            End If
    End Select
    
    ValidateForm = ErrMsgNone
    
    Exit Function
errHandler:
    ValidateForm = ErrMsgNone
    Call ErrorHandler("SfbRefPro.ValidateForm")
End Function

Private Function ValidateDocuments() As ErrMsg
On Error GoTo errHandler
    ValidateDocuments = ErrMsgNone
    
    ' check if there is at least one doc
    If grd_RP_Documents.Rows > 0 Then
        Dim ll_i As Long
        Dim ll_SelectedCount As Long
        ll_SelectedCount = 0
        For ll_i = 0 To grd_RP_Documents.Rows - 1
            If grd_RP_Documents.Data(ll_i, "RPD_Sequence") = 1 Then
                ll_SelectedCount = ll_SelectedCount + 1
            End If
        Next
        If ll_SelectedCount = 0 Then
            ValidateDocuments = ErrMsgNoPrimaryImageSelected
            Exit Function
        ElseIf ll_SelectedCount > 1 Then
            ValidateDocuments = ErrMsgTooManyPrimaryImageSelected
            Exit Function
        End If
    End If
    Exit Function
errHandler:
    Call ErrorHandler("SfbRefPro.ValidateDocuments")
End Function

' Validate sub form (check for empty required fields etc.)
Private Function ValidateSubForm(ByVal ae_SubScreen As ArrRPSubScr) As ErrMsg
On Error GoTo errHandler
    
    Select Case ae_SubScreen
        Case RPSubDocAdd
            If txt_RP_DocumentTitle.Text = "" Then
                ValidateSubForm = ErrMsgMandatoryAreEmpty
                txt_RP_DocumentTitle.SetFocus
                Exit Function
            End If
            
            
            If txt_RP_DocumentPath.Text = "" Then
                ValidateSubForm = ErrMsgMandatoryAreEmpty
                txt_RP_DocumentPath.SetFocus
                Exit Function
            End If
            
            If Not mo_FSO.FileExists(txt_RP_DocumentPath.Text) Then
                ValidateSubForm = ErrMsgFileDoesntExists
                txt_RP_DocumentPath.SetFocus
                Exit Function
            End If
            
            If cbo_RP_DocumentType.SelectedItem Is Nothing Then
                ValidateSubForm = ErrMsgMandatoryAreEmpty
                cbo_RP_DocumentType.SetFocus
                Exit Function
            End If
'P615
            If Not CheckDroppedArea Then
                ValidateSubForm = ErrMsgDroppeddArea
                cvw_RP_RecommendedArea.SetFocus
                Exit Function
            End If
            
            If Not (CheckAreaMarket) Then
                ValidateSubForm = ErrMsgInvalidArea
                cvw_RP_RecommendedArea.SetFocus
                Exit Function
            End If
  'P615
            If cbo_RPD_Cat.SelectedItem Is Nothing Then
                ValidateSubForm = ErrMsgMandatoryAreEmpty
                cbo_RPD_Cat.SetFocus
                Exit Function
            End If
            
            Select Case CategoryControl(cbo_RPD_Cat.SelectedItem.Key)
            Case 1
                ValidateSubForm = ErrMsgMandatoryAreEmpty
                cvw_RP_RecommendedArea.SetFocus
                Exit Function
            Case 2
                ValidateSubForm = ErrMsgMandatoryAreEmpty
                cbo_DocLang.SetFocus
                Exit Function
            End Select
            
            Case RPSubDocUpd
            
            If txt_RP_DocumentTitle.Text = "" Then
                ValidateSubForm = ErrMsgMandatoryAreEmpty
                txt_RP_DocumentTitle.SetFocus
                Exit Function
            End If
            If cbo_RP_DocumentType.SelectedItem Is Nothing Then
                ValidateSubForm = ErrMsgMandatoryAreEmpty
                cbo_RP_DocumentType.SetFocus
                Exit Function
            End If
            
            If Not CheckDroppedArea Then
                ValidateSubForm = ErrMsgDroppeddArea
                cvw_RP_RecommendedArea.SetFocus
                Exit Function
            End If
            
            If Not (CheckAreaMarket) Then
                ValidateSubForm = ErrMsgInvalidArea
                cvw_RP_RecommendedArea.SetFocus
                Exit Function
            End If
'P615
            If cbo_RPD_Cat.SelectedItem Is Nothing Then
                ValidateSubForm = ErrMsgMandatoryAreEmpty
                cbo_RPD_Cat.SetFocus
                Exit Function
            Else
                Select Case CategoryControl(cbo_RPD_Cat.SelectedItem.Key)
                Case 1
                    ValidateSubForm = ErrMsgMandatoryAreEmpty
                    cvw_RP_RecommendedArea.SetFocus
                    Exit Function
                Case 2
                    ValidateSubForm = ErrMsgMandatoryAreEmpty
                    cbo_DocLang.SetFocus
                    Exit Function
                End Select
            End If
            End Select
            
           
    ValidateSubForm = ErrMsgNone
    
    Exit Function
errHandler:
    ValidateSubForm = ErrMsgNone
    Call ErrorHandler("SfbRefPro.ValidateSubForm")
End Function




' store redord to databaze
Private Sub RPStoreRecord()
On Error GoTo errHandler
    Dim le_Msg As ErrMsg
    le_Msg = ValidateForm()
    
    Select Case le_Msg
        Case ErrMsgInvalidArea
            ASC_SendMessage ms_LanguageCode, ErrMsgInvalidArea, "#document linked to an invalid area"
            Exit Sub
        Case ErrMsgDroppeddArea
            ASC_SendMessage ms_LanguageCode, ms_Area & ErrMsgDroppeddArea, "#Recommended is not available to be selected as it is no longer available."
            Exit Sub
        Case ErrMsgNumericRequired
            ASC_SendMessage ms_LanguageCode, ErrMsgNumericRequired, "#Number required."
            Exit Sub
        Case ErrMsgMandatoryAreEmpty
            ASC_SendMessage ms_LanguageCode, ErrMsgMandatoryAreEmpty, "#Mandatory fields are not filled."
            Exit Sub
        Case ErrMsgAtLeastOneItemChecked
            ASC_SendMessage ms_LanguageCode, ErrMsgAtLeastOneItemChecked, "#At least one item must be checked."
            Exit Sub
        Case ErrMsgNoPrimaryImageSelected
            If grd_RP_Documents.Rows > 1 Then
                ASC_SendMessage ms_LanguageCode, ErrMsgNoPrimaryImageSelected, "#No primary image selected."
                Exit Sub
            Else
                ' make sequence to primary image
                Call RPUpdateSequence(ml_CurrRPcode, grd_RP_Documents.Data(0, "RPD_code"))
            End If
        Case ErrMsgTooManyPrimaryImageSelected
            ASC_SendMessage ms_LanguageCode, ErrMsgTooManyPrimaryImageSelected, "#Too many primary images selected."
            Exit Sub
    End Select
    
    Select Case RPActiveScreen
        Case RPAdd
            Call RPSaveNew
            ml_CurrRPiConcurrency = 1
            ml_CurrLIiConcurrency = 1
        Case RPEdit
            txt_last_upd.Text = ms_UserName
            ml_CurrRPcode = RPUpdate
    End Select
    
    RPUpdateGrid
    
    Select Case RPActiveScreen
         Case RPAdd
            RPActiveScreen = RPEdit
            
               
         Case RPEdit
            RPActiveScreen = RPMain
    End Select
    

    Exit Sub
errHandler:
    If Err.Number = SQLBadRowAffectedCount Then
        Err.Clear
        ASC_SendMessage ms_LanguageCode, ErrMsgIConcurency, "#Someone changed detail of this record and detail screen will be reloaded."
        RPRestoreRecord True
        
        Exit Sub
    End If

     Call ErrorHandler("SfbRefPro.RPStoreRecord")
End Sub

' adds sub item to database
Private Function RPStoreSubRecord(ByVal ae_SubScreen As ArrRPSubScr, ByVal as_Code As String) As Boolean
On Error GoTo errHandler
    RPStoreSubRecord = False
    Dim ls_SQL As String
    
    Dim le_Msg As ErrMsg
    le_Msg = ValidateSubForm(ae_SubScreen)
    
    
    Select Case le_Msg
        Case ErrMsgMandatoryAreEmpty
            ASC_SendMessage ms_LanguageCode, ErrMsgMandatoryAreEmpty, "#Mandatory fields are not filled."
            Exit Function
        Case ErrMsgFileDoesntExists
            ASC_SendMessage ms_LanguageCode, ErrMsgFileDoesntExists, "#File doesn't exist."
            Exit Function
        Case ErrMsgInvalidArea
            ASC_SendMessage ms_LanguageCode, ErrMsgInvalidArea, "#document linked to an invalid area"
            Exit Function
        Case ErrMsgDroppeddArea
            ASC_SendMessage ms_LanguageCode, ErrMsgDroppeddArea, "#Recommended is not available to be selected as it is no longer available."
            Exit Function
    End Select
    
    ' retrieve new id
    Dim ls_ID_small As String
    ls_ID_small = "null"
    
    ' 23.6.2010 if we are in addDocument screen additional scheck is required
    Dim lo_pict As IPicture
    Set lo_pict = Nothing
    
    If ae_SubScreen = RPSubDocAdd Then
        ' if document type is ( BMP, JPG, GIF )
        If cbo_RP_DocumentType.SelectedItem.Key = 1 Or _
            cbo_RP_DocumentType.SelectedItem.Key = 2 Or _
            cbo_RP_DocumentType.SelectedItem.Key = 3 Then
            
            ' create preview image
            Set lo_pict = GetSmallImage(txt_RP_DocumentPath.Text, Get_A_Config("RP_SMALL_W"), Get_A_Config("RP_SMALL_H"), Get_A_Config("RP_SMALL_DEPTH"))
            
            If lo_pict Is Nothing Then
                If ASC_SendMessage(ms_LanguageCode, ErrMsgInvalidResizeFormat, "#Invalid file format for resizing! Continue without preview image?", , vbYesNo) = vbNo Then
                    Exit Function
                End If
            End If
        End If
    End If
    
    
    ' insert blob
    If ae_SubScreen = RPSubDocAdd Then
        as_Code = mo_Db.SQLNextID("RP_DOC")
        If as_Code = "" Then
            Err.Raise vbObjectError + 514, Err.Source, "SQLNextID failed for Reference Project (RP_DOC)"
        End If
        
        ls_SQL = "RP_Document_Blob_ins " & as_Code & ", ?"
        
        If Not mo_Db.FileToBlobSQL(ls_SQL, txt_RP_DocumentPath.Text, 9) Then
            Err.Raise SQLFailure, Err.Source, "BLOB Insert failed"
        End If
        
        ' JN 15.6.2010
        ' save preview image if exists
        If Not lo_pict Is Nothing Then
            
            Dim ls_filePath As String
            ls_filePath = App.Path & C_TEMPDIR & as_Code & "_small.bmp"
            
            Call SavePicture(lo_pict, ls_filePath)
    
            ' upload ppreview image
            ls_ID_small = mo_Db.SQLNextID("RP_DOC")
            If ls_ID_small = "" Then
                Err.Raise vbObjectError + 514, Err.Source, "SQLNextID failed for Reference Project (RP_DOC)"
            End If
            
            ls_SQL = "RP_Document_Blob_ins " & ls_ID_small & ", ?"
            
            If Not mo_Db.FileToBlobSQL(ls_SQL, ls_filePath, 9) Then
                Err.Raise SQLFailure, Err.Source, "BLOB Insert failed"
            End If
        End If
    End If
    
    'ASC_BeginTransaction mo_Db, "RP_SUBITEM_ADD"
    
    Select Case ae_SubScreen
        Case RPSubProdAdd
            ' check for duplicity
            ls_SQL = "exec RP_BI_Marketing_Link_chk $RPCode$, $BIMKTCode$"
            
            ' TODO: GET SELECTED CODE FROM ANOTHER PLACE
            ls_SQL = Replace(ls_SQL, "$RPCode$", ml_CurrRPcode)
'            ls_SQL = Replace(ls_SQL, "$BIMKTCode$", SqlStr(grd_RP_BIMarketing.SelectedKey(0)(0)))
            ls_SQL = Replace(ls_SQL, "$BIMKTCode$", SQLStr(as_Code))
            
            ExecuteSQLSafe mo_Db, ls_SQL, 0, True
            
            ' construct insert for RP_Product_Link table
            ls_SQL = "exec RP_BI_Marketing_Link_ins $RPCode$, $BIMKTCode$, $ZUCode$"
            
            ls_SQL = Replace(ls_SQL, "$RPCode$", ml_CurrRPcode)
            ls_SQL = Replace(ls_SQL, "$BIMKTCode$", SQLStr(as_Code))
'            ls_SQL = Replace(ls_SQL, "$BIMKTCode$", SqlStr(grd_RP_BIMarketing.SelectedKey(0)(0)))
            ls_SQL = Replace(ls_SQL, "$ZUCode$", ml_UserCode)
            
            ExecuteSQLSafe mo_Db, ls_SQL, 1
        
        
        Case RPSubFreeAdd
            ' check for duplicity
            ls_SQL = "exec RP_Product_Link_chk $RPCode$, $RPPCode$"
            
            ls_SQL = Replace(ls_SQL, "$RPCode$", ml_CurrRPcode)
            ls_SQL = Replace(ls_SQL, "$RPPCode$", grd_RP_FreeTextStored.SelectedKey(0)(0))
            
            ExecuteSQLSafe mo_Db, ls_SQL, 0, True
            
            ' construct insert for RP_Product_Link table
            ls_SQL = "exec RP_Product_Link_ins $RPCode$, $RPPCode$, $LangCode$, $ZUCode$"
            
            ls_SQL = Replace(ls_SQL, "$RPCode$", ml_CurrRPcode)
            ls_SQL = Replace(ls_SQL, "$RPPCode$", grd_RP_FreeTextStored.SelectedKey(0)(0))
            ls_SQL = Replace(ls_SQL, "$LangCode$", "'E'")
            ls_SQL = Replace(ls_SQL, "$ZUCode$", ml_UserCode)
            
            ExecuteSQLSafe mo_Db, ls_SQL, 1
        Case RPSubDocAdd
            
            ' check for duplicity
            ls_SQL = "exec RP_Document_chk $RPCode$, $RPDTitle$"
            
            ls_SQL = Replace(ls_SQL, "$RPCode$", ml_CurrRPcode)
            ls_SQL = Replace(ls_SQL, "$RPDTitle$", SQLStr(txt_RP_DocumentTitle.Text))
            
            ExecuteSQLSafe mo_Db, ls_SQL, 0, True
            
            ' construct insert for RP_Product_Link table
'P615 :$RDPCat$ + docLang
            ls_SQL = "RP_Document_ins $RPDCode$, $RPCode$, $LangCode$, $RDPTitle$, $RDPType$, $RDPCategory$, $RDPClass$, $RPDSequence$, $ZUCode$, $InternetFlag$, $RPDCat$, $DocLang$, $RPD_Code_small$"
            
            ls_SQL = Replace(ls_SQL, "$RPDCode$", as_Code)
            ls_SQL = Replace(ls_SQL, "$RPCode$", ml_CurrRPcode)
            ls_SQL = Replace(ls_SQL, "$LangCode$", "'E'")
            ls_SQL = Replace(ls_SQL, "$RDPTitle$", SQLStr(txt_RP_DocumentTitle.Text))
            ls_SQL = Replace(ls_SQL, "$RDPType$", cbo_RP_DocumentType.SelectedItem.Key)
            ls_SQL = Replace(ls_SQL, "$RDPCategory$", SQLStr(GetComboKey(cbo_RP_DocumentCategory), True))
            ls_SQL = Replace(ls_SQL, "$RDPClass$", SQLStr(GetComboKey(cbo_RP_DocumentClass), True))
            ls_SQL = Replace(ls_SQL, "$RPDSequence$", 0)
            ls_SQL = Replace(ls_SQL, "$ZUCode$", ml_UserCode)
            ls_SQL = Replace(ls_SQL, "$InternetFlag$", IIf(chk_RPD_internet_Flag.Value = 1, "'X'", "''"))
            ls_SQL = Replace(ls_SQL, "$RPDCat$", SQLStr(GetComboKey(cbo_RPD_Cat), True))
            ls_SQL = Replace(ls_SQL, "$DocLang$", SQLStr(GetComboKey(cbo_DocLang), True))
            ls_SQL = Replace(ls_SQL, "$RPD_Code_small$", ls_ID_small)
            
            ExecuteSQLSafe mo_Db, ls_SQL
            
'P615 manage MKS link code
' 23.6.2010 JN - MKS link code is managed by main record and this only duplicate records into RP_MKS_RA_Link for each new document
'            ls_SQL = "exec RP_MKS_RA_Link_ins $RPCode$, '$MKSCode$', null, 'E', $ZUCode$"
            
'            ls_SQL = Replace(ls_SQL, "$RPCode$", ml_CurrRPcode)
'            ls_SQL = Replace(ls_SQL, "$ZUCode$", ml_UserCode)
'            ls_SQL = Replace(ls_SQL, "$MKSCode$", ms_MKS_Code)
            
'            ExecuteSQLSafe mo_Db, ls_SQL
            
'P615 store recommended area when RPD_code is known

'            cvw_RP_RecommendedArea.Calling_Key_Values = as_Code & "®©E®©" & ml_CurrRPcode & "®©" & ml_UserCode
            cvw_RP_RecommendedArea.Calling_Key_Values = as_Code & "®©E®©" & ml_CurrRPcode & "®©" & ml_UserCode & "®©" & cbo_RP_MarketSeg.SelectedItem.Key
            If Not cvw_RP_RecommendedArea.SaveList Then
                Err.Raise CompFncFailed, "SaveList", "List of recommended area cannot be saved."
            End If
            
         Case RPSubDocUpd
         
'P615 store recommended area

            If Not cvw_RP_RecommendedArea.SaveList Then
                Err.Raise CompFncFailed, "SaveList", "List of recommended area cannot be saved."
            End If
            ' construct insert for RP_Document table
'P615 :$RDPCat$ + DocLang
            ls_SQL = "exec RP_Document_upd $RPDCode$, $RPCode$, $LangCode$, $RPDTitle$, $RDPType$, $RDPCategory$, $RDPClass$, $ZUCode$, $InternetFlag$, $iConc$, $RDPCat$, $DocLang$"
            
            ls_SQL = Replace(ls_SQL, "$RPDCode$", ml_CurrRPDcode)
            ls_SQL = Replace(ls_SQL, "$RPCode$", ml_CurrRPcode)
            ls_SQL = Replace(ls_SQL, "$LangCode$", ms_LanguageSubCode)
            ls_SQL = Replace(ls_SQL, "$RPDTitle$", SQLStr(txt_RP_DocumentTitle.Text))
            ls_SQL = Replace(ls_SQL, "$RDPType$", cbo_RP_DocumentType.SelectedItem.Key)
            ls_SQL = Replace(ls_SQL, "$RDPCategory$", SQLStr(GetComboKey(cbo_RP_DocumentCategory), True))
            ls_SQL = Replace(ls_SQL, "$RDPClass$", SQLStr(GetComboKey(cbo_RP_DocumentClass), True))
            ls_SQL = Replace(ls_SQL, "$ZUCode$", ml_UserCode)
            ls_SQL = Replace(ls_SQL, "$InternetFlag$", IIf(chk_RPD_internet_Flag.Value = 1, "'X'", "''"))
            ls_SQL = Replace(ls_SQL, "$iConc$", ml_CurrRPDiConcurrency)
            ls_SQL = Replace(ls_SQL, "$RDPCat$", SQLStr(GetComboKey(cbo_RPD_Cat), True))
            ls_SQL = Replace(ls_SQL, "$DocLang$", SQLStr(GetComboKey(cbo_DocLang), True))
            
            ' updates more then one record (for all languages), but title is updated only for active language
            ExecuteSQLSafe mo_Db, ls_SQL
            
'p615 manage  MKS link
' 23.6.2010 JN - MKS link code is managed by main record
'            If ms_MKS_Code <> cbo_RP_MarketSeg.SelectedItem.Key Then
'                ls_SQL = "exec RP_MKS_RA_Link_del $RP_Code$,$MKS_Code$,null"
                
'                ls_SQL = Replace(ls_SQL, "$RP_Code$", ml_CurrRPcode)
'                ls_SQL = Replace(ls_SQL, "$MKS_Code$", ms_MKS_Code)
                
'                ExecuteSQLSafe mo_Db, ls_SQL
                
'                ls_SQL = "exec RP_MKS_RA_Link_ins $RPCode$, '$MKSCode$', null, 'E', $ZUCode$"
                
'                ls_SQL = Replace(ls_SQL, "$RPCode$", ml_CurrRPcode)
'                ls_SQL = Replace(ls_SQL, "$ZUCode$", ml_UserCode)
'                ls_SQL = Replace(ls_SQL, "$MKSCode$", cbo_RP_MarketSeg.SelectedItem.Key)
                
'                ExecuteSQLSafe mo_Db, ls_SQL
'            End If
            
    End Select
        
    ' check master iconcurency
    ls_SQL = "exec RP_Master_Reference_Project_upd $RPCode$, $ZUCode$, $IConc$"
            
    ls_SQL = Replace(ls_SQL, "$RPCode$", ml_CurrRPcode)
    ls_SQL = Replace(ls_SQL, "$ZUCode$", ml_UserCode)
    ls_SQL = Replace(ls_SQL, "$IConc$", ml_CurrRPiConcurrency)
            
    ExecuteSQLSafe mo_Db, ls_SQL, 1
        
    

    'ASC_CommitTransaction mo_Db, "RP_SUBITEM_ADD"
    ml_CurrRPiConcurrency = ml_CurrRPiConcurrency + 1
    If ae_SubScreen = RPSubDocUpd Then
        ml_CurrRPDiConcurrency = ml_CurrRPDiConcurrency + 1  '????
    End If
    
    
    
    Call RPUpdateSubGrid(ae_SubScreen, as_Code, ls_ID_small)
    
    RPStoreSubRecord = True
    Exit Function
errHandler:
    'ASC_RollBackTransaction mo_Db, "RP_SUBITEM_ADD"
    If Err.Number = SQLBadRowAffectedCount Then
        Err.Clear
        ASC_SendMessage ms_LanguageCode, ErrMsgIConcurency, "#Someone changed detail of this record and detail screen will be reloaded."
        RPRestoreRecord True
        
        Exit Function
    End If
    If Err.Number = DuplicityDetected Then
        Err.Clear
        ASC_SendMessage ms_LanguageCode, WarMsgItemExists, "#You are trying to add existing item in destination."
        Exit Function
    End If
    
    Call ErrorHandler("SfbRefPro.RPStoreSubRecord")
End Function

Private Sub RPUpdateBIMarketing_link(ByVal al_RPCode As Long, ByVal as_BI_MKT_Code As String, ByVal as_Shape_Used As String)
Const C_REQ As String = "EXEC RP_BI_Marketing_Link_upd $RPCode$, $BI_MKT_Code$, $Shape_Used$"
On Error GoTo errHandler
    Dim ls_SQL As String
    
    ls_SQL = Replace(C_REQ, "$RPCode$", al_RPCode)
    ls_SQL = Replace(ls_SQL, "$BI_MKT_Code$", SQLStr(as_BI_MKT_Code))
    ls_SQL = Replace(ls_SQL, "$Shape_Used$", SQLStr(as_Shape_Used))
            
    Call ExecuteSQLSafe(mo_Db, ls_SQL, 1)
    Exit Sub
errHandler:
    Call ErrorHandler("SfbRefPro.RPUpdateBIMarketing_link")
End Sub

Private Sub RPUpdateSequence(ByVal al_RPCode As Long, ByVal al_RPDCode As Long)
On Error GoTo errHandler
Const C_REQ As String = "EXEC RP_Document_Seq_upd $RPCode$, $RPDCode$, $ZUCode$"
On Error GoTo errHandler
    Dim ls_SQL As String
    
    ls_SQL = Replace(C_REQ, "$RPCode$", al_RPCode)
    ls_SQL = Replace(ls_SQL, "$RPDCode$", al_RPDCode)
    ls_SQL = Replace(ls_SQL, "$ZUCode$", ml_UserCode)
            
    Call ExecuteSQLSafe(mo_Db, ls_SQL)
    Exit Sub
errHandler:
    Call ErrorHandler("SfbRefPro.RPUpdateSequence")
End Sub

' Restores initial record values
Private Sub RPRestoreRecord(Optional ByVal ab_DbRefrest As Boolean = False)
On Error GoTo errHandler
    
    mb_TabGridLoaded(0) = False
    mb_TabGridLoaded(1) = False
    mb_TabGridLoaded(2) = False
    mb_TabGridLoaded(3) = False
    If ab_DbRefrest Then
        If mc_Cursor <> 0 Then
            mo_Db.Close mc_Cursor
            mc_Cursor = 0
        End If
    End If
    
    Select Case RPActiveScreen
    
        Case RPAdd ' Clears controls
            Call RPClearDetail
            Call RPDefaultValues
        Case RPEdit ' Loads initial values
            Call RPClearDetail
            RPLoadToForm grd_RP_Main.SelectedKey(0)(0)
            
    End Select
    Exit Sub
errHandler:
     Call ErrorHandler("SfbRefPro.RPRestoreRecord")
End Sub


' Removes record from database
Private Sub RPRemoveRecord()
Dim ls_SQL As String
Dim lb_TranOpened As Boolean

On Error GoTo errHandler

    lb_TranOpened = False

    If ASC_SendMessage(ms_LanguageCode, WarMsgDoYouRemove, "#Do you want to remove selected record ?", , vbYesNo) = vbYes Then
        
        ASC_BeginTransaction mo_Db, "RP_REMOVE"
        lb_TranOpened = True
        
        ' removes from RP_Reference_Project table
        ls_SQL = "RP_Reference_Project_del $Code$, $UserCode$, $IConc$"
        ls_SQL = Replace(ls_SQL, "$Code$", ml_CurrRPcode)
        ls_SQL = Replace(ls_SQL, "$UserCode$", ml_UserCode)
        ls_SQL = Replace(ls_SQL, "$IConc$", ml_CurrRPiConcurrency)
        ExecuteSQLSafe mo_Db, ls_SQL, 1
        
        ' removes from RP_LangTable table
        ls_SQL = "RP_LangInfo_del $Code$, $UserCode$"
        ls_SQL = Replace(ls_SQL, "$Code$", ml_CurrRPcode)
        ls_SQL = Replace(ls_SQL, "$UserCode$", ml_UserCode)
        ExecuteSQLSafe mo_Db, ls_SQL
        
        
        ASC_CommitTransaction mo_Db, "RP_REMOVE"
        lb_TranOpened = False
        
        RPUpdateGrid
    End If
    RPActiveScreen = RPMain
    
    Exit Sub
errHandler:
    If lb_TranOpened Then
    ASC_RollBackTransaction mo_Db, "RP_REMOVE"
    End If
    
    If Err.Number = SQLBadRowAffectedCount Then
        Err.Clear
        ASC_SendMessage ms_LanguageCode, ErrMsgIConcurency, "#Someone changed detail of this record and detail screen will be reloaded."
        RPRestoreRecord True
        LoadGrid
        Exit Sub
    End If
    Call ErrorHandler("SfbRefPro.RPRemoveRecord")
End Sub

' removes sub item from databaze
Private Sub RPRemoveSubRecord(ByVal ae_SubScreen As ArrRPSubScr)
On Error GoTo errHandler
    If ASC_SendMessage(ms_LanguageCode, WarMsgDoYouRemove, "#Do you want to remove selected record ?", , vbYesNo) = vbYes Then
        Dim ls_SQL As String
        
        'ASC_BeginTransaction mo_Db, "RP_REMOVE_SUB_ITEM"
        
        Select Case ae_SubScreen
            Case RPSubProdMain
                ls_SQL = "RP_BI_Marketing_Link_del $RPCode$, $RPPCode$"
                ls_SQL = Replace(ls_SQL, "$RPCode$", ml_CurrRPcode)
                ls_SQL = Replace(ls_SQL, "$RPPCode$", SQLStr(grd_RP_Products.SelectedKey(0)(0)))
                ExecuteSQLSafe mo_Db, ls_SQL, 1
            Case RPSubFreeMain
                ls_SQL = "RP_Product_Link_del $RPCode$, $BIMKTCode$"
                ls_SQL = Replace(ls_SQL, "$RPCode$", ml_CurrRPcode)
                ls_SQL = Replace(ls_SQL, "$BIMKTCode$", SQLStr(grd_RP_FreeText.SelectedKey(0)(0)))
                ExecuteSQLSafe mo_Db, ls_SQL, 1
            Case RPSubDocMain
'P615 delete link first
                ls_SQL = "RP_Document_RA_Link_del2 $RPDCode$"
                ls_SQL = Replace(ls_SQL, "$RPDCode$", grd_RP_Documents.SelectedKey(0)(0))
                ExecuteSQLSafe mo_Db, ls_SQL
                
                ls_SQL = "RP_Document_del $RPDCode$, $ZUCode$, $iConc$"
                ls_SQL = Replace(ls_SQL, "$RPDCode$", grd_RP_Documents.SelectedKey(0)(0))
                ls_SQL = Replace(ls_SQL, "$ZUCode$", ml_UserCode)
                ls_SQL = Replace(ls_SQL, "$iConc$", grd_RP_Documents.CurrentLine("IConcurrency"))
                ExecuteSQLSafe mo_Db, ls_SQL
            Case RPSubCustMain
                ls_SQL = "RP_Customer_del $RPCode$, '$CCU_CapKey$', $CPR_Code$, $Lang_Code$"
                ls_SQL = Replace(ls_SQL, "$RPCode$", ml_CurrRPcode)
                ls_SQL = Replace(ls_SQL, "$CCU_CapKey$", grd_RP_Customers.SelectedKey(0)(0))
                ls_SQL = Replace(ls_SQL, "$CPR_Code$", grd_RP_Customers.SelectedKey(0)(1))
                ls_SQL = Replace(ls_SQL, "$Lang_Code$", "'E'")
                ExecuteSQLSafe mo_Db, ls_SQL, 1
                
        End Select
        
        
        
        
        
         ' check master iconcurency
        ls_SQL = "RP_Master_Reference_Project_upd $RPCode$, $ZUCode$, $IConc$"
                
        ls_SQL = Replace(ls_SQL, "$RPCode$", ml_CurrRPcode)
        ls_SQL = Replace(ls_SQL, "$ZUCode$", ml_UserCode)
        ls_SQL = Replace(ls_SQL, "$IConc$", ml_CurrRPiConcurrency)
                
        ExecuteSQLSafe mo_Db, ls_SQL, 1
            
        ml_CurrRPiConcurrency = ml_CurrRPiConcurrency + 1
        
        RPUpdateSubGrid ae_SubScreen
        
        'ASC_CommitTransaction mo_Db, "RP_REMOVE_SUB_ITEM"
    End If
    
    Exit Sub
errHandler:
    'ASC_RollBackTransaction mo_Db, "RP_REMOVE_SUB_ITEM"
    If Err.Number = SQLBadRowAffectedCount Then
        Err.Clear
        ASC_SendMessage ms_LanguageCode, ErrMsgIConcurency, "#Someone changed detail of this record and detail screen will be reloaded."
        RPRestoreRecord True
        LoadGrid
        Exit Sub
    End If

    Call ErrorHandler("SfbRefPro.RPRemovesSubRecord")
End Sub


' updates grid after add, update, del
Private Sub RPUpdateGrid()
On Error GoTo errHandler
    Select Case RPActiveScreen
        Case RPEdit
            ' find line to be updated
            If grd_RP_Main.SearchKey(True, ml_CurrRPcode) Then
                ' update line
                grd_RP_Main.CurrentLine("RP_InternetDesc") = txt_RP_Internet_Desc.Text
                grd_RP_Main.CurrentLine("RP_Construct_Year") = txt_RP_ConstructYear.Text
                'grd_RP_Main.CurrentLine("RP_Architect") = txt_RP_Architect.Text
                grd_RP_Main.CurrentLine("CT_Desc") = cbo_RP_Country.Text
                grd_RP_Main.CurrentLine("MKS_desc") = cbo_RP_MarketSeg.Text
                grd_RP_Main.CurrentLine("RP_Town") = txt_RP_Town.Text
                grd_RP_Main.CurrentLine("LAST_UPD") = txt_last_upd.Text
                grd_RP_Main.CurrentLine("IFLAG") = IIf(chk_RP_InternetFlag.Value = 1, "X", "")

            Else
                ' someone deleted record then undelete
                grd_RP_Main.InsertLine 0, Array(ml_CurrRPcode, txt_RP_Internet_Desc.Text, txt_RP_ConstructYear.Text, cbo_RP_Country.Text, cbo_RP_MarketSeg.Text, txt_RP_Town.Text, Txt_Creator.Text, txt_last_upd.Text, IIf(chk_RP_InternetFlag.Value = 1, "X", ""))
                grd_RP_Main.Row = 0
            End If
        Case RPAdd
            grd_RP_Main.InsertLine 0, Array(ml_CurrRPcode, txt_RP_Internet_Desc.Text, txt_RP_ConstructYear.Text, cbo_RP_Country.Text, cbo_RP_MarketSeg.Text, txt_RP_Town.Text, Txt_Creator.Text, txt_last_upd.Text, IIf(chk_RP_InternetFlag.Value = 1, "X", ""))
            grd_RP_Main.Row = 0
        Case RPRem
            Call grd_RP_Main.DeleteLine(ml_CurrRPcode)
    End Select
    
    DoEvents
    Exit Sub
errHandler:
     Call ErrorHandler("SfbRefPro.RPUpdateGrid")
End Sub


' updates grids of subs after item is added or removed
Private Sub RPUpdateSubGrid(ByVal ae_SubScreen As ArrRPSubScr, Optional ByVal as_Code2 As String = "", Optional ByVal as_codeSmall As String = "null")
On Error GoTo errHandler
    Select Case ae_SubScreen
        Case RPSubFreeAdd
           grd_RP_FreeText.AddLine Array(grd_RP_FreeTextStored.CurrentLine("RPP_code"), grd_RP_FreeTextStored.CurrentLine("Product_Desc"), grd_RP_FreeTextStored.CurrentLine("Product_URL"))
           grd_RP_FreeText.SearchKey True, grd_RP_FreeTextStored.CurrentLine("RPP_code")
           'grd_RP_FreeTextStored.DeselectRow coz last comment
        Case RPSubFreeMain
           grd_RP_FreeText.DeleteSelectedLines
        Case RPSubProdAdd
            ' get necessary data from SQL, because form does not serve them
            Dim ls_Req As String
            Dim ll_cursor As Long
            ls_Req = Replace("EXEC BI_Marketing_RP_sel $SHORT_CODE$, $Language_Code$", "$SHORT_CODE$", SQLStr(as_Code2), , , vbTextCompare)
            ls_Req = Replace(ls_Req, "$Language_Code$", SQLStr(ms_LanguageCode), , , vbTextCompare)
            ll_cursor = OpenSQLSafe(mo_Db, ls_Req)
                
            If mo_Db.RowCount(ll_cursor) > 0 Then
                Call grd_RP_Products.AddLine(Array(as_Code2, mo_Db.GetFields(ll_cursor, "CG_desc"), mo_Db.GetFields(ll_cursor, "BI_MKT_desc"), mo_Db.GetFields(ll_cursor, "SH_Desc"), " "))
                Call grd_RP_Products.SearchKey(True, as_Code2)
            Else
                Call Err.Raise(CompFncFailed, "mo_Db.RowCount(ll_cursor) = 0", "Critical error: Selected item not found in DB and cannot be linked.")
            End If
            Call mo_Db.Close(ll_cursor)
            ll_cursor = 0
        Case RPSubProdMain
           grd_RP_Products.DeleteSelectedLines
           
        Case RPSubDocAdd
           grd_RP_Documents.AddLine Array(as_Code2, cbo_RP_DocumentType.Text, txt_RP_DocumentTitle.Text, 0, 1, _
                                                cbo_RP_DocumentType.SelectedItem.Key, _
                                                GetComboKey(cbo_RP_DocumentCategory), _
                                                IIf(Not GetComboKey(cbo_RP_DocumentCategory) = "", cbo_RP_DocumentCategory.Text, ""), _
                                                GetComboKey(cbo_RP_DocumentClass), _
                                                IIf(Not GetComboKey(cbo_RP_DocumentClass) = "", cbo_RP_DocumentClass.Text, ""), _
                                                IIf(chk_RPD_internet_Flag.Value = 1, "X", ""), _
                                                GetComboKey(cbo_RPD_Cat), _
                                                IIf(Not GetComboKey(cbo_RPD_Cat) = "", cbo_RPD_Cat.Text, ""), _
                                                GetComboKey(cbo_DocLang), _
                                                IIf(Not GetComboKey(cbo_DocLang) = "", cbo_DocLang.Text, ""), _
                                                IIf(as_codeSmall = "null", 0, as_codeSmall))
           
           grd_RP_Documents.SearchKey True, as_Code2
           
        Case RPSubDocUpd
            If grd_RP_Documents.SearchKey(True, ml_CurrRPDcode) Then
                ' update line
                grd_RP_Documents.CurrentLine("RPD_code") = ml_CurrRPDcode
                grd_RP_Documents.CurrentLine("RF_desc") = cbo_RP_DocumentType.Text
                grd_RP_Documents.CurrentLine("RPD_Title") = txt_RP_DocumentTitle.Text
                grd_RP_Documents.CurrentLine("iConcurrency") = ml_CurrRPDiConcurrency
                grd_RP_Documents.CurrentLine("RPD_type") = cbo_RP_DocumentType.SelectedItem.Key
                
                grd_RP_Documents.CurrentLine("RPD_Category") = GetComboKey(cbo_RP_DocumentCategory)
                grd_RP_Documents.CurrentLine("RPD_Class") = GetComboKey(cbo_RP_DocumentClass)
                grd_RP_Documents.CurrentLine("RF_desc_category") = IIf(Not GetComboKey(cbo_RP_DocumentCategory) = "", cbo_RP_DocumentCategory.Text, "")
                grd_RP_Documents.CurrentLine("RF_desc_class") = IIf(Not GetComboKey(cbo_RP_DocumentClass) = "", cbo_RP_DocumentClass.Text, "")
                grd_RP_Documents.CurrentLine("IFLAG") = IIf(chk_RPD_internet_Flag.Value = 1, "X", "")
                grd_RP_Documents.CurrentLine("RPD_Cat") = GetComboKey(cbo_RPD_Cat)
                grd_RP_Documents.CurrentLine("RPD_Cat_desc") = IIf(Not GetComboKey(cbo_RPD_Cat) = "", cbo_RPD_Cat.Text, "")
                grd_RP_Documents.CurrentLine("DocLang") = GetComboKey(cbo_DocLang)
                grd_RP_Documents.CurrentLine("DocLang_Desc") = IIf(Not GetComboKey(cbo_DocLang) = "", cbo_DocLang.Text, "")
            Else
                ' someone deleted record then undelete
                grd_RP_Documents.AddLine Array(as_Code2, cbo_RP_DocumentType.Text, txt_RP_DocumentTitle.Text, 0, 1, _
                                                cbo_RP_DocumentType.SelectedItem.Key, _
                                                GetComboKey(cbo_RP_DocumentCategory), _
                                                IIf(Not GetComboKey(cbo_RP_DocumentCategory) = "", cbo_RP_DocumentCategory.Text, ""), _
                                                GetComboKey(cbo_RP_DocumentClass), _
                                                IIf(Not GetComboKey(cbo_RP_DocumentClass) = "", cbo_RP_DocumentClass.Text, ""), _
                                                GetComboKey(cbo_RPD_Cat), _
                                                IIf(Not GetComboKey(cbo_RPD_Cat) = "", cbo_RPD_Cat.Text, ""), _
                                                GetComboKey(cbo_DocLang), _
                                                IIf(Not GetComboKey(cbo_DocLang) = "", cbo_DocLang.Text, ""), _
                                                IIf(as_codeSmall = "null", 0, as_codeSmall))

                grd_RP_Documents.SearchKey True, as_Code2
            End If
        Case RPSubDocMain
           grd_RP_Documents.DeleteSelectedLines
        Case RPSubCustAdd
            ' implemented directly in ShowLink proc
        Case RPSubCustMain
           grd_RP_Customers.DeleteSelectedLines
    End Select
    Exit Sub
errHandler:
    If ll_cursor > 0 Then
        Call mo_Db.Close(ll_cursor)
    End If
    Call ErrorHandler("SfbRefPro.RPUpdateSubGrid")
End Sub



' Sets combobox selected item
' Params:
' ao_ComboBox (ArmCombobox)
' as_Key (String)
' as_Request (String)
Private Sub SetComboBoxText(ByRef ao_ComboBox As ArmCombobox, ByVal as_Key As String, ByVal as_Desc As String)
On Error GoTo errHandler
     
    If Not ao_ComboBox.SearchItem(as_Key) And Not as_Key = "" Then
        ' key not found ... set value from parameter
        
        ao_ComboBox.AddItem Array(as_Key, as_Desc), True
            
    End If
    Exit Sub
errHandler:
    Call ErrorHandler("SfbRefPro.SetComboBoxText")
End Sub

' Standard error handler
Private Sub ErrorHandler(ByVal as_Fct As String)
    Err.Raise Err.Number, as_Fct & SEP1 & Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
End Sub


' display standard error message
' Params:
' as_Fct (String) - Error CallStack
Private Sub ErrorMessage(ByVal as_Fct As String)
    Dim li_OldPointer As Integer
    li_OldPointer = Screen.MousePointer
    
    Screen.MousePointer = vbDefault
    
    Dim ls_Pom As String
    ls_Pom = as_Fct & SEP1 & Err.Source & vbCrLf & Err.Description
    LogMessage Err.Number & ": " & Err.Description & SEP2 & as_Fct & SEP1 & Err.Source, MSG_ERROR
    MsgBox ls_Pom, , "Error message"
    
    Screen.MousePointer = li_OldPointer
End Sub

'turn off on mouse pointer sand hour glass, use counter
' Params:
' lb_Enable (Boolean)
Private Static Sub SetMousePointer(lb_Enable As Boolean)
    Dim li_Count As Integer
    Dim li_OldPointer 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
            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
End Sub

' Display an error message
' Params:
' as_LG_Code (String)
' ai_MsgCode (Integer)
' as_MsgDefault (String)
' as_MsgCxt (String = "")
' Buttons (VbMsgBoxStyle = vbOKOnly)
Public Function ASC_SendMessage(ByVal as_LG_Code As String, ByVal ai_MsgCode As Integer, ByVal as_MsgDefault As String, Optional ByVal as_MsgCxt As String = "", Optional Buttons As VbMsgBoxStyle = vbOKOnly) As VbMsgBoxResult
Dim ls_Message As String
Dim ll_Mouse As Long

    On Error GoTo Trace_Err
    
    If mo_Db Is Nothing Then
        ls_Message = as_MsgDefault
    Else
        If mo_Db.IsConnected = False Then
            ls_Message = as_MsgDefault
        Else
            ls_Message = ASC_MsgText(as_LG_Code, ai_MsgCode, as_MsgDefault)
        End If
    End If
    
'P615 special with martket segm and recommended area
    If ai_MsgCode = ErrMsgInvalidArea Then
        ls_Message = Replace(ls_Message, "$XX$", ms_DocumentTitle)
        ls_Message = Replace(ls_Message, "$YYY$", ms_Area)
        ls_Message = Replace(ls_Message, "$ZZ$", cbo_RP_MarketSeg.Text)
    End If
    If ai_MsgCode = ErrMsgDroppeddArea Then
        ls_Message = ms_Area & ls_Message
    End If
    
    ls_Message = ls_Message & vbCrLf & Trim(as_MsgCxt)
    ll_Mouse = Screen.MousePointer
    Screen.MousePointer = vbArrow
    ASC_SendMessage = MsgBox(ls_Message, Buttons)
    Screen.MousePointer = ll_Mouse
Trace_End:
    Exit Function
    
Trace_Err:
    ASC_SendMessage = vbAbort
End Function


' Get error text
' Params:
' as_LG_Code (String)
' ai_MsgID (Integer)
' as_MsgDefault (String = "")
Private Function ASC_MsgText(ByVal as_LG_Code As String, ByVal ai_MsgID As Integer, Optional ByVal as_MsgDefault As String = "")
Dim ls_Msg As String, ls_Request As String

    On Error GoTo Trace_Err
   
    ls_Request = "SELECT Message_Text FROM Error_Message WHERE Language_Code = '" & as_LG_Code & "' AND MsgID = " & ai_MsgID
    
    
    Dim lc_Msg  As Long
    lc_Msg = OpenSQLSafe(mo_Db, ls_Request, 1)
  
    
    ls_Msg = mo_Db.GetFields(lc_Msg, "MESSAGE_TEXT")
    mo_Db.Close lc_Msg
    ASC_MsgText = IIf(Len(ls_Msg) <> 0, ls_Msg, as_MsgDefault)
    Exit Function
Trace_Err:
    If Not lc_Msg = 0 Then
        mo_Db.Close lc_Msg
    End If
    ASC_MsgText = IIf(Len(ls_Msg) <> 0, ls_Msg, as_MsgDefault)
    
End Function


' copy & pasted ( & cleaned from wrong code) functions from sifyb tools module to use transaction
Public Function ASC_BeginTransaction(ByRef ao_Armdb As Object, Optional ByVal as_Name As String = "") As Boolean
On Error GoTo errHandler
    Dim ls_Request As String
    ASC_BeginTransaction = False
    ls_Request = "BEGIN TRAN " & as_Name
    'Execute the request
    ao_Armdb.ExecuteSQL ls_Request
    ASC_BeginTransaction = True
    Exit Function
errHandler:
    Call ErrorHandler("SfbRefPro.ASC_BeginTransaction")
End Function

Public Function ASC_CommitTransaction(ByRef ao_Armdb As Object, Optional ByVal as_Name As String = "") As Boolean
On Error GoTo errHandler
    Dim ls_Request As String

    ASC_CommitTransaction = False
    ls_Request = "COMMIT TRAN " & as_Name
    'Execute the request
    ao_Armdb.ExecuteSQL ls_Request
    ASC_CommitTransaction = True
    Exit Function
errHandler:
    Call ErrorHandler("SfbRefPro.ASC_CommitTransaction")
End Function

Public Function ASC_RollBackTransaction(ByRef ao_Armdb As Object, Optional ByVal as_Name As String = "") As Boolean
    Dim ls_Request As String
  
    ASC_RollBackTransaction = False
    ls_Request = "ROLLBACK TRAN " & as_Name
    'Execute the request
    ao_Armdb.ExecuteSQL ls_Request
    ASC_RollBackTransaction = True
End Function

' tranlate date to sql format
' Params:
' ad_Date (Date)
Private Function SQLDateTime(ad_Date As Date) As String
On Error GoTo errHandler
  If ad_Date = 0 Then
    SQLDateTime = "Null"
  Else
    SQLDateTime = "{ ts '" & Format(ad_Date, "yyyy-mm-dd hh:mm:ss") & "'}"
  End If
    Exit Function
errHandler:
     Call ErrorHandler("SfbRefPro.SQLDateTime")
End Function

' translate string to sql format
' Params:
' as_Value (String)
' ab_EmptyNULL (Boolean = False)
Private Function SQLStr(ByVal as_Value As String, Optional ByVal ab_EmptyNULL As Boolean = False) As String
    If as_Value = "" And ab_EmptyNULL Then
        SQLStr = "NULL"
    Else
        SQLStr = "'" & Replace(as_Value, "'", "''") & "'"
    End If
End Function

Private Function SqlDbl(ad_Value As Double) As String
  SqlDbl = Str(ad_Value)
End Function

' logs message to database
Private Sub LogMessage(ByVal as_Message As String, ByVal al_Type As Long)
On Error GoTo errHandler
    ExecuteSQLSafe mo_Db, "A_log_ins " & _
         ml_UserCode & ", " & _
         Choose(al_Type, "W", "E", "I") & ", " & _
         SQLStr(Left(as_Message, 4000)) & ", 'Reference Project'", 1
    Exit Sub
errHandler:
    MsgBox "SfbRefPro.LogMessage - " & Err.Number & ": " & Err.Description
End Sub



' Adds SQL Error messages to description
' Params:
' as_Desc (String)
Private Function AddSQLErrMsgsToDesc(ByVal as_Desc As String)
On Error GoTo errHandler
    Dim ls_PomCodes As String, ls_PomMessages As String
    GetErrorCodesAndErrorMessages ls_PomCodes, ls_PomMessages
    AddSQLErrMsgsToDesc = as_Desc & SEP2 & ls_PomCodes & SEP1 & ls_PomMessages
    Exit Function
errHandler:
     Call ErrorHandler("SfbRefPro.AddSQLErrMsgsToDesc")
End Function




' return error values of last db operation
' Params:
' as_ErrorCodes (String)
' as_ErrorMessages (String)
' ab_Asynchronous (Boolean = False)
' al_Cursor (Long = 0)

Private Sub GetErrorCodesAndErrorMessages(ByRef as_ErrorCodes As String, ByRef as_ErrorMessages As String, _
  Optional ByVal ab_Asynchronous As Boolean = False, Optional ByVal al_cursor As Long = 0)
    Dim lv_SQLErrorCodes As Variant
    Dim lv_SQLErrorMessages As Variant

On Error GoTo errHandler:

    If Not (mo_Db Is Nothing) Then
      If ab_Asynchronous Then
          lv_SQLErrorCodes = mo_Db.SQLAsynchErrorCodes(al_cursor)
          lv_SQLErrorMessages = mo_Db.SQLAsynchErrorMessages(al_cursor)
      Else
          lv_SQLErrorCodes = mo_Db.SQLErrorCodes
          lv_SQLErrorMessages = mo_Db.SQLErrorMessages
      End If
      
      If IsArray(lv_SQLErrorCodes) Then
          as_ErrorCodes = Join(lv_SQLErrorCodes, ",")
          as_ErrorMessages = Join(lv_SQLErrorMessages, ",")
      Else
          as_ErrorCodes = ""
          as_ErrorMessages = ""
      End If
    End If
    Exit Sub
errHandler:
    Call ErrorHandler("GetErrorCodesAndErrorMessages")
End Sub

Private Sub LanguageChanged(as_Language As String)
On Error GoTo errHandler
    
    ' change charset
    
    Dim lo_array As Collection
    Set lo_array = New Collection
    
    ' controls that are language dependent of selected language, except grids - grids are set in fill functions
    Call lo_array.Add(txt_RP_DocumentTitle)
    Call lo_array.Add(txt_RP_Desc)
    Call lo_array.Add(txt_RP_Internet_Desc)
    Call lo_array.Add(txt_RP_Text)
    Call lo_array.Add(txt_RP_Town)
    Call lo_array.Add(txt_RP_CustomerInfo)
    Call lo_array.Add(grd_RP_Main)
    Call lo_array.Add(grd_RP_Documents)
    
    Dim ll_codePage As Long
    ll_codePage = GetCodePageFromLanguage(mo_Db, as_Language)
    Call ChangeCharset(lo_array, ll_codePage)
    Set lo_array = Nothing

    Exit Sub
errHandler:
    Call ErrorHandler("LanguageChanged()")
End Sub


' Loads data to grid
Private Sub LoadGrid()
Const C_REQ As String = "EXEC RP_Reference_Project_lst '$DateMin$', '$DateMax$', '$CT_code$', $Opt_search$, '$SearchStr$', '$InternetFlag$', 'E', '$LangSubCode$'"
On Error GoTo errHandler
    Call grd_RP_Main.Load(ReplaceHolders(C_REQ), False)
    Exit Sub
errHandler:
     Call ErrorHandler("SfbRefPro.LoadGrid")
End Sub



' Return the result of a SQL request
' Convert SQL runtime errors and process errors to VB Error
#If LIVE = 1 Then
Private Function OpenSQLSafe(ByVal ao_DB As Object, ByVal as_Request As String, Optional ByVal al_RowExpectedCount = -1) As Long
#Else
Private Function OpenSQLSafe(ByVal ao_DB As ARMSYSCOMLib.ArmDb, ByVal as_Request As String, Optional ByVal al_RowExpectedCount = -1) As Long
#End If

On Error GoTo errHandler

    Dim lc_Data As Long
    lc_Data = ao_DB.OpenSQL(as_Request)
    
    If lc_Data = 0 Then
        Err.Raise ArmErr.SQLFailure, "SQL : " & as_Request, Join(ao_DB.SQLErrorCodes, SEP2) & SEP1 & Join(ao_DB.SQLErrorMessages, SEP2)
    End If
    
    If al_RowExpectedCount <> -1 Then
        ' Then check the rowcount
        If ao_DB.RowCount(lc_Data) <> al_RowExpectedCount Then
            Err.Raise ArmErr.SQLBadRowExpectedCount, "SQL : " & as_Request, al_RowExpectedCount & "<>" & ao_DB.RowCount(lc_Data)
        End If
    End If

    OpenSQLSafe = lc_Data

    Exit Function

errHandler:
    Call ErrorHandler("OpenSQLSafe")

End Function


' Execute a SQL request returning no data
' Convert SQL runtime errors and process errors to VB Error
' Params:
' ao_Db (Object)
' as_Request (String)
' al_RowAffectedCount (String)
#If LIVE = 1 Then
Private Sub ExecuteSQLSafe(ByVal ao_DB As Object, ByVal as_Request As String, Optional ByVal al_RowAffectedCount = -1, Optional ab_DuplicityCheck As Boolean = False)
#Else
Private Sub ExecuteSQLSafe(ByVal ao_DB As ARMSYSCOMLib.ArmDb, ByVal as_Request As String, Optional ByVal al_RowAffectedCount = -1, Optional ab_DuplicityCheck As Boolean = False)
#End If
On Error GoTo errHandler

    ' First execute the request
    If Not ao_DB.ExecuteSQL(as_Request) Then
        Err.Raise ArmErr.SQLFailure, "SQL : " & as_Request, Join(ao_DB.SQLErrorCodes, SEP2) & SEP1 & Join(ao_DB.SQLErrorMessages, SEP2)
    End If

    If al_RowAffectedCount <> -1 Then
        ' Then check the rowcount
        If ao_DB.SQLRowsAffected <> al_RowAffectedCount Then
            
            If ab_DuplicityCheck Then
                Err.Raise ArmCusErr.DuplicityDetected, "SQL : " & as_Request, al_RowAffectedCount & "<>" & ao_DB.SQLRowsAffected
            Else
                Err.Raise ArmErr.SQLBadRowAffectedCount, "SQL : " & as_Request, al_RowAffectedCount & "<>" & ao_DB.SQLRowsAffected
            End If
        End If
    End If

    Exit Sub

errHandler:
    Call ErrorHandler("ExecuteSQLSafe")
End Sub


Private Sub cbo_RP_DocumentType_ComboItemSelected()
    If cbo_RP_DocumentType.SelectedItem Is Nothing Then
        fil_Full.Pattern = "*.*"
    Else
        fil_Full.Pattern = "*." & cbo_RP_DocumentType.Text
    End If
End Sub

Private Sub cbo_RP_MarketSeg_ComboItemSelected()
On Error GoTo errHandler

    If mb_LoadingData Then
        Exit Sub
    End If
    SetMousePointer False
    
'P615
    If RPActiveScreen = RPEdit Then
        If Not (CheckMarket) Then
                ASC_SendMessage ms_LanguageCode, ErrMsgInvalidArea, "#document linked to an invalid area"
                SetMousePointer True
                Exit Sub
        End If
    End If
    ' setup checkviem by market segmentation selected item

    cvw_RP_RecommendedArea.Calling_Key_Values = CStr(cbo_RP_MarketSeg.SelectedItem.Key) & "®©E®©" & ml_CurrRPcode & "®©" & ml_UserCode & "®©" & cbo_RP_MarketSeg.SelectedItem.Key
    cvw_RP_RecommendedArea.LoadEditLists
    If me_RPActiveScr = RPEdit Then
      Call cvw_RP_RecommendedArea.LoadList ' load checked item for edit mode only - because then if user dont change market segment nothing will be saved
    Else
      Call cvw_RP_RecommendedArea.SetVisibleList("CHEC")
    End If
    SetMousePointer True
    Exit Sub
errHandler:
    Call ErrorMessage("SfbRefPro.cbo_RP_MarketSeg_ComboItemSelected")
    SetMousePointer True
End Sub

Private Sub dir_Full_Change()
On Error GoTo errHandler
    SetMousePointer False
    fil_Full.Path = dir_Full.Path
    SetMousePointer True
    Exit Sub
errHandler:
    Call ErrorMessage("SfbRefPro.dir_Full_Change")
    SetMousePointer True
End Sub

Private Sub drv_Full_Change()
On Error GoTo errHandler
    SetMousePointer False
    dir_Full.Path = drv_Full.Drive
    SetMousePointer True
    Exit Sub
errHandler:

    Call ErrorMessage("SfbRefPro.drv_Full_Change")
    SetMousePointer True
End Sub

Private Sub fil_Full_Click()
On Error GoTo errHandler
    SetMousePointer False
    txt_RP_DocumentPath.Text = mo_FSO.BuildPath(fil_Full.Path, fil_Full.FileName)
    SetMousePointer True
    Exit Sub
errHandler:
    Call ErrorMessage("SfbRefPro.fil_Full_Click")
    SetMousePointer True
End Sub



'Private Sub grd_RP_BIMarketing_ItemSelected()
'On Error GoTo ErrHandler
'    SetMousePointer False
'    RPStoreSubRecord RPSubProdAdd ' adds product by codes sub item
'    SetMousePointer True
'    Exit Sub
'ErrHandler:
'    Call ErrorMessage("SfbRefPro.grd_RP_BIMarketing_ItemSelected")
'    SetMousePointer True
'End Sub


' return command to be executed to open file with specific extension
Private Function GetCommand(ByVal as_ext As String, ByRef as_DDEExec As String, ByRef as_Application As String, ByRef as_Topic As String, ByVal ao_shell As Object) As String

    Dim ls_defValue As String

    GetCommand = ""

    On Error GoTo exitFnc
    ls_defValue = ao_shell.RegRead("HKCR\." & as_ext & "\")
    If ls_defValue = "" Then
        Call Err.Raise(CompFncFailed, "", "File extension is not supported.")
    End If
    
    Dim ls_cmd As String
    
    ls_cmd = ao_shell.RegRead("HKCR\" & ls_defValue & "\shell\Open\command\")
    If ls_cmd = "" Then
        Call Err.Raise(CompFncFailed, "", "Open command not defined.")
    End If
    GetCommand = ls_cmd
    
    ' try to locate DDEExec, if not exception is rised
    as_DDEExec = ao_shell.RegRead("HKCR\" & ls_defValue & "\shell\Open\ddeexec\")
    as_Application = ao_shell.RegRead("HKCR\" & ls_defValue & "\shell\Open\ddeexec\application\")
    as_Topic = ao_shell.RegRead("HKCR\" & ls_defValue & "\shell\Open\ddeexec\topic\")

    Exit Function
exitFnc:
End Function

#If LIVE Then
Private Function DownloadZipFile(ByVal ao_Armdb As Object, ByVal al_RZ_ID As Long, ByVal as_FileName As String) As String
#Else
Private Function DownloadZipFile(ByVal ao_Armdb As ARMSYSCOMLib.ArmDb, ByVal al_RZ_ID As Long, ByVal as_FileName As String) As String
#End If
On Error GoTo errHandler
    
    Dim ls_path As String
    
    ls_path = App.Path & C_TEMPDIR & al_RZ_ID & "\"
    
    ' check if file exists in local temporary directory
    If mo_FSO.FileExists(ls_path & as_FileName) Then
        DownloadZipFile = ls_path & as_FileName
        Exit Function
    End If
    
    If Not mo_FSO.FolderExists(ls_path) Then
        Call CreateDirStruct(ls_path, mo_FSO)
        Debug.Assert (mo_FSO.FolderExists(ls_path))     ' folder Download must exists
    End If
    
    ' download media from SQL server and decompress
    Call DownloadBlob(al_RZ_ID, ls_path & as_FileName)
    
    Debug.Assert (mo_FSO.FileExists(ls_path & as_FileName))
    DownloadZipFile = ls_path & as_FileName
    
Exit Function
errHandler:
    Call Err.Raise(Err.Number, "DownloadZipFile" & SEP1 & Err.Source, Err.Description, Err.HelpFile, Err.HelpContext)
End Function

Private Sub DownloadBlob(ByVal as_ID As String, ByVal as_filePath As String)
On Error GoTo errHandler
    

    Dim ls_SQL As String
    ls_SQL = "SELECT RPD_Blob FROM RP_Document_Blob WHERE RPD_code=$Code$"
    ls_SQL = Replace(ls_SQL, "$Code$", as_ID)

    If Not mo_Db.BlobToFileSQL(ls_SQL, as_filePath, True, False) Then
         Err.Raise ArmErr.SQLFailure, "SQL : " & ls_SQL, Join(mo_Db.SQLErrorCodes, SEP2) & SEP1 & Join(mo_Db.SQLErrorMessages, SEP2)
    End If
    Exit Sub
errHandler:
    Call ErrorHandler("DownloadBlob()")
End Sub

' create directory if not exist
Private Function CreateDirStruct(ByVal strPath As String, ByVal ao_FSO As Object) As Boolean

On Error GoTo Create_Dir_Struct_Errors
    Dim intIndex    As Integer
    Dim strTmpPath  As String
    
    If Len(Trim$(strPath)) = 0 Then
        ' if we specify wrong path it is error
        CreateDirStruct = False
        Exit Function
    End If
    
    If right$(strPath, 1) <> "\" Then strPath = strPath & "\"
    intIndex = 0
    
    Do
        ' get the next path chunk
        intIndex = InStr(intIndex + 1, strPath, "\")
        
        If intIndex > 0 Then
            strTmpPath = Left$(strPath, intIndex - 1)
        Else
            Exit Do
        End If
        
        ' see if this folder exists
        If Not ao_FSO.FolderExists(strTmpPath) Then
            ' Create this folder.
            ' If there is an error, it will be trapped bellow
            ao_FSO.CreateFolder strTmpPath
            intIndex = 1
        End If
    Loop
    CreateDirStruct = True
    Exit Function

Create_Dir_Struct_Errors:
    CreateDirStruct = False
    Call ErrorHandler("CreateDirStruct()")
End Function

Private Sub grd_RP_Documents_ItemSelected()
On Error GoTo errHandler

    Call ExecuteDocument(grd_RP_Documents.CurrentLine("RPD_code"), grd_RP_Documents.CurrentLine("RF_desc"))
    
    Exit Sub
errHandler:
    Call ErrorHandler("SfbRefPro.grd_RP_Documents_ItemSelected")
End Sub

Private Sub grd_RP_Documents_SelChange()
On Error GoTo errHandler
    
    ' check if selected row containt small image
    tlb_RP_DocumentTasks.ButtonEnabled("v") = grd_RP_Documents.CurrentLine("RPD_Code_small") > 0
    
    Exit Sub
errHandler:
    Call ErrorHandler("SfbRefPro.grd_RP_Documents_ItemSelected")
End Sub

Private Sub grd_RP_FreeTextStored_ItemSelected()
On Error GoTo errHandler
    SetMousePointer False
    Call RPStoreSubRecord(RPSubFreeAdd, grd_RP_FreeTextStored.SelectedKey(0)(0))  ' adds product by codes sub item
    SetMousePointer True
    Exit Sub
errHandler:
    Call ErrorHandler("SfbRefPro.grd_RP_FreeTextStored_ItemSelected")
    SetMousePointer True
End Sub

Private Sub grd_RP_Main_ItemSelected()
On Error GoTo errHandler


    Screen.MousePointer = vbHourglass
    ' clear form
    Call RPClearDetail
    RPActiveScreen = RPDtl
    ' and loads values
    RPLoadToForm grd_RP_Main.SelectedKey(0)(0)
    Screen.MousePointer = vbDefault
    Exit Sub
errHandler:
    Screen.MousePointer = vbDefault
    Call ErrorHandler("SfbRefPro.grd_RP_Main_ItemSelected")
End Sub

Public Sub Move(ByVal aLeft As Single, ByVal aTop As Single, ByVal aWidth As Single, ByVal aHeight As Single)
    Call UserControl.Extender.Move(aLeft, aTop, aWidth, aHeight)
End Sub
Public Property Let Visible(ByVal aVisible As Boolean)
    UserControl.Extender.Visible = aVisible
End Property
Public Property Get Visible() As Boolean
    Visible = UserControl.Extender.Visible
End Property

Private Sub grd_RP_Products_DblClick()
On Error GoTo errHandler
    ' only Add/Update screen allows to change Shape_Used
    If RPActiveScreen <> RPEdit Then Exit Sub

    Call SetMousePointer(False)

    grd_RP_Products.SelectedLine(0, "Shape_Used") = IIf(grd_RP_Products.SelectedLine(0, "Shape_Used") = "CHECK", "UNCHECK", "CHECK")
    
    ' update DB immediatelly
    Call RPUpdateBIMarketing_link(ml_CurrRPcode, grd_RP_Products.SelectedKey(0)(0), IIf(grd_RP_Products.SelectedLine(0, "Shape_Used") = "CHECK", "X", " "))
    
    Call SetMousePointer(True)
    Exit Sub
errHandler:
    Call ErrorMessage("SfbRefPro.grd_RP_Products_DblClick")
    Call SetMousePointer(True)
End Sub

Private Sub tbs_RP_Products_Click()
On Error GoTo errHandler
    SetMousePointer False
    Select Case RPActiveSubScreen
        Case RPSubProdMain, RPSubFreeMain, RPSubDocMain, RPSubCustMain
           Select Case tbs_RP_Products.SelectedItem.Index
           
               Case 1
                   RPActiveSubScreen = RPSubProdMain
               Case 2
                   RPActiveSubScreen = RPSubFreeMain
               Case 3
                   RPActiveSubScreen = RPSubDocMain
               Case 4
                   RPActiveSubScreen = RPSubCustMain
           End Select
    End Select
    
    SetMousePointer True
    Exit Sub
errHandler:
    Call ErrorMessage("SfbRefPro.tbs_RPProducts_Click")
    SetMousePointer True
End Sub

Private Sub tlb_RP_CustomersTasks_action(ByVal as_Role As String, as_Language As String)
On Error GoTo errHandler
    Select Case as_Role
        Case "A"
            RPActiveSubScreen = RPSubCustAdd ' starts adding new customers
        Case "C"
            If grd_RP_Customers.SelectedCount = 0 Then
                ASC_SendMessage ms_LanguageCode, WarMsgSelectRow, "#Please select a row."
            Else
                RPRemoveSubRecord RPSubCustMain ' removes document sub item
            End If
    End Select
    Exit Sub
errHandler:
    Call ErrorMessage("SfbRefPro.tlb_RP_DocumentTasks_action")
End Sub

Private Sub tlb_RP_DocumentTasks_action(ByVal as_Role As String, as_Language As String)
On Error GoTo errHandler
    Select Case as_Role
        Case "A"
            RPActiveSubScreen = RPSubDocAdd ' starts adding new documents
'P615
            cvw_RP_RecommendedArea.SetVisibleList ("CHEC")
'            cvw_RP_RecommendedArea.Calling_Key_Values = ms_MKS_Code & "®©E®©" & ml_CurrRPcode & "®©" & ml_UserCode
'            cvw_RP_RecommendedArea.Calling_Key_Values = ml_CurrRPDcode & "®©E®©" & ml_CurrRPcode & "®©" & ml_UserCode
            cvw_RP_RecommendedArea.Calling_Key_Values = ml_CurrRPDcode & "®©E®©" & ml_CurrRPcode & "®©" & ml_UserCode & "®©" & cbo_RP_MarketSeg.SelectedItem.Key
            cvw_RP_RecommendedArea.LoadEditLists
            cvw_RP_RecommendedArea.LoadList
            cvw_RP_RecommendedArea.Checkboxes = True
            Call cvw_RP_RecommendedArea.UnCheckAll("CHEC")
            
        Case "B"
            If grd_RP_Documents.SelectedCount = 0 Then
                ASC_SendMessage ms_LanguageCode, WarMsgSelectRow, "#Please select a row."
            Else
                RPActiveSubScreen = RPSubDocUpd ' starts updating document record
                RPLoadToSubForm RPSubDocUpd
'P615
                cvw_RP_RecommendedArea.SetVisibleList ("CHEC")
'                cvw_RP_RecommendedArea.Calling_Key_Values = ml_CurrRPDcode & "®©E®©" & ml_CurrRPcode & "®©" & ml_UserCode
                cvw_RP_RecommendedArea.Calling_Key_Values = ml_CurrRPDcode & "®©E®©" & ml_CurrRPcode & "®©" & ml_UserCode & "®©" & cbo_RP_MarketSeg.SelectedItem.Key
                cvw_RP_RecommendedArea.LoadEditLists
                cvw_RP_RecommendedArea.LoadList
                cvw_RP_RecommendedArea.Checkboxes = True
            
            End If
        Case "C"
            If grd_RP_Documents.SelectedCount = 0 Then
                ASC_SendMessage ms_LanguageCode, WarMsgSelectRow, "#Please select a row."
            Else
                RPRemoveSubRecord RPSubDocMain ' removes document sub item
            End If
        Case "Z"    ' update sequence only
            If grd_RP_Documents.SelectedCount = 0 Then
                ASC_SendMessage ms_LanguageCode, WarMsgSelectRow, "#Please select a row."
            Else
                Call RPUpdateSequence(ml_CurrRPcode, grd_RP_Documents.SelectedKey(0)(0))  ' removes document sub item
                ' update grid
                Dim ll_i As Long
                For ll_i = 0 To grd_RP_Documents.Rows - 1
                    grd_RP_Documents.Data(ll_i, "RPD_Sequence") = IIf(ll_i = grd_RP_Documents.Row, 1, 0)
                Next
            End If
        Case "v"    ' view small image
            If grd_RP_Documents.SelectedCount = 0 Then
                ASC_SendMessage ms_LanguageCode, WarMsgSelectRow, "#Please select a row."
            Else
                If grd_RP_Documents.CurrentLine("RPD_Code_small") > 0 Then
                    ' open preview
                    Call ExecuteDocument(grd_RP_Documents.CurrentLine("RPD_Code_small"), "BMP")
                End If
            End If
            
    End Select

    
    Exit Sub
errHandler:
    Call ErrorMessage("SfbRefPro.tlb_RP_DocumentTasks_action")
End Sub

Private Sub tlb_RP_FreeTextTasks_action(ByVal as_Role As String, as_Language As String)
On Error GoTo errHandler
    Select Case as_Role
        Case "A"
            RPActiveSubScreen = RPSubFreeAdd ' start adding products by free text
        Case "C"
            If grd_RP_FreeText.SelectedCount = 0 Then
                ASC_SendMessage ms_LanguageCode, WarMsgSelectRow, "#Please select a row."
            Else
                RPRemoveSubRecord RPSubFreeMain ' removes product by free text sub item
            End If

    End Select
    Exit Sub
errHandler:
    Call ErrorMessage("SfbRefPro.tlb_RP_FreeTextTasks_action")
End Sub

Private Sub tlb_RP_ProductTasks_action(ByVal as_Role As String, as_Language As String)
On Error GoTo errHandler
    Select Case as_Role
        Case "A"
            RPActiveSubScreen = RPSubProdAdd ' starts adding products by code from bi_marketing
            
            Load Item_sel
            Item_sel.ms_TypeCodeReturn = 3
            Item_sel.show 1
            If gb_Return = OK Then
                If gs_Photo = "" Then
                    ASC_SendMessage ms_LanguageCode, WarMsgSelectRow, "#Please select a row."
                Else
                    Call RPStoreSubRecord(RPSubProdAdd, gs_Photo)  ' adds product by codes sub item
                End If
            End If
            ' move screen back
            Call RPProductCancel

        Case "C"
            If grd_RP_Products.SelectedCount = 0 Then
                ASC_SendMessage ms_LanguageCode, WarMsgSelectRow, "#Please select a row."
            Else
                RPRemoveSubRecord RPSubProdMain ' removes product by codes sub item
            End If
    End Select
    Exit Sub
errHandler:
    Call ErrorMessage("SfbRefPro.tlb_RP_ProductTasks_action")
End Sub

Private Sub tlb_RP_Tasks_Action(ByVal as_Role As String, as_Language As String)
On Error GoTo errHandler
    SetMousePointer False
    Select Case RPActiveScreen
        Case RPMain
            If (as_Role = "B" Or as_Role = "C") And grd_RP_Main.SelectedCount = 0 Then
                ASC_SendMessage ms_LanguageCode, WarMsgSelectRow, "#Please select a row."
            Else
                Select Case as_Role
                    Case "A" ' add new record
                        Call RPClearDetail
                        RPActiveScreen = RPAdd
                        Call RPDefaultValues
                    Case "B" ' edit selected record
                        If grd_RP_Main.SelectedLine(0, "IFLAG") = "" Or mb_HaveIntFlagRight Then
                            Call RPClearDetail
                            RPActiveScreen = RPEdit
                            ' loads data of selected record to controls
                            RPLoadToForm grd_RP_Main.SelectedKey(0)(0)
                        Else
                            ' you do not have rights enough to edit this row
                            Call ASC_SendMessage(ms_LanguageCode, ErrNotEnoughRights, "#You do not have enough rights to edit this row.")
                        End If
                    Case "C" ' remove seleced record
                        If grd_RP_Main.SelectedLine(0, "IFLAG") = "" Or mb_HaveIntFlagRight Then
                            Call RPClearDetail
                            RPActiveScreen = RPRem
                            RPLoadToForm grd_RP_Main.SelectedKey(0)(0) ' and loads values
                        Else
                            ' you do not have rights enough to delete this row
                            Call ASC_SendMessage(ms_LanguageCode, ErrNotEnoughRights, "#You do not have enough rights to edit this row.")
                        End If
                    Case "D"
                        ms_LanguageSubCode = as_Language
                        If Not ms_LanguageSubCode = "E" Then
                            tlb_RP_DocumentTasks.ButtonEnabled("A") = False
                            tlb_RP_DocumentTasks.ButtonEnabled("C") = False
                        Else
                            tlb_RP_DocumentTasks.ButtonEnabled("A") = True
                            tlb_RP_DocumentTasks.ButtonEnabled("C") = True
                        End If
                        Call LanguageChanged(ms_LanguageSubCode)
                        LoadGrid
                    Case "E" ' reloads data to grid
                        LoadGrid
                    Case "G"       ' export to excell
                        Call ExportExcel(mo_Db, True, ms_ConnectString, ms_LanguageCode, grd_RP_Main, DataTypeEnum.Reference_Project)
                    Case "F" ' quit
                        RaiseEvent quit
                End Select
            End If
        Case RPAdd, RPEdit, RPDtl, RPRem
'P615
            If RPActiveScreen = RPEdit And as_Role <> "B" Then
                If Not (CheckMarket) Then
                    ASC_SendMessage ms_LanguageCode, ErrMsgInvalidArea, "#document linked to an invalid area"
                End If
            End If

            Select Case as_Role
                Case "A" ' save record
                    RPStoreRecord
                Case "B" ' restore start values
                    RPRestoreRecord
                Case "C" ' leaves screen
                    Select Case RPActiveSubScreen
                        Case RPSubDocMain, RPSubFreeMain, RPSubProdMain, RPSubCustMain ' leaves record screen
                            Call RPCancel(RPActiveScreen = RPAdd Or RPActiveScreen = RPEdit)
                        Case RPSubDocAdd, RPSubDocUpd
                            RPDocumentCancel ' cancels adding or updating documents
                        Case RPSubFreeAdd
                            RPFreeTextCancel ' cancels adding free text products
'                        Case RPSubProdAdd
'                            RPProductCancel ' cancels adding products from bi_marketing
                        Case RPSubCustAdd
                            RPCustomerCancel ' cancels adding products from customers
                        Case Else
                            Debug.Assert (False)
                    End Select
                Case "D" ' removes record
                    RPRemoveRecord
                Case "M" ' add sub item
                    Select Case RPActiveSubScreen
'                         Case RPSubProdAdd
'                            If grd_RP_BIMarketing.SelectedCount = 0 Then
'                                ASC_SendMessage ms_LanguageCode, WarMsgSelectRow, "#Please select a row."
'                            Else
'                                RPStoreSubRecord RPSubProdAdd ' adds product by codes sub item
'                            End If
                         Case RPSubFreeAdd
                            If grd_RP_FreeTextStored.SelectedCount = 0 Then
                                ASC_SendMessage ms_LanguageCode, WarMsgSelectRow, "#Please select a row."
                            Else
                                Call RPStoreSubRecord(RPSubFreeAdd, grd_RP_FreeTextStored.SelectedKey(0)(0))  ' adds product by free text sub item
                            End If
                        Case RPSubDocAdd
'P615

                            If RPStoreSubRecord(RPActiveSubScreen, "") Then ' adds or updatedocument sub item
'P615 keep photographer & copyright cbo at the previous value
                                ClearForm UserControl.Controls, fra_RP_Document_Sub, Array(cbo_RP_DocumentType, cbo_RP_DocumentClass, cbo_RP_DocumentCategory, cvw_RP_RecommendedArea)
                                cvw_RP_RecommendedArea.UnCheckAll ("CHEC")
                            End If


                        
                        Case RPSubDocUpd
'p615
'                            Call RPStoreSubRecord(RPActiveSubScreen, "") ' adds or updatedocument sub item
                            If RPStoreSubRecord(RPActiveSubScreen, "") Then ' adds or updatedocument sub item
                                RPActiveSubScreen = RPSubDocMain
                            End If
                        Case RPSubCustAdd
                            Call RPStoreSubRecord(RPActiveSubScreen, "")  ' adds or updatedocument sub item
                            RPActiveSubScreen = RPSubCustMain
                        Case Else
                            Debug.Assert (False)
                    End Select
            End Select
    End Select
    SetMousePointer True
    Exit Sub
errHandler:
     Call ErrorMessage("SfbRefPro.tlb_RP_Tasks_Action")
     SetMousePointer True
End Sub


Private Sub Resize()

  fra_RP_Document_Sub.Left = 0
  fra_RP_Document_Sub.Top = 0
  fra_RP_Document_Sub.Width = fra_RP_Detail.Width + 250 ' frames width is handled strange in VB
  fra_RP_Document_Sub.Height = tbs_RP_Products.Top - 120
  
  fra_RP_FreeText_Sub.Left = 0
  fra_RP_FreeText_Sub.Top = 0
  fra_RP_FreeText_Sub.Width = fra_RP_Detail.Width + 250
  fra_RP_FreeText_Sub.Height = tbs_RP_Products.Top - 120
  
End Sub

' add new Customer into Customer tab
Private Sub ShowLink(as_ActionType As String)
Dim lo_LinkForm As LinkForm
Dim ls_CPR_Code
Dim ls_SQL
Dim ls_Cur As Long
Dim ll_Idx As Long

    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "SfbRefPro:ShowLink", "as_ActionType=" & as_ActionType
    #End If
    
    Dim ls_CustomerKey As String
    Select Case as_ActionType
        Case "Add"
            ls_CustomerKey = ""
        Case Else
            ls_CustomerKey = grd_RP_Customers.CurrentKey(0)
            If ls_CustomerKey = "" Then GoTo Trace_End
    End Select
    
    Set lo_LinkForm = New LinkForm
    Load lo_LinkForm
    
    lo_LinkForm.Language = ms_LanguageCode
    lo_LinkForm.ConnectString = ms_ConnectString

    Set lo_LinkForm.mt_CstValues = mt_CstValues
    'If mb_use_framework_connection = True Then
        Set lo_LinkForm.ArmDb = mo_Db
    'End If
    
    Call lo_LinkForm.ActivateRPCustomerSelection(grd_RP_Main.SelectedKey(0)(0), txt_RP_Desc.Text, "", "", "", "")
    
    If as_ActionType <> "Add" Then lo_LinkForm.Customer = ls_CustomerKey
    
    lo_LinkForm.SQLActionType = as_ActionType
    
    lo_LinkForm.Load_A_Com
    
    CapMouseOn True
    lo_LinkForm.show 1
    CapMouseOff True
    
    If lo_LinkForm.DataUpdated = True Then
        ls_CPR_Code = GetCodeFromCombo(lo_LinkForm.cbo_role)
        
        ' do check on mandatory fields
        If ls_CPR_Code <> "" Then
            ' check for duplicity
            ls_SQL = "exec RP_Customer_chk $RPCode$, '$CCU_CapKey$', $CPR_Code$, $Language_Code$"
            
            ls_SQL = Replace(ls_SQL, "$RPCode$", ml_CurrRPcode)
            ls_SQL = Replace(ls_SQL, "$Language_Code$", "'E'")
            ls_SQL = Replace(ls_SQL, "$CCU_CapKey$", lo_LinkForm.CCU_CapKey)
            ls_SQL = Replace(ls_SQL, "$CPR_Code$", ls_CPR_Code)
            
            ExecuteSQLSafe mo_Db, ls_SQL, 0, True
            
            ' construct insert for RP_Customer table
            ls_SQL = "RP_Customer_ins $RPCode$, $LangCode$, '$CCU_CapKey$', $CPR_Code$, $ZUCode$"
            
            ls_SQL = Replace(ls_SQL, "$RPCode$", ml_CurrRPcode)
            ls_SQL = Replace(ls_SQL, "$LangCode$", "'E'")
            ls_SQL = Replace(ls_SQL, "$CCU_CapKey$", lo_LinkForm.CCU_CapKey)
            ls_SQL = Replace(ls_SQL, "$CPR_Code$", ls_CPR_Code)
            ls_SQL = Replace(ls_SQL, "$ZUCode$", ml_UserCode)
            
            ExecuteSQLSafe mo_Db, ls_SQL, 1
            
            ' get additional info for actually added customer
            ls_SQL = "RP_Customer_sel $RPCode$, '$CCU_CapKey$', $CPR_Code$, $LangCode$"
            
            ls_SQL = Replace(ls_SQL, "$RPCode$", ml_CurrRPcode)
            ls_SQL = Replace(ls_SQL, "$LangCode$", "'E'")
            ls_SQL = Replace(ls_SQL, "$CCU_CapKey$", lo_LinkForm.CCU_CapKey)
            ls_SQL = Replace(ls_SQL, "$CPR_Code$", ls_CPR_Code)
            
            ls_Cur = OpenSQLSafe(mo_Db, ls_SQL)
            Debug.Assert (ls_Cur <> 0)
            
            grd_RP_Customers.AddLine
            For ll_Idx = 0 To mo_Db.FieldCount(ls_Cur)
                grd_RP_Customers.SelectedLine(0, mo_Db.GetFieldName(ls_Cur, ll_Idx)) = mo_Db.GetFields(ls_Cur, ll_Idx)
            Next
            ' set master 'colapsed'/'no icon' icon
            grd_RP_Customers.SelectedLine(0, "MasterDetail") = IIf(grd_RP_Customers.SelectedLine(0, "detailCount") = 0, C_MASTER_NO_DETAIL_ICON, C_MASTER_COLAPSED_ICON)
        Else
            ASC_SendMessage ms_LanguageCode, ErrMsgMandatoryAreEmpty, "#Mandatory fields are not filled."
        End If


    End If
    lo_LinkForm.Unload_A_Com
    
    Unload lo_LinkForm
    Set lo_LinkForm = Nothing
    
Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "SfbRefPro:ShowLink"
    #End If
    CapMouseOn
    Exit Sub
    
Trace_Err:
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "SfbRefPro:ShowLink"
    If Not lo_LinkForm Is Nothing Then
        Unload lo_LinkForm
        Set lo_LinkForm = Nothing
    End If

    Call ErrorMessage("SfbRefPro.ShowLink")
    CapMouseOn
End Sub

Private Function GetComboKey(ByRef ac_ComboBox As ArmCombobox)
    GetComboKey = ""
    
    If Not ac_ComboBox.SelectedItem Is Nothing Then
        GetComboKey = ac_ComboBox.SelectedItem.Key
    End If
End Function

Private Sub btn_checkAll_Click()
On Error GoTo errHandler
    SetMousePointer False
    
    Dim lo_ItemInfo As ArmItemInfo
    Dim l_i As Long
      
    For Each lo_ItemInfo In cvw_RP_RPExcludedCountries.RoleList("CHEC").Items
        lo_ItemInfo.CurrentChecked = True
    Next lo_ItemInfo
    
    Call cvw_RP_RPExcludedCountries.RoleList("CHEC").RefreshList
    SetMousePointer True
    Exit Sub
errHandler:
    Call ErrorMessage("SfbRefPro.btn_checkAll_Click")
    SetMousePointer True
End Sub

Private Sub btn_uncheckAll_Click()
On Error GoTo errHandler
    SetMousePointer False
    
    Call cvw_RP_RPExcludedCountries.UnCheckAll("CHEC")

    SetMousePointer True
    Exit Sub
errHandler:
    Call ErrorMessage("SfbRefPro.btn_uncheckAll_Click")
    SetMousePointer True
End Sub



Private Sub LockScreen(ByVal ab_lock As Boolean)

    Dim ll_errNumber As Long, ls_ErrSrc As String, ls_ErrDesc As String
    ll_errNumber = Err.Number
    ls_ErrSrc = Err.Source
    ls_ErrDesc = Err.Description

On Error GoTo errHandler
    Static ll_Count As Long
    Static ll_Mousepointer As Long
    Static lb_Locked As Boolean
      
      
    ll_Count = ll_Count + IIf(ab_lock, 1, -1)
    Debug.Assert (ll_Count >= 0)
    
    ' First lock
    If Not lb_Locked And ab_lock Then
        ll_Mousepointer = Screen.MousePointer
        Screen.MousePointer = vbHourglass
        LockWindowUpdate UserControl.hwnd
        lb_Locked = True
    End If
    
    ' Unlock
    If ll_Count = 0 Then
        DoEvents ' Flush events
        LockWindowUpdate 0
        UserControl.Refresh ' Repaint immediately
        Screen.MousePointer = ll_Mousepointer
        lb_Locked = False
    End If
    
    Err.Number = ll_errNumber
    Err.Source = ls_ErrSrc
    Err.Description = ls_ErrDesc
    
    Exit Sub
    
errHandler:
    Call ErrorHandler("LockScreen")
End Sub

Private Sub cal_filtersMax_datechangee()
On Error GoTo errHandler

    Call LockScreen(True)
    If IsDate(cal_filtersMax.date_courte) And IsDate(cal_FiltersMin.date_courte) Then
        If CDate(cal_filtersMax.date_courte) < CDate(cal_FiltersMin.date_courte) Then
            cal_filtersMax.SetFocus
            cal_filtersMax.reinit_cal
            Call MsgBox(MsgText(969, ms_LanguageCode, "#End date cannot be less than Start date"), vbInformation)
        Else
            ' refresh grid
            Call LoadGrid
        End If
    End If
    
    Call LockScreen(False)
    Exit Sub
    
errHandler:
    Call LockScreen(False)
    Call ErrorMessage("SfbRefPro.cal_filtersMax_datechangee")
End Sub

Private Sub cal_filtersMax_inoutcontainer(in_out As Byte)
    Static lo_oldContainer As VB.Frame
On Error GoTo errHandler

    Call LockScreen(True)
    If in_out Then
        Set lo_oldContainer = MoveControlToFront(cal_filtersMax)
    Else
        Debug.Assert (Not lo_oldContainer Is Nothing)
        Call MoveControlToFrame(cal_filtersMax, lo_oldContainer)
    End If
    
    Call LockScreen(False)

    Exit Sub
    
errHandler:
    Call LockScreen(False)

    Select Case Err.Number
    Case Else
        Call LogMessage("cal_filtersMax_inoutcontainer: " & Err.Number & ": " & Err.Source & ": " & Err.Description, "E")
        Call MsgBox("Error during the process, Contact immediatly your IT support.", vbCritical)
        End
    End Select
End Sub

Private Sub cal_FiltersMin_datechangee()
On Error GoTo errHandler
    Call LockScreen(True)
    
    If IsDate(cal_FiltersMin.date_courte) And IsDate(cal_filtersMax.date_courte) Then
        If CDate(cal_FiltersMin.date_courte) > CDate(cal_filtersMax.date_courte) Then
             cal_FiltersMin.SetFocus
             cal_FiltersMin.reinit_cal
             Call MsgBox(MsgText(968, ms_LanguageCode, "#Start date cannot be greater than End date"), vbInformation)
        Else
            ' refresh grid
            Call LoadGrid
        End If
    End If

    Call LockScreen(False)

    Exit Sub
    
errHandler:
    Call LockScreen(False)
    Call ErrorMessage("SfbRefPro.cal_FiltersMin_datechangee")
End Sub

Private Sub cal_FiltersMin_inoutcontainer(in_out As Byte)
    Static lo_oldContainer As VB.Frame
On Error GoTo errHandler

    Call LockScreen(True)
    If in_out Then
        Set lo_oldContainer = MoveControlToFront(cal_FiltersMin)
    Else
        Debug.Assert (Not lo_oldContainer Is Nothing)
        Call MoveControlToFrame(cal_FiltersMin, lo_oldContainer)
    End If
    
    Call LockScreen(False)

    Exit Sub
    
errHandler:
    Call LockScreen(False)

    Select Case Err.Number
    Case Else
        Call LogMessage("cal_FiltersMin_inoutcontainer: " & Err.Number & ": " & Err.Source & ": " & Err.Description, "E")
        Call MsgBox("Error during the process, Contact immediatly your IT support.", vbCritical)
        End
    End Select
End Sub

' function return original container
Private Function MoveControlToFront(ByRef ao_ctrl As Object) As Object
On Error GoTo errHandler
    Set MoveControlToFront = ao_ctrl.Container
    ao_ctrl.Top = ao_ctrl.Container.Top + ao_ctrl.Top
    ao_ctrl.Left = ao_ctrl.Container.Left + ao_ctrl.Left
    Set ao_ctrl.Container = ao_ctrl.Container.Container
    Exit Function
errHandler:
    Call ErrorHandler("SfbRefPro.MoveControlToFront")
End Function

' recalculate position correctly only in case of one level hierachical change
Private Function MoveControlToFrame(ByRef ao_ctrl As Object, ByRef ao_Frame As VB.Frame) As Object
On Error GoTo errHandler
    Set MoveControlToFrame = ao_ctrl.Container
    Set ao_ctrl.Container = ao_Frame
    ao_ctrl.Top = ao_ctrl.Top - ao_Frame.Top
    ao_ctrl.Left = ao_ctrl.Left - ao_Frame.Left
    Exit Function
errHandler:
    Call ErrorHandler("SfbRefPro.MoveControlToFrame")
End Function

Private Sub opt_FiltersDate_Click(Index As Integer)
On Error GoTo errHandler
    Dim lb_Visible As Boolean
    Call LockScreen(True)
    
    lb_Visible = (Index = 1)
    cal_FiltersMin.Visible = lb_Visible
    cal_filtersMax.Visible = lb_Visible
    
    
    Call LoadGrid
    
    Call LockScreen(False)
    Exit Sub
    
errHandler:
    Call LockScreen(False)
    Call ErrorMessage("opt_FiltersDate_Click")
End Sub

Private Sub cbo_FiltersCountry_ComboItemSelected()
On Error GoTo errHandler
    Call LockScreen(True)

    Call LoadGrid
    
    Call LockScreen(False)
    Exit Sub
    
errHandler:
    Call LockScreen(False)
    Call ErrorMessage("cbo_FiltersCountry_ComboItemSelected")
End Sub

Private Sub opt_fieldC_Click(Index As Integer)
On Error GoTo errHandler
    Call LockScreen(True)

    Call LoadGrid
    
    Call LockScreen(False)
    Exit Sub
    
errHandler:
    Call LockScreen(False)
    Call ErrorMessage("opt_fieldC_Click")
End Sub

Private Sub opt_Like_Click(Index As Integer)
On Error GoTo errHandler
    Call LockScreen(True)

    Call LoadGrid
    
    Call LockScreen(False)
    Exit Sub
    
errHandler:
    Call LockScreen(False)
    Call ErrorMessage("opt_Like_Click")
End Sub

Private Sub opt_inernet_Click(Index As Integer)
On Error GoTo errHandler
    Call LockScreen(True)

    Call LoadGrid
    
    Call LockScreen(False)
    Exit Sub
    
errHandler:
    Call LockScreen(False)
    Call ErrorMessage("opt_inernet_Click")
End Sub

Private Sub txt_LikeStr_Change()
On Error GoTo errHandler
    Call LockScreen(True)

    Call LoadGrid
    
    Call LockScreen(False)
    Exit Sub
    
errHandler:
    Call LockScreen(False)
    Call ErrorMessage("txt_LikeStr_Change")
End Sub

Private Function ReplaceHolders(ByVal as_Request As String) As String
On Error GoTo errHandler

    Dim ls_Request As String
    Dim lo_Obj As Object
    ls_Request = Replace(as_Request, "$LangSubCode$", ms_LanguageSubCode, , , vbTextCompare)
    
    Set lo_Obj = GetItemAtValue(opt_FiltersDate, True)
    Debug.Assert (Not lo_Obj Is Nothing)
    If lo_Obj.Index = 1 Then
        ' date between selected
        ls_Request = Replace(ls_Request, "$DateMin$", cal_FiltersMin.date_sql, , , vbTextCompare)
        ls_Request = Replace(ls_Request, "$DateMax$", cal_filtersMax.date_sql, , , vbTextCompare)
    Else
        ls_Request = Replace(ls_Request, "'$DateMin$'", "NULL", , , vbTextCompare)
        ls_Request = Replace(ls_Request, "'$DateMax$'", "NULL", , , vbTextCompare)
    End If
    If Not cbo_FiltersCountry.SelectedItem Is Nothing Then
        If IsEmpty(cbo_FiltersCountry.SelectedItem.Key) Then
            ls_Request = Replace(ls_Request, "'$CT_code$'", "NULL", , , vbTextCompare)
        Else
            ls_Request = Replace(ls_Request, "$CT_Code$", cbo_FiltersCountry.SelectedItem.Key, , , vbTextCompare)
        End If
    Else
        ls_Request = Replace(ls_Request, "'$CT_code$'", "NULL", , , vbTextCompare)
    End If
    
    Set lo_Obj = GetItemAtValue(opt_fieldC, True)
    If Not lo_Obj Is Nothing Then
        ls_Request = Replace(ls_Request, "$Opt_search$", lo_Obj.Index, , , vbTextCompare)
        Set lo_Obj = GetItemAtValue(opt_like, True)
        Debug.Assert (Not lo_Obj Is Nothing)
        Select Case lo_Obj.Index
            Case 0      ' xxx%
                ls_Request = Replace(ls_Request, "$SearchStr$", Replace(txt_LikeStr.Text, "'", "''") & "%", , , vbTextCompare)
            Case 1      ' %xxx%
                ls_Request = Replace(ls_Request, "$SearchStr$", "%" & Replace(txt_LikeStr.Text, "'", "''") & "%", , , vbTextCompare)
            Case 2      ' %xxx
                ls_Request = Replace(ls_Request, "$SearchStr$", "%" & Replace(txt_LikeStr.Text, "'", "''"), , , vbTextCompare)
            Case Else
                ls_Request = Replace(ls_Request, "$SearchStr$", "%", , , vbTextCompare)   ' all
        End Select
    Else
        ls_Request = Replace(ls_Request, "$Opt_search$", "NULL", , , vbTextCompare)
        ls_Request = Replace(ls_Request, "'$SearchStr$'", "NULL", , , vbTextCompare)
    End If
    
    
    Set lo_Obj = GetItemAtValue(opt_inernet, True)
    Debug.Assert (Not lo_Obj Is Nothing)
    Select Case lo_Obj.Index
        Case 0      ' ALL
            ls_Request = Replace(ls_Request, "'$InternetFlag$'", "NULL", , , vbTextCompare)
        Case 1      ' YES
            ls_Request = Replace(ls_Request, "$InternetFlag$", "X", , , vbTextCompare)
        Case 2      ' NO
            ls_Request = Replace(ls_Request, "$InternetFlag$", " ", , , vbTextCompare)
        Case Else
            Debug.Assert (False)
    End Select

    ReplaceHolders = ls_Request

    Exit Function
errHandler:
    Call ErrorHandler("ReplaceHolders")
End Function

Private Function GetItemAtValue(ByRef aoa_items As Object, ByVal av_Value As Variant) As Object
On Error GoTo errHandler
    Dim lo_Obj As Object
    For Each lo_Obj In aoa_items
        If lo_Obj.Value = av_Value Then
            Set GetItemAtValue = lo_Obj
            Exit For
        End If
    Next
    Exit Function
errHandler:
    Call ErrorHandler("GetItemAtValue")
End Function

Private Function GetRights() As Boolean
Const C_REQ As String = "EXEC A_Config_sel 'REFPRINT'"
On Error GoTo ErrorHandler
    Dim ll_cursor As Long
    Dim lsa_users() As String
    Dim ll_Index As Long
    
    GetRights = False
    ll_cursor = OpenSQLSafe(mo_Db, C_REQ)
    Debug.Assert (ll_cursor <> 0)
    
    If mo_Db.RowCount(ll_cursor) > 0 Then
        lsa_users = Split(mo_Db.GetFields(ll_cursor, 0), SEP1 + SEP2)
        For ll_Index = LBound(lsa_users) To UBound(lsa_users)
            If CStr(ml_UserCode) = lsa_users(ll_Index) Then
                GetRights = True
                Exit For
            End If
        Next
    End If
    Call mo_Db.Close(ll_cursor)
    Exit Function
ErrorHandler:
    If ll_cursor <> 0 Then Call mo_Db.Close(ll_cursor)
    Call ErrorHandler("GetRights()")
End Function

Private Sub RPClearDetail()
On Error GoTo errHandler
        Call ClearForm(UserControl.Controls, fra_RP_Detail)
        Call ClearForm(UserControl.Controls, fra_RP_Document)
        Call ClearForm(UserControl.Controls, fra_RP_Customers)
        Call ClearForm(UserControl.Controls, fra_RP_FreeText)
        Call ClearForm(UserControl.Controls, fra_RP_Product)
    Exit Sub
errHandler:
     Call ErrorHandler("SfbProRef.RPClearDetail")
End Sub


Private Function GetUserName(ByVal al_U_Code As Long) As String
On Error GoTo errHandler
Const C_REQ As String = "SELECT GENP.P_First_Name + ' ' + GENP.P_Name AS RP_User FROM GEN_Systems_Users GEN INNER JOIN GEN_People GENP ON GENP.P_Code = GEN.P_Code WHERE GEN.U_Code=$U_CODE$"
    Dim ls_Req As String
    Dim ll_cursor As Long
    
    ls_Req = Replace(C_REQ, "$U_CODE$", al_U_Code, , , vbTextCompare)
    ll_cursor = OpenSQLSafe(mo_Db, ls_Req)
    GetUserName = mo_Db.GetFields(ll_cursor, "RP_User")
    Call mo_Db.Close(ll_cursor)
    ll_cursor = 0
    Exit Function
errHandler:
    If ll_cursor > 0 Then
        Call mo_Db.Close(ll_cursor)
        ll_cursor = 0
    End If
    Call ErrorHandler("SfbProRef.GetUserName")
End Function

Private Function CheckAreaMarket() As Boolean
On Error GoTo errHandler
    Dim ll_Count As Long, ll_Idx As Long, ll_cursor As Long
    Dim ls_Req As String
    Dim lv_Key As Variant
    
    If RPActiveScreen <> RPEdit Then Exit Function

    
    CheckAreaMarket = False
    ms_Area = ""
        
    ls_Req = "exec Recommended_Comb_chk '$RA$','$MKS$'"
    
    ll_Count = cvw_RP_RecommendedArea.CheckedCount(cvw_RP_RecommendedArea.GetVisibleList)
    If ll_Count > 0 Then
        For ll_Idx = 0 To cvw_RP_RecommendedArea.RoleList("CHEC").CheckedCount - 1
            lv_Key = cvw_RP_RecommendedArea.CheckedKeys(cvw_RP_RecommendedArea.GetVisibleList)
            
            ls_Req = Replace(ls_Req, "$RA$", lv_Key(ll_Idx)(0))
            ls_Req = Replace(ls_Req, "$MKS$", cbo_RP_MarketSeg.SelectedItem.Key)
                
            ll_cursor = OpenSQLSafe(mo_Db, ls_Req)
            If mo_Db.RowCount(ll_cursor) <> 1 Then
                ms_Area = cvw_RP_RecommendedArea.RoleList("CHEC").GetItem(cvw_RP_RecommendedArea.RoleList("CHEC").CheckedKeys(ll_Idx)).GetData(1)
            
                Call mo_Db.Close(ll_cursor)
                ll_cursor = 0
                Exit Function
            End If
        Next

        Call mo_Db.Close(ll_cursor)
        ll_cursor = 0
    End If

    CheckAreaMarket = True
    Exit Function
errHandler:
    If ll_cursor > 0 Then
        Call mo_Db.Close(ll_cursor)
        ll_cursor = 0
    End If
    Call ErrorHandler("CheckAreaMarket()")
End Function


Private Function CheckMarket() As Boolean
On Error GoTo errHandler
    Dim ll_Count As Long, ll_Idx As Long, ll_cursor As Long
    Dim ls_Req As String
    Dim lv_Key As Variant
    
    If RPActiveScreen <> RPEdit Then Exit Function
    
    CheckMarket = False
    ms_Area = ""
        
    ls_Req = "exec Recommended_Comb_chk2 '$RP$','$MKS$'"
    
    ls_Req = Replace(ls_Req, "$MKS$", cbo_RP_MarketSeg.SelectedItem.Key)
    ls_Req = Replace(ls_Req, "$RP$", ml_CurrRPcode)
'   ls_req = Replace(ls_req, "$RP$", mo_Db.GetFields(mc_Cursor, "RP_code"))
    ll_cursor = OpenSQLSafe(mo_Db, ls_Req)
    If mo_Db.RowCount(ll_cursor) <> 0 Then
        ms_Area = mo_Db.GetFields(ll_cursor, "RA_desc")
        ms_DocumentTitle = mo_Db.GetFields(ll_cursor, "RPD_Title")
        
        Call mo_Db.Close(ll_cursor)
        ll_cursor = 0
        Exit Function
    End If


    Call mo_Db.Close(ll_cursor)
    ll_cursor = 0

    CheckMarket = True
    Exit Function
errHandler:
    If ll_cursor > 0 Then
        Call mo_Db.Close(ll_cursor)
        ll_cursor = 0
    End If
    Call ErrorHandler("CheckMarket()")
End Function


Private Function CheckDroppedArea() As Boolean
On Error GoTo errHandler
    Dim ll_Count As Long, ll_Idx As Long, ll_cursor As Long
    Dim ls_Req As String
    Dim lv_Key As Variant
    
    CheckDroppedArea = False
    ms_Area = ""
        
    
    ll_Count = cvw_RP_RecommendedArea.CheckedCount(cvw_RP_RecommendedArea.GetVisibleList)
    If ll_Count > 0 Then
        For ll_Idx = 0 To cvw_RP_RecommendedArea.RoleList("CHEC").CheckedCount - 1
            lv_Key = cvw_RP_RecommendedArea.CheckedKeys(cvw_RP_RecommendedArea.GetVisibleList)
            
            If cvw_RP_RecommendedArea.RoleList("CHEC").GetItem(cvw_RP_RecommendedArea.RoleList("CHEC").CheckedKeys(ll_Idx)).GetData(2) = "X" Then
                ms_Area = cvw_RP_RecommendedArea.RoleList("CHEC").GetItem(cvw_RP_RecommendedArea.RoleList("CHEC").CheckedKeys(ll_Idx)).GetData(1) & " "
                Exit Function
            End If
            
        Next

    End If

    CheckDroppedArea = True
    Exit Function
errHandler:
    Call ErrorHandler("CheckDroppedArea()")
End Function

Private Sub ImageArray()
On Error GoTo errHandler
    Dim ll_cursor As Long
    Dim ls_Req As String, ls_value As String
    Dim lv_Key As Variant
    Dim ll_Idx As Long
    
    ls_Req = "exec A_Config_sel 'RPD_Cat'"
    
    ll_cursor = OpenSQLSafe(mo_Db, ls_Req)
    If mo_Db.RowCount(ll_cursor) <> 0 Then
        ls_value = mo_Db.GetFields(ll_cursor, "CFG_Value")
        ls_value = Replace(ls_value, " ", "")
        ls_value = Replace(ls_value, "'", "")
        
        lv_Key = Split(ls_value, ",")
        
        ReDim ml_Image(UBound(lv_Key))
        
        For ll_Idx = 0 To (UBound(lv_Key))
            ml_Image(ll_Idx) = CLng(lv_Key(ll_Idx))
        Next
        
        Call mo_Db.Close(ll_cursor)
        ll_cursor = 0
        Exit Sub
    End If

    Exit Sub
errHandler:
    Call ErrorHandler("CheckMarket()")

End Sub

Private Function CategoryControl(ByVal al_RPDCat As Long) As Long
On Error GoTo errHandler

    Dim lb_Image As Boolean
    Dim ll_Idx As Long
    
    CategoryControl = 0
    lb_Image = False
        
' Is rpd_cat from combo is an image ?
    For ll_Idx = 0 To UBound(ml_Image)
        If al_RPDCat = ml_Image(ll_Idx) Then
            lb_Image = True
            Exit For
        End If
    Next
    
    If lb_Image Then
        If cvw_RP_RecommendedArea.CheckedCount("CHEC") = 0 Then
            CategoryControl = 1
        End If
    Else
        If cbo_DocLang.Text = "" Then
            CategoryControl = 2
        End If
    End If
    
    
    Exit Function
errHandler:
    Call ErrorHandler("CheckDroppedArea()")
End Function


' JN 15.6.2010
Private Function GetSmallImage(ByVal as_filePath As String, ByVal al_width As Long, ByVal al_height As Long, ByVal al_pictDepth As Long) As IPicture
On Error GoTo errHandler
    
    Dim lo_pict1 As New StdPicture
    Dim ld_Scale As Single
    Dim al_destW As Single
    Dim al_destH As Single
    
    Set GetSmallImage = Nothing
    
    al_destW = ScaleX(al_width, vbPixels, vbHimetric)
    al_destH = ScaleY(al_height, vbPixels, vbHimetric)
    
    Set lo_pict1 = SafeLoadImage(as_filePath)
    If lo_pict1 = 0 Then
        Exit Function
    End If

    If al_destW / lo_pict1.Width > al_destH / lo_pict1.Height Then
        ld_Scale = al_destH / lo_pict1.Height
    Else
        ld_Scale = al_destW / lo_pict1.Width
    End If
    
    Set GetSmallImage = GDIToPicture(CopyBitmap(lo_pict1.Handle, cbmDIB, HimetricToPixelsX(lo_pict1.Width * ld_Scale), HimetricToPixelsY(lo_pict1.Height * ld_Scale), al_pictDepth), True, , True)

Exit Function
errHandler:
    Call ErrorHandler("GetSmallImage()")
End Function

Private Function HimetricToPixelsX(ByVal inHimetric As Long) As Long
    HimetricToPixelsX = ConvertPixelHimetric(inHimetric, True, True)
End Function

Private Function HimetricToPixelsY(ByVal inHimetric As Long) As Long
    HimetricToPixelsY = ConvertPixelHimetric(inHimetric, True, False)
End Function

Private Function ConvertPixelHimetric(ByVal inValue As Long, _
    ByVal ToPix As Boolean, inXAxis As Boolean) As Long
    Dim TempIC As Long, GDCFlag As Long
    
    Const HimetricInch As Long = 2540
    
    TempIC = CreateIC("DISPLAY", vbNullString, vbNullString, ByVal 0&)
    
    If (TempIC) Then
        If (inXAxis) Then GDCFlag = LOGPIXELSX Else GDCFlag = LOGPIXELSY
        
        If (ToPix) Then _
            ConvertPixelHimetric = MulDiv(inValue, GetDeviceCaps(TempIC, GDCFlag), HimetricInch) _
        Else _
            ConvertPixelHimetric = MulDiv(inValue, HimetricInch, GetDeviceCaps(TempIC, GDCFlag))
        
        Call DeleteDC(TempIC)
    End If
End Function

Private Function CopyBitmap(ByVal inBMP As Long, _
    Optional ByVal inCopyMode As enCopyBMPMode = cbmSame, _
    Optional ByVal inNewWidth As Long = 0&, _
    Optional ByVal inNewHeight As Long = 0&, _
    Optional ByVal inNewDepth As Long = 0&, _
    Optional ByVal inStretchMode As enCopyBMPStretchMode = cbsmHalftone, _
    Optional ByRef inoutPalette As Long = 0&, _
    Optional ByVal inFlags As enCopyBMPFlags = 0&) As Long
    Dim BMInf As Bitmap
    Dim hSrcDC As Long, hSrcOldBMP As Long
    Dim hDstDC As Long, hDstBMP As Long, hDstOldBMP As Long
    Dim DIBInf As BitmapInfo
    Dim NumCol As Long
    Dim DeskWnd As Long, DeskDC As Long
    Dim UseWidth As Long, UseHeight As Long, UseDepth As Long
    Dim BlitRet As Long
    Dim hPal As Long, hOldPal As Long
    Dim Pal() As PaletteEntry, PalLen As Long
    
    ' Get some information about the source Bitmap
    If (GetObject(inBMP, Len(BMInf), BMInf) = 0) Then Exit Function
    
    Select Case inNewDepth ' Validate new depth (0 if un-defined)
        Case 0, 1, 4, 8, 16, 24, 32
        Case Else: Exit Function
    End Select
    
    ' Create some device contexts and select source Bitmap
    hSrcDC = CreateCompatibleDC(0&)
    hDstDC = CreateCompatibleDC(0&)
    hSrcOldBMP = SelectObject(hSrcDC, inBMP)
    
    ' Get size of result Bitmap
    If (inNewWidth) Then UseWidth = Abs(inNewWidth) Else UseWidth = BMInf.bmWidth
    If (inNewHeight) Then UseHeight = Abs(inNewHeight) Else UseHeight = BMInf.bmHeight
    If (inNewDepth) Then UseDepth = inNewDepth Else UseDepth = BMInf.bmBitsPixel
    
    If (hSrcOldBMP) Then ' If we're matching the format, select which the source was
        If (inCopyMode = cbmSame) Then inCopyMode = IIf(BMInf.bmBits, cbmDIB, cbmDDB)
        
        ' Converting to paletted depth, manage palette
        If (UseDepth <= 8&) Then
            If ((inoutPalette <> 0) And ((inFlags And cbfUseDefaultPalette) = 0&)) Then
                hPal = inoutPalette ' Use specified palette
            Else ' Create default halftone palette
                hPal = CreateHalftonePalette(hSrcDC)
            End If
            
            If (hPal) Then ' Get palette size
                Call GetObject(hPal, 4&, PalLen)
                
                If (PalLen > 0) Then ' Extract palette entries
                    ReDim Pal(0 To PalLen - 1) As PaletteEntry
                    Call GetPaletteEntries(hPal, 0&, PalLen - 1, Pal(0&))
                    
                    If ((inCopyMode = cbmDDB) And _
                        CBool(inFlags And cbfReturnPalette)) Then
                        ' Return the palette since DDB's require a seperate palette
                        inoutPalette = hPal
                    Else ' Destroy the HPALETTE since DIB's embed their palette
                        If ((inoutPalette = 0&) Or CBool(inFlags And cbfDestroyUserPalette)) Then _
                            Call DeleteObject(hPal)
                    End If
                End If
            End If
        End If
        
        If (inCopyMode = cbmDIB) Then ' Set DIB header size
            DIBInf.bmiHeader.biSize = Len(DIBInf.bmiHeader)
            
            ' Get DIB header information from source
            If (GetDIBits(hSrcDC, inBMP, 0&, 0&, ByVal 0&, DIBInf, DIB_RGB_COLORS)) Then
                If (((DIBInf.bmiHeader.biBitCount > 0) And _
                    (DIBInf.bmiHeader.biBitCount <= 8)) Or _
                    (DIBInf.bmiHeader.biCompression = BI_BITFIELDS)) Then
                    NumCol = DIBInf.bmiHeader.biClrUsed ' Get palette information
                    Call GetDIBits(hSrcDC, inBMP, 0&, 0&, ByVal 0&, DIBInf, DIB_RGB_COLORS)
                    DIBInf.bmiHeader.biClrUsed = NumCol
                End If
                
                With DIBInf.bmiHeader
                    ' If the bit-depth is being modified then the original bit-fields make no sense
                    If (.biBitCount <> UseDepth) Then .biCompression = BI_RGB
                    .biWidth = UseWidth
                    .biHeight = UseHeight
                    .biBitCount = UseDepth ' Fill DIB header with any new information about the size
                    .biSizeImage = ((((UseWidth * .biBitCount) + &H1F) And Not &H1F) \ &H8) * UseHeight
                End With
                
                If (hPal) Then
                    Dim LoopPal As Long
                    
                    For LoopPal = 0 To PalLen - 1
                        With Pal(LoopPal) ' Copy halftone palette into DIB palette
                            DIBInf.bmiColors(LoopPal) = RGB(.peRed, .peGreen, .peBlue)
                        End With
                    Next LoopPal
                    
                    ' Set palette length
                    DIBInf.bmiHeader.biClrUsed = PalLen
                End If
                
                ' Create new DIB with same header as source
                hDstBMP = CreateDIBSection(hDstDC, DIBInf, DIB_RGB_COLORS, 0&, 0&, 0&)
            End If
        Else
            If (BMInf.bmBitsPixel = 1) Then ' Special case 1-BPP DDB
                hDstBMP = CreateBitmap(UseWidth, UseHeight, 1&, 1&, ByVal 0&)
            Else ' Create new DDB compatible with the screen
                DeskWnd = GetDesktopWindow()
                DeskDC = GetDC(DeskWnd)
                hDstBMP = CreateCompatibleBitmap(DeskDC, UseWidth, UseHeight)
                Call ReleaseDC(DeskWnd, DeskDC)
            End If
        End If
        
        ' Select new Bitmap into destination DC
        hDstOldBMP = SelectObject(hDstDC, hDstBMP)
        
        If (hDstOldBMP) Then ' Copy source to destination
            
            ' Select the palette into the DC for DDB copies
            If ((hPal <> 0&) And (inCopyMode = cbmDDB)) Then _
                hOldPal = SelectObject(hDstDC, hPal)
            
            If ((UseWidth = BMInf.bmWidth) And (UseHeight = BMInf.bmHeight) And _
                (Not CBool(inFlags And cbfUseHalftoneDither) And (hPal <> 0))) Then ' Blit
                BlitRet = BitBlt(hDstDC, 0&, 0&, BMInf.bmWidth, _
                    BMInf.bmHeight, hSrcDC, 0&, 0&, vbSrcCopy)
            Else ' Stretch-blit
                If ((inFlags And cbfUseHalftoneDither) And (hPal <> 0)) Then
                    Call SetStretchBltMode(hDstDC, cbsmHalftone) ' Dither palette
                Else
                    Call SetStretchBltMode(hDstDC, inStretchMode)
                End If
                
                BlitRet = StretchBlt(hDstDC, 0&, 0&, UseWidth, UseHeight, _
                    hSrcDC, 0&, 0&, BMInf.bmWidth, BMInf.bmHeight, vbSrcCopy)
            End If
            
            ' De-select the palette if used
            If (hOldPal) Then Call SelectObject(hDstDC, hOldPal)
            
            If (BlitRet) Then ' Return copied Bitmap to caller
                CopyBitmap = hDstBMP
            Else ' Copy failed, destroy destination Bitmap
                Call DeleteObject(hDstBMP)
                hDstBMP = 0
            End If
            
            ' De-select destination Bitmap
            Call SelectObject(hDstDC, hDstOldBMP)
        Else ' Something went wrong
            Call DeleteObject(hDstBMP)
            hDstBMP = 0
        End If
        
        ' De-select source
        Call SelectObject(hSrcDC, hSrcOldBMP)
    End If
    
    ' Destroy surfaces
    Call DeleteDC(hDstDC)
    Call DeleteDC(hSrcDC)
End Function


Private Function GDIToPicture(ByVal inGDIObj As Long, _
    Optional ByVal inOwnObj As Boolean = True, _
    Optional ByVal inPal As Long = &H0, _
    Optional ByVal inDestroyOnFail As Boolean = False) As IPicture
    Dim IconInf As ICONINFO
    Dim PicDesc As PictDescGeneirc
    Dim RetPic As IPicture
    Dim TempEMF As Long
    Dim MetaHead As EnhMetaHeader
    Dim ObjType As Long
    
    ObjType = GetObjectType(inGDIObj)
    Select Case ObjType
        Case OBJ_BITMAP
            PicDesc.pdgSize = 16
            PicDesc.pdcPicType = PICTYPE_BITMAP
            PicDesc.pdcExtraA = inPal
        Case OBJ_METAFILE ' UNTESTED!
            PicDesc.pdgSize = 20
            PicDesc.pdcPicType = PICTYPE_METAFILE
            
            ' WMF objects don't store bounds information so perform
            ' temporary conversion to EMF and read header structure
            TempEMF = WMFToEMF(inGDIObj)
            If (TempEMF) Then
                Call GetEnhMetaFileHeader(TempEMF, Len(MetaHead), MetaHead)
                PicDesc.pdcExtraA = MetaHead.rclBounds.right
                PicDesc.pdcExtraB = MetaHead.rclBounds.bottom
                Call DeleteEnhMetaFile(TempEMF)
            End If
        Case OBJ_ENHMETAFILE
            PicDesc.pdgSize = 12
            PicDesc.pdcPicType = PICTYPE_ENHMETAFILE
        Case Else ' Test for icon/cursor
            If (GetIconInfo(inGDIObj, IconInf)) Then
                PicDesc.pdgSize = 12
                PicDesc.pdcPicType = PICTYPE_ICON
                
                ' Clean up Bitmap copies
                Call DeleteObject(IconInf.hbmColor)
                Call DeleteObject(IconInf.hbmMask)
            End If
    End Select
    
    ' Couldn't match this object against known types
    If (PicDesc.pdgSize = 0) Then Exit Function
    
    ' Set object handle
    PicDesc.pdcHandle = inGDIObj
    
    If (OleCreatePictureIndirect(PicDesc, IPictureGUID(), _
        inOwnObj, RetPic) = S_OK) Then Set GDIToPicture = RetPic
    Set RetPic = Nothing
    
    If ((GDIToPicture Is Nothing) And inDestroyOnFail) Then
        Select Case ObjType ' Call appropriate cleanup routine
            Case OBJ_BITMAP:      Call DeleteObject(inGDIObj)
            Case OBJ_METAFILE:    Call DeleteMetaFile(inGDIObj)
            Case OBJ_ENHMETAFILE: Call DeleteEnhMetaFile(inGDIObj)
            Case Else:            Call DestroyIcon(inGDIObj)
        End Select
    End If
End Function

Private Function IPictureGUID() As Guid
    ' IPicture GUID {7BF80980-BF32-101A-8BBB-00AA00300CAB}
    With IPictureGUID
        .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
End Function


Private Function WMFToEMF(ByVal inWMF As Long) As Long
    Dim EMetaDC As Long
    
    ' Create a new Enhanced metafile device context
    EMetaDC = CreateEnhMetaFile(0, vbNullString, ByVal 0&, vbNullString)
    Call PlayMetaFile(EMetaDC, inWMF)
    WMFToEMF = CloseEnhMetaFile(EMetaDC)
    
    If (WMFToEMF = 0) Then ' If first method fails, try copy method
        Dim WMFSize As Long, WMFData() As Byte
        Dim MetaInf As MetaFilePict
        
        ' Query WMF data size
        WMFSize = GetMetaFileBitsEx(inWMF, 0, ByVal 0&)
        If (WMFSize) Then ' Allocate data buffer and extract WMF data
            ReDim WMFData(WMFSize - 1) As Byte
            Call GetMetaFileBitsEx(inWMF, WMFSize, WMFData(0))
            
            MetaInf.hMF = inWMF ' Convert WMF data to EMF
            WMFToEMF = SetWinMetaFileBits(WMFSize, WMFData(0), 0, MetaInf)
        End If
    End If
End Function


Private Function SafeLoadImage(ByRef inFile As String) As IPictureDisp
    Dim LocalFileSize As Long
    Dim FNum As Integer
    Dim FileSig As Integer
    Dim BadFile As Boolean
    Dim TempImg As StdPicture

    Const JPEGSig = &HD9FF ' EOI tag
    Const GIFSig = &H3B    ' ;

    ' Get file size (If it exists..)
    On Error Resume Next
    LocalFileSize = FileLen(inFile) + 1
    On Error GoTo 0

    If (LocalFileSize) Then
        If (LocalFileSize = 1) Then Exit Function

        Select Case LCase(right(inFile, 4))
'            Case ".gif" ' Check for broken GIF's
'                FNum = FreeFile()
'                Open inFile For Binary Access Read Lock Write As #FNum
'                    Seek (FNum), LocalFileSize - 2
'                    Get #FNum, , FileSig
'                Close #FNum

'                BadFile = (FileSig And &HFF) <> GIFSig
            Case ".jpg", "jpeg" ' Check for broken JPEG's
                FNum = FreeFile()
                Open inFile For Binary Access Read Lock Write As #FNum
                    Seek (FNum), LocalFileSize - 2
                    Get #FNum, , FileSig
                Close #FNum

                BadFile = FileSig <> JPEGSig
            Case Else ' No known (serious) problems with this format
                BadFile = False
        End Select

        ' Check the terminator
        If (BadFile) Then Exit Function

        ' Attempt to load the image
        On Error Resume Next
        Set SafeLoadImage = LoadPicture(inFile)
        On Error GoTo 0
    End If ' (LocalFileSize)
End Function








Private Sub ExecuteDocument(ByVal as_RPD_Code As String, ByVal as_extension As String)
On Error GoTo errHandler
    Dim ls_Filename As String
    Dim ls_Command As String
    ' create shell object to access Registry and Runtime
    Dim lo_shell As Object
    Set lo_shell = CreateObject("WSCript.Shell")
    If lo_shell Is Nothing Then
        Call Err.Raise(CompFncFailed, "CreateObject()", "Cannot create WSCript.Shell.")
    End If
    
    ' get command defined for extension
    Dim ls_DDEExec As String, ls_Application As String, ls_topic As String
    ls_Command = GetCommand(as_extension, ls_DDEExec, ls_Application, ls_topic, lo_shell)
    
    If ls_Command = "" Then
        ' TODO: Manage status: no associate application found
        ' TODO: here we can try explorer.exe to display media
        Call Err.Raise(CompFncFailed, "", "No Application associated with file.")
    End If
    
    ' now when we know how to run, we can download file and run
    ls_Filename = DownloadZipFile(mo_Db, as_RPD_Code, "tempfile" & as_RPD_Code & "." & as_extension)
    
    ' anyway, to execute document we don't need ls_command
    Call lo_shell.Run("""" & ls_Filename & """")
    
    Set lo_shell = Nothing
    
    Exit Sub
errHandler:
    Call ErrorHandler("SfbRefPro.ExecuteDocument()")
End Sub

Private Function Get_A_Config(ByVal TheKey As String) As String
On Error GoTo Get_A_Config_er
Dim curs As Long
Dim ls_Req As String

Get_A_Config = ""
ls_Req = "select cfg_value from A_config where cfg_Key ='" & UCase(TheKey) & "'"
curs = mo_Db.OpenSQL(ls_Req)
    If curs = 0 Then
        Err.Raise CompFncFailed, "SfbRefPro.Get_A_Config", "Error executing " & ls_Req & mo_Db.LastErrorCode & "  " & mo_Db.LastErrorMessage
    Else
        If mo_Db.RowCount(curs) <> 1 Then
            mo_Db.Close (curs)
            curs = 0
            Err.Raise CompFncFailed, "SfbRefPro.Get_A_Config", "Executing " & ls_Req & " returned " & mo_Db.RowCount(curs) & " record(s) while one was expected"
        Else
            Get_A_Config = mo_Db.GetFields(curs, 0)
            mo_Db.Close (curs)
            curs = 0
        End If
    End If
Exit Function
Get_A_Config_er:
    If curs > 0 Then
        Call mo_Db.Close(curs)
        curs = 0
    End If
    Call ErrorHandler("SfbRefPro.Get_A_Config()")
End Function


Private Sub ChangeCharset(ByRef ao_Container As Object, ByVal al_CodePage As Long)
On Error GoTo errHandler
    Dim lc_Control As Object   ' A control of the container
    Dim ll_Charset As Long
    
    Screen.MousePointer = vbHourglass

    Debug.Assert (al_CodePage <> 0)

    ll_Charset = GetCharSetFromCodePage(al_CodePage)
    
    For Each lc_Control In ao_Container
        If Not TypeOf lc_Control Is CommonDialog And Not TypeOf lc_Control Is ToolbarControl Then
            lc_Control.Font.Name = "Arial"
            lc_Control.Font.Charset = ll_Charset
        End If
    Next
    
    Screen.MousePointer = vbDefault
    Exit Sub

errHandler:
    Screen.MousePointer = vbDefault
    Call ErrorHandler("ChangeCharset()")
End Sub
