Imports EgtUILib.EgtInterface Imports EgtWPFLib5 Imports Newtonsoft.Json Imports System.IO Imports System.Collections.ObjectModel Imports System.Globalization Imports EgtWindowMaker.ManageWindowVM Imports MS.Internal.Text.TextInterface Imports System.Xml.Serialization Public Class ManageWindowVM Inherits VMBase Public Enum ParamCathegories As Integer GENERAL = 1 FRAME = 2 SPLIT = 3 SASH = 4 FILL = 5 HARDWARE = 6 End Enum Public Enum SplitParamPages As Integer SELECTION = 1 PARAMETERS = 2 End Enum Public Enum DShowModes MODE2D = 1 MODESIMPLE3D = 2 MODE3D = 3 End Enum Private m_SelParamCathegory As ParamCathegories Public Property SelParamCathegoryIndex As Integer Get Return m_SelParamCathegory - 1 End Get Set(value As Integer) Select Case m_SelParamCathegory Case ParamCathegories.SPLIT, ParamCathegories.SASH, ParamCathegories.FILL If Not IsNothing(m_SelArea) AndAlso Not m_SelArea.bApplied Then m_SelArea.ParentArea.AreaList.Remove(m_SelArea) End If End Select m_SelParamCathegory = value + 1 Select Case m_SelParamCathegory Case ParamCathegories.GENERAL Case ParamCathegories.FRAME ' seleziono area frame SetSelArea(m_CurrWindow.AreaList(0), True) ' mostro aree di selezione ManageSplitSelectionSurfaces(False, True) Case ParamCathegories.SPLIT ' resetto selezione SetSelArea(Nothing, True) ' mostro aree di selezione ManageSplitSelectionSurfaces(True, True) Case ParamCathegories.SASH ' resetto selezione SetSelArea(Nothing, True) ' mostro aree di selezione ManageSplitSelectionSurfaces(True, True) Case ParamCathegories.FILL ' resetto selezione SetSelArea(Nothing, True) ' mostro aree di selezione ManageSplitSelectionSurfaces(True, True) End Select End Set End Property Public ReadOnly Property SelParamCathegory As Integer Get Return m_SelParamCathegory End Get End Property Friend Sub ResetParamCathegory() m_SelParamCathegory = ParamCathegories.GENERAL NotifyPropertyChanged(NameOf(SelParamCathegoryIndex)) End Sub Private m_CurrWindow As Window Public Property CurrWindow As Window Get Return m_CurrWindow End Get Set(value As Window) m_CurrWindow = value End Set End Property Private m_SelArea As Area Public Property SelArea As Area Get Return m_SelArea End Get Set(value As Area) m_SelArea = value End Set End Property Private Sub SetSelArea(Area As Area, Optional NotifyProperty As Boolean = False) m_SelArea = Area Map.refSceneHostVM.ResetSelIdList() If Not IsNothing(Area) Then SelSurfFromArea(Area) If NotifyProperty Then NotifyPropertyChanged(NameOf(SelArea)) End Sub Private m_DShowMode As DShowModes = DShowModes.MODESIMPLE3D Friend Sub SetDShowMode(value As DShowModes) m_DShowMode = value DrawWindow(False) End Sub Public Property bIsShow2DOn As Boolean Get Return m_DShowMode = DShowModes.MODE2D End Get Set(value As Boolean) If value Then m_DShowMode = DShowModes.MODE2D End If DrawWindow() ' mostro aree di selezione ManageSplitSelectionSurfaces(True, True) End Set End Property Public Property bIsShowSimple3DOn As Boolean Get Return m_DShowMode = DShowModes.MODESIMPLE3D End Get Set(value As Boolean) If value Then m_DShowMode = DShowModes.MODESIMPLE3D End If DrawWindow() ' mostro aree di selezione ManageSplitSelectionSurfaces(True, True) End Set End Property Public Property bIsShow3DOn As Boolean Get Return m_DShowMode = DShowModes.MODE3D End Get Set(value As Boolean) If value Then m_DShowMode = DShowModes.MODE3D End If DrawWindow() ' mostro aree di selezione ManageSplitSelectionSurfaces(True, True) End Set End Property Private m_HardwareShowMode As Boolean = True Public Property HardwareShowMode As Boolean Get Return m_HardwareShowMode End Get Set(value As Boolean) m_HardwareShowMode = value ' imposto se mostrare solido ferramenta Dim gf = EgtLuaCreateGlobTable("WDG") Dim kl = EgtLuaSetGlobBoolVar("WDG.AUXSTATUS", m_HardwareShowMode) Dim kj = EgtLuaCallFunction("WinSetAuxGrpStatus") Dim go = EgtLuaResetGlobVar("WDG") EgtDraw() End Set End Property #Region "Split" 'Private m_nSplitParamPage As SplitParamPages 'Public Property nSplitParamPageIndex As Integer ' Get ' Return m_nSplitParamPage - 1 ' End Get ' Set(value As Integer) ' m_nSplitParamPage = value + 1 ' End Set 'End Property Private Sub SetSplitParamPage(nValue As SplitParamPages) Select Case nValue Case SplitParamPages.SELECTION ' mostro aree di selezione For Each Area In m_CurrWindow.AreaList Area.ManageSelectionSurface(GDB_ST.ON_) Next End Select 'm_nSplitParamPage = nValue 'NotifyPropertyChanged(NameOf(nSplitParamPageIndex)) End Sub Friend ReadOnly Property SplitParamPage As SplitParamPages Get Return If(IsNothing(m_SelArea), SplitParamPages.SELECTION, SplitParamPages.PARAMETERS) End Get End Property Private Sub ManageSplitSelectionSurfaces(bShow As Boolean, Optional bDraw As Boolean = False) ' mostro aree di selezione For Each Area In m_CurrWindow.AreaList Area.ManageSelectionSurface(bShow) Next If bDraw Then EgtDraw() End Sub #End Region ' Split Private m_HardwareList As New List(Of Hardware) Public ReadOnly Property HardwareList As List(Of Hardware) Get Return m_HardwareList End Get End Property ' Definizione comandi Private m_cmdRead As ICommand Private m_cmdWrite As ICommand Private m_cmdFillGlass As ICommand Private m_cmdFillWood As ICommand Private m_cmdDraw As ICommand Private m_cmdApplyFrame As ICommand Private m_cmdApplySplit As ICommand Private m_cmdDeleteArea As ICommand Private m_cmdApplySash As ICommand Private m_cmdApplyFill As ICommand Sub New() Map.SetRefManageWindowVM(Me) ' assegno funzioni a delegati Area.m_delDrawWindow = AddressOf DrawWindow FrameDimension.m_delDrawWindow = AddressOf DrawWindow Joint.m_delDrawWindow = AddressOf DrawWindow Split.m_delDrawWindow = AddressOf DrawWindow Sash.m_delDrawWindow = AddressOf DrawWindow ' imposto path profilo per lua Dim gg = EgtLuaExecFile(Map.refMainWindowVM.MainWindowM.sBaseDir & "\" & DESIGNING_DIR & "\WinProject.lua") Dim gf = EgtLuaCreateGlobTable("WDG") Dim kk = EgtLuaSetGlobStringVar("WDG.PROFILEPATH", Map.refMainWindowVM.MainWindowM.sProfileDir) Dim ke = EgtLuaCallFunction("SetProfilePath") Dim ud = EgtLuaResetGlobVar("WDG") ' carico lista hardware RefreshHardwareList() ' creo nuova finestra NewWindow() End Sub Friend Sub NewWindow() ' creo la finestra CurrWindow = New Window CurrWindow.sProfilePath = "Profilo78" Dim Frame As Frame = Frame.CreateFrame(m_CurrWindow) m_CurrWindow.AreaList.Add(Frame) '' carico lista hardware 'RefreshHardwareList() ' disegno la finestra DrawWindow() End Sub Private Function SearchAreaById(Area As Area, nAreaId As Integer) As Area If Area.nAreaId = nAreaId Then Return Area Else For Each ChildArea In Area.AreaList Dim ResArea As Area = SearchAreaById(ChildArea, nAreaId) If Not IsNothing(ResArea) Then Return ResArea Next End If Return Nothing End Function Friend Function GetAreaFromId(nId As Integer) As Area ' recupero nome e Id dell'area selezionata Dim nSelLayerId As Integer = EgtGetParent(nId) Dim sSelLayerName As String = "" EgtGetName(nSelLayerId, sSelLayerName) Dim nSelAreaId As Integer = EgtGetParent(nSelLayerId) ' recupero eventuale riferimento ad area originale (per split multipli) Dim nOrigSplitAreaId As Integer = GDB_ID.NULL EgtGetInfo(nSelAreaId, LUA_WIN_ORIGSPLIT, nOrigSplitAreaId) If nOrigSplitAreaId <> GDB_ID.NULL Then nSelAreaId = nOrigSplitAreaId End If ' Dim nSelAreaType As Integer = 0 EgtGetInfo(nSelAreaId, WIN_AREATYPE, nSelAreaType) Dim bFrenchSash As Boolean = False If m_SelParamCathegory = ParamCathegories.SASH AndAlso nSelAreaType = AreaTypes.SASH Then ' recupero Parent area e verifico se e' di tipo Splitted Dim nParentAreaId As Integer = EgtGetParent(nSelAreaId) Dim nParentAreaType As Integer = 0 EgtGetInfo(nParentAreaId, WIN_AREATYPE, nParentAreaType) If nParentAreaType = LuaAreaTypes.SPLIT OrElse nParentAreaType = LuaAreaTypes.NULL Then ' recupero area Split originale e verifico se e' di tipo French If Not EgtGetInfo(EgtGetParent(nParentAreaId), LUA_WIN_ORIGSPLIT, nOrigSplitAreaId) Then nOrigSplitAreaId = EgtGetParent(nParentAreaId) End If Dim nSplitLayerId As Integer = EgtGetFirstNameInGroup(nOrigSplitAreaId, LUA_WIN_SPLIT) Dim nSplitType As Integer = 0 EgtGetInfo(nSplitLayerId, LUA_WIN_SPLITTYPE, nSplitType) If nSplitType = LuaSplitTypes.FRENCH Then bFrenchSash = True nSelAreaId = nOrigSplitAreaId End If End If End If ' cerco l'Id area tra le aree della grafica Dim SelArea As Area = Nothing For Each Frame In m_CurrWindow.AreaList SelArea = SearchAreaById(Frame, nSelAreaId) If Not IsNothing(SelArea) Then Exit For Next ' se area splitselection e tipo non split, prendo il figlio If (sSelLayerName = LUA_WIN_SPLITSELECTION OrElse bFrenchSash) AndAlso (SelArea.AreaType = AreaTypes.FRAME OrElse SelArea.AreaType = AreaTypes.SASH OrElse SelArea.AreaType = AreaTypes.FILL) Then SelArea = SelArea.AreaList(0) End If Return SelArea End Function Friend Sub SelAreaFromId(nSelId As Integer) Dim SelArea As Area = GetAreaFromId(nSelId) Dim ResAreaList As New List(Of Area)({SelArea}) Select Case m_SelParamCathegory Case ParamCathegories.SPLIT For Each ResArea In ResAreaList Select Case ResArea.AreaType Case AreaTypes.FRAME, AreaTypes.SASH, AreaTypes.SPLITTED If ResArea.AreaList.Count = 0 Then ' aggiungo Area split di default Dim SplitArea As Split = Split.CreateSplit(ResArea, SplitShapes.VERTICAL) ' imposto i parametri di default SplitArea.SetSplitQty(1, True) 'aggiungo area ResArea.AreaList.Add(SplitArea) ' la imposto come selezionata m_SelArea = SplitArea NotifyPropertyChanged(NameOf(SelArea)) ElseIf ResArea.AreaList(0).AreaType = AreaTypes.SPLIT Then m_SelArea = ResArea.AreaList(0) NotifyPropertyChanged(NameOf(SelArea)) End If Case AreaTypes.SPLIT m_SelArea = ResArea NotifyPropertyChanged(NameOf(SelArea)) End Select Next Case ParamCathegories.SASH For Each ResArea In ResAreaList Select Case ResArea.AreaType Case AreaTypes.FRAME, AreaTypes.SPLITTED If ResArea.AreaList.Count = 0 Then ' aggiungo Area sash di default Dim SashArea As Sash = Sash.CreateSash(ResArea) ' imposto i parametri di default SashArea.SetSashType(SashTypes.NULL) SashArea.SetSashQty(1) 'aggiungo area ResArea.AreaList.Add(SashArea) ' la imposto come selezionata m_SelArea = SashArea NotifyPropertyChanged(NameOf(SelArea)) ElseIf ResArea.AreaList(0).AreaType = AreaTypes.SASH Then m_SelArea = ResArea.AreaList(0) NotifyPropertyChanged(NameOf(SelArea)) End If Case AreaTypes.SASH m_SelArea = ResArea NotifyPropertyChanged(NameOf(SelArea)) End Select Next Case ParamCathegories.FILL For Each ResArea In ResAreaList Select Case ResArea.AreaType Case AreaTypes.SASH, AreaTypes.FRAME, AreaTypes.SPLITTED If ResArea.AreaList.Count = 0 Then ' aggiungo Area fill di default Dim FillArea As Fill = Fill.CreateFill(ResArea, FillTypes.GLASS) ' imposto i parametri di default FillArea.SetFillType(FillTypes.GLASS) 'aggiungo area ResArea.AreaList.Add(FillArea) ' la imposto come selezionata m_SelArea = FillArea NotifyPropertyChanged(NameOf(SelArea)) ElseIf ResArea.AreaList(0).AreaType = AreaTypes.FILL Then m_SelArea = ResArea.AreaList(0) NotifyPropertyChanged(NameOf(SelArea)) End If Case AreaTypes.FILL m_SelArea = ResArea NotifyPropertyChanged(NameOf(SelArea)) End Select Next End Select End Sub Friend Sub DeselAreaFromId() ' se creazione area non confermata, elimino l'area Select Case m_SelParamCathegory Case ParamCathegories.SPLIT, ParamCathegories.SASH, ParamCathegories.FILL If Not IsNothing(m_SelArea) AndAlso Not m_SelArea.bApplied Then m_SelArea.ParentArea.AreaList.Remove(m_SelArea) End If End Select m_SelArea = Nothing NotifyPropertyChanged(NameOf(SelArea)) End Sub Friend Sub SelAreaFromSurf(nAreaId As Integer) For Each Frame In m_CurrWindow.AreaList Dim ResArea As Area = FindArea(Frame, nAreaId) If Not IsNothing(ResArea) Then m_SelArea = ResArea NotifyPropertyChanged(NameOf(SelArea)) Return End If Next End Sub Friend Sub SelSurfFromArea(Area As Area) Dim nSelectionLayerId As Integer = EgtGetFirstNameInGroup(Area.nAreaId, WIN_SELECTION) Dim nSelectionAreaId As Integer = EgtGetFirstInGroup(nSelectionLayerId) EgtDeselectAll() EgtSelectObj(nSelectionAreaId) EgtDraw() End Sub Private Function FindArea(ParentArea As Area, nAreaId As Integer) As Area If nAreaId = ParentArea.nAreaId Then Return ParentArea Else For Each ChildArea In ParentArea.AreaList Dim ResArea As Area = FindArea(ChildArea, nAreaId) If Not IsNothing(ResArea) Then Return ResArea Next End If Return Nothing End Function Private Sub FindArea2(ParentArea As Area, nAreaId As Integer, ResultList As List(Of Area)) If nAreaId = ParentArea.nAreaId Then ResultList.Add(ParentArea) End If For Each ChildArea In ParentArea.AreaList Dim ResArea As Area = FindArea(ChildArea, nAreaId) If Not IsNothing(ResArea) Then ResultList.Add(ResArea) Next End Sub Friend Function OnMouseSelectingObj(nId As Integer) As Boolean Dim nStatus As Integer EgtGetStatus(nId, nStatus) If nStatus = GDB_ST.OFF Then Return False Dim nLayerId As Integer = EgtGetParent(nId) If nLayerId = GDB_ID.NULL Then Return False Dim sLayerName As String = "" EgtGetName(nLayerId, sLayerName) If String.IsNullOrWhiteSpace(sLayerName) Then Return False Return sLayerName = WIN_SELECTION OrElse sLayerName = LUA_WIN_SPLITSELECTION End Function Friend Function FindAreaIdFromGeomId(nId As Integer) As Integer Dim nAreaId As Integer = EgtGetParent(EgtGetParent(nId)) Dim nAreaType As Integer = 0 If EgtGetInfo(nAreaId, WIN_AREATYPE, nAreaType) Then Return nAreaId Else Return GDB_ID.NULL End If End Function Private Function DrawWindow(Optional bDraw As Boolean = True) As Boolean If IsNothing(m_CurrWindow) OrElse String.IsNullOrWhiteSpace(m_CurrWindow.sProfilePath) OrElse m_CurrWindow.AreaList.Count = 0 Then Return False EgtNewFile() Dim gf = EgtLuaCreateGlobTable("WDG") ' importo profilo Dim hh = EgtLuaSetGlobStringVar("WDG.PROFILE", m_CurrWindow.sProfilePath) If Not EgtLuaCallFunction("WinCreate_ImportProfile") Then Return False ' creo aree For Each Area In m_CurrWindow.AreaList If Not Area.DrawArea(Area, GDB_ID.ROOT) Then Return False Next 'EgtSaveFile("c:\\Temp\\TestFinestreAnta.nge", NGE.CMPTEXT) ' imposto se calcolare i solidi o meno Dim kk = EgtLuaSetGlobBoolVar("WDG.VALUE", If(m_DShowMode = DShowModes.MODE2D, False, True)) Dim ke = EgtLuaCallFunction("WinCalculate_SetCalcSolid") Dim dk = EgtLuaSetGlobBoolVar("WDG.VALUE", If(m_DShowMode = DShowModes.MODESIMPLE3D, True, False)) Dim de = EgtLuaCallFunction("WinCalculate_SetSimplifiedSolid") ' creo i pezzi Dim kt = EgtLuaSetGlobIntVar("WDG.FRAMEID", m_CurrWindow.AreaList(0).nAreaId) Dim uu = EgtLuaCallFunction("WinCalculate_CreatePartFromArea") Dim krt = EgtLuaSetGlobIntVar("WDG.FRAMEID", m_CurrWindow.AreaList(0).nAreaId) Dim uru = EgtLuaCallFunction("WinCalculate_AddHardware") Dim kre = EgtLuaSetGlobIntVar("WDG.FRAMEID", m_CurrWindow.AreaList(0).nAreaId) Dim krv = EgtLuaSetGlobBoolVar("WDG.DRAW", True) Dim ure = EgtLuaCallFunction("WinCalculate_AddAccessories") Dim ud = EgtLuaResetGlobVar("WDG") ' recupero aree di selezione For Each Area In m_CurrWindow.AreaList Area.GetSelectionArea() Next EgtZoom(ZM.ALL, bDraw) Return True End Function Friend Function GetImage(FilePath As String) As Boolean Dim gg = EgtLuaExecFile(Map.refMainWindowVM.MainWindowM.sBaseDir & "\" & DESIGNING_DIR & "\WinProject.lua") Dim gf = EgtLuaCreateGlobTable("WDG") Dim kyv = EgtLuaSetGlobStringVar("WDG.FILE", FilePath) Dim uye = EgtLuaCallFunction("WinGetImage") Dim ud = EgtLuaResetGlobVar("WDG") Return True End Function Private Sub RefreshHardwareList() m_HardwareList.Clear() ' aggiungo campo vuoto m_HardwareList.Add(New Hardware("000000", "", "", "", 0, 0)) ' creo file di lettura tipi hardware per Agb Dim sNow As String = DateTime.Now.ToString("yyyy_MM_dd_HH_mm_ss") Dim sInputFile As String = "a:\InputBatch\Input" & sNow & ".txt" Dim sHardwareListPath As String = "C:\AGB3000NG\OutputBatch\OutputHardwareList" & sNow & ".txt" Dim sOutputFile = "a:\OutputBatch\OutputHardwareList" & sNow & ".txt" Dim sText As String = "OUTPUTKIT=" & sHardwareListPath & Environment.NewLine & "DATAREQUEST=SE" & Environment.NewLine & "RUN" If Not Directory.Exists(Path.GetDirectoryName(sInputFile)) Then EgtOutLog("Error! Path for Agb program not found!") MessageBox.Show("Path for Agb program not found!", "Error!", MessageBoxButton.OK, MessageBoxImage.Error) Return End If File.WriteAllText(sInputFile, sText) ' attendo scrittura output Dim nWait As Integer = 0 While Not File.Exists(sOutputFile) And nWait < 20 nWait = nWait + 1 Threading.Thread.Sleep(500) End While Threading.Thread.Sleep(500) Dim sInputFileOk As String = Path.ChangeExtension(sInputFile, ".ok") Dim sInputFileErr As String = Path.ChangeExtension(sInputFile, ".err") If File.Exists(sInputFileOk) Then If File.Exists(sOutputFile) Then Dim FileHardwareList() As String = File.ReadAllLines(sOutputFile) For Each HardwareLine In FileHardwareList Dim FileLineArgs() As String = HardwareLine.Split(";"c) If FileLineArgs.Count < 8 Then Continue For Dim nSashQty As Integer = 0 Dim nSashPosition As Integer = 0 Integer.TryParse(FileLineArgs(6), nSashQty) Integer.TryParse(FileLineArgs(7), nSashPosition) m_HardwareList.Add(New Hardware(FileLineArgs(2), FileLineArgs(3), FileLineArgs(4), FileLineArgs(5), nSashQty, nSashPosition)) Next Try File.Delete(sOutputFile) Catch ex As Exception End Try Else MessageBox.Show("File di risposta lista hardware non trovato!", "Errore!", MessageBoxButton.OK, MessageBoxImage.Error) End If Try File.Delete(sInputFileOk) Catch ex As Exception End Try ElseIf File.Exists(sInputFileErr) Then MessageBox.Show("Errore nella lettura della lista hardware! " & Environment.NewLine & File.ReadAllText(sInputFileErr), "Error!", MessageBoxButton.OK, MessageBoxImage.Error) Try File.Delete(sInputFileErr) Catch ex As Exception End Try Else MessageBox.Show("Errore nella lettura della lista hardware!", "Errore!", MessageBoxButton.OK, MessageBoxImage.Error) End If End Sub Private Sub RefreshSashHardware(CurrArea As Area) If CurrArea.AreaType = AreaTypes.SASH Then DirectCast(CurrArea, Sash).RefreshHardwareList() End If For Each Child In CurrArea.AreaList RefreshSashHardware(Child) Next End Sub #Region "COMMANDS" #Region "Read" Public ReadOnly Property Read_Command As ICommand Get If m_cmdRead Is Nothing Then m_cmdRead = New Command(AddressOf Read) End If Return m_cmdRead End Get End Property Public Sub Read(FilePath As String) Dim sReadedFile As String = File.ReadAllText(FilePath) Dim WindowFromJson As JsonWindow = JsonConvert.DeserializeObject(Of JsonWindow)(sReadedFile, New PolymorphicJsonConverter) m_CurrWindow = WindowFromJson.Deserialize() NotifyPropertyChanged(NameOf(CurrWindow)) Draw() End Sub #End Region ' Read #Region "Write" Public ReadOnly Property Write_Command As ICommand Get If m_cmdWrite Is Nothing Then m_cmdWrite = New Command(AddressOf Write) End If Return m_cmdWrite End Get End Property Public Sub Write(FilePath As String) Dim JsonFromWindow As String = JsonConvert.SerializeObject(m_CurrWindow.Serialize(), Formatting.Indented) File.WriteAllText(FilePath, JsonFromWindow) End Sub #End Region ' Write #Region "FillGlass" Public ReadOnly Property FillGlass_Command As ICommand Get If m_cmdFillGlass Is Nothing Then m_cmdFillGlass = New Command(AddressOf FillGlass) End If Return m_cmdFillGlass End Get End Property Public Sub FillGlass() If m_SelArea.AreaType = AreaTypes.FILL Then DirectCast(m_SelArea, Fill).SetFillType(FillTypes.GLASS) Else m_SelArea.AreaList.Add(Fill.CreateFill(m_SelArea, FillTypes.GLASS)) End If DrawWindow(False) ' mostro aree di selezione ManageSplitSelectionSurfaces(True, False) ' riseleziono superficie di selezione dell'area selezionata If Not IsNothing(m_SelArea) Then Dim nSelLayerId As Integer = EgtGetFirstNameInGroup(m_SelArea.nAreaId, WIN_SELECTION) Dim nSelId As Integer = EgtGetFirstInGroup(nSelLayerId) EgtSetAlpha(nSelId, 70) EgtSelectObj(nSelId) End If EgtDraw() End Sub #End Region ' FillGlass #Region "FillWood" Public ReadOnly Property FillWood_Command As ICommand Get If m_cmdFillWood Is Nothing Then m_cmdFillWood = New Command(AddressOf FillWood) End If Return m_cmdFillWood End Get End Property Public Sub FillWood() If m_SelArea.AreaType = AreaTypes.FILL Then DirectCast(m_SelArea, Fill).SetFillType(FillTypes.WOOD) Else m_SelArea.AreaList.Add(Fill.CreateFill(m_SelArea, FillTypes.WOOD)) End If DrawWindow(False) ' mostro aree di selezione ManageSplitSelectionSurfaces(True, False) ' riseleziono superficie di selezione dell'area selezionata If Not IsNothing(m_SelArea) Then Dim nSelLayerId As Integer = EgtGetFirstNameInGroup(m_SelArea.nAreaId, WIN_SELECTION) Dim nSelId As Integer = EgtGetFirstInGroup(nSelLayerId) EgtSetAlpha(nSelId, 70) EgtSelectObj(nSelId) End If EgtDraw() End Sub #End Region ' FillWood #Region "Draw" Public ReadOnly Property Draw_Command As ICommand Get If m_cmdDraw Is Nothing Then m_cmdDraw = New Command(AddressOf Draw) End If Return m_cmdDraw End Get End Property Public Sub Draw() DrawWindow() End Sub #End Region ' Draw #Region "ApplyFrame" Public ReadOnly Property ApplyFrame_Command As ICommand Get If m_cmdApplyFrame Is Nothing Then m_cmdApplyFrame = New Command(AddressOf ApplyFrame) End If Return m_cmdApplyFrame End Get End Property Public Sub ApplyFrame() ' deseleziono entita' selezionata Dim nDeselGeomId As Integer = GDB_ID.NULL If m_SelArea.bApplied Then nDeselGeomId = EgtGetFirstInGroup(m_SelArea.SelectionGeomId) Else nDeselGeomId = EgtGetFirstInGroup(m_SelArea.ParentArea.SelectionGeomId) End If Map.refSceneHostVM.DeselectGeometry(nDeselGeomId) ' lancio ricalcolo DrawWindow(False) '' mostro aree di selezione 'ManageSplitSelectionSurfaces(True, False) '' riseleziono nuova area selezionata 'If Not IsNothing(m_SelArea) Then ' Dim nSelGeomId As Integer = EgtGetFirstInGroup(m_SelArea.SelectionGeomId) ' Map.refSceneHostVM.SelectGeometry(nSelGeomId) 'End If ' cancello lista aree evidenziate Map.refSceneHostVM.ResetShownAreaList() EgtDraw() ' aggiorno lista hardware For Each Area In m_CurrWindow.AreaList RefreshSashHardware(Area) Next End Sub #End Region ' ApplyFrame #Region "ApplySplit" Public ReadOnly Property ApplySplit_Command As ICommand Get If m_cmdApplySplit Is Nothing Then m_cmdApplySplit = New Command(AddressOf ApplySplit) End If Return m_cmdApplySplit End Get End Property Public Sub ApplySplit() ' deseleziono entita' selezionata Dim nDeselGeomId As Integer = GDB_ID.NULL If m_SelArea.bApplied Then nDeselGeomId = EgtGetFirstInGroup(m_SelArea.SelectionGeomId) Else nDeselGeomId = EgtGetFirstInGroup(m_SelArea.ParentArea.SelectionGeomId) End If Map.refSceneHostVM.DeselectGeometry(nDeselGeomId) ' creo o rimuovo aree in base a quantita' Dim SplitArea As Split = DirectCast(m_SelArea, Split) For Splitindex = SplitArea.AreaList.Count To SplitArea.SplitPositionList.Count - 1 SplitArea.AreaList.Add(Splitted.CreateSplitted(SplitArea)) Next For Splitindex = SplitArea.SplitPositionList.Count To SplitArea.AreaList.Count - 1 SplitArea.AreaList.Remove(SplitArea.AreaList(SplitArea.AreaList.Count - 1)) Next ' se necessario, segno area come applicata If Not m_SelArea.bApplied Then m_SelArea.AppliedDone() End If ' lancio ricalcolo DrawWindow(False) ' mostro aree di selezione ManageSplitSelectionSurfaces(True, False) ' riseleziono nuova area selezionata If Not IsNothing(m_SelArea) Then Dim nSelGeomId As Integer = EgtGetFirstInGroup(m_SelArea.SelectionGeomId) Map.refSceneHostVM.SelectGeometry(nSelGeomId) End If ' cancello lista aree evidenziate Map.refSceneHostVM.ResetShownAreaList() EgtDraw() End Sub #End Region ' ApplySplit #Region "ApplySash" Public ReadOnly Property ApplySash_Command As ICommand Get If m_cmdApplySash Is Nothing Then m_cmdApplySash = New Command(AddressOf ApplySash) End If Return m_cmdApplySash End Get End Property Public Sub ApplySash() ' deseleziono entita' selezionata Dim nDeselGeomId As Integer = GDB_ID.NULL If m_SelArea.bApplied Then nDeselGeomId = EgtGetFirstInGroup(m_SelArea.SelectionGeomId) Else nDeselGeomId = EgtGetFirstInGroup(m_SelArea.ParentArea.SelectionGeomId) End If Map.refSceneHostVM.DeselectGeometry(nDeselGeomId) ' creo o rimuovo aree in base a quantita' Dim SashArea As Sash = DirectCast(m_SelArea, Sash) If SashArea.SashList.Count = 1 Then Dim ContentArea As New List(Of Area) While SashArea.AreaList.Count > 0 If SashArea.AreaList.Count = 1 AndAlso SashArea.AreaList(0).AreaList.Count > 0 Then For Each Area In SashArea.AreaList(0).AreaList ContentArea.Add(Area) Next End If SashArea.AreaList.Remove(SashArea.AreaList(SashArea.AreaList.Count - 1)) End While If ContentArea.Count > 0 Then SashArea.AreaList = ContentArea End If Else Dim ContentArea As New List(Of Area) ' se devo aggiungere aree e ho gia' del contenuto If SashArea.AreaList.Count = 1 AndAlso SashArea.SashList.Count > SashArea.AreaList.Count Then For Each Area In SashArea.AreaList ContentArea.Add(Area) Next SashArea.AreaList.Clear() End If For Splitindex = SashArea.AreaList.Count To SashArea.SashList.Count - 1 SashArea.AreaList.Add(Splitted.CreateSplitted(SashArea)) Next For Splitindex = SashArea.SashList.Count To SashArea.AreaList.Count - 1 SashArea.AreaList.Remove(SashArea.AreaList(SashArea.AreaList.Count - 1)) Next If ContentArea.Count > 0 Then SashArea.AreaList(0).AreaList = ContentArea End If End If ' se necessario, segno area come applicata If Not m_SelArea.bApplied Then m_SelArea.AppliedDone() End If ' lancio ricalcolo DrawWindow(False) ' mostro aree di selezione ManageSplitSelectionSurfaces(True, False) ' riseleziono nuova area selezionata If Not IsNothing(m_SelArea) Then Dim nSelGeomId As Integer = EgtGetFirstInGroup(m_SelArea.SelectionGeomId) Map.refSceneHostVM.SelectGeometry(nSelGeomId) End If ' cancello lista aree evidenziate Map.refSceneHostVM.ResetShownAreaList() EgtDraw() End Sub #End Region ' ApplySash #Region "ApplyFill" Public ReadOnly Property ApplyFill_Command As ICommand Get If m_cmdApplyFill Is Nothing Then m_cmdApplyFill = New Command(AddressOf ApplyFill) End If Return m_cmdApplyFill End Get End Property Public Sub ApplyFill() ' deseleziono entita' selezionata Dim nDeselGeomId As Integer = GDB_ID.NULL If m_SelArea.bApplied Then nDeselGeomId = EgtGetFirstInGroup(m_SelArea.SelectionGeomId) Else nDeselGeomId = EgtGetFirstInGroup(m_SelArea.ParentArea.SelectionGeomId) End If Map.refSceneHostVM.DeselectGeometry(nDeselGeomId) ' se necessario, segno area come applicata If Not m_SelArea.bApplied Then m_SelArea.AppliedDone() End If ' lancio ricalcolo DrawWindow(False) ' mostro aree di selezione ManageSplitSelectionSurfaces(True, False) ' riseleziono nuova area selezionata If Not IsNothing(m_SelArea) Then Dim nSelGeomId As Integer = EgtGetFirstInGroup(m_SelArea.SelectionGeomId) Map.refSceneHostVM.SelectGeometry(nSelGeomId) End If ' cancello lista aree evidenziate Map.refSceneHostVM.ResetShownAreaList() EgtDraw() End Sub #End Region ' ApplySash #Region "DeleteArea" Public ReadOnly Property DeleteArea_Command As ICommand Get If m_cmdDeleteArea Is Nothing Then m_cmdDeleteArea = New Command(AddressOf DeleteArea) End If Return m_cmdDeleteArea End Get End Property Public Sub DeleteArea() ' deseleziono entita' selezionata Dim nDeselGeomId As Integer = GDB_ID.NULL If m_SelArea.bApplied Then nDeselGeomId = EgtGetFirstInGroup(m_SelArea.SelectionGeomId) Else nDeselGeomId = EgtGetFirstInGroup(m_SelArea.ParentArea.SelectionGeomId) End If Map.refSceneHostVM.DeselectGeometry(nDeselGeomId) ' se e' split e ha area sotto lo splitted If m_SelArea.AreaType = AreaTypes.SPLIT AndAlso m_SelArea.bApplied AndAlso Not IsNothing(m_SelArea.AreaList(0)) AndAlso m_SelArea.AreaList(0).AreaList.Count > 0 AndAlso Not IsNothing(m_SelArea.AreaList(0).AreaList(0)) Then ' recupero posizione dello split Dim nSplitIndex As Integer = m_SelArea.ParentArea.AreaList.IndexOf(m_SelArea) ' porto area sotto in sostituzione dello split m_SelArea.ParentArea.AreaList(nSplitIndex) = m_SelArea.AreaList(0).AreaList(0) m_SelArea.AreaList(0).AreaList(0).SetParentArea(m_SelArea.ParentArea) Else m_SelArea.ParentArea.AreaList.Remove(m_SelArea) End If DeselAreaFromId() DrawWindow(False) ' mostro aree di selezione ManageSplitSelectionSurfaces(True, True) ' cancello lista aree evidenziate Map.refSceneHostVM.ResetShownAreaList() End Sub #End Region ' DeleteArea #End Region ' COMMANDS End Class Public Class FrameDimension Inherits VMBase ' Actions Friend Shared m_delDrawWindow As Action Private m_bIsLen As Boolean = False Private m_nIndex As Integer Public ReadOnly Property nIndex As Integer Get Return m_nIndex End Get End Property Private m_sName As String Public ReadOnly Property sName As String Get Return m_sName End Get End Property Private m_dValue As Double Public Property dValue As Double Get Return m_dValue End Get Set(value As Double) m_dValue = value 'm_delDrawWindow() End Set End Property Sub New(nIndex As Integer, sName As String, dValue As Double, bIsLen As Boolean) m_nIndex = nIndex m_sName = sName m_dValue = dValue m_bIsLen = bIsLen End Sub Friend Function Serialize() As JsonFrameDimension Dim JsonFrameDimension As JsonFrameDimension = New JsonFrameDimension(m_nIndex, m_sName, m_dValue) Return JsonFrameDimension End Function End Class Public Class SashDimension Inherits VMBase ' reference Private m_Parent As Sash ' Actions Friend Shared m_delDrawWindow As Action Private m_bIsRelative As Boolean = False Public ReadOnly Property bIsRelative As Boolean Get Return m_bIsRelative End Get End Property Private m_OpeningTypeList As New List(Of IdNameStruct)({New IdNameStruct(Openings.TURNONLY_LEFT, ">"), New IdNameStruct(Openings.TURNONLY_RIGHT, "<"), New IdNameStruct(Openings.TILTTURN_LEFT, ">*"), New IdNameStruct(Openings.TILTTURN_RIGHT, "<*"), New IdNameStruct(Openings.TILTONLY_TOP, "˄"), New IdNameStruct(Openings.TILTONLY_BOTTOM, "˅"), New IdNameStruct(Openings.PIVOT, "◊"), New IdNameStruct(Openings.FIXED, "X"), New IdNameStruct(Openings.COMPLANARSLIDE_LEFT, "-→"), New IdNameStruct(Openings.COMPLANARSLIDE_RIGHT, "←-"), New IdNameStruct(Openings.LIFTSLIDE_LEFT, "┌→"), New IdNameStruct(Openings.LIFTSLIDE_RIGHT, "←┐")}) Public ReadOnly Property OpeningTypeList As List(Of IdNameStruct) Get Return m_OpeningTypeList End Get End Property Private m_SelOpeningType As IdNameStruct Public Property SelOpeningType As IdNameStruct Get Return m_SelOpeningType End Get Set(value As IdNameStruct) m_SelOpeningType = value m_Parent.RefreshHardwareList() m_Parent.RefreshHardwareOptionList() m_Parent.SetFirstHardware() End Set End Property Public ReadOnly Property OpeningType As Openings Get Return m_SelOpeningType.Id End Get End Property Friend Sub SetOpeningType(value As Openings) m_SelOpeningType = m_OpeningTypeList.FirstOrDefault(Function(x) x.Id = value) NotifyPropertyChanged(NameOf(SelOpeningType)) End Sub Private m_bHasHandle As Boolean Public Property bHasHandle As Boolean Get Return m_bHasHandle End Get Set(value As Boolean) m_bHasHandle = value End Set End Property Friend Sub SetHasHandle(value As Boolean) m_bHasHandle = value NotifyPropertyChanged(NameOf(bHasHandle)) End Sub Private m_dDimension As Double Public Property dDimension As Double Get Return m_dDimension End Get Set(value As Double) ' se sono in percentuale If m_bIsRelative Then ' verifico se ci sono assoluti Dim RelativeDimList As List(Of SashDimension) = m_Parent.SashList.Where(Function(x) x.bIsRelative).ToList() If RelativeDimList.Count > 0 Then If m_Parent.bIsPercentage Then Dim nIndex As Integer = RelativeDimList.IndexOf(Me) If value < m_dDimension Then If nIndex < RelativeDimList.Count - 1 Then RelativeDimList(nIndex + 1).SetDimension(RelativeDimList(nIndex + 1).dDimension + (m_dDimension - value)) ElseIf RelativeDimList.Count > 1 Then RelativeDimList(nIndex - 1).SetDimension(RelativeDimList(nIndex - 1).dDimension + (m_dDimension - value)) Else m_dDimension = 100 Return End If Else Dim dRes As Double = value If nIndex < RelativeDimList.Count - 1 Then For nInd = 0 To nIndex - 1 dRes += RelativeDimList(nInd).dDimension Next dRes = (100 - dRes) / (RelativeDimList.Count - nIndex - 1) For Ind = nIndex + 1 To RelativeDimList.Count - 1 RelativeDimList(Ind).SetDimension(dRes) Next ElseIf RelativeDimList.Count > 1 Then For Ind = nIndex + 1 To RelativeDimList.Count - 1 dRes += RelativeDimList(Ind).dDimension Next dRes = (100 - dRes) / (nIndex - 1) For nInd = 0 To nIndex - 1 RelativeDimList(nInd).SetDimension(dRes) Next Else m_dDimension = 100 Return End If End If Else End If End If ' tolgo percentuale degli assoluti ' recupero prima percentuale successiva ' verifico se devo aggiungere o sottrarre ' ' se aggiungere, lo faccio ' ' se sottrarre, verifico se posso sottrarre quanto necessario ' se non basta, provo con successiva ' se nessuna basta, tolgo un po' da ciascuna End If m_dDimension = value End Set End Property Friend Sub SetDimension(dValue As Double) m_dDimension = dValue NotifyPropertyChanged(NameOf(dDimension)) End Sub Sub New(dDimension As Double, bIsRelative As Boolean, Parent As Sash) m_dDimension = dDimension m_bIsRelative = bIsRelative m_Parent = Parent ' assengno maniglia If Parent.SashList.Count = 0 OrElse Not Parent.SashList.Any(Function(x) x.bHasHandle) Then m_bHasHandle = True End If ' assegno tipo di anta If Parent.SashList.Count = 0 Then SetOpeningType(Openings.TILTTURN_LEFT) ElseIf Parent.SashList.Count = 1 Then Select Case Parent.SashList(0).OpeningType Case Openings.TURNONLY_LEFT SetOpeningType(Openings.TURNONLY_RIGHT) Case Openings.TURNONLY_RIGHT SetOpeningType(Openings.TURNONLY_LEFT) Case Openings.TILTTURN_LEFT SetOpeningType(Openings.TILTTURN_RIGHT) Case Openings.TILTTURN_RIGHT SetOpeningType(Openings.TILTTURN_LEFT) Case Openings.TILTONLY_TOP SetOpeningType(Openings.TILTONLY_BOTTOM) Case Openings.TILTONLY_BOTTOM SetOpeningType(Openings.TILTONLY_TOP) Case Openings.COMPLANARSLIDE_LEFT SetOpeningType(Openings.COMPLANARSLIDE_RIGHT) Case Openings.COMPLANARSLIDE_RIGHT SetOpeningType(Openings.COMPLANARSLIDE_LEFT) Case Openings.LIFTSLIDE_LEFT SetOpeningType(Openings.LIFTSLIDE_RIGHT) Case Openings.LIFTSLIDE_RIGHT SetOpeningType(Openings.LIFTSLIDE_LEFT) End Select Else SetOpeningType(Parent.SashList(Parent.SashList.Count - 1).OpeningType) End If End Sub Friend Function Serialize() As JsonSashDimension Dim JsonSashDimension As JsonSashDimension = New JsonSashDimension(OpeningType, m_bHasHandle, m_dDimension) Return JsonSashDimension End Function End Class Public Class SplitDimension Inherits VMBase ' reference Private m_Parent As Split 'Private ReadOnly Property DimensionList As ObservableCollection(Of SplitDimension) ' Get ' Return m_Parent.SplitPositionList ' End Get 'End Property Private m_bIsRelative As Boolean = False Public ReadOnly Property bIsRelative As Boolean Get Return m_bIsRelative End Get End Property Friend Sub SetIsRelative(value As Boolean) m_bIsRelative = value End Sub Private m_dDimension As Double Public Property dDimension As Double Get Return m_dDimension End Get Set(value As Double) ' se sono in percentuale If m_bIsRelative Then ' verifico se ci sono assoluti Dim RelativeDimList As List(Of SplitDimension) = m_Parent.SplitPositionList.Where(Function(x) x.bIsRelative).ToList() If RelativeDimList.Count > 0 Then If m_Parent.bIsPercentage Then Dim nIndex As Integer = RelativeDimList.IndexOf(Me) If value < m_dDimension Then If nIndex < RelativeDimList.Count - 1 Then RelativeDimList(nIndex + 1).SetDimension(RelativeDimList(nIndex + 1).dDimension + (m_dDimension - value)) ElseIf RelativeDimList.Count > 1 Then RelativeDimList(nIndex - 1).SetDimension(RelativeDimList(nIndex - 1).dDimension + (m_dDimension - value)) Else m_dDimension = 100 Return End If Else Dim dRes As Double = value If nIndex < RelativeDimList.Count - 1 Then For nInd = 0 To nIndex - 1 dRes += RelativeDimList(nInd).dDimension Next dRes = (100 - dRes) / (RelativeDimList.Count - nIndex - 1) For Ind = nIndex + 1 To RelativeDimList.Count - 1 RelativeDimList(Ind).SetDimension(dRes) Next ElseIf RelativeDimList.Count > 1 Then For Ind = nIndex + 1 To RelativeDimList.Count - 1 dRes += RelativeDimList(Ind).dDimension Next dRes = (100 - dRes) / (nIndex - 1) For nInd = 0 To nIndex - 1 RelativeDimList(nInd).SetDimension(dRes) Next Else m_dDimension = 100 Return End If End If Else End If End If ' tolgo percentuale degli assoluti ' recupero prima percentuale successiva ' verifico se devo aggiungere o sottrarre ' ' se aggiungere, lo faccio ' ' se sottrarre, verifico se posso sottrarre quanto necessario ' se non basta, provo con successiva ' se nessuna basta, tolgo un po' da ciascuna End If m_dDimension = value End Set End Property Friend Sub SetDimension(dValue As Double) m_dDimension = dValue NotifyPropertyChanged(NameOf(dDimension)) End Sub Sub New(dDimension As Double, bIsRelative As Boolean, Parent As Split) m_dDimension = dDimension m_bIsRelative = bIsRelative m_Parent = Parent End Sub Friend Function Serialize() As JsonSplitDimension Dim JsonSplitDimension As JsonSplitDimension = New JsonSplitDimension(m_bIsRelative, m_dDimension) Return JsonSplitDimension End Function End Class Public Class Window Inherits VMBase Private m_sProfilePath As String Public Property sProfilePath As String Get Return m_sProfilePath End Get Set(value As String) m_sProfilePath = value End Set End Property Private m_AreaList As New ObservableCollection(Of Frame) Public Property AreaList As ObservableCollection(Of Frame) Get Return m_AreaList End Get Set(value As ObservableCollection(Of Frame)) m_AreaList = value End Set End Property Friend Function Serialize() As JsonWindow Dim JsonWindow As New JsonWindow(m_sProfilePath) For Each Area In m_AreaList JsonWindow.AreaList.Add(Area.Serialize()) Next Return JsonWindow End Function End Class Public Class Area Inherits VMBase ' Actions Friend Shared m_delDrawWindow As Action Protected m_nAreaId As Integer = GDB_ID.NULL Public Property nAreaId As Integer Get Return m_nAreaId End Get Set(value As Integer) m_nAreaId = value End Set End Property Private m_AreaList As New List(Of Area) Public Property AreaList As List(Of Area) Get Return m_AreaList End Get Set(value As List(Of Area)) m_AreaList = value End Set End Property Private m_AreaType As AreaTypes Public Property AreaType As AreaTypes Get Return m_AreaType End Get Set(value As AreaTypes) m_AreaType = value m_delDrawWindow() End Set End Property Friend Sub SetAreaType(AreaType As AreaTypes) m_AreaType = AreaType End Sub Private m_ParentArea As Area Public ReadOnly Property ParentArea As Area Get Return m_ParentArea End Get End Property Friend Sub SetParentArea(ParentArea As Area) m_ParentArea = ParentArea End Sub Private m_SelectionGeomIds(30) As Integer Public ReadOnly Property SelectionGeomIds As Integer() Get Return m_SelectionGeomIds End Get End Property Public ReadOnly Property SelectionGeomId As Integer Get Return m_SelectionGeomIds(0) End Get End Property Friend Sub SetSelectionGeomId(nId As Integer) m_SelectionGeomIds(0) = nId End Sub Private m_bApplied As Boolean = False Public ReadOnly Property bApplied As Boolean Get Return m_bApplied End Get End Property Friend Sub AppliedDone() m_bApplied = True End Sub Sub New(ParentArea As Area) m_ParentArea = ParentArea End Sub Friend Shared Function CreateArea(ParentArea As Area) As Area Dim Area As New Area(ParentArea) Area.SetAreaType(AreaTypes.NULL) Return Area End Function Friend Overridable Function DrawArea(Area As Area, nAreaId As Integer) As Boolean Return True End Function Friend Overridable Function GetSelectionArea() As Boolean Return True End Function Friend Overridable Function Serialize() As JsonArea Return Nothing End Function Friend Sub ManageSelectionSurface(bShow As Boolean) Dim nStatus As Integer = 0 Select Case Map.refManageWindowVM.SelParamCathegory Case ParamCathegories.FRAME Select Case AreaType Case AreaTypes.FRAME nStatus = GDB_ST.OFF Case AreaTypes.SPLIT nStatus = GDB_ST.OFF Case AreaTypes.SPLITTED nStatus = GDB_ST.OFF Case AreaTypes.SASH nStatus = GDB_ST.OFF Case AreaTypes.FILL nStatus = GDB_ST.OFF End Select Case ParamCathegories.SPLIT Select Case AreaType Case AreaTypes.FRAME nStatus = If(m_AreaList.Count = 0, GDB_ST.ON_, GDB_ST.OFF) Case AreaTypes.SPLIT nStatus = GDB_ST.ON_ Case AreaTypes.SPLITTED nStatus = If(m_AreaList.Count = 0, GDB_ST.ON_, GDB_ST.OFF) Case AreaTypes.SASH nStatus = If(m_AreaList.Count = 0, GDB_ST.ON_, GDB_ST.OFF) Case AreaTypes.FILL nStatus = GDB_ST.OFF End Select Case ParamCathegories.SASH Select Case AreaType Case AreaTypes.FRAME nStatus = If(m_AreaList.Count = 0, GDB_ST.ON_, GDB_ST.OFF) Case AreaTypes.SPLIT nStatus = GDB_ST.OFF Case AreaTypes.SPLITTED nStatus = If((ParentArea.AreaType = AreaTypes.SASH AndAlso ParentArea.AreaList.Count > 1) OrElse (ParentArea.AreaType <> AreaTypes.SASH AndAlso m_AreaList.Count = 0), GDB_ST.ON_, GDB_ST.OFF) Case AreaTypes.SASH nStatus = GDB_ST.ON_ Case AreaTypes.FILL nStatus = GDB_ST.OFF End Select Case ParamCathegories.FILL Select Case AreaType Case AreaTypes.FRAME nStatus = If(m_AreaList.Count = 0, GDB_ST.ON_, GDB_ST.OFF) Case AreaTypes.SPLIT nStatus = GDB_ST.OFF Case AreaTypes.SPLITTED nStatus = If(m_AreaList.Count = 0, GDB_ST.ON_, GDB_ST.OFF) Case AreaTypes.SASH nStatus = If(m_AreaList.Count = 0, GDB_ST.ON_, GDB_ST.OFF) Case AreaTypes.FILL nStatus = GDB_ST.ON_ End Select End Select For Each SelGeomId In SelectionGeomIds If SelGeomId = 0 OrElse SelGeomId = GDB_ID.NULL Then Exit For EgtSetStatus(SelGeomId, nStatus) Next For Each Area In m_AreaList Area.ManageSelectionSurface(bShow) Next End Sub End Class Public Class Frame Inherits Area Private m_ShapeList As New ObservableCollection(Of IdNameStruct)({New IdNameStruct(Shapes.RECTANGLE, "Rectangle"), New IdNameStruct(Shapes.RIGHTCHAMFER, "Right Chamfer"), New IdNameStruct(Shapes.LEFTCHAMFER, "Left Chamfer"), New IdNameStruct(Shapes.DOUBLECHAMFER, "Double Chamfer"), New IdNameStruct(Shapes.ARC, "Arc"), New IdNameStruct(Shapes.ARC_FULL, "Arc Full"), New IdNameStruct(Shapes.DOUBLEARC, "Double Arc"), New IdNameStruct(Shapes.TRIANGLE, "Triangle")}) 'New IdNameStruct(Shapes.FILLET, "Fillet"), 'New IdNameStruct(Shapes.DOUBLEARC, "Double Arc"), 'New IdNameStruct(Shapes.CUSTOM, "Custom")}) Public ReadOnly Property ShapeList As ObservableCollection(Of IdNameStruct) Get Return m_ShapeList End Get End Property Private m_Shape As Shapes Public Property SelShapeIndex As Integer Get Return IdNameStruct.IndFromId(m_Shape, m_ShapeList) End Get Set(value As Integer) Dim SelShape = IdNameStruct.IdFromInd(value, m_ShapeList) ' verifico parametri Dimension m_DimensionList.Clear() Select Case SelShape Case Shapes.RECTANGLE, Shapes.ARC_FULL DimensionList.Add(New FrameDimension(1, "Width", 1500, True)) DimensionList.Add(New FrameDimension(2, "Height", 1800, True)) Case Shapes.RIGHTCHAMFER DimensionList.Add(New FrameDimension(1, "Width", 1500, True)) DimensionList.Add(New FrameDimension(2, "Left Height", 1800, True)) DimensionList.Add(New FrameDimension(3, "Right Height", 1500, True)) Case Shapes.LEFTCHAMFER DimensionList.Add(New FrameDimension(1, "Width", 1500, True)) DimensionList.Add(New FrameDimension(2, "Left Height", 1500, True)) DimensionList.Add(New FrameDimension(3, "Right Height", 1800, True)) Case Shapes.DOUBLECHAMFER, Shapes.ARC DimensionList.Add(New FrameDimension(1, "Width", 1500, True)) DimensionList.Add(New FrameDimension(2, "Height", 1500, True)) DimensionList.Add(New FrameDimension(3, "Full Height", 1800, True)) Case Shapes.DOUBLEARC DimensionList.Add(New FrameDimension(1, "Width", 1500, True)) DimensionList.Add(New FrameDimension(2, "Height", 1500, True)) DimensionList.Add(New FrameDimension(3, "Full Height", 2400, True)) Case Shapes.TRIANGLE DimensionList.Add(New FrameDimension(1, "Width", 2000, True)) DimensionList.Add(New FrameDimension(2, "Height", 1500, True)) DimensionList.Add(New FrameDimension(3, "Height projection", 0, True)) Case Shapes.CUSTOM DimensionList.Clear() End Select ' verifico parametri Joint m_JointList.Clear() Select Case SelShape Case Shapes.RECTANGLE, Shapes.RIGHTCHAMFER, Shapes.LEFTCHAMFER, Shapes.DOUBLECHAMFER, Shapes.ARC, Shapes.DOUBLEARC JointList.Add(New Joint(1, Joints.FULL_H)) JointList.Add(New Joint(2, Joints.FULL_H)) JointList.Add(New Joint(3, Joints.FULL_H)) JointList.Add(New Joint(4, Joints.FULL_H)) Case Shapes.ARC_FULL JointList.Add(New Joint(1, Joints.FULL_H)) JointList.Add(New Joint(2, Joints.FULL_H)) JointList.Add(New Joint(3, Joints.ANGLED)) JointList.Add(New Joint(4, Joints.ANGLED)) Case Shapes.TRIANGLE JointList.Add(New Joint(1, Joints.FULL_H)) JointList.Add(New Joint(2, Joints.FULL_H)) JointList.Add(New Joint(3, Joints.ANGLED)) Case Shapes.CUSTOM JointList.Clear() End Select m_Shape = SelShape End Set End Property Friend Sub SetSelShape(Value As Shapes) DimensionList.Clear() ' aggiungo Dimension Select Case Value Case Shapes.RECTANGLE, Shapes.ARC_FULL DimensionList.Add(New FrameDimension(1, "Width", 1500, True)) DimensionList.Add(New FrameDimension(2, "Height", 1800, True)) Case Shapes.RIGHTCHAMFER DimensionList.Add(New FrameDimension(1, "Width", 1500, True)) DimensionList.Add(New FrameDimension(2, "Left Height", 1800, True)) DimensionList.Add(New FrameDimension(3, "Right Height", 1500, True)) Case Shapes.LEFTCHAMFER DimensionList.Add(New FrameDimension(1, "Width", 1500, True)) DimensionList.Add(New FrameDimension(2, "Left Height", 1500, True)) DimensionList.Add(New FrameDimension(3, "Right Height", 1800, True)) Case Shapes.DOUBLECHAMFER, Shapes.ARC DimensionList.Add(New FrameDimension(1, "Width", 1500, True)) DimensionList.Add(New FrameDimension(2, "Height", 1500, True)) DimensionList.Add(New FrameDimension(3, "Full Height", 1800, True)) Case Shapes.DOUBLEARC DimensionList.Add(New FrameDimension(1, "Width", 1500, True)) DimensionList.Add(New FrameDimension(2, "Height", 1500, True)) DimensionList.Add(New FrameDimension(3, "Full Height", 2400, True)) Case Shapes.TRIANGLE DimensionList.Add(New FrameDimension(1, "Width", 2000, True)) DimensionList.Add(New FrameDimension(2, "Height", 1500, True)) DimensionList.Add(New FrameDimension(3, "Height projection", 0, True)) Case Shapes.CUSTOM DimensionList.Clear() End Select ' aggiungo Joint Dim nJointQty As Integer = 4 Select Case Value Case Shapes.RECTANGLE, Shapes.RIGHTCHAMFER, Shapes.LEFTCHAMFER, Shapes.DOUBLECHAMFER, Shapes.ARC, Shapes.DOUBLEARC JointList.Add(New Joint(1, Joints.FULL_H)) JointList.Add(New Joint(2, Joints.FULL_H)) JointList.Add(New Joint(3, Joints.FULL_H)) JointList.Add(New Joint(4, Joints.FULL_H)) Case Shapes.ARC_FULL JointList.Add(New Joint(1, Joints.FULL_H)) JointList.Add(New Joint(2, Joints.FULL_H)) JointList.Add(New Joint(3, Joints.ANGLED)) JointList.Add(New Joint(4, Joints.ANGLED)) Case Shapes.TRIANGLE JointList.Add(New Joint(1, Joints.FULL_H)) JointList.Add(New Joint(2, Joints.FULL_H)) JointList.Add(New Joint(3, Joints.ANGLED)) Case Shapes.CUSTOM JointList.Clear() End Select m_Shape = Value NotifyPropertyChanged(NameOf(SelShapeIndex)) End Sub Public ReadOnly Property Shape As Shapes Get Return m_Shape End Get End Property Private m_DimensionList As New ObservableCollection(Of FrameDimension) Public ReadOnly Property DimensionList As ObservableCollection(Of FrameDimension) Get Return m_DimensionList End Get End Property Private m_JointList As New ObservableCollection(Of Joint) Public Property JointList As ObservableCollection(Of Joint) Get Return m_JointList End Get Set(value As ObservableCollection(Of Joint)) m_JointList = value End Set End Property Private m_bBottomRail As Boolean Public Property BottomRail As Boolean Get Return m_bBottomRail End Get Set(value As Boolean) m_bBottomRail = value m_delDrawWindow() End Set End Property Friend Sub SetBottomRail(bBottomRail As Boolean) m_bBottomRail = bBottomRail End Sub Private m_nBottomRailQty As Integer = 0 Public Property BottomRailQty As Integer Get Return m_nBottomRailQty End Get Set(value As Integer) m_nBottomRailQty = value End Set End Property Friend Sub SetBottomRailQty(nBottomRailQty As Integer) m_nBottomRailQty = nBottomRailQty End Sub Private m_Outline As ObservableCollection(Of Curve) Public Property Outline As ObservableCollection(Of Curve) Get Return m_Outline End Get Set(value As ObservableCollection(Of Curve)) m_Outline = value End Set End Property Sub New(ParentArea As Area) MyBase.New(ParentArea) End Sub Friend Shared Function CreateFrame(Window As Window) As Area Dim NewFrame As New Frame(Nothing) NewFrame.SetAreaType(AreaTypes.FRAME) NewFrame.SetSelShape(Shapes.RECTANGLE) NewFrame.SetBottomRail(False) NewFrame.SetBottomRailQty(0) NewFrame.AppliedDone() Return NewFrame End Function Private Function ConvertShape(value As Shapes) As LuaShapes Select Case value Case Shapes.RECTANGLE Return LuaShapes.RECT Case Shapes.RIGHTCHAMFER Return LuaShapes.CHAMFER_SIDE Case Shapes.LEFTCHAMFER Return LuaShapes.CHAMFER_SIDE Case Shapes.DOUBLECHAMFER Return LuaShapes.CHAMFER Case Shapes.ARC Return LuaShapes.SEGMENTAL_ARC Case Shapes.ARC_FULL Return LuaShapes.ROUND_ARC 'Case Shapes.FILLET ' Return LuaShapes. Case Shapes.DOUBLEARC Return LuaShapes.POINTED_ARC Case Shapes.TRIANGLE Return LuaShapes.TRIANGLE ' Case Shapes.CUSTOM ' Return LuaShapes.RECT Case Else Return LuaShapes.RECT End Select End Function Friend Overrides Function DrawArea(Area As Area, nAreaId As Integer) As Boolean If IsNothing(Area) Then Return False ' verifico che esista area frame con forma e dimensioni corrette If IsNothing(m_Shape) OrElse IsNothing(m_DimensionList) OrElse ((m_Shape = Shapes.RECTANGLE OrElse m_Shape = Shapes.ARC_FULL) AndAlso m_DimensionList.Count <> 2) OrElse ((m_Shape = Shapes.RIGHTCHAMFER OrElse m_Shape = Shapes.LEFTCHAMFER OrElse m_Shape = Shapes.DOUBLECHAMFER OrElse m_Shape = Shapes.ARC OrElse m_Shape = Shapes.FILLET OrElse m_Shape = Shapes.DOUBLEARC) AndAlso m_DimensionList.Count <> 3) OrElse IsNothing(m_JointList) OrElse m_JointList.Count < 3 Then Return False End If Dim tf = EgtLuaSetGlobNumVar("WDG.FRAMETYPE", ConvertShape(m_Shape)) Dim tu = EgtLuaSetGlobNumVar("WDG.WIDTH", m_DimensionList(0).dValue) Dim tt = EgtLuaSetGlobNumVar("WDG.HEIGHT", m_DimensionList(1).dValue) If m_DimensionList.Count > 2 Then Dim tr = EgtLuaSetGlobNumVar("WDG.HEIGHT2", m_DimensionList(2).dValue) End If For nJointIndex = 0 To m_JointList.Count - 1 Dim tg = EgtLuaSetGlobIntVar("WDG.JOINT" & nJointIndex + 1, m_JointList(nJointIndex).SelJointType) Next Dim tlt = EgtLuaCallFunction("WinCreate_CreateFrame") EgtLuaGetGlobIntVar("WDG.AREAID", m_nAreaId) nAreaId = m_nAreaId If m_nAreaId = GDB_ID.NULL Then Return False ' aggiungo BottomRail se necessario If m_bBottomRail Then EgtLuaSetGlobIntVar("WDG.NBR", m_nBottomRailQty) Dim tdlt = EgtLuaCallFunction("WinCreate_AddBottomRail") End If ' lancio disegno delle sotto aree For Each Area In AreaList If Not Area.DrawArea(Area, nAreaId) Then Return False Next Return True End Function Friend Overrides Function GetSelectionArea() As Boolean Dim nSelLayerId As Integer = EgtGetFirstNameInGroup(m_nAreaId, WIN_SELECTION) If nSelLayerId <> GDB_ID.NULL Then SetSelectionGeomId(nSelLayerId) End If ' lancio recupero area di selezione delle sotto aree For Each Area In AreaList If Not Area.GetSelectionArea() Then Return False Next Return True End Function Friend Overrides Function Serialize() As JsonArea Dim JsonFrame As JsonFrame = New JsonFrame(m_Shape, m_bBottomRail, m_nBottomRailQty) For Each Dimension In DimensionList JsonFrame.DimensionList.Add(Dimension.Serialize()) Next For Each Joint In JointList JsonFrame.JointList.Add(Joint.Serialize()) Next For Each Area In AreaList JsonFrame.AreaList.Add(Area.Serialize()) Next Return JsonFrame End Function End Class Public Class Sash Inherits Area 'Private m_nSashQty As Integer Public Property nSashQty As Integer Get Return If(m_SashList.Count > 0, m_SashList.Count, 1) 'Return m_nSashQty End Get Set(value As Integer) If value > m_SashList.Count Then ' recupero larghezza ultimo Dim dLastDimension As Double = 100 Dim dNewDimension As Double = 100 If m_SashList.Count > 0 Then dLastDimension = m_SashList(m_SashList.Count - 1).dDimension dNewDimension = dLastDimension / (value + 1 - nSashQty) m_SashList(m_SashList.Count - 1).SetDimension(dNewDimension) Else dNewDimension = dLastDimension / (value + 1 - nSashQty) End If ' aggiungo area Sash di default For SplitIndex = m_SashList.Count To value - 1 SashList.Add(New SashDimension(dNewDimension, True, Me)) Next ElseIf value < m_SashList.Count Then Dim dLastDimension As Double = 0 For SplitIndex = m_SashList.Count - 1 To value Step -1 dLastDimension += m_SashList(SplitIndex).dDimension SashList.RemoveAt(SplitIndex) Next dLastDimension += m_SashList(SashList.Count - 1).dDimension SashList(SashList.Count - 1).SetDimension(dLastDimension) End If RefreshHardwareList() RefreshHardwareOptionList() SetFirstHardware() End Set End Property Friend Sub SetSashQty(Qty As Integer, Optional NotifyProperty As Boolean = False) If Qty > m_SashList.Count Then ' recupero larghezza ultimo Dim dLastDimension As Double = 100 Dim dNewDimension As Double = 100 If m_SashList.Count > 0 Then dLastDimension = m_SashList(m_SashList.Count - 1).dDimension dNewDimension = dLastDimension / (Qty + 1 - nSashQty) m_SashList(m_SashList.Count - 1).dDimension = dNewDimension Else dNewDimension = dLastDimension / (Qty + 1 - nSashQty) End If ' aggiungo area Sash di default For SplitIndex = m_SashList.Count To Qty - 1 SashList.Add(New SashDimension(dNewDimension, True, Me)) Next ElseIf Qty < m_SashList.Count Then For SplitIndex = m_SashList.Count - 1 To Qty Step -1 SashList.RemoveAt(SplitIndex) Next End If If NotifyProperty Then NotifyPropertyChanged(NameOf(nSashQty)) End If End Sub Private m_bIsSashVertical As Boolean Public Property bIsSashVertical As Boolean Get Return m_bIsSashVertical End Get Set(value As Boolean) m_bIsSashVertical = value End Set End Property Friend Sub SetIsSashVertical(IsSashVertical As Boolean, Optional NotifyProperty As Boolean = False) m_bIsSashVertical = IsSashVertical If NotifyProperty Then NotifyPropertyChanged(NameOf(bIsSashVertical)) End If End Sub Private m_bIsMeasureGlass As Boolean Public Property bIsMeasureGlass As Boolean Get Return m_bIsMeasureGlass End Get Set(value As Boolean) m_bIsMeasureGlass = value End Set End Property Friend Sub SetIsMeasureGlass(IsMeasureGlass As Boolean, Optional NotifyProperty As Boolean = False) m_bIsMeasureGlass = IsMeasureGlass If NotifyProperty Then NotifyPropertyChanged(NameOf(bIsMeasureGlass)) End If End Sub Private m_SashList As New ObservableCollection(Of SashDimension) Public Property SashList As ObservableCollection(Of SashDimension) Get Return m_SashList End Get Set(value As ObservableCollection(Of SashDimension)) m_SashList = value End Set End Property Private m_SashType As SashTypes Public Property SashType As SashTypes Get Return m_SashType End Get Set(value As SashTypes) m_SashType = value End Set End Property Friend Sub SetSashType(SashType As SashTypes) m_SashType = SashType End Sub Private m_JointList As New ObservableCollection(Of Joint) Public Property JointList As ObservableCollection(Of Joint) Get Return m_JointList End Get Set(value As ObservableCollection(Of Joint)) m_JointList = value End Set End Property Private m_bBottomRail As Boolean Public Property BottomRail As Boolean Get Return m_bBottomRail End Get Set(value As Boolean) m_bBottomRail = value End Set End Property Friend Sub SetBottomRail(bBottomRail As Boolean) m_bBottomRail = bBottomRail End Sub Private m_nBottomRailQty As Integer = 0 Public Property BottomRailQty As Integer Get Return m_nBottomRailQty End Get Set(value As Integer) m_nBottomRailQty = value End Set End Property Friend Sub SetBottomRailQty(nBottomRailQty As Integer) m_nBottomRailQty = nBottomRailQty End Sub Private m_bIsPercentage As Boolean = True Public ReadOnly Property bIsPercentage As Boolean Get Return m_bIsPercentage End Get End Property Private m_HardwareList As New ObservableCollection(Of Hardware) Public ReadOnly Property HardwareList As ObservableCollection(Of Hardware) Get Return m_HardwareList End Get End Property Private m_SelHardware As Hardware Public Property SelHardware As Hardware Get Return m_SelHardware End Get Set(value As Hardware) m_SelHardware = value If Not IsNothing(m_SelHardware) AndAlso m_SelHardware.sId <> "000000" Then Dim sHwdOptPath As String = "" Dim gf = EgtLuaCreateGlobTable("WDG") Dim tft = EgtLuaSetGlobIntVar("WDG.AREAID", m_nAreaId) Dim tfy = EgtLuaSetGlobStringVar("WDG.HDWFAVOURITE", value.sId) Dim HandleSash As SashDimension = m_SashList.FirstOrDefault(Function(x) x.bHasHandle) Dim sHandle As String = "Dx" Select Case GetOpeningSide(HandleSash.OpeningType) Case OpeningSides.LEFT sHandle = "Sx" Case OpeningSides.RIGHT sHandle = "Dx" End Select Dim tfd = EgtLuaSetGlobStringVar("WDG.HDWHANDLE", sHandle) Dim tlt = EgtLuaCallFunction("WinCreate_GetHardwareOptionPath") Dim tltf = EgtLuaGetGlobStringVar("WDG.HWDOPTPATH", sHwdOptPath) If Not String.IsNullOrWhiteSpace(sHwdOptPath) Then Dim serializer As New XmlSerializer(GetType(ParametriOpzioni)) Dim HwdOptions As ParametriOpzioni = Nothing Dim sHdwOptPath As String = Path.ChangeExtension(sHwdOptPath, ".opt") Dim bHdwOptFound As Boolean = False For WaitIndex = 0 To 100 If File.Exists(sHdwOptPath) Then bHdwOptFound = True Exit For End If Threading.Thread.Sleep(100) Next If bHdwOptFound Then Dim sHwdOptText As String = "" Try sHwdOptText = File.ReadAllText(sHdwOptPath) Catch ex As Exception EgtOutLog("Hardware file opt not found or read!") End Try If Not String.IsNullOrWhiteSpace(sHwdOptText) Then Using reader As TextReader = New StringReader(sHwdOptText) HwdOptions = serializer.Deserialize(reader) End Using If Not IsNothing(HwdOptions) Then m_HwdOptionList.Clear() For Each HdwOption In HwdOptions.Items m_HwdOptionList.Add(New AGBOption(HdwOption)) Next NotifyPropertyChanged(NameOf(HwdOptionList)) End If End If End If Dim ud = EgtLuaResetGlobVar("WDG") End If End If End Set End Property Friend Sub SetSelHardware(value As Hardware) m_SelHardware = value NotifyPropertyChanged(NameOf(SelHardware)) End Sub Friend Sub SetSelHardwareFromId(sId As String) m_SelHardware = m_HardwareList.FirstOrDefault(Function(x) x.sId = sId) If IsNothing(m_SelHardware) Then m_SelHardware = m_HardwareList(0) End If NotifyPropertyChanged(NameOf(SelHardware)) End Sub Friend Sub SetFirstHardware() If m_HardwareList.Count > 0 Then m_SelHardware = m_HardwareList(0) NotifyPropertyChanged(NameOf(SelHardware)) End If End Sub Private m_HwdOptionList As New ObservableCollection(Of AGBOption) Public ReadOnly Property HwdOptionList As ObservableCollection(Of AGBOption) Get Return m_HwdOptionList End Get End Property Sub New(ParentArea As Area) MyBase.New(ParentArea) End Sub Friend Shared Function CreateSash(Area As Area) As Sash Dim NewSash As Sash = New Sash(Area) NewSash.SetAreaType(AreaTypes.SASH) NewSash.SetSashQty(1) NewSash.SetIsSashVertical(True) ' recupero numero di lati dell'area contenitore Dim nOutlineLayerId As Integer = EgtGetFirstNameInGroup(Area.nAreaId, WIN_OUTLINE) Dim nJointQty As Integer = EgtGetGroupObjs(nOutlineLayerId) For JointIndex = 0 To nJointQty - 1 NewSash.JointList.Add(New Joint(JointIndex + 1, Joints.FULL_H)) Next NewSash.SetBottomRail(False) NewSash.SetBottomRailQty(0) NewSash.RefreshHardwareList() NewSash.RefreshHardwareOptionList() NewSash.SetFirstHardware() Return NewSash End Function Private Function FindSashShape() As String ' Return "R" ' se non ancora creato, recupero area precedente Dim nAreaId As Integer = m_nAreaId If m_nAreaId = GDB_ID.NULL Then nAreaId = ParentArea.nAreaId End If Dim nOutlineLayerId As Integer = EgtGetFirstNameInGroup(nAreaId, WIN_OUTLINE) Dim OutlineIdList As New List(Of Integer) Dim nOutlineId As Integer = EgtGetFirstInGroup(nOutlineLayerId) While nOutlineId <> GDB_ID.NULL OutlineIdList.Add(nOutlineId) nOutlineId = EgtGetNext(nOutlineId) End While Dim nTempLayerId As Integer = EgtCreateGroup(nAreaId) Dim nCompoOutlineId As Integer = EgtCreateCurveCompo(nTempLayerId, OutlineIdList.ToArray(), False) Dim ptP As Point3d Dim vtL1 As Vector3d Dim vtL2 As Vector3d Dim vtB1 As Vector3d Dim vtB2 As Vector3d Dim vtN As Vector3d Dim dRad As Double Dim bCCW As Boolean If EgtCurveIsARectangle(nCompoOutlineId, 0.001, ptP, vtL1, vtL2) Then Return "R" ElseIf EgtCurveIsACircle(nCompoOutlineId, ptP, vtN, dRad, bCCW) Then Return "C" ElseIf EgtCurveIsATrapezoid(nCompoOutlineId, ptP, vtB1, vtL1, vtB2) Then Return "T" Else For nOutlineIndex = 0 To OutlineIdList.Count - 1 If EgtGetType(OutlineIdList(nOutlineIndex)) = GDB_TY.CRV_ARC Then Dim vtStart As Vector3d EgtStartVector(OutlineIdList(nOutlineIndex), GDB_ID.ROOT, vtStart) Dim vtEnd As Vector3d EgtEndVector(OutlineIdList(nOutlineIndex), GDB_ID.ROOT, vtEnd) Dim nPrevOutlineId As Integer = If(nOutlineId > 0, OutlineIdList(nOutlineIndex - 1), OutlineIdList(OutlineIdList.Count - 1)) Dim dPrevLen As Integer EgtCurveLength(nPrevOutlineId, dPrevLen) Dim vtPrev As Vector3d EgtStartVector(nPrevOutlineId, vtPrev) Dim nNextOutlineId As Integer = If(nOutlineId < OutlineIdList.Count - 1, OutlineIdList(nOutlineIndex + 1), OutlineIdList(0)) Dim dNextLen As Integer EgtCurveLength(nNextOutlineId, dNextLen) Dim vtNext As Vector3d EgtEndVector(nNextOutlineId, vtNext) If Math.Abs(dPrevLen - dNextLen) < 10 * EPS_SMALL Then If AreSameVectorApprox(vtEnd, vtNext) Then Return "AS" Else Return "AR" End If Else If AreSameVectorApprox(vtEnd, vtNext) Then Return "SS" Else Return "SR" End If End If End If Next End If Return "R" End Function Friend Function GetOpeningType(OpeningType As Openings) As OpeningTypes Select Case OpeningType Case Openings.TURNONLY_LEFT, Openings.TURNONLY_RIGHT Return OpeningTypes.TURNONLY Case Openings.TILTTURN_LEFT, Openings.TILTTURN_RIGHT Return OpeningTypes.TILTTURN Case Openings.TILTONLY_TOP, Openings.TILTONLY_BOTTOM Return OpeningTypes.TILTONLY Case Openings.PIVOT Return OpeningTypes.PIVOT Case Openings.FIXED Return OpeningTypes.FIXED Case Openings.COMPLANARSLIDE_LEFT, Openings.COMPLANARSLIDE_RIGHT Return OpeningTypes.COMPLANARSLIDE Case Openings.LIFTSLIDE_LEFT, Openings.LIFTSLIDE_RIGHT Return OpeningTypes.LIFTSLIDE Case Else Return OpeningTypes.NULL End Select End Function Private Function ConvertOpeningType() If m_SashList.Any(Function(x) GetOpeningType(x.OpeningType) = OpeningTypes.TILTTURN) Then Return "AR" Else Select Case GetOpeningType(m_SashList(0).OpeningType) Case OpeningTypes.TURNONLY Return "AB" Case OpeningTypes.TILTONLY Return "VA" Case OpeningTypes.PIVOT Return "BI" Case OpeningTypes.COMPLANARSLIDE Return "CO" Case OpeningTypes.LIFTSLIDE Return "AS" Case Else Return "" End Select End If End Function Friend Sub RefreshHardwareList() m_HardwareList.Clear() Dim sSashShape As String = FindSashShape() Dim sOpeningType As String = ConvertOpeningType() m_HardwareList = New ObservableCollection(Of Hardware)(From Hardware In Map.refManageWindowVM.HardwareList Where Hardware.sId = "000000" OrElse (Hardware.nSashQty = nSashQty AndAlso Hardware.sShape = sSashShape AndAlso Hardware.sOpeningType = sOpeningType)) NotifyPropertyChanged(NameOf(HardwareList)) End Sub Friend Sub RefreshHardwareOptionList() m_HwdOptionList.Clear() NotifyPropertyChanged(NameOf(HwdOptionList)) End Sub Friend Function GetOpeningSide(OpeningType As Openings) As OpeningSides Select Case OpeningType Case Openings.TURNONLY_LEFT, Openings.TILTTURN_LEFT, Openings.TILTONLY_TOP, Openings.COMPLANARSLIDE_LEFT, Openings.LIFTSLIDE_LEFT Return OpeningSides.LEFT Case Openings.TURNONLY_RIGHT, Openings.TILTTURN_RIGHT, Openings.TILTONLY_BOTTOM, Openings.COMPLANARSLIDE_RIGHT, Openings.LIFTSLIDE_RIGHT Return OpeningSides.RIGHT Case Else Return OpeningSides.NULL End Select End Function Friend Overrides Function DrawArea(Area As Area, nAreaId As Integer) As Boolean ' verifico se applicata If Not bApplied Then Return True ' verifico che esista area sash con info corrette If IsNothing(m_JointList) OrElse m_JointList.Count < 3 OrElse IsNothing(m_SashType) Then Return False End If ' se un'anta If nSashQty = 1 Then ' creo anta Dim tf = EgtLuaSetGlobIntVar("WDG.AREAID", nAreaId) For nJointIndex = 0 To m_JointList.Count - 1 Dim tg = EgtLuaSetGlobIntVar("WDG.JOINT" & nJointIndex + 1, m_JointList(nJointIndex).SelJointType) Next 'Dim tg = EgtLuaSetGlobIntVar("WDG.JOINTBL", m_JointList(0).SelJointType) 'Dim th = EgtLuaSetGlobIntVar("WDG.JOINTBR", m_JointList(1).SelJointType) 'Dim tj = EgtLuaSetGlobIntVar("WDG.JOINTTR", m_JointList(2).SelJointType) 'Dim tkt = EgtLuaSetGlobIntVar("WDG.JOINTTL", m_JointList(3).SelJointType) Dim tft = EgtLuaSetGlobIntVar("WDG.SASHTYPE", m_SashType) Dim tfr = EgtLuaSetGlobIntVar("WDG.OPENINGTYPE", m_SashList(0).SelOpeningType.Id) Dim tlt = EgtLuaCallFunction("WinCreate_AddSash") Dim tltf = EgtLuaGetGlobIntVar("WDG.AREAID", m_nAreaId) nAreaId = m_nAreaId If m_nAreaId = GDB_ID.NULL Then Return False ' aggiungo BottomRail se necessario If m_bBottomRail Then EgtLuaSetGlobIntVar("WDG.NBR", m_nBottomRailQty) Dim tdlt = EgtLuaCallFunction("WinCreate_AddBottomRail") End If Else ' se piu' di un'anta ' creo split EgtLuaSetGlobIntVar("WDG.AREAID", nAreaId) EgtLuaSetGlobIntVar("WDG.SPLITORIENTATION", If(m_bIsSashVertical, SplitShapes.VERTICAL, SplitShapes.HORIZONTAL)) EgtLuaSetGlobIntVar("WDG.SPLITTYPE", LuaSplitTypes.FRENCH) EgtLuaSetGlobIntVar("WDG.MEASURETYPE", 3) For PositionIndex = 0 To SashList.Count - 2 EgtLuaSetGlobNumVar("WDG.POSITION" & PositionIndex + 1, If(m_SashList(PositionIndex).bIsRelative, SashList(PositionIndex).dDimension / 100, SashList(PositionIndex).dDimension)) Next EgtLuaSetGlobNumVar("WDG.PROPORTION", SashList.Sum(Function(x) x.dDimension / 100)) EgtLuaCallFunction("WinCreate_AddSplits") Dim AreaIndex As Integer = 1 Dim NewAreaId As Integer = GDB_ID.NULL While EgtLuaGetGlobIntVar("WDG.AREAID" & AreaIndex, NewAreaId) If NewAreaId <> GDB_ID.NULL Then Area.AreaList(AreaIndex - 1).nAreaId = NewAreaId AreaIndex += 1 Else Exit While End If End While EgtLuaGetGlobIntVar("WDG.AREAID", Area.nAreaId) ' calcolo OpeningSide e OpeningType Dim nHandleIndex As Integer = SashList.IndexOf(SashList.FirstOrDefault(Function(x) x.bHasHandle)) Dim SashTypeList(m_SashList.Count - 1) As SashTypes Dim FinalSashTypeList(m_SashList.Count - 1) As SashTypes For nSashIndex = 0 To m_SashList.Count - 1 ' se active If GetOpeningSide(m_SashList(nSashIndex).OpeningType) = GetOpeningSide(m_SashList(nHandleIndex).OpeningType) Then SashTypeList(nSashIndex) = SashTypes.ACTIVE Else ' altrimenti inactive SashTypeList(nSashIndex) = SashTypes.INACTIVE End If Next For nSashIndex = 0 To m_SashList.Count - 1 If nSashIndex = 0 Then If SashTypeList(nSashIndex) = SashTypeList(nSashIndex + 1) Then If SashTypeList(nSashIndex) = SashTypes.ACTIVE Then FinalSashTypeList(nSashIndex) = SashTypes.ACTIVE_OUT Else FinalSashTypeList(nSashIndex) = SashTypes.INACTIVE_OUT End If Else ' rimane come e' FinalSashTypeList(nSashIndex) = SashTypeList(nSashIndex) End If ElseIf nSashIndex = m_SashList.Count - 1 Then If SashTypeList(nSashIndex) = SashTypeList(nSashIndex - 1) Then If SashTypeList(nSashIndex) = SashTypes.ACTIVE Then FinalSashTypeList(nSashIndex) = SashTypes.ACTIVE_OUT Else FinalSashTypeList(nSashIndex) = SashTypes.INACTIVE_OUT End If Else ' rimane come e' FinalSashTypeList(nSashIndex) = SashTypeList(nSashIndex) End If Else If SashTypeList(nSashIndex) = SashTypeList(nSashIndex + 1) OrElse SashTypeList(nSashIndex) = SashTypeList(nSashIndex - 1) Then If SashTypeList(nSashIndex) = SashTypes.ACTIVE Then FinalSashTypeList(nSashIndex) = SashTypes.ACTIVE_IN Else FinalSashTypeList(nSashIndex) = SashTypes.INACTIVE_IN End If Else ' rimane come e' FinalSashTypeList(nSashIndex) = SashTypeList(nSashIndex) End If End If Next ' creo ante For nSashIndex = 0 To m_SashList.Count - 1 Dim tf = EgtLuaSetGlobIntVar("WDG.AREAID", Area.AreaList(nSashIndex).nAreaId) For nJointIndex = 0 To m_JointList.Count - 1 Dim tg = EgtLuaSetGlobIntVar("WDG.JOINT" & nJointIndex + 1, m_JointList(nJointIndex).SelJointType) Next 'Dim tg = EgtLuaSetGlobIntVar("WDG.JOINTBL", m_JointList(0).SelJointType) 'Dim th = EgtLuaSetGlobIntVar("WDG.JOINTBR", m_JointList(1).SelJointType) 'Dim tj = EgtLuaSetGlobIntVar("WDG.JOINTTR", m_JointList(2).SelJointType) 'Dim tkt = EgtLuaSetGlobIntVar("WDG.JOINTTL", m_JointList(3).SelJointType) Dim tft = EgtLuaSetGlobIntVar("WDG.SASHTYPE", FinalSashTypeList(nSashIndex)) Dim tfr = EgtLuaSetGlobIntVar("WDG.OPENINGTYPE", m_SashList(nSashIndex).SelOpeningType.Id) Dim tlt = EgtLuaCallFunction("WinCreate_AddSash") Dim nNewAreaId As Integer = GDB_ID.NULL Dim tltf = EgtLuaGetGlobIntVar("WDG.AREAID", nNewAreaId) Area.AreaList(nSashIndex).nAreaId = nNewAreaId If nNewAreaId = GDB_ID.NULL Then Return False ' aggiungo BottomRail se necessario If m_bBottomRail Then EgtLuaSetGlobIntVar("WDG.NBR", m_nBottomRailQty) Dim tdlt = EgtLuaCallFunction("WinCreate_AddBottomRail") End If Next End If ' aggiungo ferramenta If Not IsNothing(m_SelHardware) Then EgtSetInfo(m_nAreaId, LUA_WIN_HDW_FAVOURITE, m_SelHardware.sId) Dim HandleSash As SashDimension = m_SashList.FirstOrDefault(Function(x) x.bHasHandle) Dim sHandle As String = "Dx" Select Case GetOpeningSide(HandleSash.OpeningType) Case OpeningSides.LEFT sHandle = "Sx" Case OpeningSides.RIGHT sHandle = "Dx" End Select EgtSetInfo(m_nAreaId, LUA_WIN_HDW_HANDLE, sHandle) Dim sOptions As String = "" For OptionIndex = 0 To m_HwdOptionList.Count - 1 Dim HdwOption = m_HwdOptionList(OptionIndex) sOptions &= HdwOption.sName & "=" & HdwOption.sValue.sValue & If(OptionIndex < m_HwdOptionList.Count - 1, ",", "") Next EgtSetInfo(m_nAreaId, LUA_WIN_HDW_OPTIONS, sOptions) End If ' lancio disegno delle sotto aree For Each Area In AreaList If Not Area.DrawArea(Area, nAreaId) Then Return False Next Return True End Function Friend Overrides Function GetSelectionArea() As Boolean If nSashQty = 1 Then Dim nSelLayerId As Integer = EgtGetFirstNameInGroup(m_nAreaId, WIN_SELECTION) If nSelLayerId <> GDB_ID.NULL Then SetSelectionGeomId(nSelLayerId) End If Else If nSashQty > 1 Then Dim nSplitIndex = 0 Dim nArea1Id As Integer = GDB_ID.NULL Dim nArea2Id As Integer = GDB_ID.NULL Dim nSplitAreaId As Integer = m_nAreaId While nSplitIndex < nSashQty - 1 nArea1Id = EgtGetFirstNameInGroup(nSplitAreaId, WIN_AREA & 1) nArea2Id = EgtGetFirstNameInGroup(nSplitAreaId, WIN_AREA & 2) Dim nSashId As Integer = EgtGetFirstNameInGroup(nArea1Id, WIN_AREA & "*") Dim nSashSelId As Integer = EgtGetFirstNameInGroup(nSashId, WIN_SELECTION) SelectionGeomIds(nSplitIndex) = nSashSelId nSplitAreaId = nArea2Id nSplitIndex += 1 End While nArea2Id = EgtGetFirstNameInGroup(EgtGetParent(nArea1Id), WIN_AREA & 2) Dim nSash2Id As Integer = EgtGetFirstNameInGroup(nArea2Id, WIN_AREA & "*") Dim nSash2SelId As Integer = EgtGetFirstNameInGroup(nSash2Id, WIN_SELECTION) SelectionGeomIds(nSplitIndex) = nSash2SelId End If End If ' lancio recupero area di selezione delle sotto aree For Each Area In AreaList If Not Area.GetSelectionArea() Then Return False Next Return True End Function Friend Overrides Function Serialize() As JsonArea Dim JsonSash As JsonSash = New JsonSash(m_bIsSashVertical, m_SashType, m_bBottomRail, m_nBottomRailQty, m_SelHardware.sId) For Each SashDimension In SashList JsonSash.SashList.Add(SashDimension.Serialize()) Next For Each Joint In JointList JsonSash.JointList.Add(Joint.Serialize()) Next For Each Area In AreaList JsonSash.AreaList.Add(Area.Serialize()) Next Return JsonSash End Function End Class Public Class AGBOption Inherits VMBase Enum HDWOPTIONTYPES As Integer TEXT = 1 LENGHT = 2 COMBO = 3 End Enum Private m_Type As HDWOPTIONTYPES Public ReadOnly Property Type As HDWOPTIONTYPES Get Return m_Type End Get End Property Private m_sName As String Public ReadOnly Property sName As String Get Return m_sName End Get End Property Private m_sDescription As String Public ReadOnly Property sDescription As String Get Return m_sDescription End Get End Property Private m_ValueList As New List(Of AGBOptionParameter) Public ReadOnly Property ValueList As List(Of AGBOptionParameter) Get Return m_ValueList End Get End Property Private m_sValue As AGBOptionParameter Public Property sValue As AGBOptionParameter Get Return m_sValue End Get Set(value As AGBOptionParameter) m_sValue = value End Set End Property Private m_OptVisibility As Visibility Public ReadOnly Property OptVisibility As Visibility Get Return m_OptVisibility End Get End Property Sub New(HdwOptionParam As ParametriOpzioniParametri) If HdwOptionParam.Opzioni.Count > 0 Then m_Type = HDWOPTIONTYPES.COMBO For Each Value In HdwOptionParam.Opzioni m_ValueList.Add(New AGBOptionParameter(Value.Valore, Value.DescrizioneOpzione)) Next Else m_Type = HDWOPTIONTYPES.TEXT End If m_sName = HdwOptionParam.NomeParametro m_sDescription = HdwOptionParam.DescrizioneParametro m_sValue = m_ValueList.FirstOrDefault(Function(x) x.sValue = HdwOptionParam.ValoreCorrente) m_OptVisibility = Visibility.Visible 'If(HdwOptionParam.Visible.ToLower = "true", Visibility.Visible, Visibility.Collapsed) End Sub End Class Public Class AGBOptionParameter Inherits VMBase Private m_sValue As String Public ReadOnly Property sValue As String Get Return m_sValue End Get End Property Private m_sDescription As String Public ReadOnly Property sDescription As String Get Return m_sDescription End Get End Property Sub New(sValue As String, sDescription As String) m_sValue = sValue m_sDescription = sDescription End Sub End Class Public Class Split Inherits Area Public Property nSplitQty As Integer Get Return If(m_SplitPositionList.Count > 0, m_SplitPositionList.Count - 1, 0) End Get Set(value As Integer) If value > m_SplitPositionList.Count - 1 Then ' recupero larghezza ultimo Dim dLastDimension As Double = 100 Dim dNewDimension As Double = 100 If m_SplitPositionList.Count > 0 Then dLastDimension = m_SplitPositionList(m_SplitPositionList.Count - 1).dDimension dNewDimension = dLastDimension / (value + 1 - nSplitQty) m_SplitPositionList(m_SplitPositionList.Count - 1).SetDimension(dNewDimension) Else dNewDimension = dLastDimension / (value + 1 - nSplitQty) End If ' aggiungo area Split di default For SplitIndex = m_SplitPositionList.Count To value SplitPositionList.Add(New SplitDimension(dNewDimension, True, Me)) ' AreaList.Add(Area.CreateArea) Next ElseIf value < m_SplitPositionList.Count - 1 Then Dim dLastDimension As Double = 0 For SplitIndex = m_SplitPositionList.Count - 1 To value + 1 Step -1 dLastDimension += m_SplitPositionList(SplitIndex).dDimension SplitPositionList.RemoveAt(SplitIndex) ' AreaList.RemoveAt(SplitIndex) Next dLastDimension += m_SplitPositionList(SplitPositionList.Count - 1).dDimension SplitPositionList(SplitPositionList.Count - 1).SetDimension(dLastDimension) End If End Set End Property Friend Sub SetSplitQty(Qty As Integer, Optional NotifyProperty As Boolean = False) If Qty > m_SplitPositionList.Count Then ' recupero larghezza ultimo Dim dLastDimension As Double = 100 Dim dNewDimension As Double = 100 If m_SplitPositionList.Count > 0 Then dLastDimension = m_SplitPositionList(m_SplitPositionList.Count - 1).dDimension dNewDimension = dLastDimension / (Qty + 1 - nSplitQty) m_SplitPositionList(m_SplitPositionList.Count - 1).dDimension = dNewDimension Else dNewDimension = dLastDimension / (Qty + 1 - nSplitQty) End If ' aggiungo area Split di default For SplitIndex = m_SplitPositionList.Count To Qty SplitPositionList.Add(New SplitDimension(dNewDimension, True, Me)) ' AreaList.Add(Area.CreateArea) Next ElseIf Qty < m_SplitPositionList.Count Then For SplitIndex = m_SplitPositionList.Count - 1 To Qty Step -1 SplitPositionList.RemoveAt(SplitIndex) Next End If If NotifyProperty Then NotifyPropertyChanged(NameOf(nSplitQty)) End If End Sub Private m_SplitShapeList As New ObservableCollection(Of IdNameStruct)({New IdNameStruct(SplitShapes.VERTICAL, "Vertical"), New IdNameStruct(SplitShapes.HORIZONTAL, "Horizontal"), New IdNameStruct(SplitShapes.GRID, "Grid"), New IdNameStruct(SplitShapes.CUSTOM, "Custom")}) Public ReadOnly Property SplitShapeList As ObservableCollection(Of IdNameStruct) Get Return m_SplitShapeList End Get End Property Private m_SelSplitShape As SplitShapes Public Property SelSplitShapeIndex As Integer Get Return IdNameStruct.IndFromId(m_SelSplitShape, m_SplitShapeList) End Get Set(value As Integer) m_SelSplitShape = IdNameStruct.IdFromInd(value, m_SplitShapeList) End Set End Property Friend Sub SetSplitShape(Value As SplitShapes, Optional NotifyProperty As Boolean = False) m_SelSplitShape = Value If NotifyProperty Then NotifyPropertyChanged(NameOf(SelSplitShapeIndex)) End If End Sub Friend ReadOnly Property SelSplitShape As SplitShapes Get Return m_SelSplitShape End Get End Property Private m_bIsPercentage As Boolean = True Public ReadOnly Property bIsPercentage As Boolean Get Return m_bIsPercentage End Get End Property Private m_SplitPositionList As New ObservableCollection(Of SplitDimension) Public Property SplitPositionList As ObservableCollection(Of SplitDimension) Get Return m_SplitPositionList End Get Set(value As ObservableCollection(Of SplitDimension)) m_SplitPositionList = value End Set End Property Private m_Split As Curve Public Property Split As Curve Get Return m_Split End Get Set(value As Curve) m_Split = value m_delDrawWindow() End Set End Property Sub New(ParentArea As Area) MyBase.New(ParentArea) End Sub Friend Shared Function CreateSplit(Area As Area, SplitShape As SplitShapes) As Split Dim Split As New Split(Area) Split.SetAreaType(AreaTypes.SPLIT) Split.SetSplitShape(SplitShape, True) Return Split End Function Friend Overrides Function DrawArea(Area As Area, nAreaId As Integer) As Boolean If IsNothing(Area) Then Return False ' verifico se applicata If Not bApplied Then Return True ' verifico che esista area frame con forma e dimensioni corrette If IsNothing(m_SplitPositionList) OrElse IsNothing(m_SelSplitShape) OrElse m_SplitPositionList.Count = 0 Then Return False End If ' creo split Dim tf = EgtLuaSetGlobIntVar("WDG.AREAID", nAreaId) Dim tg = EgtLuaSetGlobIntVar("WDG.SPLITORIENTATION", SelSplitShape) EgtLuaSetGlobIntVar("WDG.SPLITTYPE", LuaSplitTypes.NULL) Dim th = EgtLuaSetGlobIntVar("WDG.MEASURETYPE", 3) For PositionIndex = 0 To SplitPositionList.Count - 2 Dim tj = EgtLuaSetGlobNumVar("WDG.POSITION" & PositionIndex + 1, If(m_SplitPositionList(PositionIndex).bIsRelative, SplitPositionList(PositionIndex).dDimension / 100, SplitPositionList(PositionIndex).dDimension)) Next Dim tkt = EgtLuaSetGlobNumVar("WDG.PROPORTION", SplitPositionList.Sum(Function(x) x.dDimension / 100)) Dim tlt = EgtLuaCallFunction("WinCreate_AddSplits") Dim AreaIndex As Integer = 1 Dim NewAreaId As Integer = GDB_ID.NULL While EgtLuaGetGlobIntVar("WDG.AREAID" & AreaIndex, NewAreaId) If NewAreaId <> GDB_ID.NULL Then Area.AreaList(AreaIndex - 1).nAreaId = NewAreaId AreaIndex += 1 Else Exit While End If End While Dim tltf = EgtLuaGetGlobIntVar("WDG.AREAID", Area.nAreaId) ' lancio disegno delle sotto aree For Each Area In AreaList If Not Area.DrawArea(Area, nAreaId) Then Return False Next Return True End Function Friend Overrides Function GetSelectionArea() As Boolean Dim nAreaType As Integer = -1 EgtGetInfo(m_nAreaId, WIN_AREATYPE, nAreaType) If nAreaType = AreaTypes.FRAME Or nAreaType = AreaTypes.SASH Or nAreaType = AreaTypes.FILL Or nAreaType = AreaTypes.SPLIT Then Dim nSelLayerId As Integer = EgtGetFirstNameInGroup(m_nAreaId, LUA_WIN_SPLITSELECTION) If nSelLayerId <> GDB_ID.NULL Then SetSelectionGeomId(nSelLayerId) End If End If If nSplitQty > 1 Then Dim nSplitIndex = 1 Dim nArea2Id As Integer = m_nAreaId While nSplitIndex < nSplitQty nArea2Id = EgtGetFirstNameInGroup(nArea2Id, WIN_AREA & 2) Dim nArea2SplitSelId As Integer = EgtGetFirstNameInGroup(nArea2Id, LUA_WIN_SPLITSELECTION) SelectionGeomIds(nSplitIndex) = nArea2SplitSelId nSplitIndex += 1 End While End If 'Dim nArea1Id As Integer = EgtGetFirstNameInGroup(nAreaId, WIN_AREA & 1) 'If nArea1Id <> GDB_ID.NULL Then ' GetSelectionSplitArea(nArea1Id, SelectionGeomIds) 'End If 'Dim nArea2Id As Integer = EgtGetFirstNameInGroup(nAreaId, WIN_AREA & 2) 'If nArea2Id <> GDB_ID.NULL Then ' GetSelectionSplitArea(nArea2Id, SelectionGeomIds) 'End If ' lancio recupero area di selezione delle sotto aree For Each Area In AreaList If Not Area.GetSelectionArea() Then Return False Next Return True End Function Friend Sub GetSelectionSplitArea(nAreaId As Integer, SelectionGeomIds As List(Of Integer)) Dim nAreaType As Integer = -1 EgtGetInfo(nAreaId, WIN_AREATYPE, nAreaType) If nAreaType = AreaTypes.SPLIT Or nAreaType = AreaTypes.SPLITTED Then Dim nSelLayerId As Integer = EgtGetFirstNameInGroup(m_nAreaId, WIN_SELECTION) If nSelLayerId <> GDB_ID.NULL Then SelectionGeomIds.Add(nSelLayerId) End If Dim nArea1Id As Integer = EgtGetFirstNameInGroup(nAreaId, WIN_AREA & 1) If nArea1Id <> GDB_ID.NULL Then GetSelectionSplitArea(nArea1Id, SelectionGeomIds) End If Dim nArea2Id As Integer = EgtGetFirstNameInGroup(nAreaId, WIN_AREA & 2) If nArea2Id <> GDB_ID.NULL Then GetSelectionSplitArea(nArea2Id, SelectionGeomIds) End If End If End Sub Friend Overrides Function Serialize() As JsonArea Dim JsonSplit As JsonSplit = New JsonSplit(m_SelSplitShape) For Each SplitPosition In m_SplitPositionList JsonSplit.SplitPositionList.Add(SplitPosition.Serialize()) Next For Each Area In AreaList JsonSplit.AreaList.Add(Area.Serialize()) Next Return JsonSplit End Function End Class Public Class Splitted Inherits Area Sub New(ParentArea As Area) MyBase.New(ParentArea) End Sub Friend Shared Function CreateSplitted(Area As Area) As Splitted Dim Splitted As Splitted = New Splitted(Area) Splitted.SetAreaType(AreaTypes.SPLITTED) Return Splitted End Function Friend Overrides Function DrawArea(Area As Area, nAreaId As Integer) As Boolean ' lancio disegno delle sotto aree For Each Area In AreaList If Not Area.DrawArea(Area, m_nAreaId) Then Return False Next Return True End Function Friend Overrides Function GetSelectionArea() As Boolean Dim nSelLayerId As Integer = EgtGetFirstNameInGroup(m_nAreaId, WIN_SELECTION) If nSelLayerId <> GDB_ID.NULL Then SetSelectionGeomId(nSelLayerId) End If ' lancio recupero area di selezione delle sotto aree For Each Area In AreaList If Not Area.GetSelectionArea() Then Return False Next Return True End Function Friend Overrides Function Serialize() As JsonArea Dim JsonSplitted As JsonSplitted = New JsonSplitted() For Each Area In AreaList JsonSplitted.AreaList.Add(Area.Serialize()) Next Return JsonSplitted End Function End Class Public Class Fill Inherits Area Public ReadOnly Property FillType As FillTypes Get If m_Fill_IsChecked(0) Then Return FillTypes.GLASS Else Return FillTypes.WOOD End If End Get End Property Friend Sub SetFillType(FillType As FillTypes) Select Case FillType Case FillTypes.GLASS bGlass_IsChecked = True Case FillTypes.WOOD bWood_IsChecked = True End Select End Sub Private m_Fill_IsChecked As Boolean() = {False, False} Public Property bGlass_IsChecked As Boolean Get Return m_Fill_IsChecked(0) End Get Set(value As Boolean) m_Fill_IsChecked(0) = value End Set End Property Public Property bWood_IsChecked As Boolean Get Return m_Fill_IsChecked(1) End Get Set(value As Boolean) m_Fill_IsChecked(1) = value End Set End Property Sub New(ParentArea As Area) MyBase.New(ParentArea) End Sub Friend Shared Function CreateFill(Area As Area, FillType As FillTypes) As Fill Dim Fill As Fill = New Fill(Area) Fill.SetAreaType(AreaTypes.FILL) Fill.SetFillType(FillType) Return Fill End Function Friend Overrides Function DrawArea(Area As Area, nAreaId As Integer) As Boolean ' verifico se applicata If Not bApplied Then Return True ' creo anta Dim tf = EgtLuaSetGlobIntVar("WDG.AREAID", nAreaId) Dim tft = EgtLuaSetGlobIntVar("WDG.FILLTYPE", FillType) Dim tlt = EgtLuaCallFunction("WinCreate_AddFill") Dim tltf = EgtLuaGetGlobIntVar("WDG.AREAID", m_nAreaId) nAreaId = m_nAreaId If m_nAreaId = GDB_ID.NULL Then Return False ' lancio disegno delle sotto aree For Each Area In AreaList If Not Area.DrawArea(Area, nAreaId) Then Return False Next Return True End Function Friend Overrides Function GetSelectionArea() As Boolean Dim nSelLayerId As Integer = EgtGetFirstNameInGroup(m_nAreaId, WIN_SELECTION) If nSelLayerId <> GDB_ID.NULL Then SetSelectionGeomId(nSelLayerId) End If ' lancio recupero area di selezione delle sotto aree For Each Area In AreaList If Not Area.GetSelectionArea() Then Return False Next Return True End Function Friend Overrides Function Serialize() As JsonArea Dim JsonFill As JsonFill = New JsonFill(FillType) For Each Area In AreaList JsonFill.AreaList.Add(Area.Serialize()) Next Return JsonFill End Function End Class Public Class Joint Inherits VMBase ' Actions Friend Shared m_delDrawWindow As Action Private m_nIndex As Integer Public ReadOnly Property nIndex As Integer Get Return m_nIndex End Get End Property Private m_JointTypeList As New List(Of IdNameStruct)({New IdNameStruct(Joints.ANGLED, "Angled"), New IdNameStruct(Joints.FULL_H, "Full H"), New IdNameStruct(Joints.FULL_V, "Full V")}) Public ReadOnly Property JointTypeList As List(Of IdNameStruct) Get Return m_JointTypeList End Get End Property Private m_SelJointType As Joints Public Property SelJointTypeIndex As Integer Get Return IdNameStruct.IndFromId(m_SelJointType, m_JointTypeList) End Get Set(value As Integer) m_SelJointType = IdNameStruct.IdFromInd(value, m_JointTypeList) 'm_delDrawWindow() End Set End Property Public Property SelJointType As Joints Get Return m_SelJointType End Get Set(value As Joints) m_SelJointType = value End Set End Property Friend Sub SetSelJointType(value As Joints) m_SelJointType = value NotifyPropertyChanged(NameOf(SelJointTypeIndex)) End Sub Sub New(nIndex As Integer, SelJointType As Joints) m_nIndex = nIndex m_SelJointType = SelJointType End Sub Friend Function Serialize() As JsonJoint Dim JsonJoint As JsonJoint = New JsonJoint(m_nIndex, m_SelJointType) Return JsonJoint End Function End Class Public Class Curve Inherits VMBase Private m_CurveType As GDB_TY Public Property CurveType As GDB_TY Get Return m_CurveType End Get Set(value As GDB_TY) m_CurveType = value End Set End Property Private m_ptStart As Point3d Public Property ptStart As Point3d Get Return m_ptStart End Get Set(value As Point3d) m_ptStart = value End Set End Property Private m_ptEnd As Point3d Public Property ptEnd As Point3d Get Return m_ptEnd End Get Set(value As Point3d) m_ptEnd = value End Set End Property End Class Public Class Hardware Private m_sId As String Public ReadOnly Property sId As String Get Return m_sId End Get End Property Private m_sName As String Public ReadOnly Property sName As String Get Return m_sName End Get End Property Private m_sOpeningType As String Public ReadOnly Property sOpeningType As String Get Return m_sOpeningType End Get End Property Private m_sShape As String Public ReadOnly Property sShape As String Get Return m_sShape End Get End Property Private m_nSashQty As Integer Public ReadOnly Property nSashQty As Integer Get Return m_nSashQty End Get End Property Private m_nSashPosition As Integer Public ReadOnly Property nSashPosition As Integer Get Return m_nSashPosition End Get End Property Sub New(sId As String, sName As String, sOpeningType As String, sShape As String, nSashQty As Integer, nSashPosition As Integer) m_sId = sId m_sName = sName m_sOpeningType = sOpeningType m_sShape = sShape m_nSashQty = nSashQty m_nSashPosition = nSashPosition End Sub End Class Public Class AreaToSplitPageConverter Implements IValueConverter Public Function Convert(value As Object, targetType As Type, parameter As Object, culture As CultureInfo) As Object Implements IValueConverter.Convert If TypeOf value Is Area Then Return 1 Else Return 0 End If End Function Public Function ConvertBack(value As Object, targetType As Type, parameter As Object, culture As CultureInfo) As Object Implements IValueConverter.ConvertBack Throw New NotImplementedException() End Function End Class