Imports System Imports System.ComponentModel Imports System.Collections.Generic Imports System.Diagnostics Imports System.Text Imports DevExpress.ExpressApp Imports DevExpress.ExpressApp.Actions Imports DevExpress.Persistent.Base Imports DevExpress.Xpo Imports DevExpress.ExpressApp.SystemModule Imports DevExpress.Data.Filtering Imports System.Linq Public Class SpecTranRevaluationVC Inherits DevExpress.ExpressApp.ViewController Public Event InitWork(ByVal _Minimum As Long, ByVal _Step As Long, ByVal _Maximum As Long) Public Event DoWork() Public Event FinalWork Public Sub New() MyBase.New() 'This call is required by the Component Designer. InitializeComponent() RegisterActions(components) End Sub Private Sub aGenerateSpecTranRevaluationQuery_Execute(sender As System.Object, e As DevExpress.ExpressApp.Actions.SimpleActionExecuteEventArgs) Handles aGenerateSpecTranRevaluationQuery.Execute Dim _ocur As Xpo.XPObjectSpace = TryCast(View.ObjectSpace, Xpo.XPObjectSpace) Dim _uow As New UnitOfWork(_ocur.Session.DataLayer) Dim _SpecTranRevaluation As SpecTranRevaluation = _uow.GetObjectByKey(Of SpecTranRevaluation)(TryCast(View.SelectedObjects(0), SpecTranRevaluation).Oid) Dim _SpecTranRevaluationRowsAccounts_Collection = New XPCollection(Of SpecTranRevaluationRowsAccounts)(_uow, CriteriaOperator.Parse("SpecTranRevaluation=?", _SpecTranRevaluation)) _uow.Delete(_SpecTranRevaluationRowsAccounts_Collection) Dim _SpecTranRevaluationLiquidAssets_Collection = New XPCollection(Of SpecTranRevaluationLiquidAssets)(_uow, CriteriaOperator.Parse("SpecTranRevaluation=?", _SpecTranRevaluation)) _uow.Delete(_SpecTranRevaluationLiquidAssets_Collection) Dim _LiquidAssets_Collection As New XPCollection(Of LiquidAssets)(_uow, CriteriaOperator.Parse("CurrencyName.ShortName <>'HUF' and CustomerFrom=?", _SpecTranRevaluation.CustomersFrom)) Dim _LiquidAssets As LiquidAssets '// Pénzeszközök egyenlege Dim _SpecTranRevaluationLiquidAssets As SpecTranRevaluationLiquidAssets Dim _BallanceDEV As Double = 0 RaiseEvent InitWork(1, 1, _LiquidAssets_Collection.Count) For Each _LiquidAssets In _LiquidAssets_Collection RaiseEvent DoWork() _BallanceDEV = 0 Select Case _LiquidAssets.LiquidAssetsType Case eLiquidAssetsType.NormalBank _BallanceDEV = GetBallanceDEVBank(_uow, _LiquidAssets, _SpecTranRevaluation.DateClose.Date) If _BallanceDEV <> 0 Then _SpecTranRevaluationLiquidAssets = New SpecTranRevaluationLiquidAssets(_uow) _SpecTranRevaluationLiquidAssets.SpecTranRevaluation = _SpecTranRevaluation _SpecTranRevaluationLiquidAssets.LiquidAssets = _LiquidAssets _SpecTranRevaluationLiquidAssets.BallanceDEV = _BallanceDEV _SpecTranRevaluationLiquidAssets.BallanceHUF = GetBallanceHUFBank(_uow, _LiquidAssets, _SpecTranRevaluation.DateClose.Date) _SpecTranRevaluationLiquidAssets.BallanceHUF_Revaluation = _SpecTranRevaluationLiquidAssets.BallanceDEV * _SpecTranRevaluation.CurrencyRate _SpecTranRevaluationLiquidAssets.DifferenceHUF = _SpecTranRevaluationLiquidAssets.BallanceHUF - _SpecTranRevaluationLiquidAssets.BallanceHUF_Revaluation End If Case eLiquidAssetsType.NormalCheckout, eLiquidAssetsType.CurrencyCheckout, eLiquidAssetsType.DepositCheckout _BallanceDEV = GetBallanceDEVCassa(_uow, _LiquidAssets, _SpecTranRevaluation.DateClose.Date) If Math.Round(_BallanceDEV, 4, MidpointRounding.AwayFromZero) <> 0 Then _SpecTranRevaluationLiquidAssets = New SpecTranRevaluationLiquidAssets(_uow) _SpecTranRevaluationLiquidAssets.SpecTranRevaluation = _SpecTranRevaluation _SpecTranRevaluationLiquidAssets.LiquidAssets = _LiquidAssets _SpecTranRevaluationLiquidAssets.BallanceDEV = _BallanceDEV _SpecTranRevaluationLiquidAssets.BallanceHUF = GetBallanceHUFCassa(_uow, _LiquidAssets, _SpecTranRevaluation.DateClose.Date) _SpecTranRevaluationLiquidAssets.BallanceHUF_Revaluation = _SpecTranRevaluationLiquidAssets.BallanceDEV * _SpecTranRevaluation.CurrencyRate _SpecTranRevaluationLiquidAssets.DifferenceHUF = _SpecTranRevaluationLiquidAssets.BallanceHUF - _SpecTranRevaluationLiquidAssets.BallanceHUF_Revaluation End If End Select Next _uow.CommitChanges() RaiseEvent FinalWork '// Szállítói vevői egyenlegek Dim _SpecTranRevaluationRowsAccounts As SpecTranRevaluationRowsAccounts Dim PCI As New XPQuery(Of PCIDetail)(_uow) Dim query = From _PCI In PCI Where _PCI.DateExecution.Date <= _SpecTranRevaluation.DateClose.Date And _PCI.Customers IsNot Nothing And _PCI.ConnectInfo IsNot Nothing And _PCI.CustomersFrom Is _SpecTranRevaluation.CustomersFrom And _PCI.CurrencyName_Account IsNot Nothing And _PCI.CurrencyName_Account Is _SpecTranRevaluation.CurrencyName And _PCI.GLAccounts IsNot Nothing Group _PCI By _PCI.Customers, _ _PCI.PartnerType, _ _PCI.ConnectInfo, _PCI.GLAccounts Into g = Group Order By PartnerType, Customers, ConnectInfo Select New With {Key .Customers = Customers, _ Key .PartnerType = PartnerType, _ Key .ConnectInfo = ConnectInfo, _ Key .GLAccounts = GLAccounts, _ Key .DocumentNumber = g.Max(Function(inv) inv.DocumentNumber), _ Key .RegistryNumber = g.Max(Function(inv) inv.RegistryNumber), _ Key .AmountHUF = g.Sum(Function(inv) inv.AmountHUF_Account), _ Key .AmountDEV = g.Sum(Function(inv) inv.AmountDEV_Account), _ Key .BallanceHUF = g.Sum(Function(inv) inv.BallanceHUF), _ Key .BallanceDEV = g.Sum(Function(inv) inv.BallanceDEV), _ Key .DatePayment = g.Max(Function(inv) inv.DatePayment_Account), _ Key .DateExecution = g.Max(Function(inv) inv.DateExecution_Account) _ } RaiseEvent InitWork(1, 1, query.Count) For Each item In query RaiseEvent DoWork() Dim _GLAccountsRevaluations As GLAccountsRevaluations = _uow.FindObject(Of GLAccountsRevaluations)(CriteriaOperator.Parse("GLAccounts=?", item.GLAccounts)) If _GLAccountsRevaluations Is Nothing Then If Math.Round(item.BallanceDEV, 2, MidpointRounding.AwayFromZero) <> 0 Then _SpecTranRevaluationRowsAccounts = New SpecTranRevaluationRowsAccounts(_uow) _SpecTranRevaluationRowsAccounts.SpecTranRevaluation = _SpecTranRevaluation _SpecTranRevaluationRowsAccounts.PartnerType = item.PartnerType _SpecTranRevaluationRowsAccounts.Customers = item.Customers _SpecTranRevaluationRowsAccounts.ConnectInfo = item.ConnectInfo _SpecTranRevaluationRowsAccounts.CustomersFrom = _SpecTranRevaluation.CustomersFrom _SpecTranRevaluationRowsAccounts.BallanceDEV = item.BallanceDEV _SpecTranRevaluationRowsAccounts.GLAccounts = item.GLAccounts _SpecTranRevaluationRowsAccounts.BallanceHUF_Revaluation = Math.Round(item.BallanceDEV * _SpecTranRevaluation.CurrencyRate, 4, MidpointRounding.AwayFromZero) _SpecTranRevaluationRowsAccounts.CurrencyRate_Account = 1 If item.AmountDEV <> 0 Then _SpecTranRevaluationRowsAccounts.CurrencyRate_Account = Math.Round(item.AmountHUF / item.AmountDEV, 4, MidpointRounding.AwayFromZero) End If _SpecTranRevaluationRowsAccounts.BallanceHUF = Math.Round(item.BallanceDEV * _SpecTranRevaluationRowsAccounts.CurrencyRate_Account, 4, MidpointRounding.AwayFromZero) _SpecTranRevaluationRowsAccounts.DifferenceHUF = Math.Round((item.BallanceDEV * _SpecTranRevaluationRowsAccounts.CurrencyRate_Account) - _SpecTranRevaluationRowsAccounts.BallanceHUF_Revaluation, 4, MidpointRounding.AwayFromZero) End If End If Next _uow.CommitChanges() RaiseEvent FinalWork Frame.GetController(Of RefreshController).RefreshAction.DoExecute() End Sub Private Function GetBallanceHUFCassa(ByVal _uow As UnitOfWork, ByVal _LiquidAssets As LiquidAssets, ByVal _ToDate As Date) As Double Dim _GLCassa_Collection As New XPCollection(Of GLCassa)(PersistentCriteriaEvaluationBehavior.InTransaction, _uow, _ CriteriaOperator.Parse("LiquidAssets_Cassa=? and DateExecution<=? and DocumentNumber<>''", _LiquidAssets, DateAdd(DateInterval.Minute, 1439, _ToDate.Date))) Dim _GLCassa As GLCassa Dim _GLRows As GLRows Dim _InAmountHUF As Double = 0 Dim _OutAmountHUF As Double = 0 For Each _GLCassa In _GLCassa_Collection For Each _GLRows In _GLCassa.GLRows _InAmountHUF += _GLRows.InAmountHUF _OutAmountHUF += _GLRows.OutAmountHUF Next Next Return _InAmountHUF - _OutAmountHUF End Function Private Function GetBallanceDEVCassa(ByVal _uow As UnitOfWork, ByVal _LiquidAssets As LiquidAssets, ByVal _ToDate As Date) As Double Dim _GLCassa_Collection As New XPCollection(Of GLCassa)(PersistentCriteriaEvaluationBehavior.InTransaction, _uow, _ CriteriaOperator.Parse("LiquidAssets_Cassa=? and DateExecution<=? and DocumentNumber<>''", _LiquidAssets, DateAdd(DateInterval.Minute, 1439, _ToDate.Date))) Dim _GLCassa As GLCassa Dim _GLRows As GLRows Dim _InAmountDEV As Double = 0 Dim _OutAmountDEV As Double = 0 For Each _GLCassa In _GLCassa_Collection For Each _GLRows In _GLCassa.GLRows _InAmountDEV += _GLRows.InAmountDEV _OutAmountDEV += _GLRows.OutAmountDEV Next Next Return _InAmountDEV - _OutAmountDEV End Function Function GetBallanceHUFBank(ByVal _uow As UnitOfWork, ByVal _LiquidAssets As LiquidAssets, ByVal _ToDate As Date) As Double Dim _GLBank_Collection As New XPCollection(Of GLBank)(_uow, _ CriteriaOperator.Parse("LiquidAssets_Main=? and DateExecution<=? and IsEditable=False", _LiquidAssets, DateAdd(DateInterval.Minute, 1439, _ToDate.Date))) Dim _GLBank As GLBank Dim _GLRows As GLRows Dim _InAmountHUF As Double = 0 Dim _OutAmountHUF As Double = 0 For Each _GLBank In _GLBank_Collection For Each _GLRows In _GLBank.GLRows _InAmountHUF += _GLRows.InAmountHUF _OutAmountHUF += _GLRows.OutAmountHUF Next Next Return _InAmountHUF - _OutAmountHUF End Function Function GetBallanceDEVBank(ByVal _uow As UnitOfWork, ByVal _LiquidAssets As LiquidAssets, ByVal _ToDate As Date) As Double Dim _GLBank_Collection As New XPCollection(Of GLBank)(_uow, _ CriteriaOperator.Parse("LiquidAssets_Main=? and DateExecution<=? and IsEditable=False", _LiquidAssets, DateAdd(DateInterval.Minute, 1439, _ToDate.Date))) Dim _GLBank As GLBank Dim _GLRows As GLRows Dim _InAmountDEV As Double = 0 Dim _OutAmountDEV As Double = 0 For Each _GLBank In _GLBank_Collection For Each _GLRows In _GLBank.GLRows _InAmountDEV += _GLRows.InAmountDEV _OutAmountDEV += _GLRows.OutAmountDEV Next Next Return _InAmountDEV - _OutAmountDEV End Function Private Sub aViewPCIDSpecTranRevaluation_Execute(sender As System.Object, e As DevExpress.ExpressApp.Actions.SimpleActionExecuteEventArgs) Handles aViewPCIDSpecTranRevaluation.Execute Dim _onew As Xpo.XPObjectSpace = Application.CreateObjectSpace Dim _ocur As Xpo.XPObjectSpace = TryCast(View.ObjectSpace, Xpo.XPObjectSpace) Dim _SpecTranRevaluationRowsAccounts As SpecTranRevaluationRowsAccounts = TryCast(View.SelectedObjects(0), SpecTranRevaluationRowsAccounts) ViewPDCI.ViewPDCIDetail(_onew, Application, e, _SpecTranRevaluationRowsAccounts.CustomersFrom, _ _SpecTranRevaluationRowsAccounts.Customers, _SpecTranRevaluationRowsAccounts.PartnerType, _ _SpecTranRevaluationRowsAccounts.ConnectInfo) End Sub Private Sub aCreateRevaluation_Execute(sender As System.Object, e As DevExpress.ExpressApp.Actions.SimpleActionExecuteEventArgs) Handles aCreateRevaluation.Execute '// devizás átértékelési bizonylatot csinál Dim _ocur As Xpo.XPObjectSpace = TryCast(View.ObjectSpace, Xpo.XPObjectSpace) Dim _uow As New UnitOfWork(_ocur.Session.DataLayer) Dim _SpecTranRevaluationRowsAccounts As SpecTranRevaluationRowsAccounts Dim _SpecTranRevaluation As SpecTranRevaluation = TryCast(View.SelectedObjects(0), SpecTranRevaluationRowsAccounts).SpecTranRevaluation Dim _GLHeader_Revaluation As GLMixed = Nothing Dim _GLRows_Revaluation As GLRows Dim _DebitChartOfAccounts As ChartOfAccounts = Nothing Dim _CreditChartOfAccounts As ChartOfAccounts = Nothing Dim _Controlling As Controlling = Nothing Dim _GLMixedNG As GLMixedNG Dim _Rate As Double = 1 Dim _GLHeader_RevaluationParameter = _ocur.FindObject(Of GLHeader_RateDiffParameter)(CriteriaOperator.Parse("1=1")) If _GLHeader_RevaluationParameter Is Nothing Then Throw New Exception("*Nincs beállítva az átértékelési paraméter !") Exit Sub End If Dim _ChartOfAccounts_Revaluation_Win As ChartOfAccounts = _GLHeader_RevaluationParameter.GetChartOfAccounts(_SpecTranRevaluation.DateClose.Year, eWinLoss.eRevaluationWin) Dim _ChartOfAccounts_Revaluation_Loss As ChartOfAccounts = _GLHeader_RevaluationParameter.GetChartOfAccounts(_SpecTranRevaluation.DateClose.Year, eWinLoss.eRevaluationLoss) Dim _Controlling_Revaluation_Win As Controlling = _GLHeader_RevaluationParameter.Controlling_Revaluation_Win Dim _Controlling_Revaluation_Loss As Controlling = _GLHeader_RevaluationParameter.Controlling_Revaluation_Loss If _ChartOfAccounts_Revaluation_Loss Is Nothing Or _ _ChartOfAccounts_Revaluation_Win Is Nothing Then Throw New Exception("*Nincs beállítva az átértékelési paraméter !") Exit Sub End If Dim _CurrencyName As CurrencyName = Nothing Dim i As Long = 0 Dim _InAmountHUF As Double = 0 Dim _OutAmountHUF As Double = 0 Dim _InAmountDEV As Double = 0 Dim _OutAmountDEV As Double = 0 _GLHeader_Revaluation = _ocur.CreateObject(Of GLMixed)() _GLHeader_Revaluation.CustomersFrom = _SpecTranRevaluation.CustomersFrom _GLMixedNG = _ocur.FindObject(Of GLMixedNG)(CriteriaOperator.Parse("CustomersFrom=?", _GLHeader_Revaluation.CustomersFrom), True) If _GLMixedNG IsNot Nothing Then If _GLHeader_Revaluation.DocumentNumber = "" Then _GLHeader_Revaluation.DocumentNumber = _GLMixedNG.NumberGenerator.GetNewNumber(_GLMixedNG.NumberGenerator_Revaluation) End If End If _GLHeader_Revaluation.DateExecution = _SpecTranRevaluation.DateClose.Date _GLHeader_Revaluation.DateCreated = _SpecTranRevaluation.DateClose.Date _GLHeader_Revaluation.NoteHeader = "Devizás átértékelés" _GLHeader_Revaluation.GLDocumentType = eGLDocumentType.eGLRateDiff _GLHeader_Revaluation.IsEditable = False _GLHeader_Revaluation.IsStorno = False For Each _SpecTranRevaluationRowsAccounts In View.SelectedObjects _GLHeader_Revaluation.CurrencyName = _ocur.FindObject(Of CurrencyName)(CriteriaOperator.Parse("ShortName='HUF'")) _InAmountDEV = 0 _InAmountHUF = 0 _OutAmountDEV = 0 _OutAmountHUF = 0 Select Case _SpecTranRevaluationRowsAccounts.PartnerType Case ePartnerType.ePayabels If _SpecTranRevaluationRowsAccounts.DifferenceHUF > 0 Then _DebitChartOfAccounts = _SpecTranRevaluationRowsAccounts.Customers.CustomersGLParameters.GetChartOfAccounts(_GLHeader_Revaluation.DateExecution.Year, eVATMode.eIn) _CreditChartOfAccounts = _ChartOfAccounts_Revaluation_Win _Controlling = _Controlling_Revaluation_Win _InAmountHUF = Math.Round(Math.Abs(_SpecTranRevaluationRowsAccounts.DifferenceHUF), 2) Else 'Árfolyam veszteség szállító _DebitChartOfAccounts = _ChartOfAccounts_Revaluation_Loss _CreditChartOfAccounts = _SpecTranRevaluationRowsAccounts.Customers.CustomersGLParameters.GetChartOfAccounts(_GLHeader_Revaluation.DateExecution.Year, eVATMode.eIn) _Controlling = _Controlling_Revaluation_Loss _OutAmountHUF = Math.Round(Math.Abs(_SpecTranRevaluationRowsAccounts.DifferenceHUF), 2) End If Case ePartnerType.eReceivables If _SpecTranRevaluationRowsAccounts.DifferenceHUF > 0 Then 'Nyereség vevő _DebitChartOfAccounts = _ChartOfAccounts_Revaluation_Loss _CreditChartOfAccounts = _SpecTranRevaluationRowsAccounts.Customers.CustomersGLParameters.GetChartOfAccounts(_GLHeader_Revaluation.DateExecution.Year, eVATMode.eOut) _Controlling = _Controlling_Revaluation_Loss _InAmountHUF = Math.Round(Math.Abs(_SpecTranRevaluationRowsAccounts.DifferenceHUF), 2) Else 'Árfolyam nyereség vevő _DebitChartOfAccounts = _SpecTranRevaluationRowsAccounts.Customers.CustomersGLParameters.GetChartOfAccounts(_GLHeader_Revaluation.DateExecution.Year, eVATMode.eOut) _CreditChartOfAccounts = _ChartOfAccounts_Revaluation_Win _Controlling = _Controlling_Revaluation_Win _OutAmountHUF = Math.Round(Math.Abs(_SpecTranRevaluationRowsAccounts.DifferenceHUF), 2) End If End Select _GLRows_Revaluation = _ocur.CreateObject(Of GLRows)() _GLRows_Revaluation.GLHeader = _GLHeader_Revaluation _GLRows_Revaluation.InAmountHUF = _InAmountHUF _GLRows_Revaluation.OutAmountHUF = _OutAmountHUF _GLRows_Revaluation.InAmountDEV = 0 _GLRows_Revaluation.OutAmountDEV = 0 _GLRows_Revaluation.AddGLRows(_GLHeader_Revaluation, _DebitChartOfAccounts, _CreditChartOfAccounts, 0, Math.Abs(_SpecTranRevaluationRowsAccounts.DifferenceHUF), Nothing, _ _SpecTranRevaluationRowsAccounts.Customers, Nothing, Nothing, "", Nothing, _Controlling, Nothing, Nothing, Nothing, _SpecTranRevaluationRowsAccounts.ConnectInfo, _ eGLRowsTypeVAT.eNettoRow, Guid.NewGuid, eTransactionType.eNotSet, eCashType.ePartner, _SpecTranRevaluationRowsAccounts.PartnerType) Dim _GLAccountsRevaluations As GLAccountsRevaluations = _ocur.CreateObject(Of GLAccountsRevaluations)() _GLAccountsRevaluations.GLAccounts = _SpecTranRevaluationRowsAccounts.GLAccounts _GLAccountsRevaluations.GLRows = _GLRows_Revaluation _GLAccountsRevaluations.CurrencyRate_Revaluation = _SpecTranRevaluation.CurrencyRate _GLAccountsRevaluations.CurrencyRate = _SpecTranRevaluationRowsAccounts.CurrencyRate_Account _ocur.CommitChanges() GLFunctions.ReconfigurePCI(_uow, _SpecTranRevaluationRowsAccounts.CustomersFrom, _SpecTranRevaluationRowsAccounts.Customers, _SpecTranRevaluationRowsAccounts.PartnerType, _SpecTranRevaluationRowsAccounts.ConnectInfo) Next _ocur.CommitChanges() 'Frame.GetController(Of RefreshController).RefreshAction.DoExecute() End Sub Private Sub aRemoveRevaluation_Execute(sender As System.Object, e As DevExpress.ExpressApp.Actions.SimpleActionExecuteEventArgs) Handles aRemoveRevaluation.Execute Dim _ocur As Xpo.XPObjectSpace = TryCast(View.ObjectSpace, Xpo.XPObjectSpace) Dim _GLAccountsRevaluations As GLAccountsRevaluations For Each _GLAccountsRevaluations In View.SelectedObjects _ocur.Delete(_GLAccountsRevaluations.GLRows) _ocur.Delete(_GLAccountsRevaluations) Next _ocur.CommitChanges() End Sub End Class