Attribute VB_Name = "Modulo2"
Option Explicit
'***********************************************************
'****  DICHIARAZIONI PER I Form SEMPRE IN PRIMO PIANO   ****

'Public Const SWP_NOACTIVATE = &H10
'Public Const SWP_SHOWWINDOW = &H40
'Public Const HWND_TOPMOST = -1
'Public Const HWND_NOTOPMOST = -2

'Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, _
'ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal Y As Long, ByVal cx As Long, _
'ByVal cy As Long, ByVal wFlags As Long) As Long

'***********************************************************
'****   DICHIARAZIONI PER L'EXE SEMPRE IN PRIMO PIANO   ****
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal WParam As Long, lParam As Any) As Long
Public Const WM_CLOSE = &H10
'***********************************************************

Declare Function SendMessageAsLong _
    Lib "user32" _
    Alias "SendMessageA" ( _
    ByVal hWnd As Long, _
    ByVal wMsg As Long, _
    ByVal WParam As Long, _
    ByVal lParam As Long) As Long
    
Const CB_FINDSTRING As Long = &H14C
Const CB_FINDSTRINGEXACT As Long = &H158
Const LB_FINDSTRING As Long = &H18F
Const LB_FINDSTRINGEXACT As Long = &H1A2
Const CB_ERR = -1

Declare Function SendMessageAsStr Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal WParam As Long, ByVal sParam As String) As Long
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, _
ByVal wMsg As Long, ByVal WParam As Long, lParam As Any) As Long

'Costante x la conversione del Path DOS
Public Const SW_SHOWNORMAL As Long = 1

