Option Strict Off
Option Explicit On
Module MdCalculosGrupoB
	Public Structure itpeFaturaFinal
		Dim t_str_Zona As String
		Dim t_str_Livro As String
		Dim t_str_Conta As String
		Dim t_str_Rota As String
		Dim t_lng_UnidId As Integer
		Dim t_lng_ConsId As Integer
		Dim t_str_Nome As String
		Dim t_dbl_Cfop As Double
		Dim t_str_Fase As String
		Dim t_str_Tensao As String
		Dim t_str_Classe As String
		Dim t_str_GruTar As String
		Dim t_int_DiaVcto As Short
		Dim t_dte_VctoReal As Date
		Dim t_dte_LAtual As Date
		Dim t_dte_LAnter As Date
		Dim t_dte_LProxi As Date
		Dim t_dte_Aprest As Date
		Dim t_dte_Emissao As Date
		Dim t_str_NumMed As String
		Dim t_dbl_FpmMed As Double
		Dim t_str_Ocorrencia As String
		Dim t_int_GerarMedia As Short
		Dim t_dbl_LAtual As Double
		Dim t_dbl_LAnter As Double
		Dim t_dbl_ConsLid As Double
		Dim t_dbl_ConsFat As Double
		Dim t_dbl_ResiduokWh As Double
		Dim t_dbl_ReversoLAtual As Double
		Dim t_dbl_ReversoLAnter As Double
		Dim t_dbl_ReversokWh As Double
		Dim t_dbl_ReversokWhFat As Double
		Dim t_dbl_ReversokWhRes As Double
		Dim t_dbl_IrriganteLAtual As Double
		Dim t_dbl_IrriganteLAnter As Double
		Dim t_dbl_IrrigantekWh As Double
		Dim t_dbl_IrrigantekWhFat As Double
		Dim t_dbl_FatorPotencia As Double
		Dim t_dbl_LeitkvahrAtual As Double
		Dim t_dbl_LeitkvahrAnter As Double
		Dim t_dbl_ConsumoReativo As Double
		Dim t_dbl_NumnfCancelada As Double
		Dim t_str_MesAnoCancelada As String
	End Structure
	
	Public Function Aliquota_COFINS(ByVal adteBase As Date) As Double
		Dim lstrVlr As String
		Dim ldblRet As Double
		Dim lstrSql As String
		Dim lrstAux As ADODB.Recordset
		lrstAux = New ADODB.Recordset
		lstrSql = ""
		lstrSql = lstrSql & "SELECT * "
		lstrSql = lstrSql & "  FROM `codigos` "
		lstrSql = lstrSql & " WHERE `datanova` <= '" & VB6.Format(adteBase, "yyyy-MM-dd") & "' "
		lstrSql = lstrSql & "   AND `num` = '40COF00001' "
		lstrSql = lstrSql & "ORDER BY `datanova` DESC, `num` ASC "
		lstrSql = lstrSql & "LIMIT 0, 1 "
		Call Conectar(lstrSql, lrstAux)
		With lrstAux
			If .State = ADODB.ObjectStateEnum.adStateOpen Then
				If .RecordCount > 0 Then
					'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
					lstrVlr = Trim(IIf(IsDbNull(.Fields("valor").value), "0.00", .Fields("valor").value))
					lstrVlr = IIf(IsNumeric(lstrVlr), lstrVlr, 0)
					lstrVlr = Replace(lstrVlr, ",", ".")
					ldblRet = Val(lstrVlr)
				End If
				Call .Close()
			End If
		End With
		'UPGRADE_NOTE: Object lrstAux may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6E35BFF6-CD74-4B09-9689-3E1A43DF8969"'
		lrstAux = Nothing
		Aliquota_COFINS = ldblRet
	End Function
	
	Public Function Aliquota_PIS(ByVal adteBase As Date) As Double
		Dim lstrVlr As String
		Dim ldblRet As Double
		Dim lstrSql As String
		Dim lrstAux As ADODB.Recordset
		lrstAux = New ADODB.Recordset
		ldblRet = 0
		lstrSql = ""
		lstrSql = lstrSql & "  SELECT * "
		lstrSql = lstrSql & "    FROM `codigos` "
		lstrSql = lstrSql & "   WHERE `datanova` <= '" & VB6.Format(adteBase, "yyyy-MM-dd") & "' "
		lstrSql = lstrSql & "     AND `num` = '40PIS00001' "
		lstrSql = lstrSql & "ORDER BY `datanova` DESC, `num` ASC "
		lstrSql = lstrSql & "LIMIT 0, 1 "
		Call Conectar(lstrSql, lrstAux)
		With lrstAux
			If .State = ADODB.ObjectStateEnum.adStateOpen Then
				If .RecordCount > 0 Then
					'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
					lstrVlr = Trim(IIf(IsDbNull(.Fields("valor").value), "0.00", .Fields("valor").value))
					lstrVlr = IIf(IsNumeric(lstrVlr), lstrVlr, 0)
					lstrVlr = Replace(lstrVlr, ",", ".")
					ldblRet = Val(lstrVlr)
				End If
				Call .Close()
			End If
		End With
		'UPGRADE_NOTE: Object lrstAux may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6E35BFF6-CD74-4B09-9689-3E1A43DF8969"'
		lrstAux = Nothing
		Aliquota_PIS = ldblRet
	End Function
	
	Public Function Aliquota_ICMS(ByVal astrUf As String, ByVal adblConsumo As Double, ByVal astrClasse As String, ByVal adteFaturamento As Date, Optional ByVal astrIsento As String = "N", Optional ByVal astrInsc As String = "") As Double
		Dim lstrCodigo As String
		Dim lstrCodIcms As String
		Dim lintClasse As Short
		Dim lstrClasse As String
		Dim lstrSubClas As String
		Dim ldblLimiteKWh As Double
		Dim ldblValorIcms As Double
		Dim lstrSql As String
		Dim lrstICMS As ADODB.Recordset
		lrstICMS = New ADODB.Recordset
		lstrClasse = VB6.Format(astrClasse, "0000")
		lstrSubClas = IIf(CDbl(Left(lstrClasse, 1)) = 6, Left(lstrClasse, 2), IIf(Val(Left(lstrClasse, 1)) < 4, 1, Left(lstrClasse, 1)))
		lstrCodigo = "40" & astrUf & "B00" & Left(lstrSubClas & "00", 2)
		lintClasse = CShort(lstrSubClas)
		lstrSql = ""
		lstrSql = lstrSql & "SELECT * "
		lstrSql = lstrSql & "  FROM " & gstrDataBase & ".`codigos` "
		lstrSql = lstrSql & " WHERE `datanova` <= '" & VB6.Format(adteFaturamento, "yyyy-MM-dd") & "' "
		lstrSql = lstrSql & "   AND MID(`num`, 1, 9) = '" & lstrCodigo & "' "
		If astrIsento = "S" Then
			lstrSql = lstrSql & "   AND `valor`+0 = 0 "
		End If
		lstrSql = lstrSql & "ORDER BY `datanova` DESC, `limitkwh` ASC, `num` ASC "
		Call Conectar(lstrSql, lrstICMS)
		With lrstICMS
			If .State = ADODB.ObjectStateEnum.adStateOpen Then
				If .RecordCount > 0 Then
					While Not .EOF
						'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
						lstrCodIcms = IIf(IsDbNull(.Fields("num").value), lstrCodigo & "1", .Fields("num").value)
						'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
						ldblLimiteKWh = IIf(IsDbNull(.Fields("limitkwh").value), 0, .Fields("limitkwh").value)
						'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
						ldblValorIcms = CDbl(Replace(IIf(IsDbNull(.Fields("valor").value), 0, .Fields("valor").value), ",", "."))
						Select Case lintClasse
							'Industrial (0,1,2,3)
							Case Is < 4
								If lstrCodIcms = lstrCodigo & 1 Or lstrCodIcms = lstrCodigo & 2 Then
									If adblConsumo <= ldblLimiteKWh Then
										Aliquota_ICMS = ldblValorIcms
										Call .MoveLast()
									End If
								End If
								'Comercial Classe 4
							Case Is = 4
								If astrIsento = "N" Then
									If lstrCodIcms = lstrCodigo & 1 Then
										If adblConsumo <= ldblLimiteKWh Then
											Aliquota_ICMS = ldblValorIcms
											Call .MoveLast()
										End If
									End If
								Else
									If lstrCodIcms = lstrCodigo & 2 Then
										If adblConsumo <= ldblLimiteKWh Then
											Aliquota_ICMS = ldblValorIcms
											Call .MoveLast()
										End If
									End If
								End If
								'Rural Classe 5
							Case Is = 5
								If lstrCodIcms = lstrCodigo & 1 Or lstrCodIcms = lstrCodigo & 2 Then
									If Len(astrInsc) > 0 And lstrCodIcms = lstrCodigo & 1 Then
										Aliquota_ICMS = ldblValorIcms
										Call .MoveLast()
									Else
										If adblConsumo <= ldblLimiteKWh Then
											Aliquota_ICMS = ldblValorIcms
											Call .MoveLast()
										End If
									End If
								End If
								'Poder Publico Municipal 61
							Case Is = 61
								If lstrCodIcms = lstrCodigo & 1 Or lstrCodIcms = lstrCodigo & 2 Then
									If adblConsumo <= ldblLimiteKWh Then
										Aliquota_ICMS = ldblValorIcms
										Call .MoveLast()
									End If
								End If
								'Poder Publico Estadual 62
							Case Is = 62
								If astrIsento = "N" Then
									If lstrCodIcms = lstrCodigo & 1 Then
										If adblConsumo <= ldblLimiteKWh Then
											Aliquota_ICMS = ldblValorIcms
											Call .MoveLast()
										End If
									End If
								Else
									If lstrCodIcms = lstrCodigo & 2 Then
										If adblConsumo <= ldblLimiteKWh Then
											Aliquota_ICMS = ldblValorIcms
											Call .MoveLast()
										End If
									End If
								End If
								'Poder Publico Municipal 63
							Case Is = 63
								If lstrCodIcms = lstrCodigo & 1 Or lstrCodIcms = lstrCodigo & 2 Then
									If adblConsumo <= ldblLimiteKWh Then
										Aliquota_ICMS = ldblValorIcms
										Call .MoveLast()
									End If
								End If
								'Iluminação Publica 64
							Case Is = 64
								If lstrCodIcms = lstrCodigo & 1 Or lstrCodIcms = lstrCodigo & 2 Then
									If adblConsumo <= ldblLimiteKWh Then
										Aliquota_ICMS = ldblValorIcms
										Call .MoveLast()
									End If
								End If
								'Serviço Publico 7
							Case Is = 7
								If lstrCodIcms = lstrCodigo & 1 Or lstrCodIcms = lstrCodigo & 2 Then
									If adblConsumo <= ldblLimiteKWh Then
										Aliquota_ICMS = ldblValorIcms
										Call .MoveLast()
									End If
								End If
								'Consumo Proprio 8
							Case Is = 8
								If lstrCodIcms = lstrCodigo & 1 Or lstrCodIcms = lstrCodigo & 2 Then
									If adblConsumo <= ldblLimiteKWh Then
										Aliquota_ICMS = ldblValorIcms
										Call .MoveLast()
									End If
								End If
								'Resindencial 9
							Case Is = 9
								If lstrCodIcms = lstrCodigo & 1 Or lstrCodIcms = lstrCodigo & 2 Or lstrCodIcms = lstrCodigo & 3 Then
									If adblConsumo <= ldblLimiteKWh Then
										Aliquota_ICMS = ldblValorIcms
										Call .MoveLast()
									End If
								End If
						End Select
						Call .MoveNext()
					End While
				End If
				Call .Close()
			End If
		End With
		'UPGRADE_NOTE: Object lrstICMS may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6E35BFF6-CD74-4B09-9689-3E1A43DF8969"'
		lrstICMS = Nothing
	End Function
	
	Public Function CalcMediaMensal(ByVal astrZona As String, ByVal astrLivro As String, ByVal astrConta As String, ByVal aintNMeses As Short, ByVal alngConsId As Integer, ByVal alngUnidId As Integer, Optional ByRef alngQMedia As Integer = 0, Optional ByRef ablnGrade As Boolean = False, Optional ByRef amfgAux As AxMSFlexGridLib.AxMSFlexGrid = Nothing) As Double
		Dim lintDiv As Short
		Dim ldblkWh As Double
		Dim ldblCon As Double
		Dim ldblOco As Double
		Dim lstrOco As String
		Dim lstrDOc As String
		Dim ldblMed As Double
		Dim lstrIte As String
		Dim llngMes As Integer
		Dim llngCol As Integer
		Dim lstrSql As String
		Dim lrstAux As ADODB.Recordset
		lrstAux = New ADODB.Recordset
		If ablnGrade Then
			With amfgAux
				.Cols = aintNMeses + 3
				.Rows = 4
				Call .Clear()
				.set_RowHeight(3, 0)
			End With
		End If
		llngCol = 1
		lstrSql = ""
		lstrSql = lstrSql & "SELECT `nf`.`zona`, " & vbCrLf
		lstrSql = lstrSql & "       `nf`.`livro`, " & vbCrLf
		lstrSql = lstrSql & "       `nf`.`conta`, " & vbCrLf
		lstrSql = lstrSql & "       `nf`.`unid_id`, " & vbCrLf
		lstrSql = lstrSql & "       `nf`.`cons_id`, " & vbCrLf
		lstrSql = lstrSql & "       `nf`.`mesano_ref`, " & vbCrLf
		lstrSql = lstrSql & "       `nf`.`itensserv` " & vbCrLf
		lstrSql = lstrSql & "  FROM `nf` " & vbCrLf
		lstrSql = lstrSql & " WHERE `nf`.`zona`    = '" & astrZona & "' " & vbCrLf
		lstrSql = lstrSql & "   AND `nf`.`livro`   = '" & astrLivro & "' " & vbCrLf
		lstrSql = lstrSql & "   AND `nf`.`conta`   = '" & astrConta & "' " & vbCrLf
		lstrSql = lstrSql & "   AND `nf`.`unid_id` = " & alngUnidId & " " & vbCrLf
		lstrSql = lstrSql & "   AND `nf`.`cons_id` = " & alngConsId & " " & vbCrLf
		lstrSql = lstrSql & " ORDER BY `nf`.`mesano_ref` DESC LIMIT 0, " & aintNMeses
		Call Conectar(lstrSql, lrstAux)
		With lrstAux
			If .State = ADODB.ObjectStateEnum.adStateOpen Then
				If .RecordCount > 0 Then
					lintDiv = .RecordCount
					While Not .EOF
						'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
						llngMes = CInt(IIf(IsDbNull(.Fields("mesano_ref").value), 0, .Fields("mesano_ref").value))
						If ablnGrade Then
							With amfgAux
								llngCol = llngCol + 1
								.set_TextMatrix(0, llngCol - 1, Right(CStr(llngMes), 2) & "/" & Left(CStr(llngMes), 4))
							End With
						End If
						'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="2EED02CB-5C0E-4DC1-AE94-4FAA3A30F51A"'
						lstrIte = Trim(IIf(IsDbNull(.Fields("itensserv").value), "", .Fields("itensserv").value))
						lstrOco = ""
						ldblOco = 0
						lstrDOc = ""
						If InStr(1, lstrIte, "90410000") > 0 Then
							lstrOco = Mid(lstrIte, InStr(1, lstrIte, "90410000"), 10)
							ldblOco = BuscaVlrItem(lstrIte, lstrOco)
							lstrDOc = BuscaRefItem(lstrIte, lstrOco)
						Else
							ldblOco = 0
						End If
						ldblCon = BuscaVlrItem(lstrIte, "030201008")
						ldblkWh = ldblkWh + ldblCon
						If ldblOco = 1 Then
							alngQMedia = alngQMedia + 1
						Else
							If alngQMedia <= 1 Then alngQMedia = 0
						End If
						If ablnGrade Then
							With amfgAux
								.set_TextMatrix(1, llngCol - 1, ldblCon)
								.set_TextMatrix(2, llngCol - 1, IIf(ldblOco = 0, "LIDO", "MÉDIA"))
								.set_TextMatrix(3, llngCol - 1, Trim(lstrDOc))
							End With
						End If
						Call .MoveNext()
					End While
				End If
				Call .Close()
			End If
		End With
		If lintDiv > 0 Then
			ldblMed = Truncate(ldblkWh / lintDiv, 2)
			With amfgAux
				.set_TextMatrix(0, 0, "Meses")
				.set_TextMatrix(1, 0, "kWh")
				.set_TextMatrix(2, 0, "Ocor.")
				.set_TextMatrix(3, 0, "Desc.")
				.set_TextMatrix(0, .Cols - 2, "Qtde")
				.set_TextMatrix(1, .Cols - 2, lintDiv)
				.set_TextMatrix(2, .Cols - 2, alngQMedia)
				.set_TextMatrix(0, .Cols - 1, "Média")
				.set_TextMatrix(1, .Cols - 1, ldblMed)
			End With
		Else
			ldblMed = 0
		End If
		'UPGRADE_NOTE: Object lrstAux may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6E35BFF6-CD74-4B09-9689-3E1A43DF8969"'
		lrstAux = Nothing
		CalcMediaMensal = ldblMed
	End Function
	
	Public Function CalcConsumoLido(ByVal adblLeiAnt As Double, ByVal adblLeitAtual As Double, ByVal adblConstante As Double, ByVal aintGeraMedia As Short, ByVal adblResiduo As Double, ByVal adblMedia As Double) As Double
		Dim ldblLeitAtual As Double
		
		If aintGeraMedia <> 1 Then
			If adblLeitAtual >= 0 Then
				'verificar de consumo menor que zero pois nescaso pode haver virada de medidor
				If (adblLeitAtual - adblLeiAnt) < 0 Then
					Select Case Len(CStr(Truncate(adblLeiAnt, 0)))
						Case 3
							ldblLeitAtual = (999 + adblLeitAtual) + 1
						Case 4
							ldblLeitAtual = (9999 + adblLeitAtual) + 1
						Case 5
							ldblLeitAtual = (99999 + adblLeitAtual) + 1
						Case 6
							ldblLeitAtual = (999999 + adblLeitAtual) + 1
						Case 7
							ldblLeitAtual = (9999999 + adblLeitAtual) + 1
						Case 8
							ldblLeitAtual = (99999999 + adblLeitAtual) + 1
						Case 9
							ldblLeitAtual = (999999999 + adblLeitAtual) + 1
					End Select
				Else
					ldblLeitAtual = adblLeitAtual
				End If
				'Refazer os calculo de consumo para apurar consumo real
				CalcConsumoLido = Arredondar(((ldblLeitAtual - adblLeiAnt) + adblResiduo) * adblConstante, 0)
			Else
				CalcConsumoLido = 0
			End If
		Else
			'Quando tem Ocorrência que calcula a média, então faz pelo os ultimos 12 meses conforme art 87 res 414
			CalcConsumoLido = adblMedia
		End If
	End Function
	
	Public Sub EncheComboBoxDatasVencimento(ByRef acmbAux As System.Windows.Forms.ComboBox)
		Dim lstrDatas As String
		Dim lstrAux As String
		Dim lintPos As Short
		lstrAux = ""
		lintPos = 1
		lstrDatas = LeConfig("DATAS_VENCIMENTO")
		If lstrDatas = "" Or lstrDatas = "-1" Then
			lstrDatas = "05;10;15;20;25;30;"
		End If
		
		With acmbAux
			Call .Items.Clear()
			Call .Items.Add("")
			While lintPos <= Len(lstrDatas)
				If Mid(lstrDatas, lintPos, 1) <> ";" Then
					lstrAux = lstrAux & Mid(lstrDatas, lintPos, 1)
				ElseIf Mid(lstrDatas, lintPos, 1) = ";" Then 
					Call .Items.Add(lstrAux)
					lstrAux = ""
				End If
				lintPos = lintPos + 1
			End While
		End With
	End Sub
	
	Public Function VerificaSeExisteMicroGeracaoDistribuida(ByVal alngConsId As Integer, ByVal alngUnidId As Integer, ByVal astrGrupo As String, ByVal lintTipo As Short) As Boolean
		Dim llngUid As Integer
		Dim llngCId As Integer
		Dim lstrGru As String
		Dim lblnRet As Boolean
		Dim lstrSql As String
		Dim lrstAux As ADODB.Recordset
		lrstAux = New ADODB.Recordset
		lblnRet = False
		lstrSql = ""
		lstrSql = lstrSql & "SELECT * "
		lstrSql = lstrSql & "  FROM `microgeracao_distribuida` "
		lstrSql = lstrSql & " WHERE `grupo` = '" & astrGrupo & "' "
		If lintTipo = 0 Then
			lstrSql = lstrSql & "   AND `cons_id` = " & alngConsId & " "
			lstrSql = lstrSql & "   AND `unid_id` = " & alngUnidId & " "
		Else
			lstrSql = lstrSql & "   AND `cons_id_d` = " & alngConsId & " "
			lstrSql = lstrSql & "   AND `unid_id_d` = " & alngUnidId & " "
			lstrSql = lstrSql & "   AND `valor` > 0 " ' Caso o percentual seja zero não distribui mais
		End If
		lstrSql = lstrSql & " LIMIT 0, 1"
		Call Conectar(lstrSql, lrstAux)
		With lrstAux
			If .State = ADODB.ObjectStateEnum.adStateOpen Then
				If .RecordCount > 0 Then
					lblnRet = True
				End If
				Call .Close()
			End If
		End With
		'  If Not lblnRet Then
		'    lstrSql = ""
		'    lstrSql = lstrSql & "SELECT * "
		'    lstrSql = lstrSql & "  FROM `microgeracao_distribuida` "
		'    lstrSql = lstrSql & " WHERE `cons_id_d` = " & alngConsId & " "
		'    lstrSql = lstrSql & "   AND `unid_id_d` = " & alngUnidId & " "
		'    lstrSql = lstrSql & "   AND `grupo_d` = '" & astrGrupo & "' "
		'    lstrSql = lstrSql & " LIMIT 0, 1"
		'    Call Conectar(lstrSql, lrstAux)
		'    With lrstAux
		'      If .State = ADODB.ObjectStateEnum.adStateOpen Then
		'        If .RecordCount > 0 Then
		'          lblnRet = True
		'        End If
		'        Call .Close
		'      End If
		'    End With
		'  End If
		
		
		
		'UPGRADE_NOTE: Object lrstAux may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6E35BFF6-CD74-4B09-9689-3E1A43DF8969"'
		lrstAux = Nothing
		VerificaSeExisteMicroGeracaoDistribuida = lblnRet
	End Function
End Module