'*** Per convertire path lunghi in formato x DOS ***
Private Declare Function GetShortPathName Lib "kernel32" Alias _
    "GetShortPathNameA" (ByVal lpszLongPath As String, _
    ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
'Const MAX_PATH = 260
'***************************************************

'Per aprire i file in automatico
Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" _
(ByVal hWnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Public Const CB_SHOWDROPDOWN = &H14F '(per aprire e chiudere la combo in automatico)

Public Site As String


Public Function SostChar(Str As String, OldChar, NewChar As String) As String
   Dim i As Integer
   Dim TrovatoCarattere As Boolean
   
Ricomincia:
   i = 1
   TrovatoCarattere = False
         
   For i = 1 To Len(Str)
      If Mid(Str, i, 1) = OldChar Then
         Str = Left$(Str, i - 1) & NewChar & Right$(Str, Len(Str) - i)
         TrovatoCarattere = True
         Exit For
      End If
   Next
   
   If TrovatoCarattere = True Then
      GoTo Ricomincia
   End If
   
   SostChar = Str
End Function

Public Function ControllaApici(Str As String) As String
   Dim i As Integer
   Dim SemaforoInStringa As Boolean
   SemaforoInStringa = False
   For i = 1 To Len(Trim(Str))
      If Mid(Str, i, 1) = "'" Then
         If Not SemaforoInStringa Then
            SemaforoInStringa = True
         Else
            If ChiusuraStringa(Right$(Trim(Str), Len(Trim(Str)) - i)) Then
               SemaforoInStringa = False
            Else
               Str = Left$(Str, i - 1) & "`" & Right$(Str, Len(Str) - i)
            End If
         End If
      End If
   Next
   ControllaApici = Str
End Function

Public Function ChiusuraStringa(Str As String) As Boolean
   If Len(Str) = 0 Then
      ChiusuraStringa = True
   Else
      If Left$(Trim(Str), 1) = "," Or Left$(Trim(Str), 1) = ")" Or UCase(Left$(Trim(Str), 5)) = "WHERE" Or UCase(Left$(Trim(Str), 4)) = "AND " Or UCase(Left$(Trim(Str), 3)) = "OR " Then
         ChiusuraStringa = True
      Else
         ChiusuraStringa = False
      End If
   End If
End Function

Public Function NonNullo(Argomento As Variant, Optional Numerico As Boolean) As String
   If IsNull(Argomento) Then
      If Numerico = False Then
         NonNullo = ""
      Else
         NonNullo = "0"
      End If
   Else
      If Numerico = False Then
         NonNullo = Argomento
      Else
         If IsNumeric(Argomento) = True Then 'Qui faccio un ulteriore controllo se il valore deve essere numerico
            NonNullo = Argomento
         Else
            NonNullo = "0"
         End If
      End If
   End If
End Function

Public Function Cripta(StringaDaCriptare As String)
   Dim i As Integer
   Dim StringaCriptata As String
   For i = 1 To Len(StringaDaCriptare)
      'Stringacriptata = asc(mid(stringadacriptare,i,1)
   Next
End Function

Public Function B2N(ValoreBooleano As Boolean) As Integer
If ValoreBooleano Then
   B2N = 1
Else
   B2N = 0
End If
End Function

Public Function B2S(ValoreBooleano As Boolean) As String
If ValoreBooleano Then
   B2S = "True"
Else
   B2S = "False"
End If
End Function



'funzione per il controllo del salvataggio di un form in
'caso di uscita
Public Function TestoGlobale(frmForm As Form) As String
Dim ctlControl As Object
Dim i As Integer
Dim k As Integer

On Error Resume Next

For Each ctlControl In frmForm.Controls
   If Left(ctlControl.Name, 4) <> "Comm" And InStr(ctlControl.Name, "Grid") = 0 Then
      TestoGlobale = TestoGlobale & ctlControl.text
      TestoGlobale = TestoGlobale & ctlControl.Value
   
   ElseIf InStr(ctlControl.Name, "Grid") <> 0 Then
      For i = 0 To ctlControl.Cols - 1
         For k = 0 To ctlControl.Rows - 1
            ctlControl.Col = i
            ctlControl.Row = k
            TestoGlobale = TestoGlobale & ctlControl.text
         Next k
      Next i
   End If
Next ctlControl

On Error GoTo 0
End Function

Public Function Colore(Color As String) As Long
   Select Case Color
      Case "bianco"
         Colore = 16777215
      Case "nero"
         Colore = 1
      Case "marrone"
         Colore = 2642040
      
      Case "grigio1"
         Colore = 14737632
      Case "grigio2"
         Colore = 12632256
      Case "grigio3"
         Colore = 8421504
      Case "grigionew"
         Colore = 15658734

      Case "rosso1"
         Colore = 12632319
      Case "rosso2"
         Colore = 8421631
      Case "rosso3"
         Colore = 255

      Case "arancione1"
         Colore = 12640511
      Case "arancione2"
         Colore = 8438015
      Case "arancione3"
         Colore = 33023
      
      Case "giallo1"
         Colore = 12648447
      Case "giallo2"
         Colore = 8454143
      Case "giallo3"
         Colore = 65535
     Case "giallo4"
         Colore = 49344
         
      Case "verde1"
         Colore = 12648384
      Case "verde2"
         Colore = 8454016
      Case "verde3"
         Colore = 65280
      Case "verde4"
         Colore = 49152
      Case "verde5"
         Colore = 32768
         
      Case "celeste1"
         Colore = 16777152
      Case "celeste2"
         Colore = 16777088
      Case "celeste3"
         Colore = 16776960
           
      Case "blu1"
         Colore = 16761024
      Case "blu2"
         Colore = 16744576
      Case "blu3"
         Colore = 16711680
      Case "blu4"
         Colore = 8388608

      Case "rosa1"
         Colore = 16761087
      Case "rosa2"
         Colore = 16744703
      Case "rosa3"
         Colore = 16711935
      
      Case "cartadazucchero"
         Colore = 12294009
   End Select
   
End Function

Public Sub PausaProgram(pSecondi As Integer, Optional MenoDiUnSecondo As Boolean, Optional pUltraRapido As Boolean)
   Dim vTempoPart As Date
   Dim i As Long
   
   vTempoPart = DateAdd("s", pSecondi, Time)
   
   Do Until Time > vTempoPart
      DoEvents
      i = i + 1
      
      If pUltraRapido = True Then If i = 75000 Then Exit Do
      If MenoDiUnSecondo = True Then If i = 150000 Then Exit Do
   Loop

End Sub

Public Sub PulisciControlli(frmForm As Form)
   Dim ctlControl As Object
   
   ' Inizializza tutti i controlli
   On Error Resume Next
   For Each ctlControl In frmForm.Controls
      If InStr(1, ctlControl.Tag, "N") > 0 Then 'controllo se c'e la "N" significa che e' stringa
         'If InStr(1, ctlControl.Tag, "E") > 0 Then 'controllo se c'e la "E" significa che nel campo e' espresso un importo
         '   ctlControl.Text = "0,00"
         '   ctlControl.Caption = "0,00"
         'Else
            ctlControl.text = "0"
            ctlControl.Caption = "0"
         'End If
      ElseIf InStr(1, ctlControl.Tag, "S") > 0 Then 'controllo se c'e la "A" significa che e' stringa
         ctlControl.text = ""
         ctlControl.Caption = ""
      ElseIf InStr(1, ctlControl.Tag, "L") > 0 Then 'controllo se c'e la "L" significa che e' un ListBox
         ctlControl.Clear
      ElseIf InStr(1, ctlControl.Tag, "P") > 0 Then 'controllo se c'e la "L" significa che e' un ComboBox e imposto il ListIndex = 0
         ctlControl.ListIndex = 0
      ElseIf InStr(1, ctlControl.Tag, "H") > 0 Then 'controllo se c'e la "L" significa che e' un ComboBox e imposto il ListIndex = 0
         ctlControl.Value = 0
      End If
      
      DoEvents
   Next ctlControl
   On Error GoTo 0
End Sub

Public Sub ImpostaUCASE(frmForm As Form)
   Dim ctlControl As Object
   
   ' Inizializza tutti i controlli
   On Error Resume Next
   For Each ctlControl In frmForm.Controls
      
      If (TypeOf ctlControl Is TextBox) Or (TypeOf ctlControl Is FlatEdit) Then
         ctlControl.Tag = ctlControl.Tag & "M"
      End If
      
      DoEvents
   Next ctlControl
   On Error GoTo 0
End Sub

Public Sub ControllaCampoNumerico(frmForm As Form, ctlControl As Object)
   On Error Resume Next
   
   If ctlControl <> "" Then
      If Not IsNumeric(ctlControl) Then
         ctlControl.SetFocus
         MsgBox "Valore Errato!"
      End If
   Else
      ctlControl = "0"
   End If
   On Error GoTo 0
      
End Sub


Public Sub BloccaControlli_OLD(frmForm As Form, Tutti As Boolean)
'   Dim ctlControl As Object
'
'   ' Inizializza tutti i controlli
'   On Error Resume Next
'   For Each ctlControl In frmForm.Controls
'
'      If Not InStr(1, ctlControl.Tag, "D") > 0 Then 'Se c'e' la D signifa che non lo devo considerare
'
'         If InStr(1, ctlControl.Tag, "O") > 0 Then
'            'controllo se c'e la "0" significa che devo Sbloccarlo anziche' Bloccarlo. _
'             Se invece il parametro Totale = True significa che lo devo Bloccare comunque!
'            If Tutti = False Then
'               ctlControl.Enabled = True
'               ctlControl.BackColor = &HFFF2CC 'abilitato
'            Else
'               ctlControl.Enabled = False
'               ctlControl.BackColor = &HFFDDE3 'Disabilitato
'            End If
'         ElseIf InStr(1, ctlControl.Tag, "B") > 0 Then 'controllo se c'e la "B" significa che devo verificare l'abilitazione del campo
'            ctlControl.Enabled = False
'            ctlControl.BackColor = &HFFDDE3 'Disabilitato
'         End If
'
'      End If
'
'      DoEvents
'   Next ctlControl
'   On Error GoTo 0
End Sub

Public Sub SbloccaControlli(frmForm As Form, ctlCodice As Boolean, Tutti As Boolean)
   Dim ctlControl As Object
   
   ' Inizializza tutti i controlli
   On Error Resume Next
   For Each ctlControl In frmForm.Controls
      
      If Not InStr(1, ctlControl.Tag, "D") > 0 Then 'Se c'e' la D significa che non lo devo considerare
         
         If Tutti = True Then 'Se Tutti=True allora li devo sbloccare TUTTI senza controlli ulteriori
         
            If InStr(1, ctlControl.Tag, "O") > 0 Then
               If ctlCodice = False Then
                  ctlControl.Enabled = False
                  'If InStr(1, ctlControl.Tag, "C") = 0 Then
                  ctlControl.BackColor = CSSApp.gTextForeColorDisabled    'Disabilitato
               Else
                  ctlControl.Enabled = True
                  'If InStr(1, ctlControl.Tag, "C") = 0 Then ctlControl.BackColor = &HFFF2CC 'abilitato
                  If InStr(1, ctlControl.Tag, "C") = 0 Then
                     If InStr(1, ctlControl.Tag, "G") = 0 Then 'Non devo colorarlo di azzurro...
                        ctlControl.BackColor = CSSApp.gTextBackColorStandard 'abilitato
                     Else
                        ctlControl.BackColor = &H80000005 '...ma di bianco (nel caso di GRIGLIE)
                     End If
                  End If
               End If
            ElseIf InStr(1, ctlControl.Tag, "B") > 0 Then
               ctlControl.Enabled = True
               If InStr(1, ctlControl.Tag, "C") = 0 Then
                  If InStr(1, ctlControl.Tag, "G") = 0 Then 'Non devo colorarlo di azzurro...
                     ctlControl.BackColor = CSSApp.gTextBackColorStandard 'abilitato
                  Else
                     ctlControl.BackColor = &H80000005 '...ma di bianco (nel caso di GRIGLIE)
                  End If
               End If
            End If
         
         Else 'Altrimenti devo fare i controlli del caso
         
            If InStr(1, ctlControl.Tag, "O") > 0 Then
               'controllo se c'e la "0" significa che devo Bloccarlo anziche' Sbloccarlo. _
                Se invece il parametro ctlCodice = True significa che lo devo Sbloccare comunque!
               If ctlCodice = False Then
                  ctlControl.Enabled = False
                  If InStr(1, ctlControl.Tag, "C") = 0 Then ctlControl.BackColor = CSSApp.gTextForeColorDisabled    'Disabilitato
               Else
                  ctlControl.Enabled = True
                  'If InStr(1, ctlControl.Tag, "C") = 0 Then ctlControl.BackColor = CSSApp.gTextBackColorStandard 'abilitato
                  If InStr(1, ctlControl.Tag, "C") = 0 Then
                     If InStr(1, ctlControl.Tag, "G") = 0 Then 'Non devo colorarlo di azzurro...
                        ctlControl.BackColor = CSSApp.gTextBackColorStandard 'abilitato
                     Else
                        ctlControl.BackColor = &H80000005 '...ma di bianco (nel caso di GRIGLIE)
                     End If
                  End If
               End If
               
            ElseIf InStr(1, ctlControl.Tag, "+") > 0 Then 'controllo se c'e la "+" significa che e' un campo aggiunto e che devo Bloccare
               ctlControl.Enabled = False
               If InStr(1, ctlControl.Tag, "C") = 0 Then ctlControl.BackColor = CSSApp.gTextForeColorDisabled    'Disabilitato
            
            ElseIf InStr(1, ctlControl.Tag, "B") > 0 Then 'controllo se c'e la "B" significa che devo verificare l'abilitazione del campo
               ctlControl.Enabled = True
               'If InStr(1, ctlControl.Tag, "C") = 0 Then ctlControl.BackColor = CSSApp.gTextBackColorStandard 'abilitato
               If InStr(1, ctlControl.Tag, "C") = 0 Then
                  If InStr(1, ctlControl.Tag, "G") = 0 Then 'Non devo coilorarlo di azzurro...
                     ctlControl.BackColor = CSSApp.gTextBackColorStandard 'abilitato
                  Else
                     ctlControl.BackColor = &H80000005 '...ma di bianco (nel caso di GRIGLIE)
                  End If
               End If
            End If
            
         End If
      
      End If
      
      
      If (TypeOf ctlControl Is ReportControl) Then
         ctlControl.Redraw
      End If
      
      DoEvents
   Next ctlControl
   On Error GoTo 0
End Sub

'Public Sub SbloccaControlli(frmForm As Form, ctlCodice As Boolean, Tutti As Boolean)
'   Dim ctlControl As Object
'
'   ' Inizializza tutti i controlli
'   On Error Resume Next
'   For Each ctlControl In frmForm.Controls
'
'      If Not InStr(1, ctlControl.Tag, "D") > 0 Then 'Se c'e' la D signifa che non lo devo considerare
'
'         If Tutti = True Then 'Se Tutti=True allora li devo sbloccare TUTTI senza controlli ulteriori
'
'            If InStr(1, ctlControl.Tag, "O") > 0 Then
'               If ctlCodice = False Then
'                  ctlControl.Enabled = False
'                  If InStr(1, ctlControl.Tag, "C") = 0 Then ctlControl.BackColor = CSSApp.gTextForeColorDisabled    'Disabilitato
'               Else
'                  ctlControl.Enabled = True
'                  If InStr(1, ctlControl.Tag, "C") = 0 Then ctlControl.BackColor = CSSApp.gTextBackColorStandard 'abilitato
'               End If
'            ElseIf InStr(1, ctlControl.Tag, "B") > 0 Then
'               ctlControl.Enabled = True
'               If InStr(1, ctlControl.Tag, "C") = 0 Then ctlControl.BackColor = CSSApp.gTextBackColorStandard 'abilitato
'            End If
'
'         Else 'Altriemnti devo fare i controlli del caso
'
'            If InStr(1, ctlControl.Tag, "O") > 0 Then
'               'controllo se c'e la "0" significa che devo Bloccarlo anziche' Sbloccarlo. _
'                Se invece il parametro ctlCodice = True significa che lo devo Sbloccare comunque!
'               If ctlCodice = False Then
'                  ctlControl.Enabled = False
'                  If InStr(1, ctlControl.Tag, "C") = 0 Then ctlControl.BackColor = CSSApp.gTextForeColorDisabled    'Disabilitato
'               Else
'                  ctlControl.Enabled = True
'                  If InStr(1, ctlControl.Tag, "C") = 0 Then ctlControl.BackColor = CSSApp.gTextBackColorStandard 'abilitato
'               End If
'
'            ElseIf InStr(1, ctlControl.Tag, "+") > 0 Then 'controllo se c'e la "+" significa che e' un campo aggiunto e che devo Bloccare
'               ctlControl.Enabled = False
'               If InStr(1, ctlControl.Tag, "C") = 0 Then ctlControl.BackColor = CSSApp.gTextForeColorDisabled    'Disabilitato
'
'            ElseIf InStr(1, ctlControl.Tag, "B") > 0 Then 'controllo se c'e la "B" significa che devo verificare l'abilitazione del campo
'               ctlControl.Enabled = True
'               If InStr(1, ctlControl.Tag, "C") = 0 Then ctlControl.BackColor = CSSApp.gTextBackColorStandard 'abilitato
'            End If
'
'         End If
'
'      End If
'
'      DoEvents
'   Next ctlControl
'   On Error GoTo 0
'
''   Dim ctlControl As Object
''
''   ' Inizializza tutti i controlli
''   On Error Resume Next
''   For Each ctlControl In frmForm.Controls
''
''      If Not InStr(1, ctlControl.Tag, "D") > 0 Then 'Se c'e' la D signifa che non lo devo considerare
''
''         If Tutti = True Then 'Se Tutti=True allora li devo sbloccare TUTTI senza controlli ulteriori
''
''            If InStr(1, ctlControl.Tag, "O") > 0 Then
''               If ctlCodice = False Then
''                  ctlControl.Enabled = False
''                  ctlControl.BackColor = CSSApp.gTextForeColorDisabled    'Disabilitato
''               Else
''                  ctlControl.Enabled = True
''                  ctlControl.BackColor = CSSApp.gTextBackColorStandard 'abilitato
''               End If
''            ElseIf InStr(1, ctlControl.Tag, "B") > 0 Then
''               ctlControl.Enabled = True
''               ctlControl.BackColor = CSSApp.gTextBackColorStandard 'abilitato
''            End If
''
''         Else 'Altriemnti devo fare i controlli del caso
''
''            If InStr(1, ctlControl.Tag, "O") > 0 Then
''               'controllo se c'e la "0" significa che devo Bloccarlo anziche' Sbloccarlo. _
''                Se invece il parametro ctlCodice = True significa che lo devo Sbloccare comunque!
''               If ctlCodice = False Then
''                  ctlControl.Enabled = False
''                  ctlControl.BackColor = CSSApp.gTextForeColorDisabled    'Disabilitato
''               Else
''                  ctlControl.Enabled = True
''                  ctlControl.BackColor = CSSApp.gTextBackColorStandard 'abilitato
''               End If
''
''            ElseIf InStr(1, ctlControl.Tag, "+") > 0 Then 'controllo se c'e la "+" significa che e' un campo aggiunto e che devo Bloccare
''               ctlControl.Enabled = False
''               ctlControl.BackColor = CSSApp.gTextForeColorDisabled    'Disabilitato
''
''            ElseIf InStr(1, ctlControl.Tag, "B") > 0 Then 'controllo se c'e la "B" significa che devo verificare l'abilitazione del campo
''               ctlControl.Enabled = True
''               ctlControl.BackColor = CSSApp.gTextBackColorStandard 'abilitato
''            End If
''
''         End If
''
''      End If
''
''      DoEvents
''   Next ctlControl
''   On Error GoTo 0
'
'End Sub

Public Sub ImpostaControlliObbligatori(frmForm As Form, Obbligatori As Boolean)
   Dim ctlControl As Object
   
   ' Inizializza tutti i controlli
   On Error Resume Next
   For Each ctlControl In frmForm.Controls
      
      If ctlControl.ForeColor = CSSApp.gTextForeColorObbligo Then
         'controllo se il Forecolor del controllo e' Blu
         If Obbligatori = True Then
             ctlControl.Tag = ctlControl.Tag & "!"
         Else
            ctlControl.Tag = Replace(ctlControl.Tag, "!", "")
         End If
      End If
      
      DoEvents
   Next ctlControl
   On Error GoTo 0
End Sub



'*****************************************************
' Scopo......: converte la data in formato mm/gg/aa hh:mm:ss
' Input......: data e ora
' Restituisce: la data nel formato SQL: 'mm/gg/aa hh:mm:ss'
'*****************************************************
Public Function DataOraSQL(ByVal StrData As String, StrOra As Boolean) As String
Dim DataEora As String
   
   If StrOra Then
      'DataEora = (Mid(StrData, 4, 2) & "/" & Left(StrData, 2) & "/" & Right(StrData, 2)) & " " & Str(Hour(Time)) & ":" & Trim(Str(Minute(Time))) & ":" & Trim(Str(Second(Time)))
      DataEora = Format(StrData, "hh:mm")
   Else
      DataEora = Trim((Mid(StrData, 4, 2)) & "/" & Trim(Left(StrData, 2)) & "/" & Trim(Right(StrData, 2)))
   End If

   DataOraSQL = "#" & DataEora & "#"

End Function

'                 *****     IN LIRE     *****
'****************************************************************
' Scopo......: arrotonda sempre alla cifra superiore (24,2 = 25)*
' Input......: cifra da arrotondare, valore dell'arrotondamento *
' Restituisce: cifra arrotondata                                *
'****************************************************************

'                 *****     IN EURO     *****
'****************************************************************
' Scopo......: arrotond. matematemat.  (24,2 = 24)  (24,6 = 25) *
' Arrotondam.:         --->            (da  0 a 4)  (da  5 a 9) *
' Input......: cifra da arrotondare, valore dell'arrotondamento *
' Restituisce: cifra arrotondata                                *
'****************************************************************
Public Function Arrotonda(Prezzo As Currency) As Currency
   Dim VecchioPrezzo    As Currency
   Dim NuovoPrezzo      As Currency
   Dim Decimali         As Currency
   Dim PosVirgola       As Byte
   Dim DecimalePilota   As Byte  ' E' il 3° decimale dopo la virgola, cioè quello che comanda l'arrotodamento

   VecchioPrezzo = Prezzo

'   If Valuta = "Lire" Then    'LIRE  -  Vedi NOTE sopra
'
'      If InStr(1, VecchioPrezzo, ",") > 0 Then 'Controllo che ci sia la virgola
'         NuovoPrezzo = Mid(VecchioPrezzo, 1, (InStr(1, VecchioPrezzo, ",")) - 1)
'         Arrotonda = NuovoPrezzo + 1
'      Else
'         Arrotonda = VecchioPrezzo
'      End If
'
'   Else                       'EURO  -  Vedi NOTE sopra

      PosVirgola = InStr(1, VecchioPrezzo, ",")
      If PosVirgola > 0 Then 'Controllo che ci sia la virgola
         'Controllo se ci sono + di 2 decimali: quindi devo arrotondare!
         If Len(Mid(VecchioPrezzo, PosVirgola)) > 3 Then
            'Prendo il 3° decimale dopo la virgola...
            DecimalePilota = Mid(VecchioPrezzo, PosVirgola + 3, 1)
            If DecimalePilota > 4 Then 'arrotondo per eccesso
               NuovoPrezzo = CCur(Mid(VecchioPrezzo, 1, PosVirgola + 2)) + CCur(0.01)
               Arrotonda = NuovoPrezzo
            Else                       'arrotondo per difetto (cioe' lascio il prezzo invariato)
               NuovoPrezzo = CCur(Mid(VecchioPrezzo, 1, PosVirgola + 2))
               Arrotonda = NuovoPrezzo
            End If
         Else
            Arrotonda = VecchioPrezzo
         End If
      Else
         Arrotonda = VecchioPrezzo
      End If

'   End If
   
End Function


Public Function AutoSearch(cbo As ComboBox, KeyAscii As Integer, cmd As CommandButton) As Boolean
   Dim sBuffer As String
   Dim lRetVal As Long
     
   sBuffer = Left(cbo.text, cbo.SelStart) & Chr(KeyAscii)
   lRetVal = SendMessage((cbo.hWnd), CB_FINDSTRING, -1, ByVal sBuffer)
   
   If lRetVal <> CB_ERR Then
      '...se TROVA corrispondenza nel combo...
      
      cbo.ListIndex = lRetVal
      cbo.text = cbo.List(lRetVal)
      cbo.SelStart = Len(sBuffer)
      cbo.SelLength = Len(cbo.text)
      KeyAscii = 0
      
      AutoSearch = True
   Else
      '...se NON trova corrispondenza nel combo...
      AutoSearch = False
   End If
   
End Function

'*****************************************************
' Scopo......: converte una stringa in formato SQL,
'              tenendo conto di eventuali apici, in qual caso li raddoppia
'              secondo lo standard delle stringhe SQL.
' Input......: una stringa
' Restituisce: la stringa nel formato SQL con gli apici singoli
'*****************************************************
Public Function VerificaApici(ByVal stringa As Variant) As String

    If IsNull(stringa) Or IsEmpty(stringa) Or stringa = "" Then
        VerificaApici = ""
        Exit Function
    End If
    
   VerificaApici = Replace(stringa, "'", "''")
End Function

Function ShellToBrowser%(Frm As Form, ByVal URL$, ByVal WindowStyle%)
'FUNZIONE PER APRIRE IL SITO INTERNET CLICCANDO SU UN LINK
   Dim api%
   
   api% = ShellExecute(Frm.hWnd, "open", URL$, "", App.path, WindowStyle%)
   'Intercetta il valore restituito
   If api% < 31 Then
   'codice dell'errore - guarda l'help delle api per maggiori informazioni
       MsgBox App.Title & " ha un problema nel far avviare il Web Browser. Controllare che sia installato correttamente.(Error" & Format$(api%) & ")", 48, "Browser Non Disponibile"
       ShellToBrowser% = False
   ElseIf api% = 32 Then
   'nessun file associato
       MsgBox App.Title & " non riesce a trovare un file associato a " & URL$ & " sul sistema. Controllare che il browser sia installato correttamente e associato con questo tipo di file.", 48, "Browser Non Disponibile"
       ShellToBrowser% = False
   Else
       'E' al lavoro!
       ShellToBrowser% = True
   End If
End Function


Public Function CalcolaPrezzoNettoIVA(Importo As Double, ValIVA As Single) As Double
   'Questa funzione fa lo scorporo dell'IVA e restituisce l'Importo al Netto di IVA
   Dim ValScorporo As Single
    
   If IsNumeric(ValIVA) = True Then
      If IsNumeric(Importo) = True Then
         ValScorporo = (ValIVA / 100) + 1
         CalcolaPrezzoNettoIVA = Importo / ValScorporo
         CalcolaPrezzoNettoIVA = CalcolaPrezzoNettoIVA
      End If
   End If
End Function

Public Function CalcolaPrezzoLordoIVA(Importo As Double, ValIVA As Single) As Double
   'Questa funzione aggiunge il valore dell'iva e restituisce l'Importo al Lordo di IVA
   Dim ImpIVA As Double
    
   If IsNumeric(ValIVA) = True Then
      If IsNumeric(Importo) = True Then
         ImpIVA = (Importo * ValIVA) / 100
         CalcolaPrezzoLordoIVA = Importo + ImpIVA
         CalcolaPrezzoLordoIVA = CalcolaPrezzoLordoIVA
      End If
   End If
End Function

Public Function FormattaCampoNumerico(Valore As Double, Decimali As Byte, Optional NoFormat As Byte) As String
   If NoFormat = 0 Then
      Select Case Decimali
         Case 0
            FormattaCampoNumerico = Format(Valore, "###,###,###,##0")
         Case 1
            FormattaCampoNumerico = Format(Valore, "###,###,###,##0.0")
         Case 2
            FormattaCampoNumerico = Format(Valore, "###,###,###,##0.#0")
         Case 3
            FormattaCampoNumerico = Format(Valore, "###,###,###,##0.##0")
         Case 4
            FormattaCampoNumerico = Format(Valore, "###,###,###,##0.###0")
         Case 5
            FormattaCampoNumerico = Format(Valore, "###,###,###,##0.####0")
         Case 255
            FormattaCampoNumerico = Format(Valore, "###,###,###,##0")
      End Select
   Else
      Select Case Decimali
         Case 0
            FormattaCampoNumerico = Format(Valore, "###########0")
         Case 1
            FormattaCampoNumerico = Format(Valore, "###########0.0")
         Case 2
            FormattaCampoNumerico = Format(Valore, "###########0.#0")
         Case 3
            FormattaCampoNumerico = Format(Valore, "###########0.##0")
         Case 4
            FormattaCampoNumerico = Format(Valore, "###########0.###0")
         Case 5
            FormattaCampoNumerico = Format(Valore, "###########0.####0")
         Case 255
            FormattaCampoNumerico = Format(Valore, "###########0")
      End Select
   End If
End Function

Public Sub SelezionaTesto(ByRef Ctl As Control)
   On Error Resume Next
   
   Ctl.SelStart = 0
   Ctl.SelLength = Len(Ctl.text)

   On Error GoTo 0
End Sub


Public Function VerificaRigaDisponibileGriglia(Griglia As Object) As Integer
   Dim i As Integer
   
   For i = 1 To Griglia.Rows - 1
      If Len(Griglia.TextMatrix(i, 0)) = 0 Then
         VerificaRigaDisponibileGriglia = i
         Exit Function
      End If
   Next i
   
   Griglia.Rows = Griglia.Rows + 1
   VerificaRigaDisponibileGriglia = Griglia.Rows - 1
End Function


Public Function SetMaskFlatEdit(pCtrlFlat As FlatEdit, pMaskLiteral As String, Optional pPrompt As String) As String
   Dim vIntero As Byte
   Dim vDecimali As Byte
   Dim vTestoFisso As String
   'Dim vLato As String
   
   'Qui verifico se eventualmente c'e' del testo fisso da visualizzare prima o dopo la parte dinamica
   If Len(Trim(pCtrlFlat.DataFormat.Format)) > 0 Then
      'vLato = Mid(pCtrlFlat.DataFormat.Format, 1, 1) 'il primo carattere sarà sempre "<" oppure ">" che indicano dove deve stare la parte fissa cioè a sinistra del testo editabile o a destra
      vTestoFisso = Trim(Mid(pCtrlFlat.DataFormat.Format, 2)) 'questo è il testo fisso
   End If
   

'CAMPI NUMERICI ----------------------------------------------
   'Controllo che sia un campo Numerico
   If pCtrlFlat.Alignment = vbRightJustify Then
      
      'Stringa tipo = SetMaskFlatEdit= "####,00" , "    ,  ", " "
      
      If InStr(1, pCtrlFlat.Tag, "%") > 0 Then
         vIntero = 3 - (Len(vTestoFisso)) 'tolgo la lunghezza del testo fisso
         vDecimali = 2
      Else
         'Qui controllo se c'e' un valore di MaxLength che mi restituisce direttamente il numero di caratteri per l'Intero disponibili
         If pCtrlFlat.MaxLength = 0 Then
            vIntero = 7 'valore MAX = 9.999.999,99
         Else
            vIntero = pCtrlFlat.MaxLength - (Len(vTestoFisso)) 'tolgo la lunghezza del testo fisso
         End If
         vDecimali = pCtrlFlat.HelpContextID
      End If
      
      If pMaskLiteral = "mask" Then
         If vDecimali > 0 Then
            SetMaskFlatEdit = vTestoFisso & String(vIntero, "#") & "," & String(vDecimali, "0")
         Else
            SetMaskFlatEdit = vTestoFisso & String(vIntero, "#")
         End If
      Else
         If vDecimali > 0 Then
            SetMaskFlatEdit = vTestoFisso & String(vIntero, pPrompt) & "," & String(vDecimali, pPrompt)
         Else
            SetMaskFlatEdit = vTestoFisso & String(vIntero, pPrompt)
         End If
      End If

   End If
'------------------------------------------------------------
   
End Function

Public Function FormattaNumero(Valore As Double, Decimali As Byte, Optional NoFormat As Byte) As String
   If NoFormat = 0 Then
      Select Case Decimali
         Case 0
            FormattaNumero = Format(Valore, "###,###,###,##0")
         Case 1
            FormattaNumero = Format(Valore, "###,###,###,##0.0")
         Case 2
            FormattaNumero = Format(Valore, "###,###,###,##0.#0")
         Case 3
            FormattaNumero = Format(Valore, "###,###,###,##0.##0")
         Case 4
            FormattaNumero = Format(Valore, "###,###,###,##0.###0")
         Case 5
            FormattaNumero = Format(Valore, "###,###,###,##0.####0")
         Case 255
            FormattaNumero = Format(Valore, "###,###,###,##0")
      End Select
   Else
      Select Case Decimali
         Case 0
            FormattaNumero = Format(Valore, "###########0")
         Case 1
            FormattaNumero = Format(Valore, "###########0.0")
         Case 2
            FormattaNumero = Format(Valore, "###########0.#0")
         Case 3
            FormattaNumero = Format(Valore, "###########0.##0")
         Case 4
            FormattaNumero = Format(Valore, "###########0.###0")
         Case 5
            FormattaNumero = Format(Valore, "###########0.####0")
         Case 255
            FormattaNumero = Format(Valore, "###########0")
      End Select
   End If
End Function



Public Function ColorFocus(ByVal bOnFocus As Boolean) As Long
  If bOnFocus Then
    'ColorFocus = &HC0FFFF
    ColorFocus = CSSApp.gTextBackColorOnFocus
  Else
'    ColorFocus = CSSApp.gTextBackColorStandard
    ColorFocus = CSSApp.gTextBackColorStandard
  End If
End Function

Public Function ControllaData(ByVal LaData As Variant) As String
   'Permette anche l'inserimento della data nel formato GGMMAA.
   Dim NoGood As Boolean
   Dim vStrEmpty As String
   
'   'Qui decido il tipo di stringa vuota che cambia se si tratta di un FlatEdit formattato o un TextBox non formattato _
'    Questo almeno finchè non sostituisco tutti i TextBox con i Flatedit formattati (SetMask)
'   If TypeOf LaData Is FlatEdit Then
'      vStrEmpty = "__/__/____"
'   Else
'      vStrEmpty = ""
'   End If
   
   NoGood = False
   
   'Qui decido il tipo di stringa vuota che cambia se si tratta di un FlatEdit formattato o un TextBox non formattato _
    Questo almeno finchè non sostituisco tutti i TextBox con i Flatedit formattati (SetMask)
   If TypeOf LaData Is FlatEdit Then
   
      If LaData <> "__/__/____" Then
         If IsDate(LaData) Then
            LaData = Format(LaData, "dd/mm/yyyy")
         Else
            If LaData = "0_/__/____" Then
               LaData = Format(Date, "dd/mm/yyyy")
            ElseIf LaData = "1_/__/____" Then
               LaData = "01/01/" & Year(Date)
            ElseIf LaData = "9_/__/____" Then
               LaData = "31/12/" & Year(Date)
            ElseIf LaData = "99/__/____" Then
               LaData = "31/12/2099"
            Else
               
               'Se è vuoto esco subito tanto poi sarà formattato
               If Len(Trim(LaData)) = 0 Then
                  Exit Function
               End If
               
               'Innanzitutto controllo che nel giorno e nel Mese ci siano caratteri validi (quindi senza "_")
               If InStr(1, Mid(LaData, 1, 6), "_") > 0 Then
                  NoGood = True
                  GoTo salta
               End If
               
               'Qui controllo che il MESE sia un nuomero valido (così aggiro anche il problema che VB inverte autnomamente giorno e mese ed accetta cnhe le date 11/15 trasformadola in 15/11)
               If Not (Mid(LaData, 4, 2) >= 1 And Mid(LaData, 4, 2) <= 12) Then
                  NoGood = True
                  GoTo salta
               End If
                  
               'Qui verifico che se l'anno è vuoto (quindi "____") sostituendolo con l'Annogestione la data sia valida
               If Mid(LaData, 7, 4) = "____" Then
                  LaData = Replace(LaData, "____", AnnoGestione)
                  If IsDate(LaData) = False Then
                     NoGood = True
                  End If
                  GoTo salta
               End If
                  
               'Qui verifico che se le ultime due cifre dell'anno sono vuoto (quindi "20__") sostituendolo con l'Annogestione la data sia valida
               If Right(LaData, 2) = "__" Then
                  LaData = Format(Replace(LaData, "_", ""), "dd/mm/yyyy")
                  If IsDate(LaData) = False Then
                     NoGood = True
                  End If
                  GoTo salta
               End If

               'Se arriva qui faccio semplicemente il controllo sulla data
               If IsDate(LaData) = False Then
                  NoGood = True
               End If
               GoTo salta

            End If
         End If
      
      Else
         
         LaData = ""
         Exit Function
      
      End If
      
   Else  '...TextBox
   
      If LaData <> "" Then
         If IsDate(LaData) Then
            LaData = Format(LaData, "dd/mm/yyyy")
         Else
            If LaData = "0" Then
               LaData = Format(Date, "dd/mm/yyyy")
            ElseIf LaData = "1" Then
               LaData = "01/01/" & Year(Date)
            ElseIf LaData = "9" Then
               LaData = "31/12/" & Year(Date)
            ElseIf LaData = "99" Then
               LaData = "31/12/2099"
            Else
               If Len(LaData) = 4 Then
                  LaData = Left(LaData, 2) & "/" & Right(LaData, 2) & "/" & AnnoGestione
                  If IsDate(LaData) Then
                     LaData = Format(LaData, "dd/mm/yyyy")
                  Else
                     NoGood = True
                  End If
               ElseIf Len(LaData) = 6 Then
                  LaData = Left(LaData, 2) & "/" & Mid(LaData, 3, 2) & "/" & Right(LaData, 2)
                  If IsDate(LaData) Then
                     LaData = Format(LaData, "dd/mm/yyyy")
                  Else
                     NoGood = True
                  End If
               ElseIf Len(LaData) = 8 Then
                  LaData = Left(LaData, 2) & "/" & Mid(LaData, 3, 2) & "/" & Right(LaData, 4)
                  If IsDate(LaData) Then
                     LaData = Format(LaData, "dd/mm/yyyy")
                  Else
                     NoGood = True
                  End If
               Else
                  NoGood = True
               End If
               
               'If NoGood Then
               '   MsgBox "Data errata!", vbExclamation, "ATTENZIONE"
               '   LaData = "Errore"
               'End If
               
            End If
         End If
      
      Else
      
         LaData = ""
         Exit Function
      
      End If
      
   End If
   
salta:
      
   If NoGood = True Then
      'MsgBox "Data errata!", vbExclamation, "ATTENZIONE"
      'Call VisualizzaMsgBoxPopUp("msg_exclamation", "ATTENZIONE!", "Data errata")
      MsgBox "Data errata", vbExclamation
      LaData = "Errore"
   Else
      'Qui effettuo un ulteriore controllo giusto per evitare che la data non abbia un valore valido ma totalmente fuori senso
      If Year(LaData) < 1900 Or Year(LaData) > 2100 Then
         NoGood = True
         GoTo salta
      End If
   End If
   
   ControllaData = LaData

End Function

Public Function ControllaOra(ByVal pCtrlOra As FlatEdit) As String
   'Permette anche l'inserimento della data nel formato GGMMAA.
   Dim NoGood As Boolean
   Dim vStrEmpty As String
   
   NoGood = False
   
   If pCtrlOra <> "__:__" Then
      If IsDate(pCtrlOra) Then
         pCtrlOra = Format(pCtrlOra, "hh:nn")
      Else
         If pCtrlOra = "0_:__" Then
            pCtrlOra = Format(Time, "hh:nn")
         Else
            
            'Se è vuoto esco subito tanto poi sarà formattato
            If Len(Trim(pCtrlOra)) = 0 Then
               Exit Function
            End If
            
            'Qui verifico che se le ultime due cifre dell'ora sono vuote (quindi "__") le sostituisco con doppio ZERO "00"
            If Right(pCtrlOra, 2) = "__" Then
               pCtrlOra = Format(Replace(pCtrlOra, "__", "00"), "hh:nn")
            End If
            
            'controllo se l'ora è formata da due cifre
            If IsNumeric(Mid(pCtrlOra, 1, 2)) Then
               'Controllo che non esca dai valori min e max
               If CInt(Mid(pCtrlOra, 1, 2)) > 23 Then
                  NoGood = True
                  GoTo salta
               End If
            End If
            
            'controllo se le ORE sono formate da una sola cifra (PRIMA CIFRA = NUMERO E SECONDA = "_")
            If (IsNumeric(Mid(pCtrlOra, 1, 1))) And (Mid(pCtrlOra, 2, 1) = "_") Then
               pCtrlOra = Format("0" & Mid(pCtrlOra, 1, 1) & ":" & Mid(pCtrlOra, 4), "hh:nn")
               If IsDate(pCtrlOra) = False Then
                  NoGood = True
                  GoTo salta
               End If
            End If
            
            'controllo se le ORE sono formate da una sola cifra (PRIMA CIFRA = "_" E SECONDA = NUMERO)
            If (Mid(pCtrlOra, 1, 1) = "_") And (IsNumeric(Mid(pCtrlOra, 2, 1))) Then
               pCtrlOra = Format("0" & Mid(pCtrlOra, 2), "hh:nn")
               If IsDate(pCtrlOra) = False Then
                  NoGood = True
                  GoTo salta
               End If
            End If
                           
            'Se arriva qui faccio semplicemente il controllo sull'ora
            If IsDate(pCtrlOra) = False Then
               NoGood = True
            End If
            GoTo salta

         End If
      End If
   
   Else
      
      pCtrlOra = ""
      Exit Function
   
   End If
   
   
salta:
   If NoGood = True Then
      'MsgBox "Ora errata!", vbExclamation, "ATTENZIONE"
      'Call VisualizzaMsgBoxPopUp("msg_exclamation", "ATTENZIONE!", "Ora errata")
      MsgBox "Ora errata", vbExclamation
      pCtrlOra = "Errore"
   End If
   ControllaOra = pCtrlOra

End Function



Public Sub BloccaSingoloControllo(pCtrl As Object, Optional pBackColorInvariato As Boolean)
   pCtrl.Enabled = False
   If pBackColorInvariato = False Then pCtrl.BackColor = CSSApp.gTextForeColorDisabled
End Sub
Public Sub SbloccaSingoloControllo(pCtrl As Object, Optional pBackColorInvariato As Boolean)
   pCtrl.Enabled = True
   If pBackColorInvariato = False Then pCtrl.BackColor = CSSApp.gTextBackColorStandard
End Sub



Public Function VerificaArrayInizializzato(v_Arr As Variant) As Boolean
   'Questa funzione mi restituisce TRUE se l'array è stato inizializzato
   On Local Error GoTo GestErr
   
   If (LBound(v_Arr) <= UBound(v_Arr)) Then VerificaArrayInizializzato = True

GestErr:
   
End Function
Public Function AddArrayElement(pArray As Variant, pElement As String) As String() ', Optional pSecondoElement As String) As String()
'Questa funzione richiederà, per funzionare, di due argomenti: l'array su cui operare e l'elemento da aggiungere in coda.

  Dim NewArrSize As Integer
  
  ' Verifico se pArray è una array
   'If IsArray(pArray) Then
   If VerificaArrayInizializzato(pArray) = True Then

      ' Incremento di uno il numero di elementi
         NewArrSize = CInt(UBound(pArray) + 1)
         ReDim Preserve pArray(NewArrSize)
      ' Aggiungo in coda il nuovo elemento (se c'è anche il secondo valore lo accodo alla stringa del primoElemento separandolo con "¦")
         pArray(NewArrSize) = pElement '& "¦ & IIf(Len(Trim(pSecondoElement)) > 0, pSecondoElement, "")"
      
   Else
      ReDim pArray(0)
      pArray(0) = pElement '& "¦ & IIf(Len(Trim(pSecondoElement)) > 0, pSecondoElement, "")"
   End If
   
   AddArrayElement = pArray
   
End Function

Public Sub VerificaEsistenzaPathCartella(pPathCartella As String, Optional pSoloControllo As Boolean, Optional prEsistenza As Boolean)
   'Questa sub serve per controllare l'esistenza di una cartella e se non esiste la crea _
    salvo che il parametro pSoloControllo non sia TRUE. In questo caso effettua SOLO il controllo. _
    L'esito dell'esistenza è passato al parametro di ritorno prEsistenza (questo l'ho fatto perchè _
    non ho voluto trasformare la Sub in Funzione perchè già usata all'interno del programma)
   
   Dim MyFolder As String
   
   'restituisce una stringa vuota se la cartella non esiste
   MyFolder = Dir(pPathCartella, vbDirectory)
   If Len(Trim(MyFolder)) = 0 Then
   'crea la cartella
      If pSoloControllo = False Then MkDir pPathCartella
      prEsistenza = False
   Else
      prEsistenza = True
   End If

End Sub



Public Sub Sendkeys(text As Variant, Optional wait As Boolean = False)
   Dim WshShell As Object
   Set WshShell = CreateObject("wscript.shell")
   WshShell.Sendkeys CStr(text), wait
   Set WshShell = Nothing
End Sub
