unit Form3d; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Math, Keyboard, Dialogs, GLScene, GLObjects, GLWin32Viewer,{ GLMisc,} GLTexture, jpeg, StdCtrls, ExtCtrls, Buttons,PCTypesUtils,GLGeomObjects,VectorGeometry, GLFile3DS, GLExtrusion, GLGraph, GLVectorFileObjects, GLPortal, GLSpaceText,GLMultiPolygon, VectorTypes, GLHUDObjects, GLWaterPlane, GLBitmapFont, GLWindowsFont, LibJPeg, Form3d_Save, siComp, siLngLnk, GLMesh, {U_Arch3D}U_Arch3DNew, ComCtrls, ImgList, cxControls, cxContainer, cxEdit, cxTextEdit, cxMemo, cxMaskEdit, RzCmboBx, cxLookAndFeelPainters, cxButtons, cxImage, RzButton, RzRadChk, cxDropDownEdit, ExtDlgs, GLCadencer, glFPSMovement, GLNavigator, Menus, GeometryBB, cxGroupBox, U_Cad, U_SCSLists, RzTabs, U_ESCadClasess, PowerCad, exgrid, RapTree, RzTreeVw, File3DS, Types3Ds,{Tolik 11/02/2019}PersistentClasses, MeshUtils, VectorLists, GLMeshOptimizer, Utils3Ds, glFileObj, cxGraphics, cxLookAndFeels, GLMaterial, GLCoordinates, GLCrossPlatform, BaseClasses, glNodes, {Tolik 19/03/2019}GlColor, GLKeyboard, U_Common_Classes, OpenGL1x, GLBehaviours, GLParticleFX, IniFiles; const // Koeff Cam Move kmPerspective = 0.1; //04.01.2012 в некоторых местах было 0.132 и 0.12 kmOrthogonel = 0.003; //04.01.2012 0.03; cmpNearestPointDelta = 0.05; type TModeType = (F3DFirstPerson, F3DPerspective, F3DOrtho); // Tolik 11/02/2020 -- // Tolik 11/10/2018 TOpen3dsModelDialog = class(TOpenDialog) private GLCadencer: TGLCadencer; GLSceneViewer: TGLSceneViewer; GLScene: TGLScene; GLCamera: TGLCamera; GLDummyCube: TGLDummyCube; GLLightSource: TGLLightSource; GLPlane: TGLPlane; glObjClass: TGLSceneObjectClass; glObject: TGLFreeForm; ObjectMin, ObjectMax, RoomMin, RoomMax, ObjSize, RoomSize, SetPos, Scale, ObjPos: TDoublePoint; SetScale: Double; tmpdir, tmpfname: string; HashStr: string; GWidth: double; FSavedFilename: string; gPanel: TPanel; procedure PreviewKeyPress(Sender: TObject; var Key: Char); protected procedure PreviewClick(Sender: TObject); virtual; //procedure DoClose; override; procedure DoSelectionChange; override; procedure DoShow; override; Procedure Get3DSObjectBounds(var Min, Max: TDoublePoint; aObject: TGLFreeForm; aReplaceYZ: Boolean = False); Procedure Initialize; Procedure CheckKeyPressed(Sender: TObject; const deltaTime, newTime: Double); published public constructor Create(AOwner: TComponent); override; function Execute: Boolean; override; Destructor Destroy; override; end; // TPropViewType = (pvtNone, pvtSingleSide, pvtMultiSides, pvtSingle3ds, pvtMulti3ds, pvtSingleConn, pvtMultiConn, pvtSingleLine, pvtMultiLine); TToolMode = (tmSelect, tmCut); TLineOrder = (loNone, loHorz, loVert, loRaise); TCoord = (cX, cY, cZ); TCutData = class(TObject) Index11: Integer; Index12: Integer; Index21: Integer; Index22: Integer; end; TResizeData = class(TObject) BasisNodes: T3DPointArray; Side1: TGLPolygon; Side2: TGLPolygon; Nodep11: TGLNode; Nodep12: TGLNode; Nodep21: TGLNode; Nodep22: TGLNode; Noder11: TGLNode; Noder12: TGLNode; Noder21: TGLNode; Noder22: TGLNode; Indexp11: Integer; Indexp12: Integer; Indexp21: Integer; Indexp22: Integer; Indexr11: Integer; Indexr12: Integer; Indexr21: Integer; Indexr22: Integer; end; TPropRecord = class(TMyObject) fName: string; fDesc: TStringList; fCoords: TList; fRotate: string; constructor Create; // Tolik 11/03/2017 - - destructor destroy;override; // end; TVector3fArr = array of TVector3f; Tfrm3D = class(TForm) GLScene: TGLScene; panMain: TPanel; GLCamera: TGLCamera; panUpper: TPanel; SpeedButton1: TSpeedButton; SpeedButton2: TSpeedButton; DummyCube: TGLDummyCube; TransCube: TGLDummyCube; GLPlane1: TGLPlane; GLDummyCube1: TGLDummyCube; GLHUDText1: TGLHUDText; SpeedButton3: TSpeedButton; SaveDialog: TSaveDialog; lbViewType: TLabel; lng_Forms: TsiLangLinked; cbViewCeiling: TCheckBox; Splitter1: TSplitter; ImageList_Dir: TImageList; panScene: TPanel; GLSceneViewer: TGLSceneViewer; panObjects: TPanel; Splitter2: TSplitter; Label10: TLabel; OpenTexture: TOpenPictureDialog; sbFirstFace: TSpeedButton; MainCenter: TGLDummyCube; GLCadencer: TGLCadencer; pmModelTree: TPopupMenu; nAdd3DObject: TMenuItem; Open3DObject: TOpenDialog; pmCut: TPopupMenu; sbSaveModel: TSpeedButton; nDeleteAllSubSides: TMenuItem; FirstPerson: TGLDummyCube; FirstPersonCamera: TGLCamera; GLNavigator1: TGLNavigator; GLFPSMovementManager1: TGLFPSMovementManager; Edit1: TEdit; Edit2: TEdit; NDel3DObject: TMenuItem; MatLib: TGLMaterialLibrary; pcTree: TRzPageControl; pcProps: TRzPageControl; TabArchModel: TRzTabSheet; TabScsModel: TRzTabSheet; TabArchProps: TRzTabSheet; TabScsProps: TRzTabSheet; cxGroupBox1: TcxGroupBox; cbLists: TcxComboBox; cbObjectsTypes: TcxComboBox; ModelTree: TTreeView; Panel1: TPanel; panName: TPanel; Label2: TLabel; edName: TcxTextEdit; panDesc: TPanel; Label3: TLabel; btnEmpty: TSpeedButton; mDesc: TcxMemo; panCoords: TPanel; Label4: TLabel; Label8: TLabel; Label9: TLabel; Label11: TLabel; edCoordX: TcxMaskEdit; edCoordY: TcxMaskEdit; edCoordZ: TcxMaskEdit; cbCoordNbr: TcxComboBox; panSideTexture: TPanel; Label7: TLabel; Label1: TLabel; imgSideTexture: TcxImage; bSideTextureChange: TcxButton; bSideTextureClear: TcxButton; cbSideHashs: TcxComboBox; panRotate: TPanel; Label5: TLabel; Label37: TLabel; Label27: TLabel; Label28: TLabel; edTextureRotate: TcxMaskEdit; edTextureScale: TcxMaskEdit; panMirror: TPanel; Label6: TLabel; cbMirror: TRzCheckBox; panPos3ds: TPanel; Label12: TLabel; Label13: TLabel; Label14: TLabel; Label15: TLabel; edPosX: TcxMaskEdit; edPosY: TcxMaskEdit; edPosZ: TcxMaskEdit; panRotate3ds: TPanel; Label16: TLabel; Label17: TLabel; Label18: TLabel; Label19: TLabel; Label24: TLabel; Label25: TLabel; Label26: TLabel; edAngleX: TcxMaskEdit; edAngleY: TcxMaskEdit; edAngleZ: TcxMaskEdit; panScale3ds: TPanel; Label20: TLabel; Label21: TLabel; Label22: TLabel; Label23: TLabel; edScaleX: TcxMaskEdit; edScaleY: TcxMaskEdit; edScaleZ: TcxMaskEdit; panObjectTexture: TPanel; Label29: TLabel; Label30: TLabel; imgObjectTexture: TcxImage; bObjectTextureChange: TcxButton; cbObjectHashs: TcxComboBox; bObjectTextureClear: TcxButton; Panel2: TPanel; panScsName: TPanel; Label31: TLabel; edScsName: TcxTextEdit; panScsDesc: TPanel; Label32: TLabel; btnScsEmpty: TSpeedButton; mScsDesc: TcxMemo; cxGroupBox2: TcxGroupBox; cbScsLists: TcxComboBox; cbScsObjectsTypes: TcxComboBox; ScsModelTree: TTreeView; pmScsPopup: TPopupMenu; nDivLine: TMenuItem; panScsOffset: TPanel; Label33: TLabel; Label34: TLabel; Label35: TLabel; Label36: TLabel; edScsOffsetX: TcxMaskEdit; edScsOffsetY: TcxMaskEdit; edScsOffsetZ: TcxMaskEdit; panScsRotate: TPanel; Label38: TLabel; Label39: TLabel; Label40: TLabel; Label41: TLabel; Label42: TLabel; Label43: TLabel; Label44: TLabel; edScsAngleX: TcxMaskEdit; edScsAngleY: TcxMaskEdit; edScsAngleZ: TcxMaskEdit; panScsScale: TPanel; Label45: TLabel; Label46: TLabel; Label47: TLabel; Label48: TLabel; edScsScaleX: TcxMaskEdit; edScsScaleY: TcxMaskEdit; edScsScaleZ: TcxMaskEdit; panScsObjectTexture: TPanel; Label49: TLabel; bScsLoadModel: TcxButton; sbApplyScsModel: TSpeedButton; edScsIndex: TcxMaskEdit; Label50: TLabel; mScsCaption: TcxMemo; Label51: TLabel; Label52: TLabel; mScsNote: TcxMemo; panScsLength: TPanel; lbScsLength: TLabel; edScsLength: TcxMaskEdit; panScsConnCoords: TPanel; Label54: TLabel; Label55: TLabel; Label56: TLabel; Label57: TLabel; edScsConnX: TcxMaskEdit; edScsConnY: TcxMaskEdit; edScsConnZ: TcxMaskEdit; panScsLineCoords: TPanel; Label58: TLabel; Label59: TLabel; Label60: TLabel; Label61: TLabel; edScsLineX1: TcxMaskEdit; edScsLineY1: TcxMaskEdit; edScsLineZ1: TcxMaskEdit; lbScsLineX2: TLabel; edScsLineX2: TcxMaskEdit; lbScsLineY2: TLabel; edScsLineY2: TcxMaskEdit; lbScsLineZ2: TLabel; edScsLineZ2: TcxMaskEdit; Label65: TLabel; lbScsLine2: TLabel; cbShowTraceCaptions: TCheckBox; TimerOnSelectNodes: TTimer; Light: TGLLightSource; sbView: TPanel; Panel3: TPanel; SpeedButton4: TSpeedButton; cbDontShowSubstrate: TRzCheckBox; SCSSubstratesPanel: TPanel; tvSubStartesView: TRzCheckTree; cbDisableSubstratesTransparency: TRzCheckBox; ShowHideAchObject: TMenuItem; N1: TMenuItem; N2: TMenuItem; procedure GLSceneViewerMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure GLSceneViewerMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure SpeedButton1Click(Sender: TObject); procedure SpeedButton2Click(Sender: TObject); procedure FormShow(Sender: TObject); procedure GLHeightField1GetHeight(const x, y: Single; var z: Single; var color: TVector4f; var texPoint: TTexPoint); procedure FormMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); procedure SpeedButton3Click(Sender: TObject); procedure cbViewCeilingClick(Sender: TObject); procedure GLSceneViewerDblClick(Sender: TObject); procedure ModelTreeClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure cbCoordNbrCloseUp(Sender: TObject); procedure bSideTextureClearClick(Sender: TObject); procedure cbMirrorClick(Sender: TObject); procedure mDescEnter(Sender: TObject); procedure sbFirstFaceClick(Sender: TObject); procedure bSideTextureChangeClick(Sender: TObject); procedure GLCadencerProgress(Sender: TObject; const deltaTime, newTime: Double); procedure GLSceneViewerClick(Sender: TObject); procedure cbHashsPropertiesCloseUp(Sender: TObject); procedure nAdd3DObjectClick(Sender: TObject); procedure ModelTreeMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure edNameExit(Sender: TObject); procedure mDescExit(Sender: TObject); procedure edPosXExit(Sender: TObject); procedure edPosYExit(Sender: TObject); procedure edPosZExit(Sender: TObject); procedure edAngleXExit(Sender: TObject); procedure edAngleYExit(Sender: TObject); procedure edAngleZExit(Sender: TObject); procedure edScaleXExit(Sender: TObject); procedure edScaleYExit(Sender: TObject); procedure edScaleZExit(Sender: TObject); procedure edCoordXKeyPress(Sender: TObject; var Key: Char); procedure edCoordXExit(Sender: TObject); procedure edCoordYExit(Sender: TObject); procedure edCoordZExit(Sender: TObject); procedure edTextureRotateExit(Sender: TObject); procedure edCoordYKeyPress(Sender: TObject; var Key: Char); procedure edCoordZKeyPress(Sender: TObject; var Key: Char); procedure edTextureRotateKeyPress(Sender: TObject; var Key: Char); procedure edNameKeyPress(Sender: TObject; var Key: Char); procedure mDescKeyPress(Sender: TObject; var Key: Char); procedure edPosXKeyPress(Sender: TObject; var Key: Char); procedure edPosYKeyPress(Sender: TObject; var Key: Char); procedure edPosZKeyPress(Sender: TObject; var Key: Char); procedure edAngleXKeyPress(Sender: TObject; var Key: Char); procedure edAngleYKeyPress(Sender: TObject; var Key: Char); procedure edAngleZKeyPress(Sender: TObject; var Key: Char); procedure edScaleXKeyPress(Sender: TObject; var Key: Char); procedure edScaleYKeyPress(Sender: TObject; var Key: Char); procedure edScaleZKeyPress(Sender: TObject; var Key: Char); procedure GLSceneViewerMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); procedure sbSaveModelClick(Sender: TObject); procedure nDeleteAllSubSidesClick(Sender: TObject); procedure Edit2Exit(Sender: TObject); procedure btnEmptyClick(Sender: TObject); procedure NDel3DObjectClick(Sender: TObject); procedure cbListsPropertiesCloseUp(Sender: TObject); procedure cbObjectsTypesPropertiesCloseUp(Sender: TObject); procedure edTextureScaleExit(Sender: TObject); procedure edTextureScaleKeyPress(Sender: TObject; var Key: Char); procedure cbObjectHashsPropertiesCloseUp(Sender: TObject); procedure bObjectTextureClearClick(Sender: TObject); procedure bObjectTextureChangeClick(Sender: TObject); procedure MatLibTextureNeeded(Sender: TObject; var textureFileName: String); procedure pcTreeTabClick(Sender: TObject); procedure cbScsListsPropertiesCloseUp(Sender: TObject); procedure cbScsObjectsTypesPropertiesCloseUp(Sender: TObject); procedure ScsModelTreeMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ScsModelTreeClick(Sender: TObject); procedure bScsLoadModelClick(Sender: TObject); procedure sbApplyScsModelClick(Sender: TObject); procedure nDivLineClick(Sender: TObject); procedure cbShowTraceCaptionsClick(Sender: TObject); procedure TimerOnSelectNodesTimer(Sender: TObject); procedure FormKeyPress(Sender: TObject; var Key: Char); procedure SpeedButton4Click(Sender: TObject); function MyGetPickedObject(x, y : Integer): TGLBaseSceneObject; procedure cbDontShowSubstrateKeyPress(Sender: TObject; var Key: Char); procedure cbDontShowSubstrateMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure cbDisableSubstratesTransparencyClick(Sender: TObject); procedure tvSubStartesViewStateChange(Sender: TObject; Node: TTreeNode; NewState: TRzCheckState); procedure ShowHideAchObjectClick(Sender: TObject); procedure N1Click(Sender: TObject); procedure N2Click(Sender: TObject); procedure GLSceneViewerBeforeRender(Sender: TObject); private { Private declarations } //Tolik 17/12/2018 -- //procedure Rotate3DSObj(aObject: TGLFreeForm; aX, aY, aZ: Double); procedure Rotate3DSObj(aObject: TGLFreeForm; aX, aY, aZ: Double; aSaveResult: Boolean = True); //Procedure Rotate3DComponent(aCompon: TglFreeForm; DegX, DegY, DegZ: Double); Procedure Rotate3DComponent(aCompon: T3DComponent); // procedure RotateConnModel(aObject: TGLFreeForm; aX, aY, aZ: Double); procedure DeselectGLObjectsT; public { Public declarations } FMode: TModeType; // Tolik -- 26/04/2018 -- isProjectModel: Boolean; // показывает что выводится модель проекта (True) или модель листа (False) FSubstList: TList; isUserTransparency: Boolean; // Tolik 28/11/2018 -- FTextureFileName: String; // Tolik 03/12/2018 -- ErrorTextureLoad: Boolean; WasShiftMouse: Boolean; FMovedComponent: TglFreeForm; // ObjMatList: TStringList; // Tolik 02/10/2019 -- список материалов загруженнфх моделей из obj-файлов // по нему потом будем искать и править материалы в МатЛибе Factor: Double; //04.01.2012 Single; mx, my : Integer; mdx, mdy : Integer; last_x, last_y: Integer; FResizer: Boolean; RStartPos1, RStartPos2, MovedStartPos, MovedStartPos1, MovedStartPos2: T3DPoint; CPoint: T3DPoint; OPoint: T3DPoint; Camera: T3DPoint; FZOrder: Double; FGridStep: Double; FToolMode: TToolMode; FPropRecord: TPropRecord; FNodesObjectsList: TList; FCutDataList: TList; FSelection: TList; FPropObjects: TList; FaceList: TList; FResizeData: TResizeData; FMovedObject, FRotatedObject: TGLFreeForm; FMovedFullConnector: TGLFreeForm; FMovedEmptyConnector: TGLCube; FMovedLine: TGLLines; FOffsetObjects, FRotatedObjects: Boolean; F3DModel: T3DModel; F3DStreamModel: T3DModel; //FFileStream: String; FIdsStream: TIntList; FFilesStream: TStringList; FMovedObjectsList: TList; FShadowObjects: TList; FCAD: TF_CAD; //16.09.2011 //#From Oleg# FxObjects: TList; FNodes: TList; Procedure UpdateFaces(Faces: TList; Yh: Double = 0); procedure UpdateModelTree; procedure UpdateScsModelTree; procedure UpdateModelTreeFromStream(Faces: TList); procedure UpdateScsModelTreeFromStream(Faces: TList); function CopySideProperties(aSide, aStrSide: T3DSide): T3DSide; function CopySubSideProperties(aStrSubSide: T3DSide): T3DSide; function CopyObjectProperties(aObject, aStrObject: T3DSObject): T3DSObject; function CopyConnectorProperties(aObject, aStrObject: T3DConnector): T3DConnector; function CopyLineProperties(aObject, aStrObject: T3DLine): T3DLine; procedure CopyModelHash; Procedure SetCubeBounds(var glCube:TGLCube;Points: T3dPointArray; Factor:Double); Procedure AddWall(aWall: TGLMesh; vs: array of TVector3f); Procedure AddFloor(aFloor: TGLMesh; vs: array of TVector3f; aSide: T3DSide); procedure OnSelectNodes(aNodes: TList); function FindGLObjectsByNodes(aNodes: TList): TList; procedure SelectGLObjects(aObjects: TList); procedure SelectGLObjects_GOOD(aObjects: TList); procedure DeselectGLObjects; function CheckGLObjectInSelectionNodes(aObject: TGLBaseSceneObject; aNodes: TList): Boolean; function GetAllSidesNodesByNodes(aNodes: TList): TList; function GetAllChildNodes(ANode: TTreeNode): TList; function GetPropViewType(aNodes: TList): TPropViewType; procedure OnLoadProperties(aObjects: TList); function LoadTexture: string; procedure SetAllPanels(aStatus: Boolean); procedure SetAllScsPanels(aStatus: Boolean); // Properties function LoadPropertiesForSingleObject(aObject: TTreeNode): TPropRecord; function LoadPropertiesForMultiObjects(aObjects: TList): TPropRecord; function LoadPropertiesForSingle3ds(aObject: TTreeNode): TPropRecord; function LoadPropertiesForMulti3ds(aObjects: TList): TPropRecord; function LoadPropertiesForSingleConn(aObject: TTreeNode): TPropRecord; function LoadPropertiesForMultiConn(aObjects: TList): TPropRecord; function LoadPropertiesForSingleLine(aObject: TTreeNode): TPropRecord; function LoadPropertiesForMultiLine(aObjects: TList): TPropRecord; procedure ChangeName; procedure ChangeDesc; procedure ChangeCoordX; procedure ChangeCoordY; procedure ChangeCoordZ; procedure ChangeTextureRotate; procedure ChangeTextureScale; procedure ChangePosX; procedure ChangePosY; procedure ChangePosZ; procedure ChangeAngleX; procedure ChangeAngleY; procedure ChangeAngleZ; procedure ChangeScaleX; procedure ChangeScaleY; procedure ChangeScaleZ; procedure Set3DSObjectPos(aGLObject: TGLFreeForm); procedure SetConnectorsOffset(aGLObjects: TList); // ************************** procedure OnRightClick; procedure RotateTextureToAngleM(aObject: T3DSide; aGLObject: TGLMesh; aAngle: Integer; aMirror: Boolean); Procedure RotateTextureToAngleP(aObject: T3DSide; aGLObject: TGLPolygon; aAngle: Integer; aMirror: Boolean); procedure SetPolygonTexture(aObject: TGLPolygon); Function Rotate3DVector(vs0, vs1, vs2: TVector3f; Ang: Double): TVector3f; Function GetImageFileByHash(aHash: string): string; function GetTextureFileByHash(aHash: string): string; Function GetObjectFileByHash(aHash: string): string; Procedure Get3DSObjectBounds(var Min, Max: T3DPoint; aObject: TGLFreeForm; aReplaceYZ: Boolean = False); Procedure GetRoomBounds(var Min, Max: T3DPoint; aFloor, aCeiling: T3DPointArray); procedure DeleteNodesObjects; procedure CreateNodesObjects(aObj: TGLPolygon); procedure SelectNodesEvent(Sender: TObject); procedure SetSideSizes; procedure DoResize; procedure AfterUpdate; procedure CreateAddForDivSide(aSide, aAddSide: TGLPolygon); procedure CreateAddForParentSide(aFirstSide, aSecondSide: TGLPolygon); procedure SetSidesData; procedure RefreshSidesPoints; procedure SaveModelToStream(const AFile: String=''; AListID: Integer = 0); procedure LoadModelFromStream(const AFile: String=''; AListID: Integer = 0); procedure SyncModelFromStream(const AFile: String=''; AListID: Integer = 0; AFaces: TList=nil); //16.09.2011 //#From Oleg# procedure GetModelData(Stream: TStream); procedure SetModelData(Stream: TStream); procedure SaveModelAddParamsToStream(const AFile: String=''); procedure GetFileData(Stream: TStream); procedure CollectFileDataFromModel(Stream: TStream); procedure LoadModelAddParamsFromStream(const AFile: String=''); procedure SetFileData(Stream: TStream); procedure ExtractAllFiles(Stream: TStream); function GetModelObjectByComponID(aComponID: Integer; aModelType: Byte = 1): TObject; function GetSimilarSide(aSide: T3DSide; aObject: TObject): T3DSide; function CmpSides(aSide1, aSide2: T3DSide): Boolean; procedure ToggleTraceCaptions(AShow: Boolean); procedure LoadSelectionData; procedure FindSelectNodesByType(aType: Integer); procedure FindSelectScsNodesByType(aType: Integer); function is3DSObject(aObj: TGLBaseSceneObject): Boolean; function isConnectorObject(aObj: TGLBaseSceneObject; aCmpObj: TGLBaseSceneObject = nil): Boolean; function isLineObject(aObj: TGLBaseSceneObject; aCmpObj: TGLBaseSceneObject = nil): Boolean; function GetDistAngle(AP1, AP2: TDoublePoint): Double; procedure UndoCutSides; //procedure SetFreeFormRotate(aObject: TGLFreeForm; aX, aY, aZ: Double); //procedure ResetFreeFormRotate(aObject: TGLFreeForm); procedure DoScale3dsObject(aWheelDelta: Integer); procedure DoScaleConnectorObjects(aWheelDelta: Integer); procedure DoRotate3dsObject(Shift: TShiftState; X, Y: Integer); procedure DoRotateConnectorObjects(Shift: TShiftState; X, Y: Integer); function GetPointToDivTrace(X, Y: Integer; aLine: TGLLines): T3DPoint; function CanDrag(aObj: TGLBaseSceneObject; X, Y: Integer): Boolean; procedure Move3DConnectorEvent(aObj: TGLBaseSceneObject); procedure Move3DLineEvent(aObj: TGLBaseSceneObject); procedure Move3DConnector(aObj: T3DConnector; dp: T3DPoint; AIsFirstObject: Boolean=false); procedure Move3DRaiseConnector(aObj: T3DConnector; dp: T3DPoint); procedure Move3DBetweenRaiseConnector(aObj: T3DConnector; dp: T3DPoint); procedure Move3DLine(aObj: T3DConnector; aLine: T3DLine; aPos: T3DPoint); procedure Trace3DConnector(aObj: TGLBaseSceneObject; dx, dy: Integer); procedure Trace3DLine(aObj: TGLBaseSceneObject; dx, dy: Integer); function Get3DConnectorByConnector(aConn: TConnectorObject): T3DConnector; function Get3DLineByOrtholine(aLine: TOrthoLine): T3DLine; function IsConnectorMoved(aConn: T3DConnector): Boolean; function GetLineOrder(aLine: TGLLines): TLineOrder; function GetFullConnectorInfo(aObj: TGLFreeForm): string; function GetEmptyConnectorInfo(aObj: TGLCube): string; function GetLineInfo(aObj: TGLLines): string; function GetPosWithGridStep(aPos: Double): Double; procedure ApplyCutting; procedure ApplyScsModel; procedure ValidateActiveControl; procedure CreateModel; procedure CreateTopNode; procedure CreateTopSCSNode; function GetKoefMoveCam: Double; function GetPointsForNormal(arr: T3DPointArray): T3DPointArray; function GetPointsForNormalVector(arr: T3DPointArray): T3DPointArray; // Tolik 15/01/2020 function GLNodesTo3DCoords(aNodes: TGLNodes; aYAsZ: Boolean=false): T3DPointArray; {$IF Defined(ES_GRAPH_SC)} Procedure ChangeAllFiguresWithPoint(aPoint:T3DPoint; Coord: TCoord); Procedure ChangeAllFiguresConnectedToModifyLine(aLine: TGLLines); {$IFEND} end; my_Tube = class(TObject) My_cl: TGLCylinder; end; var frm3D: Tfrm3D; glSide11, glSide21, glSide12, glSide22: TGLSpaceText; glSpliter: TGLLines; glCubeSpliter, glCubeSpliter1, glCubeSpliter2: TGLCube; glConn1, glConn2: TGLCube; glCursorObject: TGLCustomSceneObject; glCursorLine: TGLLines; rpos1, rpos2: T3DPoint; ModelObjectsList: TList; NoMoveEvent: Boolean = False; SelObjColor, ObjColor: Tvector4f; behav: TGLBFPSMovement; yangle:double=90; xangle:double=0; // FTextures: TStringList; FisCreate3DS: Boolean; FCurrObject: TObject; StartDragX: Integer = -999; StartDragY: Integer = -999; Gtx: double; //Alex(20.12.2010) FirstCameraPosIsSet:Boolean = False; FCorrect3DModelMaterialForObj: Boolean = true; implementation uses U_BaseConstants, U_Constants, U_BaseCommon, U_Common, U_SCSComponent, u_main, PCDrawBox, U_ProtectionCommon, fplan, USCS_Main, U_ArchCommon, {Tolik 27/11/2518 -*- } U_SetTransparency, U_TrunkSCS;{, DrawObjects;} {$R *.dfm} // Tolik 25/12/2019 -- //function comparePoint(aCPoint1, ACPoint2: TDoublePoint): Boolean; function comparePoint(aCPoint1, ACPoint2: TDoublePoint; aDelta: Double): Boolean; var currDelta: Double; begin result := False; try currDelta := ABS(aCPoint1.x - aCPoint2.x); if CompareValue(currDelta, aDelta) = -1 then begin currDelta := ABS(aCPoint1.y - aCPoint2.y); if CompareValue(currDelta, aDelta) = -1 then Result := True else result := False; end; except on e: Exception do result := False; end; { if CompareValue(aCPoint1.x, aCPoint2.x) = 0 then begin if CompareValue(aCPoint1.y, aCPoint2.y) = 0 then Result := true else Result := False; end else Result := False;} end; function compare3DPoint(aCPoint1, ACPoint2: T3DPoint; aDelta: Double): Boolean; var currDelta: Double; begin Result := True; try currDelta := ABS(aCPoint1.x - aCPoint2.x); if CompareValue(currDelta, aDelta) = 1 then begin currDelta := ABS(aCPoint1.z - aCPoint2.z); if CompareValue(currDelta, aDelta) = 1 then Result := False; end; except on e: Exception do result := True; end; { if CompareValue(aCPoint1.x, aCPoint2.x) = 0 then begin if CompareValue(aCPoint1.y, aCPoint2.y) = 0 then Result := true else Result := False; end else Result := False;} end; Function getLineComponColor(aLineComponent: TSCSComponent): Tvector4f; var LineComponProp: PProperty; NBProp: TNBProperty; LineComponColor: Integer; begin Result := ConvertWinColor(clGray); LineComponProp := aLineComponent.GetPropertyBySysName(pnOutDiametr); LineComponColor := aLineComponent.GetPropertyValueAsInteger(pnColor); if LineComponColor <> -1 then Result := ConvertWinColor(LineComponColor); end; // Tolik 11/10/2018 ********** TOpen3dsModelDialog *************** Constructor TOpen3dsModelDialog.Create(aOwner: TComponent); begin inherited Create(AOwner); //Filter := '3Ds files (*.3ds)|*.3DS'; Filter := '3Ds files (*.3ds)|*.3DS|Obj files (*.obj)|*.obj' ; gPanel := nil; GLCadencer:= nil; GLSceneViewer:= nil; GLScene:= nil; GLCamera:= nil; GLDummyCube:= nil; GLLightSource:= nil; GLPlane:= nil; end; function TOpen3dsModelDialog.Execute: Boolean; begin if NewStyleControls and not (ofOldStyleDialog in Options) then Template := 'DLGTEMPLATE' else Template := nil; Result := inherited Execute; end; destructor TOpen3dsModelDialog.Destroy; begin if GlScene <> nil then begin GLScene.Free; GLCadencer.Free; GLSceneViewer.Free; GPanel.Free; Inherited; end; end; Procedure TOpen3dsModelDialog.CheckKeyPressed(Sender: TObject; const deltaTime, newTime: Double); var DialogHandle: HWND; begin // Tolik 02/01/2020 Application.ProcessMessages; // if isKeyDown(VK_ESCAPE) then begin TglCadencer(Sender).Enabled := False; DialogHandle := GetParent(Self.Handle); SendMessage(DialogHandle, WM_CLOSE, 0,0); end; //Движение вперед по клавишам ‘ц’ и’ w’ if IsKeyDown(CHR(ORD('w'))) then GLCamera.Move(2* deltaTime) else //Движение назад по клавишам ‘ы’ и ‘s’ if IsKeyDown(ORD('s')) then GLCamera.Move(-2* deltaTime) else //Поворот влево по клавишам ‘ф’ и’ a’ if IsKeyDown(ORD('a')) then GLCamera.slide(-2* deltaTime) else //Поворот вправо по клавишам ‘в’ и ‘d’ if IsKeyDown(ORD('d')) then GLCamera.slide(2* deltaTime) else //Движение вверх по клавишам ‘u’ и ‘г’ if IsKeyDown(ORD('u')) then GLCamera.Lift(0.01) else //Движение вниз по клавишам ‘n’ и ‘т’ if IsKeyDown(ORD('n')) then GLCamera.Lift(-0.01); //Движение вперед по клавишам ‘ц’ и’ w’ {if (IsKeyDown('ц') OR IsKeyDown('w')) then GLCamera.Move(2* deltaTime); //Движение назад по клавишам ‘ы’ и ‘s’ if (IsKeyDown('ы') OR IsKeyDown('s')) then GLCamera.Move(-2* deltaTime); //Поворот влево по клавишам ‘ф’ и’ a’ if (IsKeyDown('ф') OR IsKeyDown('a')) then GLCamera.slide(-2* deltaTime); //Поворот вправо по клавишам ‘в’ и ‘d’ if (IsKeyDown('в') OR IsKeyDown('d')) then GLCamera.slide(2* deltaTime); //Движение вверх по клавишам ‘u’ и ‘г’ if (IsKeyDown('u')) OR IsKeyDown('г') then GLCamera.Lift(0.01); //Движение вниз по клавишам ‘n’ и ‘т’ if (IsKeyDown('n')) OR IsKeyDown('т') then GLCamera.Lift(-0.01); } // Tolik 22/07/2021 -- TglCadencer(Sender).Enabled := False; Sleep(100); Application.ProcessMessages; TglCadencer(Sender).Enabled := True; // end; procedure TOpen3dsModelDialog.PreviewClick(Sender: TObject); begin {} end; procedure TOpen3dsModelDialog.PreviewKeyPress(Sender: TObject; var Key: Char); begin if Key = #27 then TForm(Sender).Close; end; procedure TOpen3dsModelDialog.DoShow; var PreviewRect, StaticRect: TRect; begin inherited DoShow; end; Procedure TOpen3dsModelDialog.Initialize; var FullName: string; WinPos: TRect; DialogHandle: THandle; PreviewRect, StaticRect: TRect; begin FullName := FileName; //Self.Name := 'OpnDLG'; DialogHandle := GetParent(Self.Handle); Windows.GetWindowRect(DialogHandle, WinPos); StaticRect := GetStaticRect; GetClientRect(Handle, PreviewRect); GPanel := TPanel.Create(Self); GPanel.ParentWindow := Self.Handle; GPanel.Width := PreviewRect.Right - StaticRect.Right - 4;//160; GPanel.Height := StaticRect.Bottom - StaticRect.Top - 10; //280; GPanel.Top := StaticRect.Top + 5;//35; GPanel.Left := StaticRect.Right + 2; //556; GPanel.BorderStyle := bsNone; GPanel.BevelInner := bvNone; GPanel.BevelOuter := bvNone; GPanel.TabStop := False; GLScene := TglScene.Create(GPanel); GLCamera := TGLCamera(GLScene.Objects.AddNewChild(TGLCamera)); GLCadencer := TGLCadencer.Create(GPanel); GLCadencer.OnProgress := CheckKeyPressed; glCadencer.Scene := GLScene; GLSceneViewer := TGLSceneViewer.Create(GPanel); GLSceneViewer.Parent := GPanel; GLSceneViewer.Top := 2; GLSceneViewer.Height := GPanel.Height - 10; GLSceneViewer.Left := 2; GLSceneViewer.Width := GPanel.Width - 4; GlSceneViewer.Camera := GLCamera; GLDummyCube := TGLDummyCube(GLScene.Objects.AddNewChild(TGLDummyCube)); GLLightSource := TGLLightSource(GLScene.Objects.AddNewChild(TGLLightSource)); GLCamera.TargetObject := GLDummyCube; SetFocus(Self.Handle); end; procedure TOpen3dsModelDialog.Get3DSObjectBounds(var Min, Max: T3DPoint; aObject: TGLFreeForm; aReplaceYZ: Boolean = False); var i: Integer; Bounds: THmgBoundingBox; Coord: TVector4f; begin try Bounds := aObject.BoundingBox; for i := 0 to 7 do begin Coord := Bounds[i]; if i = 0 then begin if aReplaceYZ then begin Min.x := Coord[0]; Min.z := Coord[1]; Min.y := Coord[2]; Max.x := Coord[0]; Max.z := Coord[1]; Max.y := Coord[2]; end else begin Min.x := Coord[0]; Min.y := Coord[1]; Min.z := Coord[2]; Max.x := Coord[0]; Max.y := Coord[1]; Max.z := Coord[2]; end; end else begin if aReplaceYZ then begin if Coord[0] < Min.x then Min.x := Coord[0]; if Coord[0] > Max.x then Max.x := Coord[0]; if Coord[1] < Min.z then Min.z := Coord[1]; if Coord[1] > Max.z then Max.z := Coord[1]; if Coord[2] < Min.y then Min.y := Coord[2]; if Coord[2] > Max.y then Max.y := Coord[2]; end else begin if Coord[0] < Min.x then Min.x := Coord[0]; if Coord[0] > Max.x then Max.x := Coord[0]; if Coord[1] < Min.y then Min.y := Coord[1]; if Coord[1] > Max.y then Max.y := Coord[1]; if Coord[2] < Min.z then Min.z := Coord[2]; if Coord[2] > Max.z then Max.z := Coord[2]; end; end; end; except // on E: Exception do AddExceptionToLogEx('Tfrm3D.Get3DSObjectBounds', E.Message); end; end; procedure TOpen3dsModelDialog.DoSelectionChange; var FullName: string; ValidPicture: Boolean; WinPos: TRect; DialogHandle: THandle; bt: TButton; function ValidFile(const FileName: string): Boolean; begin Result := GetFileAttributes(PChar(FileName)) <> $FFFFFFFF; end; Function GetObjPos: TDoublePoint; begin Result.x := 0; Result.y := 0; Result.z := 0; if (ObjectMin.x < 0) then if ObjectMax.x > 0 then begin Result.x := ObjectMin.x + ObjectMax.x; end; if (ObjectMin.y < 0) then if ObjectMax.y > 0 then begin Result.y := ObjectMin.y + ObjectMax.y; end; if (ObjectMin.z < 0) then if ObjectMax.z > 0 then begin Result.z := ObjectMin.z + ObjectMax.z; end; end; begin FullName := FileName; //Self.Name := 'OpnDLG'; if FullName <> FSavedFilename then begin FSavedFilename := FullName; ValidPicture := FileExists(FullName) and ValidFile(FullName); if ValidPicture then try if glScene = nil then Initialize; GLDummyCube.DeleteChildren; glObjClass := TGLFreeForm; glObject := TGLFreeForm(GLDummyCube.addNewChild(glObjClass)); glObject.LoadFromFile(FullName); glObject.ShowAxes := True; glObject.Material.MaterialOptions := []; glObject.Material.Texture.Disabled := False; GLCamera.TargetObject := glObject; Get3DSObjectBounds(ObjectMin, ObjectMax, glObject); ObjSize.x := abs(ObjectMax.x - ObjectMin.x); ObjSize.y := abs(ObjectMax.y - ObjectMin.y); ObjSize.z := abs(ObjectMax.z - ObjectMin.z); ObjPos := GetObjPos; {if ((ObjPos.x = 0) and (ObjPos.y = 0) and (ObjPos.z = 0)) then begin glObject.Position.x := 3; glObject.Position.y := 2; glObject.Position.z := 2; end else begin glObject.Position.x := ObjPos.x; glObject.Position.y := ObjPos.y; glObject.Position.z := ObjPos.z; end;} {SetPos.x := GLSceneViewer.Width/ObjSize.x; SetPos.y := GLSceneViewer.Height/ObjSize.y; SetPos.z := 200/ObjSize.z;} SetPos.x := 160/ObjSize.x; SetPos.y := GLSceneViewer.Width/ObjSize.y; SetPos.z := GLSceneViewer.Height/2/ObjSize.z; GWidth := SetPos.x; if CompareValue(GWidth, SetPos.y) = 1 then GWidth := SetPos.y; if CompareValue(GWidth, SetPos.z) = 1 then GWidth := SetPos.z; glObject.Scale.X := GWidth/100; glObject.Scale.y := GWidth/100; glObject.Scale.z := GWidth/100; if ((ObjPos.x = 0) and (ObjPos.y = 0) and (ObjPos.z = 0)) then begin glObject.Position.x := 3; glObject.Position.y := 2; glObject.Position.z := 2; end else begin glObject.Position.x := ObjPos.x; glObject.Position.y := ObjPos.y; glObject.Position.z := ObjPos.z; end; glObject.RotateAbsolute(0, 0, 90); GPanel.SetFocus; except ValidPicture := False; end; end; inherited DoSelectionChange; SetFocus(Self.Handle); end; //--------------------------------------------------------------------- // // Classic mouse movement bits // {$IF Defined(ES_GRAPH_SC)} function GetCornerIndex(Selections: TList): integer; var i: integer; begin result := 0; for i := 0 to Selections.Count - 1 do if TObject(TTreeNode(TGLBaseSceneObject(Selections[i]).TagObject).Data) is T3dCorner then begin Result := i; break; end; end; {$IFEND} procedure Tfrm3D.GLSceneViewerMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var Obj: TGLBaseSceneObject; xStr: string; // Tolik -- 11/12/2018 -- ParentNode: TTreeNode; FullConn: T3DConnector; MovedObjAbsolutePos: Tvector4F; function GetParentConnector(aNode: TTreeNode): T3DConnector; begin Result := Nil; if aNode.Parent <> nil then if TObject(aNode.data).ClassName = 'T3DConnector' then Result := T3DConnector(aNode.data) else begin if ((TObject(aNode.Parent.data).ClassName = 'TF_CAD') or (TObject(aNode.Parent.data).ClassName = 'T3DModel')) then exit else Result := GetParentConnector(aNode.Parent); end; end; function Check3DComponentMoved: Boolean; begin Result := False; if ssShift in Shift then begin if FMovedObject <> nil then if FMovedObject.TagObject <> nil then if TTreeNode(FMovedObject.TagObject).Data <> nil then if TObject(TTreeNode(FMovedObject.TagObject).Data).ClassName = 'T3DComponent' then if FMovedObject.Parent <> nil then if FMovedObject.Parent.ClassName = 'TGLDummyCube' then if FMovedObject.Parent <> DummyCube then if FMovedObject.Parent.Parent <> nil then if FMovedObject.Parent.Parent.ClassName = 'TGLDummyCube' then if FMovedObject.Parent.Parent <> DummyCube then begin Result := True; FMovedComponent := FMovedObject; end; end; end; // begin FMovedComponent := Nil; mx := x; my := y; mdx := x; mdy := y; {if GLSceneViewer.Camera = FirstPersonCamera then exit;} if FMode = F3DFirstPerson then exit; Obj := MyGetPickedobject(X, Y); //if Button = mbLeft then if TglMouseButton(Button) = mbLeft then begin if FToolMode = tmCut then begin Obj := GlsceneViewer.Buffer.GetPickedobject(X, Y); if Obj = glCubeSpliter then begin glCursorObject.Position.x := glCubeSpliter.Position.x; glCursorObject.Position.y := glCubeSpliter.Position.y; glCursorObject.Position.z := glCubeSpliter.Position.z; FResizer := True; end; if Obj = glCubeSpliter1 then begin glCursorObject.Position.x := glCubeSpliter1.Position.x; glCursorObject.Position.y := glCubeSpliter1.Position.y; glCursorObject.Position.z := glCubeSpliter1.Position.z; FResizer := True; end; if Obj = glCubeSpliter2 then begin glCursorObject.Position.x := glCubeSpliter2.Position.x; glCursorObject.Position.y := glCubeSpliter2.Position.y; glCursorObject.Position.z := glCubeSpliter2.Position.z; FResizer := True; end; end; if FToolMode = tmSelect then begin // Move 3ds Object if (Obj <> nil) and (Obj is TGLFreeForm) then if (FSelection.Count = 1) and (TGLBaseSceneObject(FSelection[0]) = Obj) then //Tolik 11/12/2018 -- //FMovedObject := TGLFreeForm(Obj); begin FMovedObject := TGLFreeForm(Obj); if FMovedObject.TagObject <> nil then begin if TObject(TTreeNode(FMovedObject.TagObject).Data).ClassName = 'T3DConnector' then FullConn := T3DConnector(TTreeNode(FMovedObject.TagObject).Data) else FullConn := GetParentConnector(TTreeNode(FMovedObject.TagObject)); if FullConn <> nil then begin if FullConn.FGLObject <> nil then begin if TGLFreeForm(FullConn.FGLObject1) <> nil then FMovedFullConnector := TGLFreeForm(FullConn.FGLObject1) else FMovedFullConnector := TGLFreeForm(FullConn.FGLObject); if Check3DComponentMoved then begin MovedObjAbsolutePos := FMovedObject.AbsolutePosition; glCursorObject.Position.x := MovedObjAbsolutePos[0]; glCursorObject.Position.y := MovedObjAbsolutePos[1]; glCursorObject.Position.z := MovedObjAbsolutePos[2]; MovedStartPos.x := MovedObjAbsolutePos[0]; MovedStartPos.y := MovedObjAbsolutePos[1]; MovedStartPos.z := MovedObjAbsolutePos[2]; { if (FMovedObject.Parent.Parent.Parent <> nil) and (FMovedObject.Parent.Parent.Parent <> DummyCube) then begin glCursorObject.Position.x := FMovedFullConnector.Position.x; glCursorObject.Position.y := FMovedFullConnector.Position.y; glCursorObject.Position.z := FMovedFullConnector.Position.z; MovedStartPos.x := FMovedFullConnector.Position.x; MovedStartPos.y := FMovedFullConnector.Position.y; MovedStartPos.z := FMovedFullConnector.Position.z; end else begin glCursorObject.Position.x := FMovedObject.Parent.Parent.Position.x; glCursorObject.Position.y := FMovedObject.Parent.Parent.Position.y; glCursorObject.Position.z := FMovedObject.Parent.Parent.Position.z; MovedStartPos.x := FMovedObject.Parent.Parent.Position.x; MovedStartPos.y := FMovedObject.Parent.Parent.Position.y; MovedStartPos.z := FMovedObject.Parent.Parent.Position.z; end; } { glCursorObject.Position.x := TVector4F(FMovedObject.Parent.Parent.AbsolutePosition).x; glCursorObject.Position.y := TVector4F(FMovedObject.Parent.Parent.AbsolutePosition).y; glCursorObject.Position.z := TVector4F(FMovedObject.Parent.Parent.AbsolutePosition).z; MovedStartPos.x := TVector4F(FMovedObject.Parent.Parent.AbsolutePosition).x; MovedStartPos.y := TVector4F(FMovedObject.Parent.Parent.AbsolutePosition).y; MovedStartPos.z := TVector4F(FMovedObject.Parent.Parent.AbsolutePosition).z; } end else begin glCursorObject.Position.x := FMovedFullConnector.Position.x; glCursorObject.Position.y := FMovedFullConnector.Position.y; glCursorObject.Position.z := FMovedFullConnector.Position.z; MovedStartPos.x := FMovedFullConnector.Position.x; MovedStartPos.y := FMovedFullConnector.Position.y; MovedStartPos.z := FMovedFullConnector.Position.z; end; StartDragX := X; StartDragY := Y; sbView.Caption := GetFullConnectorInfo(FMovedFullConnector); // if not (ssShift in Shift) then FMovedObject := nil; end; end; end; end; if (Obj <> nil) and (Obj is TGLFreeForm) then begin // Offset Connector Model if (ssCtrl in Shift) then begin if (FSelection.Count > 0) and (isConnectorObject(Obj)) then FOffsetObjects := True; end else // Move Connector Object begin if (FSelection.Count = 1) and (isConnectorObject(TGLBaseSceneObject(FSelection[0]), Obj)) then begin FMovedFullConnector := TGLFreeForm(Obj); glCursorObject.Position.x := FMovedFullConnector.Position.x; glCursorObject.Position.y := FMovedFullConnector.Position.y; glCursorObject.Position.z := FMovedFullConnector.Position.z; MovedStartPos.x := FMovedFullConnector.Position.x; MovedStartPos.y := FMovedFullConnector.Position.y; MovedStartPos.z := FMovedFullConnector.Position.z; StartDragX := X; StartDragY := Y; sbView.Caption := GetFullConnectorInfo(FMovedFullConnector); end; end; end; // Move Clean Connector if (Obj <> nil) and (Obj is TGLCube) then if (Obj = glConn1) or (Obj = glConn2) then begin FMovedEmptyConnector := TGLCube(Obj); glCursorObject.Position.x := FMovedEmptyConnector.Position.x; glCursorObject.Position.y := FMovedEmptyConnector.Position.y; glCursorObject.Position.z := FMovedEmptyConnector.Position.z; MovedStartPos.x := FMovedEmptyConnector.Position.x; MovedStartPos.y := FMovedEmptyConnector.Position.y; MovedStartPos.z := FMovedEmptyConnector.Position.z; StartDragX := X; StartDragY := Y; sbView.Caption := GetEmptyConnectorInfo(FMovedEmptyConnector); end; // Move Line Object if (Obj <> nil) and (Obj is TGLLines) then {$IF Defined(ES_GRAPH_SC)} if FSelection.Count <= 3 then if isLineObject(TGLBaseSceneObject(FSelection[GetCornerIndex(FSelection)]), Obj) then {$ELSE} if FSelection.Count = 1 then if isLineObject(TGLBaseSceneObject(FSelection[0]), Obj) then {$IFEND} begin FMovedLine := TGLLines(Obj); glCursorLine.Nodes[0].X := FMovedLine.Nodes[0].X; glCursorLine.Nodes[0].Y := FMovedLine.Nodes[0].Y; glCursorLine.Nodes[0].Z := FMovedLine.Nodes[0].Z; glCursorLine.Nodes[1].X := FMovedLine.Nodes[1].X; glCursorLine.Nodes[1].Y := FMovedLine.Nodes[1].Y; glCursorLine.Nodes[1].Z := FMovedLine.Nodes[1].Z; MovedStartPos1.x := FMovedLine.Nodes[0].X; MovedStartPos1.y := FMovedLine.Nodes[0].Y; MovedStartPos1.z := FMovedLine.Nodes[0].Z; MovedStartPos2.x := FMovedLine.Nodes[1].X; MovedStartPos2.y := FMovedLine.Nodes[1].Y; MovedStartPos2.z := FMovedLine.Nodes[1].Z; StartDragX := X; StartDragY := Y; sbView.Caption := GetLineInfo(FMovedLine); end; //Tolik 27/11/2018-- if Obj <> nil then if TGlBaseSceneObject(Obj).TagObject <> nil then if TTreeNode(TGlBaseSceneObject(Obj).TagObject).Data <> nil then begin if TObject(TTreeNode(TGlBaseSceneObject(Obj).TagObject).Data).ClassName = 'T3DLineComponent' then begin if TTreeNode(TGlBaseSceneObject(Obj).TagObject).Parent <> nil then begin if TObject(TTreeNode(TGlBaseSceneObject(Obj).TagObject).Parent.Data).ClassName = 'T3DLine' then begin Obj := TGlBaseSceneObject(T3DLine(TTreeNode(TGlBaseSceneObject(Obj).TagObject).Parent.Data).FGLObject); if Obj <> nil then if Obj.ClassNAme = 'TGLLines' then begin FMovedLine := TGLLines(Obj); glCursorLine.Nodes[0].X := FMovedLine.Nodes[0].X; glCursorLine.Nodes[0].Y := FMovedLine.Nodes[0].Y; glCursorLine.Nodes[0].Z := FMovedLine.Nodes[0].Z; glCursorLine.Nodes[1].X := FMovedLine.Nodes[1].X; glCursorLine.Nodes[1].Y := FMovedLine.Nodes[1].Y; glCursorLine.Nodes[1].Z := FMovedLine.Nodes[1].Z; MovedStartPos1.x := FMovedLine.Nodes[0].X; MovedStartPos1.y := FMovedLine.Nodes[0].Y; MovedStartPos1.z := FMovedLine.Nodes[0].Z; MovedStartPos2.x := FMovedLine.Nodes[1].X; MovedStartPos2.y := FMovedLine.Nodes[1].Y; MovedStartPos2.z := FMovedLine.Nodes[1].Z; StartDragX := X; StartDragY := Y; sbView.Caption := GetLineInfo(FMovedLine); end; end; end; end; if TObject(TTreeNode(TGlBaseSceneObject(Obj).TagObject).Data).ClassName = 'T3DComponent' then begin if TTreeNode(TGlBaseSceneObject(Obj).TagObject).Parent <> nil then begin if TObject(TTreeNode(TGlBaseSceneObject(Obj).TagObject).Parent.Data).ClassName = 'T3DConnector' then begin Obj := TGlBaseSceneObject(T3DConnector(TTreeNode(TGlBaseSceneObject(Obj).TagObject).Parent.Data).FGLObject); if Obj <> nil then begin if Obj.ClassNAme = 'T3DConnector' then begin FMovedFullConnector := TGLFreeForm(Obj); glCursorObject.Position.x := FMovedFullConnector.Position.x; glCursorObject.Position.y := FMovedFullConnector.Position.y; glCursorObject.Position.z := FMovedFullConnector.Position.z; MovedStartPos.x := FMovedFullConnector.Position.x; MovedStartPos.y := FMovedFullConnector.Position.y; MovedStartPos.z := FMovedFullConnector.Position.z; StartDragX := X; StartDragY := Y; sbView.Caption := GetFullConnectorInfo(FMovedFullConnector); end; end; end; end; end; end; // end; end else //if Button = mbRight then if TglMouseButton(Button) = mbRight then begin if (Obj <> nil) and (Obj is TGLFreeForm) then if (FSelection.Count = 1) and (TGLBaseSceneObject(FSelection[0]) = Obj) then begin FRotatedObject := TGLFreeForm(Obj); last_x := x; last_y := y; end; if (Obj <> nil) and (Obj is TGLFreeForm) then if isConnectorObject(Obj) then begin FRotatedObjects := True; last_x := x; last_y := y; end; end; end; {$IF Defined(ES_GRAPH_SC)} Procedure Tfrm3D.ChangeAllFiguresConnectedToModifyLine(aLine: TGLLines); //Процедура перерисовки фигур, присоедененных к клинии aLine var j,k: integer; //xNode: TtreeNode; GLPoint: T3DPoint; aLinePoints: T3DPointArray; GlNode: TGLNodes; GlLineNode: TGLLinesNodes; xGLObject: TGLBaseSceneObject; xSide: T3dSide; xLine: T3DWall; xCorner: T3dCorner; begin /////////////////////////// ROOF ///////////////////////////// if (StartDragX = -999) and (StartDragY = -999) then begin SetLength(aLinePoints,2); //Устанавливаем длину массива в 2 //Заполняем массив точек aLinePoints[0] := DoublePoint(aLIne.Nodes[0].X,aLIne.Nodes[0].Y,aLIne.Nodes[0].Z); aLinePoints[1] := DoublePoint(aLIne.Nodes[1].X,aLIne.Nodes[1].Y,aLIne.Nodes[1].Z); //Проходимся по всем элементам, которые видны в 3Д for j := 0 to DummyCube.Count - 1 do begin xLine := nil; xCorner := nil; if DummyCube.Children[j] is TGLPolygon then //Если фигура - полигон begin GlNode := TGLPolygon(DummyCube.Children[j]).Nodes; //Проходим по всем точкам фигуры for k := 0 to GlNode.Count - 1 do begin GLPoint := DoublePoint(GlNode[k].X,GlNode[k].y,GlNode[k].z); //Преобразовываем точки фигуры в удобный вид if EQDPZ(GLPoint,MovedStartPos1) then //Если нашли требуемую точку begin if TOBject(TTreeNode(TGLPolygon(DummyCube.Children[j]).TagObject).Data) is T3DSide then begin xSide := T3DSide(TTreeNode(TGLPolygon(DummyCube.Children[j]).TagObject).Data); xGLObject := TGLBaseSceneObject(xSide.FGLObject); end; //Меняем найденной точке координаты 3Д///// GlNode[k].X := aLinePoints[0].x; // GlNode[k].Y := aLinePoints[0].y; // GlNode[k].Z := aLinePoints[0].z; // //Меняе координаты элемента в дереве///////////////// xSide.FGLPoints[k] := aLinePoints[0]; // xSide.FPoints[k].X := aLinePoints[0].x / Factor; // xSide.FPoints[k].Y := aLinePoints[0].y / Factor; // xSide.FPoints[k].Z := aLinePoints[0].z / Factor; // end; //все то же самое, что и с точкой 1 if EQDPZ(GLPoint,MovedStartPos2) then begin if TOBject(TTreeNode(TGLPolygon(DummyCube.Children[j]).TagObject).Data) is T3DSide then begin xSide := T3DSide(TTreeNode(TGLPolygon(DummyCube.Children[j]).TagObject).Data); xGLObject := TGLBaseSceneObject(xSide.FGLObject); end; GlNode[k].X := aLinePoints[1].x; GlNode[k].Y := aLinePoints[1].y; GlNode[k].Z := aLinePoints[1].z; xSide.FGLPoints[k] := aLinePoints[1]; xSide.FPoints[k].X := aLinePoints[1].x / Factor; xSide.FPoints[k].Y := aLinePoints[1].y / Factor; xSide.FPoints[k].Z := aLinePoints[1].z / Factor; end; end; end; if DummyCube.Children[j] is TGLLines then //Если фигура - это линия begin GlLineNode := TGLLines(DummyCube.Children[j]).Nodes; for k := 0 to GlLineNode.Count - 1 do begin GLPoint := DoublePoint(GlLineNode[k].X,GlLineNode[k].Y,GlLineNode[k].Z); if EQDPZ(GLPoint,MovedStartPos1) then begin //Линии могут бить двух видов: угол - Это T3DCorner, Грань крыши - это T3DWall if TOBject(TTreeNode(TGLPolygon(DummyCube.Children[j]).TagObject).Data) is T3DWall then begin xLine := T3DWall(TTreeNode(TGLPolygon(DummyCube.Children[j]).TagObject).Data); xGLObject := TGLBaseSceneObject(xLine.FGLObject); end; if TOBject(TTreeNode(TGLPolygon(DummyCube.Children[j]).TagObject).Data) is T3DCorner then begin xCorner := T3DCorner(TTreeNode(TGLPolygon(DummyCube.Children[j]).TagObject).Data); xGLObject := TGLBaseSceneObject(xCorner.FGLObject); end; GlLineNode[k].X := aLinePoints[0].x; GlLineNode[k].Y := aLinePoints[0].y; GlLineNode[k].Z := aLinePoints[0].z; if TObject(TTreenode(TGLLines(DummyCube.Children[j]).TagObject).Data) is T3dCorner then begin GlLineNode[k+1].X := aLinePoints[0].x; GlLineNode[k+1].Y := aLinePoints[0].Y + (1 * Factor + FDeltaZ); GlLineNode[k+1].Z := aLinePoints[0].z; end; if xLine <> nil then begin xLine.FGLPOints[k] := aLinePoints[0]; xLine.FPoints[k].x := aLinePoints[0].x / Factor; xLine.FPoints[k].y := aLinePoints[0].y / Factor; xLine.FPoints[k].z := aLinePoints[0].z / Factor; end; if xCorner <> nil then begin xCorner.FGLPOints[k] := aLinePoints[0]; xCorner.FPoints.x := aLinePoints[0].x / Factor; xCorner.FPoints.y := aLinePoints[0].y / Factor; xCorner.FPoints.z := aLinePoints[0].z / Factor; end; end; if EQDPZ(GLPoint,MovedStartPos2) then begin if TOBject(TTreeNode(TGLPolygon(DummyCube.Children[j]).TagObject).Data) is T3DWall then begin xLine := T3DWall(TTreeNode(TGLPolygon(DummyCube.Children[j]).TagObject).Data); xGLObject := TGLBaseSceneObject(xLine.FGLObject); end; if TOBject(TTreeNode(TGLPolygon(DummyCube.Children[j]).TagObject).Data) is T3DCorner then begin xCorner := T3DCorner(TTreeNode(TGLPolygon(DummyCube.Children[j]).TagObject).Data); xGLObject := TGLBaseSceneObject(xCorner.FGLObject); end; GlLineNode[k].X := aLinePoints[1].x; GlLineNode[k].Y := aLinePoints[1].y; GlLineNode[k].Z := aLinePoints[1].z; if TObject(TTreenode(TGLLines(DummyCube.Children[j]).TagObject).Data) is T3dCorner then begin GlLineNode[k+1].X := aLinePoints[1].x; GlLineNode[k+1].Y := aLinePoints[1].Y + (1 * Factor + FDeltaZ); GlLineNode[k+1].Z := aLinePoints[1].z; end; if xLine <> nil then begin xLine.FGLPOints[k] := aLinePoints[1]; xLine.FPoints[k].x := aLinePoints[1].x / Factor; xLine.FPoints[k].y := aLinePoints[1].y / Factor; xLine.FPoints[k].z := aLinePoints[1].z / Factor; end; if xCorner <> nil then begin xCorner.FGLPOints[k] := aLinePoints[1]; xCorner.FPoints.x := aLinePoints[1].x / Factor; xCorner.FPoints.y := aLinePoints[1].y / Factor; xCorner.FPoints.z := aLinePoints[1].z / Factor; end; end; end; end; end; end; ////////////////////////// \ROOF ///////////////////////////// end; {$IFEND} procedure Tfrm3D.GLSceneViewerMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); var i, j, dx, dy : Integer; v : TVector; mp: TPoint; ip : TVector; tileX, tileY : Integer; shiftDown : Boolean; mip, translateOffset : TVector; translating : Boolean; koefcam: Double; //04.01.2012 single; //vx,vz: single; spd: Double; //04.01.2012 single; dw,dh: integer; xObj: TGLBaseSceneObject; VX, VY: TVector; Camera: TGLCamera; glObject, glObject1: TGLFreeForm; xObject: T3DSObject; AngX, AngY, AngZ: Double; xConn: T3DConnector; VX3, VY3, V3: TVector3f; begin if NoMoveEvent then begin NoMoveEvent := False; mx := x; my := y; end; shiftDown:=(IsKeyDown(VK_LSHIFT) or IsKeyDown(VK_RSHIFT)); dx := mx - x; dy := my - y; if (dx = 0) and (dy = 0) then exit; // Tolik 11/02/2020 if FMode = F3DFirstPerson then exit; { if GLSceneViewer.Camera = FirstPersonCamera then exit;} Camera := GLSceneViewer.Camera; // SELECT MODE //if FToolMode = tmSelect then if not FResizer then begin if ssLeft in Shift then begin // Do Move 3ds Object if FMovedObject <> nil then begin GLSceneViewer.Cursor := crHandPoint; VY := VectorMake(VectorPerpendicular(YVector, VectorNormalize(VectorSubtract(Camera.Position.AsAffineVector, MainCenter.Position.AsAffineVector)))); VX := VectorCrossProduct(VY, VectorNormalize( VectorSubtract(Camera.Position.AsVector, MainCenter.Position.AsVector))); NormalizeVector(VY); NormalizeVector(VX); FMovedObject.Position.Translate(VectorCombine(VX, VY, -dx * 0.132 * Camera.DistanceToTarget / Camera.FocalLength, dy * 0.132 * Camera.DistanceToTarget / Camera.FocalLength)); end // Do Move Fulll Connector else if FMovedFullConnector <> nil then begin if CanDrag(FMovedFullConnector, X, Y) then Trace3DConnector(FMovedFullConnector, dx, dy); end // Do Move Empty Connector else if FMovedEmptyConnector <> nil then begin if CanDrag(FMovedEmptyConnector, X, Y) then Trace3DConnector(FMovedEmptyConnector, dx, dy); end // Do Move Line else if FMovedLine <> nil then begin if CanDrag(FMovedLine, X, Y) then Trace3DLine(FMovedLine, dx, dy); end // Do Offset Connector Model else if (ssCtrl in Shift) and FOffsetObjects then // ********************* Offset ****************************************** begin GLSceneViewer.Cursor := crHandPoint; VY := VectorMake(VectorPerpendicular(YVector, VectorNormalize(VectorSubtract(Camera.Position.AsAffineVector, MainCenter.Position.AsAffineVector)))); VX := VectorCrossProduct(VY, VectorNormalize( VectorSubtract(Camera.Position.AsVector, MainCenter.Position.AsVector))); NormalizeVector(VY); NormalizeVector(VX); for i := 0 to FSelection.Count - 1 do begin glObject := TGLFreeForm(FSelection[i]); {$IF Defined(ES_GRAPH_SC)} if TObject(TTreeNode(glObject.tagObject).Data) is T3DConnector then begin xConn := T3DConnector(TTreeNode(glObject.tagObject).Data); glObject1 := TGLFreeForm(xConn.FGLObject1); glObject1.Position.Translate(VectorCombine(VX, VY, -dx * 0.132 * Camera.DistanceToTarget / Camera.FocalLength, dy * 0.132 * Camera.DistanceToTarget / Camera.FocalLength)); end; {$ELSE} xConn := T3DConnector(TTreeNode(glObject.tagObject).Data); glObject1 := TGLFreeForm(xConn.FGLObject1); glObject1.Position.Translate(VectorCombine(VX, VY, -dx * 0.132 * Camera.DistanceToTarget / Camera.FocalLength, dy * 0.132 * Camera.DistanceToTarget / Camera.FocalLength)); {$IFEND} end; end // ********************* Offset ****************************************** else begin if GLSceneViewer.Camera = GLCamera then begin GLSceneViewer.Camera.MoveAroundTarget(my - y, mx - x); //GLLightFirstPerson.MoveTo(GLSceneViewer.Camera); end; //Alex(17.12.2010) Закоментировал движение камеры мышкой при виде от первого лица {else if GLSceneViewer.Camera = GLCameraFirstPerson then begin GLSceneViewer.Camera.MoveAroundTarget(my - y, mx - x); //GLSceneViewer.Camera.pitch(my - y); //DummyCube.Turn(mx - x); //GLSceneViewer.Camera.Turn(my - y); //GLSceneViewer.Camera.Roll(mx - x); end; } end; end else //Alex(22.12.2010) Если FirstPerson то не перемещаем if ((ssRight in Shift) and (GLSceneViewer.Camera <> FirstPersonCamera)) then begin // ********************* Rotate ****************************************** if (FRotatedObject <> nil) then begin DoRotate3dsObject(Shift, X, Y); end else if FRotatedObjects then begin DoRotateConnectorObjects(Shift, X, Y); end // ********************* Rotate ****************************************** else begin if GLSceneViewer.Camera.CameraStyle = csPerspective then koefcam := 0.12 else koefcam := 0.03; if GLSceneViewer.Camera.Position.Y < 0 then v := GLSceneViewer.Camera.ScreenDeltaToVectorXZ(-dx, -dy, koefcam * GLSceneViewer.Camera.DistanceToTarget / GLSceneViewer.Camera.FocalLength) else v := GLSceneViewer.Camera.ScreenDeltaToVectorXZ(-dx, dy, koefcam * GLSceneViewer.Camera.DistanceToTarget / GLSceneViewer.Camera.FocalLength); GLDummyCube1.Position.Translate(v); DummyCube.Position.Translate(v); TransCube.Position.Translate(v); //Alex(22.12.2010) FirstPerson.Position.Translate(v); GLSceneViewer.Camera.TransformationChanged; end; end; end; // Режим Разрезки (Resizing) if (FToolMode = tmCut) then begin // поиcк обьекта для ресайзинга if not FResizer then begin if Shift = [] then begin xObj := GLSceneViewer.Buffer.GetPickedobject(X, Y); if (xObj = glCubeSpliter) or (xObj = glCubeSpliter1) or (xObj = glCubeSpliter2) then GLSceneViewer.Cursor := crSizeAll else GLSceneViewer.Cursor := crDefault; end; end else // Движение ресайзинга begin VY := VectorMake(VectorPerpendicular(YVector, VectorNormalize(VectorSubtract(Camera.Position.AsAffineVector, MainCenter.Position.AsAffineVector)))); VX := VectorCrossProduct(VY, VectorNormalize( VectorSubtract(Camera.Position.AsVector, MainCenter.Position.AsVector))); NormalizeVector(VY); NormalizeVector(VX); glCursorObject.Position.Translate(VectorCombine(VX, VY, -dx * 0.132 * Camera.DistanceToTarget / Camera.FocalLength, dy * 0.132 * Camera.DistanceToTarget / Camera.FocalLength)); DoResize; end; end; mx := x; my := y; end; procedure Tfrm3D.UpdateFaces(Faces: TList; Yh: Double = 0); //const // clrBlack : TVector = (0, 0, 0, 1); var i, pCnt, pCntNormal, j, k, FigureID, glPointIndex: Integer; Face:TFaceRecord; glPoly:TGLPolyGon; glLine: TGLLines; glCube: TGLCube; glSphere: TGLSphere; glCenter: TGLDummyCube; glPipe: TGLPipe; p, p1, p2, p3, p4, p5, p6, p7, p8, normal: T3dPoint; TmpP: T3dPoint; tx,ty,tz,bx,by,bz,cx,cy,cz: Double; glObject: TGLBaseSceneObject; glObjClass: TGLSceneObjectClass; glObject1: TGLBaseSceneObject; glObjClass1: TGLSceneObjectClass; SCSCatalog: TSCSCatalog; xoffset, aScaleModel: Double; //04.01.2012 single; aColorModel: TVector4f; glWallSide, glFloor, glCeiling, glDoorSide, glWindowSide, glBalconDoorSide, glBalconWindowSide: TGLPolygon; gl3DSObject, glModelObject: TGLFreeForm; aColor: TVector4f; tmpdir, ImgName, ImgName1: string; WallCoords: array [0..5] of TVector3f; FloorCoords: array of TVector3f; NormalPoints: T3DPointArray; //19.06.2012 - Координаты для определения нормали BegCoordIndex: integer; xNode: TTreeNode; xSide: T3DSide; //это те обьекты полигонов и мэшей, которые добавляются в Faces и отрисовываются xObject: T3DSObject; //объекты с 3ds xConn: T3DConnector; //Конектор xLine: T3DLine; //Линия //**ROOF** ParentWallNOde,WallNode, CornerNode: TTreeNode; Wall: T3DWall; iWall, iModelCnt, iCorner: Integer; xCorner: T3DCorner; pArr: TDoublePointArr; isRoof,IsAperture: boolean; xNet:TNet; //*\ROOF** PrevxNode: TTreeNode; PrevxSide: T3DSide; Angle1, Angle2, ResAng: Double; dp1, dp2: TDoublePoint; pN, pN2, pP: TVector3f; //Alex(22.12.2010) xRoom: T3DRoom; RoomMin, RoomMax, RoomSize, SetPos, Scale: T3DPoint; // Tolik 03/05/2018 -- SubstrateFileName, PlanName: String; Cad, TmpCad: TF_Cad; TmpGLPlane: TGLPlane; MaxFloorHeight, MinFloorHeight, FloorHeight: Double; ListParams: TListParams; CadListIndex: Integer; SubRootNode, childNode: TTreeNode; currList: TSCSCatalog; // Tolik 18/09/2018 glCyl: TGlCylinder; xCyl: T3DTube; xBooblick: T3DBooblick; glBooblick: TGLTorus; Object3DModelLoaded: Boolean; // Tolik 13/10/2018 -- TempImg: TImage; //19.06.2012 - вернет координаты для определения нормали {function GetPointsForNormal(arr: T3DPointArray): T3DPointArray; var i, j: Integer; ChkPt, LineP1, LineP2: P3DPoint; ProjPoint: T3DPoint; ValidPt: Boolean; begin SetLength(Result, 0); for i := 0 to Length(arr) - 1 do begin ChkPt := @arr[i]; ValidPt := true; if Length(Result) >= 2 then begin // Проверяем есть ли такая уже for j := 0 to Length(Result) - 1 do if EQDP(ChkPt^, Result[j]) then begin ValidPt := false; Break; //// BREAK //// end; if ValidPt then begin // Если последняя добавленная в результаты на одной линии с добавляемой LineP1 := @Result[Length(Result)-1]; LineP2 := @Result[Length(Result)-2]; if IsPointInLine(LineP2^, ChkPt^, LineP1^, 1, 0) then begin ////Result[Length(Result)-1] := ChkPt^; LineP1^ := ChkPt^; ValidPt := false; end else // Если точка не налини, проверяем не рядом ли она, через проецирование ее на линию begin ProjPoint := LineP1^; PointToLineByAngle(LineP2^, ChkPt^, ProjPoint); if GetLineLength(LineP1^, ProjPoint) < 4 then begin //LineP1^ := ChkPt^; //ValidPt := false; end; end; end; end; if ValidPt then begin SetLength(Result, Length(Result) + 1); Result[Length(Result) - 1] := arr[i]; end; end; end;} // Tolik -- 13/10/2018 //function Load3DSModel(var aConn: T3DConnector; aNode: TTreeNode): Boolean; function Load3DSModel(var aConn: T3DConnector; aNode: TTreeNode): Boolean; type PMeshObject = ^TMeshObject; var ci: integer; ObjectMin, ObjectMax, RoomMin, RoomMax, ObjSize, RoomSize, SetPos, Scale, ObjPos: TDoublePoint; glObject, glObject1: TGlFreeForm; p, ModelOffset, ModelSize, ModelRotation: T3dPoint; SetScale: Double; F3dModelFileNameName: String; SelfNode, ParentNode: TTreeNode; ObjWidth, ObjHeight, ObjLength: Double; SCSConn: TConnectorObject; SCSCatalog: TSCSCatalog; SCSComponent: TSCSComponent; ConnCadList: TSCSList; ConnCad: TF_Cad; i, j, k : Integer; CanUse3DSize: Boolean; F3DCompon: T3dComponent; ModelScale: TGLCoordinates; ObjBCenter: TVector3F; ObjAbsBCenter: TVector4F; matL: TglMaterialLibrary; TextureName: String; ModelCount: Integer; // Models Count in PointObj ModelList: TList; LeftPoint, RightPoint, CenterPoint: Double; CPoint: TDoublePoint; ComponGroupObject, ComponGroupObject1, ComponGroupObject2: TGLDummyCube; //ComponGroupObject: TGLFreeForm; AbsVector, AbsUpVector: TVector4F; ObjMatrix : TMatrix; PitchAngle, RollAngle: Integer; // Tolik pitchangle -- угол назклона модели // rollangle - угол поворота модели aRollAngle: single; ObjTextCoord: TVector3F; DsFile: TFile3DS; FMeshMotion: PKFMesh3DS; MeshMin, MeshMax, objMin, objMax: TVector3F; f: TextFile; delta, min, max, vr : TAffineVector; meshPoint: TPoint3DS; ViewPort3Ds: TViewport3DS; MeshObject, MeshObject1 : TMeshObject; PMesh: PMeshObject; vectorPos, ObjVPos: TVector4F; MeshPos: TPoint3DS; MeshLevel, DBaseLevel: TReleaseLevel; MeshSettings: TMeshSet3Ds; File3DsDbase: TDBType3DS; MyFile: TGL3DSVectorFile; ObjFile: TGLOBJVectorFile; MatLibName: String; CurrDirName, LibDir: String; Load3ds: boolean; Procedure GetCompon3ModelAngles(aCompon: TSCSComponent); var i: Integer; currProp: PProperty; begin PitchAngle := 0; RollAngle := 0; for i := 0 to aCompon.Properties.Count - 1 do begin currProp := PProperty(aCompon.Properties[i]); if UpperCase(currProp.SysName) = 'PITCHANGLE_3DMODEL' then begin PitchAngle := StrToInt(currProp.Value); end else if UpperCase(currProp.SysName) = 'ROLLANGLE_3DMODEL' then begin RollAngle := StrToInt(currProp.Value); end; end; end; Procedure GetCompon3DProps(aCompon: TSCSComponent); var i: Integer; currProp: PProperty; begin CanUse3DSize := False; ModelSize.x := -1; ModelSize.y := -1; ModelSize.z := -1; ModelOffset.x := 0; ModelOffset.y := 0; ModelOffset.z := 0; ModelRotation.x := 0; ModelRotation.y := 0; ModelRotation.z := 0; PitchAngle := 0; RollAngle := 0; F3dModelFileNameName := ''; for i := 0 to aCompon.Properties.Count - 1 do begin currProp := PProperty(aCompon.Properties[i]); if UpperCase(currProp.SysName) = '3DS_MODEL' then begin F3dModelFileNameName := currProp.Value; //Tolik -- для локальных путей if Pos('\\', F3dModelFileNameName) = 0 then // если не сетевой путь begin if Pos(':', F3dModelFileNameName) = 0 then // если локальный путь F3dModelFileNameName := ExeDir + F3dModelFileNameName; //добавить путь к ЕХЕ (приложению) end; end else if UpperCase(currProp.SysName) = '3D_WIDTH' then begin ModelSize.x := StrToFloat_My(currProp.Value); end else if UpperCase(currProp.SysName) = '3D_HEIGHT' then begin ModelSize.z := StrToFloat_My(currProp.Value); end else if UpperCase(currProp.SysName) = '3D_LENGTH' then begin ModelSize.y := StrToFloat_My(currProp.Value); end else if UpperCase(currProp.SysName) = 'K_3DMODEL_OFF_X' then begin ModelOffset.x := StrToFloat_My(currProp.Value); end else if UpperCase(currProp.SysName) = 'K_3DMODEL_OFF_Y' then begin ModelOffset.y := StrToFloat_My(currProp.Value); end else if UpperCase(currProp.SysName) = 'K_3DMODEL_OFF_Z' then begin ModelOffset.z := StrToFloat_My(currProp.Value); end else if UpperCase(currProp.SysName) = 'PITCHANGLE_3DMODEL' then begin PitchAngle := StrToInt(currProp.Value); end else if UpperCase(currProp.SysName) = 'ROLLANGLE_3DMODEL' then begin RollAngle := StrToInt(currProp.Value); end else if UpperCase(currProp.SysName) = 'R_ANGLE' then // угол поворота begin ModelRotation.z := StrToFloat_My(currProp.Value); end else if UpperCase(currProp.SysName) = 'P_ANGLE' then // угол вращения begin ModelRotation.x := StrToFloat_My(currProp.Value); end else if UpperCase(currProp.SysName) = 'T_ANGLE' then // угол наклона begin ModelRotation.y := StrToFloat_My(currProp.Value); end; end; if ModelSize.x <> -1 then if ModelSize.y <> -1 then if ModelSize.z <> -1 then CanUse3DSize := True; end; Procedure StripMeshObject(aMesh: TglFreeForm); var sIndex,MoIndex: Integer; MeshObj : TMeshObject; fg : TFGVertexIndexList; strips : TPersistentObjectList; begin for MoIndex := 0 to aMesh.MeshObjects.Count -1 do begin MeshObj := aMesh.MeshObjects[MoIndex]; fg := (MeshObj.FaceGroups[0] as TFGVertexIndexList); strips := StripifyMesh(fg.VertexIndices, MeshObj.Vertices.Count, True); try fg.Free; for sIndex := 0 to strips.Count - 1 do begin fg := TFGVertexIndexList.CreateOwned(MeshObj.FaceGroups); fg.VertexIndices := (strips[sIndex] as TIntegerList); if sIndex = 0 then fg.Mode := fgmmTriangles else fg.Mode := fgmmTriangleStrip; end; finally strips.Free; end; end; end; Function getMatlibNAme(aFileName: string): String; var FileDir,s: String; i, j: Integer; begin Result := ''; FileDir := ExtractFilePath(aFileName); if Length(FileDir) > 0 then if FileDir[Length(FileDir)] <> '\' then FileDir := FileDir + '\'; s := ExtractFileName(aFileName); s := FileDir + StringReplace(s, '.obj', '.mtl', [rfReplaceAll, rfIgnoreCase]); if FileExists(s) then Result := s; end; // Типа, наоборот -- если да, то грузить модель не можем function CheckCantLoad3dModel(aModelName: String): Boolean; begin Result := False; Load3ds := False; // true -- грузим 3Ds, False - .Obj if Length(aModelName) < 5 then begin Result := True; exit; end; if aModelName[Length(aModelName) - 3] <> '.' then begin Result := True; exit; end; if (Pos('.3DS', UpperCase(aModelName)) = (Length(aModelName) - 3)) then Load3Ds := True; end; begin Result := False; if aConn.FSCSObject = nil then exit; if aNode = nil then exit; ModelList := Nil; ParentNode := aNode; try SCSCatalog := Nil; SCSConn := aConn.FSCSObject; ConnCadList := F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(FCad.FCADListID); if ConnCadList <> nil then if SCSConn <> nil then SCSCatalog := ConnCadList.GetCatalogFromReferencesBySCSID(SCSConn.ID); if SCSCatalog <> nil then begin ModelCount := 0; ModelList := TList.Create; for i := 0 to SCSCatalog.ComponentReferences.Count - 1 do begin SCSComponent := SCSCatalog.ComponentReferences[i]; GetCompon3DProps(SCSComponent); //if SCSComponent.isTop then if F3dModelFileNameName <> '' then begin if FileExists(F3dModelFileNameName) then begin if CheckCantLoad3dModel(F3dModelFileNameName) then Continue; F3DCompon := nil; //GetCompon3DProps(SCSComponent); F3DCompon := T3dComponent.Create(nil, nil, self.F3DModel, false); SelfNode := ScsModelTree.Items.AddChild(ParentNode, SCSComponent.GetNameForVisible); SelfNode.ImageIndex := 12; SelfNode.SelectedIndex := 12; SelfNode.Data := F3DCompon; F3DCompon.FSCSCompon := SCSComponent; F3DCompon.FSCSComponID := SCSComponent.ID; F3DCompon.F3dModelFileName := F3dModelFileNameName; glObjClass := TGLFreeForm; glObject := TGLFreeForm(DummyCube.addNewChild(glObjClass)); //glObject.ObjectStyle := []; glObject.Material.Texture.Disabled := False; glObject.AutoCentering := [macCenterX, macCenterY, macCenterZ]; TGLFreeForm(glObject).Material.Texture.Disabled := True; glObject.MaterialLibrary := MatLib; // TglFreeForm(glObject).LightmapLibrary := MatLib; glObject.IgnoreMissingTextures := true; glObject.UseMeshMaterials := True; TGLFreeForm(glObject).Material.Texture.Disabled := False; // FisCreate3DS := True; ErrorTextureLoad := False; // в принципе, FTextureFileName нужен только, чтоб ыопределить путь к файлу... // но, на всякий... if not Load3ds then // если .obj, то библиотека в файле .mtl FTextureFileName := getMatlibNAme(F3dModelFileNameName) else FTextureFileName := F3dModelFileNameName; CurrDirName := GetCurrentDir; LibDir := ExtractFileDir(F3dModelFileNameName); SetCurrentDir(LibDir); try glObject.LoadFromFile(F3dModelFileNameName); except on E: Exception do begin if ErrorTextureLoad then begin ErrorTextureLoad := False; FisCreate3DS := False; DummyCube.Remove(glObject, false); glObject.free; glObject := TGLFreeForm(DummyCube.addNewChild(glObjClass)); glObject.AutoCentering := [macCenterX, macCenterY, macCenterZ]; TGLFreeForm(glObject).Material.Texture.Disabled := True; glObject.MaterialLibrary := MatLib; //TglFreeForm(glObject).LightmapLibrary := MatLib; //glObject.LightmapLibrary := MatLib; // Tolik 23/09/2019 -- glObject.IgnoreMissingTextures := true; try glObject.LoadFromFile(F3dModelFileNameName); //glObject.MeshObjects.DropMaterialLibraryCache; except on E: Exception do begin FreeAndNil(F3DCompon); DummyCube.Remove(glObject, false); glObject.free; end; end; end else begin FreeAndNil(F3DCompon); DummyCube.Remove(glObject, false); glObject.free; end; end; end; { glObject.Material.FrontProperties.Shininess := 0; glObject.Material.BackProperties.Shininess := 0; glObject.Material.FrontProperties.Specular.Color := clrBlack; glObject.Material.BackProperties.Specular.Color:= clrBlack;} // Tolik 02/10/2019 -- // если моделька грузится из .obj файла, то записать список материалов if not Load3ds then begin if FCorrect3DModelMaterialForObj then // только если установлена настройка программы корректировать материалы для моделей .obj begin for j := 0 to glObject.MeshObjects.Count - 1 do begin for k := 0 to TMeshObject(glObject.MeshObjects[j]).FaceGroups.Count - 1 do begin if ObjMatList.IndexOf(TFaceGroup(TMeshObject(glObject.MeshObjects[j]).FaceGroups[k]).MaterialName) = -1 then ObjMatList.Add(TFaceGroup(TMeshObject(glObject.MeshObjects[j]).FaceGroups[k]).MaterialName); end; end; end; end; // SetCurrentDir(CurrDirName); if F3DCompon <> nil then begin // Tolik 20/09/2019 -- здесь если выключить -- не будет освещения (как в 6-ке не работает) // Self.Light.Shining := False; // FisCreate3DS := False; INC(ModelCount); //glObject.Material.FrontProperties.Shininess := 1; { glObject.LightmapLibrary := MatLib; glObject.BeginUpdate; glObject.Material.BackProperties.Ambient.Alpha := 1; glObject.Material.BackProperties.Diffuse.Alpha := 1; glObject.Material.BackProperties.Emission.Alpha := 1; glObject.Material.FrontProperties.Ambient.Alpha := 1; glObject.Material.FrontProperties.Diffuse.Alpha := 1; glObject.Material.FrontProperties.Emission.Alpha := 1; glObject.Material.BackProperties.Ambient.Color := ClrSilver; glObject.Material.BackProperties.Diffuse.Color := ClrSilver; glObject.Material.BackProperties.Emission.Color := ClrSilver; glObject.Material.FrontProperties.Ambient.Color := ClrSilver; glObject.Material.FrontProperties.Diffuse.Color := ClrSilver; glObject.Material.FrontProperties.Emission.Color := ClrSilver; glObject.Material.BlendingMode := bmOpaque; glObject.Material.FrontProperties.Shininess := 1; glObject.EndUpdate;} //glObject.BuildOctree(); ModelList.Add(glObject); F3DCompon.FGLObject := glObject; F3DCompon.FGLObject1 := glObject; //TSCSComponent(SelfNode.Data).FGLObject := glObject; Get3DSObjectBounds(ObjectMin, ObjectMax, glObject); //Bounds := TGLFreeForm(glObject).BoundingBoxUnscaled; ObjSize.x := abs(ObjectMax.x - ObjectMin.x); ObjSize.y := abs(ObjectMax.y - ObjectMin.y); ObjSize.z := abs(ObjectMax.z - ObjectMin.z); p := Face.Points[0]; p := DoublePoint(p.x,p.z,p.y); SetPos.x := p.x * factor; SetPos.y := p.y * factor; SetPos.z := p.z * factor; GetCompon3DProps(SCSComponent); if CanUse3DSize then begin F3DCompon.FUse3DSize := True; Scale.X := 1; Scale.Y := 1; Scale.Z := 1; if ((ObjSize.x <> 0) and (ModelSize.x <> 0)) then Scale.X := (ModelSize.x * UOMToMetre(1000 / FCAD.PCad.MapScale) * factor) / ObjSize.x; if ((ObjSize.y <> 0) and (ModelSize.y <> 0)) then Scale.Y := (ModelSize.y * UOMToMetre(1000 / FCAD.PCad.MapScale) * factor) / ObjSize.y; if ((ObjSize.z <> 0) and (ModelSize.z <> 0)) then Scale.Z := (ModelSize.z * UOMToMetre(1000 / FCAD.PCad.MapScale) * factor) / ObjSize.z; glObject.Scale.X := Scale.x; if Load3ds then begin glObject.Scale.Y := Scale.y; glObject.Scale.Z := Scale.Z; end else begin // для .obj файла (все наоборот) glObject.Scale.Y := Scale.Z; glObject.Scale.Z := Scale.Y; end; end else begin Scale.X := 1; if ((ObjSize.x <> 0) and (ModelSize.x > 0)) then Scale.X := (ModelSize.x * UOMToMetre(1000 / FCAD.PCad.MapScale) * factor) / ObjSize.x else if ((ObjSize.y <> 0) and (ModelSize.y > 0)) then Scale.X := (ModelSize.y * UOMToMetre(1000 / FCAD.PCad.MapScale) * factor) / ObjSize.y else if ((ObjSize.z <> 0) and (ModelSize.z > 0)) then Scale.X := (ModelSize.z * UOMToMetre(1000 / FCAD.PCad.MapScale) * factor) / ObjSize.z; glObject.Scale.X := Scale.x; glObject.Scale.Y := Scale.x; glObject.Scale.Z := Scale.x; end; // Pos correction by user offsets Get3DSObjectBounds(ObjectMin, ObjectMax, glObject); ObjSize.x := abs(ObjectMax.x - ObjectMin.x); ObjSize.y := abs(ObjectMax.y - ObjectMin.y); ObjSize.z := abs(ObjectMax.z - ObjectMin.z); glObject.Position.x := SetPos.x;// + {ObjSize.x *} ModelOffset.x; glObject.Position.y := SetPos.y;// + {ObjSize.z *} ModelOffset.z; glObject.Position.z := SetPos.z;// + {ObjSize.y *} ModelOffset.y; // { if glObject.Material.Texture.Disabled then begin glObject.Material.FrontProperties.Ambient.Color := ObjColor; glObject.Material.FrontProperties.Diffuse.Color := ObjColor; glObject.Material.FrontProperties.Emission.Color := ObjColor; glObject.Material.BackProperties.Ambient.Color := ObjColor; glObject.Material.BackProperties.Diffuse.Color := ObjColor; glObject.Material.BackProperties.Emission.Color := ObjColor; end; glObject.Material.MaterialOptions := []; glObject.Material.Texture.Disabled := False;} { if RollAngle <> 0 then // 14/12/2018 угол поворота glObject.Roll(RollAngle);} if PitchAngle <> 0 then // угол наклона begin { ComponGroupObject := TGLDummyCube(DummyCube.addNewChild(TGLDummyCube)); ComponGroupObject.Position.X := glObject.Position.X; ComponGroupObject.Position.Y := glObject.Position.Y; ComponGroupObject.Position.Z := glObject.Position.Z; Dummycube.Remove(glObject, False); ComponGroupObject.AddChild(glObject); ComponGroupObject.Pitch(PitchAngle); glObject.MoveTo(DummyCube); glObject.Position.x := SetPos.x + ObjSize.x * ModelOffset.x; glObject.Position.y := SetPos.y + ObjSize.z * ModelOffset.z; glObject.Position.z := SetPos.z + ObjSize.y * ModelOffset.y;} //glObject.Pitch(PitchAngle); //DummyCube.Remove(ComponGroupObject, False); //ComponGroupObject.Free; end; aRollAngle := TGLFreeForm(gLObject).RollAngle; aRollAngle := TGLFreeForm(gLObject).PitchAngle; aRollAngle := TGLFreeForm(gLObject).TurnAngle; TGLFreeForm(gLObject).ResetRotations; //TGLFreeForm(gLObject).PitchAngle := 90; //TGLFreeForm(gLObject).Pitch(90); //TGLFreeForm(gLObject).ShowAxes := True; TGLFreeForm(gLObject).Rotation.DirectX := 0; TGLFreeForm(gLObject).Rotation.DirectY := 0; TGLFreeForm(gLObject).Rotation.DirectZ := 0; //TGLFreeForm(gLObject).Rotation.Z := 90; //TGLFreeForm(gLObject).Rotation.Y := 270; //TGLFreeForm(gLObject).Rotation.X := 180; //Rotate3DSObj(TGLFreeForm(gLObject), 90, 270, 225, False); //Rotate3DSObj(TGLFreeForm(gLObject), -45, 0, 0); // glObject.Turn(-45); glObject.TagObject := SelfNode; Self.F3DModel.FScsObjects.Add(F3DCompon); Result := True; end; end; end; end; // Tolik -- Pos correction on ConnectorObject (for more than 1 model) if ModelCount > 0 then begin p := Face.Points[0]; p := DoublePoint(p.x,p.z,p.y); ComponGroupObject := TGLDummyCube(DummyCube.addNewChild(TGLDummyCube)); { if SCSConn.FDrawFigureAngle <> 0 then ComponGroupObject.Turn(RadToDeg(-SCSConn.FDrawFigureAngle)); } ComponGroupObject.Position.X := p.x * factor; ComponGroupObject.Position.Y := p.y * factor + FZOrder*factor*(UOMToMetre(1000 / FCAD.PCad.MapScale)); ComponGroupObject.Position.Z := p.z * factor; LeftPoint := 0; RightPoint := 0; if Odd(ModelCount) then // Odd count begin i := (ModelCount div 2); glObject := TGLFreeForm(ModelList[i]); if glObject.TagObject <> nil then begin if TTreeNode(glObject.TagObject).Data <> nil then if TObject(TTreeNode(glObject.TagObject).Data).ClassName = 'T3DComponent' then; // T3DComponent(TTreeNode(glObject.TagObject).Data).isGroupedFigure := true; end; Get3DSObjectBounds(ObjectMin, ObjectMax, glObject); LeftPoint := LeftPoint - (abs(ObjectMax.x - ObjectMin.x)/2); RightPoint := RightPoint + (abs(ObjectMax.x - ObjectMin.x)/2); DEC(i); j := 2; DummyCube.Remove(glObject, False); //if ModelCount > 1 then {begin glObject.Roll(-90); TGLFreeForm(gLObject).Rotation.DirectX := 0; TGLFreeForm(gLObject).Rotation.DirectY := 1; TGLFreeForm(gLObject).Rotation.DirectZ := 0; end;} //glObject.ShowAxes := True; glObject.Position.z := 0; glObject.Position.x := 0; glObject.Position.y := 0 + FZOrder*factor*(UOMToMetre(1000 / FCAD.PCad.MapScale)); glObject.Parent := ComponGroupObject; end else // even count begin i := (ModelCount div 2) - 1; j := 1; end; While i > -1 do begin glObject := TGLFreeForm(ModelList[i]); if glObject.TagObject <> nil then begin if TTreeNode(glObject.TagObject).Data <> nil then if TObject(TTreeNode(glObject.TagObject).Data).ClassName = 'T3DComponent' then; // T3DComponent(TTreeNode(glObject.TagObject).Data).isGroupedFigure := true; end; //if ModelCount > 1 then {begin glObject.Roll(-90); TGLFreeForm(gLObject).Rotation.DirectX := 0; TGLFreeForm(gLObject).Rotation.DirectY := 1; TGLFreeForm(gLObject).Rotation.DirectZ := 0; end;} //glObject.PitchAngle := -90; {glObject.Direction.DirectX := 0; glObject.Direction.DirectY := 1; glObject.Direction.DirectZ := 0; } Get3DSObjectBounds(ObjectMin, ObjectMax, glObject); LeftPoint := LeftPoint - (abs(ObjectMax.x - ObjectMin.x)/2); RightPoint := RightPoint + (abs(ObjectMax.x - ObjectMin.x)/2); DummyCube.Remove(glObject, False); glObject.Position.z := LeftPoint; glObject.Position.x := 0; glObject.Position.y := 0; glObject.Parent := ComponGroupObject; //ComponGroupObject.AddChild(glObject); glObject := TGLFreeForm(ModelList[i + j]); if glObject.TagObject <> nil then begin if TTreeNode(glObject.TagObject).Data <> nil then if TObject(TTreeNode(glObject.TagObject).Data).ClassName = 'T3DComponent' then; // T3DComponent(TTreeNode(glObject.TagObject).Data).isGroupedFigure := true; end; DummyCube.Remove(glObject, False); //if ModelCount > 1 then {begin glObject.Roll(-90); TGLFreeForm(gLObject).Rotation.DirectX := 0; TGLFreeForm(gLObject).Rotation.DirectY := 1; TGLFreeForm(gLObject).Rotation.DirectZ := 0; end; } glObject.Position.z := RightPoint; glObject.Position.x := 0; glObject.Position.y := 0; glObject.Parent := ComponGroupObject; //ComponGroupObject.AddChild(glObject); LeftPoint := LeftPoint - (abs(ObjectMax.x - ObjectMin.x)/2); RightPoint := RightPoint + (abs(ObjectMax.x - ObjectMin.x)/2); DEC(i); INC(j,2); end; {if SCSConn.FDrawFigureAngle <> 0 then ComponGroupObject.TurnAngle := (-1)*(RadToDeg(SCSConn.FDrawFigureAngle));} //ComponGroupObject.ShowAxes := True; aConn.FglObject := ComponGroupObject; ComponGroupObject.TagObject := aNode; //aConn.FRotate.z := (-1)*RadToDeg(SCSConn.FDrawFigureAngle); j := ComponGroupObject.Count - 1; //ComponGroupObject.Name := 'ComponGroupObject'; //for i := 0 to ComponGroupObject.Count - 1 do for i := 0 to j do begin glObject := TGLFreeForm(ComponGroupObject.Children[0]); if glObject.TagObject <> nil then begin if TObject(TTreeNode(glObject.TagObject).Data).ClassNAme = 'T3DComponent' then begin if T3DComponent(TTreeNode(glObject.TagObject).Data).FSCSCompon <> nil then begin Get3DSObjectBounds(ObjectMin, ObjectMax, glObject); GetCompon3DProps(T3DComponent(TTreeNode(glObject.TagObject).Data).FSCSCompon); glObject.Position.z := glObject.Position.z + ModelOffset.z * (ObjectMax.y - ObjectMin.y); glObject.Position.x := glObject.Position.x + ModelOffset.x * (ObjectMax.x - ObjectMin.x); glObject.Position.y := glObject.Position.y + ModelOffset.y * (ObjectMax.z - ObjectMin.z); ComponGroupObject2 := TglDummyCube(DummyCube.AddNewChild(TglDummyCube)); ComponGroupObject1 := TglDummyCube(DummyCube.AddNewChild(TglDummyCube)); ComponGroupObject2.Parent := ComponGroupObject; ComponGroupObject2.Position.X := TGLFreeForm(gLObject).Position.x; ComponGroupObject2.Position.Y := TGLFreeForm(gLObject).Position.y; ComponGroupObject2.Position.Z := TGLFreeForm(gLObject).Position.z; //ComponGroupObject2.Name := 'ComponGroupObject2'; ComponGroupObject1.Parent := ComponGroupObject2; ComponGroupObject1.Position.X := 0; ComponGroupObject1.Position.Y := 0; ComponGroupObject1.Position.Z := 0; //ComponGroupObject1.Name := 'ComponGroupObject1'; TGLFreeForm(gLObject).Position.x := 0; TGLFreeForm(gLObject).Position.y := 0; TGLFreeForm(gLObject).Position.z := 0; TGLFreeForm(gLObject).Parent := ComponGroupObject1; if glObject.TagObject <> nil then if TTreeNode(glObject.TagObject).Data <> nil then begin T3DComponent(TTreeNode(glObject.TagObject).Data).FOffset.x := ModelOffset.x * (ObjectMax.x - ObjectMin.x); T3DComponent(TTreeNode(glObject.TagObject).Data).FOffset.z := ModelOffset.z * (ObjectMax.y - ObjectMin.y); T3DComponent(TTreeNode(glObject.TagObject).Data).FOffset.y := ModelOffset.y * (ObjectMax.z - ObjectMin.z); if T3DComponent(TTreeNode(glObject.TagObject).Data).FSCSCompon <> nil then begin if T3DComponent(TTreeNode(glObject.TagObject).Data).FSCSCompon.GetPropertyBySysName('P_ANGLE') <> nil then begin T3DComponent(TTreeNode(glObject.TagObject).Data).FRotate.x := ModelRotation.x; glObject.PitchAngle := ModelRotation.x; end else begin if Load3ds then begin T3DComponent(TTreeNode(glObject.TagObject).Data).FRotate.x := 90; glObject.PitchAngle := 90; end else begin T3DComponent(TTreeNode(glObject.TagObject).Data).FRotate.x := 0; glObject.PitchAngle := 0; end; end; if T3DComponent(TTreeNode(glObject.TagObject).Data).FSCSCompon.GetPropertyBySysName('R_ANGLE') <> nil then begin T3DComponent(TTreeNode(glObject.TagObject).Data).FRotate.y := ModelRotation.y; ComponGroupObject1.RollAngle := ModelRotation.y; end else begin T3DComponent(TTreeNode(glObject.TagObject).Data).FRotate.y := 0; ComponGroupObject1.RollAngle := 0; end; if T3DComponent(TTreeNode(glObject.TagObject).Data).FSCSCompon.GetPropertyBySysName('T_ANGLE') <> nil then begin T3DComponent(TTreeNode(glObject.TagObject).Data).FRotate.z := ModelRotation.z; ComponGroupObject2.TurnAngle := ModelRotation.z; end else begin if Load3ds then begin T3DComponent(TTreeNode(glObject.TagObject).Data).FRotate.z := 90; ComponGroupObject2.TurnAngle := 90; end else begin T3DComponent(TTreeNode(glObject.TagObject).Data).FRotate.z := -90; ComponGroupObject2.TurnAngle := -90; end; end; end else begin T3DComponent(TTreeNode(glObject.TagObject).Data).FRotate.x := 90; glObject.PitchAngle := 90; T3DComponent(TTreeNode(glObject.TagObject).Data).FRotate.y := 0; ComponGroupObject1.RollAngle := 0; T3DComponent(TTreeNode(glObject.TagObject).Data).FRotate.z := 90; ComponGroupObject2.TurnAngle := 90; end; //if ModelRotation.x <> 0 then { T3DComponent(TTreeNode(glObject.TagObject).Data).FRotate.x := ModelRotation.x; glObject.PitchAngle := ModelRotation.x + 90; T3DComponent(TTreeNode(glObject.TagObject).Data).FRotate.z := ModelRotation.z; //ComponGroupObject1.TurnAngle := ModelRotation.z - 90; ComponGroupObject1.RollAngle := ModelRotation.y; T3DComponent(TTreeNode(glObject.TagObject).Data).FRotate.y := ModelRotation.y; //ComponGroupObject2.RollAngle := ModelRotation.y; ComponGroupObject2.TurnAngle := ModelRotation.z - 90;} end; end; end; end; end; if SCSConn.FDrawFigureAngle <> 0 then begin ComponGroupObject.TurnAngle := (-1)*(RadToDeg(SCSConn.FDrawFigureAngle)); aConn.FRotate.z := (-1)*RadToDeg(SCSConn.FDrawFigureAngle); end else begin ComponGroupObject.TurnAngle := 0; aConn.FRotate.z := 0; end; //ComponGroupObject.TurnAngle := (-1)*(RadToDeg(SCSConn.FDrawFigureAngle)); (* if SCSConn.FDrawFigureAngle <> 0 then begin while ComponGroupObject.Count > 0 do begin glObject := TGLFreeForm(ComponGroupObject.Children[0]); ObjMatrix := glObject.Matrix; AbsVector := glObject.AbsolutePosition; AbsUpVector := glObject.AbsoluteUp; T3DComponent(TTreeNode(glObject.TagObject).Data).AbsVector := glObject.AbsolutePosition; T3DComponent(TTreeNode(glObject.TagObject).Data).AbsUpVector := glObject.AbsoluteUP; glObject.MoveTo(DummyCube); glObject.AbsolutePosition := AbsVector; glObject.AbsoluteUp := AbsUpVector; glObject.Roll(90); glObject.Direction.DirectX := 0; glObject.Direction.DirectY := 1; glObject.Direction.DirectZ := 0; glObject.ShowAxes := True; if glObject.TagObject <> nil then if TObject(TTreeNode(glObject.TagObject).Data).ClassName = 'T3DComponent' then if T3DComponent(TTreeNode(glObject.TagObject).Data).FSCSCompon <> nil then begin T3DComponent(TTreeNode(glObject.TagObject).Data).FOffset.x := glObject.Position.X; T3DComponent(TTreeNode(glObject.TagObject).Data).FOffset.y := glObject.Position.Y; T3DComponent(TTreeNode(glObject.TagObject).Data).FOffset.z := glObject.Position.Z; GetCompon3DProps(T3DComponent(TTreeNode(glObject.TagObject).Data).FSCSCompon); Get3DSObjectBounds(ObjectMin, ObjectMax, glObject); ObjSize.x := abs(ObjectMax.x - ObjectMin.x); ObjSize.y := abs(ObjectMax.y - ObjectMin.y); ObjSize.z := abs(ObjectMax.z - ObjectMin.z); glObject.Position.x := glObject.Position.x + ObjSize.x * ModelOffset.x; glObject.Position.y := glObject.Position.y + ObjSize.z * ModelOffset.z; glObject.Position.z := glObject.Position.z + ObjSize.y * ModelOffset.y; end; ComponGroupObject1 := TglDummyCube(DummyCube.AddNewChild(TglDummyCube)); ComponGroupObject1.Position.X := TGLFreeForm(gLObject).Position.x; ComponGroupObject1.Position.Y := TGLFreeForm(gLObject).Position.y; ComponGroupObject1.Position.Z := TGLFreeForm(gLObject).Position.z; TGLFreeForm(gLObject).Position.x := 0; TGLFreeForm(gLObject).Position.y := 0; TGLFreeForm(gLObject).Position.z := 0; TGLFreeForm(gLObject).MoveTo(ComponGroupObject1); //ComponGroupObject.TurnAngle := 45; ComponGroupObject2 := TglDummyCube(DummyCube.AddNewChild(TglDummyCube)); ComponGroupObject2.Position.X := ComponGroupObject1.Position.X; ComponGroupObject2.Position.Y := ComponGroupObject1.Position.Y; ComponGroupObject2.Position.Z := ComponGroupObject1.Position.Z; ComponGroupObject1.Parent := ComponGroupObject2; ComponGroupObject1.Position.X := 0; ComponGroupObject1.Position.Y := 0; ComponGroupObject1.Position.Z := 0; end; //DummyCube.Remove(ComponGroupObject, False); //FreeAndNil(ComponGroupObject); //ComponGroupObject.Free; end else begin { for i := 0 to ComponGroupObject.Count - 1 do begin glObject := TGLFreeForm(ComponGroupObject.Children[i]); if glObject.TagObject <> nil then if TObject(TTreeNode(glObject.TagObject).Data).ClassName = 'T3DComponent' then if T3DComponent(TTreeNode(glObject.TagObject).Data).FSCSCompon <> nil then begin T3DComponent(TTreeNode(glObject.TagObject).Data).FOffset.x := glObject.Position.X; T3DComponent(TTreeNode(glObject.TagObject).Data).FOffset.y := glObject.Position.Y; T3DComponent(TTreeNode(glObject.TagObject).Data).FOffset.z := glObject.Position.Z; GetCompon3DProps(T3DComponent(TTreeNode(glObject.TagObject).Data).FSCSCompon); Get3DSObjectBounds(ObjectMin, ObjectMax, glObject); ObjSize.x := abs(ObjectMax.x - ObjectMin.x); ObjSize.y := abs(ObjectMax.y - ObjectMin.y); ObjSize.z := abs(ObjectMax.z - ObjectMin.z); glObject.Position.x := glObject.Position.x + ObjSize.x * ModelOffset.x; glObject.Position.y := glObject.Position.y + ObjSize.z * ModelOffset.z; glObject.Position.z := glObject.Position.z + ObjSize.y * ModelOffset.y; end; end; } while ComponGroupObject.Count > 0 do begin glObject := TGLFreeForm(ComponGroupObject.Children[0]); ObjMatrix := glObject.Matrix; AbsVector := glObject.AbsolutePosition; AbsUpVector := glObject.AbsoluteUp; glObject.MoveTo(DummyCube); glObject.AbsolutePosition := AbsVector; glObject.AbsoluteUp := AbsUpVector; T3DComponent(TTreeNode(glObject.TagObject).Data).AbsVector := glObject.AbsolutePosition; T3DComponent(TTreeNode(glObject.TagObject).Data).AbsUpVector := glObject.AbsoluteUP; //glObject.Rotation.Z := 90; //glObject.Roll(90); if glObject.TagObject <> nil then if TObject(TTreeNode(glObject.TagObject).Data).ClassName = 'T3DComponent' then if T3DComponent(TTreeNode(glObject.TagObject).Data).FSCSCompon <> nil then begin T3DComponent(TTreeNode(glObject.TagObject).Data).FOffset.x := glObject.Position.X; T3DComponent(TTreeNode(glObject.TagObject).Data).FOffset.y := glObject.Position.Y; T3DComponent(TTreeNode(glObject.TagObject).Data).FOffset.z := glObject.Position.Z; GetCompon3DProps(T3DComponent(TTreeNode(glObject.TagObject).Data).FSCSCompon); Get3DSObjectBounds(ObjectMin, ObjectMax, glObject); ObjSize.x := abs(ObjectMax.x - ObjectMin.x); ObjSize.y := abs(ObjectMax.y - ObjectMin.y); ObjSize.z := abs(ObjectMax.z - ObjectMin.z); glObject.Position.x := glObject.Position.x + ObjSize.x * ModelOffset.x; glObject.Position.y := glObject.Position.y + ObjSize.z * ModelOffset.z; glObject.Position.z := glObject.Position.z + ObjSize.y * ModelOffset.y; end; end; end; *) { if ComponGroupObject <> nil then begin DummyCube.Remove(ComponGroupObject, False); ComponGroupObject.Free; end; } end; (* else if ModelCount = 1 then begin glObject := TGLFreeForm(ModelList[0]); glObject.Roll(90); {T3DComponent(TTreeNode(glObject.TagObject).Data).AbsVector := glObject.AbsolutePosition; T3DComponent(TTreeNode(glObject.TagObject).Data).AbsUpVector := glObject.AbsoluteUP; T3DComponent(TTreeNode(glObject.TagObject).Data).absMatrix := glObject.AbsoluteMatrix;} ComponGroupObject := TglDummyCube(DummyCube.AddNewChild(TglDummyCube)); ComponGroupObject.Position.X := TGLFreeForm(gLObject).Position.x; ComponGroupObject.Position.Y := TGLFreeForm(gLObject).Position.y; ComponGroupObject.Position.Z := TGLFreeForm(gLObject).Position.z; TGLFreeForm(gLObject).Position.x := 0; TGLFreeForm(gLObject).Position.y := 0; TGLFreeForm(gLObject).Position.z := 0; TGLFreeForm(gLObject).MoveTo(ComponGroupObject); //ComponGroupObject.TurnAngle := 45; ComponGroupObject1 := TglDummyCube(DummyCube.AddNewChild(TglDummyCube)); ComponGroupObject1.Position.X := ComponGroupObject.Position.X; ComponGroupObject1.Position.Y := ComponGroupObject.Position.Y; ComponGroupObject1.Position.Z := ComponGroupObject.Position.Z; ComponGroupObject.Parent := ComponGroupObject1; ComponGroupObject.Position.X := 0; ComponGroupObject.Position.Y := 0; ComponGroupObject.Position.Z := 0; aConn.FglObject := ComponGroupObject; ComponGroupObject.TagObject := aNode; //ComponGroupObject1.RollAngle := 45; //ComponGroupObject1.ShowAxes := True; end; *) end; except on E: Exception do begin Result := False; end; end; if ModelList <> nil then ModelList.Free; end; Procedure Collect3DLine(aLine: T3DLine); var i: Integer; LineList: TSCSList; ComponOutRadius: Double; LineCatalog: TSCSCatalog; LineComponent: TSCSComponent; LineFigure: TOrthoLine; F3DLineCompon: T3DLineComponent; ParentNode, ChildNode: TTreeNode; GLCyl: TGlFreeForm; glComponCube: TglCube; TubePoint1, TubePoint2: PDoublePoint; ComponColor: Tvector4f; LineCP: T3DPoint; LineComponOffset: Double; CanAddCableCompon, CanAddCableChannel, CanAddTube: Boolean; LineLen: Double; Arg_um_ent: Double; { Function getLineComponColor(aLineComponent: TSCSComponent): Tvector4f; var LineComponProp: PProperty; NBProp: TNBProperty; LineComponColor: Integer; begin Result := ConvertWinColor(clGray); LineComponProp := aLineComponent.GetPropertyBySysName(pnOutDiametr); LineComponColor := aLineComponent.GetPropertyValueAsInteger(pnColor); if LineComponColor <> -1 then Result := ConvertWinColor(LineComponColor); end; } Function getLineComponOutRadius(aLineComponent: TSCSComponent): double; var LineComponProp: PProperty; NBProp: TNBProperty; OutDiam: Double; LineComponCatalog: TSCSCatalog; SideString, SideString1: String; Side1, Side2: Double; CharPos: integer; ED_Izm: string; Dir_v: TVector4f; begin Result := -1; ED_Izm := 'mm'; if aLineComponent.ComponentType.SysName = ctsnCableChannelAccessory then exit; if ((aLineComponent.ComponentType.SysName <> ctsnCableChannel) or (aLineComponent.Componenttype.GUID = '{80B7A366-98B3-4D3A-A115-C64A3498218E}')) then begin LineComponProp := aLineComponent.GetPropertyBySysName(pnOutDiametr); if LineComponProp <> nil then begin OutDiam := StrToFloat_My(LineComponProp.Value); if OutDiam > 0 then begin NbProp := F_NormBase.GSCSBase.NBSpravochnik.GetPropertyByGUID(LineComponProp.GuidProperty); if NbProp <> nil then //Result := ConverResultToUom(OutDiam/2, NbProp.PropertyData.Izm) ED_Izm := NbProp.PropertyData.Izm else begin OutDiam := 0; LineComponProp := Nil; end; end; end else //if isCableComponent(aLineComponent) then // if Cable begin LineComponProp := aLineComponent.GetPropertyBySysName(pnOutSection); if LineComponProp <> nil then begin OutDiam := StrToFloat_My(LineComponProp.Value); if OutDiam > 0 then begin OutDiam := SQRT(OutDiam); NbProp := F_NormBase.GSCSBase.NBSpravochnik.GetPropertyByGUID(LineComponProp.GuidProperty); if NbProp <> nil then //Result := ConverResultToUom(OutDiam/2, NbProp.PropertyData.Izm); ED_Izm := NbProp.PropertyData.Izm else begin OutDiam := 0; LineComponProp := Nil; end; end; end end; if LineComponProp = nil then // try to find in_section or inside diameter begin LineComponProp := aLineComponent.GetPropertyBySysName(pnInDiametr); if LineComponProp <> nil then begin Outdiam := StrToFloat_My(LineComponProp.Value); if OutDiam > 0 then begin OutDiam := SQRT(OutDiam); NbProp := F_NormBase.GSCSBase.NBSpravochnik.GetPropertyByGUID(LineComponProp.GuidProperty); if NbProp <> nil then //Result := ConverResultToUom(OutDiam/2, NbProp.PropertyData.Izm); ED_Izm := NbProp.PropertyData.Izm else begin OutDiam := 0; LineComponProp := Nil; end; end; end; end; if LineComponProp = nil then begin LineComponProp := aLineComponent.GetPropertyBySysName(pnInSection); if LineComponProp <> nil then begin Outdiam := StrToFloat_My(LineComponProp.Value); if OutDiam > 0 then begin OutDiam := SQRT(OutDiam); NbProp := F_NormBase.GSCSBase.NBSpravochnik.GetPropertyByGUID(LineComponProp.GuidProperty); if NbProp <> nil then //Result := ConverResultToUom(OutDiam/2, NbProp.PropertyData.Izm); ED_Izm := NbProp.PropertyData.Izm else begin OutDiam := 0; LineComponProp := Nil; end; end; end; end; end else begin LineComponProp := aLineComponent.GetPropertyBySysName(pnCableChannelSideSection);// размер стороны каб канала //LineComponProp := aLineComponent.GetPropertyBySysName(pnOutSection); // наружное сечение if LineComponProp <> nil then begin SideString := UpperCase(LineComponProp.Value); if SideString <> '' then begin SideString := StringReplace(SideString,'Х','X',[rfReplaceAll]); CharPos := Pos('X', SideString); if CharPos > 1 then begin SideString1 := copy(SideString, 1, CharPos - 1); Delete(SideString,1,CharPos); Try Side1 := StrToFloat_My(SideString); Side2 := StrToFloat_My(SideString1); except on E: Exception do LineComponProp := Nil; end; if LineComponProp <> nil then begin OutDiam := Side1; if OutDiam > 0 then begin OutDiam := SQRT(Side1 * Side2); Result := ConverResultToUom(OutDiam/2, 'mm'); end; end; end else LineComponProp := Nil; end; end else begin LineComponProp := aLineComponent.GetPropertyBySysName(pnOutSection); // наружное сечение if LineComponprop <> nil then begin OutDiam := StrToFloat_My(LineComponProp.Value); if OutDiam > 0 then begin OutDiam := SQRT(OutDiam); Result := ConverResultToUom(OutDiam/2, 'mm'); end else LineComponProp := nil; end; end; end; if LineComponProp = nil then begin LineComponCatalog := aLineComponent.GetfirstParentCatalog; if LineComponCatalog <> nil then AddExceptionToLogEx('Tfrm3D: ', _3DNotSetSideSection + LineComponCatalog.GetNameForVisible(False) +'\'+ aLineComponent.GetNameForVisible(False)); end; if OutDiam <> 0 then Result := ConverResultToUom(OutDiam/2, 'mm') else begin // если есть и диаметр и наружное сечение, но диаметр = 0 LineComponProp := aLineComponent.GetPropertyBySysName(pnOutSection); // наружное сечение if LineComponprop <> nil then begin OutDiam := StrToFloat_My(LineComponProp.Value); if OutDiam > 0 then begin OutDiam := SQRT(OutDiam); Result := ConverResultToUom(OutDiam/2, 'mm'); end; end; end; end; Procedure AddLineCompon(aParentNode: TTreeNode; aCompon: TSCSComponent; aLine: TOrthoLine; a3DLine: T3dLine); var i: Integer; currNode: TTreeNode; dir_v: TVector3F; LinearAngle, LinearAngle1: Double; gp, ct : Double; pp1, pp2: TDoublePoint; dist1, dist2: double; cubeLineLen, cubeLineHeight: Double; canAddCompon: Boolean; begin if LineLen = 0 then exit; currNode := aParentNode; //if ComponOutRadius <> -1 then begin LinearAngle := 0; LinearAngle1:= 0; childNode := Nil; ComponOutRadius := getLineComponOutRadius(aCompon);//* UOMToMetre(1000 / FCAD.PCad.MapScale) * factor; if ComponOutRadius <> -1 then begin if ((aCompon.ComponentType.SysName = ctsnCableChannel) and (aCompon.Componenttype.GUID <> '{80B7A366-98B3-4D3A-A115-C64A3498218E}')) then begin if CanAddCableChannel then begin if (CompareValue(ComponOutRadius, StrToFloat_My(a3DLine.ComponDiameterList[2])) = 0) then begin F3DLineCompon := T3DLineComponent.Create(nil, nil,Self.F3DModel); Self.F3DModel.FScsObjects.Add(F3DLineCompon); childNode := ScsModelTree.Items.AddChild(aParentNode, aCompon.GetNameForVisible); childNode.ImageIndex := 8; childNode.SelectedIndex := 2; ChildNode.Data := F3DLineCompon; F3DLineCompon.FSCSCompon := aCompon; F3DLineCompon.FSCSComponID := aCompon.ID; TubePoint1 := GetPoint(LineFigure, 1, ComponOutRadius); TubePoint2 := GetPoint(LineFigure, 2, ComponOutRadius); TubePoint1.x := TubePoint1.x * factor; TubePoint1.z := TubePoint1.z * factor * UOMToMetre(1000 / FCAD.PCad.MapScale);// + (1 * Factor + FDeltaZ); TubePoint1.y := TubePoint1.y * factor; TubePoint2.x := TubePoint2.x * factor; TubePoint2.z := TubePoint2.z * factor * UOMToMetre(1000 / FCAD.PCad.MapScale);// + (1 * Factor + FDeltaZ); TubePoint2.y := TubePoint2.y * factor; if Length(Face.Points) > 1 then begin pp1.x := Face.Points[0].X * Factor; pp1.y := Face.Points[0].Z * Factor; pp1.z := Face.Points[0].Y * Factor; pp2.x := Face.Points[1].X * Factor; pp2.y := Face.Points[1].Z * Factor; pp2.z := Face.Points[1].Y * Factor; end else begin pp1.x := aLine.ap1.X * Factor; pp1.y := aLine.ActualZOrder[1] * factor * UOMToMetre(1000 / FCAD.PCad.MapScale);; pp1.z := aLine.ap1.y * Factor; pp2.x := aLine.ap2.X * Factor; pp2.y := aLine.ActualZOrder[2] * factor * UOMToMetre(1000 / FCAD.PCad.MapScale);; pp2.z := aLine.ap2.y * Factor; end; dist1 := SQRT(SQR(pp1.x) + SQR(pp1.y) + SQR(pp1.z)); dist2 := SQRT(SQR(pp2.x) + SQR(pp2.y) + SQR(pp2.z)); cubeLineLen := SQRT(Sqr(pp1.x - pp2.x) + Sqr(pp1.y - pp2.y) + Sqr(pp1.z - pp2.z)); cubeLineHeight := ABS(pp1.y - pp2.y); //AngleZ := 180 - RadToDeg(ArcSin(cubeLineHeight / cubeLineLen)); Arg_um_ent := ((pp1.y - pp2.y) / cubeLineLen); LinearAngle1 := RadToDeg(ArcSin(Arg_um_ent)); //LinearAngle1 := ArcSin((pp1.y - pp2.y) / cubeLineLen); //LinearAngle1 := RadToDeg(LinearAngle1); LinearAngle := aLine.GetAngleDF(pp1.x, pp1.z, pp2.x, pp2.z); // LinearAngle1 := RadToDeg(ArcSin((TubePoint1.z - TubePoint2.z) / cubeLineLen)); // LinearAngle := aLine.GetAngleDF(TubePoint1.x, TubePoint1.y, TubePoint2.x, TubePoint2.y); {While LinearAngle > 180 do LinearAngle := LinearAngle - 180; if LinearAngle <> 0 then begin // glComponCube.RotateAbsolute(0, 180 - LinearAngle, 0); //glComponCube.RotateAbsolute(0,180 - LinearAngle - 1, 0); end; // по Z if (CompareValue(TubePoint1.z, TubePoint2.z) <> 0) then begin if ((CompareValue(TubePoint1.x, TubePoint2.x) = 0) and (CompareValue(TubePoint1.y, TubePoint2.y) = 0)) then begin glComponCube.RotateAbsolute(0, 0, 90); end else begin gp := SQRT(SQR(Face.Points[0].x - Face.Points[1].x) + SQR(Face.Points[0].y - Face.Points[1].y) + SQR(Face.Points[0].z - Face.Points[1].z)); ct := (ABS(Face.Points[0].z - Face.Points[1].z)); LinearAngle1 := RadToDeg(ArcSin(ct/ gp)); if CompareValue(Face.Points[0].z, Face.Points[1].z) <> 0 then begin if CompareValue(Face.Points[0].z, Face.Points[1].z) = -1 then begin dist1 := SQRT(Sqr(Face.Points[0].x) + Sqr(Face.Points[0].y) + Sqr(Face.Points[0].z)); dist2 := SQRT(Sqr(Face.Points[1].x) + Sqr(Face.Points[1].y) + Sqr(Face.Points[1].z)); end else begin dist2 := SQRT(Sqr(Face.Points[0].x) + Sqr(Face.Points[0].y) + Sqr(Face.Points[0].z)); dist1 := SQRT(Sqr(Face.Points[1].x) + Sqr(Face.Points[1].y) + Sqr(Face.Points[1].z)); end; if CompareValue(dist1, dist2) = -1 then LinearAngle1 := 180 - LinearAngle1; end; end; end;} if cubeLineLen > 0 then begin glComponCube := TGLCube(DummyCube.AddNewChild(TglCube)); glComponCube.CubeHeight := ComponOutRadius * UOMToMetre(1000 / FCAD.PCad.MapScale) * factor * 2; glComponCube.CubeDepth := glComponCube.CubeHeight; glComponCube.CubeWidth := SQRT(SQR(TubePoint1.x - TubePoint2.x) + SQR(TubePoint1.y - TubePoint2.y) + SQR(TubePoint1.z - TubePoint2.z)); if pCnt > 1 then begin pp1 := Face.Points[0]; pp1 := DoublePoint(pp1.x * factor,pp1.z * factor,pp1.y * factor); pp2 := Face.Points[1]; pp2 := DoublePoint(pp2.x * factor,pp2.z * factor,pp2.y * factor); {if LinearAngle <> 0 then LinearAngle := 180 - LinearAngle;} glComponCube.RotateAbsolute(0, 180 - LinearAngle, LinearAngle1); glComponCube.Position.x := (pp1.x + pp2.x) / 2; glComponCube.Position.y := (pp1.y + pp2.y) / 2 + FZOrder*factor*(UOMToMetre(1000 / FCAD.PCad.MapScale)); glComponCube.Position.z := (pp1.z + pp2.z) / 2; end else begin glComponCube.RotateAbsolute(0, LinearAngle, LinearAngle1); glComponCube.Position.x := ((aLine.ap1.x + aLine.ap2.x)/2)*factor; glComponCube.Position.z := ((aLine.ap1.y + aLine.ap2.y)/2)*factor; glComponCube.Position.y := ((aLine.ActualZOrder[1] + aLine.ActualZOrder[2])/2)*factor*(UOMToMetre(1000 / FCAD.PCad.MapScale)) + FZOrder*factor*(UOMToMetre(1000 / FCAD.PCad.MapScale));// + (1 * Factor + FDeltaZ); end; DisPose(TubePoint1); DisPose(TubePoint2); if glComponCube.Material.Texture.Disabled then begin ComponColor := getLineComponColor(aCompon);//ConvertWinColor(clBlue); glComponCube.Material.FrontProperties.Ambient.Color := ComponColor; glComponCube.Material.FrontProperties.Diffuse.Color := ComponColor; glComponCube.Material.FrontProperties.Emission.Color := ComponColor; glComponCube.Material.BackProperties.Ambient.Color := ComponColor; glComponCube.Material.BackProperties.Diffuse.Color := ComponColor; glComponCube.Material.BackProperties.Emission.Color := ComponColor; end; glComponCube.Material.MaterialOptions := []; glComponCube.Material.Texture.Disabled := False; glComponCube.TagObject := ChildNode; F3DLineCompon.FGLObject := glComponCube; end; CanAddCableChannel := False; end; end; end else begin if isCableComponent(aCompon) then //(aCompon.Componenttype.GUID = '{80B7A366-98B3-4D3A-A115-C64A3498218E}') or (aCompon.ComponentType.SysName = ctsnTube) //CanAddCompon := (CompareValue(ComponOutRadius, StrToFloat_My(a3DLine.ComponDiameterList[0])) = 0) // tube CanAddCompon := ((FloatToStr(ComponOutRadius) = a3DLine.ComponDiameterList[0]) and CanAddCableCompon) // tube else //CanAddCompon := (CompareValue(ComponOutRadius, StrToFloat_My(a3DLine.ComponDiameterList[1])) = 0); // cableChannel CanAddCompon := ((FloatToStr(ComponOutRadius) = a3DLine.ComponDiameterList[1]) and CanAddTube); // cableChannel if CanAddCompon then begin F3DLineCompon := T3DLineComponent.Create(nil, nil,Self.F3DModel); Self.F3DModel.FScsObjects.Add(F3DLineCompon); childNode := ScsModelTree.Items.AddChild(aParentNode, aCompon.GetNameForVisible); childNode.ImageIndex := 8; childNode.SelectedIndex := 2; ChildNode.Data := F3DLineCompon; F3DLineCompon.FSCSCompon := aCompon; F3DLineCompon.FSCSComponID := aCompon.ID; GLCyl := TGLFREEFORM(DummyCube.AddNewChild(TGLCylinder)); if ComponOutRadius > 0 then begin TGLCyLinder(GLCyl).TopRadius := ComponOutRadius * UOMToMetre(1000 / FCAD.PCad.MapScale) * factor; TGLCyLinder(GLCyl).BottomRadius := ComponOutRadius * UOMToMetre(1000 / FCAD.PCad.MapScale) * factor; end; TGlCylinder(GLCyl).Loops := 2; TubePoint1 := GetPoint(LineFigure, 1, ComponOutRadius); TubePoint2 := GetPoint(LineFigure, 2, ComponOutRadius); if LineComponOffset = 0 then begin pN[0] := TubePoint1.x * factor; pP[0] := TubePoint2.x * factor; end else begin pN[0] := TubePoint1.x * factor + LineComponOffset; pP[0] := TubePoint2.x * factor + LineComponOffset; end; pN[1] := TubePoint1.z * factor * UOMToMetre(1000 / FCAD.PCad.MapScale) + FZOrder*factor*(UOMToMetre(1000 / FCAD.PCad.MapScale)); pN[2] := TubePoint1.y * factor; pP[1] := TubePoint2.z * factor * UOMToMetre(1000 / FCAD.PCad.MapScale) + FZOrder*factor*(UOMToMetre(1000 / FCAD.PCad.MapScale)); pP[2] := TubePoint2.y * factor; TGLCylinder(glCyl).Align(pN, pP); DisPose(TubePoint1); DisPose(TubePoint2); if GLCyl.Material.Texture.Disabled then begin ComponColor := getLineComponColor(aCompon);//ConvertWinColor(clGreen); GLCyl.Material.FrontProperties.Ambient.Color := ComponColor; GLCyl.Material.FrontProperties.Diffuse.Color := ComponColor; GLCyl.Material.FrontProperties.Emission.Color := ComponColor; GLCyl.Material.BackProperties.Ambient.Color := ComponColor; GLCyl.Material.BackProperties.Diffuse.Color := ComponColor; GLCyl.Material.BackProperties.Emission.Color := ComponColor; end; GLCyl.Material.MaterialOptions := []; GLCyl.Material.Texture.Disabled := False; GLCyl.TagObject := ChildNode; F3DLineCompon.FGLObject := GLCyl; //LineComponOffset := LineComponOffset + TGLCyLinder(GLCyl).TopRadius * 2 + (0.01 * factor * UOMToMetre(1000 / FCAD.PCad.MapScale)); if (aCompon.Componenttype.GUID = '{80B7A366-98B3-4D3A-A115-C64A3498218E}') or (aCompon.ComponentType.SysName = ctsnTube) then CanAddTube := False else CanAddCableCompon := False; end; end; end; { if ChildNode <> nil then currNode := ChildNode;} for i := 0 to aCompon.ChildReferences.Count - 1 do AddLineCompon(currNode, aCompon.ChildReferences[i], aLine, a3dLine); end; end; begin LineComponOffset := 0; CanAddCableCompon := True; CanAddCableChannel := True; CanAddTube := True; if aLine.FSCSObject <> nil then begin LineFigure := TOrthoLine(aLine.FSCSObject); if LineFigure <> nil then begin LineLen := LineFigure.LineLength; if LineLen <=0 then LineLen := LineFigure.LengthCalc; if LineLen > 0 then begin LineList := F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(FCad.FCADListID); if LineList <> nil then begin LineCatalog := LineList.GetCatalogFromReferencesBySCSID(LineFigure.ID); if LineCatalog <> nil then begin for i := 0 to LineCatalog.ComponentReferences.Count - 1 do begin LineComponent := LineCatalog.ComponentReferences[i]; if LineComponent.IsTop then begin ParentNode := xNode; AddLineCompon(ParentNode, LineComponent, LineFigure, aLine); end; end; end; end; end; end; end; end; // Tolik 02/10/2019 -- Procedure UpdateObjModelsMaterials; var i: Integer; MatName: String; LibMat: TGLLibMaterial; begin try for i := 0 to ObjMatList.Count - 1 do begin MatName := ObjMatList[i]; LibMat := MatLib.Materials.GetLibMaterialByName(MatName); if LibMat <> nil then begin LibMat.Material.FrontProperties.Shininess := 0; LibMat.Material.BackProperties.Shininess := 0; LibMat.Material.FrontProperties.Specular.Color := clrBlack; LibMat.Material.BackProperties.Specular.Color := clrBlack; end; end; Except on E: Exception do AddExceptionToLogEx('Tfrm3D.UpdateObjModelsMaterials: ', E.Message); end; ObjMatList.Clear; end; // begin try TimerOnSelectNodes.OnTimer := nil; FaceList := Faces; IsRoof := false; glCyl := nil; // Tolik 18/09/2018 -- {$IF Not Defined(ES_GRAPH_SC)} Factor := 0.15; {$ELSE} Factor := 0.15 * 10 / FScaleDelta; {$IFEND} FGridStep := FCAD.PCad.GridStep * factor; tmpdir := GetWorkDir; // ExtractDirByCategoryType(dctPictures); PrevxSide := nil; PrevxNode := nil; //Если есть какие либо объекты в DummyCube, очищяем его//// for i := 0 to DummyCube.Count - 1 do // begin // if not (DummyCube.Children[i] is TGLCamera) then // DummyCube.Children[i].DeleteChildren; // end; // TransCube.DeleteChildren; // // Beg - 2011-05-10 //LoadModelFromStream(FFileStream); //if F3DStreamModel = nil then // UpdateModelTree //else // UpdateModelTreeFromStream(Faces); // End - 2011-05-10 //// *********** FACES.COUNT ************************************************* for i := 0 to Faces.Count - 1 do begin Object3DModelLoaded := False; // Tolik 13/10/2018 -- IsAperture := false; Face := TFaceRecord(faces[i]); //типо перегоняем запись листа в кекорд xNode := Face.FTreeNode; xConn := T3DConnector(Face.F3DObject); // Tolik 15/10/2018 -- if (xConn <> nil) then if (xConn.FConnType = ct_Full) then if xNode <> nil then begin Object3DModelLoaded := Load3DSModel(xConn, xNode); if Object3DModelLoaded then begin {p := Face.Points[0]; p := DoublePoint(p.x,p.z,p.y); xConn.FOffSet.x := p.x * factor; xConn.FOffSet.y := p.y * factor; xConn.FOffSet.z := p.z * factor;} end; {xConn.FGLObject := Load3DSModel(xConn, xNode); Object3DModelLoaded := xConn.FGLObject <> nil; if Object3DModelLoaded then begin p := Face.Points[0]; p := DoublePoint(p.x,p.z,p.y); xConn.FGLObject1 := xConn.FGLObject; glObjClass := TGLSpaceText; glObject1 := TGLFreeForm(DummyCube.addNewChild(glObjClass)); TGLSpaceText(glObject1).Text := xConn.FSCSObject.Name + ' ' + inttostr(xConn.FSCSObject.FIndex); TGLSpaceText(glObject1).Scale.X := 0.4; TGLSpaceText(glObject1).Scale.y := 0.4; TGLSpaceText(glObject1).Scale.z := 0.4; TGLSpaceText(glObject1).Position.x := p.x*factor; TGLSpaceText(glObject1).Position.z := p.z*factor; if Face.Points[0].z = Face.Points[1].z then TGLSpaceText(glObject1).Position.y := (p.y + 2) * factor else TGLSpaceText(glObject1).Position.y := (p.y - 2) * factor; TGLSpaceText(glObject1).Extrusion := 0.05; TGLSpaceText(glObject1).Font.Color := clRed; TGLSpaceText(glObject1).Material.FrontProperties.Diffuse.Color := clrRed; TGLSpaceText(glObject1).Material.BackProperties.Diffuse.Color := clrRed; glObject1.Tag := Integer(Face.FFigure); xConn.FGLCaption := glObject1; p.x := p.x * factor; p.y := p.y * factor; p.z := p.z * factor; xConn.FGLPoint := p; end; } end; //if not Object3DModelLoaded then begin // //if xConn <> nil then // beep; xSide := nil; xObject := nil; if xNode <> nil then begin PrevxSide := xSide; PrevxNode := xNode; end else begin if Face.RecType = ftNetPath then begin xNode := PrevxNode; Face.FTreeNode := PrevxNode; end; end; pCnt := Length(Face.Points); for k := 0 to pCnt - 1 do begin p := Face.Points[k]; p := DoublePoint(p.x,p.z,p.y); if (i = 0) and (k = 0) then begin tx := p.x; ty := p.y; tz := p.z; bx := p.x; by := p.y; bz := p.z; end else begin if p.x > tx then tx := p.x; if p.x < bx then bx := p.x; if p.y > ty then ty := p.y; if p.y < by then by := p.y; if p.z > tz then tz := p.z; if p.z < bz then bz := p.z; end; end; case Face.RecType of ftPolygon: glObjClass := TGLPolyGon; ftLine : glObjClass := TGLLines; ftPipe,ftBar : glObjClass := TGLPipe; ftCylinder : glObjClass := TGLCylinder; ftSphere: glObjClass := TGLSphere; ftCenterCUbe: glObjClass := TGLDummyCube; ftNetPath: glObjClass := TGLPolygon; ftNetFloor: glObjClass := TGLPolygon; ftNetCeiling: glObjClass := TGLPolygon; ftNetDoor: glObjClass := TGLPolygon; ftNetWindow: glObjClass := TGLPolygon; ftNetBalconDoor: glObjClass := TGLPolygon; ftNetBalconWindow: glObjClass := TGLPolygon; ftNetFrame: glObjClass := TGLPolygon; ftNet3DSObject: glObjClass := TGLFreeForm; ftBooblick: glObjClass := TGLTorus; end; if face.OpTrans then begin //glObject := TransCube.AddNewChild(glObjClass); glObject := DummyCube.AddNewChild(glObjClass); end else begin glObject := DummyCube.AddNewChild(glObjClass); //Добавление типо фигуру в DummyCube end; glObject.TagObject := xNode; if xNode <> nil then begin // 3DS Object if Face.RecType = ftNet3DSObject then begin xObject := T3DSObject(xNode.Data); xObject.FZOrder := FZOrder * UOMToMetre(1000 / FCAD.PCad.MapScale) * factor; xObject.FGLObject := glObject; end else if Face.RecType = ftPipe then // 3D Connector begin xConn := T3DConnector(xNode.Data); xConn.FZOrder := FZOrder * UOMToMetre(1000 / FCAD.PCad.MapScale) * factor; if xConn.FGLObject = nil then xConn.FGLObject := glObject; if xConn.FisPipeElement then begin TGLPipe(glObject).Radius := xConn.FPipeRadius * UOMToMetre(1000 / FCAD.PCad.MapScale) * factor; TGLPipe(glObject).Slices := 32; TGLPipe(glObject).NodesColorMode := pncmAmbient; TGLPipe(glObject).Division := 3; TGLPipe(glObject).SplineMode := lsmNURBSCurve;//lsmBezierSpline; //lsmCubicSpline; end //Tolik 10/12/2018 -- else glObject.Visible := not Object3DModelLoaded; // end else if Face.RecType = ftLine then // 3D Line begin xLine := T3DLine(xNode.Data); xLine.FZOrder := FZOrder * UOMToMetre(1000 / FCAD.PCad.MapScale) * factor; if xLine.FGLObject = nil then xLine.FGLObject := glObject; //Tolik 18/10/2018 -- Collect3DLine(xLine); end // Tolik 18/09/2018 -- труба на трассе else if Face.RecType = ftCylinder then begin xCyl := T3DTube(xNode.Data); xCyl.FZOrder := FZOrder * UOMToMetre(1000 / FCAD.PCad.MapScale) * factor; if xCyl.FGLObject = nil then xCyl.FGlObject := glObject; TGlCylinder(glObject).TopRadius := (xCyl.FTopDiameter/2) * UOMToMetre(1000 / FCAD.PCad.MapScale) * factor; TGlCylinder(glObject).BottomRadius := (xCyl.FBottomDiameter/2) * UOMToMetre(1000 / FCAD.PCad.MapScale) * factor; TGlCylinder(glObject).Loops := 2; //TglCylinder(glObject).BeginUpdate; //TglCylinder(glObject).Parts := [cySides]; //TglCylinder(glObject).Height := xCyl.FLength * UOMToMetre(1000 / FCAD.PCad.MapScale) * factor; //TglCylinder(glObject).EndUpdate; end else if Face.RecType = ftBooblick then begin xBooblick := T3DBooblick(xNode.Data); if xBooblick.FGLObject = nil then xBooblick.FGlObject := glObject; {TGlCylinder(glObject).TopRadius := (xCyl.FTopDiameter/2) * UOMToMetre(1000 / FCAD.PCad.MapScale) * factor; TGlCylinder(glObject).BottomRadius := (xCyl.FBottomDiameter/2) * UOMToMetre(1000 / FCAD.PCad.MapScale) * factor; TGlCylinder(glObject).Loops := 2;} end // else // Arch Objects begin xSide := T3DSide(xNode.Data); xSide.FZOrder := FZOrder * UOMToMetre(1000 / FCAD.PCad.MapScale) * factor; if Face.RecType = ftNetFloor then begin T3DRoom(xSide.FParent).FZOrder := xSide.FZOrder; end; // только для первой делать if xSide.FGLObject = nil then xSide.FGLObject := glObject; end; end else if xConn <> nil then begin xConn.FZOrder := FZOrder * UOMToMetre(1000 / FCAD.PCad.MapScale) * factor; xConn.FGLObject := glObject; end; if xSide <> nil then begin if Pos('empty', AnsiLowerCase(xSide.FDescription.Text)) = 1 then begin if GLObject <> nil then GLObject.Visible := False; if xNode <> nil then if xNode.ImageIndex < 999 then begin xNode.ImageIndex := xNode.ImageIndex + 1000; xNode.SelectedIndex := xNode.ImageIndex; end; end else begin if GLObject <> nil then GLObject.Visible := True; //Это картинка, которая отображается в ModelTree if xNode <> nil then if xNode.ImageIndex > 999 then begin xNode.ImageIndex := xNode.ImageIndex - 1000; xNode.SelectedIndex := xNode.ImageIndex; end; end; end; case Face.RecType of ftPolygon: glPoly := TGLPolyGon(glObject); ftLine : glLine := TGLLines(glObject); ftPipe,ftBar : glPipe := TGLPipe(glObject); ftSphere: glSphere := TGLSphere(glObject); ftCenterCube: glCenter := TGLDummyCube(glObject); ftNetPath: glWallSide := TGLPolygon(glObject); ftNetFloor: glFloor := TGLPolygon(glObject); ftNetCeiling: glCeiling := TGLPolygon(glObject); ftNetDoor: glDoorSide := TGLPolyGon(glObject); ftNetWindow: glWindowSide := TGLPolyGon(glObject); ftNetBalconDoor: glBalconDoorSide := TGLPolyGon(glObject); ftNetBalconWindow: glBalconWindowSide := TGLPolyGon(glObject); ftNet3DSObject: gl3DSObject := TGLFreeForm(glObject); ftCylinder: glCyl := TGlCylinder(glObject); ftBooblick: glBooblick := TGLTorus(glObject); end; // ADD ZORDER TO Z //На русском звучит примерно так: когда строиться весь проект, учитываются координаты раньше построенных листов for k := 0 to pCnt - 1 do begin p := Face.Points[k]; if Face.RecType <> ftNet3DSObject then Face.Points[k] := DoublePoint(p.x, p.y, p.z + FZOrder * UOMToMetre(1000 / FCAD.PCad.MapScale)) else Face.Points[k] := DoublePoint(p.x, p.y + FZOrder * UOMToMetre(1000 / FCAD.PCad.MapScale) * Factor, p.z); end; //glCompon.AddNode(x,y,z) - добавление координат компоненту,который находиться в DummyCube, //где glCompon имеет такой же адресс, как и компонент в DummyCube // Tolik 18/09/2018 -- //if Face.RecType in [ftPolyGon,ftLine,ftPipe,ftBar,ftSphere] then if Face.RecType in [ftPolyGon,ftLine,ftPipe,ftBar,ftSphere, ftCylinder, ftBooblick] then begin for k := 0 to pCnt - 1 do begin p := Face.Points[k]; p := DoublePoint(p.x,p.z,p.y); if Face.RecType = ftPolyGon then begin glPoly.AddNode(p.x * factor, p.y * factor, p.z * factor); end else if Face.RecType = ftLine then begin p.x := p.x * factor; p.y := p.y * factor; p.z := p.z * factor; glLine.AddNode(p.x, p.y, p.z); if k = 0 then xLine.FGLPoint1 := p; if k = 1 then xLine.FGLPoint2 := p; end else if Face.RecType = ftCylinder then begin { p.x := p.x * factor; p.y := p.y * factor; p.z := p.z * factor; } end else if Face.RecType = ftSphere then begin glSphere.Position.X := p.x * factor; glSphere.Position.Y := p.z * factor; glSphere.Position.Z := p.y * factor; end else if Face.RecType = ftCenterCube then begin glCenter.Position.X := p.x * factor; glCenter.Position.Y := p.z * factor; glCenter.Position.Z := p.y * factor; end else if (Face.RecType = ftPipe) or (Face.RecType = ftBar) then begin p.x := p.x * factor; p.y := p.y * factor; p.z := p.z * factor; if xConn <> nil then begin glPipe.AddNode(p.x, p.y, p.z); if xConn.FisPipeElement then begin //TGLPipeNode(glPipe.Nodes[k]).RadiusFactor := xConn.FPipeRadius * UOMToMetre(1000 / FCAD.PCad.MapScale) * factor; if k = 0 then xConn.FGLPoint := p; //TGLPipeNode(glPipe.Nodes[k]).RadiusFactor := Round(xConn.FPipeRadiusArray[k]); end else begin //glPipe.AddNode(p.x, p.y, p.z); xConn.FGLPoint := p; end; end; end; end; // Tolik 24/09/2018 -- if (Face.RecType = ftPipe) then if pCnt > 1 then begin {glPipe.NodesColorMode := pncmAmbient;//pncmDiffuse; glPipe.Division := 3; p := Face.Points[1]; glPipe.Position.X := p.x * factor; glPipe.Position.y := p.z * factor; glPipe.Position.z := p.y * factor; glPipe.AddNode(0,0,0); } { glPipe.BeginUpdate; glPipe.Visible := True; glPipe.ResetRotations; glPipe.Parts := [ppOutside, ppStartDisk, ppStopDisk]; glPipe.Slices := 32; glPipe.ClearStructureChanged; glPipe.SplineMode := lsmLines; glPipe.NodesColorMode := pncmDiffuse; glPipe.Division := 3; glPipe.ObjectStyle := glPipe.ObjectStyle + [osDirectDraw]; glPipe.RollAngle := 10; glPipe.EndupDate; } end; // Tolik 18/09/2018 -- if Face.RecType = ftCylinder then begin p := Face.Points[0]; p1 := Face.Points[1]; //glCyl.BeginUpdate; { glCyl.Position.X := p.x * factor; glCyl.Position.Y := p.y * factor; glCyl.Position.Z := p.z * factor; glCyl.Height := 0; pN[0] := p.x * factor; pN[1] := p.y * factor; pN[2] := p.z * factor; pP[0] := p1.x * factor; pP[1] := p1.y * factor; pP[2] := p1.z * factor; } //glCyl.Alignment := caBottom; glCyl.Position.X := p.x * factor; glCyl.Position.Z := p.z * factor; glCyl.Position.Y := p.y * factor; pN[0] := p.x * factor; pN[1] := p.z * factor; pN[2] := p.y * factor; pP[0] := p1.x * factor; pP[1] := p1.z * factor; pP[2] := p1.y * factor; glCyl.Align(pN, pP); //glCyl.EndUpdate; end; if Face.RecType = ftBooblick then begin p := Face.Points[0]; glBooblick.BeginUpdate; glBooblick.Position.X := p.x * factor; glBooblick.Position.Z := p.y * factor; glBooblick.Position.Y := p.z * factor; GLBooblick.MinorRadius := 0.15 * UOMToMetre(1000 / FCAD.PCad.MapScale) * factor; GLBooblick.MajorRadius := 0.25 * UOMToMetre(1000 / FCAD.PCad.MapScale) * factor; glBooblick.Direction.DirectX := 2; glBooblick.Direction.DirectY := 0; glBooblick.Direction.DirectZ := 0; //glBooblick.Direction.DirectW := 1; //glBooblick.Roll(90); glBooblick.EndUpdate; end; // if Face.RecType = ftLine then begin p := Face.Points[0]; p := DoublePoint(p.x,p.z,p.y); p1 := Face.Points[1]; p1 := DoublePoint(p1.x,p1.z,p1.y); glObjClass1 := TGLSpaceText; p.x := (p.x + p1.x) * 0.5; p.y := (p.y + p1.y) * 0.5; p.z := (p.z + p1.z) * 0.5; glObject1 := DummyCube.AddNewChild(glObjClass1); glObject1.Tag := Integer(Face.FFigure); //29.03.2011 if (TOrthoLine(Face.FFigure).Name = cudUpDownCaption) or (TOrthoLine(Face.FFigure).Name = cCadClasses_Mes25) then begin TGLSpaceText(glObject1).Text := {$IF Defined(SCS_PE)} 'Raise' {$ELSE} 'С/П' {$IFEND} + inttostr(TOrthoLine(Face.FFigure).FIndex); TGLSpaceText(glObject1).Scale.X := 0.2; TGLSpaceText(glObject1).Scale.y := 0.2; TGLSpaceText(glObject1).Scale.z := 0.2; end else begin TGLSpaceText(glObject1).Text := TOrthoLine(Face.FFigure).Name + inttostr(TOrthoLine(Face.FFigure).FIndex); TGLSpaceText(glObject1).Scale.X := 0.4; TGLSpaceText(glObject1).Scale.y := 0.4; TGLSpaceText(glObject1).Scale.z := 0.4; end; TGLSpaceText(glObject1).Position.x := p.x*factor; TGLSpaceText(glObject1).Position.z := p.z*factor; if Face.Points[0].z = Face.Points[1].z then TGLSpaceText(glObject1).Position.y := (p.y + 2) * factor else TGLSpaceText(glObject1).Position.y := (p.y - 2) * factor; TGLSpaceText(glObject1).Extrusion := 0.05; TGLSpaceText(glObject1).Font.Color := clRed; TGLSpaceText(glObject1).Material.FrontProperties.Diffuse.Color := clrRed; TGLSpaceText(glObject1).Material.BackProperties.Diffuse.Color := clrRed; // with TGLSceneObject(glObject).Material do begin BackProperties.Ambient.AsWinColor:= Face.Color; BackProperties.Diffuse.AsWinColor := Face.Color; BackProperties.Emission.AsWinColor := Face.Color; FrontProperties.Ambient.AsWinColor := Face.Color; FrontProperties.Diffuse.AsWinColor := Face.Color; FrontProperties.Emission.AsWinColor := Face.Color; end; xLine.FGLCaption := glObject1; end; if Face.RecType = ftCylinder then begin p := Face.Points[0]; p := DoublePoint(p.x,p.z,p.y); p1 := Face.Points[1]; p1 := DoublePoint(p1.x,p1.z,p1.y); glObjClass1 := TGLSpaceText; p.x := (p.x + p1.x) * 0.5; p.y := (p.y + p1.y) * 0.5; p.z := (p.z + p1.z) * 0.5; glObject1 := DummyCube.AddNewChild(glObjClass1); glObject1.Tag := Integer(Face.FFigure); //29.03.2011 TGLSpaceText(glObject1).Text := 'Tube'; TGLSpaceText(glObject1).Scale.X := 0.4; TGLSpaceText(glObject1).Scale.y := 0.4; TGLSpaceText(glObject1).Scale.z := 0.4; TGLSpaceText(glObject1).Position.x := p.x*factor; TGLSpaceText(glObject1).Position.z := p.z*factor; if Face.Points[0].z = Face.Points[1].z then TGLSpaceText(glObject1).Position.y := (p.y + 2) * factor else TGLSpaceText(glObject1).Position.y := (p.y - 2) * factor; TGLSpaceText(glObject1).Extrusion := 0.05; TGLSpaceText(glObject1).Font.Color := clRed; TGLSpaceText(glObject1).Material.FrontProperties.Diffuse.Color := clrRed; TGLSpaceText(glObject1).Material.BackProperties.Diffuse.Color := clrRed; // with TGLSceneObject(glObject).Material do begin BackProperties.Ambient.AsWinColor:= Face.Color; BackProperties.Diffuse.AsWinColor := Face.Color; BackProperties.Emission.AsWinColor := Face.Color; FrontProperties.Ambient.AsWinColor := Face.Color; FrontProperties.Diffuse.AsWinColor := Face.Color; FrontProperties.Emission.AsWinColor := Face.Color; end; if xNode <> nil then begin xCyl := T3dTube(xNode.Data); xCyl.FGLCaption := glObject1; end; end; if Face.RecType = ftPipe then begin if ((XConn = nil) or ((xConn <> nil) and (not xConn.FisPipeElement))) then // Tolik 25/09/2018 -- begin // Tolik 05/08/2020 -- if Length(Face.Points) = 0 then Continue; // p := Face.Points[0]; p := DoublePoint(p.x,p.z,p.y); if TConnectorObject(Face.FFigure).ConnectorType <> ct_Clear then begin if TConnectorObject(Face.FFigure).Name <> ctnConnector then begin aScaleModel := 0.05; aColorModel := clrGreen; xoffset := 3; FigureID := TConnectorObject(Face.FFigure).ID; //SCSCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(FigureID); //так тож криво - PObjectData(Face.FTreeNode.Data).ListID).ListID - не тот здесь ИД. //SCSCatalog := F_ProjMan.GSCSBase.CurrProject.GetListByID(TSCSList(PObjectData(Face.FTreeNode.Data).ListID).ListID).GetCatalogFromReferencesBySCSID(FigureID); // и так криво, тож не тот ИД: //SCSCatalog := F_ProjMan.GSCSBase.CurrProject.GetListByID(FCAD.FCADListID).GetCatalogFromReferencesBySCSID(FigureID); // Tolik // а так - не лучше, так что пробуем взять каталог с "родного када", а то точно Х // SCSCatalog := F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(FCAD.FCADListID).GetCatalogFromReferencesBySCSID(FigureID); SCSCatalog := F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(TF_CAD(TF_CAD(TConnectorObject(Face.FFigure).Owner).Owner).FCadListID).GetCatalogFromReferencesBySCSID(FigureID); // if SCSCatalog <> nil then begin // Список всех компонентов верхнего уровня TSCSComponent if SCSCatalog.SCSComponents.Count > 0 then begin if SCSCatalog.SCSComponents[0].ComponentType.SysName = ctsnCupboard then begin aScaleModel := 0.1; aColorModel := clrBrown; xoffset := 4; end; if SCSCatalog.SCSComponents[0].ComponentType.SysName = ctsnBox then begin aScaleModel := 0.07; aColorModel := clrBrown; //xoffset := 4; end; if SCSCatalog.SCSComponents[0].ComponentType.SysName = ctsnCableChannelElement then begin aScaleModel := 0.02; aColorModel := clrBlue; end; end; end; if TConnectorObject(Face.FFigure).Name <> cCadClasses_Mes24 then begin glObjClass1 := TGLSpaceText; TmpP := p; //Face.Points[0]; //TmpP := DoublePoint(TmpP.x,TmpP.z,TmpP.y); glObject1 := DummyCube.AddNewChild(glObjClass1); TGLSpaceText(glObject1).Text := TConnectorObject(Face.FFigure).Name + inttostr(TConnectorObject(Face.FFigure).FIndex); TGLSpaceText(glObject1).Position.x := (TmpP.x + xoffset)*factor; TGLSpaceText(glObject1).Position.z := TmpP.z*factor; TGLSpaceText(glObject1).Position.y := TmpP.y*factor; TGLSpaceText(glObject1).Extrusion := 0.05; TGLSpaceText(glObject1).Font.Color := clRed; TGLSpaceText(glObject1).Scale.X := 0.4; TGLSpaceText(glObject1).Scale.y := 0.4; TGLSpaceText(glObject1).Scale.z := 0.4; TGLSpaceText(glObject1).Material.FrontProperties.Diffuse.Color := clrRed; TGLSpaceText(glObject1).Material.BackProperties.Diffuse.Color := clrRed; xConn.FGLCaption := glObject1; // Tolik 10/12/2018 -- TGLSpaceText(xConn.FGLCaption).Visible := not Object3DModelLoaded; //TglBasesceneObject(xConn.FGlObject).Visible; // end; glObjClass1 := TGLFreeForm; glModelObject := TGLFreeForm(DummyCube.AddNewChild(glObjClass1)); //glModelObject.ObjectStyle := []; {!!!} ImgName := GetObjectFileByHash(xConn.FObjectHash); // Exist Loaded Model if ImgName <> '' then begin glModelObject.Material.Texture.Disabled := False; glModelObject.MaterialLibrary := MatLib; // FTextures.Clear; FisCreate3DS := False; FCurrObject := xConn; glModelObject.LoadFromFile(ImgName); {TODO - проверить - возможно это таки нужно будет делать!} //for k := 0 to MatLib.Materials.Count - 1 do // MatLib.Materials[k].Material.Texture.MappingMode := tmmCubeMapCamera; glModelObject.Position.x := (p.x + xConn.FOffset.x) * factor; glModelObject.Position.z := (p.z + xConn.FOffset.y) * factor; glModelObject.Position.y := (p.y + xConn.FOffset.z) * factor; glModelObject.Scale.X := xConn.FScale.x; glModelObject.Scale.Y := xConn.FScale.y; glModelObject.Scale.Z := xConn.FScale.z; end else begin {$IF Defined(ES_GRAPH_SC)} glModelObject.LoadFromFile(ExeDir + '\3DModels\RM.3ds'); {$else} glModelObject.LoadFromFile(ExeDir + '\Map.3ds'); {$IFEND} glModelObject.Position.x := (p.x + xConn.FOffset.x) * factor; glModelObject.Position.z := (p.z + xConn.FOffset.y) * factor; glModelObject.Position.y := (p.y + xConn.FOffset.z) * factor; glModelObject.Scale.X := aScaleModel; glModelObject.Scale.Y := aScaleModel; glModelObject.Scale.Z := aScaleModel; xConn.FScale.x := glModelObject.Scale.X; xConn.FScale.y := glModelObject.Scale.Y; xConn.FScale.z := glModelObject.Scale.Z; end; glModelObject.TagObject := xNode; RotateConnModel(glModelObject, xConn.FRotate.x, xConn.FRotate.y, xConn.FRotate.z); //SetFreeFormRotate(glModelObject, xConn.FRotate.x, xConn.FRotate.y, xConn.FRotate.z); with glModelObject.Material do begin if Texture.Disabled then begin FrontProperties.Ambient.Color := aColorModel; FrontProperties.Diffuse.Color := aColorModel; FrontProperties.Emission.Color := aColorModel; BackProperties.Ambient.Color := aColorModel; BackProperties.Diffuse.Color := aColorModel; BackProperties.Emission.Color := aColorModel; end; end; glModelObject.Material.MaterialOptions := []; glModelObject.Material.Texture.Disabled := False; // glModelObject.BuildOctree; // - тормоза xConn.FColor := aColorModel; xConn.FGLObject1 := glModelObject; {TODO} // посмотреть что здесь вообще!!! ImgName1 := GetImageFileByHash(xConn.FTextureHash); if ImgName1 <> '' then begin glModelObject.MaterialLibrary := nil; try glModelObject.Material.Texture.Image.LoadFromFile(ImgName1); except ShowMessage('File not found ' + ImgName1); end; //glModelObject.Material.Texture.MappingMode := tmmCubeMapCamera; end; //Tolik -- 10/12/2018 -- //glModelObject.Visible := TglBasesceneObject(xConn.FGlObject).Visible; glModelObject.Visible := not Object3DModelLoaded; // {!!!} end else begin FigureID := TConnectorObject(Face.FFigure).ID; //SCSCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(FigureID); //SCSCatalog := F_ProjMan.GSCSBase.CurrProject.GetListByID(TSCSList(PObjectData(Face.FTreeNode.Data).ListID).ListID).GetCatalogFromReferencesBySCSID(FigureID); //SCSCatalog := F_ProjMan.GSCSBase.CurrProject.GetListByID(FCAD.FCADListID).GetCatalogFromReferencesBySCSID(FigureID); //Tolik - коммент выше // SCSCatalog := F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(FCAD.FCADListID).GetCatalogFromReferencesBySCSID(FigureID); SCSCatalog := F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(TF_CAD(TF_CAD((TConnectorObject(Face.FFigure).Owner)).Owner).FCadListID).GetCatalogFromReferencesBySCSID(FigureID); // if SCSCatalog <> nil then begin // Список всех компонентов верхнего уровня TSCSComponent if SCSCatalog.SCSComponents.Count > 0 then begin if SCSCatalog.SCSComponents[0].ComponentType.SysName = ctsnCableChannelElement then begin aScaleModel := 0.02; aColorModel := clrBlue; glObjClass1 := TGLFreeForm; glModelObject := TGLFreeForm(DummyCube.AddNewChild(glObjClass1)); {!!!} ImgName := GetObjectFileByHash(xConn.FObjectHash); // Exist Loaded Model if ImgName <> '' then begin glModelObject.Material.Texture.Disabled := False; glModelObject.MaterialLibrary := MatLib; // FTextures.Clear; FisCreate3DS := False; FCurrObject := xConn; glModelObject.LoadFromFile(ImgName); {TODO - проверить - возможно это таки нужно будет делать!} //for k := 0 to MatLib.Materials.Count - 1 do // MatLib.Materials[k].Material.Texture.MappingMode := tmmCubeMapCamera; glModelObject.Position.x := (p.x + xConn.FOffset.x) * factor; glModelObject.Position.z := (p.z + xConn.FOffset.y) * factor; glModelObject.Position.y := (p.y + xConn.FOffset.z) * factor; glModelObject.Scale.X := xConn.FScale.x; glModelObject.Scale.Y := xConn.FScale.y; glModelObject.Scale.Z := xConn.FScale.z; end else begin {$IF Defined(ES_GRAPH_SC)} glModelObject.LoadFromFile(ExeDir + '\3DModels\RM.3ds'); {$else} glModelObject.LoadFromFile(ExeDir + '\Map.3ds'); {$IFEND} glModelObject.Position.x := (p.x + xConn.FOffset.x) * factor; glModelObject.Position.z := (p.z + xConn.FOffset.y) * factor; glModelObject.Position.y := (p.y + xConn.FOffset.z) * factor; glModelObject.Scale.X := aScaleModel; glModelObject.Scale.Y := aScaleModel; glModelObject.Scale.Z := aScaleModel; xConn.FScale.x := glModelObject.Scale.X; xConn.FScale.y := glModelObject.Scale.Y; xConn.FScale.z := glModelObject.Scale.Z; end; glModelObject.TagObject := xNode; RotateConnModel(glModelObject, xConn.FRotate.x, xConn.FRotate.y, xConn.FRotate.z); //SetFreeFormRotate(glModelObject, xConn.FRotate.x, xConn.FRotate.y, xConn.FRotate.z); with glModelObject.Material do begin if Texture.Disabled then begin FrontProperties.Ambient.Color := ObjColor; FrontProperties.Diffuse.Color := ObjColor; FrontProperties.Emission.Color := ObjColor; BackProperties.Ambient.Color := ObjColor; BackProperties.Diffuse.Color := ObjColor; BackProperties.Emission.Color := ObjColor; end; end; glModelObject.Material.MaterialOptions := []; glModelObject.Material.Texture.Disabled := False; // glModelObject.BuildOctree; // - тормоза xConn.FColor := aColorModel; xConn.FGLObject1 := glModelObject; {TODO} // посмотреть что здесь вообще!!! ImgName1 := GetImageFileByHash(xConn.FTextureHash); if ImgName1 <> '' then begin glModelObject.MaterialLibrary := nil; try glModelObject.Material.Texture.Image.LoadFromFile(ImgName1); except ShowMessage('File not found ' + ImgName1); end; //glModelObject.Material.Texture.MappingMode := tmmCubeMapCamera; end {!!!} end; end; end; end; end else begin glPipe.Visible := false; //EmptyProcedure; end; end; if ((xConn <> nil) and xConn.FisPipeElement) then begin { glPipe.Position.X := xConn.FGLPoint.x; glPipe.Position.y := xConn.FGLPoint.y; glPipe.Position.z := xConn.FGLPoint.z;} {glPipe.Scale.X := 0.1; glPipe.Scale.Y := 0.1; glPipe.Scale.Z := 0.1;} glPipe.TagObject := xNode; aColorModel := clrGreen; with glPipe.Material do begin if Texture.Disabled then begin FrontProperties.Ambient.Color := aColorModel; FrontProperties.Diffuse.Color := aColorModel; FrontProperties.Emission.Color := aColorModel; BackProperties.Ambient.Color := aColorModel; BackProperties.Diffuse.Color := aColorModel; BackProperties.Emission.Color := aColorModel; end; end; end; // with TGLSceneObject(glObject).Material do begin BackProperties.Ambient.AsWinColor:= Face.Color; BackProperties.Diffuse.AsWinColor := Face.Color; BackProperties.Emission.AsWinColor := Face.Color; FrontProperties.Ambient.AsWinColor := Face.Color; FrontProperties.Diffuse.AsWinColor := Face.Color; FrontProperties.Emission.AsWinColor := Face.Color; if TConnectorObject(Face.FFigure).Name = 'Anchor' then begin BackProperties.Ambient.AsWinColor:= clNone; BackProperties.Diffuse.AsWinColor := clNone; BackProperties.Emission.AsWinColor := clNone; FrontProperties.Ambient.AsWinColor := clNone; FrontProperties.Diffuse.AsWinColor := clNone; FrontProperties.Emission.AsWinColor := clNone; end; end; end; end; if Face.RecType = ftLine then begin glLine.NodeSize := 0; glLine.ShowAxes := False; if TOrthoLine(Face.FFigure).FLineType = ts_ClearTrace then gLLine.LineWidth := 1 else gLLine.LineWidth := 4; glLine.AntiAliased := True; glLine.NodesAspect := lnaInvisible; glLine.LineColor.AsWinColor := Face.Color; //clred; xLine.FColor := Face.Color; end else if Face.RecType = ftPolyGon then begin //glPoly.Smooth := True; glPoly.Parts := [ppTop,ppBottom]; end; {TODO} // OK if not (Face.RecType in [ftNetPath, ftNetDoor, ftNetWindow, ftNetBalconDoor, ftNetBalconWindow, ftNetFloor, ftNetCeiling]) then begin with TGLSceneObject(glObject).Material do begin BackProperties.Ambient.AsWinColor:= Face.Color; BackProperties.Diffuse.AsWinColor := Face.Color; BackProperties.Emission.AsWinColor := Face.Color; FrontProperties.Ambient.AsWinColor := Face.Color; FrontProperties.Diffuse.AsWinColor := Face.Color; FrontProperties.Emission.AsWinColor := Face.Color; if Face.RecType = ftPipe then begin begin if TConnectorObject(Face.FFigure).Name = 'Anchor' then begin BackProperties.Ambient.AsWinColor:= clNone; BackProperties.Diffuse.AsWinColor := clNone; BackProperties.Emission.AsWinColor := clNone; FrontProperties.Ambient.AsWinColor := clNone; FrontProperties.Diffuse.AsWinColor := clNone; FrontProperties.Emission.AsWinColor := clNone; end; end; end; end; end; {TODO} // OK // ********************** NETPATHs ***************************************** if Face.RecType = ftNetPath then begin for k := 0 to pCnt - 1 do begin p := Face.Points[k]; p := DoublePoint(p.x, p.z, p.y); p1 := Face.Points[1]; p1 := DoublePoint(p1.x, p1.z, p1.y); p.x := p.x * factor; if (Face.FFaceWallType in [fwtDoorSlope, fwtWindowSlope, fwtBalconSlope, fwtNiche]) then begin if (p.y < 0.011) then begin if (p.y <> p1.y) then p.y := p.y * factor else p.y := p.y * factor + FDeltaZSlope; end else p.y := p.y * factor; end else p.y := p.y * factor; p.z := p.z * factor; //В зависимости от того, сколько раз пройдет цик ФОР, столько точек и будет задано //в полигоне glWallSide.AddNode(p.x, p.y, p.z); if xSide <> nil then xSide.FGLPoints[k] := p; end; with TGLSceneObject(glObject).Material do begin aColor := clrNewTan; BackProperties.Ambient.Color := aColor; BackProperties.Diffuse.Color := aColor; BackProperties.Emission.Color := aColor; FrontProperties.Ambient.Color := aColor; FrontProperties.Diffuse.Color := aColor; FrontProperties.Emission.Color := aColor; Texture.texturemode := tmDecal; Texture.Disabled := False; ImgName := GetImageFileByHash(xSide.FTextureHash); if ImgName <> '' then begin try Texture.Image.LoadFromFile(ImgName); except ShowMessage('File not found ' + ImgName); end; end else begin try if Face.FFaceWallType = fwtInner then Texture.Image.LoadFromFile(ExeDir + '\3DTextures\inner_wall.bmp') else if Face.FFaceWallType = fwtOuter then Texture.Image.LoadFromFile(ExeDir + '\3DTextures\outer_wall.bmp') else if Face.FFaceWallType = fwtDoorSlope then Texture.Image.LoadFromFile(ExeDir + '\3DTextures\door_slope.bmp') else if Face.FFaceWallType = fwtWindowSlope then Texture.Image.LoadFromFile(ExeDir + '\3DTextures\window_slope.bmp') else if Face.FFaceWallType = fwtArc then Texture.Image.LoadFromFile(ExeDir + '\3DTextures\arc.bmp') else if Face.FFaceWallType = fwtBalconSlope then Texture.Image.LoadFromFile(ExeDir + '\3DTextures\balcon_slope.bmp') else if Face.FFaceWallType = fwtNiche then Texture.Image.LoadFromFile(ExeDir + '\3DTextures\niche.bmp'); except ShowMessage('Texture File not found'); end; end; end; RotateTextureToAngleP(xSide, GLWallSide, xSide.FTextureRotate, xSide.FMirror); end; // ********************** NETPATHs ***************************************** // ********************** NETDOORs ***************************************** if Face.RecType = ftNetDoor then begin for k := 0 to pCnt - 1 do begin p := Face.Points[k]; p := DoublePoint(p.x, p.z, p.y); p1 := Face.Points[1]; p1 := DoublePoint(p1.x, p1.z, p1.y); p.x := p.x * factor; if (p.y < 0.011) then begin if (p.y <> p1.y) then p.y := p.y * factor else p.y := p.y * factor + FDeltaZSlope end else p.y := p.y * factor; p.z := p.z * factor; glDoorSide.AddNode(p.x, p.y, p.z); xSide.FGLPoints[k] := p; end; with TGLSceneObject(glObject).Material do begin aColor := clrTan; BackProperties.Ambient.Color := aColor; BackProperties.Diffuse.Color := aColor; BackProperties.Emission.Color := aColor; FrontProperties.Ambient.Color := aColor; FrontProperties.Diffuse.Color := aColor; FrontProperties.Emission.Color := aColor; MaterialOptions := [moNoLighting]; end; end; // ********************** NETDOORs ***************************************** // ********************** NETWINDOWs *************************************** if Face.RecType = ftNetWindow then begin for k := 0 to pCnt - 1 do begin p := Face.Points[k]; p := DoublePoint(p.x, p.z, p.y); p1 := Face.Points[1]; p1 := DoublePoint(p1.x, p1.z, p1.y); p.x := p.x * factor; //if (p.y < 0.011) then //begin // if (p.y <> p1.y) then // p.y := p.y * factor // else // p.y := p.y * factor + FDeltaZSlope //end //else p.y := p.y * factor; p.z := p.z * factor; glWindowSide.AddNode(p.x, p.y, p.z); xSide.FGLPoints[k] := p; end; with TGLSceneObject(glObject).Material do begin aColor := clrSilver; BackProperties.Ambient.Color := aColor; BackProperties.Diffuse.Color := aColor; BackProperties.Emission.Color := aColor; FrontProperties.Ambient.Color := aColor; FrontProperties.Diffuse.Color := aColor; FrontProperties.Emission.Color := aColor; MaterialOptions := [moNoLighting]; end; end; // ********************** NETWINDOWs *************************************** // ********************** NETBALCONs *************************************** if Face.RecType = ftNetBalconDoor then begin for k := 0 to pCnt - 1 do begin p := Face.Points[k]; p := DoublePoint(p.x, p.z, p.y); p1 := Face.Points[1]; p1 := DoublePoint(p1.x, p1.z, p1.y); p.x := p.x * factor; if (p.y < 0.011) then begin if (p.y <> p1.y) then p.y := p.y * factor else p.y := p.y * factor + FDeltaZSlope end else p.y := p.y * factor; p.z := p.z * factor; glBalconDoorSide.AddNode(p.x, p.y, p.z); xSide.FGLPoints[k] := p; end; with TGLSceneObject(glObject).Material do begin aColor := clrGray80; BackProperties.Ambient.Color := aColor; BackProperties.Diffuse.Color := aColor; BackProperties.Emission.Color := aColor; FrontProperties.Ambient.Color := aColor; FrontProperties.Diffuse.Color := aColor; FrontProperties.Emission.Color := aColor; MaterialOptions := [moNoLighting]; end; end; if Face.RecType = ftNetBalconWindow then begin for k := 0 to pCnt - 1 do begin p := Face.Points[k]; p := DoublePoint(p.x, p.z, p.y); p1 := Face.Points[1]; p1 := DoublePoint(p1.x, p1.z, p1.y); p.x := p.x * factor; //if (p.y < 0.011) then //begin // if (p.y <> p1.y) then // p.y := p.y * factor // else // p.y := p.y * factor + FDeltaZSlope //end //else p.y := p.y * factor; p.z := p.z * factor; glBalconWindowSide.AddNode(p.x, p.y, p.z); xSide.FGLPoints[k] := p; end; with TGLSceneObject(glObject).Material do begin aColor := clrSilver; BackProperties.Ambient.Color := aColor; BackProperties.Diffuse.Color := aColor; BackProperties.Emission.Color := aColor; FrontProperties.Ambient.Color := aColor; FrontProperties.Diffuse.Color := aColor; FrontProperties.Emission.Color := aColor; MaterialOptions := [moNoLighting]; end; end; // ********************** NETBALCONs *************************************** // ********************** NETFLOOR ***************************************** {TODO} // OK (* if Face.RecType = ftNetFloor then begin glFloor.Direction.Y := -1; glFloor.Direction.Z := 0; glFloor.Direction.X := 0; glFloor.Up.Y := 0; glFloor.Up.Z := 1; glFloor.Up.X := 0; SetLength(FloorCoords, pCnt div 2); for k := 0 to (pCnt div 2) - 1 do begin p := Face.Points[k]; p := DoublePoint(p.x, p.z, p.y); FloorCoords[k][0] := p.x * factor; FloorCoords[k][1] := p.y * factor + FDeltaZ; FloorCoords[k][2] := p.z * factor; end; if (pCnt div 2) >= 3 then begin for k := 0 to (pCnt div 2) - 3 do begin dp1 := DoublePoint(FloorCoords[0][0], FloorCoords[0][2], FloorCoords[0][1]); dp2 := DoublePoint(FloorCoords[k + 1][0], FloorCoords[k + 1][2], FloorCoords[k + 1][1]); Angle1 := GetLineAngle(dp1, dp2); dp1 := DoublePoint(FloorCoords[k + 1][0], FloorCoords[k + 1][2], FloorCoords[k + 1][1]); dp2 := DoublePoint(FloorCoords[k + 2][0], FloorCoords[k + 2][2], FloorCoords[k + 2][1]); Angle2 := GetLineAngle(dp1, dp2); ResAng := abs(Angle1 - Angle2); //if ResAng < 180 then begin pN := CalcPlaneNormal (FloorCoords[0], FloorCoords[k + 1], FloorCoords[k + 2]); if (not isNaN(pN[0])) and (Not IsNaN(pN[1])) and (Not IsNaN(pN[2])) then break; end; end; if k > ((pCnt div 2) - 1) then k := 0; pN := CalcPlaneNormal (FloorCoords[0], FloorCoords[k + 1], FloorCoords[k + 2]); end else pN[1] := 0; if pN[1] >= 0 then glFloor.Parts := [ppTop] else glFloor.Parts := [ppBottom]; for k := 0 to (pCnt div 2) - 1 do begin p := Face.Points[k]; p := DoublePoint(p.x, p.y, p.z); glFloor.AddNode(p.x * factor, p.y * factor, p.z * factor + FDeltaZ); end; with TGLSceneObject(glObject).Material do begin aColor := clrSilver; BackProperties.Ambient.Color := aColor; BackProperties.Diffuse.Color := aColor; BackProperties.Emission.Color := aColor; FrontProperties.Ambient.Color := aColor; FrontProperties.Diffuse.Color := aColor; FrontProperties.Emission.Color := aColor; Texture.texturemode := tmDecal; Texture.Disabled := False; Texture.Image.LoadFromFile(tex_floor); TGLSceneObject(glObject).Tag := 998; end; end; *) if Face.RecType = ftNetFloor then begin { glFloor.Direction.Y := -1; glFloor.Direction.Z := 0; glFloor.Direction.X := 0; glFloor.Up.Y := 0; glFloor.Up.Z := 1; glFloor.Up.X := 0; } //19.06.2012 // Tolik 13/01/2019 -- if Length(Face.PointsForNormal) > 0 then NormalPoints := GetPointsForNormal(Face.PointsForNormal) else NormalPoints := GetPointsForNormal(Face.Points); pCntNormal := Length(NormalPoints); SetLength(FloorCoords, pCntNormal); for k := 0 to pCntNormal - 1 do begin p := NormalPoints[k]; //19.06.2012 Face.Points[k]; p := DoublePoint(p.x, p.z, p.y); FloorCoords[k][0] := p.x * factor; FloorCoords[k][1] := p.y * factor + FDeltaZFloor; //FDeltaZ; FloorCoords[k][2] := p.z * factor; end; if pCntNormal >= 3 then begin for k := 0 to pCntNormal - 3 do begin { dp1 := DoublePoint(FloorCoords[0][0], FloorCoords[0][2], FloorCoords[0][1]); dp2 := DoublePoint(FloorCoords[k + 1][0], FloorCoords[k + 1][2], FloorCoords[k + 1][1]); Angle1 := GetLineAngle(dp1, dp2); dp1 := DoublePoint(FloorCoords[k + 1][0], FloorCoords[k + 1][2], FloorCoords[k + 1][1]); dp2 := DoublePoint(FloorCoords[k + 2][0], FloorCoords[k + 2][2], FloorCoords[k + 2][1]); Angle2 := GetLineAngle(dp1, dp2); ResAng := abs(Angle1 - Angle2); //if ResAng < 180 then } begin pN := CalcPlaneNormal (FloorCoords[0], FloorCoords[k + 1], FloorCoords[k + 2]); if (not isNaN(pN[0])) and (Not IsNaN(pN[1])) and (Not IsNaN(pN[2])) then break; end; end; if k > (pCntNormal - 1) then k := 0; pN := CalcPlaneNormal (FloorCoords[0], FloorCoords[k + 1], FloorCoords[k + 2]); end else pN[1] := 0; {$IF Defined(ES_GRAPH_SC)} IsRoof := ifFiguraISRoof(GetNetByComponID(t3droom(xSide.FParent).FSCSCOmpon.ID,GCadForm)); //Отображает плоскости крыши если смотреть и сверху и снизу...Потому и залочил if not ISRoof then {$IFEND} if pN[1] >= 0 then glFloor.Parts := [ppTop] else glFloor.Parts := [ppBottom]; //Задаем точки для отрисовки полигона///////////////////////////////////////////////////////// setLength(xSide.FGLPoints, pCnt); glPointIndex := 0; for k := 0 to pCnt - 1 do // begin // p := Face.Points[k]; //Tolik 14/01/2020 if k > 0 then begin if not comparePoint(p, Face.Points[k - 1], cmpNearestPointDelta) then begin p := DoublePoint(p.x * factor, p.z * factor + FDeltaZFloor, p.y * factor); {TODO} // OK // glFloor.AddNode(p.x, p.y, p.z); // xSide.FGLPoints[glPointIndex] := p; inc(glPointIndex); end; end // else begin p := DoublePoint(p.x * factor, p.z * factor + FDeltaZFloor, p.y * factor); {TODO} // OK // glFloor.AddNode(p.x, p.y, p.z); // xSide.FGLPoints[glPointIndex] := p; inc(glPointIndex); end; end; setLength(xSide.FGLPoints, glPointIndex); setLength(NormalPoints, 0); NormalPoints := GetPointsForNormalVector(xSide.FGLPoints); pCntNormal := Length(NormalPoints); SetLength(FloorCoords, 0); if pCntNormal >= 3 then begin SetLength(FloorCoords, pCntNormal); for k := 0 to pCntNormal - 1 do begin p := NormalPoints[k]; FloorCoords[k][0] := p.x; FloorCoords[k][1] := p.y; FloorCoords[k][2] := p.z; end; for k := 0 to pCntNormal - 3 do begin begin pN2 := CalcPlaneNormal (FloorCoords[0], FloorCoords[k + 1], FloorCoords[k + 2]); if (not isNaN(pN[0])) and (Not IsNaN(pN[1])) and (Not IsNaN(pN[2])) then break; end; end; if k > (pCntNormal - 1) then k := 0; pN2 := CalcPlaneNormal(FloorCoords[0], FloorCoords[k + 1], FloorCoords[k + 2]); if (pN2[1] <> 0) and (Not IsNaN(pN2[1])) then begin if (pN2[1] > 0) then glFloor.Parts := [ppTop] else glFloor.Parts := [ppBottom]; end; end; { SetLength(FloorCoords, 3); for k := 0 to 2 do begin p := xSide.FGLPoints[k]; FloorCoords[k][0] := p.x; FloorCoords[k][1] := p.y; FloorCoords[k][2] := p.z; end; pN2 := CalcPlaneNormal (FloorCoords[0], FloorCoords[1], FloorCoords[2]); if (not isNaN(pN[0])) and (Not IsNaN(pN[1])) and (Not IsNaN(pN[2])) then begin if (pN2[1] > 0) then glFloor.Parts := [ppTop] else glFloor.Parts := [ppBottom]; end; } xSide.FZOrder := xSide.FZOrder + FDeltaZFloor; with TGLSceneObject(glObject).Material do begin aColor := clrSilver; BackProperties.Ambient.Color := aColor; BackProperties.Diffuse.Color := aColor; BackProperties.Emission.Color := aColor; FrontProperties.Ambient.Color := aColor; FrontProperties.Diffuse.Color := aColor; FrontProperties.Emission.Color := aColor; Texture.texturemode := tmDecal; Texture.Disabled := False; ImgName := GetImageFileByHash(xSide.FTextureHash); if ImgName <> '' then begin try Texture.Image.LoadFromFile(ImgName); except ShowMessage('File not found ' + ImgName); end; end else begin try Texture.Image.LoadFromFile(ExeDir + '\3DTextures\floor.bmp'); except ShowMessage('File not found ' + ExeDir + '\3DTextures\floor.bmp'); end; end; end; RotateTextureToAngleP(xSide, GLFloor, xSide.FTextureRotate, xSide.FMirror); end; // ********************** NETFLOOR ***************************************** // ********************** NETCEILING *************************************** {TODO} // OK (* if Face.RecType = ftNetCeiling then begin glCeiling.Direction.Y := -1; glCeiling.Direction.Z := 0; glCeiling.Direction.X := 0; glCeiling.Up.Y := 0; glCeiling.Up.Z := 1; glCeiling.Up.X := 0; SetLength(FloorCoords, pCnt div 2); for k := 0 to (pCnt div 2) - 1 do begin p := Face.Points[k]; p := DoublePoint(p.x, p.z, p.y); FloorCoords[k][0] := p.x * factor; FloorCoords[k][1] := p.y * factor + FDeltaZ; FloorCoords[k][2] := p.z * factor; end; if (pCnt div 2) >= 3 then begin for k := 0 to (pCnt div 2) - 3 do begin dp1 := DoublePoint(FloorCoords[0][0], FloorCoords[0][2], FloorCoords[0][1]); dp2 := DoublePoint(FloorCoords[k + 1][0], FloorCoords[k + 1][2], FloorCoords[k + 1][1]); Angle1 := GetLineAngle(dp1, dp2); dp1 := DoublePoint(FloorCoords[k + 1][0], FloorCoords[k + 1][2], FloorCoords[k + 1][1]); dp2 := DoublePoint(FloorCoords[k + 2][0], FloorCoords[k + 2][2], FloorCoords[k + 2][1]); Angle2 := GetLineAngle(dp1, dp2); ResAng := abs(Angle1 - Angle2); //if ResAng < 180 then begin pN := CalcPlaneNormal (FloorCoords[0], FloorCoords[k + 1], FloorCoords[k + 2]); if (not isNaN(pN[0])) and (Not IsNaN(pN[1])) and (Not IsNaN(pN[2])) then break; end; end; if k > ((pCnt div 2) - 1) then k := 0; pN := CalcPlaneNormal (FloorCoords[0], FloorCoords[k + 1], FloorCoords[k + 2]); end else pN[1] := 0; if pN[1] >= 0 then glCeiling.Parts := [ppBottom] else glCeiling.Parts := [ppTop]; for k := 0 to (pCnt div 2) - 1 do begin p := Face.Points[k]; p := DoublePoint(p.x, p.y, p.z); glCeiling.AddNode(p.x * factor, p.y * factor, - (p.z * factor + FDeltaZ) ); end; with TGLSceneObject(glObject).Material do begin aColor := clrSilver; BackProperties.Ambient.Color := aColor; BackProperties.Diffuse.Color := aColor; BackProperties.Emission.Color := aColor; FrontProperties.Ambient.Color := aColor; FrontProperties.Diffuse.Color := aColor; FrontProperties.Emission.Color := aColor; Texture.texturemode := tmDecal; Texture.Disabled := False; Texture.Image.LoadFromFile(tex_ceiling); TGLSceneObject(glObject).Tag := 999; end; end; *) if Face.RecType = ftNetCeiling then //Тут,я так понял и нужно ковырнуть, чтоб потолок рисовался правильно begin { glCeiling.Direction.Y := -1; glCeiling.Direction.Z := 0; glCeiling.Direction.X := 0; glCeiling.Up.Y := 0; glCeiling.Up.Z := 1; glCeiling.Up.X := 0; } //19.06.2012 //тут может быть ошибочка,потому, что в одной прорисовке не правильно берет координаты // Tolik 13/01/2019 -- if Length(Face.PointsForNormal) > 0 then NormalPoints := GetPointsForNormal(Face.PointsForNormal) else NormalPoints := GetPointsForNormal(Face.Points); //NormalPoints := GetPointsForNormal(Face.Points); // pCntNormal := Length(NormalPoints); SetLength(FloorCoords, pCntNormal); for k := 0 to pCntNormal - 1 do begin p := NormalPoints[k]; //19.06.2012 Face.Points[k]; p := DoublePoint(p.x, p.z, p.y); FloorCoords[k][0] := p.x * factor; FloorCoords[k][1] := p.y * factor + FDeltaZ; FloorCoords[k][2] := p.z * factor; end; if pCntNormal >= 3 then begin for k := 0 to pCntNormal - 3 do begin { dp1 := DoublePoint(FloorCoords[0][0], FloorCoords[0][2], FloorCoords[0][1]); dp2 := DoublePoint(FloorCoords[k + 1][0], FloorCoords[k + 1][2], FloorCoords[k + 1][1]); //достаем угол между двумя точками в пространстве Angle1 := GetLineAngle(dp1, dp2); dp1 := DoublePoint(FloorCoords[k + 1][0], FloorCoords[k + 1][2], FloorCoords[k + 1][1]); dp2 := DoublePoint(FloorCoords[k + 2][0], FloorCoords[k + 2][2], FloorCoords[k + 2][1]); Angle2 := GetLineAngle(dp1, dp2); ResAng := abs(Angle1 - Angle2); //if ResAng < 180 then } begin pN := CalcPlaneNormal (FloorCoords[0], FloorCoords[k + 1], FloorCoords[k + 2]); if (not isNaN(pN[0])) and (Not IsNaN(pN[1])) and (Not IsNaN(pN[2])) then break; end; end; if k > (pCntNormal - 1) then k := 0; pN := CalcPlaneNormal (FloorCoords[0], FloorCoords[k + 1], FloorCoords[k + 2]); end else pN[1] := 0; {$IF Defined(ES_GRAPH_SC)} if TOBject(xSide.FParent) is t3droom then IsRoof := ifFiguraISRoof(GetNetByComponID(t3droom(xSide.FParent).FSCSCompon.ID,GCadForm)); //Отображает плоскости крыши если смотреть и сверху и снизу...Потому и залочил if not ISRoof then {$IFEND} if pN[1] >= 0 then glCeiling.Parts := [ppBottom] else glCeiling.Parts := [ppTop]; {$IF Defined(ES_GRAPH_SC)} if TOBject(xSide.FParent) is t3droom then for k := 0 to t3droom(xSide.FParent).FSCSCompon.Properties.Count - 1 do if PProperty(t3droom(xSide.FParent).FSCSCompon.Properties[k]).SysName = 'RESIDUE' then begin IsAperture := True; break; end; {$IFEND} //Добавление точек построения плоскости потолка(крыши);////////////////////// glPointIndex := 0; for k := 0 to pCnt - 1 do // begin // p := Face.Points[k]; // //Tolik 14/01/2020 if k > 0 then begin if not comparePoint(p, Face.Points[k - 1], cmpNearestPointDelta) then begin p := DoublePoint(p.x * factor, p.z * factor + FDeltaZ, p.y * factor); // {$IF Defined(ES_GRAPH_SC)} if IsAperture then // glCeiling.AddNode(p.x, p.y+0.03, p.z) // else // {$IFEND} glCeiling.AddNode(p.x, p.y, p.z); // //xSide.FGLPoints[k] := p; // xSide.FGLPoints[glPointIndex] := p; inc(glPointIndex); end; end else begin p := DoublePoint(p.x * factor, p.z * factor + FDeltaZ, p.y * factor); // {$IF Defined(ES_GRAPH_SC)} if IsAperture then // glCeiling.AddNode(p.x, p.y+0.03, p.z) // else // {$IFEND} glCeiling.AddNode(p.x, p.y, p.z); // //xSide.FGLPoints[k] := p; // xSide.FGLPoints[glPointIndex] := p; inc(glPointIndex); end; end; setLength(xSide.FGLPoints, glPointIndex); setLength(NormalPoints, 0); NormalPoints := GetPointsForNormalVector(xSide.FGLPoints); pCntNormal := Length(NormalPoints); SetLength(FloorCoords, 0); if pCntNormal >= 3 then begin SetLength(FloorCoords, pCntNormal); for k := 0 to pCntNormal - 1 do begin p := NormalPoints[k]; FloorCoords[k][0] := p.x; FloorCoords[k][1] := p.y; FloorCoords[k][2] := p.z; end; for k := 0 to pCntNormal - 3 do begin begin // pN2 := CalcPlaneNormal (FloorCoords[0], FloorCoords[k + 1], FloorCoords[k + 2]); pN2 := CalcPlaneNormal (FloorCoords[k], FloorCoords[k + 1], FloorCoords[k + 2]); if (not isNaN(pN[0])) and (Not IsNaN(pN[1])) and (Not IsNaN(pN[2])) then break; end; end; if k > (pCntNormal - 1) then k := 0; //pN2 := CalcPlaneNormal(FloorCoords[0], FloorCoords[k + 1], FloorCoords[k + 2]); pN2 := CalcPlaneNormal(FloorCoords[k], FloorCoords[k + 1], FloorCoords[k + 2]); if (pN2[1] <> 0) and (Not IsNaN(pN2[1])) then begin if (pN2[1] > 0) then glCeiling.Parts := [ppBottom] else glCeiling.Parts := [ppTop]; end; end; xSide.FZOrder := xSide.FZOrder + FDeltaZ; with TGLSceneObject(glObject).Material do begin aColor := clrSilver; BackProperties.Ambient.Color := aColor; BackProperties.Diffuse.Color := aColor; BackProperties.Emission.Color := aColor; FrontProperties.Ambient.Color := aColor; FrontProperties.Diffuse.Color := aColor; FrontProperties.Emission.Color := aColor; Texture.texturemode := tmDecal; Texture.Disabled := False; ImgName := GetImageFileByHash(xSide.FTextureHash); if ImgName <> '' then begin try Texture.Image.LoadFromFile(ImgName); except ShowMessage('File not found ' + ImgName); end; end else begin if not IsAperture then begin try Texture.Image.LoadFromFile(ExeDir + '\3DTextures\ceiling.bmp') except ShowMessage('File not found ' + ExeDir + '\3DTextures\ceiling.bmp'); end; end else begin //проем вообще оставим без текстуры пока //try // Texture.Image.LoadFromFile(ExeDir + '\3DTextures\window_slope.bmp'); //except // ShowMessage('File not found ' + ExeDir + '\3DTextures\window_slope.bmp'); //end; end; end; end; RotateTextureToAngleP(xSide, GLCeiling, xSide.FTextureRotate, xSide.FMirror);//Повернуть текстуру на заданный угол end; // ********************** NETCEILING *************************************** // ********************** NET3DSObject ************************************* if Face.RecType = ftNet3DSObject then begin gl3DSObject.Material.Texture.Disabled := False; try // на поднятии подменяем на текущий savedir! { if FileExists(ExeDir + '\' + dnSave + '\' + ExtractFileName(xObject.FPath)) then xObject.FPath := ExeDir + '\' + dnSave + '\' + ExtractFileName(xObject.FPath) else begin // если нет такого знач просто буковку текущего диска подставим. xObject.FPath := copy(ExeDir, 1, 1) + copy(xObject.FPath, 2, $FFFF); end; } ImgName := GetObjectFileByHash(xObject.FObjectHash); if ImgName <> '' then begin gl3DSObject.Material.Texture.Disabled := False; gl3DSObject.MaterialLibrary := MatLib; // FTextures.Clear; FisCreate3DS := False; FCurrObject := xObject; gl3DSObject.LoadFromFile(ImgName); {TODO - проверить - возможно это таки нужно будет делать!} //for k := 0 to MatLib.Materials.Count - 1 do // MatLib.Materials[k].Material.Texture.MappingMode := tmmCubeMapCamera; for k := 0 to pCnt - 1 do begin p := Face.Points[k]; gl3DSObject.Position.x := p.x; gl3DSObject.Position.y := p.y; gl3DSObject.Position.z := p.z; end; gl3DSObject.Scale.x := xObject.FScale.x; gl3DSObject.Scale.y := xObject.FScale.y; gl3DSObject.Scale.z := xObject.FScale.z; Rotate3DSObj(gl3DSObject, xObject.FRotate.x, xObject.FRotate.y, xObject.FRotate.z); //SetFreeFormRotate(gl3DSObject, xObject.FRotate.x, xObject.FRotate.y, xObject.FRotate.z); with gl3DSObject.Material do begin if Texture.Disabled then begin FrontProperties.Ambient.Color := ObjColor; FrontProperties.Diffuse.Color := ObjColor; FrontProperties.Emission.Color := ObjColor; BackProperties.Ambient.Color := ObjColor; BackProperties.Diffuse.Color := ObjColor; BackProperties.Emission.Color := ObjColor; end; end; gl3DSObject.Material.MaterialOptions := []; gl3DSObject.Material.Texture.Disabled := False; // gl3DSObject.BuildOctree; // - тормоза // LOAD texture from Hash {TODO} // посмотреть что здесь вообще!!! {TODO} // Пересмотреть что здесь за хрень вообще пытается грузится!!! ImgName1 := GetImageFileByHash(xObject.FTextureHash); if ImgName1 <> '' then begin gl3DSObject.MaterialLibrary := nil; try gl3DSObject.Material.Texture.Image.LoadFromFile(ImgName1); except ShowMessage('File not found ' + ImgName1); end; //gl3DSObject.Material.Texture.MappingMode := tmmCubeMapCamera; end end; except end; end; // ********************** NET3DSObject ************************************* with TGLSceneObject(glObject).Material do begin if (Face.Trans) or (face.OpTrans) then begin BlendingMode := bmTransparency; BackProperties.Diffuse.Alpha := 0.4; FrontProperties.Diffuse.Alpha := 0.4; end; end; if Face.RecType = ftPipe then begin {$IF Defined(ES_GRAPH_SC)} glPipe.Radius := 0; {$ELSE} //Tolik 25/09/2018 -- //glPipe.Radius := Face.Size if xConn = nil then glPipe.Radius := Face.Size else if not xConn.FisPipeElement then glPipe.Radius := Face.Size; // {$IFEND} glPipe.Parts := [ppOutSide,ppInSide,ppStartDisk,ppStopDisk]; end else if Face.RecType = ftBar then begin glPipe.Radius := 0.06; end else if Face.RecType = ftSphere then begin glSphere.Radius := Face.Size * factor; end else if Face.RecType = ftCenterCube then begin end else begin end; //*******************ROOF******************* if IsRoof then begin if xNode <> nil then //Если такой нод существует в дереве begin if (TObject(xNode.Data) is T3dside)and(TObject(T3dside(xNode.Data).FParent) is t3droom) then begin if t3droom(T3dside(xNode.Data).FParent).FWalls <> nil then //Если у него есть стены begin for iWall:= 0 to t3droom(T3dside(xNode.Data).FParent).FWalls.count-1 do //Проходимся по всем стенам begin Wall := T3DWall(t3droom(T3dside(xNode.Data).FParent).FWalls[iWall]); //Порядковый номер стены for iModelCnt := 0 to ModelTree.Items.Count - 1 do //Находим соответствующую стену с ModelTree//// if AnsiUpperCase(Wall.FName) = AnsiUpperCase(ModelTree.Items[iModelCnt].Text) then // begin // if Wall.FParent.FName = ModelTree.Items[iModelCnt].Parent.Text then // begin // WallNode := ModelTree.Items[iModelCnt]; // Запоминаем найденный нод в дереве glObject := DummyCube.AddNewChild(TGLLines); //Добавление фигуры в DummyCube (линия) glObject.TagObject := WallNode; //связываем её с веткой нода Wall.FZOrder := FZOrder * UOMToMetre(1000 / FCAD.PCad.MapScale) * factor; if Wall.FGLObject = nil then Wall.FGLObject := glObject; //запоминаем у стены какой ей пренадлежит объект GLScene glLine := TGLLines(glObject); //Распределяем координаты... case Face.RecType of ftNetCeiling: pArr := Wall.FParent.FCeilingConture; ftNetFloor: pArr := Wall.FParent.FFloorConture; end; pCnt := length(pArr); { //Корректировка координаты Z//////////////////////////////////////////////////////// for k := 0 to pCnt-1 do // begin // p := pArr[k]; // if (p.x = Wall.FPlanObject.p1.x)and(p.y = Wall.FPlanObject.p1.y) then // Wall.FPlanObject.p1.z := p.z+ FZOrder * UOMToMetre(1000 / FCAD.PCad.MapScale);// if (p.x = Wall.FPlanObject.p2.x)and(p.y = Wall.FPlanObject.p2.y) then // Wall.FPlanObject.p2.z := p.z+ FZOrder * UOMToMetre(1000 / FCAD.PCad.MapScale);// if (p.x = Wall.FPlanObject.l1.x)and(p.y = Wall.FPlanObject.l1.y) then // Wall.FPlanObject.p1.z := p.z+ FZOrder * UOMToMetre(1000 / FCAD.PCad.MapScale);// if (p.x = Wall.FPlanObject.l2.x)and(p.y = Wall.FPlanObject.l2.y) then // Wall.FPlanObject.p2.z := p.z+ FZOrder * UOMToMetre(1000 / FCAD.PCad.MapScale);// if (p.x = Wall.FPlanObject.r1.x)and(p.y = Wall.FPlanObject.r1.y) then // Wall.FPlanObject.p1.z := p.z+ FZOrder * UOMToMetre(1000 / FCAD.PCad.MapScale);// if (p.x = Wall.FPlanObject.r2.x)and(p.y = Wall.FPlanObject.r2.y) then // Wall.FPlanObject.p2.z := p.z+ FZOrder * UOMToMetre(1000 / FCAD.PCad.MapScale);// end; } // xNet := t3droom(T3dside(xNode.Data).FParent).FPlanObject; //Корректировка координаты Z в точках P1 и P2 Wall.FPlanObject.p1.z := GetZPoint(xNet,Wall.FPlanObject.p1) + FZOrder * UOMToMetre(1000 / FCAD.PCad.MapScale); Wall.FPlanObject.p2.z := GetZPoint(xNet,Wall.FPlanObject.p2) + FZOrder * UOMToMetre(1000 / FCAD.PCad.MapScale); p := DoublePoint(Wall.FPlanObject.p1.x * factor, Wall.FPlanObject.p1.z * factor + FDeltaZ, Wall.FPlanObject.p1.y * factor); glLine.AddNode(p.x, p.y, p.z); //Координаты точки 1 линии(грани) Wall.FGLPOints[0] := p; p := DoublePoint(Wall.FPlanObject.p2.x * factor, Wall.FPlanObject.p2.z * factor + FDeltaZ,Wall.FPlanObject.p2.y * factor); glLine.AddNode(p.x, p.y, p.z); //координаты точки 2 линии(грани) Wall.FGLPOints[1] := p; glLine.NodeSize := 0; glLine.ShowAxes := False; gLLine.LineWidth := 2; glLine.AntiAliased := True; glLine.NodesAspect := lnaInvisible; glLine.Visible := false; glLine.LineColor.AsWinColor := clYellow; break; end; end; end; end; //Распарсиваем углы if (TObject(xNode.Data) is T3dside) and (TObject(T3dside(xNode.Data).FParent) is t3droom) then begin if t3droom(T3dside(xNode.Data).FParent).FCorner <> nil then begin for iCorner := 0 to t3droom(T3dside(xNode.Data).FParent).FCorner.Count - 1 do begin xCorner := T3DCorner(t3droom(T3dside(xNode.Data).FParent).FCorner[icorner]); for iModelCnt := 0 to ModelTree.Items.Count - 1 do //Находим соответствующую стену с ModelTree//// begin { if AnsiUpperCase(Wall.FName) = AnsiUpperCase(ModelTree.Items[iModelCnt].Text) then // begin // if Wall.FParent.FName = ModelTree.Items[iModelCnt].Parent.Text then // begin } if TObject(ModelTree.Items[iModelCnt].Data) is T3DCorner then begin if T3DCorner(ModelTree.Items[iModelCnt].Data) = xCorner then // begin CornerNode := ModelTree.Items[iModelCnt]; // Запоминаем найденный нод в дереве glObject := DummyCube.AddNewChild(TGLLines); //Добавление фигуры в DummyCube (линия) glObject.TagObject := CornerNode; //связываем её с веткой нода xCorner.FZOrder := FZOrder * UOMToMetre(1000 / FCAD.PCad.MapScale) * factor; if xCorner.FGLObject = nil then xCorner.FGLObject := glObject; //запоминаем у стены какой ей пренадлежит объект GLScene glLine := TGLLines(glObject); //Распределяем координаты... case Face.RecType of ftNetCeiling: pArr := xCorner.FParent.FCeilingConture; end; pCnt := length(pArr); { //Корректировка координаты Z/////////////////////////////////////////////////// for k := 0 to pCnt-1 do // begin // p := pArr[k]; // //if (Round(xCorner.FPoints.x) = Round(p.x))and (Round(xCorner.FPoints.y) = Round(p.y)) then if (EQDP(xCorner.FPoints,p))then xCorner.FPoints.z := p.z+ FZOrder * UOMToMetre(1000 / FCAD.PCad.MapScale); end; } xCorner.FPoints.z := xCorner.FPoints.z + FZOrder * UOMToMetre(1000 / FCAD.PCad.MapScale); p := DoublePoint(xCorner.FPoints.x* factor,xCorner.FPoints.z* factor + FDeltaZ,xCorner.FPoints.y* factor); glLine.AddNode(p.x, p.y, p.z); //Координаты точки 1 линии(грани) SetLength(xCorner.FGLPOints,1); xCorner.FGLPOints[0] := p; p.y := (xCorner.FPoints.z+1) * factor + FDeltaZ; glLine.AddNode(p.x, p.y, p.z); //координаты точки 2 линии(грани) glLine.NodeSize := 0; glLine.ShowAxes := False; gLLine.LineWidth := 6; glLine.AntiAliased := True; glLine.NodesAspect := lnaInvisible; glLine.Visible := false; glLine.LineColor.AsWinColor := clGreen; break; end; end; end; end; end; end; end; end; end; //******************\ROOF******************* end; end; //// *********** FACES.COUNT ************************************************* //FCAD.FActiveNet; // Factor := 0.15; if tx > tz then Gtx := tx else Gtx := tz; cx := ((tx+bx) / 2) * Factor; cy := ((ty+by) / 2) * Factor; cz := ((tz+bz) / 2) * Factor; Cpoint := DoublePoint(cx,cy,cz); Opoint := DoublePoint(cx,(by * factor) - 5,tz * factor); MainCenter.Position.X := cx; //MainCenter.Position.Y := cy; MainCenter.Position.Z := cz; //Это под каким обзором камера смотрит на построенную модель////// GLCamera.Position.x := cx; // GLCamera.Position.y := cy; // GLCamera.Position.z := tz * factor + 40; // if NotBase3DPlane = nil then begin {$IF Not Defined(ES_GRAPH_SC)} // Tolik -- 24/06/2016 -- if not cbDontShowSubstrate.Checked then begin try //GLPLane1.BeginUpdate; //TempImg := TImage.Create(Self); //TempImg.Picture.Bitmap := TBitmap.Create; //TempImg.Picture.Bitmap.PixelFormat := pf32bit; //TempImg.Picture.LoadFromFile(GetPathToSCSTmpDir + '\3d.jpg'); //TempImg.Picture.Bitmap.LoadFromFile('c:\3d.bmp'); //GLPlane1.Height := Round((TempImg.Picture.Height * factor)/10); //GLPlane1.Width := Round((TempImg.Picture.Width * factor)/10); //GLPlane1.Material.BlendingMode := bmOpaque; //GLPlane1.Material.Texture.Disabled := True; GLPlane1.Material.Texture.Image.LoadFromFile(GetPathToSCSTmpDir + '\3d.jpg'); //GLPlane1.Material.Texture.Image.SaveToFile('c:\from3d.bmp'); //GLPlane1.Material.Texture.Image.Height := TempImg.Picture.Height; //GLPlane1.Material.Texture.Image.Width := TempImg.Picture.Width; //GLPlane1.Material.Texture.Image.Assign(TempImg.Picture); //TempImg.Free; //GLPLane1.EndUpdate; //GLPLane1.NotifyChange(Self); except ShowMessage('File not found ' + GetPathToSCSTmpDir + '\3d.jpg'); end; end else begin if Assigned(GLPlane1.Material.Texture.Image) then GLPlane1.Material.Texture.Image.Destroy; end; GLPlane1.Position.y := GLPlane1.Position.y - 0.032; {$ELSE} GLPlane1.Position.y := GLPlane1.Position.y - FDeltaZPlane; // {$IFEND} GLPlane1.Scale.Y := FCAD.PCad.WorkHeight * factor; GLPlane1.Scale.X := FCAD.PCad.WorkWidth * factor; GLPlane1.beginUpdate; //GLPlane1.Material.Texture.Image.LoadFromFile(SubstrateFileName); //NotBase3DPlane.Material.Texture.TextureMode:=tmModulate; GLPlane1.Material.BlendingMode := bmModulate;//bmAdditive;//bmAlphaTest50; GLPlane1.Material.Texture.Disabled := False; {GLPlane1.Material.BackProperties.Ambient.Alpha := 1; GLPlane1.Material.BackProperties.Ambient.Blue := 0.2; GLPlane1.Material.BackProperties.Ambient.Green := 0.2; GLPlane1.Material.BackProperties.Ambient.Red := 0.2; GLPlane1.Material.BackProperties.Diffuse.Alpha := 1; GLPlane1.Material.BackProperties.Diffuse.Blue := 0.8; GLPlane1.Material.BackProperties.Diffuse.Green := 0.8; GLPlane1.Material.BackProperties.Diffuse.Red := 0.8; GLPlane1.Material.BackProperties.Emission.Alpha := 1; GLPlane1.Material.BackProperties.Emission.Blue := 0; GLPlane1.Material.BackProperties.Emission.Green := 0; GLPlane1.Material.BackProperties.Emission.Red := 0; GLPlane1.Material.BackProperties.Specular.Alpha := 1; GLPlane1.Material.BackProperties.Specular.Blue := 0; GLPlane1.Material.BackProperties.Specular.Green := 0; GLPlane1.Material.BackProperties.Specular.Red := 0; } GLPlane1.Material.FrontProperties.Ambient.Alpha := 0.5; GLPlane1.Material.FrontProperties.Ambient.Blue := 0.5; GLPlane1.Material.FrontProperties.Ambient.Green := 0.5; GLPlane1.Material.FrontProperties.Ambient.Red := 0.5; GLPlane1.Material.FrontProperties.Diffuse.Alpha := 0.5; GLPlane1.Material.FrontProperties.Diffuse.Blue := 0.5; GLPlane1.Material.FrontProperties.Diffuse.Green := 0.5; GLPlane1.Material.FrontProperties.Diffuse.Red := 0.5; GLPlane1.Material.FrontProperties.Emission.Alpha := 0.5; GLPlane1.Material.FrontProperties.Emission.Blue := 0; GLPlane1.Material.FrontProperties.Emission.Green := 0; GLPlane1.Material.FrontProperties.Emission.Red := 0; GLPlane1.Material.FrontProperties.Specular.Alpha := 0.5; GLPlane1.Material.FrontProperties.Specular.Blue := 0; GLPlane1.Material.FrontProperties.Specular.Green := 0; GLPlane1.Material.FrontProperties.Specular.Red := 0; //NoGLPlane1tBase3DPlane.Material.FrontProperties.Shininess := 25; GLPlane1.EndUpdate; SubRootNode := tvSubStartesView.DropTarget; // верхний узел (все) CurrList := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(GCadForm.FCADListID); if CurrList <> nil then begin ChildNode := tvSubStartesView.Items.AddChild(SubRootNode, currList.GetNameForVisible); ChildNode.Data := GLPlane1; tvSubStartesView.ItemState[ChildNode.AbsoluteIndex] := csChecked; end; GLSceneViewer.RecreateWnd; end; // Tolik 03/05/2018 -- if ListOfCadsFor3DModel <> nil then if NotBase3DPlane <> nil then begin NotBase3DPlane.BeginUpdate; NotBase3DPlane.Parent := Self.GLDummyCube1; NotBase3DPlane.EndUpdate; //Self.GLDummyCube1.BeginUpdate; //Self.GLDummyCube1.AddChild(NotBase3DPlane); //Self.GLDummyCube1.EndUpdate; //NotBase3DPlane.Name; {$IF Not Defined(ES_GRAPH_SC)} // Tolik -- 24/06/2016 -- if not cbDontShowSubstrate.Checked then begin try SubstrateFileName := GetPathToSCSTmpDir + '\' + NotBase3DPlane.Name + 'd.jpg'; NotBase3DPlane.beginUpdate; NotBase3DPlane.Material.Texture.Image.LoadFromFile(SubstrateFileName); //NotBase3DPlane.Material.Texture.TextureMode:=tmModulate; NotBase3DPlane.Material.BlendingMode := bmModulate;//bmAdditive;//bmAlphaTest50; NotBase3DPlane.Material.Texture.Disabled := False; NotBase3DPlane.Material.BackProperties.Ambient.Alpha := 1; NotBase3DPlane.Material.BackProperties.Ambient.Blue := 0.2; NotBase3DPlane.Material.BackProperties.Ambient.Green := 0.2; NotBase3DPlane.Material.BackProperties.Ambient.Red := 0.2; NotBase3DPlane.Material.BackProperties.Diffuse.Alpha := 1; NotBase3DPlane.Material.BackProperties.Diffuse.Blue := 0.8; NotBase3DPlane.Material.BackProperties.Diffuse.Green := 0.8; NotBase3DPlane.Material.BackProperties.Diffuse.Red := 0.8; NotBase3DPlane.Material.BackProperties.Emission.Alpha := 1; NotBase3DPlane.Material.BackProperties.Emission.Blue := 0; NotBase3DPlane.Material.BackProperties.Emission.Green := 0; NotBase3DPlane.Material.BackProperties.Emission.Red := 0; NotBase3DPlane.Material.BackProperties.Specular.Alpha := 1; NotBase3DPlane.Material.BackProperties.Specular.Blue := 0; NotBase3DPlane.Material.BackProperties.Specular.Green := 0; NotBase3DPlane.Material.BackProperties.Specular.Red := 0; NotBase3DPlane.Material.FrontProperties.Ambient.Alpha := 0.5; NotBase3DPlane.Material.FrontProperties.Ambient.Blue := 0.5; NotBase3DPlane.Material.FrontProperties.Ambient.Green := 0.5; NotBase3DPlane.Material.FrontProperties.Ambient.Red := 0.5; NotBase3DPlane.Material.FrontProperties.Diffuse.Alpha := 0.5; NotBase3DPlane.Material.FrontProperties.Diffuse.Blue := 0.5; NotBase3DPlane.Material.FrontProperties.Diffuse.Green := 0.5; NotBase3DPlane.Material.FrontProperties.Diffuse.Red := 0.5; NotBase3DPlane.Material.FrontProperties.Emission.Alpha := 0.5; NotBase3DPlane.Material.FrontProperties.Emission.Blue := 0; NotBase3DPlane.Material.FrontProperties.Emission.Green := 0; NotBase3DPlane.Material.FrontProperties.Emission.Red := 0; NotBase3DPlane.Material.FrontProperties.Specular.Alpha := 0.5; NotBase3DPlane.Material.FrontProperties.Specular.Blue := 0; NotBase3DPlane.Material.FrontProperties.Specular.Green := 0; NotBase3DPlane.Material.FrontProperties.Specular.Red := 0; //NotBase3DPlane.Material.FrontProperties.Shininess := 25; NotBase3DPlane.EndUpdate; GLSceneViewer.RecreateWnd; except ShowMessage('File not found ' + SubstrateFileName); end; end else begin if Assigned(NotBase3DPlane.Material.Texture.Image) then NotBase3DPlane.Material.Texture.Image.Destroy; end; ListParams := GetListParams(GCadForm.FCADListID); FloorHeight := MetreToUOM(ListParams.Settings.HeightRoom)*(1000 / GCadForm.PCad.MapScale)*Factor; // высота этажа //if currCad.FCADListIndex > 0 then if F3DSavedCad <> nil then begin Cad := GCadForm; GCadForm := F3DSavedCad; if ListNotUnderFloor(Cad) then begin MaxFloorHeight := Get3DFloorHeight(Cad)*Factor; MinFloorHeight := MaxFloorHeight - FloorHeight; end else begin MinFloorHeight := Get3DFloorHeight(Cad)*Factor; MaxFloorHeight := MinFloorHeight + FloorHeight; end; GCadForm := Cad; {CadListIndex := HListOfCadsFor3DModel.IndexOF(GCadForm); if CadListIndex <> -1 then NotBase3DPlane.Position.y := NotBase3DPlane.Position.y + CadListIndex * MinFloorHeight else begin CadListIndex := LListOfCadsFor3DModel.IndexOF(GCadForm); NotBase3DPlane.Position.y := NotBase3DPlane.Position.y + CadListIndex * MinFloorHeight end; } NotBase3DPlane.Position.y := NotBase3DPlane.Position.y + MinFloorHeight; end; {$ELSE} NotBase3DPlane.Position.y := NotBase3DPlane.Position.y - FDeltaZPlane; // {$IFEND} NotBase3DPlane.Scale.Y := FCAD.PCad.WorkHeight * factor; NotBase3DPlane.Scale.X := FCAD.PCad.WorkWidth * factor; SubRootNode := tvSubStartesView.DropTarget; // верхний узел (все) CurrList := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(GCadForm.FCADListID); if CurrList <> nil then begin ChildNode := tvSubStartesView.Items.AddChild(SubRootNode, currList.GetNameForVisible); ChildNode.Data := NotBase3DPlane; tvSubStartesView.ItemState[ChildNode.AbsoluteIndex] := csChecked; end; end; // //Alex(20.12.2010) FirstCameraPosIsSet := False; try if F3DModel.FRooms.Count > 0 then begin xRoom := T3DRoom(F3DModel.FRooms[0]); if ((xRoom.FFloor <> nil) and (xRoom.FCeiling <> nil)) then begin GetRoomBounds(RoomMin, RoomMax, xRoom.FFloor.FGLPoints, xRoom.FCeiling.FGLPoints); RoomSize.x := abs(RoomMax.x - RoomMin.x); RoomSize.y := abs(RoomMax.y - RoomMin.y); RoomSize.z := abs(RoomMax.z - RoomMin.z); SetPos.x := abs(RoomMax.x + RoomMin.x) / 2; SetPos.y := abs(RoomMax.y + RoomMin.y) / 2; SetPos.z := abs(RoomMax.z + RoomMin.z) / 2; FirstCameraPosIsSet := True; end else FirstCameraPosIsSet := False; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.sbFirstFaceClick', E.Message); end; if not FirstCameraPosIsSet then begin SetPos.x := 0; SetPos.y := 2.7; SetPos.z := 0; FirstCameraPosIsSet := True; end; FirstPerson.Position.X := SetPos.x; FirstPerson.Position.Y := SetPos.y; FirstPerson.Position.Z := SetPos.z; //-- // Камера в перспективный вид glCamera.CameraStyle := csPerspective; GLCamera.FocalLength := 160; GLCamera.DepthOfView := Trunc(100 * gtx/400); if GLCamera.DepthOfView > 500 then GLCamera.DepthOfView := 500; if GLCamera.DepthOfView < 100 then GLCamera.DepthOfView := 100; if Factor > 0.15 then begin GLCamera.DepthOfView := Trunc(100 * Factor / 0.15); FirstPersonCamera.DepthOfView := Trunc(100 * Factor / 0.15); end; lbViewType.Caption := cForm3D_Mes3; AfterUpdate; if ObjMatList.Count > 0 then UpdateObjModelsMaterials; except on E: Exception do AddExceptionToLogEx('Form3d.UpdateFaces', E.Message); end; end; procedure Tfrm3D.SetCubeBounds(var glCube: TGLCube; Points: T3dPointArray; Factor:Double); var p1,p2,p3,p4,p5: T3DPoint; px,py,pz: Double; len,w,h: Double; mp,xp1,xp2: TDoublePoint; mp3: T3dPoint; begin p1 := Points[0]; p2 := Points[1]; p3 := Points[2]; p4 := Points[3]; p5 := Points[4]; xp1 := DoublePOint(p1.x,p1.y); xp2 := DoublePOint(p3.x,p3.y); mp := MPoint(xp1,xp2); pz := (p1.z+p5.z) /2; mp3 := DoublePOint(mp,pz); xp1 := DoublePoint(p1.x,p1.y); xp2 := DoublePoint(p2.x,p2.y); len := GetLineLenght(xp1,xp2); xp1 := DoublePoint(p1.x,p1.y); xp2 := DoublePoint(p4.x,p4.y); w := GetLineLenght(xp1,xp2); h := abs(p1.z-p5.z); glCube.Position.X := mp3.x*factor; glCube.Position.Y := mp3.z*factor; glCube.Position.Z := mp3.y*factor; glCube.CubeWidth := h*factor; glCube.CubeDepth := w*factor; glCube.CubeHeight := len*factor; end; procedure Tfrm3D.SpeedButton1Click(Sender: TObject); begin FMode := F3DPerspective; glCamera.CameraStyle := csPerspective; GLCamera.FocalLength := 160; GLSceneViewer.Camera := GLCamera; //GLSceneViewer.Camera := GLCamera2; //GLLightFirstPerson.Shining := False; Light.Shining := True; Light.Parent := GLCamera; lbViewType.Caption := cForm3D_Mes3; end; procedure Tfrm3D.SpeedButton2Click(Sender: TObject); begin FMode := F3DOrtho; glCamera.CameraStyle := csOrthogonal; GLCamera.FocalLength := 1.7; GLSceneViewer.Camera := GLCamera; //GLSceneViewer.Camera := GLCamera2; //GLLightFirstPerson.Shining := False; Light.Shining := True; Light.Parent := GLCamera; lbViewType.Caption := cForm3D_Mes4; end; (* procedure Tfrm3D.cmbCenterClick(Sender: TObject); var xObject:TObject; begin if CmbCenter.ItemIndex = -1 then exit; xObject := CmbCenter.Items.Objects[cmbCenter.ItemIndex]; if not assigned(xObject) then exit; //GLCamera1.TargetObject := TGLDummyCube(xObject); end; *) procedure Tfrm3D.FormShow(Sender: TObject); Procedure SortChildsInBackOrder; var i: Integer; FirstChild, CurrChild: TGLPlane; begin for i := 0 to GLDummyCube1.Count - 1 do begin CurrChild := TGLPlane(GLDummyCube1.Children[i]); GLDummyCube1.Remove(currChild, True); GLDummyCube1.Insert(0, CurrChild); end; end; begin // Tolik 06/11/2019 -- WindowState := wsMaximized; Width := Screen.Width; Height := Screen.Height; // {$IF Defined(ES_GRAPH_SC)} // Нельзя назначать здесь таймер //TimerOnSelectNodes.OnTimer := TimerOnSelectNodesTimer; {$IFEND} if GReadOnlyMode then sbApplyScsModel.Enabled := False; // UpdateModelTree; cbViewCeiling.Checked := True; {$IF Not Defined(ES_GRAPH_SC)} cbViewCeiling.Visible := False; //20.12.2011 sbSaveModel.Visible := False; //20.12.2011 panObjects.Visible := False; //20.12.2011 Splitter1.Visible := False; TabArchModel.TabVisible := false; TabScsModel.TabVisible := false; pcTree.ActivePage := TabScsModel; TabArchProps.TabVisible := false; TabArchModel.TabVisible := false; pcProps.ActivePage := TabArchModel; cbShowTraceCaptions.Top := 11; {$IFEND} {$if Defined(ES_GRAPH_SC)} sbApplyScsModel.Visible := False; cbShowTraceCaptions.Visible := False; TabScsModel.TabVisible := False; {$ifend} SetAllPanels(False); SetAllScsPanels(False); LoadSelectionData; GLCadencer.Enabled := True; //Tolik 08/05/2018 -- if isProjectModel then begin tvSubStartesView.DropTarget.Expand(False); tvSubStartesView.Visible := True; end; // end; procedure Tfrm3D.GLHeightField1GetHeight(const x, y: Single; var z: Single; var color: TVector4f; var texPoint: TTexPoint); begin z := 0; end; // Tolik function Tfrm3D.MyGetPickedObject(x, y : Integer): TGLBaseSceneObject; var pkList : TGLPickList; begin pkList := GlsceneViewer.Buffer.GetPickedObjects(Rect(x - 5, y - 5, x + 5, y + 5)); try if pkList.Count>0 then Result:=pkList.Hit[0] else Result:=nil; finally pkList.Free; end; end; procedure Tfrm3D.FormMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); var i, j: integer; s: Single; shiftDown : Boolean; ctrlDown : Boolean; Res1: TWinControl; Pt: TPoint; glObject, glObject1: TGLFreeForm; pScale: Double; xConn: T3DConnector; begin pScale := 0.1; // 10% pScale := WheelDelta / 120 * pScale; GetCursorPos(Pt); Res1 := FindControl(WindowFromPoint(Pt)); if (Res1 = nil) or (Res1.name <> 'GLSceneViewer') then exit; shiftDown := (IsKeyDown(VK_LShift) or IsKeyDown(VK_RSHIFT)); ctrlDown := (IsKeyDown(VK_LCONTROL) or IsKeyDown(VK_RCONTROL)); if ctrlDown then begin if FSelection.Count <> 0 then //Tolik 05/11/2019 -- если ничего не выбрано, получим "List index out of Bounds" begin {*** Scaling FreeForm ***} if (FSelection.Count = 1) and is3DSObject(TGLBaseSceneObject(FSelection[0])) then begin DoScale3dsObject(WheelDelta); end else if isConnectorObject(TGLBaseSceneObject(FSelection[0])) then begin DoScaleConnectorObjects(WheelDelta); end end {*** Scaling FreeForm ***} else begin for i := 0 to DummyCube.Count - 1 do begin if shiftdown then begin if DummyCube.Children[i].ClassName = 'TGLSpaceText' then begin if WheelDelta < 0 then begin if DummyCube.Children[i].Scale.X >= 0.01 then begin DummyCube.Children[i].Scale.X := DummyCube.Children[i].Scale.X + WheelDelta / 24000; DummyCube.Children[i].Scale.Y := DummyCube.Children[i].Scale.Y + WheelDelta / 24000; DummyCube.Children[i].Scale.Z := DummyCube.Children[i].Scale.Z + WheelDelta / 24000; end; end else begin DummyCube.Children[i].Scale.X := DummyCube.Children[i].Scale.X + WheelDelta / 24000; DummyCube.Children[i].Scale.Y := DummyCube.Children[i].Scale.Y + WheelDelta / 24000; DummyCube.Children[i].Scale.Z := DummyCube.Children[i].Scale.Z + WheelDelta / 24000; end; end; end else begin {$IF Defined(ES_GRAPH_SC)} {$ELSE} if DummyCube.Children[i].ClassName = 'TGLFreeForm' then begin if WheelDelta < 0 then begin if DummyCube.Children[i].Scale.X >= 0.01 then begin DummyCube.Children[i].Scale.X := DummyCube.Children[i].Scale.X + WheelDelta / 24000; DummyCube.Children[i].Scale.Y := DummyCube.Children[i].Scale.Y + WheelDelta / 24000; DummyCube.Children[i].Scale.Z := DummyCube.Children[i].Scale.Z + WheelDelta / 24000; end; end else begin DummyCube.Children[i].Scale.X := DummyCube.Children[i].Scale.X + WheelDelta / 24000; DummyCube.Children[i].Scale.Y := DummyCube.Children[i].Scale.Y + WheelDelta / 24000; DummyCube.Children[i].Scale.Z := DummyCube.Children[i].Scale.Z + WheelDelta / 24000; end; end; {$IFEND} end; end; end; end else begin //Alex(17.12.2010) Откл изменения FocalLength при виде от первого лица if GLSceneViewer.Camera = FirstPersonCamera then begin if WheelDelta > 0 then FirstPersonCamera.FocalLength := FirstPersonCamera.FocalLength + 5 else FirstPersonCamera.FocalLength := FirstPersonCamera.FocalLength - 5; end; if GLSceneViewer.Camera <> FirstPersonCamera then begin s := GLSceneViewer.Camera.FocalLength; if shiftdown then begin if GLSceneViewer.Camera.CameraStyle = csPerspective then GLSceneViewer.Camera.FocalLength := s + WheelDelta / 80 else GLSceneViewer.Camera.FocalLength := s + WheelDelta / 2420; end else begin if GLSceneViewer.Camera.CameraStyle = csPerspective then GLSceneViewer.Camera.FocalLength := s + WheelDelta / 20 else GLSceneViewer.Camera.FocalLength := s + WheelDelta / 540; end; end; end end; procedure Tfrm3D.SpeedButton3Click(Sender: TObject); var Save3D: TSaveDialog; Jpeg: TJPEGImage; Bmp: TBitmap; BmpFileName: string; bmpx, bmpy: Integer; begin try if GLSceneViewer.Camera = FirstPersonCamera then begin ShowMessage('Недоступно в режиме просмотра "От первого лица"!'); Exit; end; {$IF Defined(ES_GRAPH_SC)} {$ELSE} {//04.01.2012 if GLSceneViewer.Camera.CameraStyle = csPerspective then begin ShowMessage(cForm3D_Mes2); Exit; end;} {$IFEND} Save3D := TSaveDialog.Create(nil); with Save3D do begin InitialDir := GetEXEDir; Title := cForm3D_Mes1; Filter := '(*.jpg)|*.jpg'; DefaultExt := '*.jpg'; FileName := ''; Options := [ofReadOnly,ofHideReadOnly,ofPathMustExist,ofFileMustExist,ofNoDereferenceLinks]; end; if Save3D.Execute then begin if frm3D_Save.ShowModal = mrOk then begin Bmp := TBitmap.Create; Jpeg := TJPEGImage.Create; BmpFileName := ChangeFileExt(Save3D.FileName, '.bmp'); if frm3D_Save.rbLow.Checked then begin GLSceneViewer.Buffer.RenderToFile(BmpFileName, 300); end; if frm3D_Save.rbNormal.Checked then begin bmpx := GLSceneViewer.Buffer.Width * 2; bmpy := GLSceneViewer.Buffer.Height * 2; GLSceneViewer.Buffer.RenderToFile(BmpFileName, bmpx, bmpy); end; if frm3D_Save.rbHigh.Checked then begin bmpx := GLSceneViewer.Buffer.Width * 3; bmpy := GLSceneViewer.Buffer.Height * 3; GLSceneViewer.Buffer.RenderToFile(BmpFileName, bmpx, bmpy); end; Bmp.LoadFromFile(BmpFileName); ConvertBMPToJpeg(Bmp, BmpFileName); FreeAndNil(Bmp); DeleteFile(BmpFileName); end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.SpeedButton3Click', E.Message); end; end; {$IF Defined(ES_GRAPH_SC)} function IfNodeSelectedInTree(aNode: TTreeNode): Boolean; var i: Integer; begin Result := False; for i := 0 to frm3D.ModelTree.SelectionCount -1 do begin if aNode = frm3D.ModelTree.Selections[i] then begin Result := true; Break; end; end; end; procedure ShowCornerSides(aCorner: T3DCorner); var i,j: Integer; xNode: TTreeNode; xWall: T3DWall; begin if aCorner.JoinedWalls = nil then Exit; for i := 0 to frm3D.DummyCube.Count - 1 do begin xNode := TTreeNode(frm3D.DummyCube.Children[i].TagObject); if xNode <> nil then for j := 0 to aCorner.JoinedWalls.Count - 1 do begin xWall:= T3DWall(aCorner.JoinedWalls[j]); if xNode.Data = xWall then begin frm3D.DummyCube.Children[i].Visible := True; Break; end; end; end; end; procedure ShowSideSubSides(aSide: T3DSide); var i,j: Integer; xNode: TTreeNode; xWall: T3DWall; xCorner: T3DCorner; begin if not (TObject(aSide.FParent) is T3DRoom) then Exit; for i := 0 to frm3D.DummyCube.Count - 1 do begin xNode := TTreeNode(frm3D.DummyCube.Children[i].TagObject); if xNode <> nil then begin for j := 0 to T3DRoom(aSide.FParent).FWalls.Count - 1 do begin xWall:= T3DWall(T3DRoom(aSide.FParent).FWalls[j]); if xNode.Data = xWall then begin frm3D.DummyCube.Children[i].Visible := True; Break; end; end; for j := 0 to T3DRoom(aSide.FParent).FCorner.Count - 1 do begin xCorner := T3DCorner(T3DRoom(aSide.FParent).FCorner[j]); if xNode.Data = xCorner then begin frm3D.DummyCube.Children[i].Visible := True; Break; end; end; end; end; end; {$IFEND} procedure Tfrm3D.cbViewCeilingClick(Sender: TObject); var i: integer; xNode: TTreeNode; begin try for i := 0 to DummyCube.Count - 1 do begin if (DummyCube.Children[i].TagObject <> nil) then begin xNode := TTreeNode(DummyCube.Children[i].TagObject); // включить/выключить потолок и пол if cbViewCeiling.Checked then begin {$IF Defined(ES_GRAPH_SC)} if TObject(xNode.Data) is T3dSide then begin if T3dSide(xNode.Data).FFaceType = ftNetCeiling then begin if xNode <> nil then begin if xNode.ImageIndex < 1000 then DummyCube.Children[i].Visible := True; end else DummyCube.Children[i].Visible := True; end; if T3dSide(xNode.Data).FFaceType = ftNetFloor then begin if xNode <> nil then begin if xNode.ImageIndex < 1000 then DummyCube.Children[i].Visible := True; end else DummyCube.Children[i].Visible := True; end; end; //Добавлено 13.12.2013 Митяй Д.В. //Отображение ребер стены(Линий) if IfNodeSelectedInTree(xNode) then begin if TObject(xNode.Data) is T3DWall then DummyCube.Children[i].Visible := True; if TObject(xNode.Data) is T3DCorner then begin ShowCornerSides(T3DCorner(xNode.Data)); DummyCube.Children[i].Visible := True; end; if TObject(xNode.Data) is T3DSide then begin DummyCube.Children[i].Visible := True; ShowSideSubSides(T3DSide(xNode.Data)); end; end; {$ELSE} if T3dSide(xNode.Data).FFaceType = ftNetCeiling then begin if xNode <> nil then begin if xNode.ImageIndex < 1000 then DummyCube.Children[i].Visible := True; end else DummyCube.Children[i].Visible := True; end; if T3dSide(xNode.Data).FFaceType = ftNetFloor then begin if xNode <> nil then begin if xNode.ImageIndex < 1000 then DummyCube.Children[i].Visible := True; end else DummyCube.Children[i].Visible := True; end; {$IFEND} end else begin {$IF Defined(ES_GRAPH_SC)} if TObject(xNode.Data) is T3dSide then begin if T3dSide(xNode.Data).FFaceType = ftNetCeiling then DummyCube.Children[i].Visible := False; if T3dSide(xNode.Data).FFaceType = ftNetFloor then DummyCube.Children[i].Visible := False; end; //Добавлено 10.12.2013 Митяй Д.В. //Скрытие отображения ребер стены(Линий) if TObject(xNode.Data) is T3DWall then DummyCube.Children[i].Visible := False; if TObject(xNode.Data) is T3DCorner then DummyCube.Children[i].Visible := False; {$ELSE} if T3dSide(xNode.Data).FFaceType = ftNetCeiling then DummyCube.Children[i].Visible := False; if T3dSide(xNode.Data).FFaceType = ftNetFloor then DummyCube.Children[i].Visible := False; {$IFEND} end; end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.cbViewCeilingClick', E.Message); end; GLSceneViewer.SetFocus; end; procedure Tfrm3D.AddWall(aWall: TGLMesh; vs: array of TVector3f); var vd: array [1..6] of TVertexData; pN, pP: TVector3f; mat: TAffineMatrix; begin try pN := CalcPlaneNormal (vs[0], vs[1], vs[2]); SetVector (mat[2], pN); SetVector (mat[0], VectorNormalize (VectorSubtract (vs[1], vs[0]))); SetVector (mat[1], VectorCrossProduct (mat[2], mat[0])); InvertMatrix (mat); with vd[1] do begin coord := vs[0]; normal := pN; pP := VectorTransform (vs[0], mat); textCoord := TexPointMake (pP[0], pP[1]); end; with vd[2] do begin coord := vs[1]; normal := pN; pP := VectorTransform (vs[1], mat); textCoord := TexPointMake (pP[0], pP[1]); end; with vd[3] do begin coord := vs[2]; normal := pN; pP := VectorTransform (vs[2], mat); textCoord := TexPointMake (pP[0], pP[1]); end; with vd[4] do begin coord := vs[3]; normal := pN; pP := VectorTransform (vs[3], mat); textCoord := TexPointMake (pP[0], pP[1]); end; with vd[5] do begin coord := vs[4]; normal := pN; pP := VectorTransform (vs[4], mat); textCoord := TexPointMake (pP[0], pP[1]); end; with vd[6] do begin coord := vs[5]; normal := pN; pP := VectorTransform (vs[5], mat); textCoord := TexPointMake (pP[0], pP[1]); end; aWall.Vertices.AddVertex (vd[1]); aWall.Vertices.AddVertex (vd[2]); aWall.Vertices.AddVertex (vd[3]); aWall.Vertices.AddVertex (vd[4]); aWall.Vertices.AddVertex (vd[5]); aWall.Vertices.AddVertex (vd[6]); except on E: Exception do AddExceptionToLogEx('Tfrm3D.AddFloor', E.Message); end; end; procedure Tfrm3D.AddFloor(aFloor: TGLMesh; vs: array of TVector3f; aSide: T3DSide); var vd: TVertexData; pN, pP: TVector3f; pN2: TVector3f; vs0, vs1, vs2: TVector3f; mat: TAffineMatrix; i, k, Cnt: Integer; Angle1, Angle2, ResAng: Double; dp1, dp2: TDoublePoint; begin try Cnt := Length(vs); //pN := CalcPlaneNormal (vs[0], vs[1], vs[2]); pN2[0] := 0; pN2[1] := 1; pN2[2] := 0; if Cnt >= 3 then begin for k := 0 to Cnt - 3 do begin dp1 := DoublePoint(vs[0][0], vs[0][2], vs[0][1]); dp2 := DoublePoint(vs[k + 1][0], vs[k + 1][2], vs[k + 1][1]); Angle1 := GetLineAngle(dp1, dp2); dp1 := DoublePoint(vs[k + 1][0], vs[k + 1][2], vs[k + 1][1]); dp2 := DoublePoint(vs[k + 2][0], vs[k + 2][2], vs[k + 2][1]); Angle2 := GetLineAngle(dp1, dp2); ResAng := abs(Angle1 - Angle2); if ResAng < 180 then begin pN := CalcPlaneNormal (vs[0], vs[k + 1], vs[k + 2]); if (not isNaN(pN[0])) and (Not IsNaN(pN[1])) and (Not IsNaN(pN[2])) then break; end; end; if k > (Cnt - 1) then k := 0; SetVector(vs0, vs[0]); SetVector(vs1, vs[k + 1]); SetVector(vs2, vs[k + 2]); end else begin vs0[0] := 0; vs0[1] := 0; vs0[2] := 0; vs1[0] := 100; vs1[1] := 0; vs1[2] := 0; vs2[0] := 100; vs2[1] := 0; vs2[2] := 100; end; pN := CalcPlaneNormal (vs0, vs1, vs2); SetVector (mat[2], pN); SetVector (mat[0], VectorNormalize (VectorSubtract (vs1, vs0))); SetVector (mat[1], VectorCrossProduct (mat[2], mat[0])); InvertMatrix (mat); for i := 0 to Cnt - 1 do begin vd.coord := vs[i]; vd.normal := pN; pP := VectorTransform (vs[i], mat); vd.textCoord := TexPointMake (pP[0], pP[1]); aFloor.Vertices.AddVertex (vd); end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.AddFloor', E.Message); end; end; procedure Tfrm3D.UpdateModelTree; var i, j, k, ii, jj, kk, cld: integer; xModelNode, xListNode, xRoomNode, xCeilingNode, xFloorNode, xWallNode, xWallElementNode, xBalconElementNode, xSlopeNode, xSideNode, xNode: TTreeNode; xRoom: T3DRoom; xWall,xSecondWall: T3DWall; xWallElement: T3DWallElement; xBalconElement: T3DBalconElement; xSlope: T3DSlope; xSide: T3DSide; ItsRoof: Boolean; Str: string; ip: TDoublePoint; p: PDoublePoint; CornerNode: TTreeNode; xCorner: T3DCorner; CornerName: string; begin try xSecondWall := nil; xModelNode := ModelTree.Items.GetFirstNode; // добавить лист Str := FCAD.FCADListName + ' ' + IntToStr(FCAD.FCADListIndex); xListNode:= ModelTree.Items.AddChild(xModelNode, Str); xListNode.Data := FCAD; xListNode.ImageIndex := 1; xListNode.SelectedIndex := xListNode.ImageIndex; // распарсить комнаты for i := 0 to F3DModel.FRooms.Count - 1 do begin ItsRoof := false; xRoom := T3DRoom(F3DModel.FRooms[i]); if (xRoom.FListID <> FCAD.FCADListID) or (not xRoom.FVisible) then continue; xRoomNode:= ModelTree.Items.AddChild(xListNode, xRoom.FName); xRoomNode.Data := xRoom; xRoomNode.ImageIndex := 47; xRoomNode.SelectedIndex := xRoomNode.ImageIndex; //26.11.2013 - Добавлено Митяй Дмитрий /////////////////////////////////////////////// // добавить потолок в комнаты // xSide := xRoom.FCeiling; {$if Defined(ES_GRAPH_SC)} // Tolik 17/06/2018 - - // for j := 0 to xRoom.FSCSCompon.Properties.Count - 1 do // begin // if PProperty(xRoom.FSCSCompon.Properties[j]).SysName = 'MATERIAL_TYPE' then // begin // ItsRoof := true; // break; // end; // if PProperty(xRoom.FSCSCompon.Properties[j]).SysName = 'RESIDUE' then // begin // ItsRoof := true; // break; // end; // end; // if ItsRoof then //Если это крыша, значит меняем "Потолок" на "Грань крыши" // // Tolik -- 01/02/2017 -- // xSide.FName := 'Грань крыши'; xSide.FName := RhRoofVerge; // xNode := ModelTree.Items.AddChild(xRoomNode, xSide.FName); xNode.Data := xSide; xNode.ImageIndex := 56; xNode.SelectedIndex := xNode.ImageIndex; xSide.FFace.FTreeNode := xNode; {$else} //Tolik 31/08/2018 -- только для СКС (не будет пола/потолка для одиночных контуров, только для замкнутых, типа, комнат) if xSide <> nil then begin xNode := ModelTree.Items.AddChild(xRoomNode, xSide.FName); xNode.Data := xSide; xNode.ImageIndex := 56; xNode.SelectedIndex := xNode.ImageIndex; xSide.FFace.FTreeNode := xNode; end; {$ifEnd} // добавить пол в комнату, если он имеется if xRoom.FFloor <> nil then begin xSide := xRoom.FFloor; xNode := ModelTree.Items.AddChild(xRoomNode, xSide.FName); xNode.Data := xSide; xNode.ImageIndex := 56; xNode.SelectedIndex := xNode.ImageIndex; xSide.FFace.FTreeNode := xNode; end; // распарсить стены каждой комнаты for j := 0 to xRoom.FWalls.Count - 1 do begin xWall := T3DWall(xRoom.FWalls[j]); xWallNode:= ModelTree.Items.AddChild(xRoomNode, xWall.FName); xWallNode.Data := xWall; xWallNode.ImageIndex := 49; xWallNode.SelectedIndex := xWallNode.ImageIndex; // распарсить элементы каждой стены for k := 0 to xWall.FWallElements.Count - 1 do begin xWallElement := T3DWallElement(xWall.FWallElements[k]); // окно if xWallElement.FElementType = dotWindow then begin xWallElementNode := ModelTree.Items.AddChild(xWallNode, xWallElement.FName); xWallElementNode.Data := xWallElement; xWallElementNode.ImageIndex := 52; xWallElementNode.SelectedIndex := xWallElementNode.ImageIndex; // добавить откосы for ii := 0 to xWallElement.FSlopes.Count - 1 do begin xSlope := T3DSlope(xWallElement.FSlopes[ii]); xSlopeNode := ModelTree.Items.AddChild(xWallElementNode, xSlope.FName); xSlopeNode.Data := xSlope; xSlopeNode.ImageIndex := 57; xSlopeNode.SelectedIndex := xSlopeNode.ImageIndex; // добавть грани откоса for jj := 0 to xSlope.FSides.Count - 1 do begin xSide := T3DSide(xSlope.FSides[jj]); xNode := ModelTree.Items.AddChild(xSlopeNode, xSide.FName); xNode.Data := xSide; xNode.ImageIndex := 50; xNode.SelectedIndex := xNode.ImageIndex; xSide.FFace.FTreeNode := xNode; end; end; end; // дверь if xWallElement.FElementType = dotDoor then begin xWallElementNode:= ModelTree.Items.AddChild(xWallNode, xWallElement.FName); xWallElementNode.Data := xWallElement; xWallElementNode.ImageIndex := 51; xWallElementNode.SelectedIndex := xWallElementNode.ImageIndex; // добавить откосы for ii := 0 to xWallElement.FSlopes.Count - 1 do begin xSlope := T3DSlope(xWallElement.FSlopes[ii]); xSlopeNode := ModelTree.Items.AddChild(xWallElementNode, xSlope.FName); xSlopeNode.Data := xSlope; xSlopeNode.ImageIndex := 57; xSlopeNode.SelectedIndex := xSlopeNode.ImageIndex; // добавть грани откоса for jj := 0 to xSlope.FSides.Count - 1 do begin xSide := T3DSide(xSlope.FSides[jj]); xNode := ModelTree.Items.AddChild(xSlopeNode, xSide.FName); xNode.Data := xSide; xNode.ImageIndex := 50; xNode.SelectedIndex := xNode.ImageIndex; xSide.FFace.FTreeNode := xNode; end; end; end; // балкон if xWallElement.FElementType = dotBalcony then begin xWallElementNode:= ModelTree.Items.AddChild(xWallNode, xWallElement.FName); xWallElementNode.Data := xWallElement; xWallElementNode.ImageIndex := 55; xWallElementNode.SelectedIndex := xWallElementNode.ImageIndex; // добавить откосы for ii := 0 to xWallElement.FSlopes.Count - 1 do begin xSlope := T3DSlope(xWallElement.FSlopes[ii]); xSlopeNode := ModelTree.Items.AddChild(xWallElementNode, xSlope.FName); xSlopeNode.Data := xSlope; xSlopeNode.ImageIndex := 57; xSlopeNode.SelectedIndex := xSlopeNode.ImageIndex; // добавть грани откоса for jj := 0 to xSlope.FSides.Count - 1 do begin xSide := T3DSide(xSlope.FSides[jj]); xNode := ModelTree.Items.AddChild(xSlopeNode, xSide.FName); xNode.Data := xSide; xNode.ImageIndex := 50; xNode.SelectedIndex := xNode.ImageIndex; xSide.FFace.FTreeNode := xNode; end; end; // добавить элементы балкона for ii := 0 to xWallElement.FBalconElements.Count - 1 do begin xBalconElement := T3DBalconElement(xWallElement.FBalconElements[ii]); if xBalconElement.FElementType = dotDoor then begin xBalconElementNode := ModelTree.Items.AddChild(xWallElementNode, xBalconElement.FName); xBalconElementNode.ImageIndex := 51; xBalconElementNode.SelectedIndex := xBalconElementNode.ImageIndex; end; if xBalconElement.FElementType = dotWindow then begin xBalconElementNode := ModelTree.Items.AddChild(xWallElementNode, xBalconElement.FName); xBalconElementNode.ImageIndex := 52; xBalconElementNode.SelectedIndex := xBalconElementNode.ImageIndex; end; xBalconElementNode.Data := xBalconElement; // добавть грани элемента балкона for jj := 0 to xBalconElement.FSides.Count - 1 do begin xSide := T3DSide(xBalconElement.FSides[jj]); xNode := ModelTree.Items.AddChild(xBalconElementNode, xSide.FName); xNode.Data := xSide; xNode.ImageIndex := 50; xNode.SelectedIndex := xNode.ImageIndex; xSide.FFace.FTreeNode := xNode; end; end; end; // ниша if xWallElement.FElementType = dotNiche then begin xWallElementNode:= ModelTree.Items.AddChild(xWallNode, xWallElement.FName); xWallElementNode.Data := xWallElement; xWallElementNode.ImageIndex := 53; xWallElementNode.SelectedIndex := xWallElementNode.ImageIndex; end; // арка if xWallElement.FElementType = dotArc then begin xWallElementNode:= ModelTree.Items.AddChild(xWallNode, xWallElement.FName); xWallElementNode.Data := xWallElement; xWallElementNode.ImageIndex := 54; xWallElementNode.SelectedIndex := xWallElementNode.ImageIndex; end; // добавить грани данного элемента стены for ii := 0 to xWallElement.FSides.Count - 1 do begin xSide := T3DSide(xWallElement.FSides[ii]); xNode := ModelTree.Items.AddChild(xWallElementNode, xSide.FName); xNode.Data := xSide; xNode.ImageIndex := 50; xNode.SelectedIndex := xNode.ImageIndex; xSide.FFace.FTreeNode := xNode; end; end; // добавить грани стены for k := 0 to xWall.FSides.Count - 1 do begin xSide := T3DSide(xWall.FSides[k]); xNode := ModelTree.Items.AddChild(xWallNode, xSide.FName); xNode.Data := xSide; xNode.ImageIndex := 50; xNode.SelectedIndex := xNode.ImageIndex; xSide.FFace.FTreeNode := xNode; end; { //Тут распарсить углы.Так как почти вся прога построена на указателях, //шаг вправо, шаг влево - взрыв))) Потому добавлять углы будем следующим образом: //Берем две стены, точнее - их координаты, и проверяем на пересекаемость. //Если есть точка пересечения - значит это угол, добавляем его. Пока так... for cld := j+1 to xRoom.FWalls.Count - 1 do begin xSecondWall := T3DWall(xRoom.FWalls[cld]); if LinesCross(xSecondWall.FPlanObject.IP1^, xSecondWall.FPlanObject.IP2^, xWall.FPlanObject.IP1^, xWall.FPlanObject.IP2^) then begin //находим точку пересечения if GetInterSectionPoint(xSecondWall.FPlanObject.IP1^, xSecondWall.FPlanObject.IP2^, xWall.FPlanObject.IP1^, xWall.FPlanObject.IP2^, ip) then begin CornerName := 'Угол для: ' + xSecondWall.FName + '/' + xWall.FName; xCorner := T3DCorner.Create(xRoom,CornerName); xCorner.JoinedWalls.Add(xSecondWall); xCorner.JoinedWalls.Add(xWall); CornerNode := ModelTree.Items.AddChild(xRoomNode, CornerName); CornerNode.Data := xCorner; CornerNode.ImageIndex := 3; CornerNode.SelectedIndex := CornerNode.ImageIndex; end; end; end; } end; //*****************ROOF*********************** {$IF Defined(ES_GRAPH_SC)} if xRoom.FCorner <> nil then begin for cld := 0 to xRoom.FCorner.Count - 1 do begin xCorner := T3DCorner(xRoom.FCorner[cld]); CornerNode := ModelTree.Items.AddChild(xRoomNode, xCorner.FName); CornerNode.Data := xCorner; CornerNode.ImageIndex := 3; CornerNode.SelectedIndex := CornerNode.ImageIndex; end; end; {$IFEND} //*****************\ROOF********************** end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.UpdateModelTree', E.Message); end; end; procedure Tfrm3D.UpdateScsModelTree; var i, j, k, ii, jj, kk: integer; xModelNode, xListNode, xScsNode: TTreeNode; xConn: T3DConnector; xLine: T3DLine; xTube: T3DTube; Str: string; begin try xModelNode := ScsModelTree.Items.GetFirstNode; // добавить лист Str := FCAD.FCADListName + ' ' + IntToStr(FCAD.FCADListIndex); xListNode:= ScsModelTree.Items.AddChild(xModelNode, Str); xListNode.Data := FCAD; xListNode.ImageIndex := 1; xListNode.SelectedIndex := xListNode.ImageIndex; // распарсить комнаты for i := 0 to F3DModel.FScsObjects.Count - 1 do begin if TObject(F3DModel.FScsObjects[i]) is T3DConnector then begin xConn := T3DConnector(F3DModel.FScsObjects[i]); if (xConn.FListID <> FCAD.FCADListID) then Continue; if (xConn.FConnType = ct_Empty) then begin // Tolik 24/09/2018 - - //xConn.FFace.F3DObject := xConn; //Continue; if not xConn.FisPipeElement then begin xConn.FFace.F3DObject := xConn; Continue; end else begin xScsNode := ScsModelTree.Items.AddChild(xListNode, xConn.FName); xScsNode.Data := xConn; xScsNode.ImageIndex := 3; xScsNode.SelectedIndex := xScsNode.ImageIndex; xConn.FFace.FTreeNode := xScsNode; end; end else begin xScsNode := ScsModelTree.Items.AddChild(xListNode, xConn.FName); xScsNode.Data := xConn; xScsNode.ImageIndex := 3; xScsNode.SelectedIndex := xScsNode.ImageIndex; xConn.FFace.FTreeNode := xScsNode; //Tolik 15/10/2018 -- // if xConn.F3dModelFileName <> '' then xConn.FFace.F3DObject := xConn; end; end; if TObject(F3DModel.FScsObjects[i]) is T3DLine then begin xLine := T3DLine(F3DModel.FScsObjects[i]); if (xLine.FListID <> FCAD.FCADListID) then Continue; xScsNode:= ScsModelTree.Items.AddChild(xListNode, xLine.FName); xScsNode.Data := xLine; xScsNode.ImageIndex := 2; xScsNode.SelectedIndex := xScsNode.ImageIndex; xLine.FFace.FTreeNode := xScsNode; end; end; // Tolik 18/09/2018 -- for i := 0 to F3DModel.FScsObjects.Count - 1 do begin if TObject(F3DModel.FScsObjects[i]) is T3DTube then begin xTube := T3DTube(F3DModel.FScsObjects[i]); if (xConn.FListID <> FCAD.FCADListID) then Continue; xScsNode := ScsModelTree.Items.AddChild(xListNode, xTube.FName); xScsNode.Data := xTube; xScsNode.ImageIndex := 3; xScsNode.SelectedIndex := xScsNode.ImageIndex; xTube.FFace.FTreeNode := xScsNode; end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.UpdateScsModelTree', E.Message); end; end; procedure Tfrm3D.UpdateModelTreeFromStream(Faces: TList); var i, j, k, ii, jj, kk, iadd, cld: integer; xModelNode, xListNode, xRoomNode, xCeilingNode, xFloorNode, xWallNode, xWallElementNode, xBalconElementNode, xSlopeNode, xSideNode, x3DSNode, xNode, xSubNode: TTreeNode; xRoom, xStrRoom: T3DRoom; xWall, xStrWall,xSecondWall: T3DWall; xWallElement, xStrWallElement: T3DWallElement; xBalconElement, xStrBalconElement: T3DBalconElement; xSlope, xStrSlope: T3DSlope; xSide, xStrSide, xAddSide, xSubSide, xStrSubSide: T3DSide; xObject, xStrObject: T3DSObject; FName: string; Str: string; CornerNode: TTreeNode; ItsRoof: Boolean; ip: TDoublePoint; xCorner: T3DCorner; CornerName: string; begin try xModelNode := ModelTree.Items.GetFirstNode; CopyModelHash; // добавить лист Str := FCAD.FCADListName + ' ' + IntToStr(FCAD.FCADListIndex); xListNode:= ModelTree.Items.AddChild(xModelNode, Str); xListNode.Data := FCAD; xListNode.ImageIndex := 1; xListNode.SelectedIndex := xListNode.ImageIndex; // распарсить комнаты for i := 0 to F3DModel.FRooms.Count - 1 do begin xRoom := T3DRoom(F3DModel.FRooms[i]); ItsRoof := False; if (xRoom.FListID <> FCAD.FCADListID) or (not xRoom.FVisible) then continue; xStrRoom := T3DRoom(getModelObjectByComponID(xRoom.FSCSComponID)); xRoomNode:= ModelTree.Items.AddChild(xListNode, xRoom.FName); xRoomNode.Data := xRoom; xRoomNode.ImageIndex := 47; xRoomNode.SelectedIndex := xRoomNode.ImageIndex; // добавить потолок в комнату xSide := xRoom.FCeiling; xStrSide := GetSimilarSide(xSide, xStrRoom); //Проверка на то, как добавлять: "Потолок" или "Грань крыши"////////////////////////// for j := 0 to xRoom.FSCSCompon.Properties.Count - 1 do // begin // if PProperty(xRoom.FSCSCompon.Properties[j]).SysName = 'MATERIAL_TYPE' then // begin // ItsRoof := true; // break; // end; // if PProperty(xRoom.FSCSCompon.Properties[j]).SysName = 'RESIDUE' then // begin // ItsRoof := true; // break; // end; // end; // if ItsRoof then //Если это крыша, значит меняем "Потолок" на "Грань крыши" // xSide.FName := 'Грань крыши'; xNode := ModelTree.Items.AddChild(xRoomNode, xSide.FName); xNode.Data := xSide; xNode.ImageIndex := 56; xNode.SelectedIndex := xNode.ImageIndex; xSide.FFace.FTreeNode := xNode; if xStrSide <> nil then begin CopySideProperties(xSide, xStrSide); if xStrSide.FSubSides.Count > 0 then begin Faces.Remove(xSide.FFace); for iadd := 0 to xStrSide.FSubSides.Count - 1 do begin xStrSubSide := T3DSide(xStrSide.FSubSides[iadd]); xSubSide := CopySubSideProperties(xStrSubSide); xSubNode := ModelTree.Items.AddChild(xNode, xSubSide.FName); xSubNode.Data := xSubSide; xSubNode.ImageIndex := 56; xSubNode.SelectedIndex := xSubNode.ImageIndex; xSubSide.FFace.FTreeNode := xSubNode; Faces.Add(xSubSide.FFace); xSubSide.FParent := xSide; xSide.FSubSides.Add(xSubSide); end; end; end; // добавить пол в комнату if xRoom.FFloor <> nil then begin xSide := xRoom.FFloor; xStrSide := GetSimilarSide(xSide, xStrRoom); xNode := ModelTree.Items.AddChild(xRoomNode, xSide.FName); xNode.Data := xSide; xNode.ImageIndex := 56; xNode.SelectedIndex := xNode.ImageIndex; xSide.FFace.FTreeNode := xNode; if xStrSide <> nil then begin CopySideProperties(xSide, xStrSide); if xStrSide.FSubSides.Count > 0 then begin Faces.Remove(xSide.FFace); for iadd := 0 to xStrSide.FSubSides.Count - 1 do begin xStrSubSide := T3DSide(xStrSide.FSubSides[iadd]); xSubSide := CopySubSideProperties(xStrSubSide); xSubNode := ModelTree.Items.AddChild(xNode, xSubSide.FName); xSubNode.Data := xSubSide; xSubNode.ImageIndex := 56; xSubNode.SelectedIndex := xSubNode.ImageIndex; xSubSide.FFace.FTreeNode := xSubNode; Faces.Add(xSubSide.FFace); xSubSide.FParent := xSide; xSide.FSubSides.Add(xSubSide); end; end; end; end; // добавить 3дс объекты // !!! Если не изменялись размеры или месторасположение комнаты if xStrSide <> nil then begin for j := 0 to xStrRoom.F3DSObjects.Count - 1 do begin FName := GetObjectFileByHash(T3DSObject(xStrRoom.F3DSObjects[j]).FObjectHash); if FileExists(FName) then begin xStrObject := T3DSObject(xStrRoom.F3DSObjects[j]); xObject := CopyObjectProperties(nil, xStrObject); xNode := ModelTree.Items.AddChild(xRoomNode, xObject.FName); xNode.Data := xObject; xNode.ImageIndex := 42; xNode.SelectedIndex := xNode.ImageIndex; xObject.FFace.FTreeNode := xNode; Faces.Add(xObject.FFace); xObject.FParent := xRoom; xRoom.F3DSObjects.Add(xObject); end; end; end; // распарсить стены каждой комнаты for j := 0 to xRoom.FWalls.Count - 1 do begin xWall := T3DWall(xRoom.FWalls[j]); xStrWall := T3DWall(getModelObjectByComponID(xWall.FSCSComponID)); xWallNode:= ModelTree.Items.AddChild(xRoomNode, xWall.FName); xWallNode.Data := xWall; xWallNode.ImageIndex := 49; xWallNode.SelectedIndex := xWallNode.ImageIndex; // распарсить элементы каждой стены for k := 0 to xWall.FWallElements.Count - 1 do begin xWallElement := T3DWallElement(xWall.FWallElements[k]); xStrWallElement := T3DWallElement(getModelObjectByComponID(xWallElement.FSCSComponID)); // окно if xWallElement.FElementType = dotWindow then begin xWallElementNode := ModelTree.Items.AddChild(xWallNode, xWallElement.FName); xWallElementNode.Data := xWallElement; xWallElementNode.ImageIndex := 52; xWallElementNode.SelectedIndex := xWallElementNode.ImageIndex; // добавить откосы for ii := 0 to xWallElement.FSlopes.Count - 1 do begin xSlope := T3DSlope(xWallElement.FSlopes[ii]); xStrSlope := T3DSlope(getModelObjectByComponID(xSlope.FSCSComponID)); xSlopeNode := ModelTree.Items.AddChild(xWallElementNode, xSlope.FName); xSlopeNode.Data := xSlope; xSlopeNode.ImageIndex := 57; xSlopeNode.SelectedIndex := xSlopeNode.ImageIndex; // добавть грани откоса for jj := 0 to xSlope.FSides.Count - 1 do begin xSide := T3DSide(xSlope.FSides[jj]); xStrSide := GetSimilarSide(xSide, xStrSlope); xNode := ModelTree.Items.AddChild(xSlopeNode, xSide.FName); xNode.Data := xSide; xNode.ImageIndex := 50; xNode.SelectedIndex := xNode.ImageIndex; xSide.FFace.FTreeNode := xNode; if xStrSide <> nil then begin CopySideProperties(xSide, xStrSide); if xStrSide.FSubSides.Count > 0 then begin Faces.Remove(xSide.FFace); for iadd := 0 to xStrSide.FSubSides.Count - 1 do begin xStrSubSide := T3DSide(xStrSide.FSubSides[iadd]); xSubSide := CopySubSideProperties(xStrSubSide); xSubNode := ModelTree.Items.AddChild(xNode, xSubSide.FName); xSubNode.Data := xSubSide; xSubNode.ImageIndex := 56; xSubNode.SelectedIndex := xSubNode.ImageIndex; xSubSide.FFace.FTreeNode := xSubNode; Faces.Add(xSubSide.FFace); xSubSide.FParent := xSide; xSide.FSubSides.Add(xSubSide); end; end; end; end; end; end; // дверь if xWallElement.FElementType = dotDoor then begin xWallElementNode:= ModelTree.Items.AddChild(xWallNode, xWallElement.FName); xWallElementNode.Data := xWallElement; xWallElementNode.ImageIndex := 51; xWallElementNode.SelectedIndex := xWallElementNode.ImageIndex; // добавить откосы for ii := 0 to xWallElement.FSlopes.Count - 1 do begin xSlope := T3DSlope(xWallElement.FSlopes[ii]); xStrSlope := T3DSlope(getModelObjectByComponID(xSlope.FSCSComponID)); xSlopeNode := ModelTree.Items.AddChild(xWallElementNode, xSlope.FName); xSlopeNode.Data := xSlope; xSlopeNode.ImageIndex := 57; xSlopeNode.SelectedIndex := xSlopeNode.ImageIndex; // добавть грани откоса for jj := 0 to xSlope.FSides.Count - 1 do begin xSide := T3DSide(xSlope.FSides[jj]); xStrSide := GetSimilarSide(xSide, xStrSlope); xNode := ModelTree.Items.AddChild(xSlopeNode, xSide.FName); xNode.Data := xSide; xNode.ImageIndex := 50; xNode.SelectedIndex := xNode.ImageIndex; xSide.FFace.FTreeNode := xNode; if xStrSide <> nil then begin CopySideProperties(xSide, xStrSide); if xStrSide.FSubSides.Count > 0 then begin Faces.Remove(xSide.FFace); for iadd := 0 to xStrSide.FSubSides.Count - 1 do begin xStrSubSide := T3DSide(xStrSide.FSubSides[iadd]); xSubSide := CopySubSideProperties(xStrSubSide); xSubNode := ModelTree.Items.AddChild(xNode, xSubSide.FName); xSubNode.Data := xSubSide; xSubNode.ImageIndex := 56; xSubNode.SelectedIndex := xSubNode.ImageIndex; xSubSide.FFace.FTreeNode := xSubNode; Faces.Add(xSubSide.FFace); xSubSide.FParent := xSide; xSide.FSubSides.Add(xSubSide); end; end; end; end; end; end; // балкон if xWallElement.FElementType = dotBalcony then begin xWallElementNode:= ModelTree.Items.AddChild(xWallNode, xWallElement.FName); xWallElementNode.Data := xWallElement; xWallElementNode.ImageIndex := 55; xWallElementNode.SelectedIndex := xWallElementNode.ImageIndex; // добавить откосы for ii := 0 to xWallElement.FSlopes.Count - 1 do begin xSlope := T3DSlope(xWallElement.FSlopes[ii]); xStrSlope := T3DSlope(getModelObjectByComponID(xSlope.FSCSComponID)); xSlopeNode := ModelTree.Items.AddChild(xWallElementNode, xSlope.FName); xSlopeNode.Data := xSlope; xSlopeNode.ImageIndex := 57; xSlopeNode.SelectedIndex := xSlopeNode.ImageIndex; // добавть грани откоса for jj := 0 to xSlope.FSides.Count - 1 do begin xSide := T3DSide(xSlope.FSides[jj]); xStrSide := GetSimilarSide(xSide, xStrSlope); xNode := ModelTree.Items.AddChild(xSlopeNode, xSide.FName); xNode.Data := xSide; xNode.ImageIndex := 50; xNode.SelectedIndex := xNode.ImageIndex; xSide.FFace.FTreeNode := xNode; if xStrSide <> nil then begin CopySideProperties(xSide, xStrSide); if xStrSide.FSubSides.Count > 0 then begin Faces.Remove(xSide.FFace); for iadd := 0 to xStrSide.FSubSides.Count - 1 do begin xStrSubSide := T3DSide(xStrSide.FSubSides[iadd]); xSubSide := CopySubSideProperties(xStrSubSide); xSubNode := ModelTree.Items.AddChild(xNode, xSubSide.FName); xSubNode.Data := xSubSide; xSubNode.ImageIndex := 56; xSubNode.SelectedIndex := xSubNode.ImageIndex; xSubSide.FFace.FTreeNode := xSubNode; Faces.Add(xSubSide.FFace); xSubSide.FParent := xSide; xSide.FSubSides.Add(xSubSide); end; end; end; end; end; // добавить элементы балкона for ii := 0 to xWallElement.FBalconElements.Count - 1 do begin xBalconElement := T3DBalconElement(xWallElement.FBalconElements[ii]); xStrBalconElement := T3DBalconElement(getModelObjectByComponID(xBalconElement.FSCSComponID)); if xBalconElement.FElementType = dotDoor then begin xBalconElementNode := ModelTree.Items.AddChild(xWallElementNode, xBalconElement.FName); xBalconElementNode.ImageIndex := 51; xBalconElementNode.SelectedIndex := xBalconElementNode.ImageIndex; end; if xBalconElement.FElementType = dotWindow then begin xBalconElementNode := ModelTree.Items.AddChild(xWallElementNode, xBalconElement.FName); xBalconElementNode.ImageIndex := 52; xBalconElementNode.SelectedIndex := xBalconElementNode.ImageIndex; end; xBalconElementNode.Data := xBalconElement; // добавть грани элемента балкона for jj := 0 to xBalconElement.FSides.Count - 1 do begin xSide := T3DSide(xBalconElement.FSides[jj]); xStrSide := GetSimilarSide(xSide, xStrBalconElement); xNode := ModelTree.Items.AddChild(xBalconElementNode, xSide.FName); xNode.Data := xSide; xNode.ImageIndex := 50; xNode.SelectedIndex := xNode.ImageIndex; xSide.FFace.FTreeNode := xNode; if xStrSide <> nil then begin CopySideProperties(xSide, xStrSide); if xStrSide.FSubSides.Count > 0 then begin Faces.Remove(xSide.FFace); for iadd := 0 to xStrSide.FSubSides.Count - 1 do begin xStrSubSide := T3DSide(xStrSide.FSubSides[iadd]); xSubSide := CopySubSideProperties(xStrSubSide); xSubNode := ModelTree.Items.AddChild(xNode, xSubSide.FName); xSubNode.Data := xSubSide; xSubNode.ImageIndex := 56; xSubNode.SelectedIndex := xSubNode.ImageIndex; xSubSide.FFace.FTreeNode := xSubNode; Faces.Add(xSubSide.FFace); xSubSide.FParent := xSide; xSide.FSubSides.Add(xSubSide); end; end; end; end; end; end; // ниша if xWallElement.FElementType = dotNiche then begin xWallElementNode:= ModelTree.Items.AddChild(xWallNode, xWallElement.FName); xWallElementNode.Data := xWallElement; xWallElementNode.ImageIndex := 53; xWallElementNode.SelectedIndex := xWallElementNode.ImageIndex; end; // арка if xWallElement.FElementType = dotArc then begin xWallElementNode:= ModelTree.Items.AddChild(xWallNode, xWallElement.FName); xWallElementNode.Data := xWallElement; xWallElementNode.ImageIndex := 54; xWallElementNode.SelectedIndex := xWallElementNode.ImageIndex; end; // добавить грани данного элемента стены for ii := 0 to xWallElement.FSides.Count - 1 do begin xSide := T3DSide(xWallElement.FSides[ii]); xStrSide := GetSimilarSide(xSide, xStrWallElement); xNode := ModelTree.Items.AddChild(xWallElementNode, xSide.FName); xNode.Data := xSide; xNode.ImageIndex := 50; xNode.SelectedIndex := xNode.ImageIndex; xSide.FFace.FTreeNode := xNode; if xStrSide <> nil then begin CopySideProperties(xSide, xStrSide); if xStrSide.FSubSides.Count > 0 then begin Faces.Remove(xSide.FFace); for iadd := 0 to xStrSide.FSubSides.Count - 1 do begin xStrSubSide := T3DSide(xStrSide.FSubSides[iadd]); xSubSide := CopySubSideProperties(xStrSubSide); xSubNode := ModelTree.Items.AddChild(xNode, xSubSide.FName); xSubNode.Data := xSubSide; xSubNode.ImageIndex := 56; xSubNode.SelectedIndex := xSubNode.ImageIndex; xSubSide.FFace.FTreeNode := xSubNode; Faces.Add(xSubSide.FFace); xSubSide.FParent := xSide; xSide.FSubSides.Add(xSubSide); end; end; end; end; end; // добавить грани стены for k := 0 to xWall.FSides.Count - 1 do begin xSide := T3DSide(xWall.FSides[k]); xStrSide := GetSimilarSide(xSide, xStrWall); xNode := ModelTree.Items.AddChild(xWallNode, xSide.FName); xNode.Data := xSide; xNode.ImageIndex := 50; xNode.SelectedIndex := xNode.ImageIndex; xSide.FFace.FTreeNode := xNode; if xStrSide <> nil then begin CopySideProperties(xSide, xStrSide); if xStrSide.FSubSides.Count > 0 then begin Faces.Remove(xSide.FFace); for iadd := 0 to xStrSide.FSubSides.Count - 1 do begin xStrSubSide := T3DSide(xStrSide.FSubSides[iadd]); xSubSide := CopySubSideProperties(xStrSubSide); xSubNode := ModelTree.Items.AddChild(xNode, xSubSide.FName); xSubNode.Data := xSubSide; xSubNode.ImageIndex := 56; xSubNode.SelectedIndex := xSubNode.ImageIndex; xSubSide.FFace.FTreeNode := xSubNode; Faces.Add(xSubSide.FFace); xSubSide.FParent := xSide; xSide.FSubSides.Add(xSubSide); end; end; end; end; //*****************ROOF*********************** //Тут распарсить углы.Так как почти вся прога построена на указателях, //шаг вправо, шаг влево - взрыв))) Потому добавлять углы будем следующим образом: //Берем две стены, точнее - их координаты, и проверяем на пересекаемость. //Если есть точка пересечения - значит это угол, добавляем его. Пока так... { for cld := j+1 to xRoom.FWalls.Count - 1 do begin xSecondWall := T3DWall(xRoom.FWalls[cld]); if LinesCross(xSecondWall.FPlanObject.IP1^, xSecondWall.FPlanObject.IP2^, xWall.FPlanObject.IP1^, xWall.FPlanObject.IP2^) then begin //находим точку пересечения if GetInterSectionPoint(xSecondWall.FPlanObject.IP1^, xSecondWall.FPlanObject.IP2^, xWall.FPlanObject.IP1^, xWall.FPlanObject.IP2^, ip) then begin CornerName := 'Угол для: ' + xSecondWall.FName + '/' + xWall.FName; xCorner := T3DCorner.Create(xRoom,CornerName); xCorner.JoinedWalls.Add(xSecondWall); xCorner.JoinedWalls.Add(xWall); CornerNode := ModelTree.Items.AddChild(xRoomNode, CornerName); CornerNode.Data := xCorner; CornerNode.ImageIndex := 3; CornerNode.SelectedIndex := CornerNode.ImageIndex; end; end; end; } //*****************\ROOF********************** end; //*****************ROOF*********************** {$IF Defined(ES_GRAPH_SC)} if xRoom.FCorner <> nil then begin for cld := 0 to xRoom.FCorner.Count - 1 do begin xCorner := T3DCorner(xRoom.FCorner[cld]); CornerNode := ModelTree.Items.AddChild(xRoomNode, xCorner.FName); CornerNode.Data := xCorner; CornerNode.ImageIndex := 3; CornerNode.SelectedIndex := CornerNode.ImageIndex; end; end; {$IFEND} //*****************\ROOF********************** end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.UpdateModelTreeFromStream', E.Message); end; end; procedure Tfrm3D.UpdateScsModelTreeFromStream(Faces: TList); var i, j, k, ii, jj, kk, iadd: integer; xModelNode, xListNode, xScsNode: TTreeNode; xConn, xStrConn: T3DConnector; xLine, xStrLine: T3DLine; FName: string; Str: string; begin try xModelNode := ScsModelTree.Items.GetFirstNode; // добавить лист Str := FCAD.FCADListName + ' ' + IntToStr(FCAD.FCADListIndex); xListNode:= ScsModelTree.Items.AddChild(xModelNode, Str); xListNode.Data := FCAD; xListNode.ImageIndex := 1; xListNode.SelectedIndex := xListNode.ImageIndex; for i := 0 to F3DModel.FScsObjects.Count - 1 do begin if TObject(F3DModel.FScsObjects[i]) is T3DConnector then begin xConn := T3DConnector(F3DModel.FScsObjects[i]); if (xConn.FListID <> FCAD.FCADListID) then Continue; if (xConn.FConnType = ct_Empty) then begin xConn.FFace.F3DObject := xConn; Continue; end; xStrConn := T3DConnector(getModelObjectByComponID(xConn.FSCSComponID, 2)); xScsNode:= ScsModelTree.Items.AddChild(xListNode, xConn.FName); xScsNode.Data := xConn; xScsNode.ImageIndex := 3; xScsNode.SelectedIndex := xScsNode.ImageIndex; xConn.FFace.FTreeNode := xScsNode; if xStrConn <> nil then begin CopyConnectorProperties(xConn, xStrConn); end; end; if TObject(F3DModel.FScsObjects[i]) is T3DLine then begin xLine := T3DLine(F3DModel.FScsObjects[i]); if (xLine.FListID <> FCAD.FCADListID) then Continue; xStrLine := T3DLine(getModelObjectByComponID(xLine.FSCSComponID, 2)); xScsNode:= ScsModelTree.Items.AddChild(xListNode, xLine.FName); xScsNode.Data := xLine; xScsNode.ImageIndex := 2; xScsNode.SelectedIndex := xScsNode.ImageIndex; xLine.FFace.FTreeNode := xScsNode; if xStrLine <> nil then begin CopyLineProperties(xLine, xStrLine); end; end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.UpdateScsModelTreeFromStream', E.Message); end; end; function Tfrm3D.CopySideProperties(aSide, aStrSide: T3DSide): T3DSide; var i, j: integer; xSide: T3DSide; Points: T3DPointArray; begin try Result := nil; xSide := aSide; xSide.FName := aStrSide.FName; xSide.FDescription.Text := aStrSide.FDescription.Text; xSide.FFaceType := aStrSide.FFaceType; xSide.FWallType := aStrSide.FWallType; xSide.FSideType := aStrSide.FSideType; xSide.FColor := aStrSide.FColor; xSide.FTextureRotate := aStrSide.FTextureRotate; xSide.FTextureScale := aStrSide.FTextureScale; xSide.FMirror := aStrSide.FMirror; xSide.FTextureHash := aStrSide.FTextureHash; xSide.FTexture_ext := aStrSide.FTexture_ext; SetLength(xSide.FPoints, Length(aStrSide.FPoints)); for i := 0 to Length(aStrSide.FPoints) - 1 do begin xSide.FPoints[i].x := aStrSide.FPoints[i].x; xSide.FPoints[i].y := aStrSide.FPoints[i].y; xSide.FPoints[i].z := aStrSide.FPoints[i].z; end; SetLength(xSide.FGLPoints, Length(aStrSide.FGLPoints)); for i := 0 to Length(aStrSide.FGLPoints) - 1 do begin xSide.FGLPoints[i].x := aStrSide.FGLPoints[i].x; xSide.FGLPoints[i].y := aStrSide.FGLPoints[i].y; xSide.FGLPoints[i].z := aStrSide.FGLPoints[i].z; end; SetLength(xSide.FFace.Points, Length(xSide.FPoints)); for i := 0 to Length(xSide.FPoints) - 1 do xSide.FFace.Points[i] := xSide.FPoints[i]; except on E: Exception do AddExceptionToLogEx('Tfrm3D.CopySideProperties', E.Message); end; end; function Tfrm3D.CopySubSideProperties(aStrSubSide: T3DSide): T3DSide; var i, j: integer; xSide: T3DSide; Points: T3DPointArray; begin try Result := nil; xSide := T3DSide.Create(aStrSubSide.FFaceType, aStrSubSide.FWallType, aStrSubSide.FSideType, aStrSubSide.FParent); xSide.FName := aStrSubSide.FName; xSide.FDescription.Text := aStrSubSide.FDescription.Text; xSide.FColor := aStrSubSide.FColor; xSide.FTextureRotate := aStrSubSide.FTextureRotate; xSide.FTextureScale := aStrSubSide.FTextureScale; xSide.FMirror := aStrSubSide.FMirror; xSide.FTextureHash := aStrSubSide.FTextureHash; xSide.FTexture_ext := aStrSubSide.FTexture_ext; SetLength(xSide.FPoints, Length(aStrSubSide.FPoints)); for i := 0 to Length(aStrSubSide.FPoints) - 1 do begin xSide.FPoints[i].x := aStrSubSide.FPoints[i].x; xSide.FPoints[i].y := aStrSubSide.FPoints[i].y; xSide.FPoints[i].z := aStrSubSide.FPoints[i].z; end; SetLength(xSide.FGLPoints, Length(aStrSubSide.FGLPoints)); for i := 0 to Length(aStrSubSide.FGLPoints) - 1 do begin xSide.FGLPoints[i].x := aStrSubSide.FGLPoints[i].x; xSide.FGLPoints[i].y := aStrSubSide.FGLPoints[i].y; xSide.FGLPoints[i].z := aStrSubSide.FGLPoints[i].z; end; xSide.FFace := TFaceRecord.Create(xSide.FPoints, clGray, xSide.FFaceType, 1, False, nil); xSide.FFace.FFaceWallType := xSide.FWallType; xSide.FFace.FWallSideType := xSide.FSideType; Result := xSide; except on E: Exception do AddExceptionToLogEx('Tfrm3D.CopySubSideProperties', E.Message); end; end; function Tfrm3D.CopyObjectProperties(aObject, aStrObject: T3DSObject): T3DSObject; var i, j: integer; xObject: T3DSObject; Points: T3DPointArray; begin try Result := nil; xObject := aObject; if xObject = nil then begin xObject := T3DSObject.Create(aStrObject.FParent); xObject.FName := aStrObject.FName; xObject.FDescription.Text := aStrObject.FDescription.Text; xObject.FObjectHash := aStrObject.FObjectHash; xObject.FTextureHash := aStrObject.FTextureHash; xObject.FTexture_ext := aStrObject.FTexture_ext; xObject.FPosition := aStrObject.FPosition; xObject.FScale := aStrObject.FScale; xObject.FRotate := aStrObject.FRotate; //for i := 0 to aStrObject.FFiles.Count - 1 do // xObject.FFiles.Add(aStrObject.FFiles[i]); //for i := 0 to aStrObject.FHashs.Count - 1 do // xObject.FHashs.Add(aStrObject.FHashs[i]); SetLength(Points, 1); Points[0].x := xObject.FPosition.x; Points[0].y := xObject.FPosition.y; Points[0].z := xObject.FPosition.z; xObject.FFace := TFaceRecord.Create(Points, clGray, ftNet3DSObject, 1, False, nil); Result := xObject; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.CopyObjectProperties', E.Message); end; end; function Tfrm3D.CopyConnectorProperties(aObject, aStrObject: T3DConnector): T3DConnector; var i: integer; xConn: T3DConnector; begin try Result := nil; xConn := aObject; xConn.FName := aStrObject.FName; xConn.FDescription.Text := aStrObject.FDescription.Text; xConn.FOffset := aStrObject.FOffset; xConn.FScale := aStrObject.FScale; xConn.FRotate := aStrObject.FRotate; xConn.FObjectHash := aStrObject.FObjectHash; xConn.FTextureHash := aStrObject.FTextureHash; xConn.FTexture_ext := aStrObject.FTexture_ext; //for i := 0 to aStrObject.FFiles.Count - 1 do // xConn.FFiles.Add(aStrObject.FFiles[i]); //for i := 0 to aStrObject.FHashs.Count - 1 do // xConn.FHashs.Add(aStrObject.FHashs[i]); except on E: Exception do AddExceptionToLogEx('Tfrm3D.CopyConnectorProperties', E.Message); end; end; function Tfrm3D.CopyLineProperties(aObject, aStrObject: T3DLine): T3DLine; var i: integer; xLine: T3DLine; begin try Result := nil; xLine := aObject; xLine.FName := aStrObject.FName; xLine.FDescription.Text := aStrObject.FDescription.Text; { xConn.FOffset := aStrObject.FOffset; xConn.FScale := aStrObject.FOffset; xConn.FRotate := aStrObject.FOffset; xConn.FObjectHash := aStrObject.FObjectHash; xConn.FTextureHash := aStrObject.FTextureHash; xConn.FTexture_ext := aStrObject.FTexture_ext; for i := 0 to aStrObject.FFiles.Count - 1 do xConn.FFiles.Add(aStrObject.FFiles[i]); for i := 0 to aStrObject.FHashs.Count - 1 do xConn.FHashs.Add(aStrObject.FHashs[i]); } except on E: Exception do AddExceptionToLogEx('Tfrm3D.CopyLineProperties', E.Message); end; end; procedure Tfrm3D.GLSceneViewerDblClick(Sender: TObject); var i, j: integer; Obj: TGLBaseSceneObject; Mesh: TGLMesh; Polygon: TGLPolygon; xNode: TTreeNode; xNodes: TList; isExists: boolean; ctrlDown: boolean; xObject: TObject; xTree: TTreeView; WallList: TList; hWall: T3DWall; iWalls,iModelCnt,iCorner: Integer; xCorner: T3DCorner; xRoom: T3DRoom; begin { if GLSceneViewer.Camera = FirstPersonCamera then exit;} try Obj := MyGetPickedobject(mx, my); if Obj <> nil then begin // Tolik 16/11/2018 -- if (Obj is TGLPolygon) or (Obj is TGLFreeForm) or (Obj is TGLPipe) or (Obj is TGLLines) or (Obj is TGLCylinder) or (obj.ClassName = 'TGLCube') then //if (Obj is TGLPolygon) or (Obj is TGLFreeForm) or (Obj is TGLPipe) or (Obj is TGLLines) or (Obj is TGLCylinder) then begin xNodes := TList.create; ctrlDown := (IsKeyDown(VK_LCONTROL) or IsKeyDown(VK_RCONTROL)); if (Obj.TagObject <> nil) then begin xObject := TObject(TTreeNode(Obj.TagObject).Data); if (xObject is T3DSide) or (xObject is T3DSObject)or(xObject is T3DWall)or(xObject is T3DCorner) then begin xTree := ModelTree; pcTree.ActivePage := TabArchModel; pcProps.ActivePage := TabArchProps; end; // Tolik 18/10/2018 -- //if (xObject is T3DConnector) or (xObject is T3DLine) or (xObject is T3DTube) then if (xObject is T3DConnector) or (xObject is T3DLine) or (xObject is T3DTube) or (xObject is T3DComponent) then begin xTree := ScsModelTree; pcTree.ActivePage := TabScsModel; pcProps.ActivePage := TabScsProps; end; if xTree.SelectionCount > 0 then begin for i := 0 to xTree.SelectionCount - 1 do begin xNode := xTree.Selections[i]; if TObject(xNode.Data) is T3DSObject then ctrlDown := False; if TObject(xNode.Data).ClassName <> TObject(TTreeNode(Obj.TagObject).Data).ClassName then ctrlDown := False; end; end; if ctrlDown then begin xNode := TTreeNode(Obj.TagObject); isExists := False; for i := 0 to xTree.SelectionCount - 1 do begin xNode := xTree.Selections[i]; if TTreeNode(Obj.TagObject) = xNode then begin isExists := True; if Not xNode.Selected then xNodes.Add(xNode); end else xNodes.Add(xNode); end; if Not isExists then xNodes.Add(TTreeNode(Obj.TagObject)); xTree.ClearSelection; for i := 0 to xNodes.Count - 1 do begin xNode := TTreeNode(xNodes.Items[i]); xNode.Selected := True; end; OnSelectNodes(xNodes); end else begin xNode := TTreeNode(Obj.TagObject); xTree.Select(xNode); xNodes.Add(xNode); {$IF Defined(ES_GRAPH_SC)} //Добавить линии грани, если это T3DSide //************************** ROOF ****************************************** if TObject(xNode.Data) is T3DSide then //Если это грань крыши if TObject(T3DSide(xNode.Data).FParent) is T3DRoom then //Если Парент - комната begin xRoom := T3DRoom(T3DSide(xNode.Data).FParent); if ifFiguraISRoof(xRoom.FSCSCOmpon) then begin if xRoom.FWalls <> nil then //Если стены у комнаты имеются begin WallList := xRoom.FWalls; for iWalls := 0 to WallList.Count - 1 do //Пробегаемся по всем стенам begin hWall := T3DWall(WallList[iWalls]); for iModelCnt := 0 to ModelTree.Items.Count - 1 do //Находим соответствующую стену с ModelTree//// if AnsiUpperCase(hWall.FName) = AnsiUpperCase(ModelTree.Items[iModelCnt].Text) then // begin // if hWall.FParent.FName = ModelTree.Items[iModelCnt].Parent.Text then // begin xNode := ModelTree.Items[iModelCnt]; xNodes.Add(xNode); //Добавляем НОД в лист для дальнейшей работы break; end; end; end; end; if xRoom.FCorner <> nil then begin for iCorner := 0 to xRoom.FCorner.Count - 1 do //Пробегаемся по всем стенам begin xCorner := T3DCorner(xRoom.FCorner[iCorner]); for iModelCnt := 0 to ModelTree.Items.Count - 1 do //Находим соответствующую стену с ModelTree//// if TObject(ModelTree.Items[iModelCnt].Data) is T3DCorner then // begin // if xCorner = T3DCorner(ModelTree.Items[iModelCnt].Data) then // begin xNode := ModelTree.Items[iModelCnt]; xNodes.Add(xNode); //Добавляем НОД в лист для дальнейшей работы break; end; end; end; end; end; end; //************************** \ROOF ***************************************** {$IFEND} OnSelectNodes(xNodes); end; end; end else begin ModelTree.ClearSelection; ScsModelTree.ClearSelection; DeselectGLObjects; end; end else begin ModelTree.ClearSelection; ScsModelTree.ClearSelection; DeselectGLObjects; end; if FNodesObjectsList.Count > 0 then DeleteNodesObjects; except on E: Exception do AddExceptionToLogEx('Tfrm3D.GLSceneViewerDblClick', E.Message); end; end; procedure Tfrm3D.ModelTreeClick(Sender: TObject); var i: Integer; xNode: TTreeNode; xNodes: TList; ClearSelected: boolean; hWall: T3DWall; WallList: TList; iWalls,iModelCnt,iCorner : Integer; xCorner: T3DCorner; xRoom: T3DRoom; // Tolik 07/09/2018 -- Procedure CollectNodes(aNode: ttreeNode); var i: Integer; childNode: TTreeNode; begin if TObject(aNode.Data) is T3DSide then xNodes.Add(aNode) else begin for i := 0 to aNode.Count - 1 do begin childNode := aNode.Item[i]; CollectNodes(childNode); end; end; end; // begin try if ModelTree.Selected <> nil then begin ClearSelected := False; for i := 0 to ModelTree.SelectionCount - 1 do begin xNode := ModelTree.Selections[i]; if TObject(xNode.Data) is T3DSObject then ClearSelected := True; if TObject(xNode.Data).ClassName <> TObject(ModelTree.Selected.Data).ClassName then ClearSelected := True; end; if ClearSelected then begin xNode := ModelTree.Selected; ModelTree.ClearSelection; xNode.Selected := True; end; xNodes := TList.create; for i := 0 to ModelTree.SelectionCount - 1 do begin xNode := ModelTree.Selections[i]; xNodes.Add(xNode); {$IF Defined(ES_GRAPH_SC)} //************************** ROOF ****************************************** if TObject(xNode.Data) is T3DSide then //Если это грань крыши if (TObject(T3DSide(xNode.Data).FParent) is T3DRoom)and(IfFiguraIsRoof(T3droom(T3DSide(xNode.Data).Fparent).FSCSCompon)) then //Если Парент - комната begin xRoom := T3DRoom(T3DSide(xNode.Data).FParent); if xRoom.FWalls <> nil then //Если стены у комнаты имеются begin WallList := xRoom.FWalls; for iWalls := 0 to WallList.Count - 1 do //Пробегаемся по всем стенам begin hWall := T3DWall(WallList[iWalls]); for iModelCnt := 0 to ModelTree.Items.Count - 1 do //Находим соответствующую стену с ModelTree//// if AnsiUpperCase(hWall.FName) = AnsiUpperCase(ModelTree.Items[iModelCnt].Text) then // begin // if hWall.FParent.FName = ModelTree.Items[iModelCnt].Parent.Text then // begin xNode := ModelTree.Items[iModelCnt]; xNodes.Add(xNode); //Добавляем НОД в лист для дальнейшей работы break; end; end; end; end; if xRoom.FCorner <> nil then begin for iCorner := 0 to xRoom.FCorner.Count - 1 do //Пробегаемся по всем стенам begin xCorner := T3DCorner(xRoom.FCorner[iCorner]); for iModelCnt := 0 to ModelTree.Items.Count - 1 do //Находим соответствующую стену с ModelTree//// if TObject(ModelTree.Items[iModelCnt].Data) is T3DCorner then // begin // if xCorner = T3DCorner(ModelTree.Items[iModelCnt].Data) then // begin xNode := ModelTree.Items[iModelCnt]; xNodes.Add(xNode); //Добавляем НОД в лист для дальнейшей работы break; end; end; end; end; end; {$else} // Tolik 07/09/2018 -- -- for SKS xNodes.Clear; CollectNodes(xNode); {$IFEND} //************************** \ROOF ***************************************** end; OnSelectNodes(xNodes); end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.ModelTreeClick', E.Message); end; end; procedure Tfrm3D.OnSelectNodes(aNodes: TList); var i: Integer; xNode: TTreeNode; xObjects: TList; begin try // найти все обьекты с Нодов xObjects := FindGLObjectsByNodes(aNodes); FNodes.Clear; for i := 0 to aNodes.Count - 1 do FNodes.Add(aNodes.Items[i]); if not Assigned(TimerOnSelectNodes.OnTimer) then begin FxObjects.Clear; for i := 0 to xObjects.Count - 1 do FxObjects.Add(xObjects.Items[i]); TimerOnSelectNodes.OnTimer := TimerOnSelectNodesTimer; TimerOnSelectNodes.Tag := 1; TimerOnSelectNodes.Enabled := True; end; { DeselectGLObjects; // Select objects SelectGLObjects(xObjects); } // Show Properties // Tolik -- 11/03/2017 -- xObjects.Free; // except on E: Exception do AddExceptionToLogEx('Tfrm3D.OnSelectNodes', E.Message); end; end; procedure Tfrm3D.FormCreate(Sender: TObject); var //xModelNode: TFlyNode; RootNode : TTreeNode; ini_file: TIniFile; // Tolik 03/10/2019 -- // Tolik 03/10/2019 -- function GetIniPath: String; begin {$if Defined(ES_GRAPH_SC)} Result := ExeDir + '\' + 'Scs.ini'; {$else} Result := ExtractFilePath(paramstr(0)) + 'Scs.ini'; {$ifend} end; // begin FMode := F3DPerspective; // Tolik 11/02/2020 // Tolik 03/10/2019 -- считать настройку корректировки материалов для моделей, которые грузятся из .obj // файлов ini_file := nil; try ini_file := TIniFile.Create(GetIniPath); except on E: Exception do AddExceptionToLog('3DModel Error Reading SCS.ini file', false); end; if ini_file <> nil then begin if ini_file.SectionExists('3D') then begin FCorrect3DModelMaterialForObj := Ini_File.ReadBool('3D', 'Correct3DModelMaterial', true); ini_file.Free; end; end; // // Tolik 07/09/2018 -- ModelTree.RightClickSelect := True; ErrorTextureLoad := False; // Tolik 03/12/2018 -- // ObjMatList := TStringList.Create; // Tolik 02/10/2019 -- FCurrObject := Nil; // 22/01/2019 -- FSelection := TList.Create; FPropObjects := TList.create; FPropRecord := TPropRecord.Create; FxObjects := TList.Create; FNodes := TList.Create; {$IF Defined(ES_GRAPH_SC)} //pcProps.Height := 420; {$IFEND} FMovedObject := nil; FRotatedObject := nil; FMovedFullConnector := nil; FMovedEmptyConnector := nil; FMovedLine := nil; FOffsetObjects := False; FRotatedObjects := False; SelObjColor := clrDarkWood; // clrLightWood; ObjColor := clrDarkBrown; // clrDarkWood; //FFileStream := ''; //13.12.2010 FIdsStream := TIntList.Create; FFilesStream := TStringList.Create; // FTextures := TStringList.Create; FMovedObjectsList := TList.Create; FShadowObjects := TList.Create; //Alex behav:= GetFPSMovement(FirstPerson); TabArchProps.TabVisible := false; TabScsProps.TabVisible := false; FCAD := nil; // Tolik 26/04/2018 -- isProjectModel := False; // показывает что выводится модель проекта (True) или модель листа (False) WasShiftMouse := False; // Tolik 16/01/2019 FMovedComponent := nil; // Tolik 18/01/2019 // {xModelNode := ScsModelTree.Items.GetFirstNode; if xModelNode <> nil then xModelNode.Text := cForm3D_Mes9; xModelNode := ModelTree.Items.GetFirstNode; if xModelNode <> nil then xModelNode.Text := cForm3D_Mes9;} //Tolik 07/05/2018-- cbDisableSubstratesTransparency.Caption := cForm3D_Mes12; SCSSubstratesPanel.Height := 320; tvSubStartesView.height := 320; tvSubStartesView.Visible := False; tvSubStartesView.Items.Clear; RootNode := tvSubStartesView.Items.Add( nil, cForm3D_Mes11); tvSubStartesView.DropTarget := RootNode; RootNode.Data := GLPlane1; tvSubStartesView.ItemState[RootNode.AbsoluteIndex] := csChecked; cbDisableSubstratesTransparency.Checked := True; // end; function Tfrm3D.FindGLObjectsByNodes(aNodes: TList): TList; var i,j: integer; xObj: TGLBaseSceneObject; xNode: TTreeNode; xNodes: TList; xCorner: T3DCorner; xWall: T3DWall; childNode: TTreeNode; // Tolik 18/10/2018 -- begin try Result := TList.Create; xNodes := GetAllSidesNodesByNodes(aNodes); for i := 0 to xNodes.Count - 1 do begin xNode := TTreeNode(xNodes[i]); if (TObject(xNode.Data) is T3DSide) then xObj := TGLBaseSceneObject(T3DSide(xNode.Data).FGLObject) else if (TObject(xNode.Data) is T3DSObject) then xObj := TGLBaseSceneObject(T3DSObject(xNode.Data).FGLObject) else //Tolik 18/10/2018 -- { if (TObject(xNode.Data) is T3DConnector) then xObj := TGLBaseSceneObject(T3DConnector(xNode.Data).FGLObject); } if (TObject(xNode.Data).ClassName = 'T3DComponent') then xObj := TGLBaseSceneObject(T3DComponent(xNode.Data).FGLObject) else if (TObject(xNode.Data).ClassName = 'T3DConnector') then begin xObj := TGLBaseSceneObject(T3DConnector(xNode.Data).FGLObject); if xObj = nil then begin for j := 0 to xNode.Count - 1 do begin ChildNode := xNode.Item[j]; xObj := TGLBaseSceneObject(T3DComponent(ChildNode.Data).FGLObject); Result.Add(xObj); xObj := nil; end; end; end else // if (TObject(xNode.Data) is T3DLine) then xObj := TGLBaseSceneObject(T3DLine(xNode.Data).FGLObject) else //Tolik 03/10/2018 -- if (TObject(xNode.Data) is T3DTube) then xObj := TGLCylinder(T3DTube(xNode.Data).FGLObject); // // {$IF Defined(ES_GRAPH_SC)} //Тут находим Объект в GLSCene, который отвечает нужному НОДУ дерева if (TObject(xNode.Data) is T3DWall) then xObj := TGLBaseSceneObject(T3DWall(xNode.Data).FGLObject); if (TObject(xNode.Data) is T3DCorner) then begin xCorner := T3DCorner(xNode.Data); if xCorner.JoinedWalls <> nil then for j := 0 to xCorner.JoinedWalls.Count - 1 do begin xWall := T3DWall(xCorner.JoinedWalls[j]); xObj := TGLBaseSceneObject(xWall.FGLObject); Result.Add(xObj); //И добавляем эти объекты в лист end; xObj := TGLBaseSceneObject(xCorner.FGLObject); end; //{$IFEND} if xObj <> nil then // Tolik 18/10/2018 -- нех добавлять пустые Result.Add(xObj); //И добавляем эти объекты в лист end; // Tolik -- 11/03/2017 -- xNodes.Free; // except on E: Exception do AddExceptionToLogEx('', E.Message); end; end; procedure Tfrm3D.SelectGLObjects_GOOD(aObjects: TList); var i: integer; xObj: TGLBaseSceneObject; begin try FSelection.Clear; for i := 0 to aObjects.Count - 1 do FSelection.Add(aObjects.Items[i]); for i := 0 to FSelection.Count - 1 do begin xObj := TGLBaseSceneObject(FSelection[i]); if (xObj is TGLPolygon) then begin TGLPolygon(xObj).Material.Texture.ImageGamma := 1.5; TGLPolygon(xObj).Material.MaterialOptions := []; end; if (xObj is TGLFreeForm) then begin with TGLFreeForm(xObj).Material do begin if (TGLFreeForm(xObj).Material.MaterialOptions = []) and (TGLFreeForm(xObj).Material.Texture.Disabled = False) then begin TGLFreeForm(xObj).Material.MaterialOptions := [moNoLighting]; TGLFreeForm(xObj).Material.Texture.Disabled := True; end else begin BackProperties.Ambient.Color := SelObjColor; BackProperties.Diffuse.Color := SelObjColor; BackProperties.Emission.Color := SelObjColor; FrontProperties.Ambient.Color := SelObjColor; FrontProperties.Diffuse.Color := SelObjColor; FrontProperties.Emission.Color := SelObjColor; end; end; end; end; except on E: Exception do AddExceptionToLogEx('', E.Message); end; end; procedure Tfrm3D.SelectGLObjects(aObjects: TList); var i, j,iWalls,iModelCnt, iobj: integer; xObj: TGLBaseSceneObject; xConn, JoinConn1, JoinConn2: T3DConnector; xLine: T3DLine; xTube: T3DTube; xWall{,hWall}: T3DWall; xNode{,hNode}: TTreeNode; // WallList,xWNodes, xObject: TList; F3DLineComponent: T3DLineComponent; ComponColor: Tvector4f; LineComponentNode, LineComponentParentNode: TTreeNode; LineComponObject: TGLSceneObject; breakCounter: integer; begin try FSelection.Clear; for i := 0 to aObjects.Count - 1 do FSelection.Add(aObjects.Items[i]); JoinConn1 := nil; JoinConn2 := nil; for i := 0 to FSelection.Count - 1 do begin xObj := TGLBaseSceneObject(FSelection[i]); if (xObj is TGLPolygon) then begin TGLPolygon(xObj).Material.Texture.ImageGamma := 1.5; TGLPolygon(xObj).Material.MaterialOptions := []; end; if (xObj is TGLFreeForm) then begin TGLFreeForm(xObj).UseMeshMaterials := False; // Tolik 02/10/2019 -- with TGLFreeForm(xObj).Material do begin if (TGLFreeForm(xObj).Material.MaterialOptions = []) and (TGLFreeForm(xObj).Material.Texture.Disabled = False) then begin TGLFreeForm(xObj).Material.MaterialOptions := [moNoLighting]; TGLFreeForm(xObj).Material.Texture.Disabled := True; end else begin BackProperties.Ambient.Color := SelObjColor; BackProperties.Diffuse.Color := SelObjColor; BackProperties.Emission.Color := SelObjColor; FrontProperties.Ambient.Color := SelObjColor; FrontProperties.Diffuse.Color := SelObjColor; FrontProperties.Emission.Color := SelObjColor; end; end; end; if (xObj is TGLLines) then begin glConn1.Visible := False; glConn2.Visible := False; if JoinConn1 <> nil then JoinConn1.FGLObject1 := nil; if JoinConn2 <> nil then JoinConn2.FGLObject1 := nil; xNode := TTreeNode(xObj.TagObject); // Tolik 29/10/2018 -- //if (TObject(xNode.Data)) is T3DLine then if (TObject(xNode.Data).ClassName = 'T3DLine') then // begin xLine := T3DLine(TTreeNode(xObj.TagObject).Data); //Tolik //TGLLines(xObj).LineColor.AsWinColor := clYellow; TGLLines(xObj).LineColor.AsWinColor := clRed; //TGLLines(xObj).LineWidth := 10; {10 как-то не очень} TGLLines(xObj).LineWidth := 2; //TGLLines(xLine.FGLObject).LineWidth := 10; TGLLines(xLine.FGLObject).LineWidth := 2; // JoinConn1 := xLine.FJoinConnector1; JoinConn2 := xLine.FJoinConnector2; // Its not connected conn if JoinConn1.FJoinedConnectorsList.Count = 0 then begin glConn1.Position.x := TGLPipe(JoinConn1.FGLObject).Nodes[0].x; glConn1.Position.y := TGLPipe(JoinConn1.FGLObject).Nodes[0].y; glConn1.Position.z := TGLPipe(JoinConn1.FGLObject).Nodes[0].z; glConn1.TagObject := JoinConn1; JoinConn1.FGLObject1 := glConn1; glConn1.Visible := True; end; if JoinConn2.FJoinedConnectorsList.Count = 0 then begin glConn2.Position.x := TGLPipe(JoinConn2.FGLObject).Nodes[0].x; glConn2.Position.y := TGLPipe(JoinConn2.FGLObject).Nodes[0].y; glConn2.Position.z := TGLPipe(JoinConn2.FGLObject).Nodes[0].z; glConn2.TagObject := JoinConn2; JoinConn2.FGLObject1 := glConn2; glConn2.Visible := True; end; end else if (TObject(xNode.Data)) is T3DWall then begin TGLLines(xObj).Visible := True; end else if (TObject(xNode.Data)) is T3DCorner then begin TGLLines(xObj).Visible := True; end; end; if (xObj is TGLPipe) then begin xConn := T3DConnector(TTreeNode(xObj.TagObject).Data); // TO if xConn.FConnType = ct_Full then begin if (xConn.FGLObject1 is TGLFreeForm) then begin with TGLFreeForm(xConn.FGLObject1).Material do begin if (TGLFreeForm(xConn.FGLObject1).Material.MaterialOptions = []) and (TGLFreeForm(xConn.FGLObject1).Material.Texture.Disabled = False) then begin TGLFreeForm(xConn.FGLObject1).Material.MaterialOptions := [moNoLighting]; TGLFreeForm(xConn.FGLObject1).Material.Texture.Disabled := True; end else begin BackProperties.Ambient.Color := SelObjColor; BackProperties.Diffuse.Color := SelObjColor; BackProperties.Emission.Color := SelObjColor; FrontProperties.Ambient.Color := SelObjColor; FrontProperties.Diffuse.Color := SelObjColor; FrontProperties.Emission.Color := SelObjColor; end; end; end; end else // Clear Connector begin if xConn.FisPipeElement then begin with TGLPipe(xConn.FGLObject).Material do begin if (TGLPipe(xConn.FGLObject).Material.MaterialOptions = []) and (TGLPipe(xConn.FGLObject).Material.Texture.Disabled = False) then begin TGLPipe(xConn.FGLObject).Material.MaterialOptions := [moNoLighting]; TGLPipe(xConn.FGLObject).Material.Texture.Disabled := True; end else begin BackProperties.Ambient.Color := SelObjColor; BackProperties.Diffuse.Color := SelObjColor; BackProperties.Emission.Color := SelObjColor; FrontProperties.Ambient.Color := SelObjColor; FrontProperties.Diffuse.Color := SelObjColor; FrontProperties.Emission.Color := SelObjColor; end; end; end; end; end; // Tolik 03/10/2018 -- if (xObj is TGLCylinder) then begin if TObject(TTreeNode(xObj.TagObject).Data).ClassName = 'T3DTube' then begin xTube := T3DTube(TTreeNode(xObj.TagObject).Data); // TO with TGLCylinder(xTube.FGLObject).Material do begin if (TGLCylinder(xTube.FGLObject).Material.MaterialOptions = []) and (TGLCylinder(xTube.FGLObject).Material.Texture.Disabled = False) then begin TGLCylinder(xTube.FGLObject).Material.MaterialOptions := [moNoLighting]; TGLCylinder(xTube.FGLObject).Material.Texture.Disabled := True; end else begin BackProperties.Ambient.Color := SelObjColor; BackProperties.Diffuse.Color := SelObjColor; BackProperties.Emission.Color := SelObjColor; FrontProperties.Ambient.Color := SelObjColor; FrontProperties.Diffuse.Color := SelObjColor; FrontProperties.Emission.Color := SelObjColor; end; end; end else if TObject(TTreeNode(xObj.TagObject).Data).ClassName = 'T3DLineComponent' then begin F3DLineComponent := T3DLineComponent(TTreeNode(xObj.TagObject).Data); LineComponentNode := TTreeNode(xObj.TagObject); if LineComponentNode <> nil then LineComponentParentNode := LineComponentNode.Parent; with TGLCylinder(F3DLineComponent.FGLObject).Material do begin if (TGLCylinder(F3DLineComponent.FGLObject).Material.MaterialOptions = []) and (TGLCylinder(F3DLineComponent.FGLObject).Material.Texture.Disabled = False) then begin TGLCylinder(F3DLineComponent.FGLObject).Material.MaterialOptions := [moNoLighting]; TGLCylinder(F3DLineComponent.FGLObject).Material.Texture.Disabled := True; end else begin if not isUserTransparency then begin ComponColor := ConvertWinColor(clGray); if F3DLineComponent.FSCSCompon <> nil then ComponColor := getLineComponColor(F3DLineComponent.FSCSCompon); BackProperties.Ambient.Color := ComponColor; BackProperties.Diffuse.Color := ComponColor; BackProperties.Emission.Color := ComponColor; FrontProperties.Ambient.Color := ComponColor; FrontProperties.Diffuse.Color := ComponColor; FrontProperties.Emission.Color := ComponColor; BlendingMode := bmOpaque; BackProperties.Diffuse.Alpha := 1; FrontProperties.Diffuse.Alpha := 1; end; end; end; // Tolik 23/11/2018 -- if not isUserTransparency then begin if LineComponentNode <> nil then if LineComponentParentNode <> nil then begin BreakCounter := 0; // на всякий для сброса цикла for j := 0 to LineComponentParentNode.Count - 1 do begin if LineComponentParentNode.Item[j] <> LineComponentNode then begin F3DLineComponent := T3DLineComponent(LineComponentParentNode.Item[j].Data); LineComponObject := TGLSceneObject(F3DLineComponent.FGLObject); with LineComponObject.Material do begin BlendingMode := bmTransparency; BackProperties.Diffuse.Alpha := 0.4; FrontProperties.Diffuse.Alpha := 0.4; end; end; end; { While LineComponentParentNode <> nil do begin if TObject(LineComponentParentNode.Data).ClassName = 'T3DLine' then LineComponentParentNode := nil else begin F3DLineComponent := T3DLineComponent(LineComponentParentNode.Data); LineComponObject := TGLSceneObject(F3DLineComponent.FGLObject); with LineComponObject.Material do begin BlendingMode := bmTransparency; BackProperties.Diffuse.Alpha := 0.4; FrontProperties.Diffuse.Alpha := 0.4; end; LineComponentParentNode := LineComponentParentNode.Parent; end; INC(BreakCounter); if breakCounter > 1000 then LineComponentParentNode := nil; end; } end; end; end; end; if (xObj.ClasSName = 'TGLCube' ) then begin // Tolik 19/11/2018 -- if TObject(TTreeNode(xObj.TagObject).Data).ClassName = 'T3DLineComponent' then begin F3DLineComponent := T3DLineComponent(TTreeNode(xObj.TagObject).Data); LineComponentNode := TTreeNode(xObj.TagObject); if LineComponentNode <> nil then LineComponentParentNode := LineComponentNode.Parent; with TGLCube(F3DLineComponent.FGLObject).Material do begin if (TGLCube(F3DLineComponent.FGLObject).Material.MaterialOptions = []) and (TGLCube(F3DLineComponent.FGLObject).Material.Texture.Disabled = False) then begin TGLCube(F3DLineComponent.FGLObject).Material.MaterialOptions := [moNoLighting]; TGLCube(F3DLineComponent.FGLObject).Material.Texture.Disabled := True; end else begin ComponColor := ConvertWinColor(clGray); if F3DLineComponent.FSCSCompon <> nil then ComponColor := getLineComponColor(F3DLineComponent.FSCSCompon); if not isUserTransparency then begin BackProperties.Ambient.Alpha := 1; BackProperties.Diffuse.Alpha := 1; BackProperties.Emission.Alpha := 1; FrontProperties.Ambient.Alpha := 1; FrontProperties.Diffuse.Alpha := 1; FrontProperties.Emission.Alpha := 1; end; BackProperties.Ambient.Color := SelObjColor; BackProperties.Diffuse.Color := SelObjColor; BackProperties.Emission.Color := SelObjColor; FrontProperties.Ambient.Color := SelObjColor; FrontProperties.Diffuse.Color := SelObjColor; FrontProperties.Emission.Color := SelObjColor; end; end; // Tolik 23/11/2018 -- if not isUserTransparency then begin if LineComponentNode <> nil then if LineComponentParentNode <> nil then begin BreakCounter := 0; // на всякий для сброса цикла for j := 0 to LineComponentParentNode.Count - 1 do begin if LineComponentParentNode.Item[j] <> LineComponentNode then begin F3DLineComponent := T3DLineComponent(LineComponentParentNode.Item[j].Data); LineComponObject := TGLSceneObject(F3DLineComponent.FGLObject); with LineComponObject.Material do begin BlendingMode := bmTransparency; BackProperties.Diffuse.Alpha := 0.4; FrontProperties.Diffuse.Alpha := 0.4; end; end; end; end; end; end else begin with TGLCube(xObj).Material do begin if (TGLCube(xObj).Material.MaterialOptions = []) and (TGLCube(xObj).Material.Texture.Disabled = False) then begin TGLCube(xObj).Material.MaterialOptions := [moNoLighting]; TGLCube(xObj).Material.Texture.Disabled := True; end else begin BackProperties.Ambient.Color := SelObjColor; BackProperties.Diffuse.Color := SelObjColor; BackProperties.Emission.Color := SelObjColor; FrontProperties.Ambient.Color := SelObjColor; FrontProperties.Diffuse.Color := SelObjColor; FrontProperties.Emission.Color := SelObjColor; end; end; end; { if TObject(TTreeNode(xObj.TagObject).Data).ClassName = 'T3DLineComponent' then begin end else begin with TGLCube(xConn.FGLObject).Material do begin if (TGLCube(xConn.FGLObject).Material.MaterialOptions = []) and (TGLCube(xConn.FGLObject).Material.Texture.Disabled = False) then begin TGLCube(xConn.FGLObject).Material.MaterialOptions := [moNoLighting]; TGLCube(xConn.FGLObject).Material.Texture.Disabled := True; end else begin BackProperties.Ambient.Color := SelObjColor; BackProperties.Diffuse.Color := SelObjColor; BackProperties.Emission.Color := SelObjColor; FrontProperties.Ambient.Color := SelObjColor; FrontProperties.Diffuse.Color := SelObjColor; FrontProperties.Emission.Color := SelObjColor; end; end; end; } end; end; except on E: Exception do AddExceptionToLogEx('', E.Message); end; end; {TODO 22.07.2011} // Сравнить с кодом из СС или из UP3 на счет селектов деселектов и установки текстур вообще // OK procedure Tfrm3D.DeselectGLObjects; begin if not Assigned(TimerOnSelectNodes.OnTimer) then begin TimerOnSelectNodes.OnTimer := TimerOnSelectNodesTimer; TimerOnSelectNodes.Tag := 0; TimerOnSelectNodes.Enabled := True; end; end; procedure Tfrm3D.DeselectGLObjectsT; var i, j: integer; xObj: TGLBaseSceneObject; xConn, JoinConn1, JoinConn2: T3DConnector; xLine: T3DLine; xWall: T3DWall; xTube: T3DTube; F3DComponent: T3DComponent; F3DLineComponent: T3DLineComponent; ComponColor: Tvector4f; // Tolik 23/11/2018 -- LineComponentNode, LineComponentParentNode: TTreeNode; LineComponObject: TGLSceneObject; begin try JoinConn1 := nil; JoinConn2 := nil; for i := 0 to FSelection.Count - 1 do begin xObj := TGLBaseSceneObject(FSelection[i]); if (xObj is TGLPolygon) then begin TGLPolygon(xObj).Material.Texture.ImageGamma := 1; TGLPolygon(xObj).Material.MaterialOptions := [moNoLighting]; end; if (xObj is TGLFreeForm) then begin with TGLFreeForm(xObj).Material do begin if (TGLFreeForm(xObj).Material.MaterialOptions = [moNoLighting]) and (TGLFreeForm(xObj).Material.Texture.Disabled = True) then begin TGLFreeForm(xObj).Material.MaterialOptions := []; TGLFreeForm(xObj).Material.Texture.Disabled := False; end else begin BackProperties.Ambient.Color := ObjColor; BackProperties.Diffuse.Color := ObjColor; BackProperties.Emission.Color := ObjColor; FrontProperties.Ambient.Color := ObjColor; FrontProperties.Diffuse.Color := ObjColor; FrontProperties.Emission.Color := ObjColor; end; end; TGLFreeForm(xObj).UseMeshMaterials := True; // Tolik 02/10/2019 -- end; if (xObj is TGLLines) then begin if (TObject(TTreeNode(xObj.TagObject).Data)) is T3DLine then begin xLine := T3DLine(TTreeNode(xObj.TagObject).Data); TGLLines(xObj).LineColor.AsWinColor := xLine.FColor; //Tolik if xLine.FSCSObject <> nil then begin if TOrthoLine(xLine.FSCSObject).FLineType = ts_ClearTrace then TGLLines(xObj).LineWidth := 1 else TGLLines(xObj).LineWidth := 4; end else TGLLines(xObj).LineWidth := 1; {if xLine.FSCSCompon <> nil then begin if TOrthoLine(xLine.FSCSCompon).FLineType = ts_ClearTrace then TGLLines(xObj).LineWidth := 1 else TGLLines(xObj).LineWidth := 4; end else TGLLines(xObj).LineWidth := 1; } //TGLLines(xObj).LineWidth := 1; // JoinConn1 := xLine.FJoinConnector1; JoinConn2 := xLine.FJoinConnector2; if JoinConn1.FGLObject1 <> nil then begin JoinConn1.FGLObject1 := nil; glConn1.Visible := False; end; if JoinConn2.FGLObject1 <> nil then begin JoinConn2.FGLObject1 := nil; glConn2.Visible := False; end; end else if ((TObject(TTreeNode(xObj.TagObject).Data)) is T3DWall)and( IfFiguraIsRoof(T3DWall(TTreeNode(xObj.TagObject).Data).FSCSCompon) ) then begin TGLLines(xObj).Visible := False; end else if (TObject(TTreeNode(xObj.TagObject).Data)) is T3DCorner then begin TGLLines(xObj).Visible := False; end; end; if (xObj is TGLPipe) then begin xConn := T3DConnector(TTreeNode(xObj.TagObject).Data); if (xConn.FGLObject1 is TGLFreeForm) then begin with TGLFreeForm(xConn.FGLObject1).Material do begin if (TGLFreeForm(xConn.FGLObject1).Material.MaterialOptions = [moNoLighting]) and (TGLFreeForm(xConn.FGLObject1).Material.Texture.Disabled = True) then begin TGLFreeForm(xConn.FGLObject1).Material.MaterialOptions := []; TGLFreeForm(xConn.FGLObject1).Material.Texture.Disabled := False; end else begin BackProperties.Ambient.Color := xConn.FColor; BackProperties.Diffuse.Color := xConn.FColor; BackProperties.Emission.Color := xConn.FColor; FrontProperties.Ambient.Color := xConn.FColor; FrontProperties.Diffuse.Color := xConn.FColor; FrontProperties.Emission.Color := xConn.FColor; end; end; end; if xConn.FisPipeElement then begin with TGLPipe(xConn.FGLObject).Material do begin if (TGLPipe(xConn.FGLObject).Material.MaterialOptions = [moNoLighting]) and (TGLPipe(xConn.FGLObject).Material.Texture.Disabled = True) then begin TGLPipe(xConn.FGLObject).Material.MaterialOptions := []; TGLPipe(xConn.FGLObject).Material.Texture.Disabled := False; end else begin BackProperties.Ambient.Color := xConn.FColor; BackProperties.Diffuse.Color := xConn.FColor; BackProperties.Emission.Color := xConn.FColor; FrontProperties.Ambient.Color := xConn.FColor; FrontProperties.Diffuse.Color := xConn.FColor; FrontProperties.Emission.Color := xConn.FColor; end; end; end; end; // Tolik 03/10/2018 -- if (xObj is TGLCylinder) then begin if TObject(TTreeNode(xObj.TagObject).Data).ClassNAme = 'T3DTube' then begin xTube := T3DTube(TTreeNode(xObj.TagObject).Data); with TGLCylinder(xTube.FGLObject).Material do begin if (TGLCylinder(xTube.FGLObject).Material.MaterialOptions = [moNoLighting]) and (TGLCylinder(xTube.FGLObject).Material.Texture.Disabled = True) then begin TGLCylinder(xTube.FGLObject).Material.MaterialOptions := []; TGLCylinder(xTube.FGLObject).Material.Texture.Disabled := False; end else begin BackProperties.Ambient.Color := ConvertWinColor(xTube.FColor); BackProperties.Diffuse.Color := ConvertWinColor(xTube.FColor); BackProperties.Emission.Color := ConvertWinColor(xTube.FColor); FrontProperties.Ambient.Color := ConvertWinColor(xTube.FColor); FrontProperties.Diffuse.Color := ConvertWinColor(xTube.FColor); FrontProperties.Emission.Color := ConvertWinColor(xTube.FColor); end; end; end else begin if TObject(TTreeNode(xObj.TagObject).Data).ClassNAme = 'T3DLineComponent' then begin if not isUserTransparency then begin F3DLineComponent := T3DLineComponent(TTreeNode(xObj.TagObject).Data); LineComponentNode := TTreeNode(xObj.TagObject); if LineComponentNode <> nil then LineComponentParentNode := LineComponentNode.Parent; if LineComponentParentNode <> nil then begin for j := 0 to LineComponentParentNode.Count - 1 do begin F3DLineComponent := T3DLineComponent(LineComponentParentNode.Item[j].Data); LineComponObject := TGLSceneObject(F3DLineComponent.FGLObject); with LineComponObject.Material do begin ComponColor := ConvertWinColor(clGray); if F3DLineComponent.FSCSCompon <> nil then ComponColor := getLineComponColor(F3DLineComponent.FSCSCompon); BackProperties.Ambient.Color := ComponColor;//ConvertWinColor(clGreen); BackProperties.Diffuse.Color := ComponColor;//ConvertWinColor(clGreen); BackProperties.Emission.Color := ComponColor;//ConvertWinColor(clGreen); FrontProperties.Ambient.Color := ComponColor;//ConvertWinColor(clGreen); FrontProperties.Diffuse.Color := ComponColor;//ConvertWinColor(clGreen); FrontProperties.Emission.Color := ComponColor;//ConvertWinColor(clGreen); BlendingMode := bmOpaque; BackProperties.Diffuse.Alpha := 1; FrontProperties.Diffuse.Alpha := 1; end; end; end else begin with TGLCylinder(F3DLineComponent.FGLObject).Material do begin if (TGLCylinder(F3DLineComponent.FGLObject).Material.MaterialOptions = [moNoLighting]) and (TGLCylinder(F3DLineComponent.FGLObject).Material.Texture.Disabled = True) then begin TGLCylinder(F3DLineComponent.FGLObject).Material.MaterialOptions := []; TGLCylinder(F3DLineComponent.FGLObject).Material.Texture.Disabled := False; end else begin ComponColor := ConvertWinColor(clGray); if F3DLineComponent.FSCSCompon <> nil then ComponColor := getLineComponColor(F3DLineComponent.FSCSCompon); BackProperties.Ambient.Color := ComponColor;//ConvertWinColor(clGreen); BackProperties.Diffuse.Color := ComponColor;//ConvertWinColor(clGreen); BackProperties.Emission.Color := ComponColor;//ConvertWinColor(clGreen); FrontProperties.Ambient.Color := ComponColor;//ConvertWinColor(clGreen); FrontProperties.Diffuse.Color := ComponColor;//ConvertWinColor(clGreen); FrontProperties.Emission.Color := ComponColor;//ConvertWinColor(clGreen); BlendingMode := bmOpaque; BackProperties.Diffuse.Alpha := 1; FrontProperties.Diffuse.Alpha := 1; end; end; end; end; // Tolik 23/11/2018 -- {if LineComponentNode <> nil then if LineComponentParentNode <> nil then begin While LineComponentParentNode <> nil do begin if TObject(LineComponentParentNode.Data).ClassName = 'T3DLine' then LineComponentParentNode := nil else begin F3DLineComponent := T3DLineComponent(LineComponentParentNode.Data); LineComponObject := TGLSceneObject(F3DLineComponent.FGLObject); with LineComponObject.Material do begin BlendingMode := bmOpaque; BackProperties.Diffuse.Alpha := 1; FrontProperties.Diffuse.Alpha := 1; end; LineComponentParentNode := LineComponentParentNode.Parent; end; end; end; } end end; end; // // Tolik 19/11/2018 -- if (xObj is TGLCube) then begin with TGLCube(xObj).Material do begin if (TGLCube(xObj).Material.MaterialOptions = [moNoLighting]) and (TGLCube(xObj).Material.Texture.Disabled = True) then begin TGLCube(xObj).Material.MaterialOptions := []; TGLCube(xObj).Material.Texture.Disabled := False; end; //else begin if TObject(TTreeNode(xObj.TagObject).Data).ClassNAme = 'T3DLineComponent' then begin if not isUserTransparency then begin F3DLineComponent := T3DLineComponent(TTreeNode(xObj.TagObject).Data); LineComponentNode := TTreeNode(xObj.TagObject); if LineComponentNode <> nil then LineComponentParentNode := LineComponentNode.Parent; if LineComponentParentNode <> nil then begin for j := 0 to LineComponentParentNode.Count - 1 do begin F3DLineComponent := T3DLineComponent(LineComponentParentNode.Item[j].Data); LineComponObject := TGLSceneObject(F3DLineComponent.FGLObject); with LineComponObject.Material do begin ComponColor := ConvertWinColor(clGray); if F3DLineComponent.FSCSCompon <> nil then ComponColor := getLineComponColor(F3DLineComponent.FSCSCompon); BackProperties.Ambient.Color := ComponColor;//ConvertWinColor(clGreen); BackProperties.Diffuse.Color := ComponColor;//ConvertWinColor(clGreen); BackProperties.Emission.Color := ComponColor;//ConvertWinColor(clGreen); FrontProperties.Ambient.Color := ComponColor;//ConvertWinColor(clGreen); FrontProperties.Diffuse.Color := ComponColor;//ConvertWinColor(clGreen); FrontProperties.Emission.Color := ComponColor;//ConvertWinColor(clGreen); BlendingMode := bmOpaque; BackProperties.Diffuse.Alpha := 1; FrontProperties.Diffuse.Alpha := 1; end; end; end; end; end else begin end; end; end; end; // end; FSelection.Clear; SetAllPanels(False); SetAllScsPanels(False); except on E: Exception do AddExceptionToLogEx('Tfrm3D.DeselectGLObjectsT', E.Message); end; end; procedure Tfrm3D.OnLoadProperties(aObjects: TList); var i: integer; ViewType: TPropViewType; begin try ViewType := GetPropViewType(aObjects); // None if ViewType = pvtNone then begin FPropObjects.Clear; SetAllPanels(False); SetAllScsPanels(False); end // Single Side else if ViewType = pvtSingleSide then begin // Tolik 20/03/2017 -- //FPropObjects := aObjects; FPropObjects.Clear; FPropObjects.Assign(aObjects, laOr); // SetAllPanels(False); panSideTexture.Visible := True; panMirror.Visible := True; panRotate.Visible := True; // panCoords.Visible := True; panDesc.Visible := True; panName.Visible := True; LoadPropertiesForSingleObject(TTreeNode(FPropObjects[0])); end // Multi Sides else if ViewType = pvtMultiSides then begin // Tolik 20/03/2017 -*- FPropObjects.Clear; FPropObjects.Assign(aObjects,laOr); // FPropObjects := aObjects; // SetAllPanels(False); panSideTexture.Visible := True; panMirror.Visible := True; panRotate.Visible := True; // panCoords.Visible := True; panDesc.Visible := True; LoadPropertiesForMultiObjects(FPropObjects); end // Single 3ds object else if ViewType = pvtSingle3ds then begin // Tolik 20/03/2017 -*- FPropObjects.Clear; FPropObjects.Assign(aObjects,laOr); // FPropObjects := aObjects; // SetAllPanels(False); panObjectTexture.Visible := True; panScale3ds.Visible := True; panRotate3ds.Visible := True; //panPos3ds.Visible := True; panDesc.Visible := True; panName.Visible := True; LoadPropertiesForSingle3ds(TTreeNode(FPropObjects[0])); end // Multi 3ds objects else if ViewType = pvtMulti3ds then begin // Tolik 20/03/2017 -*- FPropObjects.Clear; FPropObjects.Assign(aObjects, laOr); // FPropObjects := aObjects; // SetAllPanels(False); panObjectTexture.Visible := True; panScale3ds.Visible := True; panRotate3ds.Visible := True; //panPos3ds.Visible := True; panDesc.Visible := True; LoadPropertiesForMulti3ds(FPropObjects); end // Single Connector else if ViewType = pvtSingleConn then begin // Tolik 20/03/2017 -*- FPropObjects.Clear; FPropObjects.Assign(aObjects,laOr); // FPropObjects := aObjects; // SetAllScsPanels(False); panScsObjectTexture.Visible := True; panScsScale.Visible := True; panScsRotate.Visible := True; panScsOffset.Visible := True; panScsConnCoords.Visible := True; panScsDesc.Visible := True; panScsName.Visible := True; LoadPropertiesForSingleConn(TTreeNode(FPropObjects[0])); end // Multi Connectors else if ViewType = pvtMultiConn then begin // Tolik 20/03/2017 -*- FPropObjects.Clear; FPropObjects.Assign(aObjects,laOr); // FPropObjects := aObjects; // SetAllScsPanels(False); panScsObjectTexture.Visible := True; panScsScale.Visible := True; panScsRotate.Visible := True; panScsOffset.Visible := True; panScsConnCoords.Visible := True; panScsDesc.Visible := True; LoadPropertiesForMultiConn(FPropObjects); end // Single Line else if ViewType = pvtSingleLine then begin // Tolik 20/03/2017 -*- FPropObjects.Clear; FPropObjects.Assign(aObjects,laOr); // FPropObjects := aObjects; // SetAllScsPanels(False); panScsLineCoords.Visible := True; panScsLength.Visible := True; panScsDesc.Visible := True; panScsName.Visible := True; LoadPropertiesForSingleLine(TTreeNode(FPropObjects[0])); end // Multi Lines else if ViewType = pvtMultiLine then begin // Tolik 20/03/2017 -*- FPropObjects.Clear; FPropObjects.Assign(aObjects,laOr); // FPropObjects := aObjects; // SetAllScsPanels(False); panScsLineCoords.Visible := True; panScsLength.Visible := True; panScsDesc.Visible := True; LoadPropertiesForMultiLine(FPropObjects); end; except on E: Exception do AddExceptionToLogEx('', E.Message); end; end; function Tfrm3D.CheckGLObjectInSelectionNodes(aObject: TGLBaseSceneObject; aNodes: TList): Boolean; var i, j: integer; xObj: TGLBaseSceneObject; xNode: TTreeNode; xSubNodes: TList; begin try Result := False; for i := 0 to aNodes.Count - 1 do begin xNode := TTreeNode(aNodes[i]); // если это грань, то проверить ее if (TObject(xNode.Data) is T3DSide) then begin if TTreeNode(aObject.TagObject) = xNode then begin Result := True; exit; end; end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.CheckGLObjectInSelectionNodes', E.Message); end; end; function Tfrm3D.GetAllSidesNodesByNodes(aNodes: TList): TList; var i, j: integer; xNode, hNode: TTreeNode; xNodes: TList; begin try Result := TList.Create; for i := 0 to aNodes.Count - 1 do begin xNode := TTreeNode(aNodes[i]); // Tolik 23/11/2018 -- (не делать мультиселект объектов для листов и модели) if ((TObject(TTreeNode(aNodes[0]).data).ClassName = 'TF_CAD') or (TObject(TTreeNode(aNodes[0]).data).ClassName = 'T3DModel')) then Continue; // if (TObject(xNode.Data) is T3DSide) and (T3DSide(xNode.Data).FSubSides.Count = 0) then begin Result.Add(xNode); end else if TObject(xNode.Data) is T3DSObject then begin Result.Add(xNode); end // Tolik 03/10/2018 else if TObject(xNode.Data) is T3DTube then begin Result.Add(xNode); end else if TObject(xNode.Data) is T3DConnector then begin Result.Add(xNode); end else if TObject(xNode.Data) is T3DLine then begin Result.Add(xNode); end else //**ROOF** if (TObject(xNode.Data) is T3DWall)and(IFFiguraIsRoof(T3dWall(xNode.Data).FSCSCompon)) then begin Result.Add(xNode); end else if (TObject(xNode.Data) is T3DCorner)and(IFFiguraIsRoof(T3DCorner(xNode.Data).FParent.FSCSCOmpon)) then begin Result.Add(xNode); end else //*\ROOF** begin xNodes := GetAllChildNodes(xNode); for j := 0 to xNodes.Count - 1 do Result.Add(xNodes[j]); end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.GetAllSidesNodesByNodes', E.Message); end; end; function Tfrm3D.GetAllChildNodes(ANode: TTreeNode): TList; procedure StepGetAllChildNodes(ACurrNode: TTreeNode); var CurrNode: TTreeNode; begin CurrNode := ACurrNode.getFirstChild; while CurrNode <> nil do begin if (TObject(CurrNode.Data) is T3DSide) then Result.Add(CurrNode); if (TObject(CurrNode.Data) is T3DSObject) then Result.Add(CurrNode); if (TObject(CurrNode.Data) is T3DConnector) then Result.Add(CurrNode); if (TObject(CurrNode.Data) is T3DLine) then Result.Add(CurrNode); if (TObject(CurrNode.Data) is T3DWall) then Result.Add(CurrNode); if (TObject(CurrNode.Data) is T3DCorner) then Result.Add(CurrNode); StepGetAllChildNodes(CurrNode); CurrNode := CurrNode.GetNextSibling; end; end; begin Result := TList.Create; StepGetAllChildNodes(ANode); end; procedure Tfrm3D.FormDestroy(Sender: TObject); begin ObjMatList.Free; // Tolik 02/10/2019 -- if FSelection <> nil then //FreeAndNil(FSelection); FSelection.free; if FPropObjects <> nil then //FreeAndNil(FPropObjects); FPropObjects.free; if FxObjects <> nil then //FreeAndNil(FxObjects); FxObjects.free; if FNodes <> nil then FNodes.Free; // Tolik 11/03/2017 -- FPropRecord.Free; FMovedObjectsList.Free; FShadowObjects.Free; FFilesStream.Free; FIdsStream.Free; FNodesObjectsList.free; FCutDataList.free; SetLength(FResizeData.BasisNodes, 0); FResizeData.free; glCursorObject.free; glCursorLine.free; // // Это нужно обязательно - иначе на некоторых дровах видео - выпадет // Context Activation Failed: C0070006 GLSceneViewer.Free; end; function Tfrm3D.GetPropViewType(aNodes: TList): TPropViewType; var i: integer; xNode: TTreeNode; HalpList: TList; begin try Result := pvtNone; {$IF Defined(ES_GRAPH_SC)} HalpList := tlist.Create; HalpList.Assign(aNodes); aNodes.Clear; for i := 0 to HalpList.count - 1 do begin xNode := TTreeNode(HalpList[i]); if (TObject(xNode.Data) is T3DSide) or (TObject(xNode.Data) is T3DSObject) or (TObject(xNode.Data) is T3DConnector) or (TObject(xNode.Data) is T3DLine) then aNodes.Add(xNode); end; FreeAndNil(HalpList); {$IFEND} if aNodes.Count > 0 then begin if aNodes.Count = 1 then begin // Tolik 10/12/2018 -- { if (TObject(TTreeNode(aNodes[0]).Data) is T3DSide) then Result := pvtSingleSide; if (TObject(TTreeNode(aNodes[0]).Data) is T3DSObject) then Result := pvtSingle3ds; if (TObject(TTreeNode(aNodes[0]).Data) is T3DLine) then Result := pvtSingleLine; if (TObject(TTreeNode(aNodes[0]).Data) is T3DConnector) then if T3DConnector(TTreeNode(aNodes[0]).Data).FConnType = ct_Full then Result := pvtSingleConn; } if (TObject(TTreeNode(aNodes[0]).Data) is T3DSide) then Result := pvtSingleSide else if (TObject(TTreeNode(aNodes[0]).Data) is T3DSObject) then Result := pvtSingle3ds else if (TObject(TTreeNode(aNodes[0]).Data) is T3DLine) then Result := pvtSingleLine else if (TObject(TTreeNode(aNodes[0]).Data).ClassName = 'T3DConnector') then begin if T3DConnector(TTreeNode(aNodes[0]).Data).FConnType = ct_Full then Result := pvtSingleConn end else if (TObject(TTreeNode(aNodes[0]).Data).ClassName = 'T3DComponent') then if (T3DComponent(TTreeNode(aNodes[0]).Data).F3dModelFileName <> '') then Result := pvtSingle3ds; end else begin for i := 0 to aNodes.count - 1 do begin xNode := TTreeNode(aNodes[i]); if not (TObject(xNode.Data) is T3DSide) and not (TObject(xNode.Data) is T3DSObject) and not (TObject(xNode.Data) is T3DConnector) and not (TObject(xNode.Data) is T3DLine) then exit; if (TObject(xNode.Data) is T3DSide) then begin if (Result <> pvtNone) and (Result <> pvtMultiSides) then begin Result := pvtNone; exit; end; Result := pvtMultiSides; end; if (TObject(xNode.Data) is T3DSObject) then begin if (Result <> pvtNone) and (Result <> pvtMulti3ds) then begin Result := pvtNone; exit; end; Result := pvtMulti3ds; end; if (TObject(xNode.Data) is T3DLine) then begin if (Result <> pvtNone) and (Result <> pvtMultiLine) then begin Result := pvtNone; exit; end; Result := pvtMultiLine; end; if (TObject(xNode.Data) is T3DConnector) then begin if (Result <> pvtNone) and (Result <> pvtMultiConn) then begin Result := pvtNone; exit; end; if T3DConnector(xNode.Data).FConnType = ct_Empty then begin Result := pvtNone; exit; end; Result := pvtMultiConn; end; end; end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.GetPropViewType', E.Message); end; end; function Tfrm3D.LoadPropertiesForMultiObjects(aObjects: TList): TPropRecord; var i: integer; xObject: T3DSide; xGLObject: TGLBaseSceneObject; Points: T3DPointArray; Cnt: Integer; xRotate, xScale: Integer; xMirror: Boolean; xCnt: Integer; CoordsInfo: string; begin try mDesc.Clear; cbCoordNbr.Properties.Items.Clear; for i := 0 to aObjects.Count - 1 do begin {$IF Defined(ES_GRAPH_SC)} if TObject(TTreeNode(aObjects[i]).Data) is T3DSide then {$IFEND} begin xObject := T3DSide(TTreeNode(aObjects[i]).Data); xGLObject := TGLBaseSceneObject(xObject.FGLObject); if i = 0 then begin xRotate := xObject.FTextureRotate; xScale := xObject.FTextureScale; xMirror := xObject.FMirror; edTextureRotate.Text := IntToStr(xObject.FTextureRotate); edTextureScale.Text := IntToStr(xObject.FTextureScale); cbMirror.Checked := xObject.FMirror; xCnt := Length(xObject.FGLPoints); end else begin if edTextureRotate.Text <> '' then if xRotate <> xObject.FTextureRotate then edTextureRotate.Text := ''; if edTextureScale.Text <> '' then if xScale <> xObject.FTextureScale then edTextureScale.Text := ''; if cbMirror.AllowGrayed = False then if xMirror <> xObject.FMirror then cbMirror.AllowGrayed := True; if xCnt <> - 1 then if xCnt <> Length(xObject.FGLPoints) then xCnt := -1; end; end; end; if xCnt > 0 then begin //panCoords.Enabled := True; for i := 0 to xCnt - 1 do begin CoordsInfo := '';{' (' + FloatToStr(xObject.FGLPoints[i].x) + '; ' + FloatToStr(xObject.FGLPoints[i].y) + '; ' + FloatToStr(xObject.FGLPoints[i].z) + ')';} cbCoordNbr.Properties.Items.Add(InttoStr(i + 1) + CoordsInfo); end; cbCoordNbr.Text := cbCoordNbr.Properties.Items[0]; edCoordX.Text := ''; edCoordY.Text := ''; edCoordZ.Text := ''; end else begin //panCoords.Enabled := False; end; imgSideTexture.Clear; cbSideHashs.Properties.Items.Clear; for i := 0 to F3DModel.FHashs.Count - 1 do begin cbSideHashs.Properties.Items.Add(F3DModel.FHashs.Strings[i]); end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.LoadPropertiesForMultiObjects', E.Message); end; end; function Tfrm3D.LoadPropertiesForSingleObject(aObject: TTreeNode): TPropRecord; var i: integer; xObject: T3DSide; xGLObject: TGLBaseSceneObject; Points: T3DPointArray; Cnt: Integer; CoordsInfo: string; tmpdir, tmpfname: string; begin try xObject := T3DSide(aObject.Data); xGLObject := TGLBaseSceneObject(xObject.FGLObject); edName.Text := xObject.FName; mDesc.Clear; for i := 0 to xObject.FDescription.Count - 1 do mDesc.Lines.Add(xObject.FDescription[i]); if Pos('empty', AnsiLowerCase(mDesc.Lines.Text)) = 1 then begin if xGLObject <> nil then begin xGLObject.Visible := False; if xObject.FAsArc and (AnsiLowerCase(xObject.ClassName) <> 't3dsobject') then RotateTextureToAngleP(xObject, TGLPolygon(xGLObject), xObject.FTextureRotate, xObject.FMirror); end; btnEmpty.GroupIndex := 1; btnEmpty.Down := True; if aObject.ImageIndex < 999 then begin aObject.ImageIndex := aObject.ImageIndex + 1000; aobject.SelectedIndex := aObject.ImageIndex; end; end else begin btnEmpty.GroupIndex := 0; btnEmpty.Down := False; if xGLObject <> nil then begin xGLObject.Visible := True; if xObject.FAsArc and (AnsiLowerCase(xObject.ClassName) <> 't3dsobject') then RotateTextureToAngleP(xObject, TGLPolygon(xGLObject), xObject.FTextureRotate, xObject.FMirror); end; if aObject.ImageIndex > 999 then begin aObject.ImageIndex := aObject.ImageIndex - 1000; aobject.SelectedIndex := aObject.ImageIndex; end; end; edTextureRotate.Text := IntToStr(xObject.FTextureRotate); edTextureScale.Text := IntToStr(xObject.FTextureScale); cbMirror.Checked := xObject.FMirror; cbCoordNbr.Properties.Items.Clear; Cnt := Length(xObject.FGLPoints); for i := 0 to Cnt - 1 do begin CoordsInfo := '';{' (' + FloatToStr(xObject.FGLPoints[i].x) + '; ' + FloatToStr(xObject.FGLPoints[i].y) + '; ' + FloatToStr(xObject.FGLPoints[i].z) + ')';} cbCoordNbr.Properties.Items.Add(InttoStr(i + 1) + CoordsInfo); end; cbCoordNbr.Text := cbCoordNbr.Properties.Items[0]; edCoordX.Text := FloatToStr(xObject.FGLPoints[0].x); edCoordY.Text := FloatToStr(xObject.FGLPoints[0].y); edCoordZ.Text := FloatToStr(xObject.FGLPoints[0].z); imgSideTexture.Clear; tmpfname := GetImageFileByHash(xObject.FTextureHash); if tmpfname <> '' then imgSideTexture.Picture.LoadFromFile(tmpfname); cbSideHashs.Properties.Items.Clear; for i := 0 to F3DModel.FHashs.Count - 1 do begin cbSideHashs.Properties.Items.Add(F3DModel.FHashs.Strings[i]); end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.LoadPropertiesForSingleObject', E.Message); end; end; function Tfrm3D.LoadPropertiesForSingle3ds(aObject: TTreeNode): TPropRecord; var i: integer; xObject: T3DSObject; xGLObject: TGLBaseSceneObject; tmpdir, tmpfname: string; ComponObject: TGLFreeForm; Compon: T3DComponent; xConn: T3DConnector; begin try // Tolik 10/12/2018 -- if TObject(aObject.Data).ClassName = 'T3DSObject' then begin // xObject := T3DSObject(aObject.Data); xGLObject := TGLBaseSceneObject(xObject.FGLObject); edName.Text := xObject.FName; mDesc.Clear; for i := 0 to xObject.FDescription.Count - 1 do mDesc.Lines.Add(xObject.FDescription[i]); edPosX.Text := FloatToStr(xObject.FPosition.x); edPosY.Text := FloatToStr(xObject.FPosition.y); edPosZ.Text := FloatToStr(xObject.FPosition.z); edAngleX.Text := FloatToStr(xObject.FRotate.x); edAngleY.Text := FloatToStr(xObject.FRotate.y); edAngleZ.Text := FloatToStr(xObject.FRotate.z); edScaleX.Text := FloatToStr(xObject.FScale.x); edScaleY.Text := FloatToStr(xObject.FScale.y); edScaleZ.Text := FloatToStr(xObject.FScale.z); imgObjectTexture.Clear; tmpfname := GetImageFileByHash(xObject.FTextureHash); if tmpfname <> '' then imgObjectTexture.Picture.LoadFromFile(tmpfname); cbObjectHashs.Properties.Items.Clear; for i := 0 to F3DModel.FHashs.Count - 1 do begin cbObjectHashs.Properties.Items.Add(F3DModel.FHashs.Strings[i]); end; end // Tolik 10/12/2018 -- else if TObject(aObject.Data).ClassName = 'T3DComponent' then begin if T3DComponent(aObject.Data).FGLObject.ClassName = 'TGLFreeForm' then begin Compon := T3DComponent(aObject.Data); ComponObject := TGLFreeForm(Compon.FGLObject); edName.Text := aObject.Text;//xObject.FName; edSCSName.Text := aObject.Text;//xObject.FName; mDesc.Clear; { for i := 0 to xObject.FDescription.Count - 1 do mDesc.Lines.Add(xObject.FDescription[i]);} edPosX.Text := FloatToStr(ComponObject.Position.x); edPosY.Text := FloatToStr(ComponObject.Position.y); edPosZ.Text := FloatToStr(ComponObject.Position.z); edAngleX.Text := FloatToStr(ComponObject.Rotation.x); edAngleY.Text := FloatToStr(ComponObject.Rotation.y); edAngleZ.Text := FloatToStr(ComponObject.Rotation.z); edScaleX.Text := FloatToStr(ComponObject.Scale.x); edScaleY.Text := FloatToStr(ComponObject.Scale.y); edScaleZ.Text := FloatToStr(ComponObject.Scale.z); edSCSScaleX.Text := FloatToStr(ComponObject.Scale.x); edSCSScaleY.Text := FloatToStr(ComponObject.Scale.y); edSCSScaleZ.Text := FloatToStr(ComponObject.Scale.z); edSCSAngleX.Text := FloatToStr(Compon.FRotate.x); edSCSAngleY.Text := FloatToStr(Compon.FRotate.y); edSCSAngleZ.Text := FloatToStr(Compon.FRotate.z); { edSCSAngleX.Text := FloatToStr(ComponObject.Rotation.x); edSCSAngleY.Text := FloatToStr(ComponObject.Rotation.y); edSCSAngleZ.Text := FloatToStr(ComponObject.Rotation.z); } // edSCSConnX.Text := FloatToStr(ComponObject.Position.x); edSCSConnX.Text := FloatToStr(ComponObject.Position.x); edSCSConnY.Text := FloatToStr(ComponObject.Position.y); edSCSConnZ.Text := FloatToStr(ComponObject.Position.z); {imgObjectTexture.Clear; tmpfname := GetImageFileByHash(xObject.FTextureHash); if tmpfname <> '' then imgObjectTexture.Picture.LoadFromFile(tmpfname); cbObjectHashs.Properties.Items.Clear; for i := 0 to F3DModel.FHashs.Count - 1 do begin cbObjectHashs.Properties.Items.Add(F3DModel.FHashs.Strings[i]); end;} end; end else if TObject(aObject.Data).ClassName = 'T3DConnector' then begin xConn := T3DConnector(aObject.Data); edSCSAngleX.Text := FloatToStr(xConn.FRotate.x); edSCSAngleY.Text := FloatToStr(xConn.FRotate.y); edSCSAngleZ.Text := FloatToStr(xConn.FRotate.z); edAngleX.Text := FloatToStr(xConn.FRotate.x); edAngleY.Text := FloatToStr(xConn.FRotate.y); edAngleZ.Text := FloatToStr(xConn.FRotate.z); if T3DConnector(aObject.Data).FGLObject.ClassName = 'TGLFreeForm' then begin ComponObject := TGLFreeForm(Compon.FGLObject); edName.Text := aObject.Text;//xObject.FName; edSCSName.Text := aObject.Text;//xObject.FName; mDesc.Clear; for i := 0 to xConn.FDescription.Count - 1 do mDesc.Lines.Add(xConn.FDescription[i]); edPosX.Text := FloatToStr(ComponObject.Position.x); edPosY.Text := FloatToStr(ComponObject.Position.y); edPosZ.Text := FloatToStr(ComponObject.Position.z); edScaleX.Text := FloatToStr(ComponObject.Scale.x); edScaleY.Text := FloatToStr(ComponObject.Scale.y); edScaleZ.Text := FloatToStr(ComponObject.Scale.z); edSCSScaleX.Text := FloatToStr(ComponObject.Scale.x); edSCSScaleY.Text := FloatToStr(ComponObject.Scale.y); edSCSScaleZ.Text := FloatToStr(ComponObject.Scale.z); edSCSConnX.Text := FloatToStr(ComponObject.Position.x); edSCSConnY.Text := FloatToStr(ComponObject.Position.y); edSCSConnZ.Text := FloatToStr(ComponObject.Position.z); end else begin xGLObject := TGLBaseSceneObject(xConn.FGLObject); edName.Text := xConn.FName; mDesc.Clear; for i := 0 to xConn.FDescription.Count - 1 do mDesc.Lines.Add(xConn.FDescription[i]); edPosX.Text := FloatToStr(xGLObject.Position.x); edPosY.Text := FloatToStr(xGLObject.Position.y); edPosZ.Text := FloatToStr(xGLObject.Position.z); edScaleX.Text := FloatToStr(xGLObject.Scale.x); edScaleY.Text := FloatToStr(xGLObject.Scale.y); edScaleZ.Text := FloatToStr(xGLObject.Scale.z); {cbObjectHashs.Properties.Items.Clear; for i := 0 to F3DModel.FHashs.Count - 1 do begin cbObjectHashs.Properties.Items.Add(F3DModel.FHashs.Strings[i]); end;} end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.LoadPropertiesForSingle3ds', E.Message); end; end; function Tfrm3D.LoadPropertiesForMulti3ds(aObjects: TList): TPropRecord; var i: integer; xObject: T3DSObject; xGLObject: TGLBaseSceneObject; Points: T3DPointArray; Cnt: Integer; xPosX, xPosY, xPosZ, xAngleX, xAngleY, xAngleZ, xScaleX, xScaleY, xScaleZ: Double; begin try mDesc.Clear; for i := 0 to aObjects.Count - 1 do begin xObject := T3DSObject(TTreeNode(aObjects[i]).Data); xGLObject := TGLBaseSceneObject(xObject.FGLObject); if i = 0 then begin xPosX := xObject.FPosition.x; edPosX.Text := FloatToStr(xPosX); xPosY := xObject.FPosition.y; edPosY.Text := FloatToStr(xPosY); xPosZ := xObject.FPosition.z; edPosZ.Text := FloatToStr(xPosZ); xAngleX := xObject.FRotate.x; edAngleX.Text := FloatToStr(xAngleX); xAngleY := xObject.FRotate.y; edAngleY.Text := FloatToStr(xAngleY); xAngleZ := xObject.FRotate.z; edAngleZ.Text := FloatToStr(xAngleZ); xScaleX := xObject.FScale.x; edScaleX.Text := FloatToStr(xScaleX); xScaleY := xObject.FScale.y; edScaleY.Text := FloatToStr(xScaleY); xScaleZ := xObject.FScale.z; edScaleZ.Text := FloatToStr(xScaleZ); end else begin if edPosX.Text <> '' then if xPosX <> xObject.FPosition.x then edPosX.Text := ''; if edPosY.Text <> '' then if xPosY <> xObject.FPosition.y then edPosY.Text := ''; if edPosZ.Text <> '' then if xPosZ <> xObject.FPosition.z then edPosZ.Text := ''; if edAngleX.Text <> '' then if xAngleX <> xObject.FRotate.x then edAngleX.Text := ''; if edAngleY.Text <> '' then if xAngleY <> xObject.FRotate.y then edAngleY.Text := ''; if edAngleZ.Text <> '' then if xAngleZ <> xObject.FRotate.z then edAngleZ.Text := ''; if edScaleX.Text <> '' then if xScaleX <> xObject.FScale.x then edScaleX.Text := ''; if edScaleY.Text <> '' then if xScaleY <> xObject.FScale.y then edScaleY.Text := ''; if edScaleZ.Text <> '' then if xScaleZ <> xObject.FScale.z then edScaleZ.Text := ''; end; end; imgObjectTexture.Clear; cbObjectHashs.Properties.Items.Clear; for i := 0 to F3DModel.FHashs.Count - 1 do begin cbObjectHashs.Properties.Items.Add(F3DModel.FHashs.Strings[i]); end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.LoadPropertiesForMulti3ds', E.Message); end; end; procedure Tfrm3D.cbCoordNbrCloseUp(Sender: TObject); var Index: Integer; xObject: T3DSide; begin try Index := cbCoordNbr.ItemIndex; if FPropObjects.Count > 0 then begin if FPropObjects.Count = 1 then begin xObject := T3DSide(TTreeNode(FPropObjects[0]).Data); edCoordX.Text := FloatToStr(xObject.FGLPoints[Index].x); edCoordY.Text := FloatToStr(xObject.FGLPoints[Index].y); edCoordZ.Text := FloatToStr(xObject.FGLPoints[Index].z); end else begin edCoordX.Text := ''; edCoordY.Text := ''; edCoordZ.Text := ''; end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.cbCoordNbrCloseUp', E.Message); end; end; { TPropRecord } constructor TPropRecord.Create; begin inherited Create; fCoords := TList.Create; fDesc := TStringList.Create; end; // Tolik -- 11/03/2017 -- destructor TPropRecord.destroy; begin fCoords.Free; fDesc.Free; inherited destroy; end; //-- procedure Tfrm3D.bSideTextureChangeClick(Sender: TObject); var i: integer; FName: string; xObject: T3DSide; xGLObject: TGLBaseSceneObject; tmpdir, tmpfname, ExtStr, BmpFName: string; Bmp: TBitmap; Jpeg: TJPEGImage; HashStr: string; begin try FName := LoadTexture; if (FName <> '') and FileExists(FName) then begin imgSideTexture.Picture.LoadFromFile(FName); ExtStr := ExtractFileExt(FName); tmpdir := GetWorkDir; //ExtractDirByCategoryType(dctPictures); // получаем HASH по загружаемому файлу HashStr := GetImageHash(FName); // по HASH ищем есть ли он в нашей базе tmpfname := GetImageFileByHash(HashStr); // если найден, то грузим его if tmpfname <> '' then begin end else // не найден - создаем для файла HASH, копируем в темп, грузим begin F3DModel.FHashs.Add(HashStr); tmpfname := tmpdir + '\' + HashStr + '.bmp'; if (ExtStr = '.jpg') or (ExtStr = '.jpeg') then begin Bmp := TBitmap.Create; Jpeg := TJPEGImage.Create; jpeg.CompressionQuality := 100; {Default Value} Jpeg.LoadFromFile(FName); Bmp.Assign(Jpeg); Bmp.SaveTofile(tmpfname); FreeAndNil(Bmp); FreeAndNil(Jpeg); end else CopyFile(PChar(FName), PChar(tmpfname), True); end; for i := 0 to FPropObjects.Count - 1 do begin if TObject(TTreeNode(FPropObjects[i]).Data) is T3DSide then begin xObject := T3DSide(TTreeNode(FPropObjects[i]).Data); xGLObject := TGLBaseSceneObject(xObject.FGLObject); xObject.FTextureHash := HashStr; xObject.FTexture_ext := ExtStr; if (xGLObject is TGLPolygon) then begin TGLPolygon(xGLObject).Material.Texture.Disabled := False; TGLPolygon(xGLObject).Material.Texture.DestroyHandles; try TGLPolygon(xGLObject).Material.Texture.Image.LoadFromFile(tmpfname); except ShowMessage('File not found ' + tmpfname); end; RotateTextureToAngleP(xObject, TGLPolygon(xGLObject), xObject.FTextureRotate, xObject.FMirror); end; end; end; // Resfresh HASHs cbSideHashs.Properties.Items.Clear; for i := 0 to F3DModel.FHashs.Count - 1 do begin cbSideHashs.Properties.Items.Add(F3DModel.FHashs.Strings[i]); end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.bTextureChangeClick', E.Message); end; end; function Tfrm3D.LoadTexture: string; begin try Result := ''; OpenTexture.InitialDir := ExeDir + '\3DTextures'; NoMoveEvent := True; if OpenTexture.Execute then begin Result := OpenTexture.FileName; end; except on E: Exception do AddExceptionToLogEx('', E.Message); end; end; procedure Tfrm3D.edNameExit(Sender: TObject); begin ChangeName; end; procedure Tfrm3D.bSideTextureClearClick(Sender: TObject); var FName: string; i: integer; xObject: T3DSide; xGLObject: TGLBaseSceneObject; tmpdir, tmpfname, ExtStr, BmpFName: string; Bmp: TBitmap; Jpeg: TJPEGImage; begin try for i := 0 to FPropObjects.Count - 1 do begin if TOBject(TTreeNode(FPropObjects[i]).Data) is T3DSide then begin xObject := T3DSide(TTreeNode(FPropObjects[i]).Data); xGLObject := TGLBaseSceneObject(xObject.FGLObject); xObject.FTextureHash := ''; xObject.FTexture_ext := ''; if (xGLObject is TGLPolygon) then begin imgSideTexture.Clear; TGLPolygon(xGLObject).Material.Texture.Disabled := True; end; end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.bTextureClearClick', E.Message); end; end; procedure Tfrm3D.cbMirrorClick(Sender: TObject); var i: integer; xObject: T3DSide; xGLObject: TGLBaseSceneObject; begin try for i := 0 to FPropObjects.Count - 1 do begin if TObject(TTreeNode(FPropObjects[i]).Data) is T3DSide then begin xObject := T3DSide(TTreeNode(FPropObjects[i]).Data); xGLObject := TGLBaseSceneObject(xObject.FGLObject); xObject.FMirror := cbMirror.Checked; if (xGLObject is TGLPolygon) then RotateTextureToAngleP(xObject, TGLPolygon(xGLObject), xObject.FTextureRotate, xObject.FMirror); end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.cbMirrorClick', E.Message); end; end; procedure Tfrm3D.mDescEnter(Sender: TObject); begin ChangeDesc; end; procedure Tfrm3D.mDescExit(Sender: TObject); begin ChangeDesc; end; procedure Tfrm3D.edNameKeyPress(Sender: TObject; var Key: Char); begin if Key = #13 then ChangeName; end; procedure Tfrm3D.mDescKeyPress(Sender: TObject; var Key: Char); begin if Key = #13 then ChangeDesc; end; procedure Tfrm3D.edCoordXKeyPress(Sender: TObject; var Key: Char); begin if Key = #13 then ChangeCoordX; end; procedure Tfrm3D.edCoordXExit(Sender: TObject); begin ChangeCoordX; end; procedure Tfrm3D.edCoordYExit(Sender: TObject); begin ChangeCoordY; end; procedure Tfrm3D.edCoordYKeyPress(Sender: TObject; var Key: Char); begin if Key = #13 then ChangeCoordY; end; procedure Tfrm3D.edCoordZKeyPress(Sender: TObject; var Key: Char); begin if Key = #13 then ChangeCoordZ; end; procedure Tfrm3D.edCoordZExit(Sender: TObject); begin ChangeCoordZ; end; procedure Tfrm3D.edTextureRotateExit(Sender: TObject); begin ChangeTextureRotate; end; procedure Tfrm3D.edTextureRotateKeyPress(Sender: TObject; var Key: Char); begin if Key = #13 then ChangeTextureRotate; end; {$IF Defined(ES_GRAPH_SC)} Procedure Tfrm3D.ChangeAllFiguresWithPoint(aPoint:T3DPoint; Coord: TCoord); //Процедура перерисовки всех точек,как aPoint var j,k: integer; xNode: TtreeNode; GLPoint: T3DPoint; GlNode: TGLNodes; GlLineNode: TGLLinesNodes; xGLObject: TGLBaseSceneObject; xSide: T3dSide; xLine: T3DWall; xCorner: T3dCorner; begin /////////////////////////// ROOF ///////////////////////////// for j := 0 to DummyCube.Count - 1 do begin xLine := nil; xCorner := nil; if DummyCube.Children[j] is TGLPolygon then begin GlNode := TGLPolygon(DummyCube.Children[j]).Nodes; for k := 0 to GlNode.Count - 1 do begin GLPoint := DoublePoint(GlNode[k].X,GlNode[k].y,GlNode[k].z); if EQDPZ(GLPoint,aPoint) then begin if TOBject(TTreeNode(TGLPolygon(DummyCube.Children[j]).TagObject).Data) is T3DSide then begin xSide := T3DSide(TTreeNode(TGLPolygon(DummyCube.Children[j]).TagObject).Data); xGLObject := TGLBaseSceneObject(xSide.FGLObject); end; case Coord of cX: begin GlNode[k].X := StrToFloat_My(edCoordX.Text); xSide.FGLPoints[k].x := StrToFloat_My(edCoordX.Text); xSide.FPoints[k].x := StrToFloat_My(edCoordX.Text) / Factor; end; cY: begin GlNode[k].Y := StrToFloat_My(edCoordY.Text); xSide.FGLPoints[k].Y := StrToFloat_My(edCoordY.Text); xSide.FPoints[k].Y := StrToFloat_My(edCoordY.Text) / Factor; end; cZ: begin GlNode[k].Z := StrToFloat_My(edCoordZ.Text); xSide.FGLPoints[k].Z := StrToFloat_My(edCoordZ.Text); xSide.FPoints[k].Z := StrToFloat_My(edCoordZ.Text) / Factor; end; end; break; end; end; end; if DummyCube.Children[j] is TGLLines then begin GlLineNode := TGLLines(DummyCube.Children[j]).Nodes; for k := 0 to GlLineNode.Count - 1 do begin GLPoint := DoublePoint(GlLineNode[k].X,GlLineNode[k].Y,GlLineNode[k].Z); if EQDPZ(GLPoint,aPoint) then begin if TOBject(TTreeNode(TGLPolygon(DummyCube.Children[j]).TagObject).Data) is T3DWall then begin xLine := T3DWall(TTreeNode(TGLPolygon(DummyCube.Children[j]).TagObject).Data); xGLObject := TGLBaseSceneObject(xLine.FGLObject); end; if TOBject(TTreeNode(TGLPolygon(DummyCube.Children[j]).TagObject).Data) is T3DCorner then begin xCorner := T3DCorner(TTreeNode(TGLPolygon(DummyCube.Children[j]).TagObject).Data); xGLObject := TGLBaseSceneObject(xCorner.FGLObject); end; case Coord of cX: begin if xLine <> nil then begin xLine.FGLPOints[k].x := StrToFloat_My(edCoordX.Text); xLine.FPoints[k].x := StrToFloat_My(edCoordX.Text) / Factor; end; if xCorner <> nil then begin xCorner.FGLPOints[k].x := StrToFloat_My(edCoordX.Text); xCorner.FPoints.x := StrToFloat_My(edCoordX.Text) / Factor; end; GlLineNode[k].X := StrToFloat_My(edCoordX.Text); if TObject(TTreenode(TGLLines(DummyCube.Children[j]).TagObject).Data) is T3dCorner then GlLineNode[k+1].X := StrToFloat_My(edCoordX.Text); end; cY: begin if xLine <> nil then begin xLine.FGLPOints[k].y := StrToFloat_My(edCoordy.Text); xLine.FPoints[k].y := StrToFloat_My(edCoordy.Text) / Factor; end; if xCorner <> nil then begin xCorner.FGLPOints[k].y := StrToFloat_My(edCoordY.Text); xCorner.FPoints.y := StrToFloat_My(edCoordY.Text) / Factor; end; GlLineNode[k].Y := StrToFloat_My(edCoordY.Text); if TObject(TTreenode(TGLLines(DummyCube.Children[j]).TagObject).Data) is T3dCorner then begin GlLineNode[k+1].Y := GlLineNode[k].Y + (1 * Factor + FDeltaZ); end; end; cZ: begin if xLine <> nil then begin xLine.FGLPOints[k].z := StrToFloat_My(edCoordz.Text); xLine.FPoints[k].z := StrToFloat_My(edCoordz.Text) / Factor; end; if xCorner <> nil then begin xCorner.FGLPOints[k].z := StrToFloat_My(edCoordZ.Text); xCorner.FPoints.z := StrToFloat_My(edCoordZ.Text) / Factor; end; GlLineNode[k].Z := StrToFloat_My(edCoordZ.Text); if TObject(TTreenode(TGLLines(DummyCube.Children[j]).TagObject).Data) is T3dCorner then begin GlLineNode[k+1].Z := StrToFloat_My(edCoordZ.Text); end; end; end; break; end; end; end; end; ////////////////////////// \ROOF ///////////////////////////// end; {$IFEND} procedure Tfrm3D.ChangeCoordX; var i,j,k: integer; xObject: T3DSide; xGLObject: TGLBaseSceneObject; Index: Integer; p: TVector3f; Point3D: T3DPoint; begin try if edCoordX.Text = '' then exit; Index := cbCoordNbr.ItemIndex; for i := 0 to FPropObjects.Count - 1 do begin {$IF Defined(ES_GRAPH_SC)} if TOBject(TTreeNode(FPropObjects[i]).Data) is T3DSide then begin xObject := T3DSide(TTreeNode(FPropObjects[i]).Data); xGLObject := TGLBaseSceneObject(xObject.FGLObject); Point3D := xObject.FGLPoints[Index]; xObject.FGLPoints[Index].x := StrToFloat_My(edCoordX.Text); xObject.FPoints[Index].x := StrToFloat_My(edCoordX.Text) / Factor; if (xGLObject is TGLPolygon) then begin TGLPolygon(xGLObject).Nodes[Index].X := StrToFloat_My(edCoordX.Text); end; ChangeAllFiguresWithPoint(Point3D, cX); end; {$ELSE} xObject := T3DSide(TTreeNode(FPropObjects[i]).Data); xGLObject := TGLBaseSceneObject(xObject.FGLObject); xObject.FGLPoints[Index].x := StrToFloat_My(edCoordX.Text); xObject.FPoints[Index].x := StrToFloat_My(edCoordX.Text) / Factor; if (xGLObject is TGLPolygon) then begin TGLPolygon(xGLObject).Nodes[Index].X := StrToFloat_My(edCoordX.Text); end; {$IFEND} end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.ChangeCoordX', E.Message); end; end; procedure Tfrm3D.ChangeCoordY; var i: integer; xObject: T3DSide; xGLObject: TGLBaseSceneObject; Index: Integer; p: TVector3f; Point3D: T3DPoint; begin try if edCoordY.Text = '' then exit; Index := cbCoordNbr.ItemIndex; for i := 0 to FPropObjects.Count - 1 do begin {$IF Defined(ES_GRAPH_SC)} if TOBject(TTreeNode(FPropObjects[i]).Data) is T3DSide then begin xObject := T3DSide(TTreeNode(FPropObjects[i]).Data); xGLObject := TGLBaseSceneObject(xObject.FGLObject); Point3D := xObject.FGLPoints[Index]; xObject.FGLPoints[Index].y := StrToFloat_My(edCoordY.Text); xObject.FPoints[Index].z := StrToFloat_My(edCoordY.Text) / Factor; if (xGLObject is TGLPolygon) then begin TGLPolygon(xGLObject).Nodes[Index].Y := StrToFloat_My(edCoordY.Text); end; ChangeAllFiguresWithPoint(Point3D, cY); end; {$ELSE} xObject := T3DSide(TTreeNode(FPropObjects[i]).Data); xGLObject := TGLBaseSceneObject(xObject.FGLObject); xObject.FGLPoints[Index].y := StrToFloat_My(edCoordY.Text); xObject.FPoints[Index].z := StrToFloat_My(edCoordY.Text) / Factor; if (xGLObject is TGLPolygon) then begin TGLPolygon(xGLObject).Nodes[Index].Y := StrToFloat_My(edCoordY.Text); end; {$IFEND} end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.ChangeCoordY', E.Message); end; end; procedure Tfrm3D.ChangeCoordZ; var i: integer; xObject: T3DSide; xGLObject: TGLBaseSceneObject; Index: Integer; p: TVector3f; Point3D: T3DPoint; begin try if edCoordZ.Text = '' then exit; Index := cbCoordNbr.ItemIndex; for i := 0 to FPropObjects.Count - 1 do begin {$IF Defined(ES_GRAPH_SC)} if TOBject(TTreeNode(FPropObjects[i]).Data) is T3DSide then begin xObject := T3DSide(TTreeNode(FPropObjects[i]).Data); xGLObject := TGLBaseSceneObject(xObject.FGLObject); Point3D := xObject.FGLPoints[Index]; xObject.FGLPoints[Index].z := StrToFloat_My(edCoordZ.Text); xObject.FPoints[Index].y := StrToFloat_My(edCoordZ.Text) / Factor; if (xGLObject is TGLPolygon) then begin TGLPolygon(xGLObject).Nodes[Index].Z := StrToFloat_My(edCoordZ.Text); end; ChangeAllFiguresWithPoint(Point3D, cZ); end; {$ELSE} xObject := T3DSide(TTreeNode(FPropObjects[i]).Data); xGLObject := TGLBaseSceneObject(xObject.FGLObject); xObject.FGLPoints[Index].z := StrToFloat_My(edCoordZ.Text); xObject.FPoints[Index].y := StrToFloat_My(edCoordZ.Text) / Factor; if (xGLObject is TGLPolygon) then begin TGLPolygon(xGLObject).Nodes[Index].Z := StrToFloat_My(edCoordZ.Text); end; {$IFEND} end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.ChangeCoordZ', E.Message); end; end; procedure Tfrm3D.ChangeDesc; var i, j: integer; xObject: TObject; xSide: T3DSide; x3DSObject: T3DSObject; xConn: T3DConnector; xLine: T3DLine; xGLObject, xGLObject1: TGLBaseSceneObject; begin try for i := 0 to FPropObjects.Count - 1 do begin xObject := TObject(TTreeNode(FPropObjects[i]).Data); if xObject is T3DSide then begin xSide := T3DSide(xObject); xGLObject := TGLBaseSceneObject(xSide.FGLObject); xSide.FDescription.Clear; for j := 0 to mDesc.Lines.Count - 1 do xSide.FDescription.Add(mDesc.Lines[j]); if Pos('empty', AnsiLowerCase(mDesc.Lines.Text)) = 1 then begin if xGLObject <> nil then begin xGLObject.Visible := False; if xSide.FAsArc then RotateTextureToAngleP(xSide, TGLPolygon(xGLObject), xSide.FTextureRotate, xSide.FMirror); end; btnEmpty.GroupIndex := 1; btnEmpty.Down := True; if TTreeNode(FPropObjects[i]).ImageIndex < 999 then begin TTreeNode(FPropObjects[i]).ImageIndex := TTreeNode(FPropObjects[i]).ImageIndex + 1000; TTreeNode(FPropObjects[i]).SelectedIndex := TTreeNode(FPropObjects[i]).ImageIndex; end; end else begin btnEmpty.GroupIndex := 0; btnEmpty.Down := False; if xGLObject <> nil then begin xGLObject.Visible := True; if xSide.FAsArc then RotateTextureToAngleP(xSide, TGLPolygon(xGLObject), xSide.FTextureRotate, xSide.FMirror); end; if TTreeNode(FPropObjects[i]).ImageIndex > 999 then begin TTreeNode(FPropObjects[i]).ImageIndex := TTreeNode(FPropObjects[i]).ImageIndex - 1000; TTreeNode(FPropObjects[i]).SelectedIndex := TTreeNode(FPropObjects[i]).ImageIndex; end; end; end; if xObject is T3DSObject then begin x3DSObject := T3DSObject(xObject); xGLObject := TGLBaseSceneObject(x3DSObject.FGLObject); x3DSObject.FDescription.Clear; for j := 0 to mDesc.Lines.Count - 1 do x3DSObject.FDescription.Add(mDesc.Lines[j]); if Pos('empty', AnsiLowerCase(mDesc.Lines.Text)) = 1 then begin if xGLObject <> nil then xGLObject.Visible := False; btnEmpty.GroupIndex := 1; btnEmpty.Down := True; end else begin btnEmpty.GroupIndex := 0; btnEmpty.Down := False; if xGLObject <> nil then xGLObject.Visible := True; end; end; if xObject is T3DConnector then begin xConn := T3DConnector(xObject); xGLObject := TGLBaseSceneObject(xConn.FGLObject); xGLObject1 := TGLBaseSceneObject(xConn.FGLObject1); xConn.FDescription.Clear; for j := 0 to mScsDesc.Lines.Count - 1 do xConn.FDescription.Add(mScsDesc.Lines[j]); if Pos('empty', AnsiLowerCase(mScsDesc.Lines.Text)) = 1 then begin if xGLObject <> nil then xGLObject.Visible := False; btnEmpty.GroupIndex := 1; btnEmpty.Down := True; end else begin btnEmpty.GroupIndex := 0; btnEmpty.Down := False; if xGLObject <> nil then xGLObject.Visible := True; end; end; if xObject is T3DLine then begin xLine := T3DLine(xObject); xGLObject := TGLBaseSceneObject(xLine.FGLObject); xLine.FDescription.Clear; for j := 0 to mScsDesc.Lines.Count - 1 do xLine.FDescription.Add(mScsDesc.Lines[j]); if Pos('empty', AnsiLowerCase(mScsDesc.Lines.Text)) = 1 then begin if xGLObject <> nil then xGLObject.Visible := False; btnEmpty.GroupIndex := 1; btnEmpty.Down := True; end else begin btnEmpty.GroupIndex := 0; btnEmpty.Down := False; if xGLObject <> nil then xGLObject.Visible := True; end; end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.ChangeDesc', E.Message); end; end; procedure Tfrm3D.ChangeName; var i: integer; xObject: TObject; xSide: T3DSide; x3DSObject: T3DSObject; xConn: T3DConnector; xLine: T3DLine; xGLObject: TGLBaseSceneObject; begin try if (pcProps.ActivePage = TabArchProps) and (edName.Text = '') then exit; if (pcProps.ActivePage = TabScsProps) and (edScsName.Text = '') then exit; for i := 0 to FPropObjects.Count - 1 do begin xObject := TObject(TTreeNode(FPropObjects[i]).Data); if xObject is T3DSide then begin xSide := T3DSide(xObject); xGLObject := TGLBaseSceneObject(xSide.FGLObject); TTreeNode(FPropObjects[i]).Text := edName.Text; xSide.FName := edName.Text; end; if xObject is T3DSObject then begin x3DSObject := T3DSObject(xObject); xGLObject := TGLBaseSceneObject(x3DSObject.FGLObject); TTreeNode(FPropObjects[i]).Text := edName.Text; x3DSObject.FName := edName.Text; end; if xObject is T3DConnector then begin xConn := T3DConnector(xObject); xGLObject := TGLBaseSceneObject(xConn.FGLObject); TTreeNode(FPropObjects[i]).Text := edScsName.Text; xConn.FName := edScsName.Text; end; if xObject is T3DLine then begin xLine := T3DLine(xObject); xGLObject := TGLBaseSceneObject(xLine.FGLObject); TTreeNode(FPropObjects[i]).Text := edScsName.Text; xLine.FName := edScsName.Text; end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.ChangeName', E.Message); end; end; procedure Tfrm3D.ChangeTextureRotate; var i: integer; xObject: T3DSide; xGLObject: TGLBaseSceneObject; Bmp: TBitmap; begin try if edTextureRotate.Text = '' then exit; for i := 0 to FPropObjects.Count - 1 do begin if TOBject(TTreeNode(FPropObjects[i]).Data) is T3DSide then begin xObject := T3DSide(TTreeNode(FPropObjects[i]).Data); xGLObject := TGLBaseSceneObject(xObject.FGLObject); if StrToInt(edTextureRotate.Text) >= 360 then edTextureRotate.Text := IntToStr(StrToInt(edTextureRotate.Text) mod 360); xObject.FTextureRotate := StrToInt(edTextureRotate.Text); if (xGLObject is TGLMesh) then begin RotateTextureToAngleM(xObject, TGLMesh(xGLObject), xObject.FTextureRotate, xObject.FMirror); end; if (xGLObject is TGLPolygon) then begin RotateTextureToAngleP(xObject, TGLPolygon(xGLObject), xObject.FTextureRotate, xObject.FMirror); end; end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.ChangeTextureRotate', E.Message); end; end; //Alex(20.12.2010) procedure Tfrm3D.sbFirstFaceClick(Sender: TObject); begin FMode := F3DFirstPerson; FirstPersonCamera.FocalLength := 100; //160; DeselectGLObjects; GLSceneViewer.SetFocus; GLSceneViewer.Camera := FirstPersonCamera; //GLLightFirstPerson.Shining := True; //Light.Shining := False; Light.Parent := FirstPersonCamera; lbViewType.Caption := cForm3D_Mes5; end; // Tolik 16/10/2018 -- старая закомменчена -- см ниже procedure Tfrm3D.GLCadencerProgress(Sender: TObject; const deltaTime, newTime: Double); var i: integer; speed : Single; Pt: TPoint; //Alex movementScale: single; shiftDown, CTrlDown: Boolean; dp: T3DPoint; // Tolik MoveDelta: Double; // Tolik CanMoveObj: Boolean; glObject: TGLFreeForm; MovedConn: T3DConnector; MovedComponent: T3DComponent; ParentNode: TTreeNode; Shift: TShiftState; OldAngle: Double; klPress: integer; function GetParentConnector(aNode: TTreeNode): T3DConnector; begin Result := Nil; if aNode.Parent <> nil then if TObject(aNode.data).ClassName = 'T3DConnector' then Result := T3DConnector(aNode.data) else begin if ((TObject(aNode.Parent.data).ClassName = 'TF_CAD') or (TObject(aNode.Parent.data).ClassName = 'T3DModel')) then exit else Result := GetParentConnector(aNode.Parent); end; end; Function CanMoveConn(aConn: T3DConnector): Boolean; var i: Integer; Conn, JoinedConn: TConnectorObject; MaxFloorHeight, MinFloorHeight, FloorHeight: Double; currCad: TF_CAD; ListParams: TListParams; begin Result := False; begin Conn := TConnectorObject(aConn.FSCSObject); if Conn <> nil then begin Result := True; //if Conn.ConnectorType = ct_Clear then begin if Conn.FConnRaiseType in [crt_TrunkUP, crt_TrunkDown, crt_BetweenFloorUp, crt_BetweenFloorDown] then Result := False; // вершину межэтажки или магистрали двигать по вертикали нельзя end; //else if Result then if Conn.ConnectorType = ct_NB then begin for i := 0 to Conn.JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(Conn.JoinedConnectorsList[i]); if JoinedConn.FConnRaiseType in [crt_TrunkUP, crt_TrunkDown, crt_BetweenFloorUp, crt_BetweenFloorDown] then Result := False; // вершину межэтажки или магистрали двигать по вертикали нельзя end; end; if Result then // проверить на "улет" с этажа begin currCad := TF_CAD(TPowerCad(Conn.Owner).Owner); if currCad <> nil then begin ListParams := GetListParams(currCad.FCADListID); FloorHeight := MetreToUOM(ListParams.Settings.HeightRoom)*(1000 / currCad.PCad.MapScale)*Factor; // высота этажа //if currCad.FCADListIndex > 0 then if ListNotUnderFloor(currCad) then begin MaxFloorHeight := Get3DFloorHeight(TF_CAD(TPowerCad(Conn.Owner).Owner))*Factor; MinFloorHeight := MaxFloorHeight - FloorHeight; end else begin MinFloorHeight := Get3DFloorHeight(TF_CAD(TPowerCad(Conn.Owner).Owner))*Factor; MaxFloorHeight := MinFloorHeight + FloorHeight; end; Result := True; if ((CompareValue(MaxFloorHeight, aConn.FPoint.z*Factor*FScaleDeltaSCS + dp.y*Factor*FScaleDeltaSCS) < 0) or (CompareValue(MinFloorHeight, aConn.FPoint.z*Factor*FScaleDeltaSCS + dp.y*Factor*FScaleDeltaSCS) > 0)) then Result := False; end; end; end; end; end; Function CanMoveComponent(aCompon: T3DComponent):Boolean; var ParentCatalog: TSCSCatalog; currCad: TF_CAD; FloorHeight, MinFloorHeight, MaxFloorHeight : Double; ListParams: TListParams; ParentConnector: T3DConnector; begin Result := True; currCad := Nil; if aCompon.FSCSCompon <> nil then currCad := GetListByID(aCompon.FSCSCompon.ListID); ParentConnector := Nil; if aCompon.FGLObject <> nil then begin if TglFreeForm(ACompon.FglObject).TagObject <> nil then ParentConnector := GetParentConnector(TTreeNode(TglFreeForm(ACompon.FglObject).TagObject)); end; if ((ParentConnector = nil) or (currCad = nil)) then begin Result := False; exit; end; ListParams := GetListParams(currCad.FCADListID); FloorHeight := MetreToUOM(ListParams.Settings.HeightRoom)*(1000 / currCad.PCad.MapScale)*Factor; // высота этажа if ListNotUnderFloor(currCad) then begin MaxFloorHeight := Get3DFloorHeight(currCad)*Factor; MinFloorHeight := MaxFloorHeight - FloorHeight; end else begin MinFloorHeight := Get3DFloorHeight(currCad)*Factor; MaxFloorHeight := MinFloorHeight + FloorHeight; end; Result := True; { xConn.FGLPoint.y / Factor / FScaleDeltaSCS; } if ((CompareValue(MaxFloorHeight, ParentConnector.FPoint.z*Factor*FScaleDeltaSCS + aCompon.FOffset.y*Factor*FScaleDeltaSCS + dp.y*Factor*FScaleDeltaSCS) < 0) or (CompareValue(MinFloorHeight, ParentConnector.FPoint.z*Factor*FScaleDeltaSCS + aCompon.FOffset.y*Factor*FScaleDeltaSCS + dp.y*Factor*FScaleDeltaSCS) > 0)) then Result := False; end; begin if not GLSceneViewer.Focused then exit; klPress := 0; if IsKeyDown(VK_PRIOR) then klPress := 1 else if IsKeyDown(VK_NEXT) then klPress := 2 else //Движение влево if IsKeyDown(VK_LEFT) then klPress := 3 else //Движение вправо if IsKeyDown(VK_RIGHT) then klPress := 4 else //Движение вперед if IsKeyDown(VK_UP) then klPress := 5 else //Движение назад if IsKeyDown(VK_DOWN) then klPress := 6 else if IsKeyDown(ORD('W')) then klPress := 7 else if IsKeyDown(ORD('S')) then klPress := 8 else if IsKeyDown(ORD('A')) then klPress := 9 else if IsKeyDown(ORD('D')) then klPress := 10 else if IsKeyDown(VK_ESCAPE) then klPress := 11 else if IsKeyDown(VK_RETURN) then klPress := 12; shiftDown:=(IsKeyDown(VK_LSHIFT) or IsKeyDown(VK_RSHIFT)); CTrlDown := (IsKeyDown(VK_CONTROL)); // handle keypresses speed := deltaTime; CanMoveObj := false; MoveDelta := 0.01; movementScale:= GLFPSMovementManager1.movementScale; if CTrlDown then MoveDelta := 0.1; if FMode = F3DFirstPerson then begin case klPress of 3: //Движение влево begin if shiftDown then behav.StrafeHorizontal(-MovementScale*deltaTime * 2) else //behav.TurnHorizontal(-100*deltatime); behav.TurnHorizontal(-20*deltatime); end; 4: //Движение вправо begin if shiftDown then behav.StrafeHorizontal(MovementScale*deltaTime * 2) else //behav.TurnHorizontal(100*deltatime); behav.TurnHorizontal(20*deltatime); end; 5: //Движение вперед begin {if shiftDown then behav.MoveForward(MovementScale*deltaTime * 4) else behav.MoveForward(MovementScale*deltaTime * 2);} if shiftDown then behav.MoveForward(MovementScale*deltaTime * 2) else behav.MoveForward(MovementScale*deltaTime); end; 6: //Движение назад begin if shiftDown then behav.MoveForward(-MovementScale*deltaTime * 2) else behav.MoveForward(-MovementScale*deltaTime); {behav.MoveForward(-MovementScale*deltaTime * 4) else behav.MoveForward(-MovementScale*deltaTime * 2);} end; end; if FSelection.Count = 0 then begin case klPress of 1: begin if shiftDown then behav.StrafeVertical(MovementScale*deltaTime) else // behav.turnVertical(70*deltatime); behav.turnVertical(MovementScale*deltatime); end; 2: begin if shiftDown then behav.StrafeVertical(-MovementScale*deltaTime) else //behav.turnVertical(-70*deltatime); behav.turnVertical(-MovementScale*deltatime); end; end; end else if FSelection.Count > 0 then begin dp.x := 0; dp.y := 0; dp.z := 0; case klPress of 1: //Вверх begin dp.y := dp.y + MoveDelta; CanMoveObj := True; end; 2: //Вниз begin dp.y := dp.y - MoveDelta; CanMoveObj := True; end; 7: //Движение вперед по клавишам ц и w begin dp.z := dp.z + MoveDelta; CanMoveObj := True; end; 8: //Движение назад по клавишам ы и s begin dp.z := dp.z - MoveDelta; CanMoveObj := True; end; 9: //Поворот влево по клавишам ф и a begin dp.x := dp.x - MoveDelta; CanMoveObj := True; end; 10: //Поворот вправо по клавишам в и d begin dp.x := dp.x + MoveDelta; CanMoveObj := True; end; end; if CanMoveObj then begin for i := 0 to FSelection.Count - 1 do begin glObject := TGLFreeForm(FSelection[i]); if TObject(TTreeNode(glObject.tagObject).Data).ClassName = 'T3DConnector' then begin MovedConn := T3DConnector(TTreeNode(glObject.tagObject).Data); if MovedConn <> nil then if CanMoveConn(MovedConn) then begin FMovedObjectsList.Clear; Move3DConnector(MovedConn, dp); FMovedObjectsList.Remove(T3DConnector(TTreeNode(glObject.tagObject).Data)); end; end else if TObject(TTreeNode(glObject.tagObject).Data).ClassName = 'T3DComponent' then begin MovedComponent := T3DComponent(TTreeNode(glObject.tagObject).Data); if not ShiftDown then begin ParentNode := TTreeNode(glObject.tagObject).Parent; if ParentNode <> nil then if TObject(ParentNode.Data) is T3DConnector then begin MovedConn := T3DConnector(ParentNode.Data); if CanMoveConn(MovedConn) then begin //FMovedObjectsList.Remove(T3DConnector(TTreeNode(glObject.tagObject).Data)); FMovedObjectsList.Clear; Move3DConnector(MovedConn, dp); FMovedObjectsList.Remove(T3DConnector(TTreeNode(glObject.tagObject).Data)); end; end; end else begin if MovedComponent.FGLObject <> nil then begin if MovedComponent.FGLObject.ClassName = 'TGLFreeForm' then begin glObject := TGLFreeForm(MovedComponent.FGLObject); {if glObject.Parent = DummyCube then begin glObject.Position.x := glObject.Position.x + dp.x; glObject.Position.y := glObject.Position.y + dp.y; glObject.Position.z := glObject.Position.z + dp.z; end; } if CanMoveComponent(MovedComponent) then //Tolik --04/02/2019 -- Чтобы модель не вылетела за пределы этажа по высоте begin MovedComponent.FOffset.x := MovedComponent.FOffset.x + dp.x; MovedComponent.FOffset.y := MovedComponent.FOffset.y + dp.y; MovedComponent.FOffset.z := MovedComponent.FOffset.z + dp.z; {MovedComponent.FOffset.y := MovedComponent.FOffset.y + dp.z; MovedComponent.FOffset.z := MovedComponent.FOffset.z + dp.y;} if glObject.Parent <> nil then if glObject.Parent.ClassName = 'TGLDummyCube' then if glObject.Parent <> DummyCube then begin //glObject.Parent.Position.x := glObject.Position.x; //glObject.Parent.Position.y := glObject.Position.y; //glObject.Parent.Position.z := glObject.Position.z; if glObject.Parent.Parent <> nil then if glObject.Parent.Parent.ClassName = 'TGLDummyCube' then if glObject.Parent.Parent <> DummyCube then begin if (glObject.Parent.Parent.Parent <> nil) then begin if TGLDummyCube(glObject.Parent.Parent.Parent) <> DummyCube then begin OldAngle := TglDummyCube(TGLDummyCube(glObject.Parent.Parent.Parent)).TurnAngle; TGLDummyCube(glObject.Parent.Parent.Parent).TurnAngle := (-1)*OldAngle; glObject.Parent.Parent.Position.x := glObject.Parent.Parent.Position.x + dp.x; glObject.Parent.Parent.Position.y := glObject.Parent.Parent.Position.y + dp.y; glObject.Parent.Parent.Position.z := glObject.Parent.Parent.Position.z + dp.z; TGLDummyCube(glObject.Parent.Parent.Parent).TurnAngle := OldAngle; end else begin glObject.Parent.Parent.Position.x := glObject.Parent.Parent.Position.x + dp.x; glObject.Parent.Parent.Position.y := glObject.Parent.Parent.Position.y + dp.y; glObject.Parent.Parent.Position.z := glObject.Parent.Parent.Position.z + dp.z; end; end; {glObject.Parent.Parent.Position.x := glObject.Position.x; glObject.Parent.Parent.Position.y := glObject.Position.y; glObject.Parent.Parent.Position.z := glObject.Position.z; } end; end; end; end; end; end; end; end; end; end; end else begin case klPress of 7: //Движение вперед по клавишам ц и w begin GLSceneViewer.Camera.Move(5 * deltaTime); end; 8: //Движение назад по клавишам ы и s begin GLSceneViewer.Camera.Move(-5 * deltaTime); end; 9: //Поворот влево по клавишам ф и a begin GLSceneViewer.Camera.slide(-5 * deltaTime); end; 10: //Поворот вправо по клавишам в и d begin GLSceneViewer.Camera.slide(5 * deltaTime); end; end; if klPress > 10 then begin if FToolMode <> tmSelect then begin ApplyCutting; // **** Undo Cut ***************** if klPress = 11 then begin UndoCutSides; end; end else // Check Escape On Object Tracing begin if FMovedFullConnector <> nil then begin FMovedFullConnector.Position.X := MovedStartPos.x; FMovedFullConnector.Position.Y := MovedStartPos.y; FMovedFullConnector.Position.Z := MovedStartPos.z; for i := 0 to FShadowObjects.Count - 1 do DummyCube.Remove(TGLLines(FShadowObjects[i]), True); FShadowObjects.Clear; FMovedFullConnector := nil; GLSceneViewer.Cursor := crDefault; sbView.Caption := ''; end; if FMovedEmptyConnector <> nil then begin FMovedEmptyConnector.Position.X := MovedStartPos.x; FMovedEmptyConnector.Position.Y := MovedStartPos.y; FMovedEmptyConnector.Position.Z := MovedStartPos.z; for i := 0 to FShadowObjects.Count - 1 do DummyCube.Remove(TGLLines(FShadowObjects[i]), True); FShadowObjects.Clear; FMovedEmptyConnector := nil; GLSceneViewer.Cursor := crDefault; sbView.Caption := ''; end; if FMovedLine <> nil then begin FMovedLine.Nodes[0].X := MovedStartPos1.x; FMovedLine.Nodes[0].Y := MovedStartPos1.y; FMovedLine.Nodes[0].Z := MovedStartPos1.z; FMovedLine.Nodes[1].X := MovedStartPos2.x; FMovedLine.Nodes[1].Y := MovedStartPos2.y; FMovedLine.Nodes[1].Z := MovedStartPos2.z; FMovedLine := nil; GLSceneViewer.Cursor := crDefault; sbView.Caption := ''; end; end; end; end; // Tolik 04/03/2020 -- if klPress = 11 then begin if FSelection.count > 0 then begin ModelTree.ClearSelection; ScsModelTree.ClearSelection; DeselectGLObjects; end; end; // GLSceneViewer.Invalidate; end; (* // Tolik 16/10/2018 -- старая закомменчена -- см ниже procedure Tfrm3D.GLCadencerProgress(Sender: TObject; const deltaTime, newTime: Double); var i: integer; speed : Single; Pt: TPoint; //Alex movementScale: single; shiftDown, CTrlDown: Boolean; dp: T3DPoint; // Tolik MoveDelta: Double; // Tolik CanMoveObj: Boolean; glObject: TGLFreeForm; MovedConn: T3DConnector; MovedComponent: T3DComponent; ParentNode: TTreeNode; Shift: TShiftState; OldAngle: Double; function GetParentConnector(aNode: TTreeNode): T3DConnector; begin Result := Nil; if aNode.Parent <> nil then if TObject(aNode.data).ClassName = 'T3DConnector' then Result := T3DConnector(aNode.data) else begin if ((TObject(aNode.Parent.data).ClassName = 'TF_CAD') or (TObject(aNode.Parent.data).ClassName = 'T3DModel')) then exit else Result := GetParentConnector(aNode.Parent); end; end; Function CanMoveConn(aConn: T3DConnector): Boolean; var i: Integer; Conn, JoinedConn: TConnectorObject; MaxFloorHeight, MinFloorHeight, FloorHeight: Double; currCad: TF_CAD; ListParams: TListParams; begin Result := False; begin Conn := TConnectorObject(aConn.FSCSObject); if Conn <> nil then begin Result := True; //if Conn.ConnectorType = ct_Clear then begin if Conn.FConnRaiseType in [crt_TrunkUP, crt_TrunkDown, crt_BetweenFloorUp, crt_BetweenFloorDown] then Result := False; // вершину межэтажки или магистрали двигать по вертикали нельзя end; //else if Result then if Conn.ConnectorType = ct_NB then begin for i := 0 to Conn.JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(Conn.JoinedConnectorsList[i]); if JoinedConn.FConnRaiseType in [crt_TrunkUP, crt_TrunkDown, crt_BetweenFloorUp, crt_BetweenFloorDown] then Result := False; // вершину межэтажки или магистрали двигать по вертикали нельзя end; end; if Result then // проверить на "улет" с этажа begin currCad := TF_CAD(TPowerCad(Conn.Owner).Owner); if currCad <> nil then begin ListParams := GetListParams(currCad.FCADListID); FloorHeight := MetreToUOM(ListParams.Settings.HeightRoom)*(1000 / currCad.PCad.MapScale)*Factor; // высота этажа //if currCad.FCADListIndex > 0 then if ListNotUnderFloor(currCad) then begin MaxFloorHeight := Get3DFloorHeight(TF_CAD(TPowerCad(Conn.Owner).Owner))*Factor; MinFloorHeight := MaxFloorHeight - FloorHeight; end else begin MinFloorHeight := Get3DFloorHeight(TF_CAD(TPowerCad(Conn.Owner).Owner))*Factor; MaxFloorHeight := MinFloorHeight + FloorHeight; end; Result := True; if ((CompareValue(MaxFloorHeight, aConn.FPoint.z*Factor*FScaleDeltaSCS + dp.y*Factor*FScaleDeltaSCS) < 0) or (CompareValue(MinFloorHeight, aConn.FPoint.z*Factor*FScaleDeltaSCS + dp.y*Factor*FScaleDeltaSCS) > 0)) then Result := False; end; end; end; end; end; Function CanMoveComponent(aCompon: T3DComponent):Boolean; var ParentCatalog: TSCSCatalog; currCad: TF_CAD; FloorHeight, MinFloorHeight, MaxFloorHeight : Double; ListParams: TListParams; ParentConnector: T3DConnector; begin Result := True; currCad := Nil; if aCompon.FSCSCompon <> nil then currCad := GetListByID(aCompon.FSCSCompon.ListID); ParentConnector := Nil; if aCompon.FGLObject <> nil then begin if TglFreeForm(ACompon.FglObject).TagObject <> nil then ParentConnector := GetParentConnector(TTreeNode(TglFreeForm(ACompon.FglObject).TagObject)); end; if ((ParentConnector = nil) or (currCad = nil)) then begin Result := False; exit; end; ListParams := GetListParams(currCad.FCADListID); FloorHeight := MetreToUOM(ListParams.Settings.HeightRoom)*(1000 / currCad.PCad.MapScale)*Factor; // высота этажа if ListNotUnderFloor(currCad) then begin MaxFloorHeight := Get3DFloorHeight(currCad)*Factor; MinFloorHeight := MaxFloorHeight - FloorHeight; end else begin MinFloorHeight := Get3DFloorHeight(currCad)*Factor; MaxFloorHeight := MinFloorHeight + FloorHeight; end; Result := True; { xConn.FGLPoint.y / Factor / FScaleDeltaSCS; } if ((CompareValue(MaxFloorHeight, ParentConnector.FPoint.z*Factor*FScaleDeltaSCS + aCompon.FOffset.y*Factor*FScaleDeltaSCS + dp.y*Factor*FScaleDeltaSCS) < 0) or (CompareValue(MinFloorHeight, ParentConnector.FPoint.z*Factor*FScaleDeltaSCS + aCompon.FOffset.y*Factor*FScaleDeltaSCS + dp.y*Factor*FScaleDeltaSCS) > 0)) then Result := False; end; begin if not GLSceneViewer.Focused then exit; // handle keypresses speed := deltaTime/10; CanMoveObj := false; MoveDelta := 0.01; shiftDown:=(IsKeyDown(VK_LSHIFT) or IsKeyDown(VK_RSHIFT)); {if shiftDown then MoveDelta := 0.1;} { Shift := KeyboardStateToShiftState; if ssCtrl in Shift then MoveDelta := 0.1;} CTrlDown := (IsKeyDown(VK_CONTROL)); if CTrlDown then MoveDelta := 0.1; //Alex(16.12.2010) // Tolik 11/02/2020 //if GLSceneViewer.Camera = FirstPersonCamera then if FMode = F3DFirstPerson then // begin movementScale:= GLFPSMovementManager1.movementScale; if FSelection.Count = 0 then begin //Вверх if IsKeyDown(VK_PRIOR) then begin if shiftDown then behav.StrafeVertical(MovementScale*deltaTime) else behav.turnVertical(70*deltatime); end; //Вниз if IsKeyDown(VK_NEXT) then begin if shiftDown then behav.StrafeVertical(-MovementScale*deltaTime) else behav.turnVertical(-70*deltatime); end; end; //Движение влево if IsKeyDown(VK_LEFT) then begin if shiftDown then behav.StrafeHorizontal(-MovementScale*deltaTime * 2) else behav.TurnHorizontal(-100*deltatime); end; //Движение вправо if IsKeyDown(VK_RIGHT) then begin if shiftDown then behav.StrafeHorizontal(MovementScale*deltaTime * 2) else behav.TurnHorizontal(100*deltatime); end; //Движение вперед if IsKeyDown(VK_UP) then begin //if shiftDown then // behav.turnVertical(70*deltatime) //else if shiftDown then behav.MoveForward(MovementScale*deltaTime * 4) else behav.MoveForward(MovementScale*deltaTime * 2); end; //Движение назад if IsKeyDown(VK_DOWN) then begin //if shiftDown then // behav.turnVertical(-70*deltatime) //else if shiftDown then behav.MoveForward(-MovementScale*deltaTime * 4) else behav.MoveForward(-MovementScale*deltaTime * 2); end; if FSelection.Count > 0 then begin dp.x := 0; dp.y := 0; dp.z := 0; //Движение вперед по клавишам ц и w if (IsKeyDown('ц') or IsKeyDown('w')) then begin dp.z := dp.z + MoveDelta; CanMoveObj := True; end; //Движение назад по клавишам ы и s if (IsKeyDown('s') or IsKeyDown('ы') or IsKeyDown('і')) then begin dp.z := dp.z - MoveDelta; CanMoveObj := True; end; //Поворот влево по клавишам ф и a if (IsKeyDown('ф') or IsKeyDown('a')) then begin dp.x := dp.x - MoveDelta; CanMoveObj := True; end; //Поворот вправо по клавишам в и d if (IsKeyDown('в') or IsKeyDown('d')) then begin dp.x := dp.x + MoveDelta; CanMoveObj := True; end; //Вверх if IsKeyDown(VK_PRIOR) then begin dp.y := dp.y + MoveDelta; CanMoveObj := True; end; //Вниз if IsKeyDown(VK_NEXT) then begin dp.y := dp.y - MoveDelta; CanMoveObj := True; end; if CanMoveObj then begin for i := 0 to FSelection.Count - 1 do begin glObject := TGLFreeForm(FSelection[i]); if TObject(TTreeNode(glObject.tagObject).Data).ClassName = 'T3DConnector' then begin MovedConn := T3DConnector(TTreeNode(glObject.tagObject).Data); if MovedConn <> nil then if CanMoveConn(MovedConn) then begin FMovedObjectsList.Clear; Move3DConnector(MovedConn, dp); FMovedObjectsList.Remove(T3DConnector(TTreeNode(glObject.tagObject).Data)); end; end else if TObject(TTreeNode(glObject.tagObject).Data).ClassName = 'T3DComponent' then begin MovedComponent := T3DComponent(TTreeNode(glObject.tagObject).Data); if not ShiftDown then begin ParentNode := TTreeNode(glObject.tagObject).Parent; if ParentNode <> nil then if TObject(ParentNode.Data) is T3DConnector then begin MovedConn := T3DConnector(ParentNode.Data); if CanMoveConn(MovedConn) then begin //FMovedObjectsList.Remove(T3DConnector(TTreeNode(glObject.tagObject).Data)); FMovedObjectsList.Clear; Move3DConnector(MovedConn, dp); FMovedObjectsList.Remove(T3DConnector(TTreeNode(glObject.tagObject).Data)); end; end; end else begin if MovedComponent.FGLObject <> nil then begin if MovedComponent.FGLObject.ClassName = 'TGLFreeForm' then begin glObject := TGLFreeForm(MovedComponent.FGLObject); {if glObject.Parent = DummyCube then begin glObject.Position.x := glObject.Position.x + dp.x; glObject.Position.y := glObject.Position.y + dp.y; glObject.Position.z := glObject.Position.z + dp.z; end; } if CanMoveComponent(MovedComponent) then //Tolik --04/02/2019 -- Чтобы модель не вылетела за пределы этажа по высоте begin MovedComponent.FOffset.x := MovedComponent.FOffset.x + dp.x; MovedComponent.FOffset.y := MovedComponent.FOffset.y + dp.y; MovedComponent.FOffset.z := MovedComponent.FOffset.z + dp.z; {MovedComponent.FOffset.y := MovedComponent.FOffset.y + dp.z; MovedComponent.FOffset.z := MovedComponent.FOffset.z + dp.y;} if glObject.Parent <> nil then if glObject.Parent.ClassName = 'TGLDummyCube' then if glObject.Parent <> DummyCube then begin //glObject.Parent.Position.x := glObject.Position.x; //glObject.Parent.Position.y := glObject.Position.y; //glObject.Parent.Position.z := glObject.Position.z; if glObject.Parent.Parent <> nil then if glObject.Parent.Parent.ClassName = 'TGLDummyCube' then if glObject.Parent.Parent <> DummyCube then begin if (glObject.Parent.Parent.Parent <> nil) then begin if TGLDummyCube(glObject.Parent.Parent.Parent) <> DummyCube then begin OldAngle := TglDummyCube(TGLDummyCube(glObject.Parent.Parent.Parent)).TurnAngle; TGLDummyCube(glObject.Parent.Parent.Parent).TurnAngle := (-1)*OldAngle; glObject.Parent.Parent.Position.x := glObject.Parent.Parent.Position.x + dp.x; glObject.Parent.Parent.Position.y := glObject.Parent.Parent.Position.y + dp.y; glObject.Parent.Parent.Position.z := glObject.Parent.Parent.Position.z + dp.z; TGLDummyCube(glObject.Parent.Parent.Parent).TurnAngle := OldAngle; end else begin glObject.Parent.Parent.Position.x := glObject.Parent.Parent.Position.x + dp.x; glObject.Parent.Parent.Position.y := glObject.Parent.Parent.Position.y + dp.y; glObject.Parent.Parent.Position.z := glObject.Parent.Parent.Position.z + dp.z; end; end; {glObject.Parent.Parent.Position.x := glObject.Position.x; glObject.Parent.Parent.Position.y := glObject.Position.y; glObject.Parent.Parent.Position.z := glObject.Position.z; } end; end; end; end; end; end; end; end; end; end else GLSceneViewer.Invalidate; end else begin //if IsKeyDown(VK_RIGHT) then // DummyCube.Translate(GLSceneViewer.Camera.Position.Z * speed, 0, -GLSceneViewer.Camera.Position.X * speed); //if IsKeyDown(VK_LEFT) then // DummyCube.Translate(-GLSceneViewer.Camera.Position.Z * speed, 0, GLSceneViewer.Camera.Position.X * speed); //if IsKeyDown(VK_UP) then // DummyCube.Translate(-GLSceneViewer.Camera.Position.X * speed, 0, -GLSceneViewer.Camera.Position.Z * speed); //if IsKeyDown(VK_DOWN) then // DummyCube.Translate(GLSceneViewer.Camera.Position.X * speed, 0, GLSceneViewer.Camera.Position.Z * speed); //Движение вперед по клавишам ц и w if (IsKeyDown('ц') or IsKeyDown('w')) then GLSceneViewer.Camera.Move(5 * deltaTime); //Движение назад по клавишам ы и s if (IsKeyDown('ы') or IsKeyDown('s')) then GLSceneViewer.Camera.Move(-5 * deltaTime); //Поворот влево по клавишам ф и a if (IsKeyDown('ф') or IsKeyDown('a')) then GLSceneViewer.Camera.slide(-5 * deltaTime); //Поворот вправо по клавишам в и d if (IsKeyDown('в') or IsKeyDown('d')) then GLSceneViewer.Camera.slide(5 * deltaTime); if IsKeyDown(VK_ESCAPE) or IsKeyDown(VK_RETURN) then begin if FToolMode <> tmSelect then begin //21.09.2011 //FToolMode := tmSelect; // glSpliter.Visible := False; // glCubeSpliter.Visible := False; // glCubeSpliter1.Visible := False; // glCubeSpliter2.Visible := False; // glSide11.Visible := False; // glSide12.Visible := False; // glSide21.Visible := False; // glSide22.Visible := False; // GLSceneViewer.Cursor := crDefault; // DeleteNodesObjects; // RefreshSidesPoints; ApplyCutting; // **** Undo Cut ***************** if IsKeyDown(VK_ESCAPE) then begin UndoCutSides; end; end else // Check Escape On Object Tracing begin if FMovedFullConnector <> nil then begin FMovedFullConnector.Position.X := MovedStartPos.x; FMovedFullConnector.Position.Y := MovedStartPos.y; FMovedFullConnector.Position.Z := MovedStartPos.z; for i := 0 to FShadowObjects.Count - 1 do DummyCube.Remove(TGLLines(FShadowObjects[i]), True); FShadowObjects.Clear; FMovedFullConnector := nil; GLSceneViewer.Cursor := crDefault; sbView.Caption := ''; end; if FMovedEmptyConnector <> nil then begin FMovedEmptyConnector.Position.X := MovedStartPos.x; FMovedEmptyConnector.Position.Y := MovedStartPos.y; FMovedEmptyConnector.Position.Z := MovedStartPos.z; for i := 0 to FShadowObjects.Count - 1 do DummyCube.Remove(TGLLines(FShadowObjects[i]), True); FShadowObjects.Clear; FMovedEmptyConnector := nil; GLSceneViewer.Cursor := crDefault; sbView.Caption := ''; end; if FMovedLine <> nil then begin FMovedLine.Nodes[0].X := MovedStartPos1.x; FMovedLine.Nodes[0].Y := MovedStartPos1.y; FMovedLine.Nodes[0].Z := MovedStartPos1.z; FMovedLine.Nodes[1].X := MovedStartPos2.x; FMovedLine.Nodes[1].Y := MovedStartPos2.y; FMovedLine.Nodes[1].Z := MovedStartPos2.z; FMovedLine := nil; GLSceneViewer.Cursor := crDefault; sbView.Caption := ''; end; end; end; end; end; *) // (* procedure Tfrm3D.GLCadencerProgress(Sender: TObject; const deltaTime, newTime: Double); var i: integer; speed : Single; Pt: TPoint; //Alex movementScale: single; shiftDown: Boolean; begin if not GLSceneViewer.Focused then exit; // handle keypresses speed := deltaTime; shiftDown:=(IsKeyDown(VK_LSHIFT) or IsKeyDown(VK_RSHIFT)); //Alex(16.12.2010) if GLSceneViewer.Camera = FirstPersonCamera then begin movementScale:= GLFPSMovementManager1.movementScale; //Вверх if IsKeyDown(VK_PRIOR) then begin if shiftDown then behav.StrafeVertical(MovementScale*deltaTime) else behav.turnVertical(70*deltatime); end; //Вниз if IsKeyDown(VK_NEXT) then begin if shiftDown then behav.StrafeVertical(-MovementScale*deltaTime) else behav.turnVertical(-70*deltatime); end; //Движение влево if IsKeyDown(VK_LEFT) then begin if shiftDown then behav.StrafeHorizontal(-MovementScale*deltaTime * 2) else behav.TurnHorizontal(-100*deltatime); end; //Движение вправо if IsKeyDown(VK_RIGHT) then begin if shiftDown then behav.StrafeHorizontal(MovementScale*deltaTime * 2) else behav.TurnHorizontal(100*deltatime); end; //Движение вперед if IsKeyDown(VK_UP) then begin //if shiftDown then // behav.turnVertical(70*deltatime) //else if shiftDown then behav.MoveForward(MovementScale*deltaTime * 4) else behav.MoveForward(MovementScale*deltaTime * 2); end; //Движение назад if IsKeyDown(VK_DOWN) then begin //if shiftDown then // behav.turnVertical(-70*deltatime) //else if shiftDown then behav.MoveForward(-MovementScale*deltaTime * 4) else behav.MoveForward(-MovementScale*deltaTime * 2); end; GLSceneViewer.Invalidate; end else begin //if IsKeyDown(VK_RIGHT) then // DummyCube.Translate(GLSceneViewer.Camera.Position.Z * speed, 0, -GLSceneViewer.Camera.Position.X * speed); //if IsKeyDown(VK_LEFT) then // DummyCube.Translate(-GLSceneViewer.Camera.Position.Z * speed, 0, GLSceneViewer.Camera.Position.X * speed); //if IsKeyDown(VK_UP) then // DummyCube.Translate(-GLSceneViewer.Camera.Position.X * speed, 0, -GLSceneViewer.Camera.Position.Z * speed); //if IsKeyDown(VK_DOWN) then // DummyCube.Translate(GLSceneViewer.Camera.Position.X * speed, 0, GLSceneViewer.Camera.Position.Z * speed); //Движение вперед по клавишам ц и w if (IsKeyDown('ц') or IsKeyDown('w')) then GLSceneViewer.Camera.Move(5 * deltaTime); //Движение назад по клавишам ы и s if (IsKeyDown('ы') or IsKeyDown('s')) then GLSceneViewer.Camera.Move(-5 * deltaTime); //Поворот влево по клавишам ф и a if (IsKeyDown('ф') or IsKeyDown('a')) then GLSceneViewer.Camera.slide(-5 * deltaTime); //Поворот вправо по клавишам в и d if (IsKeyDown('в') or IsKeyDown('d')) then GLSceneViewer.Camera.slide(5 * deltaTime); if IsKeyDown(VK_ESCAPE) or IsKeyDown(VK_RETURN) then begin if FToolMode <> tmSelect then begin //21.09.2011 //FToolMode := tmSelect; // glSpliter.Visible := False; // glCubeSpliter.Visible := False; // glCubeSpliter1.Visible := False; // glCubeSpliter2.Visible := False; // glSide11.Visible := False; // glSide12.Visible := False; // glSide21.Visible := False; // glSide22.Visible := False; // GLSceneViewer.Cursor := crDefault; // DeleteNodesObjects; // RefreshSidesPoints; ApplyCutting; // **** Undo Cut ***************** if IsKeyDown(VK_ESCAPE) then begin UndoCutSides; end; end else // Check Escape On Object Tracing begin if FMovedFullConnector <> nil then begin FMovedFullConnector.Position.X := MovedStartPos.x; FMovedFullConnector.Position.Y := MovedStartPos.y; FMovedFullConnector.Position.Z := MovedStartPos.z; for i := 0 to FShadowObjects.Count - 1 do DummyCube.Remove(TGLLines(FShadowObjects[i]), True); FShadowObjects.Clear; FMovedFullConnector := nil; GLSceneViewer.Cursor := crDefault; sbView.Caption := ''; end; if FMovedEmptyConnector <> nil then begin FMovedEmptyConnector.Position.X := MovedStartPos.x; FMovedEmptyConnector.Position.Y := MovedStartPos.y; FMovedEmptyConnector.Position.Z := MovedStartPos.z; for i := 0 to FShadowObjects.Count - 1 do DummyCube.Remove(TGLLines(FShadowObjects[i]), True); FShadowObjects.Clear; FMovedEmptyConnector := nil; GLSceneViewer.Cursor := crDefault; sbView.Caption := ''; end; if FMovedLine <> nil then begin FMovedLine.Nodes[0].X := MovedStartPos1.x; FMovedLine.Nodes[0].Y := MovedStartPos1.y; FMovedLine.Nodes[0].Z := MovedStartPos1.z; FMovedLine.Nodes[1].X := MovedStartPos2.x; FMovedLine.Nodes[1].Y := MovedStartPos2.y; FMovedLine.Nodes[1].Z := MovedStartPos2.z; FMovedLine := nil; GLSceneViewer.Cursor := crDefault; sbView.Caption := ''; end; end; end; end; end; *) procedure Tfrm3D.GLSceneViewerBeforeRender(Sender: TObject); const clrBlack : TVector = (0, 0, 0, 1); clrGray20 : TVector = (0.20, 0.20, 0.20, 1); clrGray80 : TVector = (0.80, 0.80, 0.80, 1); begin //beep; // Для истории... на всякий...здесь эффекта никакого не дает. { glMaterialfv(GL_FRONT_AND_BACK, GL_AMBIENT, @clrGray20); glMaterialfv(GL_FRONT_AND_BACK, GL_DIFFUSE, @clrGray80); glMaterialfv(GL_FRONT_AND_BACK, GL_SPECULAR, @clrBlack); glMaterialfv(GL_FRONT_AND_BACK, GL_EMISSION, @clrBlack); glMateriali(GL_FRONT_AND_BACK, GL_SHININESS, 0);} // FillChar(FFrontBackColors, SizeOf(FFrontBackColors), 127); // FFrontBackShininess[0]:=0; // FFrontBackShininess[1]:=0; end; procedure Tfrm3D.GLSceneViewerClick(Sender: TObject); begin try if not GLSceneViewer.Focused then begin SendMessage(GLSceneViewer.Handle, WM_ACTIVATE, MakewParam(WA_ACTIVE, 0), 0); SendMessage(GLSceneViewer.Handle, WM_SETFOCUS, 0, 0); end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.GLSceneViewerClick', E.Message); end; end; procedure Tfrm3D.RotateTextureToAngleM(aObject: T3DSide; aGLObject: TGLMesh; aAngle: Integer; aMirror: Boolean); var pN, pP: TVector3f; mat: TAffineMatrix; i: Integer; vs, vs0, vs1, vs2: TVector3f; tp: TTexPoint; r1, r2: T3DPoint; rAngle: Double; VCoords: array [1..4] of TVector3f; axis: T3DAxis; begin try // if (aObject.FFaceType = ftNetFloor) or (aObject.FFaceType = ftNetCeiling) then begin VCoords[1][0] := 0; VCoords[1][1] := 0; VCoords[1][2] := 0; VCoords[2][0] := 100; VCoords[2][1] := 0; VCoords[2][2] := 0; VCoords[3][0] := 100; VCoords[3][1] := 0; VCoords[3][2] := 100; VCoords[4][0] := 0; VCoords[4][1] := 0; VCoords[4][2] := 100; axis := aZ; end else if (aObject.FFaceType = ftNetPath) then begin VCoords[1] := aGLObject.Vertices[0].coord; VCoords[2] := aGLObject.Vertices[1].coord; VCoords[3] := aGLObject.Vertices[3].coord; VCoords[4] := aGLObject.Vertices[2].coord; axis := aY; end; rAngle := Math.DegToRad(aAngle); //rAngle := StrToFloat_My(InttoStr(aAngle)); //rAngle := DegToRad(rAngle); if (aAngle >=0) and (aAngle < 90) then begin if not aMirror then begin vs0 := VCoords[1]; vs1 := VCoords[2]; end else begin vs0 := VCoords[2]; vs1 := VCoords[1]; end; vs2 := VCoords[4]; r1.x := vs0[0]; r1.y := vs0[2]; r1.z := vs0[1]; r2.x := vs1[0]; r2.y := vs1[2]; r2.z := vs1[1]; r2 := Rotate3DPoint(r1, r2, Math.DegToRad(aAngle- 0), axis); vs1[0] := r2.x; vs1[2] := r2.y; vs1[1] := r2.z; end; if (aAngle >=90) and (aAngle < 180) then begin if not aMirror then begin vs0 := VCoords[2]; vs1 := VCoords[3]; end else begin vs0 := VCoords[3]; vs1 := VCoords[2]; end; vs2 := VCoords[1]; r1.x := vs0[0]; r1.y := vs0[2]; r1.z := vs0[1]; r2.x := vs1[0]; r2.y := vs1[2]; r2.z := vs1[1]; r2 := Rotate3DPoint(r1, r2, Math.DegToRad(aAngle - 90), axis); vs1[0] := r2.x; vs1[2] := r2.y; vs1[1] := r2.z; end; if (aAngle >=180) and (aAngle < 270) then begin if not aMirror then begin vs0 := VCoords[3]; vs1 := VCoords[4]; end else begin vs0 := VCoords[4]; vs1 := VCoords[3]; end; vs2 := VCoords[2]; r1.x := vs0[0]; r1.y := vs0[2]; r1.z := vs0[1]; r2.x := vs1[0]; r2.y := vs1[2]; r2.z := vs1[1]; r2 := Rotate3DPoint(r1, r2, Math.DegToRad(aAngle - 180), axis); vs1[0] := r2.x; vs1[2] := r2.y; vs1[1] := r2.z; end; if (aAngle >=270) and (aAngle < 360) then begin if not aMirror then begin vs0 := VCoords[4]; vs1 := VCoords[1]; end else begin vs0 := VCoords[1]; vs1 := VCoords[4]; end; vs2 := VCoords[3]; r1.x := vs0[0]; r1.y := vs0[2]; r1.z := vs0[1]; r2.x := vs1[0]; r2.y := vs1[2]; r2.z := vs1[1]; r2 := Rotate3DPoint(r1, r2, Math.DegToRad(aAngle - 270), axis); vs1[0] := r2.x; vs1[2] := r2.y; vs1[1] := r2.z; end; pN := CalcPlaneNormal (vs0, vs1, vs2); SetVector (mat[2], pN); SetVector (mat[0], VectorNormalize (VectorSubtract (vs1, vs0))); SetVector (mat[1], VectorCrossProduct (mat[2], mat[0])); InvertMatrix (mat); for i := 0 to aGLObject.Vertices.Count - 1 do begin vs := aGLObject.Vertices[i].coord; pP := VectorTransform (vs, mat); tp := TexPointMake (pP[0], pP[1]); aGLObject.Vertices.VertexTexCoord[i] := tp; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.RotateTextureToAngle', E.Message); end; end; procedure Tfrm3D.RotateTextureToAngleP(aObject: T3DSide; aGLObject: TGLPolygon; aAngle: Integer; aMirror: Boolean); var pN, pP: TVector3f; mat: TAffineMatrix; i: Integer; vs, vs0, vs1, vs2: TVector3f; tp: TTexPoint; r1, r2: T3DPoint; rAngle: Double; VCoords: array [1..4] of TVector3f; axis: T3DAxis; xScale: Double; WH_koef: double; //- ширина / высота HW_koef: double; //- высота / ширина f_find_other_GLObject: Boolean; f_face_index: integer; f_first_Object: T3DSide; f_Face: TFaceRecord; f_GLObject: TGLBaseSceneObject; tmpdir: string; tmpfname: string; Coords3D: T3DPointArray; begin try f_find_other_GLObject := True; f_face_index := 0; f_first_Object := aObject; f_GLObject := aGLObject; tmpfname := ''; if (f_GLObject is TGLPolygon) and (f_GLObject.TagObject <> nil) then begin if (T3DSide(TTreeNode(f_GLObject.TagObject).Data).FAsArc) then begin //tmpdir := GetWorkDir; //ExtractDirByCategoryType(dctPictures); //tmpfname := tmpdir + '\tmp.bmp'; //aGLObject.Material.Texture.Image.SaveToFile(tmpfname); end; end; while f_find_other_GLObject do begin {TODO} // перепроверить //if aObject.FAsArc then begin //Задаются 4 точки в пространстве по часовой стрелке по умолчанию- //стена, лежащая на оси Х VCoords[1][0] := 0; VCoords[1][1] := 0; VCoords[1][2] := 0; VCoords[2][0] := 100; VCoords[2][1] := 0; VCoords[2][2] := 0; VCoords[3][0] := 100; VCoords[3][1] := 100; VCoords[3][2] := 0; VCoords[4][0] := 0; VCoords[4][1] := 100; VCoords[4][2] := 0; end; //else begin if aGLObject.Nodes.Count >= 3 then begin //VCoords[1][0] := aGLObject.Nodes[0].x; //VCoords[1][1] := aGLObject.Nodes[0].y; //VCoords[1][2] := aGLObject.Nodes[0].z; //VCoords[2][0] := aGLObject.Nodes[1].x; //VCoords[2][1] := aGLObject.Nodes[1].y; //VCoords[2][2] := aGLObject.Nodes[1].z; //VCoords[3][0] := aGLObject.Nodes[2].x; //VCoords[3][1] := aGLObject.Nodes[2].y; //VCoords[3][2] := aGLObject.Nodes[2].z; //VCoords[4][0] := aGLObject.Nodes[3].x; //VCoords[4][1] := aGLObject.Nodes[3].y; //VCoords[4][2] := aGLObject.Nodes[3].z; //28.08.2012 Coords3D := GetPointsForNormal(GLNodesTo3DCoords(aGLObject.Nodes, true)); //Coords3D := GLNodesTo3DCoords(aGLObject.Nodes, true); if (AObject.FFaceType = ftNetFloor) or (AObject.FFaceType = ftNetCeiling) then Coords3D := GetPointsForNormal(GLNodesTo3DCoords(aGLObject.Nodes, true)) else Coords3D := GLNodesTo3DCoords(aGLObject.Nodes, true); for i := 0 to Length(Coords3D) -1 do begin if Length(VCoords) >= (i+1) then begin VCoords[i+1][0] := Coords3D[i].x; //VCoords[i+1][1] := Coords3D[i].y; //VCoords[i+1][2] := Coords3D[i].z; VCoords[i+1][1] := Coords3D[i].z; VCoords[i+1][2] := Coords3D[i].y; end else Break; //// BREAK //// end; //Tolik -- 02/02/2017 -- если комната получится треугольная, то, чтобы не поломались текстуры // пола и потолка ... if Length(Coords3D) = 3 then begin VCoords[4][0] := VCoords[3][0]; VCoords[4][1] := VCoords[3][1]; VCoords[4][2] := VCoords[3][2]; end; // end else begin //Получается что-то,наподобии стены VCoords[1][0] := 0; VCoords[1][1] := 0; VCoords[1][2] := 0; VCoords[2][0] := 100; VCoords[2][1] := 0; VCoords[2][2] := 0; VCoords[3][0] := 100; VCoords[3][1] := 0; VCoords[3][2] := 100; VCoords[4][0] := 0; VCoords[4][1] := 0; VCoords[4][2] := 100; end; end; rAngle := Math.DegToRad(aAngle); if (aAngle >=0) and (aAngle < 90) then begin if not aMirror then begin vs0 := VCoords[1]; vs1 := VCoords[2]; end else begin vs0 := VCoords[2]; vs1 := VCoords[1]; end; vs2 := VCoords[4]; vs1 := Rotate3DVector(vs0, vs1, vs2, aAngle - 0); end; if (aAngle >=90) and (aAngle < 180) then begin if not aMirror then begin vs0 := VCoords[2]; vs1 := VCoords[3]; end else begin vs0 := VCoords[3]; vs1 := VCoords[2]; end; vs2 := VCoords[1]; vs1 := Rotate3DVector(vs0, vs1, vs2, aAngle - 90); end; if (aAngle >=180) and (aAngle < 270) then begin if not aMirror then begin vs0 := VCoords[3]; vs1 := VCoords[4]; end else begin vs0 := VCoords[4]; vs1 := VCoords[3]; end; vs2 := VCoords[2]; vs1 := Rotate3DVector(vs0, vs1, vs2, aAngle - 180); end; if (aAngle >=270) and (aAngle < 360) then begin if not aMirror then begin vs0 := VCoords[4]; vs1 := VCoords[1]; end else begin vs0 := VCoords[1]; vs1 := VCoords[4]; end; vs2 := VCoords[3]; vs1 := Rotate3DVector(vs0, vs1, vs2, aAngle - 270); end; pN := CalcPlaneNormal (vs0, vs1, vs2); SetVector (mat[2], pN); SetVector (mat[0], VectorNormalize (VectorSubtract (vs1, vs0))); SetVector (mat[1], VectorCrossProduct (mat[2], mat[0])); with aGLObject.Material.Texture do begin {TODO} // применять текущий масштаб + применение заданого пользователем // OK xScale := aObject.FTextureScale / 100; // 1; WH_koef := Image.Width / Image.Height; HW_koef := Image.Height / Image.Width; MappingMode := tmmObjectLinear; if Image.Width > Image.Height then begin MappingSCoordinates.AsVector := VectorMake(mat[0][0] * (1 / xScale) * HW_koef, mat[0][1] * (1 / xScale) * HW_koef, mat[0][2] * (1 / xScale) * HW_koef, 0); MappingTCoordinates.AsVector := VectorMake(mat[1][0] * (1 / xScale) * 1, mat[1][1] * (1 / xScale) * 1, mat[1][2] * (1 / xScale) * 1, 0); end else begin MappingSCoordinates.AsVector := VectorMake(mat[0][0] * (1 / xScale), mat[0][1] * (1 / xScale), mat[0][2] * (1 / xScale), 0); MappingTCoordinates.AsVector := VectorMake(mat[1][0] * (1 / xScale) * WH_koef, mat[1][1] * (1 / xScale) * WH_koef, mat[1][2] * (1 / xScale) * WH_koef, 0); end; end; f_find_other_GLObject := False; if aObject.FAsArc then begin //xSide := T3DSide(TTreeNode(xObj.TagObject).Data); while f_face_index < DummyCube.Count do begin if DummyCube.Children[f_face_index] <> f_GLObject then begin if (DummyCube.Children[f_face_index] is TGLPolygon) and (DummyCube.Children[f_face_index].TagObject <> nil) then begin if (T3DSide(TTreeNode(DummyCube.Children[f_face_index].TagObject).Data).FAsArc) and (DummyCube.Children[f_face_index].TagObject = f_GLObject.TagObject) and (DummyCube.Children[f_face_index].TagObject = f_first_Object.FFace.FTreeNode) then begin f_find_other_GLObject := True; aGLObject := TGLPolygon(DummyCube.Children[f_face_index]); //if tmpfname <> '' then begin aGLObject.Visible := f_GLObject.Visible; aGLObject.Material.Texture.Disabled := False; aGLObject.Material.Texture.MappingMode := tmmObjectLinear; aGLObject.Material.Texture.DestroyHandles; //aGLObject.Material.Texture.Image.LoadFromFile(tmpfname); aGLObject.Material.Texture.Image.Assign(TGLPolygon(f_GLObject).Material.Texture.Image); end; f_face_index := f_face_index + 1; break; end; end; end; f_face_index := f_face_index + 1; end; end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.RotateTextureToAngleP', E.Message); end; end; procedure Tfrm3D.SetPolygonTexture(aObject: TGLPolygon); var pN: TVector3f; mat: TAffineMatrix; vs0, vs1, vs2: TVector3f; VCoords: array [1..4] of TVector3f; begin try if aObject.Nodes.Count <= 4 then begin VCoords[1][0] := aObject.Nodes[0].x; VCoords[1][1] := aObject.Nodes[0].y; VCoords[1][2] := aObject.Nodes[0].z; VCoords[2][0] := aObject.Nodes[1].x; VCoords[2][1] := aObject.Nodes[1].y; VCoords[2][2] := aObject.Nodes[1].z; VCoords[3][0] := aObject.Nodes[2].x; VCoords[3][1] := aObject.Nodes[2].y; VCoords[3][2] := aObject.Nodes[2].z; VCoords[4][0] := aObject.Nodes[3].x; VCoords[4][1] := aObject.Nodes[3].y; VCoords[4][2] := aObject.Nodes[3].z; end else begin VCoords[1][0] := 0; VCoords[1][1] := 0; VCoords[1][2] := 0; VCoords[2][0] := 100; VCoords[2][1] := 0; VCoords[2][2] := 0; VCoords[3][0] := 100; VCoords[3][1] := 0; VCoords[3][2] := 100; VCoords[4][0] := 0; VCoords[4][1] := 0; VCoords[4][2] := 100; end; vs0 := VCoords[1]; vs1 := VCoords[2]; vs2 := VCoords[3]; pN := CalcPlaneNormal (vs0, vs1, vs2); SetVector (mat[2], pN); SetVector (mat[0], VectorNormalize (VectorSubtract (vs1, vs0))); SetVector (mat[1], VectorCrossProduct (mat[2], mat[0])); with aObject.Material.Texture do begin MappingMode := tmmObjectLinear; MappingSCoordinates.AsVector := VectorMake(mat[0][0], mat[0][1], mat[0][2], 0); MappingTCoordinates.AsVector := VectorMake(mat[1][0], mat[1][1], mat[1][2], 0); end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.SetPolygonTexture', E.Message); end; end; Function Tfrm3D.Rotate3DVector(vs0, vs1, vs2: TVector3f; Ang: Double): TVector3f; var osp: T3DPoint; nz, nx, ny: Double; r0, r1, r2: TDoublePoint; k: double; begin r0.x := vs0[0]; r0.y := vs0[2]; r0.z := vs0[1]; r1.x := vs1[0]; r1.y := vs1[2]; r1.z := vs1[1]; r2.x := vs2[0]; r2.y := vs2[2]; r2.z := vs2[1]; k := (Ang / 90); nx := r1.x - (r1.x - r2.x) * k; ny := r1.y - (r1.y - r2.y) * k; nz := r1.z - (r1.z - r2.z) * k; Result[0] := nx; Result[1] := nz; Result[2] := ny; end; function Tfrm3D.GetImageFileByHash(aHash: string): string; var i: integer; tmpdir, tmpfname, str: string; begin try Result := ''; if aHash <> '' then begin tmpdir := GetWorkDir; // ExtractDirByCategoryType(dctPictures); for i := 0 to F3DModel.FHashs.Count - 1 do begin str := F3DModel.FHashs.Strings[i]; if str = aHash then begin tmpfname := tmpdir + '\' + str + '.bmp'; if FileExists(tmpfname) then begin Result := tmpfname; exit; end; end; end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.GetImageFileByHash', E.Message); end; end; function Tfrm3D.GetTextureFileByHash(aHash: string): string; var i: integer; tmpdir, tmpfname, str: string; begin try Result := ''; if aHash <> '' then begin tmpdir := GetWorkDir; i := F3DModel.FFilesHashs.IndexOf(aHash); if i >= 0 then begin str := F3DModel.FFilesHashs.Strings[i]; tmpfname := tmpdir + '\' + str; if FileExists(tmpfname) then begin Result := tmpfname; exit; end; end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.GetTextureFileByHash', E.Message); end; end; procedure Tfrm3D.cbHashsPropertiesCloseUp(Sender: TObject); var i, Index: Integer; xObject: T3DSide; xGLObject: TGLBaseSceneObject; tmpdir, tmpfname, ExtStr, BmpFName: string; HashStr: string; begin try Index := cbSideHashs.ItemIndex; if Index >= 0 then begin HashStr := cbSideHashs.Properties.Items[Index]; tmpdir := GetWorkDir; //ExtractDirByCategoryType(dctPictures); tmpfname := GetImageFileByHash(HashStr); ExtStr := ExtractFileExt(tmpfname); if tmpfname <> '' then begin imgSideTexture.Picture.LoadFromFile(tmpfname); for i := 0 to FPropObjects.Count - 1 do begin if TOBject(TTreeNode(FPropObjects[i]).Data) is T3DSide then begin xObject := T3DSide(TTreeNode(FPropObjects[i]).Data); xGLObject := TGLBaseSceneObject(xObject.FGLObject); xObject.FTextureHash := HashStr; xObject.FTexture_ext := ExtStr; if (xGLObject is TGLPolygon) then begin TGLPolygon(xGLObject).Material.Texture.Disabled := False; TGLPolygon(xGLObject).Material.Texture.DestroyHandles; try TGLPolygon(xGLObject).Material.Texture.Image.LoadFromFile(tmpfname); except ShowMessage('File not found ' + tmpfname); end; RotateTextureToAngleP(xObject, TGLPolygon(xGLObject), xObject.FTextureRotate, xObject.FMirror); // TGLPolygon(xGLObject).Material.Texture.ApplyMappingMode; // TGLPolygon(xGLObject).Material.Texture.TexHeight := 100; // TGLPolygon(xGLObject).Material.Texture.TexWidth := 100; end; end; end; end end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.cbHashsPropertiesCloseUp', E.Message); end; end; procedure Tfrm3D.nAdd3DObjectClick(Sender: TObject); var i, j: integer; FName: string; xNode, xSubNode: TTreeNode; xRoom: T3DRoom; xObject: T3DSObject; glObjClass: TGLSceneObjectClass; glObject: TGLFreeForm; ObjectMin, ObjectMax, RoomMin, RoomMax, ObjSize, RoomSize, SetPos, Scale: T3DPoint; SetScale: Double; tmpdir, tmpfname: string; HashStr: string; //Tolik 20/10/2018 -- Odlg: TOpen3dsModelDialog; ComponGroupObject1, ComponGroupObject2: TGLDummyCube; // begin try Odlg := TOpen3dsModelDialog.Create(Self); if ModelTree.SelectionCount = 1 then begin xNode := ModelTree.Selections[0]; //Open3DObject.InitialDir := ExeDir + '\3DModels'; Odlg.InitialDir := ExeDir + '\3DModels'; NoMoveEvent := True; if Odlg.Execute then //if Open3DObject.Execute then begin // это можно не делать! //tmpdir := AddCreateDirToPath(ExtractFileDir(Application.ExeName), dnSave); //CopyFile(PChar(Open3DObject.FileName), PChar(tmpdir + '\' + ExtractFileName(Open3DObject.FileName)), True); //if FileExists(tmpdir + '\' + ExtractFileName(Open3DObject.FileName)) then // FName := tmpdir + '\' + ExtractFileName(Open3DObject.FileName) //else //FName := Open3DObject.FileName; FName := Odlg.FileName; FTextureFileName := FName; // Tolik 03/12/2018 -- xRoom := T3DRoom(xNode.Data); tmpdir := GetWorkDir; //ExtractDirByCategoryType(dctPictures); // MARK // получаем HASH по загружаемому файлу HashStr := GetObjectHash(FName); // по HASH ищем есть ли он в нашей базе tmpfname := GetObjectFileByHash(HashStr); // если найден, то грузим его if tmpfname <> '' then begin end else // не найден - создаем для файла HASH, копируем в темп, грузим begin F3DModel.F3DSHashs.Add(HashStr); tmpfname := tmpdir + '\' + HashStr + '.3ds'; CopyFile(PChar(FName), PChar(tmpfname), True); end; // MARK BeginProgress('Идет загрузка 3ds объекта ...'); // *** // создать обьект на GLScene glObjClass := TGLFreeForm; glObject := TGLFreeForm(DummyCube.AddNewChild(glObjClass)); glObject.Material.Texture.Disabled := False; glObject.MaterialLibrary := MatLib; xObject := T3DSObject.Create(xRoom); // FTextures.Clear; FisCreate3DS := True; FCurrObject := xObject; //glObject.LoadFromFile(FName); xObject.FObjectHash := HashStr; //glObject.UseMeshMaterials := True; glObject.LoadFromFile(tmpfname); //glObject.BuildOctree; //тормоза //glObject.StructureChanged; {TODO - перепроверить - возможно и нужно это делать! } //for i := 0 to MatLib.Materials.Count - 1 do // MatLib.Materials[i].Material.Texture.MappingMode := tmmCubeMapCamera; Get3DSObjectBounds(ObjectMin, ObjectMax, glObject); GetRoomBounds(RoomMin, RoomMax, xRoom.FFloor.FGLPoints, xRoom.FCeiling.FGLPoints); ObjSize.x := abs(ObjectMax.x - ObjectMin.x); ObjSize.y := abs(ObjectMax.y - ObjectMin.y); ObjSize.z := abs(ObjectMax.z - ObjectMin.z); RoomSize.x := abs(RoomMax.x - RoomMin.x); RoomSize.y := abs(RoomMax.y - RoomMin.y); RoomSize.z := abs(RoomMax.z - RoomMin.z); SetPos.x := abs(RoomMax.x + RoomMin.x) / 2; SetPos.y := RoomMin.y + FDeltaZFloor; //abs(RoomMax.y + RoomMin.y) / 2; SetPos.z := abs(RoomMax.z + RoomMin.z) / 2; Scale.X := RoomSize.x / ObjSize.x; Scale.Y := RoomSize.y / ObjSize.y; Scale.Z := RoomSize.z / ObjSize.z; SetScale := MinFloat(Scale.X, Scale.Y, Scale.Z); //if SetScale > 1 then // SetScale := 1; glObject.Position.x := SetPos.x; glObject.Position.y := SetPos.y; glObject.Position.z := SetPos.z; glObject.Scale.X := SetScale; glObject.Scale.Y := SetScale; glObject.Scale.Z := SetScale; if glObject.Material.Texture.Disabled then begin glObject.Material.FrontProperties.Ambient.Color := ObjColor; glObject.Material.FrontProperties.Diffuse.Color := ObjColor; glObject.Material.FrontProperties.Emission.Color := ObjColor; glObject.Material.BackProperties.Ambient.Color := ObjColor; glObject.Material.BackProperties.Diffuse.Color := ObjColor; glObject.Material.BackProperties.Emission.Color := ObjColor; end; // ЭТО ДЕЛАТЬ НЕЛЬЗЯ НА 3Д моделях! //glObject.Material.Texture.MappingMode := tmmCubeMapCamera; //// glObject.BuildOctree; тормоза //glObject.Material.MaterialOptions := [moNoLighting]; glObject.Material.MaterialOptions := []; glObject.Material.Texture.Disabled := False; // создать объект в классе xObject.FZOrder := xObject.FParent.FZOrder; //xObject.FName := ExtractFileName(FName); // запишем лучше полный путь к файлу что бы на получении текстур юзать путь! xObject.FName := FName; xObject.FPosition.x := glObject.Position.X; xObject.FPosition.y := glObject.Position.Y - xObject.FZOrder; xObject.FPosition.z := glObject.Position.Z; xObject.FScale.x := glObject.Scale.X; xObject.FScale.y := glObject.Scale.Y; xObject.FScale.z := glObject.Scale.Z; xObject.FGLObject := glObject; xRoom.F3DSObjects.Add(xObject); // создать Нод в дереве xSubNode := ModelTree.Items.AddChild(xNode, xObject.FName); xSubNode.Data := xObject; xSubNode.ImageIndex := 42; xSubNode.SelectedIndex := xSubNode.ImageIndex; glObject.TagObject := xSubNode; ComponGroupObject2 := TglDummyCube(DummyCube.AddNewChild(TglDummyCube)); ComponGroupObject1 := TglDummyCube(DummyCube.AddNewChild(TglDummyCube)); //ComponGroupObject2.Parent := ComponGroupObject; ComponGroupObject2.Position.X := TGLFreeForm(gLObject).Position.x; ComponGroupObject2.Position.Y := TGLFreeForm(gLObject).Position.y; ComponGroupObject2.Position.Z := TGLFreeForm(gLObject).Position.z; //ComponGroupObject2.Name := 'ComponGroupObject2'; ComponGroupObject1.Parent := ComponGroupObject2; ComponGroupObject1.Position.X := 0; ComponGroupObject1.Position.Y := 0; ComponGroupObject1.Position.Z := 0; //ComponGroupObject1.Name := 'ComponGroupObject1'; TGLFreeForm(gLObject).Position.x := 0; TGLFreeForm(gLObject).Position.y := 0; TGLFreeForm(gLObject).Position.z := 0; TGLFreeForm(gLObject).Parent := ComponGroupObject1; Rotate3DSObj(TGLFreeForm(gLObject), 0, 0, -45); end; Odlg.free; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.nAdd3DObjectClick', E.Message); end; EndProgress; end; procedure Tfrm3D.ModelTreeMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var i: Integer; xNode: TTreeNode; begin {$if Defined(ES_GRAPH_SC)} if (Button = mbRight) then begin if ModelTree.SelectionCount = 1 then begin xNode := ModelTree.Selections[0]; if (TObject(xNode.Data) is T3DRoom) then begin pmModelTree.Items[0].Visible := True; pmModelTree.Items[1].Visible := False; pmModelTree.Items[2].Visible := False; pmModelTree.Popup(X, Y); end; if (FToolMode = tmSelect) and (TObject(xNode.Data) is T3DSide) and (T3DSide(xNode.Data).FSubSides.Count > 0) then begin pmModelTree.Items[0].Visible := False; pmModelTree.Items[1].Visible := True; pmModelTree.Items[2].Visible := False; pmModelTree.Popup(X, Y); end; if (TObject(xNode.Data) is T3DSObject) then begin pmModelTree.Items[0].Visible := False; pmModelTree.Items[1].Visible := False; pmModelTree.Items[2].Visible := True; pmModelTree.Popup(X, Y); end; end; end; {$else} // Tolik 31/08/2018 -- SKS !!! if (TGLMouseButton(Button) = mbRight) then begin { Self.ModelTree.ClearSelection; xNode := ModelTree.GetNodeAt(X - ModelTree.Left, Y - ModelTree.Top); if xNode <> nil then ModelTree.Select(xNode);} if ModelTree.SelectionCount = 1 then begin xNode := ModelTree.Selections[0]; if xNode <> ModelTree.Selected then begin xNode := ModelTree.Selected; ModelTree.ClearSelection; ModelTree.Select(xNode); ModelTree.OnClick(ModelTree); end; if (TObject(xNode.Data) is T3DRoom) then begin pmModelTree.Items[0].Visible := True; //pmModelTree.Items[0].Visible := False; // Tolik 22/01/2019 -- pmModelTree.Items[1].Visible := False; pmModelTree.Items[2].Visible := False; pmModelTree.Items[3].Visible := True; // Tolik 02/09/2019 -- //pmModelTree.Popup(X, Y); pmModelTree.Popup(Mouse.CursorPos.X, Mouse.CursorPos.Y); // end else if (FToolMode = tmSelect) and (TObject(xNode.Data) is T3DSide) and (T3DSide(xNode.Data).FSubSides.Count > 0) then begin pmModelTree.Items[0].Visible := False; pmModelTree.Items[1].Visible := True; pmModelTree.Items[2].Visible := False; pmModelTree.Items[3].Visible := True; // Tolik 02/09/2019 -- //pmModelTree.Popup(X, Y); pmModelTree.Popup(Mouse.CursorPos.X, Mouse.CursorPos.Y); // end else if (TObject(xNode.Data) is T3DSObject) then begin pmModelTree.Items[0].Visible := False; pmModelTree.Items[1].Visible := False; pmModelTree.Items[2].Visible := True; //pmModelTree.Items[2].Visible := False; // Tolik 22/01/2019 -- pmModelTree.Items[3].Visible := True; // Tolik 02/09/2019 -- //pmModelTree.Popup(X, Y); pmModelTree.Popup(Mouse.CursorPos.X, Mouse.CursorPos.Y); // end else begin pmModelTree.Items[0].Visible := False; pmModelTree.Items[1].Visible := False; pmModelTree.Items[2].Visible := False; pmModelTree.Items[3].Visible := True; // Tolik 02/09/2019 -- //pmModelTree.Popup(X, Y); pmModelTree.Popup(Mouse.CursorPos.X, Mouse.CursorPos.Y); // end; end; end; {$ifEnd} end; procedure Tfrm3D.ChangeAngleX; var i: integer; xObject: TObject; x3dsObject: T3DSObject; xConn: T3DConnector; xGLObject, xGLObject1: TGLBaseSceneObject; // Tolik 13/12/2018 -- OldPos: TDoublePoint; ComponObj: TGLFreeForm; RotateAngle: TDoublePoint; RMatrix: TMatrix; ComponGroupObject: TGLDummyCube; //ComponGroupObject: TGLFreeForm; AbsVector, AbsUpVector: TVector4F; ObjMatrix : TMatrix; // begin try if (pcProps.ActivePage = TabArchProps) and (edAngleX.Text = '') then exit; if (pcProps.ActivePage = TabScsProps) and (edScsAngleX.Text = '') then exit; for i := 0 to FPropObjects.Count - 1 do begin xObject := TObject(TTreeNode(FPropObjects[i]).Data); if xObject is T3DSObject then begin x3dsObject := T3DSObject(xObject); xGLObject := TGLBaseSceneObject(x3dsObject.FGLObject); x3dsObject.FRotate.x := StrToFloat_My(edAngleX.Text); if (xGLObject is TGLFreeForm) then begin Rotate3DSObj(TGLFreeForm(xGLObject), x3dsObject.FRotate.x, x3dsObject.FRotate.y, x3dsObject.FRotate.z); end; end else // Tolik 13/12/2018 -- //if xObject is T3DConnector then if xObject.ClassNAme = 'T3DConnector' then // begin xConn := T3DConnector(xObject); xGLObject := TGLBaseSceneObject(xConn.FGLObject); xGLObject1 := TGLBaseSceneObject(xConn.FGLObject1); xConn.FRotate.x := StrToFloat_My(edScsAngleX.Text); RotateConnModel(TGLFreeForm(xGLObject1), xConn.FRotate.x, xConn.FRotate.y, xConn.FRotate.z); end // Tolik 13/12/2018 -- else if xObject.ClassName = 'T3DComponent' then begin //Tolik 13/12/2018 -- if edSCSAngleX.Text <> '' then if edSCSAngleY.Text <> '' then if edSCSAngleZ.Text <> '' then begin Rotate3DComponent(T3DComponent(xObject)); end; end; // end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.ChangeAngleX', E.Message); end; end; procedure Tfrm3D.ChangeAngleY; var i: integer; xObject: TObject; x3dsObject: T3DSObject; xConn: T3DConnector; xGLObject, xGLObject1: TGLBaseSceneObject; // Tolik 13/12/2018 -- ComponObj: TGLFreeForm; //RotateAngle: Double; RotateAngle: TDoublePoint; ComponGroupObject: TGLDummyCube; //ComponGroupObject: TGLFreeForm; AbsVector, AbsUpVector: TVector4F; ObjMatrix : TMatrix; // // begin try if (pcProps.ActivePage = TabArchProps) and (edAngleY.Text = '') then exit; if (pcProps.ActivePage = TabScsProps) and (edScsAngleY.Text = '') then exit; for i := 0 to FPropObjects.Count - 1 do begin xObject := TObject(TTreeNode(FPropObjects[i]).Data); if xObject is T3DSObject then begin x3dsObject := T3DSObject(xObject); xGLObject := TGLBaseSceneObject(x3dsObject.FGLObject); x3dsObject.FRotate.y := StrToFloat_My(edAngleY.Text); if (xGLObject is TGLFreeForm) then begin Rotate3DSObj(TGLFreeForm(xGLObject), x3dsObject.FRotate.x, x3dsObject.FRotate.y, x3dsObject.FRotate.z); end; end; // Tolik 13/12/2018 -- //if xObject is T3DConnector then if xObject.ClassName = 'T3DConnector' then // begin xConn := T3DConnector(xObject); xGLObject := TGLBaseSceneObject(xConn.FGLObject); xGLObject1 := TGLBaseSceneObject(xConn.FGLObject1); xConn.FRotate.y := StrToFloat_My(edScsAngleY.Text); RotateConnModel(TGLFreeForm(xGLObject1), xConn.FRotate.x, xConn.FRotate.y, xConn.FRotate.z); end; // Tolik 13/12/2018 -- if xObject.ClassName = 'T3DComponent' then begin if edSCSAngleX.Text <> '' then if edSCSAngleY.Text <> '' then if edSCSAngleZ.Text <> '' then Rotate3DComponent(T3DComponent(xObject)); end; (* if xObject.ClassName = 'T3DComponent' then begin //Tolik 13/12/2018 -- if edAngleX.Text <> '' then if edAngleY.Text <> '' then if edAngleZ.Text <> '' then begin if T3DComponent(xObject).FglObject <> nil then begin ComponObj := TGLFreeForm(T3DComponent(xObject).FglObject); {DummyCube.BeginUpdate; OldPos.x := ComponObj.Position.X; OldPos.y := ComponObj.Position.Y; OldPos.z := ComponObj.Position.Z; DummyCube.Remove(ComponObj, False); ComponObj.Position.x := 0; ComponObj.Position.y := 0; ComponObj.Position.z := 0;} //ComponObj.ResetRotations; //ComponObj.RotateAbsolute(StrToFloat_My(edAngleX.Text) - ComponObj.Rotation.x, StrToFloat_My(edAngleY.Text) - ComponObj.Rotation.y, StrToFloat_My(edAngleZ.Text) - ComponObj.Rotation.z); //ComponObj.Roll(-90); RotateAngle := (StrToFloat_My(edScsAngleY.Text) - ComponObj.Rotation.Y); if RotateAngle <> 0 then ComponObj.Turn(RotateAngle); { ComponObj.Rotation.X := (StrToFloat_My(edAngleX.Text) - ComponObj.Rotation.X); ComponObj.Rotation.Y := (StrToFloat_My(edAngleY.Text) - ComponObj.Rotation.Y); ComponObj.Rotation.Z := (StrToFloat_My(edAngleZ.Text) - ComponObj.Rotation.Z); } { ComponObj.Rotation.X := ComponObj.Rotation.X + (StrToFloat_My(edAngleX.Text) - ComponObj.Rotation.X); ComponObj.Rotation.Y := ComponObj.Rotation.Y + (StrToFloat_My(edAngleY.Text) - ComponObj.Rotation.Y); ComponObj.Rotation.Z := ComponObj.Rotation.Z + (StrToFloat_My(edAngleZ.Text) - ComponObj.Rotation.Z); } {ComponObj.Position.x := OldPos.x; ComponObj.Position.y := OldPos.y; ComponObj.Position.z := OldPos.z;} // DummyCube.AddChild(ComponObj); // DummyCube.EndUpdate; end; end; end;*) // end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.ChangeAngleY', E.Message); end; end; procedure Tfrm3D.ChangeAngleZ; var i: integer; xObject: TObject; x3dsObject: T3DSObject; xConn: T3DConnector; xGLObject, xGLObject1: TGLBaseSceneObject; // Tolik 13/12/2018 -- ComponObj: TGLFreeForm; //RotateAngle: Double; RotateAngle: TDoublePoint; ComponGroupObject: TGLDummyCube; //ComponGroupObject: TGLFreeForm; AbsVector, AbsUpVector: TVector4F; ObjMatrix : TMatrix; GroupObject: TGLDummyCube; // // begin try if (pcProps.ActivePage = TabArchProps) and (edAngleZ.Text = '') then exit; if (pcProps.ActivePage = TabScsProps) and (edScsAngleZ.Text = '') then exit; for i := 0 to FPropObjects.Count - 1 do begin xObject := TObject(TTreeNode(FPropObjects[i]).Data); if xObject is T3DSObject then begin x3dsObject := T3DSObject(xObject); xGLObject := TGLBaseSceneObject(x3dsObject.FGLObject); x3dsObject.FRotate.Z := StrToFloat_My(edAngleZ.Text); if (xGLObject is TGLFreeForm) then begin Rotate3DSObj(TGLFreeForm(xGLObject), x3dsObject.FRotate.x, x3dsObject.FRotate.y, x3dsObject.FRotate.z); end; end; // Tolik 13/12/2018 -- //if xObject is T3DConnector then if xObject.ClassName = 'T3DConnector' then // begin xConn := T3DConnector(xObject); if TTreeNode(FPropObjects[i]).Count = 0 then begin xGLObject := TGLBaseSceneObject(xConn.FGLObject); xGLObject1 := TGLBaseSceneObject(xConn.FGLObject1); xConn.FRotate.Z := StrToFloat_My(edScsAngleZ.Text); RotateConnModel(TGLFreeForm(xGLObject1), xConn.FRotate.x, xConn.FRotate.y, xConn.FRotate.z); end else begin if TObject(xConn.FGLObject).ClassName = 'TGLDummyCube' then begin GroupObject := TGLDummyCube(xConn.FGLObject); if xConn.FRotate.z <> 0 then GroupObject.TurnAngle := 0;//(-1)*xConn.FRotate.z; GroupObject.TurnAngle := StrToFloat_My(edScsAngleZ.Text); xConn.FRotate.z := StrToFloat_My(edScsAngleZ.Text); end; end; end; //Tolik 13/12/2018 -- if xObject.ClassName = 'T3DComponent' then begin if edSCSAngleX.Text <> '' then if edSCSAngleY.Text <> '' then if edSCSAngleZ.Text <> '' then Rotate3DComponent(T3DComponent(xObject)); end; { if xObject.ClassName = 'T3DComponent' then begin if edAngleX.Text <> '' then if edAngleY.Text <> '' then if edAngleZ.Text <> '' then begin if T3DComponent(xObject).FglObject <> nil then begin ComponObj := TGLFreeForm(T3DComponent(xObject).FglObject); RotateAngle := (StrToFloat_My(edSCSAngleZ.Text) - ComponObj.Rotation.Z); if RotateAngle <> 0 then begin ComponObj.Roll(0); ComponObj.Roll(RotateAngle); end; end; end; end;} // end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.ChangeAngleZ', E.Message); end; end; procedure Tfrm3D.ChangePosX; var i: integer; xObject: TObject; x3dsObject: T3DSObject; xConn: T3DConnector; xGLObject, xGLObject1: TGLBaseSceneObject; begin try if (pcProps.ActivePage = TabArchProps) and (edPosX.Text = '') then exit; if (pcProps.ActivePage = TabScsProps) and (edScsOffsetX.Text = '') then exit; for i := 0 to FPropObjects.Count - 1 do begin xObject := TObject(TTreeNode(FPropObjects[i]).Data); if xObject is T3DSObject then begin x3dsObject := T3DSObject(xObject); xGLObject := TGLBaseSceneObject(x3dsObject.FGLObject); x3dsObject.FPosition.x := StrToFloat_My(edPosX.Text); if (xGLObject is TGLFreeForm) then begin TGLFreeForm(xGLObject).Position.X := StrToFloat_My(edPosX.Text); end; end; if xObject is T3DConnector then begin xConn := T3DConnector(xObject); xGLObject := TGLBaseSceneObject(xConn.FGLObject); xGLObject1 := TGLBaseSceneObject(xConn.FGLObject1); TGLFreeForm(xGLObject1).Position.X := xConn.FGLPoint.x + StrToFloat_My(edScsOffsetX.Text); xConn.FOffset.x := StrToFloat_My(edScsOffsetX.Text) / Factor; end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.ChangePosX', E.Message); end; end; procedure Tfrm3D.ChangePosY; var i: integer; xObject: TObject; x3dsObject: T3DSObject; xConn: T3DConnector; xGLObject, xGLObject1: TGLBaseSceneObject; begin try if (pcProps.ActivePage = TabArchProps) and (edPosY.Text = '') then exit; if (pcProps.ActivePage = TabScsProps) and (edScsOffsetY.Text = '') then exit; for i := 0 to FPropObjects.Count - 1 do begin xObject := TObject(TTreeNode(FPropObjects[i]).Data); if xObject is T3DSObject then begin x3dsObject := T3DSObject(xObject); xGLObject := TGLBaseSceneObject(x3dsObject.FGLObject); x3dsObject.FPosition.y := StrToFloat_My(edPosY.Text); if (xGLObject is TGLFreeForm) then begin TGLFreeForm(xGLObject).Position.Y := StrToFloat_My(edPosY.Text); end; end; if xObject is T3DConnector then begin xConn := T3DConnector(xObject); xGLObject := TGLBaseSceneObject(xConn.FGLObject); xGLObject1 := TGLBaseSceneObject(xConn.FGLObject1); TGLFreeForm(xGLObject1).Position.Y := xConn.FGLPoint.y + StrToFloat_My(edScsOffsetY.Text); xConn.FOffset.y := StrToFloat_My(edScsOffsetY.Text) / Factor; end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.ChangePosY', E.Message); end; end; procedure Tfrm3D.ChangePosZ; var i: integer; xObject: TObject; x3dsObject: T3DSObject; xConn: T3DConnector; xGLObject, xGLObject1: TGLBaseSceneObject; begin try if (pcProps.ActivePage = TabArchProps) and (edPosZ.Text = '') then exit; if (pcProps.ActivePage = TabScsProps) and (edScsOffsetZ.Text = '') then exit; for i := 0 to FPropObjects.Count - 1 do begin xObject := TObject(TTreeNode(FPropObjects[i]).Data); if xObject is T3DSObject then begin x3dsObject := T3DSObject(xObject); xGLObject := TGLBaseSceneObject(x3dsObject.FGLObject); x3dsObject.FPosition.z := StrToFloat_My(edPosZ.Text); if (xGLObject is TGLFreeForm) then begin TGLFreeForm(xGLObject).Position.Z := StrToFloat_My(edPosZ.Text); end; end; if xObject is T3DConnector then begin xConn := T3DConnector(xObject); xGLObject := TGLBaseSceneObject(xConn.FGLObject); xGLObject1 := TGLBaseSceneObject(xConn.FGLObject1); TGLFreeForm(xGLObject1).Position.Z := xConn.FGLPoint.z + StrToFloat_My(edScsOffsetZ.Text); xConn.FOffset.Z := StrToFloat_My(edScsOffsetZ.Text) / Factor; end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.ChangePosZ', E.Message); end; end; procedure Tfrm3D.ChangeScaleX; var i: integer; xObject: TObject; x3dsObject: T3DSObject; xConn: T3DConnector; xGLObject, xGLObject1: TGLBaseSceneObject; begin try if (pcProps.ActivePage = TabArchProps) and (edScaleX.Text = '') then exit; if (pcProps.ActivePage = TabScsProps) and (edScsScaleX.Text = '') then exit; for i := 0 to FPropObjects.Count - 1 do begin xObject := TObject(TTreeNode(FPropObjects[i]).Data); if xObject is T3DSObject then begin x3dsObject := T3DSObject(xObject); xGLObject := TGLBaseSceneObject(x3dsObject.FGLObject); x3dsObject.FScale.x := StrToFloat_My(edScaleX.Text); if (xGLObject is TGLFreeForm) then begin TGLFreeForm(xGLObject).Scale.X := StrToFloat_My(edScaleX.Text); end; end; if xObject is T3DConnector then begin xConn := T3DConnector(xObject); xGLObject := TGLBaseSceneObject(xConn.FGLObject); xGLObject1 := TGLBaseSceneObject(xConn.FGLObject1); xConn.FScale.x := StrToFloat_My(edScsScaleX.Text); TGLFreeForm(xGLObject1).Scale.X := StrToFloat_My(edScsScaleX.Text); end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.ChangeScaleX', E.Message); end; end; procedure Tfrm3D.ChangeScaleY; var i: integer; xObject: TObject; x3dsObject: T3DSObject; xConn: T3DConnector; xGLObject, xGLObject1: TGLBaseSceneObject; begin try if (pcProps.ActivePage = TabArchProps) and (edScaleY.Text = '') then exit; if (pcProps.ActivePage = TabScsProps) and (edScsScaleY.Text = '') then exit; for i := 0 to FPropObjects.Count - 1 do begin xObject := TObject(TTreeNode(FPropObjects[i]).Data); if xObject is T3DSObject then begin x3dsObject := T3DSObject(xObject); xGLObject := TGLBaseSceneObject(x3dsObject.FGLObject); x3dsObject.FScale.y := StrToFloat_My(edScaleY.Text); if (xGLObject is TGLFreeForm) then begin TGLFreeForm(xGLObject).Scale.Y := StrToFloat_My(edScaleY.Text); end; end; if xObject is T3DConnector then begin xConn := T3DConnector(xObject); xGLObject := TGLBaseSceneObject(xConn.FGLObject); xGLObject1 := TGLBaseSceneObject(xConn.FGLObject1); xConn.FScale.y := StrToFloat_My(edScsScaleY.Text); TGLFreeForm(xGLObject1).Scale.Y := StrToFloat_My(edScsScaleY.Text); end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.ChangeScaleY', E.Message); end; end; procedure Tfrm3D.ChangeScaleZ; var i: integer; xObject: TObject; x3dsObject: T3DSObject; xConn: T3DConnector; xGLObject, xGLObject1: TGLBaseSceneObject; begin try if (pcProps.ActivePage = TabArchProps) and (edScaleZ.Text = '') then exit; if (pcProps.ActivePage = TabScsProps) and (edScsScaleZ.Text = '') then exit; for i := 0 to FPropObjects.Count - 1 do begin xObject := TObject(TTreeNode(FPropObjects[i]).Data); if xObject is T3DSObject then begin x3dsObject := T3DSObject(xObject); xGLObject := TGLBaseSceneObject(x3dsObject.FGLObject); x3dsObject.FScale.z := StrToFloat_My(edScaleZ.Text); if (xGLObject is TGLFreeForm) then begin TGLFreeForm(xGLObject).Scale.Z := StrToFloat_My(edScaleZ.Text); end; end; if xObject is T3DConnector then begin xConn := T3DConnector(xObject); xGLObject := TGLBaseSceneObject(xConn.FGLObject); xGLObject1 := TGLBaseSceneObject(xConn.FGLObject1); xConn.FScale.z := StrToFloat_My(edScsScaleZ.Text); TGLFreeForm(xGLObject1).Scale.Z := StrToFloat_My(edScsScaleZ.Text); end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.ChangeScaleZ', E.Message); end; end; procedure Tfrm3D.edPosXExit(Sender: TObject); begin ChangePosX; end; procedure Tfrm3D.edPosYExit(Sender: TObject); begin ChangePosY; end; procedure Tfrm3D.edPosZExit(Sender: TObject); begin ChangePosZ; end; procedure Tfrm3D.edAngleXExit(Sender: TObject); begin ChangeAngleX; end; procedure Tfrm3D.edAngleYExit(Sender: TObject); begin ChangeAngleY; end; procedure Tfrm3D.edAngleZExit(Sender: TObject); begin ChangeAngleZ; end; procedure Tfrm3D.edScaleXExit(Sender: TObject); begin ChangeScaleX; end; procedure Tfrm3D.edScaleYExit(Sender: TObject); begin ChangeScaleY; end; procedure Tfrm3D.edScaleZExit(Sender: TObject); begin ChangeScaleZ; end; procedure Tfrm3D.edPosXKeyPress(Sender: TObject; var Key: Char); begin if Key = #13 then ChangePosX; end; procedure Tfrm3D.edPosYKeyPress(Sender: TObject; var Key: Char); begin if Key = #13 then ChangePosY; end; procedure Tfrm3D.edPosZKeyPress(Sender: TObject; var Key: Char); begin if Key = #13 then ChangePosZ; end; procedure Tfrm3D.edAngleXKeyPress(Sender: TObject; var Key: Char); begin if Key = #13 then ChangeAngleX; end; procedure Tfrm3D.edAngleYKeyPress(Sender: TObject; var Key: Char); begin if Key = #13 then ChangeAngleY; end; procedure Tfrm3D.edAngleZKeyPress(Sender: TObject; var Key: Char); begin if Key = #13 then ChangeAngleZ; end; procedure Tfrm3D.edScaleXKeyPress(Sender: TObject; var Key: Char); begin if Key = #13 then ChangeScaleX; end; procedure Tfrm3D.edScaleYKeyPress(Sender: TObject; var Key: Char); begin if Key = #13 then ChangeScaleY; end; procedure Tfrm3D.edScaleZKeyPress(Sender: TObject; var Key: Char); begin if Key = #13 then ChangeScaleZ; end; procedure Tfrm3D.SetAllPanels(aStatus: Boolean); begin {$IF Defined(ES_GRAPH_SC)} panName.Visible := aStatus; panDesc.Visible := aStatus; // panCoords.Visible := aStatus; panRotate.Visible := aStatus; panMirror.Visible := aStatus; panSideTexture.Visible := aStatus; //panPos3ds.Visible := aStatus; panRotate3ds.Visible := aStatus; panScale3ds.Visible := aStatus; panObjectTexture.Visible := aStatus; {$IFEND} end; procedure Tfrm3D.SetAllScsPanels(aStatus: Boolean); begin {$IF Defined(ES_GRAPH_SC)} panScsName.Visible := aStatus; panScsDesc.Visible := aStatus; panScsLength.Visible := aStatus; panScsConnCoords.Visible := aStatus; panScsLineCoords.Visible := aStatus; panScsOffset.Visible := aStatus; panScsRotate.Visible := aStatus; panScsScale.Visible := aStatus; panScsObjectTexture.Visible := aStatus; {$IFEND} end; //Tolik 01/10/2018 -- procedure Tfrm3D.Get3DSObjectBounds(var Min, Max: T3DPoint; aObject: TGLFreeForm; aReplaceYZ: Boolean = False); var i: Integer; Bounds: THmgBoundingBox; Coord: TVector4f; begin try Bounds := aObject.BoundingBox; for i := 0 to 7 do begin Coord := Bounds[i]; if i = 0 then begin if aReplaceYZ then begin Min.x := Coord[0]; Min.z := Coord[1]; Min.y := Coord[2]; Max.x := Coord[0]; Max.z := Coord[1]; Max.y := Coord[2]; end else begin Min.x := Coord[0]; Min.y := Coord[1]; Min.z := Coord[2]; Max.x := Coord[0]; Max.y := Coord[1]; Max.z := Coord[2]; end; end else begin if aReplaceYZ then begin if Coord[0] < Min.x then Min.x := Coord[0]; if Coord[0] > Max.x then Max.x := Coord[0]; if Coord[1] < Min.z then Min.z := Coord[1]; if Coord[1] > Max.z then Max.z := Coord[1]; if Coord[2] < Min.y then Min.y := Coord[2]; if Coord[2] > Max.y then Max.y := Coord[2]; end else begin if Coord[0] < Min.x then Min.x := Coord[0]; if Coord[0] > Max.x then Max.x := Coord[0]; if Coord[1] < Min.y then Min.y := Coord[1]; if Coord[1] > Max.y then Max.y := Coord[1]; if Coord[2] < Min.z then Min.z := Coord[2]; if Coord[2] > Max.z then Max.z := Coord[2]; end; end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.Get3DSObjectBounds', E.Message); end; end; { procedure Tfrm3D.Get3DSObjectBounds(var Min, Max: T3DPoint; aObject: TGLFreeForm); var i: Integer; Bounds: THmgBoundingBox; Coord: TVector4f; begin try Bounds := aObject.BoundingBox; for i := 0 to 7 do begin Coord := Bounds[i]; if i = 0 then begin Min.x := Coord[0]; Min.y := Coord[1]; Min.z := Coord[2]; Max.x := Coord[0]; Max.y := Coord[1]; Max.z := Coord[2]; end else begin if Coord[0] < Min.x then Min.x := Coord[0]; if Coord[0] > Max.x then Max.x := Coord[0]; if Coord[1] < Min.y then Min.y := Coord[1]; if Coord[1] > Max.y then Max.y := Coord[1]; if Coord[2] < Min.z then Min.z := Coord[2]; if Coord[2] > Max.z then Max.z := Coord[2]; end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.Get3DSObjectBounds', E.Message); end; end; } procedure Tfrm3D.GetRoomBounds(var Min, Max: T3DPoint; aFloor, aCeiling: T3DPointArray); var i: Integer; Bounds: THmgBoundingBox; Coord1, Coord2: T3DPoint; begin try for i := 0 to Length(aFloor) - 1 do begin Coord1.x := aFloor[i].X; Coord1.y := aFloor[i].Y; Coord1.z := aFloor[i].Z; Coord2.x := aCeiling[i].X; Coord2.y := aCeiling[i].Y; Coord2.z := aCeiling[i].Z; if i = 0 then begin Min.x := Coord1.x; Min.y := Coord1.y; Min.z := Coord1.z; Max.x := Coord1.x; Max.y := Coord2.y; Max.z := Coord1.z; end else begin if Coord1.x < Min.x then Min.x := Coord1.x; if Coord1.x > Max.x then Max.x := Coord1.x; if Coord1.y < Min.y then Min.y := Coord1.y; if Coord2.y > Max.y then Max.y := Coord2.y; if Coord1.z < Min.z then Min.z := Coord1.z; if Coord1.z > Max.z then Max.z := Coord1.z; end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.GetRoomBounds', E.Message); end; end; procedure Tfrm3D.CreateNodesObjects(aObj: TGLPolygon); var i: integer; xObj: TGLSpaceText; cpos, pos, Camera: T3DPoint; SetPos: T3DPoint; delta, offset, koef, len: double; ang: double; coord1, coord2: TDoublePoint; xSide: T3DSide; begin try xSide := T3DSide(TTreeNode(aObj.TagObject).Data); delta := 0.2; if xSide.FFaceType in [ftNetFloor, ftNetCeiling] then offset := 0.8 else offset := 0.5; Camera.x := GLSceneViewer.Camera.Position.x; Camera.y := GLSceneViewer.Camera.Position.y; Camera.z := GLSceneViewer.Camera.Position.z; if FNodesObjectsList.Count > 0 then DeleteNodesObjects; cpos := DoublePoint(0, 0, 0); for i := 0 to aObj.Nodes.Count - 1 do cpos := DoublePoint(cpos.x + aObj.Nodes[i].x, cpos.y + aObj.Nodes[i].y, cpos.z + aObj.Nodes[i].z); cpos := DoublePoint(cpos.x / aObj.Nodes.Count, cpos.y / aObj.Nodes.Count, cpos.z / aObj.Nodes.Count); for i := 0 to aObj.Nodes.Count - 1 do begin xObj := TGLSpaceText(DummyCube.AddNewChild(TGLSpaceText)); pos.x := aObj.Nodes[i].x; pos.y := aObj.Nodes[i].y; pos.z := aObj.Nodes[i].z; len := SQRT(SQR(cpos.x - pos.x) + SQR(cpos.y - pos.y) + SQR(cpos.z - pos.z)); koef := offset / len; SetPos.x := pos.x + (cpos.x - pos.x) * koef; SetPos.y := pos.y + (cpos.y - pos.y) * koef; SetPos.z := pos.z + (cpos.z - pos.z) * koef; pos.x := SetPos.x; pos.y := SetPos.y; pos.z := SetPos.z; len := SQRT(SQR(camera.x - pos.x) + SQR(camera.y - pos.y) + SQR(camera.z - pos.z)); koef := delta / len; SetPos.x := pos.x + (camera.x - pos.x) * koef; SetPos.y := pos.y + (camera.y - pos.y) * koef; SetPos.z := pos.z + (camera.z - pos.z) * koef; xObj.Position.x := SetPos.x; xObj.Position.y := SetPos.y; xObj.Position.z := SetPos.z; coord1.x := pos.x; coord2.x := camera.x; if xSide.FFaceType in [ftNetFloor, ftNetCeiling] then begin coord1.y := pos.y; coord2.y := camera.y; xObj.PitchAngle := 90; end else begin coord1.y := pos.z; coord2.y := camera.z; xObj.PitchAngle := 0; end; ang := GetDistAngle(coord1, coord2); xObj.TurnAngle := ang; xObj.Text := IntToStr(i + 1); xObj.Extrusion := 0.1; xObj.Scale.X := 0.5; xObj.Scale.Y := 0.5; xObj.Scale.Z := 0.5; xObj.Adjust.Horz := TGLTextHorzAdjust(haCenter); xObj.Adjust.Vert := TGLTextVertAdjust(vaCenter); xObj.Font.Color := clBlue; with xObj.Material do begin FrontProperties.Ambient.Color := clrBlue; FrontProperties.Diffuse.Color := clrBlue; FrontProperties.Emission.Color := clrBlue; BackProperties.Ambient.Color := clrBlue; BackProperties.Diffuse.Color := clrBlue; BackProperties.Emission.Color := clrBlue; end; FNodesObjectsList.Add(xObj); end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.CreateNodesObjects', E.Message); end; end; procedure Tfrm3D.DeleteNodesObjects; var i: integer; xObj: TGLSpaceText; begin try for i := 0 to FNodesObjectsList.Count - 1 do begin xObj := TGLSpaceText(FNodesObjectsList[i]); DummyCube.Remove(xObj, True); end; FNodesObjectsList.Clear; except on E: Exception do AddExceptionToLogEx('Tfrm3D.DeleteNodesObjects', E.Message); end; end; procedure Tfrm3D.DoResize; var Len1, Len2, Len3, Len13, HLen, DLen1, DLen2: Double; LenToCursor1, LenToCursor2, LenToResizer1, LenToResizer2: Double; Len11, Len12, Len21, Len22, LimitLen1, LimitLen2: Double; p1, p2, hp: T3DPoint; delta, p, S: double; begin try // Calc H Length Len1 := SQRT(SQR(glCursorObject.Position.x - RStartPos1.x) + SQR(glCursorObject.Position.y - RStartPos1.y) + SQR(glCursorObject.Position.z - RStartPos1.z)); Len2 := SQRT(SQR(glCursorObject.Position.x - RStartPos2.x) + SQR(glCursorObject.Position.y - RStartPos2.y) + SQR(glCursorObject.Position.z - RStartPos2.z)); Len3 := SQRT(SQR(RStartPos1.x - RStartPos2.x) + SQR(RStartPos1.y - RStartPos2.y) + SQR(RStartPos1.z - RStartPos2.z)); p := (Len1 + Len2 + Len3) / 2; S := SQRT(p * (p - Len1) * (p - Len2) * (p - Len3)); HLen := 2 * S / Len3; // Calc H point Len13 := SQRT(SQR(Len1) - SQR(HLen)); delta := Len13 / Len3; hp.x := RStartPos1.x + (RStartPos2.x - RStartPos1.x) * delta; hp.y := RStartPos1.y + (RStartPos2.y - RStartPos1.y) * delta; hp.z := RStartPos1.z + (RStartPos2.z - RStartPos1.z) * delta; if EQD(HLen, 0) then exit; // Calc Sides Lengths Len11 := SQRT(SQR(FResizeData.Nodep11.x - RStartPos1.x) + SQR(FResizeData.Nodep11.y - RStartPos1.y) + SQR(FResizeData.Nodep11.z - RStartPos1.z)); Len12 := SQRT(SQR(FResizeData.Nodep12.x - RStartPos2.x) + SQR(FResizeData.Nodep12.y - RStartPos2.y) + SQR(FResizeData.Nodep12.z - RStartPos2.z)); Len21 := SQRT(SQR(FResizeData.Nodep21.x - RStartPos1.x) + SQR(FResizeData.Nodep21.y - RStartPos1.y) + SQR(FResizeData.Nodep21.z - RStartPos1.z)); Len22 := SQRT(SQR(FResizeData.Nodep22.x - RStartPos2.x) + SQR(FResizeData.Nodep22.y - RStartPos2.y) + SQR(FResizeData.Nodep22.z - RStartPos2.z)); LimitLen1 := Min(Len11, Len12); LimitLen2 := Min(Len21, Len22); // Calc Lenght Vector LenToCursor1 := SQRT(SQR(FResizeData.Nodep11.x - glCursorObject.Position.x) + SQR(FResizeData.Nodep11.y - glCursorObject.Position.y) + SQR(FResizeData.Nodep11.z - glCursorObject.Position.z)); LenToCursor2 := SQRT(SQR(FResizeData.Nodep21.x - glCursorObject.Position.x) + SQR(FResizeData.Nodep21.y - glCursorObject.Position.y) + SQR(FResizeData.Nodep21.z - glCursorObject.Position.z)); LenToResizer1 := SQRT(SQR(FResizeData.Nodep11.x - hp.x) + SQR(FResizeData.Nodep11.y - hp.y) + SQR(FResizeData.Nodep11.z - hp.z)); LenToResizer2 := SQRT(SQR(FResizeData.Nodep21.x - hp.x) + SQR(FResizeData.Nodep21.y - hp.y) + SQR(FResizeData.Nodep21.z - hp.z)); // Движение к точкам первой грани if LenToCursor1 < LenToResizer1 then begin if HLen > LimitLen1 then HLen := LimitLen1; if Len11 = 0 then DLen1 := 0 else DLen1 := HLen / Len11; if Len12 = 0 then DLen2 := 0 else DLen2 := HLen / Len12; rpos1.x := RStartPos1.x - (RStartPos1.x - FResizeData.Nodep11.x) * DLen1; rpos1.y := RStartPos1.y - (RStartPos1.y - FResizeData.Nodep11.y) * DLen1; rpos1.z := RStartPos1.z - (RStartPos1.z - FResizeData.Nodep11.z) * DLen1; rpos2.x := RStartPos2.x - (RStartPos2.x - FResizeData.Nodep12.x) * DLen2; rpos2.y := RStartPos2.y - (RStartPos2.y - FResizeData.Nodep12.y) * DLen2; rpos2.z := RStartPos2.z - (RStartPos2.z - FResizeData.Nodep12.z) * DLen2; end else if LenToCursor2 < LenToResizer2 then // Движение к точкам второй грани begin if HLen > LimitLen2 then HLen := LimitLen2; if Len21 = 0 then DLen1 := 0 else DLen1 := HLen / Len21; if Len22 = 0 then DLen2 := 0 else DLen2 := HLen / Len22; rpos1.x := RStartPos1.x - (RStartPos1.x - FResizeData.Nodep21.x) * DLen1; rpos1.y := RStartPos1.y - (RStartPos1.y - FResizeData.Nodep21.y) * DLen1; rpos1.z := RStartPos1.z - (RStartPos1.z - FResizeData.Nodep21.z) * DLen1; rpos2.x := RStartPos2.x - (RStartPos2.x - FResizeData.Nodep22.x) * DLen2; rpos2.y := RStartPos2.y - (RStartPos2.y - FResizeData.Nodep22.y) * DLen2; rpos2.z := RStartPos2.z - (RStartPos2.z - FResizeData.Nodep22.z) * DLen2; end else if (LimitLen1 = 0) or (LimitLen2 = 0) then begin rpos1.x := RStartPos1.x; rpos1.y := RStartPos1.y; rpos1.z := RStartPos1.z; rpos2.x := RStartPos2.x; rpos2.y := RStartPos2.y; rpos2.z := RStartPos2.z; end; // Set Spliter Line and Cube glSpliter.Nodes[0].X := rpos1.x; glSpliter.Nodes[0].Y := rpos1.y; glSpliter.Nodes[0].Z := rpos1.z; glSpliter.Nodes[1].X := rpos2.x; glSpliter.Nodes[1].Y := rpos2.y; glSpliter.Nodes[1].Z := rpos2.z; glCubeSpliter.Position.x := (rpos1.x + rpos2.x) / 2; glCubeSpliter.Position.y := (rpos1.y + rpos2.y) / 2; glCubeSpliter.Position.z := (rpos1.z + rpos2.z) / 2; glCubeSpliter1.Position.x := rpos1.x; glCubeSpliter1.Position.y := rpos1.y; glCubeSpliter1.Position.z := rpos1.z; glCubeSpliter2.Position.x := rpos2.x; glCubeSpliter2.Position.y := rpos2.y; glCubeSpliter2.Position.z := rpos2.z; SetSideSizes; except on E: Exception do AddExceptionToLogEx('Tfrm3D.DoResize', E.Message); end; end; procedure Tfrm3D.SelectNodesEvent(Sender: TObject); var i, j, ItemIndex, Index: Integer; xObj: TGLPolygon; xCutData: TCutData; p1, p2: T3DPoint; GLPoints1, GLPoints2: T3DPointArray; Len: Integer; xGLSide: TGLPolygon; Nodep11, Nodep12, Nodep21, Nodep22, Noder11, Noder12, Noder21, Noder22: Integer; LenX, LenY, LenZ, LenXY, LenXZ, LenXYZ :double; xSide: T3DSide; begin try Index := TMenuItem(Sender).Tag; xObj := TGLPolygon(DummyCube.Children[Index]); ItemIndex := TMenuItem(Sender).MenuIndex; xCutData := TCutData(FCutDataList[ItemIndex]); // Basis Nodes SetLength(FResizeData.BasisNodes, xObj.Nodes.Count); for i := 0 to xObj.Nodes.Count - 1 do begin FResizeData.BasisNodes[i].x := xObj.Nodes[i].X; FResizeData.BasisNodes[i].y := xObj.Nodes[i].Y; FResizeData.BasisNodes[i].z := xObj.Nodes[i].Z; end; // Create Spliter p1.x := (xObj.Nodes[xCutData.Index11].x + xObj.Nodes[xCutData.Index12].x) / 2; p1.y := (xObj.Nodes[xCutData.Index11].y + xObj.Nodes[xCutData.Index12].y) / 2; p1.z := (xObj.Nodes[xCutData.Index11].z + xObj.Nodes[xCutData.Index12].z) / 2; p2.x := (xObj.Nodes[xCutData.Index21].x + xObj.Nodes[xCutData.Index22].x) / 2; p2.y := (xObj.Nodes[xCutData.Index21].y + xObj.Nodes[xCutData.Index22].y) / 2; p2.z := (xObj.Nodes[xCutData.Index21].z + xObj.Nodes[xCutData.Index22].z) / 2; glSpliter.Nodes[0].x := p1.x; glSpliter.Nodes[0].y := p1.y; glSpliter.Nodes[0].z := p1.z; glSpliter.Nodes[1].x := p2.x; glSpliter.Nodes[1].y := p2.y; glSpliter.Nodes[1].z := p2.z; glSpliter.Visible := True; // Create CubeSpliter glCubeSpliter.Position.x := (p1.x + p2.x) / 2; glCubeSpliter.Position.y := (p1.y + p2.y) / 2; glCubeSpliter.Position.z := (p1.z + p2.z) / 2; glCubeSpliter.Visible := True; glCubeSpliter1.Position.x := p1.x; glCubeSpliter1.Position.y := p1.y; glCubeSpliter1.Position.z := p1.z; glCubeSpliter1.Visible := True; glCubeSpliter2.Position.x := p2.x; glCubeSpliter2.Position.y := p2.y; glCubeSpliter2.Position.z := p2.z; glCubeSpliter2.Visible := True; // Create Side1 SetLength(GLPoints1, 0); for i := 0 to xCutData.Index11 do begin Len := Length(GLPoints1); SetLength(GLPoints1, Len + 1); GLPoints1[Len].x := xObj.Nodes[i].x; GLPoints1[Len].y := xObj.Nodes[i].y; GLPoints1[Len].z := xObj.Nodes[i].z; end; Nodep11 := Len; Len := Length(GLPoints1); SetLength(GLPoints1, Len + 2); GLPoints1[Len] := p1; Noder11 := Len; GLPoints1[Len + 1] := p2; Noder12 := Len + 1; if Len + 2 <= xCutData.Index22 then Nodep12 := Len + 2 else Nodep12 := 0; if xCutData.Index22 <> 0 then begin for i := xCutData.Index22 to xObj.Nodes.Count - 1 do begin Len := Length(GLPoints1); SetLength(GLPoints1, Len + 1); GLPoints1[Len].x := xObj.Nodes[i].x; GLPoints1[Len].y := xObj.Nodes[i].y; GLPoints1[Len].z := xObj.Nodes[i].z; end; end; // Create Side2 xGLSide := TGLPolygon(DummyCube.AddNewChild(TGLPolygon)); SetLength(GLPoints2, 0); Len := Length(GLPoints2); SetLength(GLPoints2, Len + 1); GLPoints2[Len] := p1; Noder21 := Len; Nodep21 := Len + 1; for i := xCutData.Index12 to xCutData.Index21 do begin Len := Length(GLPoints2); SetLength(GLPoints2, Len + 1); GLPoints2[Len].x := xObj.Nodes[i].x; GLPoints2[Len].y := xObj.Nodes[i].y; GLPoints2[Len].z := xObj.Nodes[i].z; end; Nodep22 := Len; Len := Length(GLPoints2); SetLength(GLPoints2, Len + 1); GLPoints2[Len] := p2; Noder22 := Len; // *************************************** xObj.Nodes.Clear; for i := 0 to Length(GLPoints1) - 1 do begin // if i > 0 then // begin // if not (EQD(GLPoints1[i].x, GLPoints1[i-1].x) and EQD(GLPoints1[i].y, GLPoints1[i-1].y) and EQD(GLPoints1[i].z, GLPoints1[i-1].z)) then // xObj.AddNode(GLPoints1[i].x, GLPoints1[i].y, GLPoints1[i].z); // end // else xObj.AddNode(GLPoints1[i].x, GLPoints1[i].y, GLPoints1[i].z); end; for i := 0 to Length(GLPoints2) - 1 do begin // if i > 0 then // begin // if not (EQD(GLPoints2[i].x, GLPoints2[i-1].x) and EQD(GLPoints2[i].y, GLPoints2[i-1].y) and EQD(GLPoints2[i].z, GLPoints2[i-1].z)) then // xGLSide.AddNode(GLPoints2[i].x, GLPoints2[i].y, GLPoints2[i].z); // end // else xGLSide.AddNode(GLPoints2[i].x, GLPoints2[i].y, GLPoints2[i].z); end; xSide := T3DSide(TTreeNode(xObj.TagObject).Data); if xSide.FFaceType = ftNetCeiling then xGLSide.Parts := [ppTop]; if xSide.FFaceType = ftNetFloor then xGLSide.Parts := [ppBottom]; if TObject(xSide.FParent) is T3DSide then CreateAddForDivSide(xObj, xGLSide) else CreateAddForParentSide(xObj, xGLSide); FResizeData.Nodep11 := xObj.Nodes[Nodep11]; FResizeData.Nodep12 := xObj.Nodes[Nodep12]; FResizeData.Noder11 := xObj.Nodes[Noder11]; FResizeData.Noder12 := xObj.Nodes[Noder12]; FResizeData.Nodep21 := xGLSide.Nodes[Nodep21]; FResizeData.Nodep22 := xGLSide.Nodes[Nodep22]; FResizeData.Noder21 := xGLSide.Nodes[Noder21]; FResizeData.Noder22 := xGLSide.Nodes[Noder22]; FResizeData.Indexp11 := Nodep11; FResizeData.Indexp12 := Nodep12; FResizeData.Indexr11 := Noder11; FResizeData.Indexr12 := Noder12; FResizeData.Indexp21 := Nodep21; FResizeData.Indexp22 := Nodep22; FResizeData.Indexr21 := Noder21; FResizeData.Indexr22 := Noder22; FResizeData.Side1 := xObj; FResizeData.Side2 := xGLSide; RStartPos1 := p1; RStartPos2 := p2; rpos1 := RStartPos1; rpos2 := RStartPos2; glSide11.Visible := True; glSide12.Visible := True; glSide21.Visible := True; glSide22.Visible := True; SetSideSizes; // *************************************** FToolMode := tmCut; except on E: Exception do AddExceptionToLogEx('Tfrm3D.SelectNodesEvent', E.Message); end; end; procedure Tfrm3D.SetSideSizes; var mp: T3DPoint; pos, cpos1, cpos2, Camera: T3DPoint; SetPos: T3DPoint; delta, offset, koef, len: double; ang: double; coord1, coord2: TDoublePoint; xSide: T3DSide; begin try xSide := T3dSide(TTreeNode(FResizeData.Side1.tagObject).Data); delta := 0.4; if xSide.FFaceType in [ftNetFloor, ftNetCeiling] then offset := 0.6 else offset := 0.4; Camera.x := GLSceneViewer.Camera.Position.x; Camera.y := GLSceneViewer.Camera.Position.y; Camera.z := GLSceneViewer.Camera.Position.z; cpos1 := DoublePoint((FResizeData.Nodep11.x + FResizeData.Nodep21.x + rpos1.x + rpos2.x) / 4, (FResizeData.Nodep11.y + FResizeData.Nodep21.y + rpos1.y + rpos2.y) / 4, (FResizeData.Nodep11.z + FResizeData.Nodep21.z + rpos1.z + rpos2.z) / 4); cpos2 := DoublePoint((FResizeData.Nodep21.x + FResizeData.Nodep22.x + rpos1.x + rpos2.x) / 4, (FResizeData.Nodep21.y + FResizeData.Nodep22.y + rpos1.y + rpos2.y) / 4, (FResizeData.Nodep21.z + FResizeData.Nodep22.z + rpos1.z + rpos2.z) / 4); // ********** 11 ************************************************************* pos.x := (FResizeData.Nodep11.x + rpos1.x) / 2; pos.y := (FResizeData.Nodep11.y + rpos1.y) / 2; pos.z := (FResizeData.Nodep11.z + rpos1.z) / 2; len := SQRT(SQR(cpos1.x - pos.x) + SQR(cpos1.y - pos.y) + SQR(cpos1.z - pos.z)); koef := offset / len; SetPos.x := pos.x + (cpos1.x - pos.x) * koef; SetPos.y := pos.y + (cpos1.y - pos.y) * koef; SetPos.z := pos.z + (cpos1.z - pos.z) * koef; pos.x := SetPos.x; pos.y := SetPos.y; pos.z := SetPos.z; len := SQRT(SQR(camera.x - pos.x) + SQR(camera.y - pos.y) + SQR(camera.z - pos.z)); koef := delta / len; SetPos.x := pos.x + (camera.x - pos.x) * koef; SetPos.y := pos.y + (camera.y - pos.y) * koef; SetPos.z := pos.z + (camera.z - pos.z) * koef; glSide11.Position.x := SetPos.x; glSide11.Position.y := SetPos.y; glSide11.Position.z := SetPos.z; coord1.x := pos.x; coord2.x := camera.x; if xSide.FFaceType in [ftNetFloor, ftNetCeiling] then begin coord1.y := pos.y; coord2.y := camera.y; glSide11.PitchAngle := 90; end else begin coord1.y := pos.z; coord2.y := camera.z; glSide11.PitchAngle := 0; end; ang := GetDistAngle(coord1, coord2); glSide11.TurnAngle := ang; Len := SQRT(SQR((FResizeData.Nodep11.x - rpos1.x) / Factor) + SQR((FResizeData.Nodep11.y - rpos1.y) / Factor) + SQR((FResizeData.Nodep11.z - rpos1.z) / Factor)); glSide11.Text := FormatFloat(ffMask, Len / FScaleDelta); // ********** 12 ************************************************************* pos.x := (FResizeData.Nodep12.x + rpos2.x) / 2; pos.y := (FResizeData.Nodep12.y + rpos2.y) / 2; pos.z := (FResizeData.Nodep12.z + rpos2.z) / 2; len := SQRT(SQR(cpos1.x - pos.x) + SQR(cpos1.y - pos.y) + SQR(cpos1.z - pos.z)); koef := offset / len; SetPos.x := pos.x + (cpos1.x - pos.x) * koef; SetPos.y := pos.y + (cpos1.y - pos.y) * koef; SetPos.z := pos.z + (cpos1.z - pos.z) * koef; pos.x := SetPos.x; pos.y := SetPos.y; pos.z := SetPos.z; len := SQRT(SQR(camera.x - pos.x) + SQR(camera.y - pos.y) + SQR(camera.z - pos.z)); koef := delta / len; SetPos.x := pos.x + (camera.x - pos.x) * koef; SetPos.y := pos.y + (camera.y - pos.y) * koef; SetPos.z := pos.z + (camera.z - pos.z) * koef; glSide12.Position.x := SetPos.x; glSide12.Position.y := SetPos.y; glSide12.Position.z := SetPos.z; coord1.x := pos.x; coord2.x := camera.x; if xSide.FFaceType in [ftNetFloor, ftNetCeiling] then begin coord1.y := pos.y; coord2.y := camera.y; glSide12.PitchAngle := 90; end else begin coord1.y := pos.z; coord2.y := camera.z; glSide12.PitchAngle := 0; end; ang := GetDistAngle(coord1, coord2); glSide12.TurnAngle := ang; Len := SQRT(SQR((FResizeData.Nodep12.x - rpos2.x) / Factor) + SQR((FResizeData.Nodep12.y - rpos2.y) / Factor) + SQR((FResizeData.Nodep12.z - rpos2.z) / Factor)); glSide12.Text := FormatFloat(ffMask, Len / FScaleDelta); // ********** 21 ************************************************************* pos.x := (FResizeData.Nodep21.x + rpos1.x) / 2; pos.y := (FResizeData.Nodep21.y + rpos1.y) / 2; pos.z := (FResizeData.Nodep21.z + rpos1.z) / 2; len := SQRT(SQR(cpos2.x - pos.x) + SQR(cpos2.y - pos.y) + SQR(cpos2.z - pos.z)); koef := offset / len; SetPos.x := pos.x + (cpos2.x - pos.x) * koef; SetPos.y := pos.y + (cpos2.y - pos.y) * koef; SetPos.z := pos.z + (cpos2.z - pos.z) * koef; pos.x := SetPos.x; pos.y := SetPos.y; pos.z := SetPos.z; len := SQRT(SQR(camera.x - pos.x) + SQR(camera.y - pos.y) + SQR(camera.z - pos.z)); koef := delta / len; SetPos.x := pos.x + (camera.x - pos.x) * koef; SetPos.y := pos.y + (camera.y - pos.y) * koef; SetPos.z := pos.z + (camera.z - pos.z) * koef; glSide21.Position.x := SetPos.x; glSide21.Position.y := SetPos.y; glSide21.Position.z := SetPos.z; coord1.x := pos.x; coord2.x := camera.x; if xSide.FFaceType in [ftNetFloor, ftNetCeiling] then begin coord1.y := pos.y; coord2.y := camera.y; glSide21.PitchAngle := 90; end else begin coord1.y := pos.z; coord2.y := camera.z; glSide21.PitchAngle := 0; end; ang := GetDistAngle(coord1, coord2); glSide21.TurnAngle := ang; Len := SQRT(SQR((FResizeData.Nodep21.x - rpos1.x) / Factor) + SQR((FResizeData.Nodep21.y - rpos1.y) / Factor) + SQR((FResizeData.Nodep21.z - rpos1.z) / Factor)); glSide21.Text := FormatFloat(ffMask, Len / FScaleDelta); // ********** 22 ************************************************************* pos.x := (FResizeData.Nodep22.x + rpos2.x) / 2; pos.y := (FResizeData.Nodep22.y + rpos2.y) / 2; pos.z := (FResizeData.Nodep22.z + rpos2.z) / 2; len := SQRT(SQR(cpos2.x - pos.x) + SQR(cpos2.y - pos.y) + SQR(cpos2.z - pos.z)); koef := offset / len; SetPos.x := pos.x + (cpos2.x - pos.x) * koef; SetPos.y := pos.y + (cpos2.y - pos.y) * koef; SetPos.z := pos.z + (cpos2.z - pos.z) * koef; pos.x := SetPos.x; pos.y := SetPos.y; pos.z := SetPos.z; len := SQRT(SQR(camera.x - pos.x) + SQR(camera.y - pos.y) + SQR(camera.z - pos.z)); koef := delta / len; SetPos.x := pos.x + (camera.x - pos.x) * koef; SetPos.y := pos.y + (camera.y - pos.y) * koef; SetPos.z := pos.z + (camera.z - pos.z) * koef; glSide22.Position.x := SetPos.x; glSide22.Position.y := SetPos.y; glSide22.Position.z := SetPos.z; coord1.x := pos.x; coord2.x := camera.x; if xSide.FFaceType in [ftNetFloor, ftNetCeiling] then begin coord1.y := pos.y; coord2.y := camera.y; glSide22.PitchAngle := 90; end else begin coord1.y := pos.z; coord2.y := camera.z; glSide22.PitchAngle := 0; end; ang := GetDistAngle(coord1, coord2); glSide22.TurnAngle := ang; Len := SQRT(SQR((FResizeData.Nodep22.x - rpos2.x) / Factor) + SQR((FResizeData.Nodep22.y - rpos2.y) / Factor) + SQR((FResizeData.Nodep22.z - rpos2.z) / Factor)); glSide22.Text := FormatFloat(ffMask, Len / FScaleDelta); except on E: Exception do AddExceptionToLogEx('Tfrm3D.SetSideSizes', E.Message); end; end; procedure Tfrm3D.AfterUpdate; var glObjClass: TGLSceneObjectClass; glNodeNbr: TGLSpaceText; xColor: TVector4f; begin try xColor := clrBlack; FToolMode := tmSelect; FNodesObjectsList := TList.Create; FCutDataList := TList.Create; FResizeData := TResizeData.Create; FResizer := False; // Add Cursor Object (3ds and Connector Move) glCursorObject := TGLCustomSceneObject.Create(GLScene); glCursorObject.Visible := False; // Add Cursor Line (Line Move) glCursorLine := TGLLines.Create(GLScene); glCursorLine.AddNode(0, 0, 0); // add 1 node glCursorLine.AddNode(0, 0, 0); // add 2 node glCursorLine.Visible := False; // Add Sides Caption for Resizer glSide11 := TGLSpaceText(DummyCube.AddNewChild(TGLSpaceText)); glSide21 := TGLSpaceText(DummyCube.AddNewChild(TGLSpaceText)); glSide12 := TGLSpaceText(DummyCube.AddNewChild(TGLSpaceText)); glSide22 := TGLSpaceText(DummyCube.AddNewChild(TGLSpaceText)); glSide11.Extrusion := 0.1; glSide11.Scale.X := 0.4; glSide11.Scale.Y := 0.4; glSide11.Scale.Z := 0.4; glSide11.Adjust.Horz := TGLTextHorzAdjust(haCenter); glSide11.Adjust.Vert := TGLTextVertAdjust(vaCenter); glSide11.Font.Color := clGray; with glSide11.Material do begin FrontProperties.Ambient.Color := xColor; FrontProperties.Diffuse.Color := xColor; FrontProperties.Emission.Color := xColor; BackProperties.Ambient.Color := xColor; BackProperties.Diffuse.Color := xColor; BackProperties.Emission.Color := xColor; end; glSide12.Extrusion := 0.1; glSide12.Scale.X := 0.4; glSide12.Scale.Y := 0.4; glSide12.Scale.Z := 0.4; glSide12.Adjust.Horz := TGLTextHorzAdjust(haCenter); glSide12.Adjust.Vert := TGLTextVertAdjust(vaCenter); glSide12.Font.Color := clGray; with glSide12.Material do begin FrontProperties.Ambient.Color := xColor; FrontProperties.Diffuse.Color := xColor; FrontProperties.Emission.Color := xColor; BackProperties.Ambient.Color := xColor; BackProperties.Diffuse.Color := xColor; BackProperties.Emission.Color := xColor; end; glSide21.Extrusion := 0.1; glSide21.Scale.X := 0.4; glSide21.Scale.Y := 0.4; glSide21.Scale.Z := 0.4; glSide21.Adjust.Horz := TGLTextHorzAdjust(haCenter); glSide21.Adjust.Vert := TGLTextVertAdjust(vaCenter); glSide21.Font.Color := clGray; with glSide21.Material do begin FrontProperties.Ambient.Color := xColor; FrontProperties.Diffuse.Color := xColor; FrontProperties.Emission.Color := xColor; BackProperties.Ambient.Color := xColor; BackProperties.Diffuse.Color := xColor; BackProperties.Emission.Color := xColor; end; glSide22.Extrusion := 0.1; glSide22.Scale.X := 0.4; glSide22.Scale.Y := 0.4; glSide22.Scale.Z := 0.4; glSide22.Adjust.Horz := TGLTextHorzAdjust(haCenter); glSide22.Adjust.Vert := TGLTextVertAdjust(vaCenter); glSide22.Font.Color := clGray; with glSide22.Material do begin FrontProperties.Ambient.Color := xColor; FrontProperties.Diffuse.Color := xColor; FrontProperties.Emission.Color := xColor; BackProperties.Ambient.Color := xColor; BackProperties.Diffuse.Color := xColor; BackProperties.Emission.Color := xColor; end; glSide11.Visible := False; glSide21.Visible := False; glSide12.Visible := False; glSide22.Visible := False; // *** Spliters *** // Spliter Line glSpliter := TGLLines(DummyCube.AddNewChild(TGLLines)); glSpliter.AddNode(0, 0, 0); glSpliter.AddNode(0, 0, 0); glSpliter.LineColor.AsWinColor := clBlack; glSpliter.NodeColor.AsWinColor := clBlack; glSpliter.LineWidth := 2; glSpliter.NodeSize := 0.3; glSpliter.NodesAspect := lnaInvisible; glSpliter.Visible := False; // Spliter Center Cube glCubeSpliter := TGLCube(DummyCube.AddNewChild(TGLCube)); glCubeSpliter.CubeDepth := 0.3; // Z glCubeSpliter.CubeHeight := 0.3; // Y glCubeSpliter.CubeWidth := 0.3; // X // Spliter Sides Cube glCubeSpliter1 := TGLCube(DummyCube.AddNewChild(TGLCube)); glCubeSpliter1.CubeDepth := 0.2; // Z glCubeSpliter1.CubeHeight := 0.2; // Y glCubeSpliter1.CubeWidth := 0.2; // X glCubeSpliter2 := TGLCube(DummyCube.AddNewChild(TGLCube)); glCubeSpliter2.CubeDepth := 0.2; // Z glCubeSpliter2.CubeHeight := 0.2; // Y glCubeSpliter2.CubeWidth := 0.2; // X with glCubeSpliter.Material do begin FrontProperties.Ambient.Color := clrBlack; FrontProperties.Diffuse.Color := clrBlack; FrontProperties.Emission.Color := clrBlack; BackProperties.Ambient.Color := clrBlack; BackProperties.Diffuse.Color := clrBlack; BackProperties.Emission.Color := clrBlack; end; glCubeSpliter.Visible := False; with glCubeSpliter1.Material do begin FrontProperties.Ambient.Color := clrBlack; FrontProperties.Diffuse.Color := clrBlack; FrontProperties.Emission.Color := clrBlack; BackProperties.Ambient.Color := clrBlack; BackProperties.Diffuse.Color := clrBlack; BackProperties.Emission.Color := clrBlack; end; glCubeSpliter1.Visible := False; with glCubeSpliter2.Material do begin FrontProperties.Ambient.Color := clrBlack; FrontProperties.Diffuse.Color := clrBlack; FrontProperties.Emission.Color := clrBlack; BackProperties.Ambient.Color := clrBlack; BackProperties.Diffuse.Color := clrBlack; BackProperties.Emission.Color := clrBlack; end; glCubeSpliter2.Visible := False; // *** Joined Conns Cubes *** glConn1 := TGLCube(DummyCube.AddNewChild(TGLCube)); glConn1.CubeDepth := 0.2; // Z glConn1.CubeHeight := 0.2; // Y glConn1.CubeWidth := 0.2; // X glConn2 := TGLCube(DummyCube.AddNewChild(TGLCube)); glConn2.CubeDepth := 0.2; // Z glConn2.CubeHeight := 0.2; // Y glConn2.CubeWidth := 0.2; // X with glConn1.Material do begin FrontProperties.Ambient.Color := clrBlue; FrontProperties.Diffuse.Color := clrBlue; FrontProperties.Emission.Color := clrBlue; BackProperties.Ambient.Color := clrBlue; BackProperties.Diffuse.Color := clrBlue; BackProperties.Emission.Color := clrBlue; end; glConn1.Visible := False; with glConn2.Material do begin FrontProperties.Ambient.Color := clrBlue; FrontProperties.Diffuse.Color := clrBlue; FrontProperties.Emission.Color := clrBlue; BackProperties.Ambient.Color := clrBlue; BackProperties.Diffuse.Color := clrBlue; BackProperties.Emission.Color := clrBlue; end; glConn2.Visible := False; ToggleTraceCaptions(cbShowTraceCaptions.Checked); //29.03.2011 except on E: Exception do AddExceptionToLogEx('Tfrm3D.AfterUpdate', E.Message); end; end; procedure Tfrm3D.GLSceneViewerMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var i: integer; xConn: T3DConnector; begin // Tolik 16/01/2019 -- WasShiftMouse := False; if ssShift in Shift then WasShiftMouse := True; // try if (TGLMouseButton(Button) = mbRight) then if (mdx = X) and (mdy = Y) then OnRightClick; if FToolMode = tmSelect then begin if FMovedObject <> nil then begin Set3DSObjectPos(FMovedObject); FMovedObject := nil; GLSceneViewer.Cursor := crDefault; end; if FMovedFullConnector <> nil then begin for i := 0 to FShadowObjects.Count - 1 do DummyCube.Remove(TGLLines(FShadowObjects[i]), True); FShadowObjects.Clear; Move3DConnectorEvent(FMovedFullConnector); FMovedFullConnector := nil; GLSceneViewer.Cursor := crDefault; sbView.Caption := ''; end; if FMovedEmptyConnector <> nil then begin for i := 0 to FShadowObjects.Count - 1 do DummyCube.Remove(TGLLines(FShadowObjects[i]), True); FShadowObjects.Clear; Move3DConnectorEvent(FMovedEmptyConnector); FMovedEmptyConnector := nil; GLSceneViewer.Cursor := crDefault; sbView.Caption := ''; end; if FMovedLine <> nil then begin Move3DLineEvent(FMovedLine); FMovedLine := nil; GLSceneViewer.Cursor := crDefault; sbView.Caption := ''; end; if FOffsetObjects then begin SetConnectorsOffset(FSelection); FOffsetObjects := False; GLSceneViewer.Cursor := crDefault; end; if FRotatedObject <> nil then FRotatedObject := nil; if FRotatedObjects then FRotatedObjects := False; end; if (FToolMode = tmCut) and FResizer then begin // при отпускании, применить ресайзинг к граням if TGLMouseButton(Button) = mbLeft then begin FResizer := False; RStartPos1 := rpos1; RStartPos2 := rpos2; SetSidesData; end; // при нажатии правой во время ресайзинга - сброс if TGLMouseButton(Button) = mbRight then begin FResizer := False; rpos1 := RStartPos1; rpos2 := RStartPos2; glSpliter.Nodes[0].X := rpos1.x; glSpliter.Nodes[0].Y := rpos1.y; glSpliter.Nodes[0].Z := rpos1.z; glSpliter.Nodes[1].X := rpos2.x; glSpliter.Nodes[1].Y := rpos2.y; glSpliter.Nodes[1].Z := rpos2.z; glCubeSpliter.Position.x := (rpos1.x + rpos2.x) / 2; glCubeSpliter.Position.y := (rpos1.y + rpos2.y) / 2; glCubeSpliter.Position.z := (rpos1.z + rpos2.z) / 2; glCubeSpliter1.Position.x := rpos1.x; glCubeSpliter1.Position.y := rpos1.y; glCubeSpliter1.Position.z := rpos1.z; glCubeSpliter2.Position.x := rpos2.x; glCubeSpliter2.Position.y := rpos2.y; glCubeSpliter2.Position.z := rpos2.z; GLSceneViewer.Cursor := crDefault; SetSideSizes; { //Full Reset FToolMode := tmSelect; glSpliter.Visible := False; glCubeSpliter.Visible := False; glSide11.Visible := False; glSide12.Visible := False; glSide21.Visible := False; glSide22.Visible := False; DeleteNodesObjects; GLSceneViewer.Cursor := crDefault; } end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.GLSceneViewerMouseUp', E.Message); end; end; procedure Tfrm3D.CreateAddForDivSide(aSide, aAddSide: TGLPolygon); var i, j: Integer; xNode, xParentNode, xAddNode: TTreeNode; xParentSide, xSide, xAddSide: T3DSide; tmpdir, tmpfname, ExtStr, BmpFName: string; HashStr: string; ZOrder: Double; begin try // Create Model Object xNode := TTreeNode(aSide.TagObject); xParentNode := xNode.Parent; // Create xSide := T3DSide(xNode.Data); SetLength(xSide.FPoints, aSide.Nodes.Count); SetLength(xSide.FGLPoints, aSide.Nodes.Count); ZOrder := xSide.FZOrder; for i := 0 to Length(xSide.FGLPoints) - 1 do begin xSide.FGLPoints[i].x := aSide.Nodes[i].X; xSide.FGLPoints[i].y := aSide.Nodes[i].Y - ZOrder; xSide.FGLPoints[i].z := aSide.Nodes[i].Z; end; for i := 0 to Length(xSide.FPoints) - 1 do begin xSide.FPoints[i].x := xSide.FGLPoints[i].x / Factor; xSide.FPoints[i].z := xSide.FGLPoints[i].y / Factor; xSide.FPoints[i].y := xSide.FGLPoints[i].z / Factor; end; xAddSide := T3DSide.Create(xSide.FFaceType, xSide.FWallType, xSide.FSideType, xSide.FParent); xAddSide.FName := cSubSide + IntToStr(xParentNode.Count + 1); xAddSide.FDescription.Text := xSide.FDescription.Text; xAddSide.FGLObject := aAddSide; xAddSide.FFace := nil; xAddSide.FColor := xSide.FColor; xAddSide.FTextureRotate := xSide.FTextureRotate; xAddSide.FTextureScale := xSide.FTextureScale; xAddSide.FMirror := xSide.FMirror; xAddSide.FTextureHash := xSide.FTextureHash; xAddSide.FTexture_ext := xSide.FTexture_ext; xAddSide.FZOrder := xSide.FZOrder; SetLength(xAddSide.FPoints, aAddSide.Nodes.Count); SetLength(xAddSide.FGLPoints, aAddSide.Nodes.Count); ZOrder := xAddSide.FZOrder; for i := 0 to Length(xAddSide.FGLPoints) - 1 do begin xAddSide.FGLPoints[i].x := aAddSide.Nodes[i].X; xAddSide.FGLPoints[i].y := aAddSide.Nodes[i].Y - ZOrder; xAddSide.FGLPoints[i].z := aAddSide.Nodes[i].Z; end; for i := 0 to Length(xAddSide.FPoints) - 1 do begin xAddSide.FPoints[i].x := xAddSide.FGLPoints[i].x / Factor; xAddSide.FPoints[i].z := xAddSide.FGLPoints[i].y / Factor; xAddSide.FPoints[i].y := xAddSide.FGLPoints[i].z / Factor; end; if xSide.FParent is T3DSide then T3DSide(xSide.FParent).FSubSides.Add(xAddSide); // Create Node xAddNode := ModelTree.Items.AddChild(xParentNode, xAddSide.FName); xAddNode.Data := xAddSide; xAddNode.ImageIndex := 50; xAddNode.SelectedIndex := xAddNode.ImageIndex; aAddSide.TagObject := xAddNode; // Apply Texture //tmpdir := GetWorkDir; // ExtractDirByCategoryType(dctPictures); //tmpfname := tmpdir + '\tmp.bmp'; //aSide.Material.Texture.Image.SaveToFile(tmpfname); //if tmpfname <> '' then begin aAddSide.Material.Texture.Disabled := False; aAddSide.Material.Texture.MappingMode := tmmObjectLinear; aAddSide.Material.Texture.DestroyHandles; //aAddSide.Material.Texture.Image.LoadFromFile(tmpfname); aAddSide.Material.Texture.Image.Assign(aSide.Material.Texture.Image); RotateTextureToAngleP(xAddSide, aAddSide, xAddSide.FTextureRotate, xAddSide.FMirror); end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.CreateAddForDivSide', E.Message); end; end; procedure Tfrm3D.CreateAddForParentSide(aFirstSide, aSecondSide: TGLPolygon); var i, j: Integer; xParentNode, xFirstNode, xSecondNode: TTreeNode; xParentSide, xFirstSide, xSecondSide: T3DSide; tmpdir, tmpfname, ExtStr, BmpFName: string; HashStr: string; ZOrder: Double; begin try // Create Model Object xParentNode := TTreeNode(aFirstSide.TagObject); xParentSide := T3DSide(xParentNode.Data); // CREATE FIRST xFirstSide := T3DSide.Create(xParentSide.FFaceType, xParentSide.FWallType, xParentSide.FSideType, xParentSide); xFirstSide.FName := cSubSide + IntToStr(xParentNode.Count + 1); xFirstSide.FDescription.Text := xParentSide.FDescription.Text; xFirstSide.FGLObject := aFirstSide; xFirstSide.FFace := nil; xFirstSide.FColor := xParentSide.FColor; xFirstSide.FTextureRotate := xParentSide.FTextureRotate; xFirstSide.FTextureScale := xParentSide.FTextureScale; xFirstSide.FMirror := xParentSide.FMirror; xFirstSide.FTextureHash := xParentSide.FTextureHash; xFirstSide.FTexture_ext := xParentSide.FTexture_ext; xFirstSide.FZOrder := xParentSide.FZOrder; SetLength(xFirstSide.FPoints, aFirstSide.Nodes.Count); SetLength(xFirstSide.FGLPoints, aFirstSide.Nodes.Count); ZOrder := xFirstSide.FZOrder; for i := 0 to Length(xFirstSide.FGLPoints) - 1 do begin xFirstSide.FGLPoints[i].x := aFirstSide.Nodes[i].X; xFirstSide.FGLPoints[i].y := aFirstSide.Nodes[i].Y - ZOrder; xFirstSide.FGLPoints[i].z := aFirstSide.Nodes[i].Z; end; for i := 0 to Length(xFirstSide.FPoints) - 1 do begin xFirstSide.FPoints[i].x := xFirstSide.FGLPoints[i].x / Factor; xFirstSide.FPoints[i].z := xFirstSide.FGLPoints[i].y / Factor; xFirstSide.FPoints[i].y := xFirstSide.FGLPoints[i].z / Factor; end; xParentSide.FSubSides.Add(xFirstSide); xFirstNode := ModelTree.Items.AddChild(xParentNode, xFirstSide.FName); xFirstNode.Data := xFirstSide; xFirstNode.ImageIndex := 50; xFirstNode.SelectedIndex := xFirstNode.ImageIndex; aFirstSide.TagObject := xFirstNode; // CREATE SECOND xSecondSide := T3DSide.Create(xParentSide.FFaceType, xParentSide.FWallType, xParentSide.FSideType, xParentSide); xSecondSide.FName := cSubSide + IntToStr(xParentNode.Count + 1); xSecondSide.FDescription.Text := xParentSide.FDescription.Text; xSecondSide.FGLObject := aSecondSide; xSecondSide.FFace := nil; xSecondSide.FColor := xParentSide.FColor; xSecondSide.FTextureRotate := xParentSide.FTextureRotate; xSecondSide.FTextureScale := xParentSide.FTextureScale; xSecondSide.FMirror := xParentSide.FMirror; xSecondSide.FTextureHash := xParentSide.FTextureHash; xSecondSide.FTexture_ext := xParentSide.FTexture_ext; xSecondSide.FZOrder := xParentSide.FZOrder; SetLength(xSecondSide.FPoints, aSecondSide.Nodes.Count); SetLength(xSecondSide.FGLPoints, aSecondSide.Nodes.Count); ZOrder := xSecondSide.FZOrder; for i := 0 to Length(xSecondSide.FGLPoints) - 1 do begin xSecondSide.FGLPoints[i].x := aSecondSide.Nodes[i].X; xSecondSide.FGLPoints[i].y := aSecondSide.Nodes[i].Y - ZOrder; xSecondSide.FGLPoints[i].z := aSecondSide.Nodes[i].Z; end; for i := 0 to Length(xSecondSide.FPoints) - 1 do begin xSecondSide.FPoints[i].x := xSecondSide.FGLPoints[i].x / Factor; xSecondSide.FPoints[i].z := xSecondSide.FGLPoints[i].y / Factor; xSecondSide.FPoints[i].y := xSecondSide.FGLPoints[i].z / Factor; end; xParentSide.FSubSides.Add(xSecondSide); xSecondNode := ModelTree.Items.AddChild(xParentNode, xSecondSide.FName); xSecondNode.Data := xSecondSide; xSecondNode.ImageIndex := 50; xSecondNode.SelectedIndex := xSecondNode.ImageIndex; aSecondSide.TagObject := xSecondNode; xParentSide.FGLObject := nil; // Apply Texture //tmpdir := GetWorkDir; // ExtractDirByCategoryType(dctPictures); //tmpfname := tmpdir + '\tmp.bmp'; //aFirstSide.Material.Texture.Image.SaveToFile(tmpfname); //if tmpfname <> '' then begin aSecondSide.Material.Texture.Disabled := False; aSecondSide.Material.Texture.MappingMode := tmmObjectLinear; aSecondSide.Material.Texture.DestroyHandles; //aSecondSide.Material.Texture.Image.LoadFromFile(tmpfname); aSecondSide.Material.Texture.Image.Assign(aFirstSide.Material.Texture.Image); RotateTextureToAngleP(xSecondSide, aSecondSide, xSecondSide.FTextureRotate, xSecondSide.FMirror); end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.CreateAddForParentSide', E.Message); end; end; procedure Tfrm3D.SetSidesData; var xNode: TTreeNode; xSide1, xSide2: T3DSide; ZOrder: Double; begin try FResizeData.Noder11.X := rpos1.x; FResizeData.Noder11.Y := rpos1.y; FResizeData.Noder11.Z := rpos1.z; FResizeData.Noder12.X := rpos2.x; FResizeData.Noder12.Y := rpos2.y; FResizeData.Noder12.Z := rpos2.z; FResizeData.Noder21.X := rpos1.x; FResizeData.Noder21.Y := rpos1.y; FResizeData.Noder21.Z := rpos1.z; FResizeData.Noder22.X := rpos2.x; FResizeData.Noder22.Y := rpos2.y; FResizeData.Noder22.Z := rpos2.z; xNode := TTreeNode(FResizeData.Side1.TagObject); xSide1 := T3DSide(xNode.Data); xNode := TTreeNode(FResizeData.Side2.TagObject); xSide2 := T3DSide(xNode.Data); ZOrder := xSide1.FZOrder; xSide1.FGLPoints[FResizeData.Indexr11].x := FResizeData.Noder11.X; xSide1.FGLPoints[FResizeData.Indexr11].y := FResizeData.Noder11.Y - ZOrder; xSide1.FGLPoints[FResizeData.Indexr11].z := FResizeData.Noder11.Z; xSide1.FGLPoints[FResizeData.Indexr12].x := FResizeData.Noder12.X; xSide1.FGLPoints[FResizeData.Indexr12].y := FResizeData.Noder12.Y - ZOrder; xSide1.FGLPoints[FResizeData.Indexr12].z := FResizeData.Noder12.Z; xSide1.FPoints[FResizeData.Indexr11].x := xSide1.FGLPoints[FResizeData.Indexr11].x / Factor; xSide1.FPoints[FResizeData.Indexr11].z := xSide1.FGLPoints[FResizeData.Indexr11].y / Factor; xSide1.FPoints[FResizeData.Indexr11].y := xSide1.FGLPoints[FResizeData.Indexr11].z / Factor; xSide1.FPoints[FResizeData.Indexr12].x := xSide1.FGLPoints[FResizeData.Indexr12].x / Factor; xSide1.FPoints[FResizeData.Indexr12].z := xSide1.FGLPoints[FResizeData.Indexr12].y / Factor; xSide1.FPoints[FResizeData.Indexr12].y := xSide1.FGLPoints[FResizeData.Indexr12].z / Factor; ZOrder := xSide2.FZOrder; xSide2.FGLPoints[FResizeData.Indexr21].x := FResizeData.Noder21.X; xSide2.FGLPoints[FResizeData.Indexr21].y := FResizeData.Noder21.Y - ZOrder; xSide2.FGLPoints[FResizeData.Indexr21].z := FResizeData.Noder21.Z; xSide2.FGLPoints[FResizeData.Indexr22].x := FResizeData.Noder22.X; xSide2.FGLPoints[FResizeData.Indexr22].y := FResizeData.Noder22.Y - ZOrder; xSide2.FGLPoints[FResizeData.Indexr22].z := FResizeData.Noder22.Z; xSide2.FPoints[FResizeData.Indexr21].x := xSide2.FGLPoints[FResizeData.Indexr21].x / Factor; xSide2.FPoints[FResizeData.Indexr21].z := xSide2.FGLPoints[FResizeData.Indexr21].y / Factor; xSide2.FPoints[FResizeData.Indexr21].y := xSide2.FGLPoints[FResizeData.Indexr21].z / Factor; xSide2.FPoints[FResizeData.Indexr22].x := xSide2.FGLPoints[FResizeData.Indexr22].x / Factor; xSide2.FPoints[FResizeData.Indexr22].z := xSide2.FGLPoints[FResizeData.Indexr22].y / Factor; xSide2.FPoints[FResizeData.Indexr22].y := xSide2.FGLPoints[FResizeData.Indexr22].z / Factor; except on E: Exception do AddExceptionToLogEx('Tfrm3D.SetSidesData', E.Message); end; end; procedure Tfrm3D.RefreshSidesPoints; var i, j: integer; xGLSide1, xGLSide2: TGLPolygon; xNode: TTreeNode; xSide1, xSide2: T3DSide; ZOrder: Double; begin try xGLSide1 := FResizeData.Side1; xGLSide2 := FResizeData.Side2; xNode := TTreeNode(xGLSide1.TagObject); xSide1 := T3DSide(xNode.Data); xNode := TTreeNode(xGLSide2.TagObject); xSide2 := T3DSide(xNode.Data); i := 0; while i < xGLSide1.Nodes.Count do begin if i > 0 then begin if EQD(xGLSide1.Nodes[i].x, xGLSide1.Nodes[i-1].x) and EQD(xGLSide1.Nodes[i].y, xGLSide1.Nodes[i-1].y) and EQD(xGLSide1.Nodes[i].z, xGLSide1.Nodes[i-1].z) then xGLSide1.Nodes.Delete(i) else i := i + 1; end else i := i + 1; end; SetLength(xSide1.FGLPoints, xGLSide1.Nodes.Count); SetLength(xSide1.FPoints, xGLSide1.Nodes.Count); ZOrder := xSide1.FZOrder; for i := 0 to xGLSide1.Nodes.Count - 1 do begin xSide1.FGLPoints[i].x := xGLSide1.Nodes[i].x; xSide1.FGLPoints[i].y := xGLSide1.Nodes[i].y - ZOrder; xSide1.FGLPoints[i].z := xGLSide1.Nodes[i].z; xSide1.FPoints[i].x := xSide1.FGLPoints[i].x / Factor; xSide1.FPoints[i].z := xSide1.FGLPoints[i].y / Factor; xSide1.FPoints[i].y := xSide1.FGLPoints[i].z / Factor; end; i := 0; while i < xGLSide2.Nodes.Count do begin if i > 0 then begin if EQD(xGLSide2.Nodes[i].x, xGLSide2.Nodes[i-1].x) and EQD(xGLSide2.Nodes[i].y, xGLSide2.Nodes[i-1].y) and EQD(xGLSide2.Nodes[i].z, xGLSide2.Nodes[i-1].z) then xGLSide2.Nodes.Delete(i) else i := i + 1; end else i := i + 1; end; SetLength(xSide2.FGLPoints, xGLSide2.Nodes.Count); SetLength(xSide2.FPoints, xGLSide2.Nodes.Count); ZOrder := xSide2.FZOrder; for i := 0 to xGLSide2.Nodes.Count - 1 do begin xSide2.FGLPoints[i].x := xGLSide2.Nodes[i].x; xSide2.FGLPoints[i].y := xGLSide2.Nodes[i].y - ZOrder; xSide2.FGLPoints[i].z := xGLSide2.Nodes[i].z; xSide2.FPoints[i].x := xSide2.FGLPoints[i].x / Factor; xSide2.FPoints[i].z := xSide2.FGLPoints[i].y / Factor; xSide2.FPoints[i].y := xSide2.FGLPoints[i].z / Factor; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.RefreshSidesPoints', E.Message); end; end; procedure Tfrm3D.FormCloseQuery(Sender: TObject; var CanClose: Boolean); var i, Res: Integer; mess: string; xIDList: integer; xFileStream: string; begin try GLCadencer.Enabled := False; mess := cForm3D_Mes6_1; //Res := MessageQuastYNC(cForm3D_Mes6_1); //21.09.2011 MessageBox(self.Handle, PAnsiChar(mess), cForm3D_Mes6_2, MB_YESNOCANCEL); if GReadOnlyMode then Res := IDNO else //Res := MessageBoxA(self.Handle, PAnsiChar(mess), cForm3D_Mes6_2, MB_YESNOCANCEL); Res := MessageBox(self.Handle, PChar(mess), cForm3D_Mes6_2, MB_YESNOCANCEL); if Res = IDYES then begin if FToolMode = tmCut then begin // Применить разрезку? case MessageQuastYNC(cForm3D_Mes6_3) of IDYES: ApplyCutting; IDCANCEL: CanClose := false; end; end; if CanClose then begin if FToolMode <> tmSelect then begin RefreshSidesPoints; UndoCutSides; end; ValidateActiveFormControl(Self); // Если фокус остался в контроле for i := 0 to FIdsStream.Count - 1 do begin xIDList := FIdsStream.Items[i]; xFileStream := FFilesStream.Strings[i]; SaveModelToStream(xFileStream, xIDList); end; ApplyScsModel; GSaved3DModelExist := True; end; end else if Res = IDNO then begin { if FToolMode <> tmSelect then begin RefreshSidesPoints; UndoCutSides; end; } end else if Res = IDCANCEL then begin CanClose := False; GLCadencer.Enabled := True; end; if CanClose then begin FreeAndNil(F3DModel); FIdsStream.Clear; FFilesStream.Clear; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.FormCloseQuery', E.Message); end; end; procedure Tfrm3D.sbSaveModelClick(Sender: TObject); var i: integer; xIDList: integer; xFileStream: string; begin try for i := 0 to FIdsStream.Count - 1 do begin xIDList := FIdsStream.Items[i]; xFileStream := FFilesStream.Strings[i]; SaveModelToStream(xFileStream, xIDList); end; GSaved3DModelExist := True; except on E: Exception do AddExceptionToLogEx('Tfrm3D.sbSaveModelClick', E.Message); end; end; procedure Tfrm3D.SaveModelToStream(const AFile: String; AListID: Integer); var fFileName: string; //08.09.2011 Buffer: array[0..1023] of Char; TempPath: string; xStream: TFileStream; xSize: Integer; mStream: TMemoryStream; i, j, k, ii, jj, kk, s: integer; xRoom: T3DRoom; xWall: T3DWall; xWallElement: T3DWallElement; xBalconElement: T3DBalconElement; xSlope: T3DSlope; xSide, xSubSide: T3DSide; x3DSObject: T3DSObject; xConn: T3DConnector; xLine: T3DLine; begin try {* Здесь на самом деле нужно получить имя файла с ПМ, вот как здесь fFileName := GetCadFileNameForSaveToPM(FCAD.FCADListID); PCad.SaveToFile(0, fFileName); это на обработчике TF_CAD.FormCloseQuery и потом на LoadModelToStream тот файл получить *} fFileName := AFile; if fFileName = '' then begin TempPath := GetAnsiTempPath; //08.09.2011 SetString(TempPath, Buffer, GetTempPath(Sizeof(Buffer) - 1, Buffer)); fFileName := TempPath + '3dmodel.pwd'; end; xStream := SafeOpenFileStream(fFileName, fmCreate or fmShareExclusive, 'Tfrm3D.SaveModelToStream', cSCSComponent_Msg22_12); ModelObjectsList := TList.Create; ModelObjectsList.Add(F3DModel); // распарсить комнаты for i := 0 to F3DModel.FRooms.Count - 1 do begin xRoom := T3DRoom(F3DModel.FRooms[i]); if (xRoom.FListID <> AListID) or (not xRoom.FVisible) then continue; ModelObjectsList.Add(xRoom); // добавить потолок в комнаты xSide := xRoom.FCeiling; ModelObjectsList.Add(xSide); for j := 0 to xSide.FSubSides.Count - 1 do begin xSubSide := T3DSide(xSide.FSubSides[j]); ModelObjectsList.Add(xSubSide); end; // добавить пол в комнату,если он есть if xRoom.FFloor <> nil then begin xSide := xRoom.FFloor; ModelObjectsList.Add(xSide); for j := 0 to xSide.FSubSides.Count - 1 do begin xSubSide := T3DSide(xSide.FSubSides[j]); ModelObjectsList.Add(xSubSide); end; end; // добавить 3дс обьекты for j := 0 to xRoom.F3DSObjects.Count - 1 do begin x3DSObject := T3DSObject(xRoom.F3DSObjects[j]); ModelObjectsList.Add(x3DSObject); end; // распарсить стены каждой комнаты for j := 0 to xRoom.FWalls.Count - 1 do begin xWall := T3DWall(xRoom.FWalls[j]); ModelObjectsList.Add(xWall); // распарсить элементы каждой стены for k := 0 to xWall.FWallElements.Count - 1 do begin xWallElement := T3DWallElement(xWall.FWallElements[k]); ModelObjectsList.Add(xWallElement); // окно if xWallElement.FElementType = dotWindow then begin // добавить откосы for ii := 0 to xWallElement.FSlopes.Count - 1 do begin xSlope := T3DSlope(xWallElement.FSlopes[ii]); ModelObjectsList.Add(xSlope); // добавть грани откоса for jj := 0 to xSlope.FSides.Count - 1 do begin xSide := T3DSide(xSlope.FSides[jj]); ModelObjectsList.Add(xSide); // Подграни for s := 0 to xSide.FSubSides.Count - 1 do begin xSubSide := T3DSide(xSide.FSubSides[s]); ModelObjectsList.Add(xSubSide); end; end; end; end; // дверь if xWallElement.FElementType = dotDoor then begin // добавить откосы for ii := 0 to xWallElement.FSlopes.Count - 1 do begin xSlope := T3DSlope(xWallElement.FSlopes[ii]); ModelObjectsList.Add(xSlope); // добавть грани откоса for jj := 0 to xSlope.FSides.Count - 1 do begin xSide := T3DSide(xSlope.FSides[jj]); ModelObjectsList.Add(xSide); // Подграни for s := 0 to xSide.FSubSides.Count - 1 do begin xSubSide := T3DSide(xSide.FSubSides[s]); ModelObjectsList.Add(xSubSide); end; end; end; end; // балкон if xWallElement.FElementType = dotBalcony then begin // добавить откосы for ii := 0 to xWallElement.FSlopes.Count - 1 do begin xSlope := T3DSlope(xWallElement.FSlopes[ii]); ModelObjectsList.Add(xSlope); // добавть грани откоса for jj := 0 to xSlope.FSides.Count - 1 do begin xSide := T3DSide(xSlope.FSides[jj]); ModelObjectsList.Add(xSide); // Подграни for s := 0 to xSide.FSubSides.Count - 1 do begin xSubSide := T3DSide(xSide.FSubSides[s]); ModelObjectsList.Add(xSubSide); end; end; end; // добавить элементы балкона for ii := 0 to xWallElement.FBalconElements.Count - 1 do begin xBalconElement := T3DBalconElement(xWallElement.FBalconElements[ii]); ModelObjectsList.Add(xBalconElement); // добавть грани элемента балкона for jj := 0 to xBalconElement.FSides.Count - 1 do begin xSide := T3DSide(xBalconElement.FSides[jj]); ModelObjectsList.Add(xSide); // Подграни for s := 0 to xSide.FSubSides.Count - 1 do begin xSubSide := T3DSide(xSide.FSubSides[s]); ModelObjectsList.Add(xSubSide); end; end; end; end; // добавить грани данного элемента стены for ii := 0 to xWallElement.FSides.Count - 1 do begin xSide := T3DSide(xWallElement.FSides[ii]); ModelObjectsList.Add(xSide); // Подграни for s := 0 to xSide.FSubSides.Count - 1 do begin xSubSide := T3DSide(xSide.FSubSides[s]); ModelObjectsList.Add(xSubSide); end; end; end; // добавить грани стены for k := 0 to xWall.FSides.Count - 1 do begin xSide := T3DSide(xWall.FSides[k]); ModelObjectsList.Add(xSide); // Подграни for s := 0 to xSide.FSubSides.Count - 1 do begin xSubSide := T3DSide(xSide.FSubSides[s]); ModelObjectsList.Add(xSubSide); end; end; end; end; for i := 0 to F3DModel.FScsObjects.Count - 1 do begin if TObject(F3DModel.FScsObjects[i]) is T3DConnector then begin xConn := T3DConnector(F3DModel.FScsObjects[i]); if (xConn.FListID <> AListID) then continue; ModelObjectsList.Add(xConn); end; if TObject(F3DModel.FScsObjects[i]) is T3DLine then begin xLine := T3DLine(F3DModel.FScsObjects[i]); if (xLine.FListID <> AListID) then continue; ModelObjectsList.Add(xLine); end; end; xSize := 0; mStream := TMemoryStream.Create; GetModelData(mStream); xSize := mStream.Size; mStream.Seek(0, soFromBeginning); if xStream <> nil then begin xStream.Write(xSize, 4); StreamToStream(mStream, xStream, xSize); end; FreeAndNil(mStream); // All used files by model xSize := 0; mStream := TMemoryStream.Create; CollectFileDataFromModel(mStream); xSize := mStream.Size; mStream.Seek(0, soFromBeginning); if xStream <> nil then begin xStream.Write(xSize, 4); StreamToStream(mStream, xStream, xSize); end; FreeAndNil(mStream); FreeAndNil(xStream); FreeAndNil(ModelObjectsList); except on E: Exception do AddExceptionToLogEx('Tfrm3D.SaveModelToStream', E.Message); end; end; procedure Tfrm3D.GetModelData(Stream: TStream); var i, xCount: integer; xSize: Integer; objStream: TMemoryStream; xObject: TObject; begin try xCount := ModelObjectsList.Count; Stream.Write(xCount, 4); for i := 0 to xCount - 1 do begin xObject := TObject(ModelObjectsList[i]); objStream := TMemoryStream.Create; if xObject is T3DModel then T3DModel(xObject).WriteToStream(objStream); if xObject is T3DRoom then T3DRoom(xObject).WriteToStream(objStream); if xObject is T3DWall then T3DWall(xObject).WriteToStream(objStream); if xObject is T3DWallElement then T3DWallElement(xObject).WriteToStream(objStream); if xObject is T3DBalconElement then T3DBalconElement(xObject).WriteToStream(objStream); if xObject is T3DSlope then T3DSlope(xObject).WriteToStream(objStream); if xObject is T3DSide then T3DSide(xObject).WriteToStream(objStream); if xObject is T3DSObject then T3DSObject(xObject).WriteToStream(objStream); if xObject is T3DConnector then T3DConnector(xObject).WriteToStream(objStream); if xObject is T3DLine then T3DLine(xObject).WriteToStream(objStream); xSize := objStream.Size; objStream.Seek(0,soFromBeginning); Stream.Write(xSize, 4); StreamToStream(objStream, Stream, xSize); FreeAndNil(objStream); end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.GetModelData', E.Message); end; end; procedure Tfrm3D.LoadModelFromStream(const AFile: String; AListID: Integer); var fFileName: string; //08.09.2011 Buffer: array[0..1023] of Char; TempPath: string; xStream: TFileStream; xSize: Integer; mStream: TMemoryStream; i, j, k, ii, jj, kk: integer; xModel: T3DModel; xRoom: T3DRoom; xWall: T3DWall; xWallElement: T3DWallElement; xBalconElement: T3DBalconElement; xSlope: T3DSlope; xCeiling, xFloor, xSide: T3DSide; xObject: TObject; begin try {* Здесь на самом деле нужно получить стрим модели, как на подобии это делается с получением стрима КАД объектов в процедуре OpenListsInProject ListStream := OpenListInPM(FCAD.FCADListID, FCAD.FCADListName, fFileName); if ListStream <> nil then begin SetString(TempPath, Buffer, GetTempPath(Sizeof(Buffer) - 1, Buffer)); ListStream.SaveToFile(TempPath + 'tempCAD.pwd'); FCAD.PCad.LoadFromFile(TempPath + 'tempCAD.pwd'); end *} F3DStreamModel := nil; ModelObjectsList := TList.Create; fFileName := AFile; if fFileName = '' then begin TempPath := GetAnsiTempPath; //08.09.2011 SetString(TempPath, Buffer, GetTempPath(Sizeof(Buffer) - 1, Buffer)); fFileName := TempPath + '3dmodel.pwd'; end; if not FileExists(fFileName) then begin FreeAndNil(ModelObjectsList); exit; end; xStream := SafeOpenFileStream(fFileName, fmOpenRead or fmShareExclusive, 'Tfrm3D.LoadModelFromStream', cSCSComponent_Msg22_12); if xStream <> nil then begin if xStream.Size = 0 then begin try FreeAndNil(xStream); except end; FreeAndNil(ModelObjectsList); exit; end; xStream.Read(xSize, 4); mStream := TMemoryStream.Create; StreamToStream(xStream, mStream, xSize); mStream.Seek(0, soFromBeginning); SetModelData(mStream); FreeAndNil(mStream); if xStream.Position < xStream.Size then begin xStream.Read(xSize, 4); mStream := TMemoryStream.Create; StreamToStream(xStream, mStream, xSize); mStream.Seek(0,soFromBeginning); ExtractAllFiles(mStream); mStream.Free; end; FreeAndNil(xStream); end; for i := 0 to ModelObjectsList.Count - 1 do begin xObject := TObject(ModelObjectsList[i]); if xObject is T3DModel then T3DModel(xObject).SetRelations; if xObject is T3DRoom then T3DRoom(xObject).SetRelations; if xObject is T3DWall then T3DWall(xObject).SetRelations; if xObject is T3DWallElement then T3DWallElement(xObject).SetRelations; if xObject is T3DBalconElement then T3DBalconElement(xObject).SetRelations; if xObject is T3DSlope then T3DSlope(xObject).SetRelations; if xObject is T3DSide then T3DSide(xObject).SetRelations; if xObject is T3DSObject then T3DSObject(xObject).SetRelations; if xObject is T3DConnector then T3DConnector(xObject).SetRelations; if xObject is T3DLine then T3DLine(xObject).SetRelations; end; FreeAndNil(ModelObjectsList); except on E: Exception do AddExceptionToLogEx('Tfrm3D.LoadModelFromStream', E.Message); end; end; procedure Tfrm3D.SyncModelFromStream(const AFile: String=''; AListID: Integer = 0; AFaces: TList=nil); begin LoadModelFromStream(AFile, AListID); if Self.F3DStreamModel = nil then begin Self.UpdateModelTree; Self.UpdateScsModelTree; end else begin {$IF Defined(ES_GRAPH_SC)} // Tolik 10/03/2018 -- для СКС поднимать со стрима только СКС объекты, архитектуру строить заново Self.UpdateModelTreeFromStream(AFaces); Self.UpdateScsModelTreeFromStream(AFaces); {$else} Self.UpdateModelTree; Self.UpdateScsModelTree; //Self.UpdateScsModelTreeFromStream(AFaces); {$ifEnd} end; Self.UpdateFaces(AFaces, 1); end; procedure Tfrm3D.SetModelData(Stream: TStream); var i,xCount: integer; xObject: TObject; xSize: Integer; objStream: TMemoryStream; TypeName: string; xModel: T3DModel; xRoom: T3DRoom; xWall: T3DWall; xWallElement: T3DWallElement; xBalconElement: T3DBalconElement; xSlope: T3DSlope; xSide: T3DSide; x3DSObject: T3DSObject; xConn: T3DConnector; xLine: T3DLine; begin try Stream.Read(xCount, 4); xModel := nil; //14.12.2010 for i := 0 to xCount - 1 do begin Stream.Read(xSize, 4); objStream := TMemoryStream.Create; StreamToStream(Stream, objStream, xSize); objStream.Seek(0,soFromBeginning); TypeName := ReadStringFromStream(objStream); if TypeName = 'T3DModel' then begin xModel := T3DModel.Create; xModel.ReadFromStream(objStream); ModelObjectsList.Add(xModel); end; if TypeName = 'T3DRoom' then begin xRoom := T3DRoom.Create(nil, nil, nil); xRoom.ReadFromStream(objStream); ModelObjectsList.Add(xRoom); end; if TypeName = 'T3DWall' then begin xWall := T3DWall.Create(nil, nil, nil); xWall.ReadFromStream(objStream); ModelObjectsList.Add(xWall); end; if TypeName = 'T3DWallElement' then begin xWallElement := T3DWallElement.Create(nil, nil, dotNone, nil); xWallElement.ReadFromStream(objStream); ModelObjectsList.Add(xWallElement); end; if TypeName = 'T3DBalconElement' then begin xBalconElement := T3DBalconElement.Create(nil, dotNone, nil); xBalconElement.ReadFromStream(objStream); ModelObjectsList.Add(xBalconElement); end; if TypeName = 'T3DSlope' then begin xSlope := T3DSlope.Create(nil, nil, nil); xSlope.ReadFromStream(objStream); ModelObjectsList.Add(xSlope); end; if TypeName = 'T3DSide' then begin xSide := T3DSide.Create(ftNetPath, fwtNone, wstNone, nil); xSide.ReadFromStream(objStream); ModelObjectsList.Add(xSide); end; if TypeName = 'T3DSObject' then begin x3DSObject := T3DSObject.Create(nil); x3DSObject.ReadFromStream(objStream); ModelObjectsList.Add(x3DSObject); end; if TypeName = 'T3DConnector' then begin xConn := T3DConnector.Create(nil, nil, nil); xConn.ReadFromStream(objStream); ModelObjectsList.Add(xConn); end; if TypeName = 'T3DLine' then begin xLine := T3DLine.Create(nil, nil, nil); xLine.ReadFromStream(objStream); ModelObjectsList.Add(xLine); end; FreeAndNil(objStream); end; frm3D.F3DStreamModel := xModel; except on E: Exception do AddExceptionToLogEx('Tfrm3D.SetModelData', E.Message); end; end; procedure Tfrm3D.CopyModelHash; var i, j: integer; xStr: string; CanAdd: Boolean; begin try // перебросить HASH for i := 0 to F3DStreamModel.FHashs.Count - 1 do begin xStr := F3DStreamModel.FHashs[i]; if F3DModel.FHashs.IndexOf(xStr) = -1 then F3DModel.FHashs.Add(xStr); //CanAdd := True; //for j := 0 to F3DModel.FHashs.Count - 1 do //begin // if F3DModel.FHashs[j] = xStr then // CanAdd := False; //end; //if CanAdd then // F3DModel.FHashs.Add(xStr); end; for i := 0 to F3DStreamModel.F3DSHashs.Count - 1 do begin xStr := F3DStreamModel.F3DSHashs[i]; if F3DModel.F3DSHashs.IndexOf(xStr) = -1 then F3DModel.F3DSHashs.Add(xStr); end; for i := 0 to F3DStreamModel.FFiles.Count - 1 do begin xStr := F3DStreamModel.FFiles[i]; if F3DModel.FFiles.IndexOf(xStr) = -1 then begin F3DModel.FFiles.Add(xStr); j := F3DModel.FFiles.IndexOf(xStr); if j >= 0 then begin while F3DModel.FFilesHashs.Count - 1 < j do F3DModel.FFilesHashs.Add(''); if F3DStreamModel.FFilesHashs.Count - 1 >= i then F3DModel.FFilesHashs[j] := F3DStreamModel.FFilesHashs[i] else F3DModel.FFilesHashs[j] := 'empty.bmp'; end; end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.CopyModelHash', E.Message); end; end; procedure Tfrm3D.OnRightClick; var xObj: TGLBaseSceneObject; Item: TMenuItem; i, j, Index: integer; Str: string; xCutData: TCutData; X, Y: Integer; xSide: T3DSide; xLine: T3DLine; xConn: T3DConnector; begin try X := mx; Y := my; if (FToolMode = tmSelect) then begin xObj := MyGetPickedobject(X, Y); // SIDES if (xObj <> nil) and (xObj is TGLPolygon) then begin xSide := T3DSide(TTreeNode(xObj.TagObject).Data); if (((xSide.FFaceType = ftNetPath) and ((xSide.FWallType = fwtInner) or (xSide.FWallType = fwtOuter))) or (xSide.FFaceType = ftNetCeiling) or (xSide.FFaceType = ftNetFloor)) and (Not xSide.FAsArc) then begin if (FSelection.Count = 1) and (TGLBaseSceneObject(FSelection[0]) = xObj) then begin // Create Nodes Texts CreateNodesObjects(TGLPolygon(xObj)); // Create PopumMenu Index := DummyCube.IndexOfChild(xObj); FCutDataList.Clear; pmCut.Items.Clear; for i := 0 to TGLPolygon(xObj).Nodes.Count - 1 do begin Str := ''; for j := i + 2 to TGLPolygon(xObj).Nodes.Count - 1 do begin Str := 'Разрезать: ' + IntToStr(i+1) + ',' + IntToStr(i+2) + '-'; if j + 1 < TGLPolygon(xObj).Nodes.Count then begin Str := Str + IntToStr(j+1) + ',' + IntToStr(j+2); Item := TMenuItem.Create(pmCut); Item.Caption := Str; pmCut.Items.Add(Item); Item.Tag := Index; Item.OnClick := SelectNodesEvent; xCutData := TCutData.create; xCutData.Index11 := i; xCutData.Index12 := i + 1; xCutData.Index21 := j; xCutData.Index22 := j + 1; FCutDataList.Add(xCutData); end else begin if i <> 0 then begin Str := Str + IntToStr(j+1) + ',' + IntToStr(1); Item := TMenuItem.Create(pmCut); Item.Caption := Str; pmCut.Items.Add(Item); Item.Tag := Index; Item.OnClick := SelectNodesEvent; xCutData := TCutData.create; xCutData.Index11 := i; xCutData.Index12 := i + 1; xCutData.Index21 := j; xCutData.Index22 := 0; FCutDataList.Add(xCutData); end; end; end; end; pmCut.Popup(X, Y); end; end; end else // SCS POPUP if (xObj <> nil) and (xObj is TGLLines) then begin xLine := T3DLine(TTreeNode(xObj.TagObject).Data); if FSelection.Count = 1 then if isLineObject(TGLBaseSceneObject(FSelection[0]), xObj) then begin if xLine.FLineType = lt_Line then begin pmScsPopup.Items[0].Visible := True; pmScsPopup.Popup(X, Y + 35); end; end; end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.OnRightClick', E.Message); end; end; // Tolik 16/10/2018 -- старая закомменчена -- см ниже... procedure Tfrm3D.Set3DSObjectPos(aGLObject: TGLFreeForm); var i: integer; xObject: T3DSObject; x3DConn: T3DConnector; begin try // Tolik 16/10/2018 -- if TObject(TTreeNode(aGLObject.TagObject).Data) is T3DConnector then begin x3DConn := T3DConnector(TTreeNode(aGLObject.TagObject).Data); end else begin // xObject := T3DSObject(TTreeNode(aGLObject.TagObject).Data); xObject.FPosition.x := aGLObject.Position.x; xObject.FPosition.y := aGLObject.Position.y - xObject.FZOrder; xObject.FPosition.z := aGLObject.Position.z; edPosX.Text := FloatToStr(xObject.FPosition.x); edPosY.Text := FloatToStr(xObject.FPosition.y); edPosZ.Text := FloatToStr(xObject.FPosition.z); end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.Set3DSObjectPos', E.Message); end; end; { procedure Tfrm3D.Set3DSObjectPos(aGLObject: TGLFreeForm); var i: integer; xObject: T3DSObject; begin try xObject := T3DSObject(TTreeNode(aGLObject.TagObject).Data); xObject.FPosition.x := aGLObject.Position.x; xObject.FPosition.y := aGLObject.Position.y - xObject.FZOrder; xObject.FPosition.z := aGLObject.Position.z; edPosX.Text := FloatToStr(xObject.FPosition.x); edPosY.Text := FloatToStr(xObject.FPosition.y); edPosZ.Text := FloatToStr(xObject.FPosition.z); except on E: Exception do AddExceptionToLogEx('Tfrm3D.Set3DSObjectPos', E.Message); end; end; } procedure Tfrm3D.SetConnectorsOffset(aGLObjects: TList); var i: integer; glObject: TGLBaseSceneObject; glObject1: TGLFreeForm; xConn: T3DConnector; off_x, off_y, off_z: Double; begin try for i := 0 to aGLObjects.Count - 1 do begin glObject := TGLBaseSceneObject(aGLObjects[i]); if TObject(TTreeNode(glObject.tagObject).Data) is T3DConnector then begin xConn := T3DConnector(TTreeNode(glObject.tagObject).Data); glObject1 := TGLFreeForm(xConn.FGLObject1); off_x := glObject1.Position.X - xConn.FGLPoint.x; if abs(off_x) < 0.0001 then off_x := 0; off_y := glObject1.Position.Y - xConn.FGLPoint.y; if abs(off_y) < 0.0001 then off_y := 0; off_z := glObject1.Position.Z - xConn.FGLPoint.z; if abs(off_z) < 0.0001 then off_z := 0; xConn.FOffset.x := off_x / Factor; xConn.FOffset.y := off_z / Factor; xConn.FOffset.z := off_y / Factor; edScsOffsetX.Text := FloatToStr(off_x); edScsOffsetY.Text := FloatToStr(off_y); edScsOffsetZ.Text := FloatToStr(off_z); end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.SetConnectorsOffset', E.Message); end; end; procedure Tfrm3D.nDeleteAllSubSidesClick(Sender: TObject); var i, j: Integer; xSide, xSubSide: T3DSide; xSideNode, xSubSideNode: TTreeNode; xGLObject, xGLSubObject: TGLBaseSceneObject; begin try if ModelTree.SelectionCount = 1 then begin xSideNode := ModelTree.Selections[0]; xSide := T3DSide(xSideNode.Data); xGLObject := TGLBaseSceneObject(xSide.FGLObject); for i := 0 to xSideNode.Count - 1 do begin xSubSideNode := xSideNode.Item[i]; xSubSide := T3DSide(xSubSideNode.Data); xGLSubObject := TGLBaseSceneObject(xSubSide.FGLObject); if i = 0 then begin xSide.FGLObject := xGLSubObject; xGLSubObject.TagObject := xSideNode; TGLPolygon(xGLSubObject).Nodes.Clear; for j := 0 to Length(xSide.FGLPoints) - 1 do begin TGLPolygon(xGLSubObject).AddNode(xSide.FGLPoints[j].x, xSide.FGLPoints[j].y, xSide.FGLPoints[j].z); end; end else begin DummyCube.Remove(xGLSubObject, True); end; end; xSideNode.DeleteChildren; xSide.FSubSides.Clear; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.nDeleteAllSubSidesClick', E.Message); end; end; function Tfrm3D.GetModelObjectByComponID(aComponID: Integer; aModelType: Byte): TObject; var i, j, k, ii, jj, kk, s: integer; xRoom: T3DRoom; xWall: T3DWall; xWallElement: T3DWallElement; xBalconElement: T3DBalconElement; xSlope: T3DSlope; xSide, xSubSide: T3DSide; x3DSObject: T3DSObject; xConn: T3DConnector; xLine: T3DLine; begin try Result := nil; // распарсить комнаты if aModelType = 1 then begin for i := 0 to F3DStreamModel.FRooms.Count - 1 do begin xRoom := T3DRoom(F3DStreamModel.FRooms[i]); if xRoom.FSCSComponID = aComponID then begin Result := xRoom; exit; end; // распарсить стены каждой комнаты for j := 0 to xRoom.FWalls.Count - 1 do begin xWall := T3DWall(xRoom.FWalls[j]); if xWall.FSCSComponID = aComponID then begin Result := xWall; exit; end; // распарсить элементы каждой стены for k := 0 to xWall.FWallElements.Count - 1 do begin xWallElement := T3DWallElement(xWall.FWallElements[k]); if xWallElement.FSCSComponID = aComponID then begin Result := xWallElement; exit; end; // окно if xWallElement.FElementType = dotWindow then begin // добавить откосы for ii := 0 to xWallElement.FSlopes.Count - 1 do begin xSlope := T3DSlope(xWallElement.FSlopes[ii]); if xSlope.FSCSComponID = aComponID then begin Result := xSlope; exit; end; end; end; // дверь if xWallElement.FElementType = dotDoor then begin // добавить откосы for ii := 0 to xWallElement.FSlopes.Count - 1 do begin xSlope := T3DSlope(xWallElement.FSlopes[ii]); if xSlope.FSCSComponID = aComponID then begin Result := xSlope; exit; end; end; end; // балкон if xWallElement.FElementType = dotBalcony then begin // добавить откосы for ii := 0 to xWallElement.FSlopes.Count - 1 do begin xSlope := T3DSlope(xWallElement.FSlopes[ii]); if xSlope.FSCSComponID = aComponID then begin Result := xSlope; exit; end; end; // добавить элементы балкона for ii := 0 to xWallElement.FBalconElements.Count - 1 do begin xBalconElement := T3DBalconElement(xWallElement.FBalconElements[ii]); if xBalconElement.FSCSComponID = aComponID then begin Result := xBalconElement; exit; end; end; end; end; end; end; end; if aModelType = 2 then begin for i := 0 to F3DStreamModel.FScsObjects.Count - 1 do begin if TObject(F3DStreamModel.FScsObjects[i]) is T3DConnector then begin xConn := T3DConnector(F3DStreamModel.FScsObjects[i]); if xConn.FSCSComponID = aComponID then begin Result := xConn; exit; end; end; if TObject(F3DStreamModel.FScsObjects[i]) is T3DLine then begin xLine := T3DLine(F3DStreamModel.FScsObjects[i]); if xLine.FSCSComponID = aComponID then begin Result := xLine; exit; end; end; end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.GetModelObjectByComponID', E.Message); end; end; function Tfrm3D.GetSimilarSide(aSide: T3DSide; aObject: TObject): T3DSide; var i, j: integer; SidesList: TList; xSide: T3DSide; begin try Result := nil; if aObject = nil then exit; if aObject is T3DRoom then begin SidesList := TList.create; SidesList.Add(T3DRoom(aObject).FCeiling); if T3DRoom(aObject).FFloor <> nil then SidesList.Add(T3DRoom(aObject).FFloor); end; if aObject is T3DWall then begin SidesList := T3DWall(aObject).FSides; end; if aObject is T3DWallElement then begin SidesList := T3DWallElement(aObject).FSides; end; if aObject is T3DBalconElement then begin SidesList := T3DBalconElement(aObject).FSides; end; if aObject is T3DSlope then begin SidesList := T3DSlope(aObject).FSides; end; // Перебор for i := 0 to SidesList.Count - 1 do begin xSide := T3DSide(SidesList[i]); if CmpSides(aSide, xSide) then begin Result := xSide; exit; end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.GetSimilarSide', E.Message); end; end; function Tfrm3D.CmpSides(aSide1, aSide2: T3DSide): Boolean; var i, j: integer; begin try Result := True; if aSide1.FWallType <> aSide2.FWallType then begin Result := False; exit; end; if Length(aSide1.FPoints) <> Length(aSide2.FPoints) then begin Result := False; exit; end; for i := 0 to Length(aSide1.FPoints) - 1 do begin if not EQD(aSide1.FPoints[i].x, aSide2.FPoints[i].x) then begin Result := False; exit; end; if not EQD(aSide1.FPoints[i].y, aSide2.FPoints[i].y) then begin Result := False; exit; end; if not EQD(aSide1.FPoints[i].z, aSide2.FPoints[i].z) then begin Result := False; exit; end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.CmpSides', E.Message); end; end; procedure Tfrm3D.Edit2Exit(Sender: TObject); begin FirstPersonCamera.FocalLength := strtoint(Edit2.Text); GLCamera.FocalLength := strtoint(Edit2.Text); //GLCamera.DepthOfView := 100; GLCamera.DepthOfView := Trunc(100 * gtx/400); if GLCamera.DepthOfView > 500 then GLCamera.DepthOfView := 500; if GLCamera.DepthOfView < 100 then GLCamera.DepthOfView := 100; end; procedure Tfrm3D.btnEmptyClick(Sender: TObject); begin if btnEmpty.Down then begin mDesc.Lines.Text := ''; end else mDesc.Lines.Text := 'empty'; if btnEmpty.GroupIndex <> 0 then begin mDesc.Lines.Text := ''; end else mDesc.Lines.Text := 'empty'; ChangeDesc; end; procedure Tfrm3D.NDel3DObjectClick(Sender: TObject); var i, j: Integer; x3DObject: T3DSObject; xSideNode: TTreeNode; xGLObject: TGLBaseSceneObject; xRoom: T3DRoom; begin try if ModelTree.SelectionCount = 1 then begin xSideNode := ModelTree.Selections[0]; x3DObject := T3DSObject(xSideNode.Data); xGLObject := TGLBaseSceneObject(x3DObject.FGLObject); FSelection.Remove(xGLObject); //add DummyCube.Remove(xGLObject, True); xSideNode.Free; xRoom := x3DObject.FParent; xRoom.F3DSObjects.Delete(xRoom.F3DSObjects.IndexOf(x3DObject)); FreeAndNil(x3DObject); end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.nDelete3DObjectClick', E.Message); end; end; function Tfrm3D.GetObjectFileByHash(aHash: string): string; var i: integer; tmpdir, tmpfname, str: string; begin try Result := ''; if aHash <> '' then begin tmpdir := GetWorkDir; // ExtractDirByCategoryType(dctPictures); for i := 0 to F3DModel.F3DSHashs.Count - 1 do begin str := F3DModel.F3DSHashs.Strings[i]; if str = aHash then begin tmpfname := tmpdir + '\' + str + '.3ds'; if FileExists(tmpfname) then begin Result := tmpfname; break; end; end; end; if Result = '' then begin for i := 0 to F3DModel.FHashs.Count - 1 do begin str := F3DModel.FHashs.Strings[i]; if str = aHash then begin tmpfname := tmpdir + '\' + str + '.3ds'; if FileExists(tmpfname) then begin Result := tmpfname; break; end; end; end; end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.GetObjectFileByHash', E.Message); end; end; procedure Tfrm3D.LoadModelAddParamsFromStream(const AFile: String); var fFileName: string; //08.09.2011 Buffer: array[0..1023] of Char; TempPath: string; xStream: TFileStream; xSize: Integer; mStream: TMemoryStream; begin try fFileName := AFile; if fFileName = '' then begin TempPath := GetAnsiTempPath; //08.09.2011 SetString(TempPath, Buffer, GetTempPath(Sizeof(Buffer) - 1, Buffer)); fFileName := TempPath + '3dmodel.pwd'; end; if not FileExists(fFileName) then exit; xStream := SafeOpenFileStream(fFileName, fmOpenRead or fmShareExclusive, 'Tfrm3D.LoadModelAddParamsFromStream', cSCSComponent_Msg22_12); if xStream <> nil then begin if xStream.Size = 0 then begin try FreeAndNil(xStream); except end; exit; end; xStream.Read(xSize, 4); mStream := TMemoryStream.Create; StreamToStream(xStream, mStream, xSize); mStream.Seek(0, soFromBeginning); SetFileData(mStream); FreeAndNil(mStream); FreeAndNil(xStream); end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.LoadModelAddParamsFromStream', E.Message); end; end; procedure Tfrm3D.SaveModelAddParamsToStream(const AFile: String); var fFileName: string; //08.09.2011 Buffer: array[0..1023] of Char; TempPath: string; xStream: TFileStream; xSize: Integer; mStream: TMemoryStream; begin try fFileName := AFile; if fFileName = '' then begin TempPath := GetAnsiTempPath; //08.09.2011 SetString(TempPath, Buffer, GetTempPath(Sizeof(Buffer) - 1, Buffer)); fFileName := TempPath + '3dmodel.pwd'; end; xStream := SafeOpenFileStream(fFileName, fmCreate or fmShareExclusive, 'Tfrm3D.SaveModelAddParamsToStream', cSCSComponent_Msg22_12); if xStream <> nil then begin xSize := 0; mStream := TMemoryStream.Create; GetFileData(mStream); xSize := mStream.Size; mStream.Seek(0, soFromBeginning); xStream.Write(xSize, 4); StreamToStream(mStream, xStream, xSize); FreeAndNil(mStream); FreeAndNil(xStream); end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.SaveModelAddParamsToStream', E.Message); end; end; procedure Tfrm3D.CollectFileDataFromModel(Stream: TStream); var i, xCount: integer; xSize: Integer; xStream: TFileStream; xFiles: TStringList; SearchRec: TSearchRec; tmpdir, FName: string; begin try tmpdir := GetWorkDir; // ExtractDirByCategoryType(dctPictures); if F3DModel <> nil then begin xFiles := TStringList.Create; for i := 0 to F3DModel.FFilesHashs.Count - 1 do begin FName := ExtractFileName(F3DModel.FFilesHashs[i]); if xFiles.IndexOf(FName) < 0 then xFiles.Add(FName); end; // Save sides textures xCount := F3DModel.FHashs.Count; Stream.Write(xCount, 4); for i := 0 to xCount - 1 do begin WriteString(Stream, F3DModel.FHashs[i]); FName := tmpdir + '\' + F3DModel.FHashs[i] + '.bmp'; if FileExists(FName) then begin xStream := TFileStream.Create(FName, fmOpenRead); xSize := xStream.Size; xStream.Seek(0,soFromBeginning); Stream.Write(xSize, 4); StreamToStream(xStream, Stream, xSize); FreeAndNil(xStream); end else begin xSize := 0; Stream.Write(xSize, 4); end; end; // Save 3ds Objects xCount := F3DModel.F3DSHashs.Count; Stream.Write(xCount, 4); for i := 0 to xCount - 1 do begin WriteString(Stream, F3DModel.F3DSHashs[i]); FName := tmpdir + '\' + F3DModel.F3DSHashs[i] + '.3ds'; if FileExists(FName) then begin xStream := TFileStream.Create(FName, fmOpenRead); xSize := xStream.Size; xStream.Seek(0,soFromBeginning); Stream.Write(xSize, 4); StreamToStream(xStream, Stream, xSize); FreeAndNil(xStream); end else begin xSize := 0; Stream.Write(xSize, 4); end; end; // Save 3ds Objects Textures xCount := xFiles.Count; Stream.Write(xCount, 4); for i := 0 to xCount - 1 do begin WriteString(Stream, xFiles.Strings[i]); FName := tmpdir + '\' + xFiles.Strings[i]; if FileExists(FName) then begin xStream := TFileStream.Create(FName, fmOpenRead); xSize := xStream.Size; xStream.Seek(0,soFromBeginning); Stream.Write(xSize, 4); StreamToStream(xStream, Stream, xSize); FreeAndNil(xStream); end else begin xSize := 0; Stream.Write(xSize, 4); end; end; FreeAndNil(xFiles); end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.GetFileData', E.Message); end; end; procedure Tfrm3D.GetFileData(Stream: TStream); var i, xCount: integer; xSize: Integer; xStream: TFileStream; xFiles: TStringList; SearchRec: TSearchRec; tmpdir, FName: string; begin try tmpdir := GetWorkDir; // ExtractDirByCategoryType(dctPictures); xFiles := TStringList.Create; // Save sides textures if (FindFirst(tmpdir + '\*.bmp', faAnyFile, SearchRec) = 0) or (FindFirst(tmpdir + '\*.jpg', faAnyFile, SearchRec) = 0) then begin repeat if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then begin if not (SearchRec.Attr and faDirectory = faDirectory) then xFiles.Add(SearchRec.Name); end; until FindNext(SearchRec) <> 0; FindClose(SearchRec); end; xCount := xFiles.Count; Stream.Write(xCount, 4); for i := 0 to xCount - 1 do begin WriteString(Stream, xFiles.Strings[i]); FName := tmpdir + '\' + xFiles.Strings[i]; xStream := TFileStream.Create(FName, fmOpenRead); xSize := xStream.Size; xStream.Seek(0,soFromBeginning); Stream.Write(xSize, 4); StreamToStream(xStream, Stream, xSize); FreeAndNil(xStream); end; xFiles.Clear; // Save 3ds Objects if FindFirst(tmpdir + '\*.3ds', faAnyFile, SearchRec) = 0 then begin repeat if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then begin if not (SearchRec.Attr and faDirectory = faDirectory) then xFiles.Add(SearchRec.Name); end; until FindNext(SearchRec) <> 0; FindClose(SearchRec); end; xCount := xFiles.Count; Stream.Write(xCount, 4); for i := 0 to xCount - 1 do begin WriteString(Stream, xFiles.Strings[i]); FName := tmpdir + '\' + xFiles.Strings[i]; xStream := TFileStream.Create(FName, fmOpenRead); xSize := xStream.Size; xStream.Seek(0,soFromBeginning); Stream.Write(xSize, 4); StreamToStream(xStream, Stream, xSize); FreeAndNil(xStream); end; FreeAndNil(xFiles); except on E: Exception do AddExceptionToLogEx('Tfrm3D.GetFileData', E.Message); end; end; procedure Tfrm3D.ExtractAllFiles(Stream: TStream); var i, xCount: integer; xSize: Integer; xStream: TMemoryStream; //TFileStream; xFiles: TStringList; SearchRec: TSearchRec; tmpdir, FName, xFileName: string; begin try tmpdir := GetWorkDir; // ExtractDirByCategoryType(dctPictures); // Load Sides Textures Stream.Read(xCount, 4); for i := 0 to xCount - 1 do begin xFileName := ReadStringFromStream(Stream); FName := tmpdir + '\' + xFileName + '.bmp'; Stream.Read(xSize, 4); xStream := TMemoryStream.Create; StreamToStream(Stream, xStream, xSize); xStream.Seek(0,soFromBeginning); if not FileExists(FName) then xStream.SaveToFile(FName); FreeAndNil(xStream); end; // Load 3ds Objects Stream.Read(xCount, 4); for i := 0 to xCount - 1 do begin xFileName := ReadStringFromStream(Stream); FName := tmpdir + '\' + xFileName + '.3ds'; Stream.Read(xSize, 4); xStream := TMemoryStream.Create; StreamToStream(Stream, xStream, xSize); xStream.Seek(0,soFromBeginning); if not FileExists(FName) then xStream.SaveToFile(FName); FreeAndNil(xStream); end; // Load 3ds Objects Textures Stream.Read(xCount, 4); for i := 0 to xCount - 1 do begin xFileName := ReadStringFromStream(Stream); FName := tmpdir + '\' + xFileName; Stream.Read(xSize, 4); xStream := TMemoryStream.Create; StreamToStream(Stream, xStream, xSize); xStream.Seek(0,soFromBeginning); if not FileExists(FName) then xStream.SaveToFile(FName); FreeAndNil(xStream); end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.SetFileData', E.Message); end; end; procedure Tfrm3D.SetFileData(Stream: TStream); var i, xCount: integer; xSize: Integer; xStream: TMemoryStream; //TFileStream; xFiles: TStringList; SearchRec: TSearchRec; tmpdir, FName, xFileName: string; begin try tmpdir := GetWorkDir; // ExtractDirByCategoryType(dctPictures); // Load Sides Textures Stream.Read(xCount, 4); for i := 0 to xCount - 1 do begin xFileName := ReadStringFromStream(Stream); FName := tmpdir + '\test_texture\' + xFileName; Stream.Read(xSize, 4); xStream := TMemoryStream.Create; StreamToStream(Stream, xStream, xSize); xStream.Seek(0,soFromBeginning); if not FileExists(FName) then xStream.SaveToFile(FName); FreeAndNil(xStream); end; // Load 3ds Objects Stream.Read(xCount, 4); for i := 0 to xCount - 1 do begin xFileName := ReadStringFromStream(Stream); FName := tmpdir + '\test_3ds\' + xFileName; Stream.Read(xSize, 4); xStream := TMemoryStream.Create; StreamToStream(Stream, xStream, xSize); xStream.Seek(0,soFromBeginning); if not FileExists(FName) then xStream.SaveToFile(FName); FreeAndNil(xStream); end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.SetFileData', E.Message); end; end; procedure Tfrm3D.LoadSelectionData; var i, j: integer; Cad: TF_Cad; xName: string; begin try cbLists.Properties.Items.Clear; cbScsLists.Properties.Items.Clear; if G3DModelForProject then // for project begin for i := 0 to FSCS_Main.MDIChildCount - 1 do begin Cad := TF_CAD(FSCS_Main.MDIChildren[i]); xName := Cad.FCADListName + ' ' + IntToStr(Cad.FCADListIndex); cbLists.Properties.Items.Add(xName); cbScsLists.Properties.Items.Add(xName); if FSCS_Main.ActiveMDIChild = Cad then begin cbLists.ItemIndex := i; cbScsLists.ItemIndex := i; end; end; end else // for list only begin Cad := TF_CAD(FSCS_Main.ActiveMDIChild); xName := Cad.FCADListName + ' ' + IntToStr(Cad.FCADListIndex); cbLists.Properties.Items.Add(xName); cbScsLists.Properties.Items.Add(xName); cbLists.ItemIndex := 0; cbScsLists.ItemIndex := 0; end; cbObjectsTypes.Properties.Items.Clear; cbObjectsTypes.Properties.Items.Add(''); // 0 {//15.08.2012 cbObjectsTypes.Properties.Items.Add('Стены'); // 1 cbObjectsTypes.Properties.Items.Add('Двери'); // 2 cbObjectsTypes.Properties.Items.Add('Окна'); // 3 cbObjectsTypes.Properties.Items.Add('Балконы'); // 4 cbObjectsTypes.Properties.Items.Add('Откосы'); // 5 cbObjectsTypes.Properties.Items.Add('Арки'); // 6 cbObjectsTypes.Properties.Items.Add('Ниши'); // 7 cbObjectsTypes.Properties.Items.Add('Полы'); // 8 cbObjectsTypes.Properties.Items.Add('Потолки'); // 9 cbObjectsTypes.Properties.Items.Add('Внутренние грани'); // 10 cbObjectsTypes.Properties.Items.Add('Внешние грани'); // 11 cbObjectsTypes.Properties.Items.Add('3ds объекты'); // 12} cbObjectsTypes.Properties.Items.Add(cForm3D_Mes7_1); cbObjectsTypes.Properties.Items.Add(cForm3D_Mes7_2); cbObjectsTypes.Properties.Items.Add(cForm3D_Mes7_3); cbObjectsTypes.Properties.Items.Add(cForm3D_Mes7_4); cbObjectsTypes.Properties.Items.Add(cForm3D_Mes7_5); cbObjectsTypes.Properties.Items.Add(cForm3D_Mes7_6); cbObjectsTypes.Properties.Items.Add(cForm3D_Mes7_7); cbObjectsTypes.Properties.Items.Add(cForm3D_Mes7_8); cbObjectsTypes.Properties.Items.Add(cForm3D_Mes7_9); cbObjectsTypes.Properties.Items.Add(cForm3D_Mes7_10); cbObjectsTypes.Properties.Items.Add(cForm3D_Mes7_11); cbObjectsTypes.Properties.Items.Add(cForm3D_Mes7_12); cbObjectsTypes.ItemIndex := 0; cbScsObjectsTypes.Properties.Items.Clear; cbScsObjectsTypes.Properties.Items.Add(''); // 0 {//15.08.2012 cbScsObjectsTypes.Properties.Items.Add('Объекты'); // 1 cbScsObjectsTypes.Properties.Items.Add('Трассы'); // 2 cbScsObjectsTypes.Properties.Items.Add('Спуски-подъемы'); // 3 cbScsObjectsTypes.Properties.Items.Add('М-э спуски-подъемы'); // 4} cbScsObjectsTypes.Properties.Items.Add(cForm3D_Mes8_1); cbScsObjectsTypes.Properties.Items.Add(cForm3D_Mes8_2); cbScsObjectsTypes.Properties.Items.Add(cForm3D_Mes8_3); cbScsObjectsTypes.Properties.Items.Add(cForm3D_Mes8_4); cbScsObjectsTypes.ItemIndex := 0; except on E: Exception do AddExceptionToLogEx('Tfrm3D.LoadSelectionData', E.Message); end; end; procedure Tfrm3D.cbListsPropertiesCloseUp(Sender: TObject); begin try cbObjectsTypes.ItemIndex := 0; ModelTree.ClearSelection; DeselectGLObjects; except on E: Exception do AddExceptionToLogEx('Tfrm3D.cbListsPropertiesCloseUp', E.Message); end; end; procedure Tfrm3D.cbObjectsTypesPropertiesCloseUp(Sender: TObject); begin try ModelTree.ClearSelection; if cbObjectsTypes.ItemIndex = 0 then begin DeselectGLObjects; end else begin FindSelectNodesByType(cbObjectsTypes.ItemIndex); end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.cbObjectsTypesPropertiesCloseUp', E.Message); end; end; procedure Tfrm3D.FindSelectNodesByType(aType: Integer); var i: integer; xModelNode, xNode: TTreeNode; xNodes, xSides, SelNodes: TList; xSide: T3DSide; xObject: T3DSObject; begin try xNodes := TList.Create; xModelNode := ModelTree.Items.GetFirstNode; xNode := xModelNode.getFirstChild; while xNode <> nil do begin if xNode.Text = cbLists.Text then break; xNode := xNode.GetNextSibling; end; xNodes.Add(xNode); xSides := GetAllSidesNodesByNodes(xNodes); FreeAndNil(xNodes); SelNodes := TList.Create; for i := 0 to xSides.Count - 1 do begin xNode := TTreeNode(xSides[i]); case aType of 1: begin if TObject(xNode.Data) is T3DSide then begin xSide := T3DSide(xNode.Data); if xSide.FFaceType = ftNetPath then begin ModelTree.Select(xNode, [ssCtrl]); SelNodes.Add(xNode); end; end; end; 2: begin if TObject(xNode.Data) is T3DSide then begin xSide := T3DSide(xNode.Data); if xSide.FFaceType = ftNetDoor then begin ModelTree.Select(xNode, [ssCtrl]); SelNodes.Add(xNode); end; end; end; 3: begin if TObject(xNode.Data) is T3DSide then begin xSide := T3DSide(xNode.Data); if xSide.FFaceType = ftNetWindow then begin ModelTree.Select(xNode, [ssCtrl]); SelNodes.Add(xNode); end; end; end; 4: begin if TObject(xNode.Data) is T3DSide then begin xSide := T3DSide(xNode.Data); if (xSide.FFaceType = ftNetBalconDoor) or (xSide.FFaceType = ftNetBalconWindow) then begin ModelTree.Select(xNode, [ssCtrl]); SelNodes.Add(xNode); end; end; end; 5: begin if TObject(xNode.Data) is T3DSide then begin xSide := T3DSide(xNode.Data); if xSide.FWallType in [fwtDoorSlope, fwtWindowSlope, fwtBalconSlope] then begin ModelTree.Select(xNode, [ssCtrl]); SelNodes.Add(xNode); end; end; end; 6: begin if TObject(xNode.Data) is T3DSide then begin xSide := T3DSide(xNode.Data); if xSide.FWallType = fwtArc then begin ModelTree.Select(xNode, [ssCtrl]); SelNodes.Add(xNode); end; end; end; 7: begin if TObject(xNode.Data) is T3DSide then begin xSide := T3DSide(xNode.Data); if xSide.FWallType = fwtNiche then begin ModelTree.Select(xNode, [ssCtrl]); SelNodes.Add(xNode); end; end; end; 8: begin if TObject(xNode.Data) is T3DSide then begin xSide := T3DSide(xNode.Data); if xSide.FFaceType = ftNetFloor then begin ModelTree.Select(xNode, [ssCtrl]); SelNodes.Add(xNode); end; end; end; 9: begin if TObject(xNode.Data) is T3DSide then begin xSide := T3DSide(xNode.Data); if xSide.FFaceType = ftNetCeiling then begin ModelTree.Select(xNode, [ssCtrl]); SelNodes.Add(xNode); end; end; end; 10: begin if TObject(xNode.Data) is T3DSide then begin xSide := T3DSide(xNode.Data); if xSide.FWallType = fwtInner then begin ModelTree.Select(xNode, [ssCtrl]); SelNodes.Add(xNode); end; end; end; 11: begin if TObject(xNode.Data) is T3DSide then begin xSide := T3DSide(xNode.Data); if xSide.FWallType = fwtOuter then begin ModelTree.Select(xNode, [ssCtrl]); SelNodes.Add(xNode); end; end; end; 12: begin if TObject(xNode.Data) is T3DSObject then begin xObject := T3DSObject(xNode.Data); ModelTree.Select(xNode, [ssCtrl]); SelNodes.Add(xNode); end; end; end; end; //Tolik -- 11/03/2017 -- xSides.Free; // OnSelectNodes(SelNodes); // -- Tolik -- 11/03/2017 -- SelNodes.Free; // except on E: Exception do AddExceptionToLogEx('Tfrm3D.FindSelectNodesByType', E.Message); end; end; procedure Tfrm3D.FindSelectScsNodesByType(aType: Integer); var i: integer; xModelNode, xNode: TTreeNode; xNodes, xScsObjects, SelNodes: TList; xConn: T3DConnector; xLine: T3DLine; begin try ScsModelTree.Items.BeginUpdate; try xNodes := TList.Create; xModelNode := ScsModelTree.Items.GetFirstNode; xNode := xModelNode.getFirstChild; while xNode <> nil do begin if xNode.Text = cbScsLists.Text then break; xNode := xNode.GetNextSibling; end; xNodes.Add(xNode); xScsObjects := GetAllSidesNodesByNodes(xNodes); FreeAndNil(xNodes); SelNodes := TList.Create; for i := 0 to xScsObjects.Count - 1 do begin xNode := TTreeNode(xScsObjects[i]); case aType of 1: begin if TObject(xNode.Data) is T3DConnector then begin xConn := T3DConnector(xNode.Data); ScsModelTree.Select(xNode, [ssCtrl]); SelNodes.Add(xNode); end; end; 2: begin if TObject(xNode.Data) is T3DLine then begin xLine := T3DLine(xNode.Data); if xLine.FLineType = lt_Line then begin ScsModelTree.Select(xNode, [ssCtrl]); SelNodes.Add(xNode); end; end; end; 3: begin if TObject(xNode.Data) is T3DLine then begin xLine := T3DLine(xNode.Data); if xLine.FLineType = lt_Raise then begin ScsModelTree.Select(xNode, [ssCtrl]); SelNodes.Add(xNode); end; end; end; 4: begin if TObject(xNode.Data) is T3DLine then begin xLine := T3DLine(xNode.Data); if xLine.FLineType = lt_FloorRaise then begin ScsModelTree.Select(xNode, [ssCtrl]); SelNodes.Add(xNode); end; end; end; end; end; // Tolik 11/03/2017 -- xScsObjects.Free; // OnSelectNodes(SelNodes); // Tolik 11/03/2017 -- SelNodes.Free; // finally ScsModelTree.Items.EndUpdate; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.FindSelectScsNodesByType', E.Message); end; end; procedure Tfrm3D.ChangeTextureScale; var i: integer; xObject: T3DSide; xGLObject: TGLBaseSceneObject; Bmp: TBitmap; begin try if edTextureScale.Text = '' then exit; for i := 0 to FPropObjects.Count - 1 do begin if TOBject(TTreeNode(FPropObjects[i]).Data) is T3DSide then begin xObject := T3DSide(TTreeNode(FPropObjects[i]).Data); xGLObject := TGLBaseSceneObject(xObject.FGLObject); xObject.FTextureScale := StrToInt(edTextureScale.Text); if (xGLObject is TGLMesh) then begin RotateTextureToAngleM(xObject, TGLMesh(xGLObject), xObject.FTextureRotate, xObject.FMirror); end; if (xGLObject is TGLPolygon) then begin RotateTextureToAngleP(xObject, TGLPolygon(xGLObject), xObject.FTextureRotate, xObject.FMirror); end; end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.ChangeTextureScale', E.Message); end; end; procedure Tfrm3D.edTextureScaleExit(Sender: TObject); begin ChangeTextureScale; end; procedure Tfrm3D.edTextureScaleKeyPress(Sender: TObject; var Key: Char); begin if Key = #13 then ChangeTextureScale; end; function Tfrm3D.is3DSObject(aObj: TGLBaseSceneObject): Boolean; var xNode: TTreeNode; xObject: TObject; Obj: TGLBaseSceneObject; begin try Result := False; xNode := TTreeNode(aObj.tagObject); Obj := GlsceneViewer.Buffer.GetPickedobject(mx, my); if TObject(xNode.Data) is T3DSObject then begin Result := True; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.is3DSObject', E.Message); end; end; function Tfrm3D.GetDistAngle(AP1, AP2: TDoublePoint): Double; var Len_X, Len_Y: Double; AngleRad: Double; AddAngle: Double; begin Result := 0; try Len_X := Abs(AP1.x - AP2.x); Len_Y := Abs(AP1.y - AP2.y); // проверки и вычиление угла в градусах AddAngle := 0; AngleRad := 0; // для неортогональных линий if (AP1.x < AP2.x) and (AP1.y < AP2.y) then // 1 begin AngleRad := ArcTan2(Len_X, Len_Y); // угол в радианах AddAngle := 0; end; if (AP1.x < AP2.x) and (AP1.y > AP2.y) then //4 begin AngleRad := ArcTan2(Len_Y, Len_X); // угол в радианах AddAngle := 90; end; if (AP1.x > AP2.x) and (AP1.y > AP2.y) then //3 begin AngleRad := ArcTan2(Len_X, Len_Y); // угол в радианах AddAngle := 180; end; if (AP1.x > Ap2.x) and (AP1.y < AP2.y) then //2 begin AngleRad := ArcTan2(Len_Y, Len_X); // угол в радианах AddAngle := 270; end; Result := Round(AngleRad * 180 / pi) + AddAngle; // для ортогональных линий if (AP1.y = AP2.y) and (AP1.x < AP2.x) then Result := 90; if (AP1.y = AP2.y) and (AP1.x > AP2.x) then Result := 270; if (AP1.x = AP2.x) and (AP1.y < AP2.y) then Result := 0; if (AP1.x = AP2.x) and (AP1.y > AP2.y) then Result := 180; except on E: Exception do AddExceptionToLogEx('Tfrm3D.GetDistAngle', E.Message); end; end; procedure Tfrm3D.UndoCutSides; var i, j, cnt: Integer; xGLSide1, xGLSide2: TGLPolygon; xNodeSide1, xNodeSide2, xNodeParentSide: TTreeNode; xSide1, xSide2, xParentSide: T3DSide; xSideNode, xSubSideNode: TTreeNode; xGLObject, xGLSubObject: TGLBaseSceneObject; ZOrder: Double; begin try xGLSide1 := FResizeData.Side1; xGLSide2 := FResizeData.Side2; xNodeSide1 := TTreeNode(xGLSide1.TagObject); xNodeSide2 := TTreeNode(xGLSide2.TagObject); xSide1 := T3DSide(xNodeSide1.Data); xSide2 := T3DSide(xNodeSide2.Data); xParentSide := T3DSide(xSide1.FParent); xNodeParentSide := xNodeSide1.Parent; // delete Side2 DummyCube.Remove(xGLSide2, True); xNodeSide2.Delete; xParentSide.FSubSides.Remove(xSide2); // backup params to Side1 cnt := Length(FResizeData.BasisNodes); xGLSide1.Nodes.Clear; SetLength(xSide1.FGLPoints, cnt); SetLength(xSide1.FPoints, cnt); ZOrder := xSide1.FZOrder; for i := 0 to cnt - 1 do begin xGLSide1.AddNode(FResizeData.BasisNodes[i].x, FResizeData.BasisNodes[i].y, FResizeData.BasisNodes[i].z); xSide1.FGLPoints[i].x := FResizeData.BasisNodes[i].x; xSide1.FGLPoints[i].y := FResizeData.BasisNodes[i].y - ZOrder; xSide1.FGLPoints[i].z := FResizeData.BasisNodes[i].z; xSide1.FPoints[i].x := xSide1.FGLPoints[i].x / Factor; xSide1.FPoints[i].z := xSide1.FGLPoints[i].y / Factor; xSide1.FPoints[i].y := xSide1.FGLPoints[i].z / Factor; end; // if Side1 is single SubSide if (xParentSide.FSubSides.Count = 1) and (xNodeParentSide.Count = 1) then begin xNodeSide1.Delete; xParentSide.FSubSides.Remove(xSide1); xParentSide.FGLObject := xGLSide1; xGLSide1.TagObject := xNodeParentSide; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.UndoCutSides', E.Message); end; end; procedure Tfrm3D.cbObjectHashsPropertiesCloseUp(Sender: TObject); var i, Index: Integer; xObject: T3DSObject; xGLObject: TGLFreeForm; tmpdir, tmpfname, ExtStr, BmpFName: string; HashStr: string; begin try Index := cbObjectHashs.ItemIndex; if Index >= 0 then begin HashStr := cbObjectHashs.Properties.Items[Index]; tmpdir := GetWorkDir; // ExtractDirByCategoryType(dctPictures); tmpfname := GetImageFileByHash(HashStr); ExtStr := ExtractFileExt(tmpfname); if tmpfname <> '' then begin imgObjectTexture.Picture.LoadFromFile(tmpfname); for i := 0 to FPropObjects.Count - 1 do begin if TObject(TTreeNode(FPropObjects[i]).Data) is T3DSObject then begin xObject := T3DSObject(TTreeNode(FPropObjects[i]).Data); xGLObject := TGLFreeForm(xObject.FGLObject); xObject.FTextureHash := HashStr; xObject.FTexture_ext := ExtStr; try xGLObject.Material.Texture.Image.LoadFromFile(tmpfname); except ShowMessage('File not found ' + tmpfname); end; //xGLObject.Material.Texture.MappingMode := tmmCubeMapCamera; end; end; end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.cbObjectHashsPropertiesCloseUp', E.Message); end; end; procedure Tfrm3D.bObjectTextureClearClick(Sender: TObject); var FName: string; i: integer; xObject: T3DSObject; xGLObject: TGLFreeForm; begin try imgObjectTexture.Clear; for i := 0 to FPropObjects.Count - 1 do begin if TOBject(TTreeNode(FPropObjects[i]).Data) is T3DSObject then begin xObject := T3DSObject(TTreeNode(FPropObjects[i]).Data); xGLObject := TGLFreeForm(xObject.FGLObject); xObject.FTextureHash := ''; xObject.FTexture_ext := ''; //xGLObject.Material.Texture.Disabled := True; //xGLObject.Material.Texture.Disabled := False; //xGLObject.Material.MaterialOptions := []; xGLObject.Material.Texture.DestroyHandles; FName := GetObjectFileByHash(xObject.FObjectHash); if FName <> '' then begin xGLObject.MaterialLibrary := MatLib; xGLObject.DeleteChildren; xGLObject.LoadFromFile(FName); end; end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.bObjectTextureClearClick', E.Message); end; end; procedure Tfrm3D.bObjectTextureChangeClick(Sender: TObject); var i: integer; FName: string; xObject: T3DSObject; xGLObject: TGLFreeForm; tmpdir, tmpfname, ExtStr, BmpFName: string; Bmp: TBitmap; Jpeg: TJPEGImage; HashStr: string; begin try FName := LoadTexture; if (FName <> '') and FileExists(FName) then begin imgObjectTexture.Picture.LoadFromFile(FName); ExtStr := ExtractFileExt(FName); tmpdir := GetWorkDir; // ExtractDirByCategoryType(dctPictures); // получаем HASH по загружаемому файлу HashStr := GetImageHash(FName); // по HASH ищем есть ли он в нашей базе tmpfname := GetImageFileByHash(HashStr); // если найден, то грузим его if tmpfname <> '' then begin end else // не найден - создаем для файла HASH, копируем в темп, грузим begin F3DModel.FHashs.Add(HashStr); tmpfname := tmpdir + '\' + HashStr + '.bmp'; if (ExtStr = '.jpg') or (ExtStr = '.jpeg') then begin Bmp := TBitmap.Create; Jpeg := TJPEGImage.Create; jpeg.CompressionQuality := 100; {Default Value} Jpeg.LoadFromFile(FName); Bmp.Assign(Jpeg); Bmp.SaveTofile(tmpfname); FreeAndNil(Bmp); FreeAndNil(Jpeg); end else CopyFile(PChar(FName), PChar(tmpfname), True); end; for i := 0 to FPropObjects.Count - 1 do begin if TObject(TTreeNode(FPropObjects[i]).Data) is T3DSObject then begin xObject := T3DSObject(TTreeNode(FPropObjects[i]).Data); xGLObject := TGLFreeForm(xObject.FGLObject); xObject.FTextureHash := HashStr; xObject.FTexture_ext := ExtStr; xGLObject.MaterialLibrary := nil; //xGLObject.Material.Texture.Disabled := False; //xGLObject.Material.MaterialOptions := []; xGLObject.Material.Texture.DestroyHandles; try xGLObject.Material.Texture.Image.LoadFromFile(tmpfname); except ShowMessage('File not found ' + tmpfname); end; //xGLObject.Material.Texture.MappingMode := tmmCubeMapCamera; end; end; // Resfresh HASHs cbObjectHashs.Properties.Items.Clear; for i := 0 to F3DModel.FHashs.Count - 1 do begin cbObjectHashs.Properties.Items.Add(F3DModel.FHashs.Strings[i]); end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.bObjectTextureChangeClick', E.Message); end; end; procedure Tfrm3D.MatLibTextureNeeded(Sender: TObject; var textureFileName: String); var tmpdir, fname, textfname, tmpfname, HashStr: string; i, j, xIndex: Integer; src_3ds_dir: string; dir_texture: string; xStr: string; templist: TStringList; //Tolik 20/02/2019 function UseTextureFullName(aName: String): Boolean; begin Result := False; if Pos(':', aName) = 2 then if FileExists(aName) then begin Result := True; exit; end; if Pos('\', aName) = 1 then if PosEx('\', aName, 1) = 2 then if FileExists(aName) then Result := True; end; begin try textfname := textureFileName; tmpdir := GetWorkDir; ErrorTextureLoad := False; dir_texture := tmpdir; if length(dir_texture) > 1 then begin if dir_texture[length(dir_texture)] <> '\' then dir_texture := dir_texture + '\'; end; if MatLib.TexturePaths <> dir_texture then MatLib.TexturePaths := dir_texture; // На создании 3ДС if FisCreate3DS then begin // Tolik 13/12/2018 -- //src_3ds_dir := ExtractFilePath(Open3DObject.FileName); src_3ds_dir := ExtractFilePath(FTextureFileName); // if length(src_3ds_dir) > 1 then begin if src_3ds_dir[length(src_3ds_dir)] <> '\' then src_3ds_dir := src_3ds_dir + '\'; end; //templist := TStringList.Create; //templist.LoadFromFile('c:\imgs.txt'); //if templist.IndexOf(Open3DObject.FileName + '\' + textureFileName) = -1 then //begin // templist.Add(Open3DObject.FileName + '\' + textureFileName); // templist.SaveToFile('c:\imgs.txt'); //end; //templist.Free; // Tolik 20/02/2019 //fname := src_3ds_dir + textureFileName; if UseTextureFullName(textureFileName) then fname := textureFileName else fname := src_3ds_dir + ExtractFileName(textureFileName); // if FileExists(fname) then begin textureFileName := textfname; // tmpdir := GetWorkDir; // ExtractDirByCategoryType(dctPictures); // получаем HASH по загружаемому файлу //Tolik 20/02/2019 //FName := src_3ds_dir + textfname; // HashStr := GetImageHash(FName) + ExtractFileExt(FName); // по HASH ищем есть ли он в нашей базе tmpfname := GetTextureFileByHash(HashStr); if tmpfname = '' then begin tmpfname := tmpdir + '\' + HashStr; CopyFile(PChar(FName), PChar(tmpfname), True); if FCurrObject is T3DSObject then xStr := 'c:\' + T3DSObject(FCurrObject).FObjectHash + '\' + textfname else if FCurrObject is T3DConnector then xStr := 'c:\' + T3DConnector(FCurrObject).FObjectHash + '\' + textfname; if F3DModel.FFiles.IndexOf(xStr) = -1 then begin F3DModel.FFiles.Add(xStr); j := F3DModel.FFiles.IndexOf(xStr); while F3DModel.FFilesHashs.Count - 1 < j do F3DModel.FFilesHashs.Add(''); F3DModel.FFilesHashs[j] := HashStr; end else begin j := F3DModel.FFiles.IndexOf(xStr); while F3DModel.FFilesHashs.Count - 1 < j do F3DModel.FFilesHashs.Add(''); F3DModel.FFilesHashs[j] := HashStr; end end else begin if FCurrObject is T3DSObject then xStr := 'c:\' + T3DSObject(FCurrObject).FObjectHash + '\' + textfname else if FCurrObject is T3DConnector then xStr := 'c:\' + T3DConnector(FCurrObject).FObjectHash + '\' + textfname; j := F3DModel.FFiles.IndexOf(xStr); if j < 0 then begin F3DModel.FFiles.Add(xStr); j := F3DModel.FFiles.IndexOf(xStr); while F3DModel.FFilesHashs.Count - 1 < j do F3DModel.FFilesHashs.Add(''); F3DModel.FFilesHashs[j] := HashStr; end else begin if F3DModel.FFilesHashs[j] <> HashStr then begin // Вообще то такого не должно бы происходить - но на всяк случай: HashStr := HashStr; F3DModel.FFiles.Add(xStr); j := F3DModel.FFiles.IndexOf(xStr); while F3DModel.FFilesHashs.Count - 1 < j do F3DModel.FFilesHashs.Add(''); F3DModel.FFilesHashs[j] := HashStr; end; end; end; if not FileExists(tmpdir + '\' + HashStr) then begin tmpfname := tmpdir + '\' + HashStr; CopyFile(PChar(FName), PChar(tmpfname), True); end; textureFileName := HashStr; end else begin // Tolik 03/12/2018 -- textureFileName := ':'; ErrorTextureLoad := True; exit; // if Not FileExists(dir_texture + 'empty.bmp') then CopyFile(PChar(ExeDir + '\3DTextures\empty.bmp'), PChar(dir_texture + 'empty.bmp'), True); if FileExists(dir_texture + 'empty.bmp') then textureFileName := 'empty.bmp' else textureFileName := ''; end; end else // На поднятии 3ДС begin if FCurrObject is T3DSObject then begin xStr := 'c:\' + T3DSObject(FCurrObject).FObjectHash + '\' + textfname; end else if FCurrObject is T3DConnector then begin xStr := 'c:\' + T3DConnector(FCurrObject).FObjectHash + '\' + textfname; end; xIndex := F3DModel.FFiles.IndexOf(xStr); if xIndex <> - 1 then begin tmpfname := F3DModel.FFilesHashs[xIndex]; fname := tmpdir + '\' + tmpfname; if FileExists(fname) then begin textureFileName := tmpfname; end else begin if Not FileExists(dir_texture + 'empty.bmp') then CopyFile(PChar(ExeDir + '\3DTextures\empty.bmp'), PChar(dir_texture + 'empty.bmp'), True); if FileExists(dir_texture + 'empty.bmp') then textureFileName := 'empty.bmp' else textureFileName := ''; end; end else begin if Not FileExists(dir_texture + 'empty.bmp') then CopyFile(PChar(ExeDir + '\3DTextures\empty.bmp'), PChar(dir_texture + 'empty.bmp'), True); if FileExists(dir_texture + 'empty.bmp') then textureFileName := 'empty.bmp' else textureFileName := ''; end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.MatLibTextureNeeded', E.Message); end; end; {TODO} // Глянуть где используется и Сравнить с UP3 // OK (* procedure Tfrm3D.SetFreeFormRotate(aObject: TGLFreeForm; aX, aY, aZ: Double); var vect31: TVector3f; oldroll: single; begin try oldroll := aObject.RollAngle; aObject.ResetRotations; GLSceneViewer.Camera.TransformationChanged; vect31[0] := 1; vect31[1] := 0; vect31[2] := 0; aObject.RotateAbsolute(vect31, aX); vect31[0] := 0; vect31[1] := 1; vect31[2] := 0; aObject.RotateAbsolute(vect31, aY); vect31[0] := 0; vect31[1] := 0; vect31[2] := 1; aObject.RotateAbsolute(vect31, aZ); //aObject.RollAngle := oldroll; //edX.Text := FloatToStr(glObject.Direction.x); //edY.Text := FloatToStr(glObject.Direction.y); //edZ.Text := FloatToStr(glObject.Direction.z); except on E: Exception do AddExceptionToLogEx('Tfrm3D.SetFreeFormRotate', E.Message); end; end; *) (* procedure Tfrm3D.ResetFreeFormRotate(aObject: TGLFreeForm); begin try aObject.ResetRotations; except on E: Exception do AddExceptionToLogEx('Tfrm3D.ResetFreeFormRotate', E.Message); end; end; *) procedure Tfrm3D.pcTreeTabClick(Sender: TObject); begin if pcTree.ActivePage = TabArchModel then begin pcProps.ActivePage := TabArchProps; end; if pcTree.ActivePage = TabScsModel then begin pcProps.ActivePage := TabScsProps; end; end; procedure Tfrm3D.cbScsListsPropertiesCloseUp(Sender: TObject); begin try cbScsObjectsTypes.ItemIndex := 0; ScsModelTree.ClearSelection; DeselectGLObjects; except on E: Exception do AddExceptionToLogEx('Tfrm3D.cbScsListsPropertiesCloseUp', E.Message); end; end; procedure Tfrm3D.cbScsObjectsTypesPropertiesCloseUp(Sender: TObject); begin try ScsModelTree.ClearSelection; if cbScsObjectsTypes.ItemIndex = 0 then begin DeselectGLObjects; end else begin FindSelectScsNodesByType(cbScsObjectsTypes.ItemIndex); end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.cbScsObjectsTypesPropertiesCloseUp', E.Message); end; end; procedure Tfrm3D.ScsModelTreeMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var i: Integer; xNode: TTreeNode; cx, cy: integer; p: TPoint; function CheckCanShowTransparensyMenu(aNode: TTreeNode): Boolean; var i: Integer; begin Result := False; if TObject(aNode.Data) is T3DLine then begin Result := True; exit; end; for i := 0 to aNode.Count - 1 do begin Result := CheckCanShowTransparensyMenu(aNode.Item[i]); if Result then break; end; end; begin if (TGLMouseButton(Button) = mbRight) then begin if ScsModelTree.SelectionCount = 1 then begin xNode := ScsModelTree.GetNodeAt(X - ScsModelTree.Parent.Parent.Parent.Left, Y - ScsModelTree.Parent.Parent.Parent.Top - ScsModelTree.Parent.Parent.Top - ScsModelTree.Parent.Top - ScsModelTree.Top - 13); if xNode <> nil then begin //if UPPERCASE(TObject(xNode.Data).ClassName) = 'TF_CAD' then begin ScsModelTree.Select(xNode); pmScsPopup.Items[0].Visible := False; if CheckCanShowTransparensyMenu(xNode) then begin pmScsPopup.Items[1].Visible := True; pmScsPopup.Items[2].Visible := True; pmScsPopup.Popup(X, Y); end; end; { if (TObject(xNode.Data) is T3DConnector) then begin // pmScsModelTree.Items[0].Visible := False; // pmScsModelTree.Popup(X, Y); end; if (TObject(xNode.Data) is T3DLine) then begin //pmScsModelTree.Items[0].Visible := False; //pmScsModelTree.Popup(X, Y); end; } end; end; end; end; procedure Tfrm3D.ScsModelTreeClick(Sender: TObject); var i: Integer; xNode: TTreeNode; xNodes: TList; ClearSelected: boolean; LineExists: Boolean; ControlList: TList; begin try LineExists := false; //20.12.2011 if ScsModelTree.Selected <> nil then begin ClearSelected := False; for i := 0 to ScsModelTree.SelectionCount - 1 do begin xNode := ScsModelTree.Selections[i]; if TObject(xNode.Data).ClassName <> TObject(ScsModelTree.Selected.Data).ClassName then ClearSelected := True; if TObject(xNode.Data).ClassName = T3DLine.ClassName then LineExists := true; end; if ClearSelected then begin xNode := ScsModelTree.Selected; ScsModelTree.ClearSelection; xNode.Selected := True; end; xNodes := TList.create; for i := 0 to ScsModelTree.SelectionCount - 1 do begin xNode := ScsModelTree.Selections[i]; xNodes.Add(xNode); end; OnSelectNodes(xNodes); // Tolik -- 11/03/2017 -- xNodes.Free; // end; ControlList := TList.Create; ControlList.Add(lbScsLength); ControlList.Add(edScsLength); ControlList.Add(lbScsLineX2); ControlList.Add(lbScsLineY2); ControlList.Add(lbScsLineZ2); ControlList.Add(lbScsLine2); ControlList.Add(edScsLineX2); ControlList.Add(edScsLineY2); ControlList.Add(edScsLineZ2); for i := 0 to ControlList.Count - 1 do TControl(ControlList[i]).Visible := LineExists; ControlList.Free; except on E: Exception do AddExceptionToLogEx('Tfrm3D.ScsModelTreeClick', E.Message); end; end; function Tfrm3D.LoadPropertiesForSingleConn(aObject: TTreeNode): TPropRecord; var i: integer; xObject: T3DConnector; xGLObject, xGLObject1: TGLBaseSceneObject; tmpdir, tmpfname: string; begin try xObject := T3DConnector(aObject.Data); xGLObject := TGLBaseSceneObject(xObject.FGLObject); xGLObject1 := TGLBaseSceneObject(xObject.FGLObject1); edScsName.Text := xObject.FName; edScsIndex.Text := IntToStr(xObject.FIndex); mScsDesc.Clear; for i := 0 to xObject.FDescription.Count - 1 do mScsDesc.Lines.Add(xObject.FDescription[i]); mScsCaption.Clear; for i := 0 to xObject.FCaptions.Count - 1 do mScsCaption.Lines.Add(xObject.FCaptions[i]); mScsNote.Clear; for i := 0 to xObject.FNotes.Count - 1 do mScsNote.Lines.Add(xObject.FNotes[i]); edScsOffsetX.Text := FloatToStr(xObject.FOffset.x * Factor); edScsOffsetY.Text := FloatToStr(xObject.FOffset.z * Factor); edScsOffsetZ.Text := FloatToStr(xObject.FOffset.y * Factor); edScsAngleX.Text := FloatToStr(xObject.FRotate.x); edScsAngleY.Text := FloatToStr(xObject.FRotate.y); edScsAngleZ.Text := FloatToStr(xObject.FRotate.z); edScsScaleX.Text := FloatToStr(xObject.FScale.x); edScsScaleY.Text := FloatToStr(xObject.FScale.y); edScsScaleZ.Text := FloatToStr(xObject.FScale.z); edScsConnX.Text := FormatFloat(ffMask, xObject.FPoint.x); edScsConnY.Text := FormatFloat(ffMask, xObject.FPoint.y); edScsConnZ.Text := FormatFloat(ffMask, xObject.FPoint.z); { imgScsObjectTexture.Clear; tmpfname := GetImageFileByHash(xObject.FTextureHash); if tmpfname <> '' then imgScsObjectTexture.Picture.LoadFromFile(tmpfname); cbScsObjectHashs.Properties.Items.Clear; for i := 0 to F3DModel.FHashs.Count - 1 do begin cbScsObjectHashs.Properties.Items.Add(F3DModel.FHashs.Strings[i]); end; } except on E: Exception do AddExceptionToLogEx('Tfrm3D.LoadPropertiesForSingleConn', E.Message); end; end; function Tfrm3D.LoadPropertiesForMultiConn(aObjects: TList): TPropRecord; var i: integer; xObject: T3DConnector; xGLObject, xGLObject1: TGLBaseSceneObject; Points: T3DPointArray; Cnt: Integer; xPosX, xPosY, xPosZ, xAngleX, xAngleY, xAngleZ, xScaleX, xScaleY, xScaleZ, xCoordX, xCoordY, xCoordZ: Double; begin try mScsDesc.Clear; mScsCaption.Clear; mScsNote.Clear; for i := 0 to aObjects.Count - 1 do begin xObject := T3DConnector(TTreeNode(aObjects[i]).Data); xGLObject := TGLBaseSceneObject(xObject.FGLObject); xGLObject1 := TGLBaseSceneObject(xObject.FGLObject1); if i = 0 then begin xPosX := xObject.FOffset.x * Factor; edScsOffsetX.Text := FloatToStr(xPosX); xPosY := xObject.FOffset.z * Factor; edScsOffsetY.Text := FloatToStr(xPosY); xPosZ := xObject.FOffset.y * Factor; edScsOffsetZ.Text := FloatToStr(xPosZ); xAngleX := xObject.FRotate.x; edScsAngleX.Text := FloatToStr(xAngleX); xAngleY := xObject.FRotate.y; edScsAngleY.Text := FloatToStr(xAngleY); xAngleZ := xObject.FRotate.z; edScsAngleZ.Text := FloatToStr(xAngleZ); xScaleX := xObject.FScale.x; edScsScaleX.Text := FloatToStr(xScaleX); xScaleY := xObject.FScale.y; edScsScaleY.Text := FloatToStr(xScaleY); xScaleZ := xObject.FScale.z; edScsScaleZ.Text := FloatToStr(xScaleZ); xCoordX := xObject.FPoint.x; edScsConnX.Text := FormatFloat(ffMask, xCoordX); xCoordY := xObject.FPoint.y; edScsConnY.Text := FormatFloat(ffMask, xCoordY); xCoordZ := xObject.FPoint.z; edScsConnZ.Text := FormatFloat(ffMask, xCoordZ); end else begin if edScsOffsetX.Text <> '' then if xPosX <> xObject.FOffset.x * Factor then edScsOffsetX.Text := ''; if edScsOffsetY.Text <> '' then if xPosY <> xObject.FOffset.z * Factor then edScsOffsetY.Text := ''; if edScsOffsetZ.Text <> '' then if xPosZ <> xObject.FOffset.y * Factor then edScsOffsetZ.Text := ''; if edScsAngleX.Text <> '' then if xAngleX <> xObject.FRotate.x then edScsAngleX.Text := ''; if edScsAngleY.Text <> '' then if xAngleY <> xObject.FRotate.y then edScsAngleY.Text := ''; if edScsAngleZ.Text <> '' then if xAngleZ <> xObject.FRotate.z then edScsAngleZ.Text := ''; if edScsScaleX.Text <> '' then if xScaleX <> xObject.FScale.x then edScsScaleX.Text := ''; if edScsScaleY.Text <> '' then if xScaleY <> xObject.FScale.y then edScsScaleY.Text := ''; if edScsScaleZ.Text <> '' then if xScaleZ <> xObject.FScale.z then edScsScaleZ.Text := ''; if edScsConnX.Text <> '' then if xCoordX <> xObject.FPoint.x then edScsConnX.Text := ''; if edScsConnY.Text <> '' then if xCoordY <> xObject.FPoint.y then edScsConnY.Text := ''; if edScsConnZ.Text <> '' then if xCoordZ <> xObject.FPoint.z then edScsConnZ.Text := ''; end; end; { imgScsObjectTexture.Clear; cbScsObjectHashs.Properties.Items.Clear; for i := 0 to F3DModel.FHashs.Count - 1 do begin cbSCSObjectHashs.Properties.Items.Add(F3DModel.FHashs.Strings[i]); end; } except on E: Exception do AddExceptionToLogEx('Tfrm3D.LoadPropertiesForMultiConn', E.Message); end; end; function Tfrm3D.LoadPropertiesForSingleLine(aObject: TTreeNode): TPropRecord; var i: integer; xObject: T3DLine; xGLObject: TGLBaseSceneObject; tmpdir, tmpfname: string; begin try xObject := T3DLine(aObject.Data); xGLObject := TGLBaseSceneObject(xObject.FGLObject); edScsName.Text := xObject.FName; edScsIndex.Text := IntToStr(xObject.FIndex); mScsDesc.Clear; for i := 0 to xObject.FDescription.Count - 1 do mScsDesc.Lines.Add(xObject.FDescription[i]); mScsCaption.Clear; for i := 0 to xObject.FCaptions.Count - 1 do mScsCaption.Lines.Add(xObject.FCaptions[i]); mScsNote.Clear; for i := 0 to xObject.FNotes.Count - 1 do mScsNote.Lines.Add(xObject.FNotes[i]); edScsLength.Text := FormatFloat(ffMask, xObject.FLength); edScsLineX1.Text := FormatFloat(ffMask, xObject.FPoint1.x); edScsLineY1.Text := FormatFloat(ffMask, xObject.FPoint1.y); edScsLineZ1.Text := FormatFloat(ffMask, xObject.FPoint1.z); edScsLineX2.Text := FormatFloat(ffMask, xObject.FPoint2.x); edScsLineY2.Text := FormatFloat(ffMask, xObject.FPoint2.y); edScsLineZ2.Text := FormatFloat(ffMask, xObject.FPoint2.z); except on E: Exception do AddExceptionToLogEx('Tfrm3D.LoadPropertiesForSingleLine', E.Message); end; end; function Tfrm3D.LoadPropertiesForMultiLine(aObjects: TList): TPropRecord; var i: integer; xObject: T3DLine; xGLObject: TGLBaseSceneObject; Points: T3DPointArray; Cnt: Integer; xCoordX1, xCoordY1, xCoordZ1, xCoordX2, xCoordY2, xCoordZ2, xLen: Double; begin try mScsDesc.Clear; mScsCaption.Clear; mScsNote.Clear; for i := 0 to aObjects.Count - 1 do begin xObject := T3DLine(TTreeNode(aObjects[i]).Data); xGLObject := TGLBaseSceneObject(xObject.FGLObject); if i = 0 then begin xLen := xObject.FLength; edScsLength.Text := FormatFloat(ffMask, xLen); xCoordX1 := xObject.FPoint1.x; edScsLineX1.Text := FormatFloat(ffMask, xCoordX1); xCoordY1 := xObject.FPoint1.y; edScsLineY1.Text := FormatFloat(ffMask, xCoordY1); xCoordZ1 := xObject.FPoint1.z; edScsLineZ1.Text := FormatFloat(ffMask, xCoordZ1); xCoordX2 := xObject.FPoint2.x; edScsLineX2.Text := FormatFloat(ffMask, xCoordX2); xCoordY2 := xObject.FPoint2.y; edScsLineY2.Text := FormatFloat(ffMask, xCoordY2); xCoordZ2 := xObject.FPoint2.z; edScsLineZ2.Text := FormatFloat(ffMask, xCoordZ2); end else begin if edScsLength.Text <> '' then if xLen <> xObject.FLength then edScsLength.Text := ''; if edScsLineX1.Text <> '' then if xCoordX1 <> xObject.FPoint1.x then edScsLineX1.Text := ''; if edScsLineY1.Text <> '' then if xCoordY1 <> xObject.FPoint1.y then edScsLineY1.Text := ''; if edScsLineZ1.Text <> '' then if xCoordZ1 <> xObject.FPoint1.z then edScsLineZ1.Text := ''; if edScsLineX2.Text <> '' then if xCoordX2 <> xObject.FPoint2.x then edScsLineX2.Text := ''; if edScsLineY2.Text <> '' then if xCoordY2 <> xObject.FPoint2.y then edScsLineY2.Text := ''; if edScsLineZ2.Text <> '' then if xCoordZ2 <> xObject.FPoint2.z then edScsLineZ2.Text := ''; end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.LoadPropertiesForMultiLine', E.Message); end; end; procedure Tfrm3D.bScsLoadModelClick(Sender: TObject); var i, j: integer; FName: string; xNode, xSubNode: TTreeNode; xConn: T3DConnector; glObject, oldglObject: TGLFreeForm; PrevObjectMin, PrevObjectMax, ObjectMin, ObjectMax, PrevObjSize, ObjSize, SetPos, Scale: T3DPoint; SetScale: Double; tmpdir, tmpfname: string; HashStr: string; // Tolik 28/09/2018 -- PosPoint, scalePoint: TDoublePoint; dlg: TOpen3dsModelDialog; begin dlg := TOpen3dsModelDialog.create(Self);//TOpenDialog.Create(Self); //dlg.Filter := 'Model files (*.3DS)|*.3DS'; dlg.Title := 'Sel3dModFile'; dlg.InitialDir := ExeDir + '\' + '3DModels'; try NoMoveEvent := True; if dlg.Execute then begin //todo - на поднятии подменяется на текущий savedir! // это можно не делать! //tmpdir := AddCreateDirToPath(ExtractFileDir(Application.ExeName), dnSave); //CopyFile(PChar(Open3DObject.FileName), PChar(tmpdir + '\' + ExtractFileName(Open3DObject.FileName)), True); //if FileExists(tmpdir + '\' + ExtractFileName(Open3DObject.FileName)) then // FName := tmpdir + '\' + ExtractFileName(Open3DObject.FileName) //else //Tolik 20/10/2018 -- //FName := Open3DObject.FileName; FName := dlg.FileName; // tmpdir := GetWorkDir; // ExtractDirByCategoryType(dctPictures); // MARK // получаем HASH по загружаемому файлу HashStr := GetObjectHash(FName); // по HASH ищем есть ли он в нашей базе tmpfname := GetObjectFileByHash(HashStr); // если найден, то грузим его if tmpfname <> '' then begin end else // не найден - создаем для файла HASH, копируем в темп, грузим begin F3DModel.F3DSHashs.Add(HashStr); tmpfname := tmpdir + '\' + HashStr + '.3ds'; CopyFile(PChar(FName), PChar(tmpfname), True); end; // MARK BeginProgress('Идет загрузка 3ds объекта ...'); // *** for j := 0 to FPropObjects.Count - 1 do begin xConn := T3DConnector(TTreeNode(FPropObjects[j]).Data); oldglObject := TGLFreeForm(xConn.FGLObject1); oldglObject.Material.Texture.Disabled := False; oldglObject.MaterialLibrary := MatLib; // FTextures.Clear; FisCreate3DS := True; FCurrObject := xConn; // Tolik 28/09/2018 -- PosPoint.x := oldglObject.Position.X; PosPoint.y := oldglObject.Position.y; PosPoint.z := oldglObject.Position.z; // Get3DSObjectBounds(PrevObjectMin, PrevObjectMax, oldglObject); PrevObjSize.x := abs(PrevObjectMax.x - PrevObjectMin.x); PrevObjSize.y := abs(PrevObjectMax.y - PrevObjectMin.y); PrevObjSize.z := abs(PrevObjectMax.z - PrevObjectMin.z); glObject := TglFreeForm.Create(frm3D.DummyCube); frm3D.DummyCube.AddChild(glObject); glObject.TagObject := OldGlObject.TagObject; OldGlObject.Free; xConn.FGLObject1 := glObject; // glObject.LoadFromFile(tmpfname); Get3DSObjectBounds(ObjectMin, ObjectMax, glObject); Rotate3DSObj(TGLFreeForm(GLObject), 0, 90, 270); {TODO - перепроверить - возможно и нужно это делать! } //for i := 0 to MatLib.Materials.Count - 1 do // MatLib.Materials[i].Material.Texture.MappingMode := tmmCubeMapCamera; //Get3DSObjectBounds(ObjectMin, ObjectMax, glObject, True); Get3DSObjectBounds(ObjectMin, ObjectMax, glObject); ObjSize.x := abs(ObjectMax.x - ObjectMin.x); ObjSize.y := abs(ObjectMax.y - ObjectMin.y); ObjSize.z := abs(ObjectMax.z - ObjectMin.z); SetPos.x := xConn.FGLPoint.x + xConn.FOffset.x / Factor; SetPos.y := xConn.FGLPoint.y + xConn.FOffset.z / Factor ;//+ FDeltaZFloor; SetPos.z := xConn.FGLPoint.z + xConn.FOffset.y / Factor; {Scale.X := ObjSize.x * glObject.Scale.x; Scale.Y := ObjSize.y * glObject.Scale.y; Scale.Z := ObjSize.z * glObject.Scale.z;} Scale.X := PrevObjSize.x / ObjSize.x * glObject.Scale.x; Scale.Y := PrevObjSize.y / ObjSize.y * glObject.Scale.y; Scale.Z := PrevObjSize.z / ObjSize.z * glObject.Scale.z; glObject.Position.x := SetPos.x; glObject.Position.y := SetPos.y; glObject.Position.z := SetPos.z; {glObject.Position.x := PosPoint.x; glObject.Position.y := PosPoint.y; glObject.Position.z := PosPoint.z;} // SetScale := MinFloat(Scale.X, Scale.Y, Scale.Z); glObject.BeginUpdate; glObject.Scale.X := SetScale; glObject.Scale.Y := SetScale; glObject.Scale.Z := SetScale; glObject.EndUpdate; RotateConnModel(glObject, xConn.FRotate.x, xConn.FRotate.y, xConn.FRotate.z); if glObject.Material.Texture.Disabled then begin glObject.Material.FrontProperties.Ambient.Color := xConn.FColor; glObject.Material.FrontProperties.Diffuse.Color := xConn.FColor; glObject.Material.FrontProperties.Emission.Color := xConn.FColor; glObject.Material.BackProperties.Ambient.Color := xConn.FColor; glObject.Material.BackProperties.Diffuse.Color := xConn.FColor; glObject.Material.BackProperties.Emission.Color := xConn.FColor; end; //glObject.Material.Texture.MappingMode := tmmCubeMapCamera; //// glObject.BuildOctree; oi?iica //glObject.Material.MaterialOptions := [moNoLighting]; glObject.Material.MaterialOptions := []; glObject.Material.Texture.Disabled := False; //xConn.FZOrder := 1; // здесь нельзя так делать! FName по идеи должно уже использоваться для других целей! //xConn.FName := FName; xConn.FScale.x := glObject.Scale.X; xConn.FScale.y := glObject.Scale.Y; xConn.FScale.z := glObject.Scale.Z; Rotate3DSObj(TGLFreeForm(GLObject), 0, 90, 270); end; //GLDummyCube1.EndUpdate; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.bScsLoadModelClick', E.Message); end; EndProgress; dlg.free; end; (* procedure Tfrm3D.bScsLoadModelClick(Sender: TObject); var i, j: integer; FName: string; xNode, xSubNode: TTreeNode; xConn: T3DConnector; glObject: TGLFreeForm; PrevObjectMin, PrevObjectMax, ObjectMin, ObjectMax, PrevObjSize, ObjSize, SetPos, Scale: T3DPoint; SetScale: Double; tmpdir, tmpfname: string; HashStr: string; begin try Open3DObject.InitialDir := ExeDir + '\3DModels'; NoMoveEvent := True; if Open3DObject.Execute then begin //todo - на поднятии подменяется на текущий savedir! // это можно не делать! //tmpdir := AddCreateDirToPath(ExtractFileDir(Application.ExeName), dnSave); //CopyFile(PChar(Open3DObject.FileName), PChar(tmpdir + '\' + ExtractFileName(Open3DObject.FileName)), True); //if FileExists(tmpdir + '\' + ExtractFileName(Open3DObject.FileName)) then // FName := tmpdir + '\' + ExtractFileName(Open3DObject.FileName) //else FName := Open3DObject.FileName; tmpdir := GetWorkDir; // ExtractDirByCategoryType(dctPictures); // MARK // получаем HASH по загружаемому файлу HashStr := GetObjectHash(FName); // по HASH ищем есть ли он в нашей базе tmpfname := GetObjectFileByHash(HashStr); // если найден, то грузим его if tmpfname <> '' then begin end else // не найден - создаем для файла HASH, копируем в темп, грузим begin F3DModel.F3DSHashs.Add(HashStr); tmpfname := tmpdir + '\' + HashStr + '.3ds'; CopyFile(PChar(FName), PChar(tmpfname), True); end; // MARK BeginProgress('Идет загрузка 3ds объекта ...'); // *** for j := 0 to FPropObjects.Count - 1 do begin xConn := T3DConnector(TTreeNode(FPropObjects[j]).Data); glObject := TGLFreeForm(xConn.FGLObject1); glObject.Material.Texture.Disabled := False; glObject.MaterialLibrary := MatLib; // FTextures.Clear; FisCreate3DS := True; FCurrObject := xConn; Get3DSObjectBounds(PrevObjectMin, PrevObjectMax, glObject); PrevObjSize.x := abs(PrevObjectMax.x - PrevObjectMin.x); PrevObjSize.y := abs(PrevObjectMax.y - PrevObjectMin.y); PrevObjSize.z := abs(PrevObjectMax.z - PrevObjectMin.z); xConn.FObjectHash := HashStr; //glObject.LoadFromFile(FName); glObject.LoadFromFile(tmpfname); {TODO - перепроверить - возможно и нужно это делать! } //for i := 0 to MatLib.Materials.Count - 1 do // MatLib.Materials[i].Material.Texture.MappingMode := tmmCubeMapCamera; Get3DSObjectBounds(ObjectMin, ObjectMax, glObject); ObjSize.x := abs(ObjectMax.x - ObjectMin.x); ObjSize.y := abs(ObjectMax.y - ObjectMin.y); ObjSize.z := abs(ObjectMax.z - ObjectMin.z); SetPos.x := xConn.FGLPoint.x + xConn.FOffset.x / Factor; SetPos.y := xConn.FGLPoint.y + xConn.FOffset.z / Factor + FDeltaZFloor; SetPos.z := xConn.FGLPoint.z + xConn.FOffset.y / Factor; Scale.X := PrevObjSize.x / ObjSize.x * glObject.Scale.x; Scale.Y := PrevObjSize.y / ObjSize.y * glObject.Scale.y; Scale.Z := PrevObjSize.z / ObjSize.z * glObject.Scale.z; glObject.Position.x := SetPos.x; glObject.Position.y := SetPos.y; glObject.Position.z := SetPos.z; SetScale := MinFloat(Scale.X, Scale.Y, Scale.Z); glObject.Scale.X := SetScale; glObject.Scale.Y := SetScale; glObject.Scale.Z := SetScale; RotateConnModel(glObject, xConn.FRotate.x, xConn.FRotate.y, xConn.FRotate.z); if glObject.Material.Texture.Disabled then begin glObject.Material.FrontProperties.Ambient.Color := xConn.FColor; glObject.Material.FrontProperties.Diffuse.Color := xConn.FColor; glObject.Material.FrontProperties.Emission.Color := xConn.FColor; glObject.Material.BackProperties.Ambient.Color := xConn.FColor; glObject.Material.BackProperties.Diffuse.Color := xConn.FColor; glObject.Material.BackProperties.Emission.Color := xConn.FColor; end; //glObject.Material.Texture.MappingMode := tmmCubeMapCamera; //// glObject.BuildOctree; oi?iica //glObject.Material.MaterialOptions := [moNoLighting]; glObject.Material.MaterialOptions := []; glObject.Material.Texture.Disabled := False; //xConn.FZOrder := 1; // здесь нельзя так делать! FName по идеи должно уже использоваться для других целей! //xConn.FName := FName; xConn.FScale.x := glObject.Scale.X; xConn.FScale.y := glObject.Scale.Y; xConn.FScale.z := glObject.Scale.Z; end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.bScsLoadModelClick', E.Message); end; EndProgress; end; *) function Tfrm3D.isConnectorObject(aObj: TGLBaseSceneObject; aCmpObj: TGLBaseSceneObject = nil): Boolean; var xNode: TTreeNode; xObject: TObject; Obj, Obj1: TGLBaseSceneObject; begin try Result := False; // Tolik 14/01/2019 if aObj = nil then exit; if aObj.tagObject = nil then exit; // xNode := TTreeNode(aObj.tagObject); Obj := GlsceneViewer.Buffer.GetPickedobject(mx, my); if TObject(xNode.Data) is T3DConnector then begin if T3DConnector(xNode.Data).FConnType = ct_Full then begin Obj1 := TGLBaseSceneObject(T3DConnector(xNode.Data).FGLObject1); if aCmpObj = nil then Result := True else if Obj1 = aCmpObj then Result := True; end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.isConnectorObject', E.Message); end; end; procedure Tfrm3D.DoScale3dsObject(aWheelDelta: Integer); var i, j: integer; glObject, glObject1: TGLFreeForm; pScale: Double; begin try pScale := 0.1; // 10% pScale := aWheelDelta / 120 * pScale; glObject := TGLFreeForm(FSelection[0]); if aWheelDelta < 0 then begin if glObject.Scale.X >= 0.01 then begin glObject.Scale.X := glObject.Scale.X + glObject.Scale.X * pScale; glObject.Scale.Y := glObject.Scale.Y + glObject.Scale.Y * pScale; glObject.Scale.Z := glObject.Scale.Z + glObject.Scale.Z * pScale; end; end else begin glObject.Scale.X := glObject.Scale.X + glObject.Scale.X * pScale; glObject.Scale.Y := glObject.Scale.Y + glObject.Scale.Y * pScale; glObject.Scale.Z := glObject.Scale.Z + glObject.Scale.Z * pScale; end; edScaleX.Text := FloatToStr(glObject.Scale.X); edScaleY.Text := FloatToStr(glObject.Scale.Y); edScaleZ.Text := FloatToStr(glObject.Scale.Z); T3DSObject(TTreeNode(glObject.TagObject).Data).FScale := DoublePoint(glObject.Scale.X, glObject.Scale.Y, glObject.Scale.Z); except on E: Exception do AddExceptionToLogEx('Tfrm3D.DoScale3dsObject', E.Message); end; end; procedure Tfrm3D.DoScaleConnectorObjects(aWheelDelta: Integer); var i, j: integer; glObject: TGLBaseSceneObject; glObject1: TGLFreeForm; pScale: Double; xConn: T3DConnector; begin try pScale := 0.1; // 10% pScale := aWheelDelta / 120 * pScale; for i := 0 to FSelection.Count - 1 do begin glObject := TGLFreeForm(FSelection[i]); if TObject(TTreeNode(glObject.tagObject).Data) is T3DConnector then begin xConn := T3DConnector(TTreeNode(glObject.tagObject).Data); if xConn.FConnType <> ct_Empty then begin glObject1 := TGLFreeForm(xConn.FGLObject1); if aWheelDelta < 0 then begin if glObject1.Scale.X >= 0.01 then begin glObject1.Scale.X := glObject1.Scale.X + glObject1.Scale.X * pScale; glObject1.Scale.Y := glObject1.Scale.Y + glObject1.Scale.Y * pScale; glObject1.Scale.Z := glObject1.Scale.Z + glObject1.Scale.Z * pScale; end; end else begin glObject1.Scale.X := glObject1.Scale.X + glObject1.Scale.X * pScale; glObject1.Scale.Y := glObject1.Scale.Y + glObject1.Scale.Y * pScale; glObject1.Scale.Z := glObject1.Scale.Z + glObject1.Scale.Z * pScale; end; xConn.FScale := DoublePoint(glObject1.Scale.X, glObject1.Scale.Y, glObject1.Scale.Z); //if FSelection.Count = 1 then begin edScsScaleX.Text := FloatToStr(glObject1.Scale.X); edScsScaleY.Text := FloatToStr(glObject1.Scale.Y); edScsScaleZ.Text := FloatToStr(glObject1.Scale.Z); end; end; end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.DoScaleConnectorObjects', E.Message); end; end; procedure Tfrm3D.DoRotate3dsObject(Shift: TShiftState; X, Y: Integer); var glObject: TGLFreeForm; xObject: T3DSObject; Camera: TGLCamera; AngX, AngY, AngZ: Double; mult: integer; VC: TVector4f; dx, dy : Integer; VX, VY: TVector; begin try glObject := FRotatedObject; Camera := GLSceneViewer.Camera; dx := mx - x; dy := my - y; VY := VectorMake(VectorPerpendicular(YVector, VectorNormalize(Camera.Position.AsAffineVector))); VX := VectorCrossProduct(VY, VectorNormalize(Camera.Position.AsVector)); NormalizeVector(VY); NormalizeVector(VX); VC := VectorCombine(VX, VY, -dx * 0.132 * Camera.DistanceToTarget / Camera.FocalLength, dy * 0.132 * Camera.DistanceToTarget / Camera.FocalLength); if abs(x - last_x) >= 10 then begin if Not (ssCtrl in Shift) then begin mult := 1; if VC[0] < 0 then mult := -1; if (ssShift in Shift) then edAngleY.Text := FloatToStr(StrToFloat_My(edAngleY.Text) - 1 * mult) else edAngleY.Text := FloatToStr(StrToFloat_My(edAngleY.Text) - 15 * mult); last_x := x; last_y := y; end else begin mult := 1; if VC[2] < 0 then mult := -1; if (ssShift in Shift) then edAngleX.Text := FloatToStr(StrToFloat_My(edAngleX.Text) - 1 * mult) else edAngleX.Text := FloatToStr(StrToFloat_My(edAngleX.Text) - 15 * mult); end; last_x := x; last_y := y; Rotate3DSObj(glObject, StrToFloat_My(edAngleX.Text), StrToFloat_My(edAngleY.Text), StrToFloat_My(edAngleZ.Text)); end; if abs(y - last_y) >= 10 then begin if Not (ssCtrl in Shift) then begin mult := 1; if VC[0] > 0 then mult := -1; if (ssShift in Shift) then edAngleZ.Text := FloatToStr(StrToFloat_My(edAngleZ.Text) - 1 * mult) else edAngleZ.Text := FloatToStr(StrToFloat_My(edAngleZ.Text) - 15 * mult); end else begin mult := 1; if VC[2] < 0 then mult := -1; if (ssShift in Shift) then edAngleX.Text := FloatToStr(StrToFloat_My(edAngleX.Text) - 1 * mult) else edAngleX.Text := FloatToStr(StrToFloat_My(edAngleX.Text) - 15 * mult); end; last_x := x; last_y := y; Rotate3DSObj(glObject, StrToFloat_My(edAngleX.Text), StrToFloat_My(edAngleY.Text), StrToFloat_My(edAngleZ.Text)); end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.DoRotate3dsObject', E.Message); end; end; procedure Tfrm3D.DoRotateConnectorObjects(Shift: TShiftState; X, Y: Integer); var i, j: integer; glObject: TGLBaseSceneObject; glObject1: TGLFreeForm; Camera: TGLCamera; xConn: T3DConnector; AngX, AngY, AngZ: Double; mult: integer; VC: TVector4f; dx, dy : Integer; VX, VY: TVector; begin try Camera := GLSceneViewer.Camera; dx := mx - x; dy := my - y; VY := VectorMake(VectorPerpendicular(YVector, VectorNormalize(Camera.Position.AsAffineVector))); VX := VectorCrossProduct(VY, VectorNormalize(Camera.Position.AsVector)); NormalizeVector(VY); NormalizeVector(VX); VC := VectorCombine(VX, VY, -dx * 0.132 * Camera.DistanceToTarget / Camera.FocalLength, dy * 0.132 * Camera.DistanceToTarget / Camera.FocalLength); for i := 0 to FSelection.Count - 1 do begin glObject := TGLFreeForm(FSelection[i]); if TObject(TTreeNode(glObject.tagObject).Data) is T3DConnector then begin xConn := T3DConnector(TTreeNode(glObject.tagObject).Data); if xConn.FConnType <> ct_Empty then begin glObject1 := TGLFreeForm(xConn.FGLObject1); if abs(x - last_x) >= 10 then begin if Not (ssCtrl in Shift) then begin mult := 1; if VC[0] < 0 then mult := -1; if (ssShift in Shift) then edScsAngleY.Text := FloatToStr(StrToFloat_My(edScsAngleY.Text) - 1 * mult) else edScsAngleY.Text := FloatToStr(StrToFloat_My(edScsAngleY.Text) - 15 * mult); last_x := x; last_y := y; end else begin mult := 1; if VC[2] < 0 then mult := -1; if (ssShift in Shift) then edScsAngleX.Text := FloatToStr(StrToFloat_My(edScsAngleX.Text) - 1 * mult) else edScsAngleX.Text := FloatToStr(StrToFloat_My(edScsAngleX.Text) - 15 * mult); end; last_x := x; last_y := y; RotateConnModel(glObject1, StrToFloat_My(edScsAngleX.Text), StrToFloat_My(edScsAngleY.Text), StrToFloat_My(edScsAngleZ.Text)); end; if abs(y - last_y) >= 10 then begin if Not (ssCtrl in Shift) then begin mult := 1; if VC[0] > 0 then mult := -1; if (ssShift in Shift) then edScsAngleZ.Text := FloatToStr(StrToFloat_My(edScsAngleZ.Text) - 1 * mult) else edScsAngleZ.Text := FloatToStr(StrToFloat_My(edScsAngleZ.Text) - 15 * mult); end else begin mult := 1; if VC[2] < 0 then mult := -1; if (ssShift in Shift) then edScsAngleX.Text := FloatToStr(StrToFloat_My(edScsAngleX.Text) - 1 * mult) else edScsAngleX.Text := FloatToStr(StrToFloat_My(edScsAngleX.Text) - 15 * mult); end; last_x := x; last_y := y; RotateConnModel(glObject1, StrToFloat_My(edScsAngleX.Text), StrToFloat_My(edScsAngleY.Text), StrToFloat_My(edScsAngleZ.Text)); end; end; end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.DoRotateConnectorObjects', E.Message); end; end; function Tfrm3D.isLineObject(aObj: TGLBaseSceneObject; aCmpObj: TGLBaseSceneObject = nil): Boolean; var xNode: TTreeNode; xObject: TObject; Obj: TGLBaseSceneObject; begin try Result := False; xNode := TTreeNode(aObj.tagObject); Obj := MyGetPickedobject(mx, my); if (TObject(xNode.Data) is T3DLine){or(TObject(xNode.Data) is T3DWall)or(TObject(xNode.Data) is T3DCorner)} then begin if aCmpObj = nil then Result := True else if aObj = aCmpObj then Result := True; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.isLineObject', E.Message); end; end; // Tolik procedure Tfrm3D.Move3DConnectorEvent(aObj: TGLBaseSceneObject); var xConn: T3DConnector; dp: T3DPoint; xGLCaption: TGLSpaceText; xGLObject: TGLPipe; // Tolik HasVertical: boolean; JoinedLinesList: TList; currConnector: T3DConnector; i, j: Integer; xxLine: T3DLine; MovedConnectorsList: TList; MovedLinesList: TList; Counter: Integer; xxConn: T3DConnector; FMovedComponentAbsPos: TVector4F; function CheckConnectorInList(AList: TList; AConnector: T3dConnector): boolean; var i: integer; conn: T3DConnector; begin Result := false; if ((AList <> nil) and (AConnector <> nil)) then begin for i := 0 to AList.Count - 1 do begin conn := T3DConnector(AList[i]); if (conn = AConnector) then begin Result := true; break; end; end; end; end; function CheckLineInList(AList: TList; ALine: T3DLine): boolean; var i: integer; currLine: T3DLine; begin Result := false; if ((AList <> nil) and (ALine <> nil)) then begin if AList.Count > 0 then begin for i := 0 to AList.Count - 1 do begin currLine := T3DLine(AList[i]); if (currLine = ALine) then begin Result := true; break; end; end; end; end; end; Procedure CheckVertLineConnected(Conn : T3DConnector); Var i, j, k:Integer; currConn1, currConn2 : T3DConnector; aLine: T3DLine; TakethisConnector: Boolean; Begin if Conn <> nil then begin //Tolik -- 28/04/2016 - if Conn.FJoinedConnectorsList.Count = 0 then if not CheckConnectorInList(MovedConnectorsList, Conn) then MovedConnectorsList.Add(Conn); // for i := 0 to Conn.FJoinedConnectorsList.Count - 1 do begin if T3DConnector(Conn.FJoinedConnectorsList[i]).FConnType = ct_Full then begin currConn2 := T3DConnector(Conn.FJoinedConnectorsList[i]); if not CheckConnectorInList(MovedConnectorsList, currConn2) then begin MovedConnectorsList.Add(Conn.FJoinedConnectorsList[i]); CheckVertLineConnected(T3DConnector(Conn.FJoinedConnectorsList[i])); end; end; for j := 0 to T3DConnector(Conn.FJoinedConnectorsList[i]).FJoinedLinesList.Count - 1 do begin aLine := T3DLine(T3DConnector(Conn.FJoinedConnectorsList[i]).FJoinedLinesList[j]); if aLine.FSCSObject.FIsVertical then begin if not CheckLineInList(MovedLinesList, aLine) then begin MovedLinesList.Add(aLine); CheckVertLineConnected(aLine.FJoinConnector1); CheckVertLineConnected(aLine.FJoinConnector2); end; end; end; end; for j := 0 to Conn.FJoinedLinesList.Count - 1 do begin aLine := T3DLine(Conn.FJoinedLinesList[j]); if aLine.FSCSObject.FIsVertical then begin if not CheckLineInList(MovedLinesList, aLine) then begin MovedLinesList.Add(aLine); CheckVertLineConnected(aLine.FJoinConnector1); CheckVertLineConnected(aLine.FJoinConnector2); end; end; end; end; {for i := 0 to Conn.FJoinedLinesList.Count - 1 do begin if T3DLine(Conn.FJoinedLinesList[i]).FSCSObject.FIsVertical then begin aLine := T3DLine(Conn.FJoinedLinesList[i]); if not CheckLineInList(MovedLinesList, aLine) then begin MovedLinesList.Add(aLine); TakeThisConnector := false; if aLine.FJoinConnector1.FJoinedConnectorsList.Count = 0 then currConn2 := aLine.FJoinConnector1 else currConn2 := aLine.FJoinConnector1.FJoinedConnectorsList[0]; if not CheckConnectorInList(MovedConnectorsList, currConn2) then begin if currConn2.FConnType = ct_Full then MovedConnectorsList.Add(currConn2); for j := 0 to currConn2.FJoinedConnectorsList.Count - 1 do begin if not CheckConnectorInList(MovedConnectorsList, currConn2.FJoinedConnectorsList[j]) then begin if T3DConnector(currConn2.FJoinedConnectorsList[j]).FConnType = ct_full then MovedConnectorsList.Add(currConn2.FJoinedConnectorsList[j]); end; end; TakeThisConnector := true; end; if not TakethisConnector then begin if aLine.FJoinConnector2.FJoinedConnectorsList.Count = 0 then currConn2 := aLine.FJoinConnector2 else currConn2 := aLine.FJoinConnector2.FJoinedConnectorsList[0]; if not CheckConnectorInList(MovedConnectorsList, currConn2) then begin if currConn2.FConnType = ct_full then MovedConnectorsList.Add(currConn2); for j := 0 to currConn2.FJoinedConnectorsList.Count - 1 do begin if not CheckConnectorInList(MovedConnectorsList, currConn2.FJoinedConnectorsList[j]) then begin if T3DConnector(currConn2.FJoinedConnectorsList[j]).FConnType = ct_Full then MovedConnectorsList.Add(currConn2.FJoinedConnectorsList[j]); end; end; TakeThisConnector := true; end; end; if TakethisConnector then ChechVertLineConnected(currConn2); end; end; end; for i := 0 to Conn.FJoinedConnectorsList.Count - 1 do begin currConn1 := Conn.FJoinedConnectorsList[i]; for j := 0 to currConn1.FJoinedLinesList.Count - 1 do begin aLine := currConn1.FJoinedLinesList[j]; if aLine.FSCSObject.FIsVertical then begin if not CheckLineInList(MovedLinesList, aLine) then begin MovedLinesList.Add(aLine); TakeThisConnector := false; if aLine.FJoinConnector1.FJoinedConnectorsList.Count = 0 then currConn2 := aLine.FJoinConnector1 else currConn2 := aLine.FJoinConnector1.FJoinedConnectorsList[0]; if not CheckConnectorInList(MovedConnectorsList, currConn2) then begin if currConn2.FConnType = ct_full then MovedConnectorsList.Add(currConn2); for k := 0 to currConn2.FJoinedConnectorsList.Count - 1 do begin if not CheckConnectorInList(MovedConnectorsList, currConn2.FJoinedConnectorsList[k]) then begin if T3DConnector(currConn2.FJoinedConnectorsList[j]).FConnType = ct_full then MovedConnectorsList.Add(currConn2.FJoinedConnectorsList[k]); end; end; TakeThisConnector := true; end; if not TakethisConnector then begin if aLine.FJoinConnector2.FJoinedConnectorsList.Count = 0 then currConn2 := aLine.FJoinConnector2 else currConn2 := aLine.FJoinConnector2.FJoinedConnectorsList[0]; if not CheckConnectorInList(MovedConnectorsList, currConn2) then begin if currConn2.FConnType = ct_full then MovedConnectorsList.Add(currConn2); for k := 0 to currConn2.FJoinedConnectorsList.Count - 1 do begin if not CheckConnectorInList(MovedConnectorsList, currConn2.FJoinedConnectorsList[k]) then begin if T3DConnector(currConn2.FJoinedConnectorsList[j]).FConnType = ct_full then MovedConnectorsList.Add(currConn2.FJoinedConnectorsList[k]); end; end; TakeThisConnector := true; end; end; if TakethisConnector then ChechVertLineConnected(currConn2); end; end; end; end; end;} End; // Tolik 01/05/2018 -- Function CantMoveConn: Boolean; var i: Integer; Conn, JoinedConn: TConnectorObject; MaxFloorHeight, MinFloorHeight, FloorHeight: Double; currCad: TF_CAD; ListParams: TListParams; begin Result := False; begin Conn := TConnectorObject(xConn.FSCSObject); if Conn <> nil then begin //if Conn.ConnectorType = ct_Clear then begin if Conn.FConnRaiseType in [crt_TrunkUP, crt_TrunkDown, crt_BetweenFloorUp, crt_BetweenFloorDown] then Result := True; // вершину межэтажки или магистрали двигать по вертикали нельзя end; //else if not Result then if Conn.ConnectorType = ct_NB then begin for i := 0 to Conn.JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(Conn.JoinedConnectorsList[i]); if JoinedConn.FConnRaiseType in [crt_TrunkUP, crt_TrunkDown, crt_BetweenFloorUp, crt_BetweenFloorDown] then Result := True; // вершину межэтажки или магистрали двигать по вертикали нельзя end; end; if not Result then // проверить на "улет" с этажа begin currCad := TF_CAD(TPowerCad(Conn.Owner).Owner); if currCad <> nil then begin ListParams := GetListParams(currCad.FCADListID); FloorHeight := MetreToUOM(ListParams.Settings.HeightRoom)*(1000 / currCad.PCad.MapScale)*Factor; // высота этажа //if currCad.FCADListIndex > 0 then if ListNotUnderFloor(currCad) then begin MaxFloorHeight := Get3DFloorHeight(TF_CAD(TPowerCad(Conn.Owner).Owner))*Factor; MinFloorHeight := MaxFloorHeight - FloorHeight; end else begin MinFloorHeight := Get3DFloorHeight(TF_CAD(TPowerCad(Conn.Owner).Owner))*Factor; MaxFloorHeight := MinFloorHeight + FloorHeight; end; Result := False; if ((CompareValue(MaxFloorHeight, aObj.Position.Y) < 0) or (CompareValue(MinFloorHeight, aObj.Position.Y) > 0)) then //if ((CompareValue(MaxFloorHeight, aObj.Position.Y) > 0) or (CompareValue(MinFloorHeight, aObj.Position.Y) > 0)) then Result := True; end; end; end; end; end; begin try //Tolik xConn := nil; // Full Connector if aObj is TGLFreeForm then begin xConn := T3DConnector(TTreeNode(aObj.tagObject).Data); end; // Empty Connector if aObj is TGLCube then begin xConn := T3DConnector(aObj.tagObject); end; if FMovedComponent <> nil then begin FMovedComponentAbsPos := FMovedComponent.AbsolutePosition; {dp.x := FMovedComponentAbsPos[0] - MovedStartPos.x; dp.y := FMovedComponentAbsPos[1] - MovedStartPos.y; dp.z := FMovedComponentAbsPos[2] - MovedStartPos.z;} {dp.x := FMovedComponent.Parent.Parent.Position.x + glCursorObject.Position.x;// - MovedStartPos.x; dp.y := FMovedComponent.Parent.Parent.Position.y + glCursorObject.Position.y;// - MovedStartPos.y; dp.z := FMovedComponent.Parent.Parent.Position.z + glCursorObject.Position.z;// - MovedStartPos.z;} dp.x := glCursorObject.Position.x - MovedStartPos.x; dp.y := glCursorObject.Position.y - MovedStartPos.y; dp.z := glCursorObject.Position.z - MovedStartPos.z; end else begin if xConn.FConnType = ct_Full then begin dp.x := aObj.Position.X - MovedStartPos.x; dp.y := aObj.Position.Y - MovedStartPos.y; dp.z := aObj.Position.Z - MovedStartPos.z; end else begin dp.x := aObj.Position.X - MovedStartPos.x; dp.y := aObj.Position.Y - MovedStartPos.y; dp.z := aObj.Position.Z - MovedStartPos.z; end; end; // Tolik 01/05/2018 -- if dp.y <> 0 then if CantMoveConn then begin aObj.Position.X := MovedStartPos.x; aObj.Position.Y := MovedStartPos.y; aObj.Position.Z := MovedStartPos.z; exit; end; MovedConnectorsList := TList.Create; MovedLinesList := TList.Create; CheckVertLineConnected(xConn); move3DConnector(xConn, dp, true); if MovedConnectorsList.Count > 1 then begin //28/04/2016 -- for i := 0 to MovedConnectorsList.Count - 1 do //for i := 1 to MovedConnectorsList.Count - 1 do move3DConnector(T3DConnector(MovedConnectorsList[i]), dp); end; FMovedObjectsList.Clear; MovedLinesList.Clear; MovedConnectorsList.Clear; if xConn.FConnType = ct_Full then begin edScsConnX.Text := FormatFloat(ffMask, xConn.FPoint.x); edScsConnY.Text := FormatFloat(ffMask, xConn.FPoint.y); edScsConnZ.Text := FormatFloat(ffMask, xConn.FPoint.z); end else begin if FSelection.Count = 1 then // Tolik 27/07/2016 -- на пустом коннекторе, если не проверять - будет АВ, // так как модель выбирает из своего дерева только ОБЪЕКТЫ (пустой коннектор - не объект, поэтому его в дереве // 3Д-модели не будет, и тогда, при клике на пустом коннекторе, ScsModelTree.Selected = nil) begin if ScsModelTree.Selected <> nil then LoadPropertiesForSingleLine(ScsModelTree.Selected); end; // end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.Move3DConnector', E.Message); end; // Tolik -- 11/03/2017 -- MovedConnectorsList.Free; MovedLinesList.Free; // end; procedure Tfrm3D.Move3DLineEvent(aObj: TGLBaseSceneObject); var xLine: T3DLine; xGLLine: TGLLines; cp, dp1, dp2: T3DPoint; xGLCaption: TGLSpaceText; JoinConn1, JoinConn2: T3DConnector; //Tolik HasVertical: boolean; JoinedLinesList: TList; currConnector: T3DConnector; i, j: Integer; xxLine: T3DLine; MovedConnectorsList: TList; MovedLinesList: TList; Counter: Integer; function CheckConnectorInList(AList: TList; AConnector: T3dConnector): boolean; var i: integer; conn: T3DConnector; begin Result := false; if ((AList <> nil) and (AConnector <> nil)) then begin for i := 0 to AList.Count - 1 do begin conn := T3DConnector(AList[i]); if (conn = AConnector) then begin Result := true; break; end; end; end; end; function CheckLineInList(AList: TList; ALine: T3DLine): boolean; var i: integer; currLine: T3DLine; begin Result := false; if ((AList <> nil) and (ALine <> nil)) then begin if AList.Count > 0 then begin for i := 0 to AList.Count - 1 do begin currLine := T3DLine(AList[i]); if (currLine = ALine) then begin Result := true; break; end; end; end; end; end; Procedure CheckVertLineConnected(Conn: T3DConnector); Var i, j:Integer; currConn1, currConn2 : T3DConnector; aLine: T3DLine; TakethisConnector: Boolean; Begin for i := 0 to Conn.FJoinedLinesList.Count - 1 do begin if T3DLine(Conn.FJoinedLinesList[i]).FSCSObject.FIsVertical then begin aLine := T3DLine(Conn.FJoinedLinesList[i]); if not CheckLineInList(MovedLinesList, aLine) then begin MovedLinesList.Add(aLine); TakeThisConnector := false; if aLine.FJoinConnector1.FJoinedConnectorsList.Count = 0 then currConn2 := aLine.FJoinConnector1 else currConn2 := aLine.FJoinConnector1.FJoinedConnectorsList[0]; if not CheckConnectorInList(MovedConnectorsList, currConn2) then begin MovedConnectorsList.Add(currConn2); TakeThisConnector := true; end; if not TakethisConnector then begin if aLine.FJoinConnector2.FJoinedConnectorsList.Count = 0 then currConn2 := aLine.FJoinConnector2 else currConn2 := aLine.FJoinConnector2.FJoinedConnectorsList[0]; if not CheckConnectorInList(MovedConnectorsList, currConn2) then begin MovedConnectorsList.Add(currConn2); TakeThisConnector := true; end; end; if TakethisConnector then CheckVertLineConnected(currConn2); end; end; end; for i := 0 to Conn.FJoinedConnectorsList.Count - 1 do begin currConn1 := Conn.FJoinedConnectorsList[i]; for j := 0 to currConn1.FJoinedLinesList.Count - 1 do begin aLine := currConn1.FJoinedLinesList[j]; if aLine.FSCSObject.FIsVertical then begin if not CheckLineInList(MovedLinesList, aLine) then begin MovedLinesList.Add(aLine); TakeThisConnector := false; if aLine.FJoinConnector1.FJoinedConnectorsList.Count = 0 then currConn2 := aLine.FJoinConnector1 else currConn2 := aLine.FJoinConnector1.FJoinedConnectorsList[0]; if not CheckConnectorInList(MovedConnectorsList, currConn2) then begin MovedConnectorsList.Add(currConn2); TakeThisConnector := true; end; if not TakethisConnector then begin if aLine.FJoinConnector2.FJoinedConnectorsList.Count = 0 then currConn2 := aLine.FJoinConnector2 else currConn2 := aLine.FJoinConnector2.FJoinedConnectorsList[0]; if not CheckConnectorInList(MovedConnectorsList, currConn2) then begin MovedConnectorsList.Add(currConn2); TakeThisConnector := true; end; end; if TakethisConnector then CheckVertLineConnected(currConn2); end; end; end; end; End; Function CantMoveLine: Boolean; var mLine: TOrthoLine; Conn1, Conn2: TConnectorObject; MaxFloorHeight, MinFloorHeight, FloorHeight: Double; currCad: TF_CAD; ListParams: TListParams; begin Result := False; xLine := Nil; if TObject(TTreeNode(aObj.tagObject).Data) is T3DLine then begin xLine := T3DLine(TTreeNode(aObj.tagObject).Data); if xLine <> nil then begin mLine := xLine.FSCSObject; if mLine.JoinConnector1 <> nil then if mLine.JoinConnector2 <> nil then if ((TConnectorObject(mLine.JoinConnector1).FConnRaiseType in [crt_TrunkUP, crt_TrunkDown, crt_BetweenFloorUp, crt_BetweenFloorDown]) or (TConnectorObject(mLine.JoinConnector2).FConnRaiseType in [crt_TrunkUP, crt_TrunkDown, crt_BetweenFloorUp, crt_BetweenFloorDown])) then Result := True; // вершину межэтажки или магистрали двигать по вертикали нельзя end; if not Result then // проверить на "улет" с этажа begin currCad := TF_CAD(TPowerCad(TConnectorObject(mLine.JoinConnector1).Owner).Owner); if currCad <> nil then begin ListParams := GetListParams(currCad.FCADListID); FloorHeight := MetreToUOM(ListParams.Settings.HeightRoom)*(1000 / currCad.PCad.MapScale)*Factor; // высота этажа if ListNotUnderFloor(currCad) then begin MaxFloorHeight := Get3DFloorHeight(currCad)*Factor; MinFloorHeight := MaxFloorHeight - FloorHeight; end else begin MinFloorHeight := Get3DFloorHeight(currCad)*Factor; MaxFloorHeight := MinFloorHeight + FloorHeight; end; if ((CompareValue(MaxFloorHeight, xGLLine.Nodes[0].Y) < 0) or (CompareValue(MinFloorHeight, xGLLine.Nodes[0].Y) > 0)) then begin Result := True; exit; end; if ((CompareValue(MaxFloorHeight, xGLLine.Nodes[1].Y) < 0) or (CompareValue(MinFloorHeight, xGLLine.Nodes[1].Y) > 0)) then Result := True; end; end; end; end; begin try xGLLine := TGLLines(aObj); // Tolik 01/05/2018 -- // MovedConnectorsList := TList.Create; // MovedLinesList := TList.Create; dp1.x := xGLLine.Nodes[0].X - MovedStartPos1.x; dp1.y := xGLLine.Nodes[0].Y - MovedStartPos1.y; dp1.z := xGLLine.Nodes[0].Z - MovedStartPos1.z; dp2.x := xGLLine.Nodes[1].X - MovedStartPos2.x; dp2.y := xGLLine.Nodes[1].Y - MovedStartPos2.y; dp2.z := xGLLine.Nodes[1].Z - MovedStartPos2.z; // Tolik 01/05/2018 -- if dp1.y <> 0 then if CantMoveLine then begin xGLLine.Nodes[0].X := MovedStartPos1.x; xGLLine.Nodes[0].Y := MovedStartPos1.y; xGLLine.Nodes[0].Z := MovedStartPos1.z; xGLLine.Nodes[1].X := MovedStartPos2.x; xGLLine.Nodes[1].Y := MovedStartPos2.y; xGLLine.Nodes[1].Z := MovedStartPos2.z; exit; end; MovedConnectorsList := TList.Create; MovedLinesList := TList.Create; // if TObject(TTreeNode(aObj.tagObject).Data) is T3DLine then begin xLine := T3DLine(TTreeNode(aObj.tagObject).Data); MovedLinesList.Add(xLine); if xLine.FJoinConnector1.FJoinedConnectorsList.Count = 0 then JoinConn1 := xLine.FJoinConnector1 else JoinConn1 := T3DConnector(xLine.FJoinConnector1.FJoinedConnectorsList[0]); if xLine.FJoinConnector2.FJoinedConnectorsList.Count = 0 then JoinConn2 := xLine.FJoinConnector2 else JoinConn2 := T3DConnector(xLine.FJoinConnector2.FJoinedConnectorsList[0]); //current Line Connectors MovedConnectorsList.Add(JoinConn1); MovedConnectorsList.Add(JoinConn2); { if xLine.FJoinConnector1 <> nil then Move3DConnector(JoinConn1, dp1); if xLine.FJoinConnector2 <> nil then Move3DConnector(JoinConn2, dp2);} // Tolik HasVertical := false; // Find Joined Vertical Lines // currLine Connectors {JoinConn1 := xLine.FJoinConnector1; JoinConn2 := xLine.FJoinConnector2; Counter := 0;} // Tolik 07/02/2019 -- на райзе вертикалей бфть не может if xLine.FSCSObject <> nil then if TOrthoLine(xLine.FSCSobject).FisRaiseUpDown = False then begin CheckVertLineConnected(JoinConn1); CheckVertLineConnected(JoinConn2); end; for i := 0 to MovedConnectorsList.Count - 1 do begin if T3DConnector(MovedConnectorsList[i]) <> nil then Move3DConnector(T3DConnector(MovedConnectorsList[i]), dp1) end; FreeAndNil(MovedConnectorsList); FreeAndNil(MovedLinesList); FMovedObjectsList.Clear; edScsLineX1.Text := FormatFloat(ffMask, xLine.FPoint1.x); edScsLineY1.Text := FormatFloat(ffMask, xLine.FPoint1.y); edScsLineZ1.Text := FormatFloat(ffMask, xLine.FPoint1.z); edScsLineX2.Text := FormatFloat(ffMask, xLine.FPoint2.x); edScsLineY2.Text := FormatFloat(ffMask, xLine.FPoint2.y); edScsLineZ2.Text := FormatFloat(ffMask, xLine.FPoint2.z); end; {$IF Defined(ES_GRAPH_SC)} if (TObject(TTreeNode(aObj.tagObject).Data) is T3DWall)or(TObject(TTreeNode(aObj.tagObject).Data) is T3DCorner) then begin //Перемещение в пространстве прилягающих сторон и точек, если это крыша :)))) if IfFiguraIsRoof(T3droom(ttreenode(aObj.tagObject).parent.data).FSCSCompon) then ChangeAllFiguresConnectedToModifyLine(xGLLine); end; {$IFEND} except on E: Exception do AddExceptionToLogEx('Tfrm3D.Move3DLine', E.Message); end; end; procedure Tfrm3D.ApplyCutting; begin if FToolMode <> tmSelect then begin FToolMode := tmSelect; glSpliter.Visible := False; glCubeSpliter.Visible := False; glCubeSpliter1.Visible := False; glCubeSpliter2.Visible := False; glSide11.Visible := False; glSide12.Visible := False; glSide21.Visible := False; glSide22.Visible := False; GLSceneViewer.Cursor := crDefault; DeleteNodesObjects; RefreshSidesPoints; end; end; // Tolik 04/12/2018 -- старая закомменчена -- см ниже procedure Tfrm3D.ApplyScsModel; var i, j, k: integer; dp: T3DPoint; xConn: T3DConnector; xLine, xAddLine: T3DLine; xScsConn, xGetScsConn: TConnectorObject; xScsLine, xScsAddLine: TOrthoLine; xCadForm: TF_CAD; //Tolik ProgressDropped: Boolean; OldGCadForm: TF_CAD; OldFlag: boolean; UndoFormsList: TList; // 26/02/2018 -- список форм для UNDO glObject: TGLFreeForm; xCompon: T3DComponent; ModelOffset, glObjMin, glObjMax, glObjSize: TDoublePoint; pModelOffx, pModelOffy, pModelOffz: PProperty; ConnDrawFigureCP: TDoublePoint; Procedure GetCompon3DProps(aCompon: TSCSComponent); var i: Integer; currProp: PProperty; begin pModelOffx := nil; pModelOffy := nil; pModelOffz := nil; for i := 0 to aCompon.Properties.Count - 1 do begin currProp := PProperty(aCompon.Properties[i]); if UpperCase(currProp.SysName) = 'K_3DMODEL_OFF_X' then begin ModelOffset.x := StrToFloat_My(currProp.Value); pModelOffx := currProp; end else if UpperCase(currProp.SysName) = 'K_3DMODEL_OFF_Y' then begin ModelOffset.y := StrToFloat_My(currProp.Value); pModelOffy := currProp; end else if UpperCase(currProp.SysName) = 'K_3DMODEL_OFF_Z' then begin ModelOffset.z := StrToFloat_My(currProp.Value); pModelOffz := currProp; end; end; end; function GetProp(aPropName: String; aCompon: TSCSComponent): TNBProperty; var insertResult: Integer; begin Result := Nil; //Result := F_ProjMan.GSCSBase.NBSpravochnik.GetPropertyBySysName(aPropName); //Result := F_ProjMan.GSCSBase.CurrProject.CurrList.Spravochnik.GetPropertyBySysName(aPropName); Result := aCompon.ProjectOwner.Spravochnik.GetPropertyBySysName(aPropName); if Result = nil then begin Result := F_NormBase.GSCSBase.NBSpravochnik.GetPropertyBySysName(aPropName); { if Result <> nil then begin //F_ProjMan.GSCSBase.CurrProject.NBSpravochnik.AddProperty(Result); //insertResult := F_ProjMan.GSCSBase.CurrProject.Spravochnik.AddProperty(Result); insertResult := aCompon.ProjectOwner.Spravochnik.AddProperty(Result); if insertResult > -1 then Result := aCompon.ProjectOwner.Spravochnik.GetPropertyBySysName(aPropName) else Result := Nil; end;} end; end; Procedure AddNewPropToCompon(aCompon: TSCSComponent; aProp: TNBProperty; aValue: Double); var Prop: PProperty; i: Integer; val: String; NBProp: TNBProperty; begin if aProp <> nil then begin Prop := aCompon.GetPropertyBySysName(aProp.PropertyData.SysName); if Prop = nil then begin if ACompon.GetPropertyBySysName(aProp.PropertyData.SysName) = nil then begin // Подтягиваем в справочник проекта из НБ Val := FloatTostr(RoundX(aValue, 10)); NBProp := F_NormBase.GSCSBase.NBSpravochnik.GetPropertyBySysName(aProp.PropertyData.SysName); if NBProp <> nil then begin ACompon.ProjectOwner.Spravochnik.GetPropertyWithAssign(NBProp.PropertyData.GUID, F_NormBase.GSCSBase.NBSpravochnik); if Val = '' then Val := NBProp.PropertyData.DefValue; end; AddPropertyToComponFromSprBySysName(ACompon, ACompon.ProjectOwner.Spravochnik, aProp.PropertyData.SysName, Val); end; end else if Prop <> nil then Prop.Value := FloatTostr(RoundX(aValue, 10)); end; end; Procedure SaveComponModelOffsetsAndRotation(aCompon: TSCSComponent; a3DCompon: T3DComponent; aObject: TglFreeForm); var xOffset, yOffset, zOffset: PProperty; AxeDelta: Double; kOff: Double; NormBaseProperty: TNBProperty; ComponProp: PProperty; begin // Angles NormBaseProperty := GetProp('R_ANGLE', aCompon); if NormBaseProperty <> nil then AddNewPropToCompon(aCompon, NormBaseProperty, a3DCompon.FRotate.z); NormBaseProperty := GetProp('T_ANGLE', aCompon); if NormBaseProperty <> nil then AddNewPropToCompon(aCompon, NormBaseProperty, a3DCompon.FRotate.y); NormBaseProperty := GetProp('P_ANGLE', aCompon); if NormBaseProperty <> nil then AddNewPropToCompon(aCompon, NormBaseProperty, a3DCompon.FRotate.x); // Offsets GetCompon3DProps(aCompon); Get3DSObjectBounds(glObjMin, glObjMax, aObject); glObjSize.x := abs(glObjMax.x - glObjMin.x); { glObjSize.y := abs(glObjMax.z - glObjMin.z); glObjSize.z := abs(glObjMax.y - glObjMin.y); } glObjSize.y := abs(glObjMax.z - glObjMin.z); glObjSize.z := abs(glObjMax.y - glObjMin.y); if ((aObject.Parent <> nil) and (aObject.Parent.ClassName = 'TGLDummyCube')) then if ((aObject.Parent.Parent <> nil) and (aObject.Parent.Parent.ClassName = 'TGLDummyCube')) then begin //if CompareValue(a3DCompon.FOffset.x, aObject.Parent.Parent.Position.x) <> 0 then if a3DCompon.FOffset.x <> 0 then begin AxeDelta := {aObject.Parent.Parent.Position.x - }a3DCompon.FOffset.x; if ABS(AxeDelta) > 0.0001 then begin { kOff := AxeDelta/glObjSize.x; if pModelOffx <> nil then begin pModelOffx.Value := FloatToStr(kOff); end else begin } //kOff := a3DCompon.FOffset.x; kOff := AxeDelta/glObjSize.x; NormBaseProperty := GetProp('K_3DMODEL_OFF_X', aCompon); if NormBaseProperty <> nil then AddNewPropToCompon(aCompon, NormBaseProperty, KOff); //end; end; end; //if CompareValue(a3DCompon.FOffset.y, aObject.Parent.Parent.Position.y) <> 0 then if a3DCompon.FOffset.y <> 0 then begin AxeDelta := {aObject.Parent.Parent.Position.y -} a3DCompon.FOffset.y; if ABS(AxeDelta) > 0.0001 then begin kOff := AxeDelta/glObjSize.y; //kOff := a3DCompon.FOffset.y; {if pModelOffz <> nil then begin pModelOffz.Value := FloatToStr(kOff); end else begin } NormBaseProperty := GetProp('K_3DMODEL_OFF_Y', aCompon); if NormBaseProperty <> nil then AddNewPropToCompon(aCompon, NormBaseProperty, KOff); //end; end; end; //if CompareValue(a3DCompon.FOffset.z, aObject.Parent.Parent.Position.z) <> 0 then if a3DCompon.FOffset.z <> 0 then begin AxeDelta := {aObject.Parent.Parent.Position.z -} a3DCompon.FOffset.z; if ABS(AxeDelta) > 0.0001 then begin //kOff := AxeDelta/glObjSize.z; {if pModelOffy <> nil then begin pModelOffy.Value := FloatToStr(kOff); end else begin } kOff := AxeDelta/glObjSize.z; //kOff := a3DCompon.FOffset.z; NormBaseProperty := GetProp('K_3DMODEL_OFF_Z', aCompon); if NormBaseProperty <> nil then AddNewPropToCompon(aCompon, NormBaseProperty, KOff); //end; end; end; end; (* GetCompon3DProps(aCompon); Get3DSObjectBounds(glObjMin, glObjMax, aObject); glObjSize.x := abs(glObjMax.x - glObjMin.x); { glObjSize.y := abs(glObjMax.z - glObjMin.z); glObjSize.z := abs(glObjMax.y - glObjMin.y); } glObjSize.y := abs(glObjMax.z - glObjMin.z); glObjSize.z := abs(glObjMax.y - glObjMin.y); //Rotation NormBaseProperty := GetProp('R_ANGLE'); if NormBaseProperty <> nil then AddNewPropToCompon(aCompon, NormBaseProperty, a3DCompon.FRotate.z); NormBaseProperty := GetProp('T_ANGLE'); if NormBaseProperty <> nil then AddNewPropToCompon(aCompon, NormBaseProperty, a3DCompon.FRotate.y); NormBaseProperty := GetProp('P_ANGLE'); if NormBaseProperty <> nil then AddNewPropToCompon(aCompon, NormBaseProperty, a3DCompon.FRotate.x); // if aObject.Parent = Dummycube then begin if CompareValue(a3DCompon.FOffset.x, aObject.Position.x) <> 0 then begin AxeDelta := aObject.Position.x - a3DCompon.FOffset.x; if ABS(AxeDelta) > 0.0001 then begin kOff := AxeDelta/glObjSize.x; if pModelOffx <> nil then begin pModelOffx.Value := FloatToStr(kOff); end else begin NormBaseProperty := GetProp('K_3DMODEL_OFF_X'); if NormBaseProperty <> nil then AddNewPropToCompon(aCompon, NormBaseProperty, KOff); end; end; end; if CompareValue(a3DCompon.FOffset.y, aObject.Position.y) <> 0 then begin AxeDelta := aObject.Position.y - a3DCompon.FOffset.y; if ABS(AxeDelta) > 0.0001 then begin kOff := AxeDelta/glObjSize.y; if pModelOffz <> nil then begin pModelOffz.Value := FloatToStr(kOff); end else begin NormBaseProperty := GetProp('K_3DMODEL_OFF_Z'); if NormBaseProperty <> nil then AddNewPropToCompon(aCompon, NormBaseProperty, KOff); end; end; end; if CompareValue(a3DCompon.FOffset.z, aObject.Position.z) <> 0 then begin AxeDelta := aObject.Position.z - a3DCompon.FOffset.z; if ABS(AxeDelta) > 0.0001 then begin kOff := AxeDelta/glObjSize.z; if pModelOffy <> nil then begin pModelOffy.Value := FloatToStr(kOff); end else begin NormBaseProperty := GetProp('K_3DMODEL_OFF_Y'); if NormBaseProperty <> nil then AddNewPropToCompon(aCompon, NormBaseProperty, KOff); end; end; end; end else begin if ((aObject.Parent <> nil) and (aObject.Parent.ClassName = 'TGLDummyCube')) then if ((aObject.Parent.Parent <> nil) and (aObject.Parent.Parent.ClassName = 'TGLDummyCube')) then begin //if CompareValue(a3DCompon.FOffset.x, aObject.Parent.Parent.Position.x) <> 0 then if a3DCompon.FOffset.x <> 0 then begin AxeDelta := {aObject.Parent.Parent.Position.x - }a3DCompon.FOffset.x; if ABS(AxeDelta) > 0.0001 then begin { kOff := AxeDelta/glObjSize.x; if pModelOffx <> nil then begin pModelOffx.Value := FloatToStr(kOff); end else begin } //kOff := a3DCompon.FOffset.x; kOff := AxeDelta/glObjSize.x; NormBaseProperty := GetProp('K_3DMODEL_OFF_X'); if NormBaseProperty <> nil then AddNewPropToCompon(aCompon, NormBaseProperty, KOff); //end; end; end; //if CompareValue(a3DCompon.FOffset.y, aObject.Parent.Parent.Position.y) <> 0 then if a3DCompon.FOffset.y <> 0 then begin AxeDelta := {aObject.Parent.Parent.Position.y -} a3DCompon.FOffset.y; if ABS(AxeDelta) > 0.0001 then begin kOff := AxeDelta/glObjSize.y; //kOff := a3DCompon.FOffset.y; {if pModelOffz <> nil then begin pModelOffz.Value := FloatToStr(kOff); end else begin } NormBaseProperty := GetProp('K_3DMODEL_OFF_Y'); if NormBaseProperty <> nil then AddNewPropToCompon(aCompon, NormBaseProperty, KOff); //end; end; end; //if CompareValue(a3DCompon.FOffset.z, aObject.Parent.Parent.Position.z) <> 0 then if a3DCompon.FOffset.z <> 0 then begin AxeDelta := {aObject.Parent.Parent.Position.z -} a3DCompon.FOffset.z; if ABS(AxeDelta) > 0.0001 then begin //kOff := AxeDelta/glObjSize.z; {if pModelOffy <> nil then begin pModelOffy.Value := FloatToStr(kOff); end else begin } kOff := AxeDelta/glObjSize.z; //kOff := a3DCompon.FOffset.z; NormBaseProperty := GetProp('K_3DMODEL_OFF_Z'); if NormBaseProperty <> nil then AddNewPropToCompon(aCompon, NormBaseProperty, KOff); //end; end; end; end; end; *) end; // begin //Tolik OldGCadForm := GCadForm; OldFlag := GCadForm.FNoMoveConnectedObjects; ProgressDropped := False; UndoFormsList := TList.Create; // *UNDO* -- 26/02/2018 -- if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, True, False); GCadForm.FCanSaveForUndo := False; end; UndoFormsList.Add(GCadForm); // try BeginProgress('Идет применение СКС модели ...', -1, True); // APPLY DIV TRACES for i := 0 to F3DModel.FScsObjects.Count - 1 do begin // Connector Object if TObject(F3DModel.FScsObjects[i]).ClassName = 'T3DConnector' then begin xConn := T3DConnector(F3DModel.FScsObjects[i]); //Tolik //xScsConn := xConn.FSCSObject; xScsConn := TConnectorObject(xConn.FSCSObject); if CheckTrunkObject(xSCSConn) then begin RotatetrunkObject(xSCSConn, (-1)* xSCSConn.FDrawFigureAngle * 180 / pi); RotatetrunkObject(xSCSConn, (-1)* xConn.FRotate.z); end else begin ConnDrawFigureCP := xSCSConn.DrawFigure.CenterPoint; if ABS(xSCSConn.FDrawFigureAngle) <> 0 then begin xSCSConn.Rotate((-1)*xSCSConn.FDrawFigureAngle); xSCSConn.DrawFigure.Rotate((-1)*xSCSConn.FDrawFigureAngle, ConnDrawFigureCP); end; xSCSConn.Rotate((-1)*DegToRad(xConn.FRotate.z)); xSCSConn.DrawFigure.Rotate((-1)*DegToRad(xConn.FRotate.z), ConnDrawFigureCP); xScsConn.FDrawFigureAngle := (-1)*DegToRad(xConn.FRotate.z); end; k := i; // // SCS Object NOT Exist if xScsConn = nil then begin // Empty and Not Connected Connector if (xConn.FConnType = ct_Empty) and (xConn.FJoinedConnectorsList.Count = 0) then begin if xConn.FListID <> FCAD.FCADListID then begin xCadForm := GetListByID(xConn.FListID); FCAD := xCadForm; end; GCadForm.FNoMoveConnectedObjects := OldFlag; GCadForm := FCAD; // Tolik 26/02/2018 -- if UndoFormsList.IndexOf(GCadForm) = -1 then begin // *UNDO* -- 26/02/2018 -- if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, True, False); GCadForm.FCanSaveForUndo := False; end; UndoFormsList.Add(GCadForm); // end; // OldFlag := GCadForm.FNoMoveConnectedObjects; GCadForm.FNoMoveConnectedObjects := False; // Get Trace which was Div xLine := T3DLine(xConn.FJoinedLinesList[0]); if xLine.FSCSObject <> nil then begin // Div on Scs xScsConn := DivideLineSimple(xLine.FSCSObject); // Joined xConn.FSCSObject := xScsConn; xScsConn.F3DObject := xConn; // Get Trace which Add By Div for j := 0 to xScsConn.JoinedOrtholinesList.Count - 1 do begin xScsAddLine := TOrthoLine(xScsConn.JoinedOrtholinesList[j]); // This line if xScsAddLine.F3DObject = nil then begin xAddLine := T3DLine(xConn.FJoinedLinesList[1]); xAddLine.FSCSObject := xScsAddLine; xScsAddLine.F3DObject := xAddLine; end; end; end; end; end; end // Tolik 12/12/2018 -- Save PointCompons Models positions else if TObject(F3DModel.FScsObjects[i]).ClassName = 'T3DComponent' then begin if T3DComponent(F3DModel.FScsObjects[i]).FSCSCompon <> nil then if T3DComponent(F3DModel.FScsObjects[i]).FGLObject <> nil then begin xCompon := T3DComponent(F3DModel.FScsObjects[i]); glObject := TGLFreeForm(T3DComponent(F3DModel.FScsObjects[i]).FGLObject); SaveComponModelOffSetsAndRotation(T3DComponent(F3DModel.FScsObjects[i]).FSCSCompon, xCompon, glObject); end; end; // end; GCadForm.FNoMoveConnectedObjects := OldFlag; // APPLY MOVES GMoveWithRaise := False; for i := 0 to F3DModel.FScsObjects.Count - 1 do begin // Connector Object if TObject(F3DModel.FScsObjects[i]).ClassNAme = 'T3DConnector' then begin xConn := T3DConnector(F3DModel.FScsObjects[i]); xScsConn := xConn.FSCSObject; // SCS Object Exist if xScsConn <> nil then begin // Not Connected Connector if (xConn.FConnType = ct_Full) or (xConn.FJoinedConnectorsList.Count = 0) then begin if xConn.FListID <> FCAD.FCADListID then begin xCadForm := GetListByID(xConn.FListID); FCAD := xCadForm; end; GCadForm.FNoMoveConnectedObjects := OldFlag; GCadForm := FCAD; // Tolik 26/02/2018 -- if UndoFormsList.IndexOf(GCadForm) = -1 then begin // *UNDO* -- 26/02/2018 -- if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, True, False); GCadForm.FCanSaveForUndo := False; end; UndoFormsList.Add(GCadForm); // end; // OldFlag := GCadForm.FNoMoveConnectedObjects; GCadForm.FNoMoveConnectedObjects := False; dp.x := Round4(xConn.FPoint.x - xScsConn.ActualPoints[1].x); dp.y := Round4(xConn.FPoint.y - xScsConn.ActualPoints[1].y); xScsConn.MoveConnector(dp.x, dp.y, false, false); if not G3DModelForProject then begin GMoveWithRaise := True; xScsConn.MoveBetweenRaiseConnector(dp.x, dp.y); // !!! GMoveWithRaise := False; end; {TODO ZCoord} xScsConn.ActualZOrder[1] := Round4(xConn.FPoint.z); //xScsConn.ActualZOrder[1] := UOMToMetre(Round4(xConn.FPoint.z)); // NEW xScsConn.MoveConnector(0, 0, false, false, false); // ДЛЯ ПЕРЕСЧЕТА ДЛИНЫ И ЗАПИСИ В РМ SetConFigureCoordZInPM(xScsConn.ID, xScsConn.ActualZOrder[1]); // ZOrder Connected Conns if xScsConn.ConnectorType <> ct_Clear then begin for j := 0 to xScsConn.JoinedConnectorsList.Count - 1 do begin xGetScsConn := TConnectorObject(xScsConn.JoinedConnectorsList[j]); if not G3DModelForProject then begin GMoveWithRaise := True; xGetScsConn.MoveBetweenRaiseConnector(dp.x, dp.y); // !!! GMoveWithRaise := False; end; {TODO ZCoord} xGetScsConn.ActualZOrder[1] := xScsConn.ActualZOrder[1]; // xGetScsConn.ActualZOrder[1] := UOMToMetre(xScsConn.ActualZOrder[1]); // NEW xGetScsConn.MoveConnector(0, 0, false, false, false); // ДЛЯ ПЕРЕСЧЕТА ДЛИНЫ И ЗАПИСИ В РМ SetConFigureCoordZInPM(xGetScsConn.ID, xGetScsConn.ActualZOrder[1]); end; end; end; end; end else // Line Object if TObject(F3DModel.FScsObjects[i]).ClassName = 'T3DLine' then begin xLine := T3DLine(F3DModel.FScsObjects[i]); {TODO ZCoord} //xLine.FSCSObject.ActualZOrder[0] := UOMToMetre(xLine.FSCSObject.ActualZOrder[0]); // new //xLine.FSCSObject.ActualZOrder[1] := UOMToMetre(xLine.FSCSObject.ActualZOrder[1]); // new //xLine.FSCSObject.ActualZOrder[2] := UOMToMetre(xLine.FSCSObject.ActualZOrder[2]); // new xScsLine := xLine.FSCSObject; end; end; except //Tolik // on E: Exception do AddExceptionToLogEx('Tfrm3D.ApplyScsModel', E.Message); on E: Exception do begin AddExceptionToLogEx('Tfrm3D.ApplyScsModel', E.Message); end; // end; GCadForm.FNoMoveConnectedObjects := OldFlag; GCadForm := OldGCadForm; //UpdateAllTracesLengthAndRefreshTextBoxOnAllLists; GMoveWithRaise := True; //Tolik FreeAndNil(UndoFormsList); EndProgress; // EndProgress; end; (* procedure Tfrm3D.ApplyScsModel; var i, j, k: integer; dp: T3DPoint; xConn: T3DConnector; xLine, xAddLine: T3DLine; xScsConn, xGetScsConn: TConnectorObject; xScsLine, xScsAddLine: TOrthoLine; xCadForm: TF_CAD; //Tolik ProgressDropped: Boolean; OldGCadForm: TF_CAD; OldFlag: boolean; UndoFormsList: TList; // 26/02/2018 -- список форм для UNDO // begin //Tolik OldGCadForm := GCadForm; OldFlag := GCadForm.FNoMoveConnectedObjects; ProgressDropped := False; UndoFormsList := TList.Create; // *UNDO* -- 26/02/2018 -- if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, True, False); GCadForm.FCanSaveForUndo := False; end; UndoFormsList.Add(GCadForm); // try BeginProgress('Идет применение СКС модели ...', -1, True); // APPLY DIV TRACES for i := 0 to F3DModel.FScsObjects.Count - 1 do begin // Connector Object if TObject(F3DModel.FScsObjects[i]) is T3DConnector then begin xConn := T3DConnector(F3DModel.FScsObjects[i]); //Tolik //xScsConn := xConn.FSCSObject; xScsConn := TConnectorObject(xConn.FSCSObject); k := i; // // SCS Object NOT Exist if xScsConn = nil then begin // Empty and Not Connected Connector if (xConn.FConnType = ct_Empty) and (xConn.FJoinedConnectorsList.Count = 0) then begin if xConn.FListID <> FCAD.FCADListID then begin xCadForm := GetListByID(xConn.FListID); FCAD := xCadForm; end; GCadForm.FNoMoveConnectedObjects := OldFlag; GCadForm := FCAD; // Tolik 26/02/2018 -- if UndoFormsList.IndexOf(GCadForm) = -1 then begin // *UNDO* -- 26/02/2018 -- if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, True, False); GCadForm.FCanSaveForUndo := False; end; UndoFormsList.Add(GCadForm); // end; // OldFlag := GCadForm.FNoMoveConnectedObjects; GCadForm.FNoMoveConnectedObjects := False; // Get Trace which was Div xLine := T3DLine(xConn.FJoinedLinesList[0]); if xLine.FSCSObject <> nil then begin // Div on Scs xScsConn := DivideLineSimple(xLine.FSCSObject); // Joined xConn.FSCSObject := xScsConn; xScsConn.F3DObject := xConn; // Get Trace which Add By Div for j := 0 to xScsConn.JoinedOrtholinesList.Count - 1 do begin xScsAddLine := TOrthoLine(xScsConn.JoinedOrtholinesList[j]); // This line if xScsAddLine.F3DObject = nil then begin xAddLine := T3DLine(xConn.FJoinedLinesList[1]); xAddLine.FSCSObject := xScsAddLine; xScsAddLine.F3DObject := xAddLine; end; end; end; end; end; end; end; GCadForm.FNoMoveConnectedObjects := OldFlag; // APPLY MOVES GMoveWithRaise := False; for i := 0 to F3DModel.FScsObjects.Count - 1 do begin // Connector Object if TObject(F3DModel.FScsObjects[i]) is T3DConnector then begin xConn := T3DConnector(F3DModel.FScsObjects[i]); xScsConn := xConn.FSCSObject; // SCS Object Exist if xScsConn <> nil then begin // Not Connected Connector if (xConn.FConnType = ct_Full) or (xConn.FJoinedConnectorsList.Count = 0) then begin if xConn.FListID <> FCAD.FCADListID then begin xCadForm := GetListByID(xConn.FListID); FCAD := xCadForm; end; GCadForm.FNoMoveConnectedObjects := OldFlag; GCadForm := FCAD; // Tolik 26/02/2018 -- if UndoFormsList.IndexOf(GCadForm) = -1 then begin // *UNDO* -- 26/02/2018 -- if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, True, False); GCadForm.FCanSaveForUndo := False; end; UndoFormsList.Add(GCadForm); // end; // OldFlag := GCadForm.FNoMoveConnectedObjects; GCadForm.FNoMoveConnectedObjects := False; dp.x := Round4(xConn.FPoint.x - xScsConn.ActualPoints[1].x); dp.y := Round4(xConn.FPoint.y - xScsConn.ActualPoints[1].y); xScsConn.MoveConnector(dp.x, dp.y, false, false); if not G3DModelForProject then begin GMoveWithRaise := True; xScsConn.MoveBetweenRaiseConnector(dp.x, dp.y); // !!! GMoveWithRaise := False; end; {TODO ZCoord} xScsConn.ActualZOrder[1] := Round4(xConn.FPoint.z); //xScsConn.ActualZOrder[1] := UOMToMetre(Round4(xConn.FPoint.z)); // NEW xScsConn.MoveConnector(0, 0, false, false, false); // ДЛЯ ПЕРЕСЧЕТА ДЛИНЫ И ЗАПИСИ В РМ SetConFigureCoordZInPM(xScsConn.ID, xScsConn.ActualZOrder[1]); // ZOrder Connected Conns if xScsConn.ConnectorType <> ct_Clear then begin for j := 0 to xScsConn.JoinedConnectorsList.Count - 1 do begin xGetScsConn := TConnectorObject(xScsConn.JoinedConnectorsList[j]); if not G3DModelForProject then begin GMoveWithRaise := True; xGetScsConn.MoveBetweenRaiseConnector(dp.x, dp.y); // !!! GMoveWithRaise := False; end; {TODO ZCoord} xGetScsConn.ActualZOrder[1] := xScsConn.ActualZOrder[1]; // xGetScsConn.ActualZOrder[1] := UOMToMetre(xScsConn.ActualZOrder[1]); // NEW xGetScsConn.MoveConnector(0, 0, false, false, false); // ДЛЯ ПЕРЕСЧЕТА ДЛИНЫ И ЗАПИСИ В РМ SetConFigureCoordZInPM(xGetScsConn.ID, xGetScsConn.ActualZOrder[1]); end; end; end; end; end else // Line Object if TObject(F3DModel.FScsObjects[i]) is T3DLine then begin xLine := T3DLine(F3DModel.FScsObjects[i]); {TODO ZCoord} //xLine.FSCSObject.ActualZOrder[0] := UOMToMetre(xLine.FSCSObject.ActualZOrder[0]); // new //xLine.FSCSObject.ActualZOrder[1] := UOMToMetre(xLine.FSCSObject.ActualZOrder[1]); // new //xLine.FSCSObject.ActualZOrder[2] := UOMToMetre(xLine.FSCSObject.ActualZOrder[2]); // new xScsLine := xLine.FSCSObject; end; end; except //Tolik // on E: Exception do AddExceptionToLogEx('Tfrm3D.ApplyScsModel', E.Message); on E: Exception do begin AddExceptionToLogEx('Tfrm3D.ApplyScsModel', E.Message); end; // end; GCadForm.FNoMoveConnectedObjects := OldFlag; GCadForm := OldGCadForm; //UpdateAllTracesLengthAndRefreshTextBoxOnAllLists; GMoveWithRaise := True; //Tolik FreeAndNil(UndoFormsList); EndProgress; // EndProgress; end; *) procedure Tfrm3D.ValidateActiveControl; begin // end; procedure Tfrm3D.sbApplyScsModelClick(Sender: TObject); begin ApplyScsModel; end; procedure Tfrm3D.nDivLineClick(Sender: TObject); var cp, cp1, p1, p2: T3DPoint; xGLLine, xGLAddLine: TGLLines; xGLConn: TGLPipe; xLine, xAddLine: T3DLine; xConn, JoinConn1, JoinConn2: T3DConnector; xParentNode, xLineNode, xAddLineNode, xConnNode: TTreeNode; xGLCaption, xGLAddCaption: TGLSpaceText; begin try xGLLine := TGLLines(FSelection[0]); cp := GetPointToDivTrace(mx, my, xGLLine); p1.x := xGLLine.Nodes[0].X; p1.y := xGLLine.Nodes[0].Y; p1.z := xGLLine.Nodes[0].Z; p2.x := xGLLine.Nodes[1].X; p2.y := xGLLine.Nodes[1].Y; p2.z := xGLLine.Nodes[1].Z; xLineNode := TTreeNode(xGLLine.tagObject); xParentNode := xLineNode.Parent; xLine := T3DLine(xLineNode.Data); JoinConn1 := xLine.FJoinConnector1; JoinConn2 := xLine.FJoinConnector2; xGLLine.Nodes[1].X := cp.x; xGLLine.Nodes[1].Y := cp.y; xGLLine.Nodes[1].Z := cp.z; xLine.FGLPoint2.x := xGLLine.Nodes[1].X; xLine.FGLPoint2.y := xGLLine.Nodes[1].Y - xLine.FZOrder; xLine.FGLPoint2.z := xGLLine.Nodes[1].Z; xLine.FPoint2.x := xLine.FGLPoint2.x / Factor; xLine.FPoint2.z := xLine.FGLPoint2.y / Factor; xLine.FPoint2.y := xLine.FGLPoint2.z / Factor; if xLine.FGLCaption <> nil then begin cp1.x := (xGLLine.Nodes[0].X + xGLLine.Nodes[1].X) / 2; cp1.y := (xGLLine.Nodes[0].Y + xGLLine.Nodes[1].Y) / 2; cp1.z := (xGLLine.Nodes[0].Z + xGLLine.Nodes[1].Z) / 2; if abs(xGLLine.Nodes[0].Y - xGLLine.Nodes[1].Y) < 0.0001 then cp1.y := cp1.y + 2 * factor else cp1.y := cp1.y - 2 * factor; xGLCaption := TGLSpaceText(xLine.FGLCaption); xGLCaption.Position.x := cp1.x; xGLCaption.Position.y := cp1.y; xGLCaption.Position.z := cp1.z; end; DeselectGLObjects; // Add Line **************************************************************** xGLAddLine := TGLLines(DummyCube.AddNewChild(TGLLines)); xGLAddLine.AddNode(cp.x, cp.y, cp.z); xGLAddLine.AddNode(p2.x, p2.y, p2.z); xGLAddLine.LineColor := xGLLine.LineColor; xGLAddLine.LineWidth := xGLLine.LineWidth; xGLAddLine.NodesAspect := xGLLine.NodesAspect; xGLAddLine.NodeColor := xGLLine.NodeColor; xAddLine := T3DLine.Create(nil, nil, xLine.FParent); xAddLine.FLineType := xLine.FLineType; xAddLine.FName := xLine.FName; xAddLine.FZOrder := xLine.FZOrder; xAddLine.FGLPoint1.x := xGLAddLine.Nodes[0].X; xAddLine.FGLPoint1.y := xGLAddLine.Nodes[0].Y - xAddLine.FZOrder; xAddLine.FGLPoint1.z := xGLAddLine.Nodes[0].Z; xAddLine.FGLPoint2.x := xGLAddLine.Nodes[1].X; xAddLine.FGLPoint2.y := xGLAddLine.Nodes[1].Y - xAddLine.FZOrder; xAddLine.FGLPoint2.z := xGLAddLine.Nodes[1].Z; xAddLine.FPoint1.x := xAddLine.FGLPoint1.x / Factor; xAddLine.FPoint1.z := xAddLine.FGLPoint1.y / Factor; xAddLine.FPoint1.y := xAddLine.FGLPoint1.z / Factor; xAddLine.FPoint2.x := xAddLine.FGLPoint2.x / Factor; xAddLine.FPoint2.z := xAddLine.FGLPoint2.y / Factor; xAddLine.FPoint2.y := xAddLine.FGLPoint2.z / Factor; xAddLine.FGLObject := xGLAddLine; F3DModel.FScsObjects.Add(xAddLine); xGLAddCaption := TGLSpaceText(DummyCube.AddNewChild(TGLSpaceText)); xGLAddCaption.Text := xAddLine.FName; xGLAddCaption.Scale.X := 0.4; xGLAddCaption.Scale.y := 0.4; xGLAddCaption.Scale.z := 0.4; xGLAddCaption.Extrusion := 0.05; xGLAddCaption.Font.Color := clRed; xGLAddCaption.Material.FrontProperties.Diffuse.Color := clrRed; xGLAddCaption.Material.BackProperties.Diffuse.Color := clrRed; xAddLine.FGLCaption := xGLAddCaption; cp1.x := (xGLAddLine.Nodes[0].X + xGLAddLine.Nodes[1].X) / 2; cp1.y := (xGLAddLine.Nodes[0].Y + xGLAddLine.Nodes[1].Y) / 2; cp1.z := (xGLAddLine.Nodes[0].Z + xGLAddLine.Nodes[1].Z) / 2; if abs(xGLAddLine.Nodes[0].Y - xGLAddLine.Nodes[1].Y) < 0.0001 then cp1.y := cp1.y + 2 * factor else cp1.y := cp1.y - 2 * factor; xGLAddCaption.Position.x := cp1.x; xGLAddCaption.Position.y := cp1.y; xGLAddCaption.Position.z := cp1.z; xAddLineNode := ScsModelTree.Items.AddChild(xParentNode, xLine.FName); xAddLineNode.Data := xAddLine; xAddLineNode.ImageIndex := 2; xAddLineNode.SelectedIndex := xAddLineNode.ImageIndex; //xAddLine.FFace.FTreeNode := xAddLineNode; xGLAddLine.TagObject := xAddLineNode; // Add Line **************************************************************** // Add Div Conn ************************************************************ xGLConn := TGLPipe(DummyCube.AddNewChild(TGLPipe)); xGLConn.AddNode(cp.x, cp.y, cp.z); xConn := T3DConnector.Create(nil, nil, xLine.FParent); xConn.FConnType := ct_Empty; xConn.FName := cCadClasses_Mes12; xConn.FZOrder := xLine.FZOrder; xConn.FGLPoint.x := xGLConn.Nodes[0].X; xConn.FGLPoint.y := xGLConn.Nodes[0].Y - xConn.FZOrder; xConn.FGLPoint.z := xGLConn.Nodes[0].Z; xConn.FPoint.x := xConn.FGLPoint.x / Factor; {TODO ZCoord} //xConn.FPoint.z := xConn.FGLPoint.y / Factor / FScaleDelta; xConn.FPoint.z := xConn.FGLPoint.y / Factor / FScaleDeltaSCS; // NEWNEW xConn.FPoint.y := xConn.FGLPoint.z / Factor; xConn.FGLObject := xGLConn; F3DModel.FScsObjects.Add(xConn); //xConnNode := ScsModelTree.Items.AddChild(xParentNode, xConn.FName); //xConnNode.Data := xConn; //xConnNode.ImageIndex := 3; //xConn.FFace.FTreeNode := xConnNode; //xGLConn.TagObject := xConnNode; // Add Div Conn ************************************************************ xLine.FJoinConnector1 := JoinConn1; xLine.FJoinConnector2 := xConn; xAddLine.FJoinConnector1 := xConn; xAddLine.FJoinConnector2 := JoinConn2; xConn.FJoinedLinesList.Add(xLine); xConn.FJoinedLinesList.Add(xAddLine); JoinConn2.FJoinedLinesList.Remove(xLine); JoinConn2.FJoinedLinesList.Add(xAddLine); except on E: Exception do AddExceptionToLogEx('Tfrm3D.nDivLineClick', E.Message); end; end; function Tfrm3D.GetPointToDivTrace(X, Y: Integer; aLine: TGLLines): T3DPoint; var glCursor: TGLCustomSceneObject; VX, VY: TVector; Camera: TGLCamera; begin try { glCursor := TGLCustomSceneObject.Create(GLScene); Camera := GLSceneViewer.Camera; VY := VectorMake(VectorPerpendicular(YVector, VectorNormalize(VectorSubtract(Camera.Position.AsAffineVector, MainCenter.Position.AsAffineVector)))); VX := VectorCrossProduct(VY, VectorNormalize( VectorSubtract(Camera.Position.AsVector, MainCenter.Position.AsVector))); NormalizeVector(VY); NormalizeVector(VX); glCursor.Position.Translate(VectorCombine(VX, VY, 0, 0)); } Result.x := (aLine.Nodes[0].X + aLine.Nodes[1].X) / 2; Result.y := (aLine.Nodes[0].Y + aLine.Nodes[1].Y) / 2; Result.z := (aLine.Nodes[0].Z + aLine.Nodes[1].Z) / 2; except on E: Exception do AddExceptionToLogEx('Tfrm3D.GetPointToDivTrace', E.Message); end; end; // Tolik 18/10/2018 -- старая закомменчена -- см ниже procedure Tfrm3D.Move3DConnector(aObj: T3DConnector; dp: T3DPoint; AIsFirstObject: Boolean=false); var i, j: integer; xConn, xConn1, xConn2, xGetConn, xRaiseConn, xObjFromRaise: T3DConnector; xLine: T3DLine; pos: T3DPoint; xGLCaption: TGLSpaceText; xGLObject: TGLPipe; xGLObjectF, xGLObject1: TGLFreeForm; isTGLFreeForm: Boolean; // Tolik 16/10/2018 -- если загружена модель SelfNode, ChildNode: TTreeNode; ChildCompon: T3DComponent; MovedComponObject: TglFreeForm; OldParentAngle: double; ObjPos: TVector4F; OldParentPos: TDoublePoint; Function GetSelfNode: TTreeNode; var i: Integer; currNode: TTreeNode; begin Result := Nil; for i := 0 to ScsModelTree.Items.Count - 1 do begin currNode := TTreeNode(ScsModelTree.Items[i]); if TObject(currNode.Data).ClassName = 'T3DConnector' then if T3DConnector(currNode.Data) = xConn then begin Result := currNode; break; end; end; end; Function CheckIsComponentMoved(aNode: TTreeNode): Boolean; var i: Integer; begin Result := False; if FSelection.Count > 0 then begin if TObject(FSelection[0]).ClassName = 'TGLFreeForm' then begin if TObject(aNode.Data).ClassName = 'T3DComponent' then begin if T3DComponent(aNode.Data).FGLObject <> nil then if TglFreeForm(T3DComponent(aNode.Data).FGLObject) = FMovedComponent then begin Result := True; exit; end; end; end; end; for i := 0 to aNode.Count - 1 do begin Result := CheckIsComponentMoved(aNode.Item[i]); if Result then exit; end; end; Function CanMoveComponent(aCompon: T3DComponent):Boolean; var ParentCatalog: TSCSCatalog; currCad: TF_CAD; FloorHeight, MinFloorHeight, MaxFloorHeight : Double; ListParams: TListParams; ParentConnector: T3DConnector; begin Result := True; currCad := Nil; if aCompon.FSCSCompon <> nil then currCad := GetListByID(aCompon.FSCSCompon.ListID); if CurrCad = nil then begin Result := False; exit; end; ListParams := GetListParams(currCad.FCADListID); FloorHeight := MetreToUOM(ListParams.Settings.HeightRoom)*(1000 / currCad.PCad.MapScale)*Factor; // высота этажа if ListNotUnderFloor(currCad) then begin MaxFloorHeight := Get3DFloorHeight(currCad)*Factor; MinFloorHeight := MaxFloorHeight - FloorHeight; end else begin MinFloorHeight := Get3DFloorHeight(currCad)*Factor; MaxFloorHeight := MinFloorHeight + FloorHeight; end; Result := True; { xConn.FGLPoint.y / Factor / FScaleDeltaSCS; } if ((CompareValue(MaxFloorHeight, xConn.FPoint.z*Factor*FScaleDeltaSCS + aCompon.FOffset.y*Factor*FScaleDeltaSCS + dp.y*Factor*FScaleDeltaSCS) < 0) or (CompareValue(MinFloorHeight, xConn.FPoint.z*Factor*FScaleDeltaSCS + aCompon.FOffset.y*Factor*FScaleDeltaSCS + dp.y*Factor*FScaleDeltaSCS) > 0)) then Result := False; end; function CheckCanMoveChildCompons(aNode: TTreeNode): Boolean; Var i: Integer; childCompon: T3DComponent; begin Result := True; if aNode = nil then // на всякий begin Result := False; exit; end; if TObject(aNode.data).ClassNAme = 'T3DComponent' then begin Result := CanMoveComponent(T3DComponent(aNode.data)); end; if Result then begin for i := 0 to aNode.Count - 1 do begin Result := CheckCanMoveChildCompons(aNode.Item[i]); if not Result then break; end; end; end; function CanMoveConnector(aConn: T3DConnector): boolean; // если сборный объект, чтобы никто из чилдов не выпрыгнул за границы этажа по высоте var ConnNode, ChildNode: TTreeNode; begin Result := True; ConnNode := nil; if aConn.FglObject <> nil then if TglBaseSceneObject(aConn.FglObject).TagObject <> nil then ConnNode := TTreeNode(TglBaseSceneObject(aConn.FglObject).TagObject); if ConnNode <> nil then Result := CheckCanMoveChildCompons(ConnNode); end; begin try if (dp.x = 0) and (dp.y = 0) and (dp.z = 0) then exit; xGLObject := nil; xConn := aObj; // Tolik 26/04/2018 -- { if dp.y <> 0 then if CorrectZOrderIfRaise then exit; } // if IsConnectorMoved(xConn) then exit; // object already moved! if WasShiftMouse then begin if FMovedComponent <> nil then begin if xConn.FGLObject <> nil then if TglBaseSceneObject(xConn.FGLObject).TagObject <> nil then begin if CheckIsComponentMoved(TTreeNode(TglBaseSceneObject(xConn.FGLObject).TagObject)) then begin MovedComponObject := FMovedComponent; if TTreeNode(MovedComponObject.TagObject).Data <> nil then if TObject(TTreeNode(MovedComponObject.TagObject).Data).ClassName = 'T3DComponent' then if CanMoveComponent(T3DComponent(TTreeNode(MovedComponObject.TagObject).Data)) then begin if MovedComponObject.Parent <> nil then if TGLDummyCube(MovedComponObject.Parent) <> DummyCube then if MovedComponObject.Parent.Parent <> nil then if TGLDummyCube(MovedComponObject.Parent.Parent) <> DummyCube then begin if TGLDummyCube(MovedComponObject.Parent.Parent).Parent <> nil then if TObject(TGLDummyCube(MovedComponObject.Parent.Parent).Parent).ClassName = 'TGLDummyCube' then if TGLDummyCube(MovedComponObject.Parent.Parent.Parent) <> DummyCube then begin //OldParentAngle := TGLDummyCube(MovedComponObject.Parent.Parent.Parent).TurnAngle; //TGLDummyCube(MovedComponObject.Parent.Parent.Parent).Turn((-1)*OldParentAngle); ObjPos := TGLDummyCube(MovedComponObject.Parent.Parent).AbsolutePosition; OldParentPos.x := TGLDummyCube(MovedComponObject.Parent.Parent).Position.X; OldParentPos.y := TGLDummyCube(MovedComponObject.Parent.Parent).Position.y; OldParentPos.z := TGLDummyCube(MovedComponObject.Parent.Parent).Position.z; ObjPos[0] := ObjPos[0] + dp.x; ObjPos[1] := ObjPos[1] + dp.y; ObjPos[2] := ObjPos[2] + dp.z; TGLDummyCube(MovedComponObject.Parent.Parent).AbsolutePosition := ObjPos; if MovedComponObject.TagObject <> nil then begin if TTreeNode(MovedComponObject.TagObject).Data <> nil then begin if TObject(TTreeNode(MovedComponObject.TagObject).Data).ClassName = 'T3DComponent' then begin T3DComponent(TTreeNode(MovedComponObject.TagObject).Data).FOffset.x := T3DComponent(TTreeNode(MovedComponObject.TagObject).Data).FOffset.x + (TGLDummyCube(MovedComponObject.Parent.Parent).Position.X - OldParentPos.x); T3DComponent(TTreeNode(MovedComponObject.TagObject).Data).FOffset.y := T3DComponent(TTreeNode(MovedComponObject.TagObject).Data).FOffset.y + (TGLDummyCube(MovedComponObject.Parent.Parent).Position.y - OldParentPos.y); T3DComponent(TTreeNode(MovedComponObject.TagObject).Data).FOffset.z := T3DComponent(TTreeNode(MovedComponObject.TagObject).Data).FOffset.z + (TGLDummyCube(MovedComponObject.Parent.Parent).Position.z - OldParentPos.z); end; end; end; exit; {TGLDummyCube(MovedComponObject.Parent.Parent).Position.X := TGLDummyCube(MovedComponObject.Parent.Parent).Position.x + dp.x; TGLDummyCube(MovedComponObject.Parent.Parent).Position.y := TGLDummyCube(MovedComponObject.Parent.Parent).Position.y + dp.y; TGLDummyCube(MovedComponObject.Parent.Parent).Position.z := TGLDummyCube(MovedComponObject.Parent.Parent).Position.z + dp.z;} //TGLDummyCube(MovedComponObject.Parent.Parent.Parent).Turn(OldParentAngle); end else begin TGLDummyCube(MovedComponObject.Parent.Parent).Position.X := TGLDummyCube(MovedComponObject.Parent.Parent).Position.x + dp.x; TGLDummyCube(MovedComponObject.Parent.Parent).Position.y := TGLDummyCube(MovedComponObject.Parent.Parent).Position.y + dp.y; TGLDummyCube(MovedComponObject.Parent.Parent).Position.z := TGLDummyCube(MovedComponObject.Parent.Parent).Position.z + dp.z; end; end; if MovedComponObject.TagObject <> nil then begin if TTreeNode(MovedComponObject.TagObject).Data <> nil then begin if TObject(TTreeNode(MovedComponObject.TagObject).Data).ClassName = 'T3DComponent' then begin T3DComponent(TTreeNode(MovedComponObject.TagObject).Data).FOffset.x := T3DComponent(TTreeNode(MovedComponObject.TagObject).Data).FOffset.x + dp.x; T3DComponent(TTreeNode(MovedComponObject.TagObject).Data).FOffset.y := T3DComponent(TTreeNode(MovedComponObject.TagObject).Data).FOffset.y + dp.z; T3DComponent(TTreeNode(MovedComponObject.TagObject).Data).FOffset.z := T3DComponent(TTreeNode(MovedComponObject.TagObject).Data).FOffset.z + dp.y; end; end; end; exit; end; end; end; end; end else if CanMoveConnector(xConn) then begin if xConn.FGLObject <> nil then begin if TglBasesceneObject(xConn.FGLObject).TagObject <> nil then if TTreeNode(TglBasesceneObject(xConn.FGLObject).TagObject).Count > 0 then begin TglBasesceneObject(xConn.FGLObject).Position.X := TglBasesceneObject(xConn.FGLObject).Position.X + dp.x; TglBasesceneObject(xConn.FGLObject).Position.Y := TglBasesceneObject(xConn.FGLObject).Position.Y + dp.y; TglBasesceneObject(xConn.FGLObject).Position.Z := TglBasesceneObject(xConn.FGLObject).Position.Z + dp.z; xConn.FGLPoint.x := TglBasesceneObject(xConn.FGLObject).Position.X + dp.x; xConn.FGLPoint.y := TglBasesceneObject(xConn.FGLObject).Position.Y + dp.y - xConn.FZOrder; xConn.FGLPoint.z := TglBasesceneObject(xConn.FGLObject).Position.Z + dp.z; xConn.FPoint.x := xConn.FGLPoint.x / Factor; {TODO ZCoord} //xConn.FPoint.z := xConn.FGLPoint.y / Factor / FScaleDelta; xConn.FPoint.z := xConn.FGLPoint.y / Factor / FScaleDeltaSCS; // NEWNEW xConn.FPoint.y := xConn.FGLPoint.z / Factor; exit; end; isTGLFreeForm := False; if xConn.FGLObject is TGLPipe then xGLObject := TGLPipe(xConn.FGLObject) else if xConn.FGLObject is TGLFreeForm then begin xGLObjectF := TGLFreeForm(xConn.FGLObject); isTGLFreeForm := True; end; // if xConn.FConnType = ct_Full then begin xGLObject1 := TGLFreeForm(xConn.FGLObject1); if FMovedFullConnector = nil then begin xGLObject1.Position.X := xGLObject1.Position.X + dp.x; xGLObject1.Position.Y := xGLObject1.Position.Y + dp.y; xGLObject1.Position.Z := xGLObject1.Position.Z + dp.z; end else //04.01.2012 begin if Not AIsFirstObject and (xGLObject1 <> nil) then begin xGLObject1.Position.X := xGLObject1.Position.X + dp.x; xGLObject1.Position.Y := xGLObject1.Position.Y + dp.y; xGLObject1.Position.Z := xGLObject1.Position.Z + dp.z; end; end; end; if isTGLFreeForm then // Tolik 16/10/2018 -- begin {xGLObjectF.Position.X := xGLObjectF.Position.X + dp.x; xGLObjectF.Position.Y := xGLObjectF.Position.Y + dp.y; xGLObjectF.Position.Z := xGLObjectF.Position.Z + dp.z;} end else begin if xGLObject <> nil then begin xGLObject.Nodes[0].X := xGLObject.Nodes[0].X + dp.x; xGLObject.Nodes[0].Y := xGLObject.Nodes[0].Y + dp.y; xGLObject.Nodes[0].Z := xGLObject.Nodes[0].Z + dp.z; end; end; if xConn.FConnType = ct_Empty then begin if xConn.FGLObject1 = glConn1 then begin glConn1.Position.X := xGLObject.Nodes[0].X; glConn1.Position.Y := xGLObject.Nodes[0].Y; glConn1.Position.Z := xGLObject.Nodes[0].Z; end; if xConn.FGLObject1 = glConn2 then begin glConn2.Position.X := xGLObject.Nodes[0].X; glConn2.Position.Y := xGLObject.Nodes[0].Y; glConn2.Position.Z := xGLObject.Nodes[0].Z; end; end; if isTGLFreeForm then // Tolik 16/10/2018 -- begin xConn.FGLPoint.x := xGLObjectF.Position.X; xConn.FGLPoint.y := xGLObjectF.Position.Y - xConn.FZOrder; xConn.FGLPoint.z := xGLObjectF.Position.Z; end else begin if xGLObject <> nil then begin xConn.FGLPoint.x := xGLObject.Nodes[0].X; xConn.FGLPoint.y := xGLObject.Nodes[0].Y - xConn.FZOrder; xConn.FGLPoint.z := xGLObject.Nodes[0].Z; end else begin if xConn.FGLObject.ClassName = 'TGLDummyCube' then begin xConn.FGLPoint.x := TGLDummyCube(xConn.FGLObject).Position.X + dp.x; xConn.FGLPoint.y := TGLDummyCube(xConn.FGLObject).Position.Y + dp.y; xConn.FGLPoint.z := TGLDummyCube(xConn.FGLObject).Position.Z + dp.z; end; end; xConn.FPoint.x := xConn.FGLPoint.x / Factor; {TODO ZCoord} //xConn.FPoint.z := xConn.FGLPoint.y / Factor / FScaleDelta; xConn.FPoint.z := xConn.FGLPoint.y / Factor / FScaleDeltaSCS; // NEWNEW xConn.FPoint.y := xConn.FGLPoint.z / Factor; end; if xConn.FGLCaption <> nil then begin xGLCaption := TGLSpaceText(xConn.FGLCaption); xGLCaption.Position.x := xGLCaption.Position.x + dp.x; xGLCaption.Position.y := xGLCaption.Position.y + dp.y; xGLCaption.Position.z := xGLCaption.Position.z + dp.z; end; SelfNode := GetSelfNode; if SelfNode <> nil then begin for i := 0 to SelfNode.Count - 1 do begin ChildNode := SelfNode.Item[i]; if TObject(ChildNode.Data).ClassName = 'T3DComponent' then begin ChildCompon := T3DComponent(ChildNode.Data); if ChildCompon.FGLObject <> nil then begin TGLFreeForm(ChildCompon.FGLObject).Position.x := TGLFreeForm(ChildCompon.FGLObject).Position.x + dp.x; TGLFreeForm(ChildCompon.FGLObject).Position.y := TGLFreeForm(ChildCompon.FGLObject).Position.y + dp.y; TGLFreeForm(ChildCompon.FGLObject).Position.z := TGLFreeForm(ChildCompon.FGLObject).Position.z + dp.z; //ChildCompon.FOffset.x := ChildCompon.FOffset.x + dp.x; //ChildCompon.FOffset.y := ChildCompon.FOffset.y + dp.y; //ChildCompon.FOffset.z := ChildCompon.FOffset.z + dp.z; end; end; end; end; end else begin xConn.FOffset.x := xConn.FOffset.x + dp.x; xConn.FOffset.y := xConn.FOffset.y + dp.y; xConn.FOffset.z := xConn.FOffset.z + dp.z; SelfNode := GetSelfNode; if SelfNode <> nil then begin for i := 0 to SelfNode.Count - 1 do begin ChildNode := SelfNode.Item[i]; if TObject(ChildNode.Data).ClassName = 'T3DComponent' then begin ChildCompon := T3DComponent(ChildNode.Data); if ChildCompon.FGLObject <> nil then begin TGLFreeForm(ChildCompon.FGLObject).Position.x := TGLFreeForm(ChildCompon.FGLObject).Position.x + dp.x; TGLFreeForm(ChildCompon.FGLObject).Position.y := TGLFreeForm(ChildCompon.FGLObject).Position.y + dp.y; TGLFreeForm(ChildCompon.FGLObject).Position.z := TGLFreeForm(ChildCompon.FGLObject).Position.z + dp.z; {ChildCompon.FOffset.x := ChildCompon.FOffset.x + dp.x; ChildCompon.FOffset.y := ChildCompon.FOffset.y + dp.y; ChildCompon.FOffset.z := ChildCompon.FOffset.z + dp.z;} end; end; end; end; end; FMovedObjectsList.Add(xConn); // Move Joined Lines ******************************************************* // if empty connector if xConn.FConnType = ct_Empty then begin for i := 0 to xConn.FJoinedLinesList.Count - 1 do begin xLine := T3DLine(xConn.FJoinedLinesList[i]); pos.x := xGLObject.Nodes[0].X; pos.y := xGLObject.Nodes[0].Y; pos.z := xGLObject.Nodes[0].Z; Move3DLine(xConn, xLine, pos); end; end else if xConn.FConnType = ct_Full then begin // if full connector if xConn.FGLObject = nil then begin pos.x := xConn.FOffset.x; pos.y := xConn.FOffset.y; pos.z := xConn.FOffset.z; end else begin if xGLObject <> nil then begin pos.x := xGLObject.Nodes[0].X; pos.y := xGLObject.Nodes[0].Y; pos.z := xGLObject.Nodes[0].Z; end else begin if xConn.FGLObject.ClassName = 'TGLDummyCube' then begin pos.x := TGLDummyCube(xConn.FGLObject).Position.X + dp.x; pos.y := TGLDummyCube(xConn.FGLObject).Position.Y + dp.y; pos.z := TGLDummyCube(xConn.FGLObject).Position.Z + dp.z; end; end; end; for i := 0 to xConn.FJoinedConnectorsList.Count - 1 do begin xGetConn := T3DConnector(xConn.FJoinedConnectorsList[i]); for j := 0 to xGetConn.FJoinedLinesList.Count - 1 do begin xLine := T3DLine(xGetConn.FJoinedLinesList[j]); { if isTGLFreeForm then begin pos.x := xGLObjectF.Position.X; pos.y := xGLObjectF.Position.Y; pos.z := xGLObjectF.Position.Z; end else begin pos.x := xGLObject.Nodes[0].X; pos.y := xGLObject.Nodes[0].Y; pos.z := xGLObject.Nodes[0].Z; end; } Move3DLine(xGetConn, xLine, pos); end; end; end; // Find and Move Raise or Object base raise Move3DRaiseConnector(xConn, dp); // Find and Move Between Floor Raise if G3DModelForProject then Move3DBetweenRaiseConnector(xConn, dp); end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.Move3DConnector', E.Message); end; end; (* procedure Tfrm3D.Move3DConnector(aObj: T3DConnector; dp: T3DPoint; AIsFirstObject: Boolean=false); var i, j: integer; xConn, xConn1, xConn2, xGetConn, xRaiseConn, xObjFromRaise: T3DConnector; xLine: T3DLine; pos: T3DPoint; xGLCaption: TGLSpaceText; xGLObject: TGLPipe; xGLObjectF, xGLObject1: TGLFreeForm; isTGLFreeForm: Boolean; // Tolik 16/10/2018 -- если загружена модель // Tolik 26/04/2018 -- // MaxFloorHeight: Double; (* Function CorrectZOrderIfRaise: Boolean; var i, j: Integer; Conn, tr_Conn, NB_Conn: TConnectorObject; JoinedLine : TOrthoLine; rh, ch: double; CheckFloorHeight: Boolean; begin Result := False; CheckFloorHeight := True; if xConn <> nil then if xConn.FSCSObject <> nil then begin Conn := TConnectorObject(xConn.FSCSObject); if FMovedLine = nil then // если тащим коннектор begin if TConnectorObject(xConn.FSCSObject).ConnectorType = ct_Clear then begin JoinedLine := Nil; if (Conn.FConnRaiseType in [crt_TrunkUP, crt_TrunkDown, crt_BetweenFloorUp, crt_BetweenFloorDown]) then dp.y := 0 // вершину магистрали/межэтажки вверх-вниз двигать нельзя else begin for i := 0 to Conn.JoinedOrthoLinesList.Count - 1 do begin JoinedLine := TOrthoLine(Conn.JoinedOrthoLinesList[i]); if JoinedLine.FIsRaiseUpDown then begin tr_Conn := Nil; if JoinedLine.JoinConnector1.ID = Conn.Id then tr_Conn := TConnectorObject(JoinedLine.JoinConnector2) else if JoinedLine.JoinConnector2.ID = Conn.Id then tr_Conn := TConnectorObject(JoinedLine.JoinConnector1); if tr_Conn <> nil then begin Rh := TGLPipe(T3DConnector(tr_Conn.F3DObject).FGLObject1).Position.Y; Ch := TGLPipe(T3DConnector(Conn.F3DObject).FGLObject1).Position.Y; //Rh := T3DConnector(tr_Conn.F3DObject).FGLPoint.y; //Ch := T3DConnector(Conn.F3DObject).FGLPoint.y; if tr_Conn.FConnRaiseType in [crt_TrunkUP, crt_BetweenFloorUp] then // не дать поднять второй коннектор выше вершины магистрали/межэтажки begin if DP.y > 0 then begin if CompareValue(Ch, Rh) = 1 then begin DP.y := 0; TGLPipe(T3DConnector(Conn.F3DObject).FGLObject1).Position.Y := Rh + 0.2; T3DConnector(Conn.F3DObject).FGLPoint.y := Rh + 0.1; //Result := True; end; CheckFloorHeight := False; end; { if DP.y > 0 then begin if CompareValue(Ch + dp.y, Rh) = 1 then dp.y := Rh - Ch - 0.2; TGLPipe(T3DConnector(Conn.F3DObject).FGLObject1).Position.Y := Ch; end;} end else if tr_Conn.FConnRaiseType in [crt_TrunkDown, crt_BetweenFloorDown] then // не дать опустить второй коннектор ниже вершины магистрали/межэтажки begin if dp.y < 0 then begin if CompareValue(Ch, Rh) = -1 then begin DP.y := 0; TGLPipe(T3DConnector(Conn.F3DObject).FGLObject1).Position.Y := Rh - 0.2; T3DConnector(Conn.F3DObject).FGLPoint.y := Rh - 0.1; //Result := True; {if CompareValue(Ch + dp.y, Rh) = -1 then dp.y := Rh - Ch + 0.2; TGLPipe(T3DConnector(Conn.F3DObject).FGLObject1).Position.Y := Ch;} end; CheckFloorHeight := False; end; end; end; break; end; end; end; end else if TConnectorObject(xConn.FSCSObject).ConnectorType = ct_NB then begin end; if CheckFloorHeight then if dp.y > 0 then //если второй конец райза (не вершина) тянется вверх -- не дать поднять выше высоты этажа begin Rh := TGLPipe(T3DConnector(tr_Conn.F3DObject).FGLObject1).Position.Y; Ch := TGLPipe(T3DConnector(Conn.F3DObject).FGLObject1).Position.Y; MaxFloorHeight := Get3DFloorHeight(Conn)*Factor; if fMovedLine = nil then begin if CompareValue(Ch, MaxFloorHeight) = 1 then begin DP.y := 0; TGLPipe(T3DConnector(Conn.F3DObject).FGLObject1).Position.Y := Rh + 0.2; T3DConnector(Conn.F3DObject).FGLPoint.y := Rh + 0.1; end; end else if CompareValue(Ch + DP.y, MaxFloorHeight) = 1 then begin DP.y := 0; TGLPipe(T3DConnector(Conn.F3DObject).FGLObject1).Position.Y := Rh + 0.2; T3DConnector(Conn.F3DObject).FGLPoint.y := Rh + 0.1; end; end; end else // если тащим трассу begin end; end; end; *) // (* begin try if (dp.x = 0) and (dp.y = 0) and (dp.z = 0) then exit; xConn := aObj; // Tolik 26/04/2018 -- { if dp.y <> 0 then if CorrectZOrderIfRaise then exit; } // if IsConnectorMoved(xConn) then exit; // object already moved! // Tolik 16/10/2018 -- // xGLObject := TGLPipe(xConn.FGLObject); isTGLFreeForm := False; if xConn.FGLObject is TGLPipe then xGLObject := TGLPipe(xConn.FGLObject) else if xConn.FGLObject is TGLFreeForm then begin xGLObjectF := TGLFreeForm(xConn.FGLObject); isTGLFreeForm := True; end; // if xConn.FConnType = ct_Full then begin xGLObject1 := TGLFreeForm(xConn.FGLObject1); if FMovedFullConnector = nil then begin xGLObject1.Position.X := xGLObject1.Position.X + dp.x; xGLObject1.Position.Y := xGLObject1.Position.Y + dp.y; xGLObject1.Position.Z := xGLObject1.Position.Z + dp.z; end else //04.01.2012 begin if Not AIsFirstObject and (xGLObject1 <> nil) then begin xGLObject1.Position.X := xGLObject1.Position.X + dp.x; xGLObject1.Position.Y := xGLObject1.Position.Y + dp.y; xGLObject1.Position.Z := xGLObject1.Position.Z + dp.z; end; end; end; if isTGLFreeForm then // Tolik 16/10/2018 -- begin {xGLObjectF.Position.X := xGLObjectF.Position.X + dp.x; xGLObjectF.Position.Y := xGLObjectF.Position.Y + dp.y; xGLObjectF.Position.Z := xGLObjectF.Position.Z + dp.z;} end else begin xGLObject.Nodes[0].X := xGLObject.Nodes[0].X + dp.x; xGLObject.Nodes[0].Y := xGLObject.Nodes[0].Y + dp.y; xGLObject.Nodes[0].Z := xGLObject.Nodes[0].Z + dp.z; end; if xConn.FConnType = ct_Empty then begin if xConn.FGLObject1 = glConn1 then begin glConn1.Position.X := xGLObject.Nodes[0].X; glConn1.Position.Y := xGLObject.Nodes[0].Y; glConn1.Position.Z := xGLObject.Nodes[0].Z; end; if xConn.FGLObject1 = glConn2 then begin glConn2.Position.X := xGLObject.Nodes[0].X; glConn2.Position.Y := xGLObject.Nodes[0].Y; glConn2.Position.Z := xGLObject.Nodes[0].Z; end; end; if isTGLFreeForm then // Tolik 16/10/2018 -- begin xConn.FGLPoint.x := xGLObjectF.Position.X; xConn.FGLPoint.y := xGLObjectF.Position.Y - xConn.FZOrder; xConn.FGLPoint.z := xGLObjectF.Position.Z; end else begin xConn.FGLPoint.x := xGLObject.Nodes[0].X; xConn.FGLPoint.y := xGLObject.Nodes[0].Y - xConn.FZOrder; xConn.FGLPoint.z := xGLObject.Nodes[0].Z; xConn.FPoint.x := xConn.FGLPoint.x / Factor; {TODO ZCoord} //xConn.FPoint.z := xConn.FGLPoint.y / Factor / FScaleDelta; xConn.FPoint.z := xConn.FGLPoint.y / Factor / FScaleDeltaSCS; // NEWNEW xConn.FPoint.y := xConn.FGLPoint.z / Factor; end; if xConn.FGLCaption <> nil then begin xGLCaption := TGLSpaceText(xConn.FGLCaption); xGLCaption.Position.x := xGLCaption.Position.x + dp.x; xGLCaption.Position.y := xGLCaption.Position.y + dp.y; xGLCaption.Position.z := xGLCaption.Position.z + dp.z; end; FMovedObjectsList.Add(xConn); // Move Joined Lines ******************************************************* // if empty connector if xConn.FConnType = ct_Empty then begin for i := 0 to xConn.FJoinedLinesList.Count - 1 do begin xLine := T3DLine(xConn.FJoinedLinesList[i]); pos.x := xGLObject.Nodes[0].X; pos.y := xGLObject.Nodes[0].Y; pos.z := xGLObject.Nodes[0].Z; Move3DLine(xConn, xLine, pos); end; end else if xConn.FConnType = ct_Full then begin // if full connector for i := 0 to xConn.FJoinedConnectorsList.Count - 1 do begin xGetConn := T3DConnector(xConn.FJoinedConnectorsList[i]); for j := 0 to xGetConn.FJoinedLinesList.Count - 1 do begin xLine := T3DLine(xGetConn.FJoinedLinesList[j]); if isTGLFreeForm then begin pos.x := xGLObjectF.Position.X; pos.y := xGLObjectF.Position.Y; pos.z := xGLObjectF.Position.Z; end else begin pos.x := xGLObject.Nodes[0].X; pos.y := xGLObject.Nodes[0].Y; pos.z := xGLObject.Nodes[0].Z; end; Move3DLine(xGetConn, xLine, pos); end; end; end; // Find and Move Raise or Object base raise Move3DRaiseConnector(xConn, dp); // Find and Move Between Floor Raise if G3DModelForProject then Move3DBetweenRaiseConnector(xConn, dp); except on E: Exception do AddExceptionToLogEx('Tfrm3D.Move3DConnector', E.Message); end; end; *) function Tfrm3D.Get3DConnectorByConnector(aConn: TConnectorObject): T3DConnector; var i: integer; xConn: T3DConnector; begin try Result := nil; for i := 0 to F3DModel.FScsObjects.Count - 1 do begin if TObject(F3DModel.FScsObjects[i]) is T3DConnector then begin xConn := T3DConnector(F3DModel.FScsObjects[i]); if xConn.FSCSObject = aConn then begin Result := xConn; exit; end; end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.Get3DConnectorByConnector', E.Message); end; end; function Tfrm3D.Get3DLineByOrtholine(aLine: TOrthoLine): T3DLine; var i: integer; xLine: T3DLine; begin try Result := nil; for i := 0 to F3DModel.FScsObjects.Count - 1 do begin if TObject(F3DModel.FScsObjects[i]) is T3DLine then begin xLine := T3DLine(F3DModel.FScsObjects[i]); if xLine.FSCSObject = aLine then begin Result := xLine; exit; end; end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.Get3DLineByOrtholine', E.Message); end; end; procedure Tfrm3D.Move3DLine(aObj: T3DConnector; aLine: T3DLine; aPos: T3DPoint); var xConn: T3DConnector; xLine: T3DLine; xGLLine: TGLLines; cp: T3DPoint; xGLCaption: TGLSpaceText; xLen, Length_X, Length_Y, Length_Z: Double; // Tolik --27/04/2018 -- NoTrunkConn: Boolean; //Tolik 19/10/2018 -- LineNode, LineComponNode: TTreeNode; i: Integer; LineCubeList: TList; //Tolik -- 19/11/2018 -- function CheckNoTrunkConn(aConn: T3DConnector): Boolean; var i: Integer; JoinedConn: TConnectorObject; begin Result := True; if xConn.FSCSObject.FConnRaiseType in [crt_TrunkUP, crt_TrunkDown, crt_BetweenFloorUp, crt_BetweenFloorDown] then Result := False; if Result then begin if xConn.FSCSObject.ConnectorType = ct_NB then begin for i := 0 to xConn.FSCSObject.JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(xConn.FSCSObject.JoinedConnectorsList[i]); if JoinedConn.FConnRaiseType in [crt_TrunkUP, crt_TrunkDown, crt_BetweenFloorUp, crt_BetweenFloorDown] then begin Result := False; break; end; end; end; end; end; Procedure RecreateLineCubicCompon(a3DObject: TGLCube; ParentNode: TTreeNode); var ObjNode: TTreeNode; LineComponent: TSCSComponent; curr3DLineCompon: T3DLineComponent; ComponIdex: Integer; AngleX, AngleY, AngleZ: Double; cubeLineLen, cubeLineHeight: Double; ParentLine: TOrthoLine; p1,p2: TDoublePoint; CubeHeight, CubeLen: Double; ComponColor: TVector4F; dist1, dist2: Double; begin if a3dObject <> nil then if a3dObject.TagObject <> nil then begin ObjNode := TTreeNode(a3dObject.TagObject); if ObjNode <> nil then begin curr3DLineCompon := T3DLineComponent(ObjNode.Data); if curr3DLineCompon <> nil then begin if curr3DLineCompon.FSCSCompon <> nil then begin LineComponent := curr3DLineCompon.FSCSCompon; DummyCube.BeginUpdate; a3DObject.ResetRotations; p1.x := TGLLines(aLine.FGLObject).Nodes[0].X; p1.y := TGLLines(aLine.FGLObject).Nodes[0].Y; p1.z := TGLLines(aLine.FGLObject).Nodes[0].Z; p2.x := TGLLines(aLine.FGLObject).Nodes[1].X; p2.y := TGLLines(aLine.FGLObject).Nodes[1].Y; p2.z := TGLLines(aLine.FGLObject).Nodes[1].Z; dist1 := SQRT(SQR(p1.x) + SQR(p1.y) + SQR(p1.z)); dist2 := SQRT(SQR(p2.x) + SQR(p2.y) + SQR(p2.z)); cubeLineLen := SQRT(Sqr(p1.x - p2.x) + Sqr(p1.y - p2.y) + Sqr(p1.z - p2.z)); cubeLineHeight := ABS(p1.y - p2.y); //AngleZ := 180 - RadToDeg(ArcSin(cubeLineHeight / cubeLineLen)); AngleZ := Math.RadToDeg(Math.ArcSin((p1.y - p2.y) / cubeLineLen)); ParentLine := TOrthoLine(T3DLine(Parentnode.Data).FSCSObject); AngleY := ParentLine.GetAngleDF(p1.x, p1.z, p2.x, p2.z); //AngleY := ParentLine.GetAngleDF(p1.z, p1.x, p2.z, p2.x); {While Angley > 180 do begin AngleY := AngleY - 180; if ((AngleY > 145) and (AngleY < 180)) or ((AngleY > 290) and (AngleY < 360)) then AngleZ := 180 - AngleZ else AngleZ := 180 + AngleZ; end; dist1 := SQRT(SQR(p1.x) + SQR(p1.y) + SQR(p1.z)); dist2 := SQRT(SQR(p2.x) + SQR(p2.y) + SQR(p2.z)); if CompareValue(dist1, dist2) = -1 then begin if CompareValue(p1.y, p2.y) = -1 then AngleZ := 180 - AngleZ; end else if CompareValue(dist2, dist1) = -1 then begin if CompareValue(p2.y, p1.y) = -1 then AngleZ := 180 - AngleZ; end; } a3DObject.Position.X := 0; a3DObject.Position.Y := 0; a3DObject.Position.Z := 0; a3DObject.RotateAbsolute(0, 180 - AngleY, AngleZ); if Sin(AngleZ) <> 0 then a3DObject.CubeWidth := cubeLineLen - ABS((a3DObject.CubeHeight/Sin(AngleZ))) else a3DObject.CubeWidth := cubeLineLen - (a3DObject.CubeHeight); a3DObject.Position.X := (p1.x + p2.x)/2; a3DObject.Position.Y := (p1.y + p2.y)/2; a3DObject.Position.Z := (p1.z + p2.z)/2; //DummyCube.Remove(a3DObject); //a3DObject.free; //a3DObject := TGLCube(DummyCube.AddNewChild(TglCube)); //a3DObject.TagObject := ObjNode; //curr3DLineCompon.FGLObject := a3DObject; DummyCube.EndUpdate; end; end; end; end; end; Procedure MoveConnectedLineComponent(aNode: TTreeNode); var i: integer; GLCyl: TGLCylinder; F3DLineCompon: T3DLineComponent; pN, pP: TVector3f; childNode: TTreeNode; begin if aNode <> nil then begin if TObject(aNode.Data).ClassName = 'T3DLineComponent' then begin if T3DLineComponent(aNode.Data).FGLObject <> nil then begin if T3DLineComponent(aNode.Data).FGLObject.ClassName = 'TGLCylinder' then begin pN[0] := xGLLine.Nodes[0].x; pN[1] := xGLLine.Nodes[0].y; pN[2] := xGLLine.Nodes[0].z; pP[0] := xGLLine.Nodes[1].x; pP[1] := xGLLine.Nodes[1].y; pP[2] := xGLLine.Nodes[1].z; TGLCylinder(T3DLineComponent(aNode.Data).FGLObject).Align(pN, pP); end else begin if T3DLineComponent(aNode.Data).FGLObject.ClassName = 'TGLCube' then if LineCubeList.IndexOf(T3DLineComponent(aNode.Data).FGLObject) = -1 then LineCubeList.Add(T3DLineComponent(aNode.Data).FGLObject); end; end; end; if aNode.Count > 0 then begin for i := 0 to aNode.Count - 1 do begin childNode := TTreeNode(aNode.Item[i]); MoveConnectedLineComponent(ChildNode); end; end; end; end; // begin try xConn := aObj; xLine := aLine; xGLLine := TGLLines(xLine.FGLObject); LineCubeList := TList.Create; // Tolik // 27/04/2018 -- NoTrunkConn := CheckNoTrunkConn(xConn); if xConn = xLine.FJoinConnector1 then begin xGLLine.Nodes[0].X := aPos.x; // Tolik 27/04/2018 -- if NoTrunkConn then // xGLLine.Nodes[0].Y := aPos.y; xGLLine.Nodes[0].Z := aPos.z; end; if xConn = xLine.FJoinConnector2 then begin xGLLine.Nodes[1].X := aPos.x; // Tolik 27/04/2018 -- if NoTrunkConn then // xGLLine.Nodes[1].Y := aPos.y; xGLLine.Nodes[1].Z := aPos.z; end; xLine.FGLPoint1.x := xGLLine.Nodes[0].X; xLine.FGLPoint1.y := xGLLine.Nodes[0].Y - xLine.FZOrder; xLine.FGLPoint1.z := xGLLine.Nodes[0].Z; xLine.FGLPoint2.x := xGLLine.Nodes[1].X; xLine.FGLPoint2.y := xGLLine.Nodes[1].Y - xLine.FZOrder; xLine.FGLPoint2.z := xGLLine.Nodes[1].Z; xLine.FPoint1.x := xLine.FGLPoint1.x / Factor; {TODO ZCoord} //xLine.FPoint1.z := xLine.FGLPoint1.y / Factor / FScaleDelta; xLine.FPoint1.z := xLine.FGLPoint1.y / Factor / FScaleDeltaSCS; // NEWNEW xLine.FPoint1.y := xLine.FGLPoint1.z / Factor; xLine.FPoint2.x := xLine.FGLPoint2.x / Factor; {TODO ZCoord} //xLine.FPoint2.z := xLine.FGLPoint2.y / Factor / FScaleDelta; xLine.FPoint2.z := xLine.FGLPoint2.y / Factor / FScaleDeltaSCS; // NEWNEW xLine.FPoint2.y := xLine.FGLPoint2.z / Factor; if xLine.FGLCaption <> nil then begin cp.x := (xGLLine.Nodes[0].X + xGLLine.Nodes[1].X) / 2; cp.y := (xGLLine.Nodes[0].Y + xGLLine.Nodes[1].Y) / 2; cp.z := (xGLLine.Nodes[0].Z + xGLLine.Nodes[1].Z) / 2; if abs(xGLLine.Nodes[0].Y - xGLLine.Nodes[1].Y) < 0.0001 then cp.y := cp.y + 2 * factor else cp.y := cp.y - 2 * factor; xGLCaption := TGLSpaceText(xLine.FGLCaption); xGLCaption.Position.x := cp.x; xGLCaption.Position.y := cp.y; xGLCaption.Position.z := cp.z; end; Length_X := (xLine.FPoint1.x - xLine.FPoint2.x) / 1000 * FCAD.PCad.MapScale; Length_Y := (xLine.FPoint1.y - xLine.FPoint2.y) / 1000 * FCAD.PCad.MapScale; Length_Z := (xLine.FPoint1.z - xLine.FPoint2.z); xLen := SQRT(SQR(Length_X) + SQR(Length_Y) + SQR(Length_Z)); xLine.FLength := xLen; // Tolik 119/10/2018 -- if xGLLine <> nil then // Line Components begin LineNode := TTreeNode(xGLLine.TagObject); if LineNode <> nil then if LineNode.Count > 0 then begin for i := 0 to LineNode.Count - 1 do begin LineComponNode := LineNode.Item[i]; MoveConnectedLineComponent(LineComponNode); end; for i := 0 to LineCubeList.Count - 1 do RecreateLineCubicCompon(TGLCube(LineCubeList[i]), LineNode); end; end; // except on E: Exception do AddExceptionToLogEx('Tfrm3D.Move3DLine', E.Message); end; LineCubeList.free; end; function Tfrm3D.IsConnectorMoved(aConn: T3DConnector): Boolean; var i: integer; begin try Result := False; for i := 0 to FMovedObjectsList.Count - 1 do begin if T3DConnector(FMovedObjectsList[i]) = aConn then begin Result := True; exit; end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.IsConnectorMoved', E.Message); end; end; procedure Tfrm3D.Trace3DConnector(aObj: TGLBaseSceneObject; dx, dy: Integer); var i: integer; VX, VY: TVector; Camera: TGLCamera; VX4, VY4, V4: TVector4f; glFull: TGLFreeForm; glEmpty: TGLCube; dist, dp: T3DPoint; xStr: string; xConn: T3DConnector; xGLLine: TGLLines; koefcam: Double; begin try Camera := GLSceneViewer.Camera; GLSceneViewer.Cursor := crHandPoint; VY := VectorMake(VectorPerpendicular(YVector, VectorNormalize(VectorSubtract(Camera.Position.AsAffineVector, MainCenter.Position.AsAffineVector)))); VX := VectorCrossProduct(VY, VectorNormalize( VectorSubtract(Camera.Position.AsVector, MainCenter.Position.AsVector))); NormalizeVector(VY); NormalizeVector(VX); koefcam := GetKoefMoveCam; //04.01.2012 - 0.132 V4 := VectorCombine(VX, VY, -dx * koefcam * Camera.DistanceToTarget / Camera.FocalLength, dy * koefcam * Camera.DistanceToTarget / Camera.FocalLength); glCursorObject.Position.Translate(V4); dist.x := abs(glCursorObject.Position.X - MovedStartPos.x); dist.y := abs(glCursorObject.Position.Y - MovedStartPos.y); dist.z := abs(glCursorObject.Position.Z - MovedStartPos.z); if aOBj is TGLFreeForm then begin glFull := TGLFreeForm(aObj); if (dist.x >= dist.y) and (dist.x >= dist.z) then begin glFull.Position.X := GetPosWithGridStep(glCursorObject.Position.X); glFull.Position.Y := MovedStartPos.y; glFull.Position.Z := MovedStartPos.z; end else if (dist.y >= dist.x) and (dist.y >= dist.z) then begin glFull.Position.X := MovedStartPos.x; glFull.Position.Y := GetPosWithGridStep(glCursorObject.Position.Y); glFull.Position.Z := MovedStartPos.z; end else if (dist.z >= dist.x) and (dist.z >= dist.y) then begin glFull.Position.X := MovedStartPos.x; glFull.Position.Y := MovedStartPos.y; glFull.Position.Z := GetPosWithGridStep(glCursorObject.Position.Z); end; // *** Move Joined *** dp.x := glFull.Position.X - MovedStartPos.x; dp.y := glFull.Position.Y - MovedStartPos.y; dp.z := glFull.Position.Z - MovedStartPos.z; for i := 0 to FShadowObjects.Count - 1 do begin xGLLine := TGLLines(FShadowObjects[i]); // Move point 1 if xGLLine.Tag = 1 then begin xGLLine.Nodes[0].X := TGLLines(xGLLine.TagObject).Nodes[0].X + dp.x; xGLLine.Nodes[0].Y := TGLLines(xGLLine.TagObject).Nodes[0].Y + dp.y; xGLLine.Nodes[0].Z := TGLLines(xGLLine.TagObject).Nodes[0].Z + dp.z; end; // Move point 2 if xGLLine.Tag = 2 then begin xGLLine.Nodes[1].X := TGLLines(xGLLine.TagObject).Nodes[1].X + dp.x; xGLLine.Nodes[1].Y := TGLLines(xGLLine.TagObject).Nodes[1].Y + dp.y; xGLLine.Nodes[1].Z := TGLLines(xGLLine.TagObject).Nodes[1].Z + dp.z; end; // Move point 1 and 2 (Raise) if xGLLine.Tag = 12 then begin xGLLine.Nodes[0].X := TGLLines(xGLLine.TagObject).Nodes[0].X + dp.x; xGLLine.Nodes[0].Y := TGLLines(xGLLine.TagObject).Nodes[0].Y + dp.y; xGLLine.Nodes[0].Z := TGLLines(xGLLine.TagObject).Nodes[0].Z + dp.z; xGLLine.Nodes[1].X := TGLLines(xGLLine.TagObject).Nodes[1].X + dp.x; xGLLine.Nodes[1].Y := TGLLines(xGLLine.TagObject).Nodes[1].Y + 0; xGLLine.Nodes[1].Z := TGLLines(xGLLine.TagObject).Nodes[1].Z + dp.z; end; // Move point 2 and 1 (Raise) if xGLLine.Tag = 21 then begin xGLLine.Nodes[0].X := TGLLines(xGLLine.TagObject).Nodes[0].X + dp.x; xGLLine.Nodes[0].Y := TGLLines(xGLLine.TagObject).Nodes[0].Y + 0; xGLLine.Nodes[0].Z := TGLLines(xGLLine.TagObject).Nodes[0].Z + dp.z; xGLLine.Nodes[1].X := TGLLines(xGLLine.TagObject).Nodes[1].X + dp.x; xGLLine.Nodes[1].Y := TGLLines(xGLLine.TagObject).Nodes[1].Y + dp.y; xGLLine.Nodes[1].Z := TGLLines(xGLLine.TagObject).Nodes[1].Z + dp.z; end; end; // *** Move Joined *** sbView.Caption := GetFullConnectorInfo(glFull); end; if aOBj is TGLCube then begin glEmpty := TGLCube(aObj); if (dist.x >= dist.y) and (dist.x >= dist.z) then begin glEmpty.Position.X := GetPosWithGridStep(glCursorObject.Position.X); glEmpty.Position.Y := MovedStartPos.y; glEmpty.Position.Z := MovedStartPos.z; end else if (dist.y >= dist.x) and (dist.y >= dist.z) then begin glEmpty.Position.X := MovedStartPos.x; glEmpty.Position.Y := GetPosWithGridStep(glCursorObject.Position.Y); glEmpty.Position.Z := MovedStartPos.z; end else if (dist.z >= dist.x) and (dist.z >= dist.y) then begin glEmpty.Position.X := MovedStartPos.x; glEmpty.Position.Y := MovedStartPos.y; glEmpty.Position.Z := GetPosWithGridStep(glCursorObject.Position.Z); end; // *** Move Joined *** dp.x := glEmpty.Position.X - MovedStartPos.x; dp.y := glEmpty.Position.Y - MovedStartPos.y; dp.z := glEmpty.Position.Z - MovedStartPos.z; for i := 0 to FShadowObjects.Count - 1 do begin xGLLine := TGLLines(FShadowObjects[i]); // Move point 1 if xGLLine.Tag = 1 then begin xGLLine.Nodes[0].X := TGLLines(xGLLine.TagObject).Nodes[0].X + dp.x; xGLLine.Nodes[0].Y := TGLLines(xGLLine.TagObject).Nodes[0].Y + dp.y; xGLLine.Nodes[0].Z := TGLLines(xGLLine.TagObject).Nodes[0].Z + dp.z; end; // Move point 2 if xGLLine.Tag = 2 then begin xGLLine.Nodes[1].X := TGLLines(xGLLine.TagObject).Nodes[1].X + dp.x; xGLLine.Nodes[1].Y := TGLLines(xGLLine.TagObject).Nodes[1].Y + dp.y; xGLLine.Nodes[1].Z := TGLLines(xGLLine.TagObject).Nodes[1].Z + dp.z; end; // Move point 1 and 2 (Raise) if xGLLine.Tag = 12 then begin xGLLine.Nodes[0].X := TGLLines(xGLLine.TagObject).Nodes[0].X + dp.x; xGLLine.Nodes[0].Y := TGLLines(xGLLine.TagObject).Nodes[0].Y + dp.y; xGLLine.Nodes[0].Z := TGLLines(xGLLine.TagObject).Nodes[0].Z + dp.z; xGLLine.Nodes[1].X := TGLLines(xGLLine.TagObject).Nodes[1].X + dp.x; xGLLine.Nodes[1].Y := TGLLines(xGLLine.TagObject).Nodes[1].Y + 0; xGLLine.Nodes[1].Z := TGLLines(xGLLine.TagObject).Nodes[1].Z + dp.z; end; // Move point 2 and 1 (Raise) if xGLLine.Tag = 21 then begin xGLLine.Nodes[0].X := TGLLines(xGLLine.TagObject).Nodes[0].X + dp.x; xGLLine.Nodes[0].Y := TGLLines(xGLLine.TagObject).Nodes[0].Y + 0; xGLLine.Nodes[0].Z := TGLLines(xGLLine.TagObject).Nodes[0].Z + dp.z; xGLLine.Nodes[1].X := TGLLines(xGLLine.TagObject).Nodes[1].X + dp.x; xGLLine.Nodes[1].Y := TGLLines(xGLLine.TagObject).Nodes[1].Y + dp.y; xGLLine.Nodes[1].Z := TGLLines(xGLLine.TagObject).Nodes[1].Z + dp.z; end; end; // *** Move Joined *** sbView.Caption := GetEmptyConnectorInfo(glEmpty); end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.Trace3DConnector', E.Message); end; end; procedure Tfrm3D.Trace3DLine(aObj: TGLBaseSceneObject; dx, dy: Integer); var VX, VY: TVector; Camera: TGLCamera; VX3, VY3, V3: TVector3f; glLine: TGLLines; dist1, dist2: T3DPoint; LineOrder: TLineOrder; koefcam: Double; begin try Camera := GLSceneViewer.Camera; GLSceneViewer.Cursor := crHandPoint; VY := VectorMake(VectorPerpendicular(YVector, VectorNormalize(VectorSubtract(Camera.Position.AsAffineVector, MainCenter.Position.AsAffineVector)))); VX := VectorCrossProduct(VY, VectorNormalize( VectorSubtract(Camera.Position.AsVector, MainCenter.Position.AsVector))); NormalizeVector(VY); NormalizeVector(VX); VX3[0] := VX[0]; VX3[1] := VX[1]; VX3[2] := VX[2]; VY3[0] := VY[0]; VY3[1] := VY[1]; VY3[2] := VY[2]; koefcam := GetKoefMoveCam; //04.01.2012 - 0.132 V3 := VectorCombine(VX3, VY3, -dx * koefcam * Camera.DistanceToTarget / Camera.FocalLength, dy * koefcam * Camera.DistanceToTarget / Camera.FocalLength); glCursorLine.Nodes.Translate(V3); dist1.x := abs(glCursorLine.Nodes[0].X - MovedStartPos1.x); dist1.y := abs(glCursorLine.Nodes[0].Y - MovedStartPos1.y); dist1.z := abs(glCursorLine.Nodes[0].Z - MovedStartPos1.z); dist2.x := abs(glCursorLine.Nodes[1].X - MovedStartPos2.x); dist2.y := abs(glCursorLine.Nodes[1].Y - MovedStartPos2.y); dist2.z := abs(glCursorLine.Nodes[1].Z - MovedStartPos2.z); glLine := TGLLines(aObj); LineOrder := GetLineOrder(glLine); if LineOrder = loNone then begin glLine.Nodes[0].X := GetPosWithGridStep(glCursorLine.Nodes[0].X); glLine.Nodes[0].Y := GetPosWithGridStep(glCursorLine.Nodes[0].Y); glLine.Nodes[0].Z := GetPosWithGridStep(glCursorLine.Nodes[0].Z); glLine.Nodes[1].X := GetPosWithGridStep(glCursorLine.Nodes[1].X); glLine.Nodes[1].Y := GetPosWithGridStep(glCursorLine.Nodes[1].Y); glLine.Nodes[1].Z := GetPosWithGridStep(glCursorLine.Nodes[1].Z); end else if LineOrder = loHorz then begin glLine.Nodes[0].X := MovedStartPos1.x; glLine.Nodes[1].X := MovedStartPos2.x; if (dist1.y >= dist1.z) then begin glLine.Nodes[0].Y := GetPosWithGridStep(glCursorLine.Nodes[0].Y); glLine.Nodes[1].Y := GetPosWithGridStep(glCursorLine.Nodes[1].Y); glLine.Nodes[0].Z := MovedStartPos1.z; glLine.Nodes[1].Z := MovedStartPos2.z; end else begin glLine.Nodes[0].Y := MovedStartPos1.y; glLine.Nodes[1].Y := MovedStartPos2.y; glLine.Nodes[0].Z := GetPosWithGridStep(glCursorLine.Nodes[0].Z); glLine.Nodes[1].Z := GetPosWithGridStep(glCursorLine.Nodes[1].Z); end; end else if LineOrder = loVert then begin glLine.Nodes[0].Z := MovedStartPos1.z; glLine.Nodes[1].Z := MovedStartPos2.z; if (dist1.x >= dist1.y) then begin glLine.Nodes[0].X := GetPosWithGridStep(glCursorLine.Nodes[0].X); glLine.Nodes[1].X := GetPosWithGridStep(glCursorLine.Nodes[1].X); glLine.Nodes[0].Y := MovedStartPos1.y; glLine.Nodes[1].Y := MovedStartPos2.y; end else begin glLine.Nodes[0].X := MovedStartPos1.x; glLine.Nodes[1].X := MovedStartPos2.x; glLine.Nodes[0].Y := GetPosWithGridStep(glCursorLine.Nodes[0].Y); glLine.Nodes[1].Y := GetPosWithGridStep(glCursorLine.Nodes[1].Y); end; end else if LineOrder = loRaise then begin glLine.Nodes[0].Y := MovedStartPos1.y; glLine.Nodes[1].Y := MovedStartPos2.y; if (dist1.x >= dist1.z) then begin glLine.Nodes[0].X := GetPosWithGridStep(glCursorLine.Nodes[0].X); glLine.Nodes[1].X := GetPosWithGridStep(glCursorLine.Nodes[1].X); glLine.Nodes[0].Z := MovedStartPos1.z; glLine.Nodes[1].Z := MovedStartPos2.z; end else begin glLine.Nodes[0].X := MovedStartPos1.x; glLine.Nodes[1].X := MovedStartPos2.x; glLine.Nodes[0].Z := GetPosWithGridStep(glCursorLine.Nodes[0].Z); glLine.Nodes[1].Z := GetPosWithGridStep(glCursorLine.Nodes[1].Z); end; end; sbView.Caption := GetLineInfo(glLine); except on E: Exception do AddExceptionToLogEx('Tfrm3D.Trace3DLine', E.Message); end; end; function Tfrm3D.GetLineOrder(aLine: TGLLines): TLineOrder; var delta: T3DPoint; begin try Result := loNone; delta.x := abs(aLine.Nodes[0].X - aLine.Nodes[1].X); delta.y := abs(aLine.Nodes[0].Y - aLine.Nodes[1].Y); delta.z := abs(aLine.Nodes[0].Z - aLine.Nodes[1].Z); // Horizontal (X) if (delta.y < 0.0001) and (delta.z < 0.0001) then begin Result := loHorz; end else // Vertical (Z) if (delta.x < 0.0001) and (delta.y < 0.0001) then begin Result := loVert; end else // Raise (Y) if (delta.x < 0.0001) and (delta.z < 0.0001) then begin Result := loRaise; end; except on E: Exception do AddExceptionToLogEx('', E.Message); end; end; procedure Tfrm3D.Move3DRaiseConnector(aObj: T3DConnector; dp: T3DPoint); var i, j: integer; xConn, xRaiseConn, xObjFromRaise: T3DConnector; xLine: T3DLine; xScsRaiseConn, xScsObjFromRaise: TConnectorObject; begin try xConn := aObj; if (xConn.FConnType <> ct_Empty) or (xConn.FJoinedConnectorsList.Count = 0) then begin if xConn.FSCSObject <> nil then begin xScsRaiseConn := GetRaiseConn(xConn.FSCSObject); if xScsRaiseConn <> nil then begin xRaiseConn := T3DConnector(xScsRaiseConn.F3DObject); if xRaiseConn <> nil then begin dp.y := 0; // no move by ZOrder Move3DConnector(xRaiseConn, dp); end; end; // получить ТО под с-п xScsObjFromRaise := xConn.FSCSObject.FObjectFromRaise; if xScsObjFromRaise <> nil then begin xObjFromRaise := T3DConnector(xScsObjFromRaise.F3DObject);; if xObjFromRaise <> nil then begin dp.y := 0; // no move by ZOrder Move3DConnector(xObjFromRaise, dp); end; end; end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.Move3DRaiseConnector', E.Message); end; end; procedure Tfrm3D.Move3DBetweenRaiseConnector(aObj: T3DConnector; dp: T3DPoint); var i, j: integer; xConn, xRaiseConn, xObjFromRaise: T3DConnector; xLine: T3DLine; xScsRaiseConn, xScsObjFromRaise, xScsConnToPassage: TConnectorObject; ListToPassage, CurGCadForm: TF_CAD; CurConnToPassageIndex: Integer; begin try xConn := aObj; if (xConn.FConnType <> ct_Empty) or (xConn.FJoinedConnectorsList.Count = 0) then begin if xConn.FSCSObject <> nil then begin xScsRaiseConn := GetRaiseConn(xConn.FSCSObject); if xScsRaiseConn <> nil then begin // Between Raise Exist if xScsRaiseConn.FID_ConnToPassage <> -1 then begin ListToPassage := GetListOfPassage(xScsRaiseConn.FID_ListToPassage); xScsConnToPassage := TConnectorObject(GetFigureByID(ListToPassage, xScsRaiseConn.FID_ConnToPassage)); if xScsConnToPassage <> nil then begin xScsObjFromRaise := xScsConnToPassage.FObjectFromRaise; if xScsObjFromRaise <> nil then begin // 3d model with this object exist if xScsObjFromRaise.F3DObject <> nil then begin xObjFromRaise := T3DConnector(xScsObjFromRaise.F3DObject); dp.y := 0; // no move by ZOrder Move3DConnector(xObjFromRaise, dp); end; end; end; end; end; end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.Move3DBetweenRaiseConnector', E.Message); end; end; function Tfrm3D.CanDrag(aObj: TGLBaseSceneObject; X, Y: Integer): Boolean; var i, j: integer; MoveOff: Integer; xConn, xGetConn: T3DConnector; xLine: T3DLine; xGLLine: TGLLines; p1, p2: T3DPoint; begin try Result := True; if (StartDragX <> -999) and (StartDragY <> -999) then begin MoveOff := 5; if (abs(X - StartDragX) >= MoveOff) or (abs(Y - StartDragY) >= MoveOff) then begin StartDragX := -999; StartDragY := -999; if aObj is TGLFreeForm then begin xConn := T3DConnector(TTreeNode(aObj.tagObject).Data); for i := 0 to xConn.FJoinedConnectorsList.Count - 1 do begin xGetConn := T3DConnector(xConn.FJoinedConnectorsList[i]); for j := 0 to xGetConn.FJoinedLinesList.Count - 1 do begin xLine := T3DLine(xGetConn.FJoinedLinesList[j]); xGLLine := TGLLines(DummyCube.AddNewChild(TGLLines)); p1.x := TGLLines(xLine.FGLObject).Nodes[0].X; p1.y := TGLLines(xLine.FGLObject).Nodes[0].Y; p1.z := TGLLines(xLine.FGLObject).Nodes[0].Z; p2.x := TGLLines(xLine.FGLObject).Nodes[1].X; p2.y := TGLLines(xLine.FGLObject).Nodes[1].Y; p2.z := TGLLines(xLine.FGLObject).Nodes[1].Z; xGLLine.AddNode(p1.x, p1.y, p1.z); xGLLine.AddNode(p2.x, p2.y, p2.z); xGLLine.LineColor.AsWinColor := clSilver; xGLLine.LineWidth := 2; xGLLine.NodesAspect := lnaInvisible; if xLine.FLineType = lt_Line then begin if xLine.FJoinConnector1 = xGetConn then xGLLine.Tag := 1; if xLine.FJoinConnector2 = xGetConn then xGLLine.Tag := 2; end else begin if xLine.FJoinConnector1 = xGetConn then xGLLine.Tag := 12; if xLine.FJoinConnector2 = xGetConn then xGLLine.Tag := 21; end; xGLLine.TagObject := xLine.FGLObject; FShadowObjects.Add(xGLLine); end; end; end; if aObj is TGLCube then begin xConn := T3DConnector(aObj.tagObject); for i := 0 to xConn.FJoinedLinesList.Count - 1 do begin xLine := T3DLine(xConn.FJoinedLinesList[i]); xGLLine := TGLLines(DummyCube.AddNewChild(TGLLines)); p1.x := TGLLines(xLine.FGLObject).Nodes[0].X; p1.y := TGLLines(xLine.FGLObject).Nodes[0].Y; p1.z := TGLLines(xLine.FGLObject).Nodes[0].Z; p2.x := TGLLines(xLine.FGLObject).Nodes[1].X; p2.y := TGLLines(xLine.FGLObject).Nodes[1].Y; p2.z := TGLLines(xLine.FGLObject).Nodes[1].Z; xGLLine.AddNode(p1.x, p1.y, p1.z); xGLLine.AddNode(p2.x, p2.y, p2.z); xGLLine.LineColor.AsWinColor := clSilver; xGLLine.LineWidth := 2; xGLLine.NodesAspect := lnaInvisible; if xLine.FLineType = lt_Line then begin if xLine.FJoinConnector1 = xConn then xGLLine.Tag := 1; if xLine.FJoinConnector2 = xConn then xGLLine.Tag := 2; end else begin if xLine.FJoinConnector1 = xConn then xGLLine.Tag := 12; if xLine.FJoinConnector2 = xConn then xGLLine.Tag := 21; end; xGLLine.TagObject := xLine.FGLObject; FShadowObjects.Add(xGLLine); end; end; end else begin Result := False; end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.CanDrag', E.Message); end; end; function Tfrm3D.GetFullConnectorInfo(aObj: TGLFreeForm): string; var xConn: T3DConnector; X, Y, Z: double; begin try xConn := T3DConnector(TTreeNode(aObj.tagObject).Data); X := aObj.Position.X / factor; {TODO ZCoord} //Z := aObj.Position.Y / factor / FScaleDelta - xConn.FZOrder; Z := aObj.Position.Y / factor / FScaleDeltaSCS - xConn.FZOrder; // NEWNEW Y := aObj.Position.Z / factor; Result := 'X=' + FormatFloat(ffMask, X) + ' ' + 'Y=' + FormatFloat(ffMask, Y) + ' ' + 'Z=' + FormatFloat(ffMask, Z); except on E: Exception do AddExceptionToLogEx('Tfrm3D.GetFullConnectorInfo', E.Message); end; end; function Tfrm3D.GetEmptyConnectorInfo(aObj: TGLCube): string; var xConn: T3DConnector; X, Y, Z: double; begin try xConn := T3DConnector(aObj.tagObject); X := aObj.Position.X / factor; {TODO ZCoord} //Z := aObj.Position.Y / factor / FScaleDelta - xConn.FZOrder; Z := aObj.Position.Y / factor / FScaleDeltaSCS - xConn.FZOrder; // NEWNEW Y := aObj.Position.Z / factor; Result := 'X=' + FormatFloat(ffMask, X) + ' ' + 'Y=' + FormatFloat(ffMask, Y) + ' ' + 'Z=' + FormatFloat(ffMask, Z); except on E: Exception do AddExceptionToLogEx('Tfrm3D.GetEmptyConnectorInfo', E.Message); end; end; function Tfrm3D.GetLineInfo(aObj: TGLLines): string; var xLine: T3DLine; X1, Y1, Z1, X2, Y2, Z2: double; begin try xLine := T3DLine(TTreeNode(aObj.tagObject).Data); X1 := aObj.Nodes[0].X / factor; {TODO ZCoord} //Z1 := aObj.Nodes[0].Y / factor / FScaleDelta - xLine.FZOrder; Z1 := aObj.Nodes[0].Y / factor / FScaleDeltaSCS - xLine.FZOrder; // NEWNEW Y1 := aObj.Nodes[0].Z / factor; X2 := aObj.Nodes[1].X / factor; {TODO ZCoord} //Z2 := aObj.Nodes[1].Y / factor / FScaleDelta - xLine.FZOrder; Z2 := aObj.Nodes[1].Y / factor / FScaleDeltaSCS - xLine.FZOrder; // NEWNEW Y2 := aObj.Nodes[1].Z / factor; Result := 'X1=' + FormatFloat(ffMask, X1) + ' ' + 'Y1=' + FormatFloat(ffMask, Y1) + ' ' + 'Z1=' + FormatFloat(ffMask, Z1) + ' ' + 'X2=' + FormatFloat(ffMask, X2) + ' ' + 'Y2=' + FormatFloat(ffMask, Y2) + ' ' + 'Z2=' + FormatFloat(ffMask, Z2); except on E: Exception do AddExceptionToLogEx('Tfrm3D.GetLineInfo', E.Message); end; end; function Tfrm3D.GetPosWithGridStep(aPos: Double): Double; var iPrev, iNext: Integer; grPrev, grNext: Double; begin try Result := aPos; iPrev := trunc(aPos / FGridstep); if iPrev >= 0 then iNext := iPrev + 1 else iNext := iPrev - 1; grPrev := FGridStep * iPrev; grNext := FGridStep * iNext; if abs(aPos - grNext) < abs(aPos - grPrev) then Result := grNext else Result := grPrev; except on E: Exception do AddExceptionToLogEx('Tfrm3D.GetPosWithGridStep', E.Message); end; end; procedure Tfrm3D.cbShowTraceCaptionsClick(Sender: TObject); begin try ToggleTraceCaptions(cbShowTraceCaptions.Checked); //29.03.2011 except on E: Exception do AddExceptionToLogEx('Tfrm3D.cbShowTraceCaptionsClick', E.Message); end; GLSceneViewer.SetFocus; end; procedure Tfrm3D.ToggleTraceCaptions(AShow: Boolean); var i: integer; GLBaseSceneObject: TGLBaseSceneObject; begin try for i := 0 to DummyCube.Count - 1 do begin GLBaseSceneObject := DummyCube.Children[i]; if GLBaseSceneObject.ClassName = 'TGLSpaceText' then if (GLBaseSceneObject.Tag <> 0) and (TObject(GLBaseSceneObject.Tag) is TOrthoLine) then GLBaseSceneObject.Visible := AShow; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.ToggleTraceCaptions', E.Message); end; end; procedure Tfrm3D.TimerOnSelectNodesTimer(Sender: TObject); begin try TimerOnSelectNodes.Enabled := False; DeselectGLObjectsT; // Select objects if TimerOnSelectNodes.Tag = 1 then begin SelectGLObjects(FxObjects); OnLoadProperties(FNodes); end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.TimerOnSelectNodesTimer', E.Message); end; TimerOnSelectNodes.OnTimer := nil; end; // Tolik 17/12/2018 -- старая закомменчена -- см. ниже procedure Tfrm3D.Rotate3DSObj(aObject: TGLFreeForm; aX, aY, aZ: Double; aSaveResult: Boolean = True); var xObject: T3DSObject; xCompon: T3DComponent; begin try aObject.ResetAndPitchTurnRoll(aZ, aY, aX); if aSaveResult then begin if TObject(TTreeNode(aObject.TagObject).Data).ClassName = 'T3DComponent' then begin xCompon := T3DComponent(TTreeNode(aObject.TagObject).Data); xCompon.FRotate.x := aX; xCompon.FRotate.y := aY; xCompon.FRotate.z := aZ; end else begin xObject := T3DSObject(TTreeNode(aObject.TagObject).Data); xObject.FRotate.x := aX; xObject.FRotate.y := aY; xObject.FRotate.z := aZ; end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.Rotate3DSObj', E.Message); end; end; Procedure Tfrm3D.Rotate3DComponent(aCompon: T3DComponent); var ComponObj: TGLFreeForm; grObj, grObj1: TGLDummyCube; StartAngle: Double; ParentNode: TTreeNode; ModelCount: Integer; function GetParentNode(aNode: TTreeNode): TTreeNode; begin Result := Nil; if aNode.Parent <> nil then if TObject(aNode.data).ClassName = 'T3DConnector' then Result := aNode else begin if ((TObject(aNode.Parent.data).ClassName = 'TF_CAD') or (TObject(aNode.Parent.data).ClassName = 'T3DModel')) then exit else Result := GetParentNode(aNode.Parent); end; end; Procedure CountResult(var aRes: Integer; aNode: TTreeNode); var i: Integer; begin for i := 0 to aNode.Count - 1 do begin if aNode.Item[i].Data <> nil then if TObject(aNode.Item[i].Data).ClassName = 'T3DComponent' then if T3DComponent(aNode.Item[i].Data).FGLObject <> nil then Inc(aRes); CountResult(aRes, aNode.Item[i]); end; end; Function GetConnModelsCount: Integer; var i: Integer; ParentNode: TTreeNode; begin Result := 0; if aCompon <> nil then begin if aCompon.FGLObject <> nil then begin if TglFreeForm(aCompon.FGLObject).TagObject <> nil then begin ParentNode := GetParentNode(TTreeNode(TglFreeForm(aCompon.FGLObject).TagObject)); if ParentNode <> nil then CountResult(Result, ParentNode); end end; end; end; begin if aCompon.FglObject <> nil then begin ComponObj := TGLFreeForm(aCompon.FglObject); if aCompon.isGroupedFigure then begin if ComponObj.Parent <> nil then if ComponObj.Parent <> DummyCube then begin StartAngle := ComponObj.Parent.RollAngle; end; end else begin if (ComponObj.Parent <> nil) and (ComponObj.Parent.ClassName = 'TGLDummyCube') and (TGLDummyCube(ComponObj.Parent) <> DummyCube) then if (ComponObj.Parent.Parent <> nil) and (ComponObj.Parent.Parent.ClassName = 'TGLDummyCube') and (TGLDummyCube(ComponObj.Parent.Parent) <> DummyCube) then begin ModelCount := GetConnModelsCount; if ModelCount = 0 then exit; { if ModelCount = 1 then begin if StrToFloat_My(edScsAngleX.Text) <> 0 then begin ComponObj.PitchAngle := -90; ComponObj.PitchAngle := StrToFloat_My(edScsAngleX.Text); end else begin ComponObj.PitchAngle := -90; ComponObj.PitchAngle := 0; end; TGLDummyCube(ComponObj.Parent).RollAngle := StrToFloat_My(edScsAngleY.Text); TGLDummyCube(ComponObj.Parent.Parent).TurnAngle := StrToFloat_My(edScsAngleZ.Text); end else if ModelCount > 1 then } begin if StrToFloat_My(edScsAngleX.Text) <> 0 then begin {ComponObj.PitchAngle := -90; ComponObj.PitchAngle := StrToFloat_My(edScsAngleX.Text);} end else begin {ComponObj.PitchAngle := -90; ComponObj.PitchAngle := 0;} end; {ComponObj.TurnAngle := StrToFloat_My(edScsAngleX.Text); TGLDummyCube(ComponObj.Parent).RollAngle := StrToFloat_My(edScsAngleY.Text); TGLDummyCube(ComponObj.Parent.Parent).TurnAngle := StrToFloat_My(edScsAngleZ.Text);} // if ModelCount = 1 then begin if TGLDummyCube(ComponObj.Parent.Parent).Parent <> nil then if TGLDummyCube(ComponObj.Parent.Parent).Parent.ClassNAme = 'TGLDummyCube' then if TGLDummyCube(ComponObj.Parent.Parent).Parent <> DummyCube then begin StartAngle := TGLDummyCube(ComponObj.Parent.Parent.Parent).TurnAngle; TGLDummyCube(ComponObj.Parent.Parent.Parent).TurnAngle := 0; {if ModelCount = 1 then TGLDummyCube(ComponObj.Parent.Parent.Parent).TurnAngle := 0//(-1)*(StartAngle); else TGLDummyCube(ComponObj.Parent.Parent.Parent).TurnAngle := -90;} TGLDummyCube(ComponObj.Parent.Parent).RollAngle := 0; //TGLDummyCube(ComponObj.Parent).TurnAngle := -90; TGLDummyCube(ComponObj.Parent).TurnAngle := 0; ComponObj.PitchAngle := 0; //ComponObj.PitchAngle := -90; ComponObj.PitchAngle := StrToFloat_My(edScsAngleX.Text); TGLDummyCube(ComponObj.Parent).RollAngle := StrToFloat_My(edScsAngleY.Text); TGLDummyCube(ComponObj.Parent.Parent).TurnAngle := StrToFloat_My(edScsAngleZ.Text); {TGLDummyCube(ComponObj.Parent).TurnAngle := StrToFloat_My(edScsAnglez.Text) - 90; TGLDummyCube(ComponObj.Parent.Parent).RollAngle := StrToFloat_My(edScsAngley.Text);} {TGLDummyCube(ComponObj.Parent).TurnAngle := StrToFloat_My(edScsAngleY.Text) - 90; TGLDummyCube(ComponObj.Parent.Parent).RollAngle := StrToFloat_My(edScsAngleZ.Text);} {TGLDummyCube(ComponObj.Parent).TurnAngle := StrToFloat_My(edScsAngleZ.Text) - 90; TGLDummyCube(ComponObj.Parent.Parent).RollAngle := StrToFloat_My(edScsAngleY.Text);} TGLDummyCube(ComponObj.Parent.Parent.Parent).TurnAngle := StartAngle; end; end; {else begin if TGLDummyCube(ComponObj.Parent.Parent).Parent <> nil then if TGLDummyCube(ComponObj.Parent.Parent).Parent.ClassNAme = 'TGLDummyCube' then if TGLDummyCube(ComponObj.Parent.Parent).Parent <> DummyCube then begin StartAngle := TGLDummyCube(ComponObj.Parent.Parent.Parent).TurnAngle; TGLDummyCube(ComponObj.Parent.Parent.Parent).TurnAngle := (-1)*(StartAngle -90); TGLDummyCube(ComponObj.Parent.Parent).TurnAngle := 0; TGLDummyCube(ComponObj.Parent).RollAngle := 0; ComponObj.PitchAngle := 0; //ComponObj.PitchAngle := -90; ComponObj.PitchAngle := StrToFloat_My(edScsAngleX.Text); TGLDummyCube(ComponObj.Parent).RollAngle := StrToFloat_My(edScsAngleY.Text); TGLDummyCube(ComponObj.Parent.Parent).TurnAngle := StrToFloat_My(edScsAngleZ.Text) + 90; TGLDummyCube(ComponObj.Parent.Parent.Parent).TurnAngle := StartAngle; end; end; } { ComponObj.PitchAngle := -90; ComponObj.PitchAngle := StrToFloat_My(edScsAngleX.Text); TGLDummyCube(ComponObj.Parent).RollAngle := StrToFloat_My(edScsAngleY.Text); TGLDummyCube(ComponObj.Parent.Parent).TurnAngle := StrToFloat_My(edScsAngleZ.Text); } end; aCompon.FRotate.x := StrToFloat_My(edSCSAngleX.Text); aCompon.FRotate.y := StrToFloat_My(edSCSAngleY.Text); aCompon.FRotate.z := StrToFloat_My(edSCSAngleZ.Text); end; end; end; end; { procedure Tfrm3D.Rotate3DSObj(aObject: TGLFreeForm; aX, aY, aZ: Double); var xObject: T3DSObject; begin try aObject.ResetAndPitchTurnRoll(aZ, aY, aX); xObject := T3DSObject(TTreeNode(aObject.TagObject).Data); xObject.FRotate.x := aX; xObject.FRotate.y := aY; xObject.FRotate.z := aZ; except on E: Exception do AddExceptionToLogEx('Tfrm3D.Rotate3DSObj', E.Message); end; end; } procedure Tfrm3D.RotateConnModel(aObject: TGLFreeForm; aX, aY, aZ: Double); var xConn: T3DConnector; begin try aObject.roll(az); aObject.ResetAndPitchTurnRoll(aZ, aY, aX); xConn := T3DConnector(TTreeNode(aObject.TagObject).Data); xConn.FRotate.x := aX; xConn.FRotate.y := aY; xConn.FRotate.z := aZ; except on E: Exception do AddExceptionToLogEx('Tfrm3D.RotateConnModel', E.Message); end; end; procedure Tfrm3D.CreateModel; begin if F3DModel = nil then F3DModel := T3DModel.Create; end; procedure Tfrm3D.CreateTopNode; var xModelNode: TTreeNode; begin ModelTree.Items.Clear; xModelNode := ModelTree.Items.AddFirst(nil, F3DModel.FName); xModelNode.Data := F3DModel; xModelNode.HasChildren := True; end; procedure Tfrm3D.CreateTopSCSNode; var xModelNode: TTreeNode; begin ScsModelTree.Items.Clear; xModelNode := ScsModelTree.Items.AddFirst(nil, F3DModel.FName); xModelNode.Data := F3DModel; xModelNode.HasChildren := True; end; function Tfrm3D.GetKoefMoveCam: Double; begin Result := 1; if GLSceneViewer.Camera.CameraStyle = csPerspective then Result := kmPerspective else Result := kmOrthogonel; end; function Tfrm3D.GetPointsForNormal(arr: T3DPointArray): T3DPointArray; var i, j: Integer; ChkPt, LineP1, LineP2: P3DPoint; ProjPoint: T3DPoint; ValidPt: Boolean; begin SetLength(Result, 0); for i := 0 to Length(arr) - 1 do begin ChkPt := @arr[i]; ValidPt := true; if Length(Result) >= 2 then begin // Проверяем есть ли такая уже for j := 0 to Length(Result) - 1 do if EQDP(ChkPt^, Result[j]) then begin ValidPt := false; Break; //// BREAK //// end; if ValidPt then begin // Если последняя добавленная в результаты на одной линии с добавляемой LineP1 := @Result[Length(Result)-1]; LineP2 := @Result[Length(Result)-2]; if IsPointInLine(LineP2^, ChkPt^, LineP1^, 1, 0) then begin ////Result[Length(Result)-1] := ChkPt^; LineP1^ := ChkPt^; ValidPt := false; end; //else //// Если точка не налини, проверяем не рядом ли она, через проецирование ее на линию //begin // ProjPoint := LineP1^; // PointToLineByAngle(LineP2^, ChkPt^, ProjPoint); // if GetLineLength(LineP1^, ProjPoint) < 4 then // begin // //LineP1^ := ChkPt^; // //ValidPt := false; // end; //end; end; end; if ValidPt then begin SetLength(Result, Length(Result) + 1); Result[Length(Result) - 1] := arr[i]; end; end; end; function Tfrm3D.GetPointsForNormalVector(arr: T3DPointArray): T3DPointArray; // Tolik 15/01/2020 var i, j, resLen, arrLen: Integer; ChkPt, LineP1, LineP2, PPt: P3DPoint; ProjPoint: T3DPoint; ValidPt: Boolean; begin New(LineP1); New(LineP2); New(PPt); SetLength(Result, 0); resLen := 0; arrLen := Length(arr) - 1; for i := 0 to arrLen do begin ChkPt := @arr[i]; ValidPt := true; if resLen > 0 then begin // Проверяем есть ли такая уже for j := 0 to resLen - 1 do if compare3DPoint(ChkPt^, Result[j], cmpNearestPointDelta) then begin ValidPt := false; Break; //// BREAK //// end; if ValidPt then if resLen > 1 then begin // Если последняя добавленная в результаты на одной линии с добавляемой LineP1^.x := Result[resLen - 1].x; LineP1^.y := Result[resLen - 1].z; LineP1^.z := Result[resLen - 1].y; LineP2^.x := Result[resLen - 2].x; LineP2^.y := Result[resLen - 2].z; LineP2^.z := Result[resLen - 2].y; PPt.x := ChkPt.x; PPt.y := ChkPt.z; PPt.z := ChkPt.y; if IsPointInLine(LineP2^, ChkPt^, LineP1^, 1, 0) then ValidPt := false; end; end; if ValidPt then begin inc(resLen); SetLength(Result, Reslen); Result[Reslen - 1] := arr[i]; end; end; DisPose(LineP1); DisPose(LineP2); DisPose(Ppt); end; function Tfrm3D.GLNodesTo3DCoords(aNodes: TGLNodes; aYAsZ: Boolean=false): T3DPointArray; var i: Integer; begin SetLength(Result, aNodes.Count); for i := 0 to aNodes.Count - 1 do begin Result[i].x := aNodes[i].x; if aYAsZ then begin Result[i].y := aNodes[i].z; Result[i].z := aNodes[i].y; end else begin Result[i].y := aNodes[i].y; Result[i].z := aNodes[i].z; end; end; end; // Tolik 04/03/2020 -- procedure Tfrm3D.FormKeyPress(Sender: TObject; var Key: Char); begin if Ord(key) = 27 then begin if FSelection.Count > 0 then begin ModelTree.ClearSelection; ScsModelTree.ClearSelection; DeselectGLObjects; end else Close; end; end; {procedure Tfrm3D.FormKeyPress(Sender: TObject; var Key: Char); begin if Ord(key) = 27 then Close; end;} // procedure Tfrm3D.SpeedButton4Click(Sender: TObject); begin Close; end; procedure Tfrm3D.cbDontShowSubstrateKeyPress(Sender: TObject; var Key: Char); var i: Integer; childNode: TTreeNode; currGLPLane: TGLPlane; RootNode: TTreeNode; CanEnableGLPlane1: Boolean; begin // Tolik -- 10/05/2018 -- { if Assigned(GLPlane1.Material.Texture.Image) then begin GLPlane1.BeginUpdate; GLPlane1.Material.Texture.Disabled := True; GLPlane1.Visible := False; GLPlane1.EndUpdate; GLSceneViewer.RecreateWnd; end; } if key = ' ' then begin if self.cbDontShowSubstrate.Checked then // uncheck (Enable substrates) begin if not GLPlane1.Material.Texture.Disabled then begin GLPlane1.Material.MaterialOptions := []; GLPlane1.Material.Texture.Disabled := True; GLPlane1.Material.FrontProperties.diffuse.alpha := 0; if not cbDisableSubstratesTransparency.Checked then GLPlane1.Material.BlendingMode := bmOpaque else GLPlane1.Material.BlendingMode := bmModulate;//bmAdditive; end; end else // cHeck (Disable substrates) begin CanEnableGLPlane1 := True; if self.tvSubStartesView.Visible then begin RootNode := tvSubStartesView.DropTarget; for i := 0 to RootNode.Count - 1 do begin if RootNode.Item[i].Data = GLPLane1 then if tvSubStartesView.ItemState[RootNode.Item[i].AbsoluteIndex] = csUnchecked then begin CanEnableGLPlane1 := False; break; end; end; end; if CanEnableGLPlane1 then begin GLPlane1.Material.MaterialOptions := []; GLPlane1.Material.Texture.Disabled := False; GLPlane1.Material.FrontProperties.diffuse.alpha := 1; if not cbDisableSubstratesTransparency.Checked then GLPlane1.Material.BlendingMode := bmOpaque else GLPlane1.Material.BlendingMode := bmModulate;//bmAdditive; end; end; if self.tvSubStartesView.Visible then begin RootNode := tvSubStartesView.DropTarget; for i := 0 to RootNode.Count - 1 do begin childNode := RootNode.Item[i]; currGLPlane := ChildNode.Data; if currGLPlane <> GLPLane1 then begin if tvSubStartesView.ItemState[childNode.AbsoluteIndex] = csChecked then currGLPlane.Visible := not cbDontShowSubstrate.Checked;//cbDontShowSubstrate.Checked; if not cbDisableSubstratesTransparency.Checked then currGLPlane.Material.BlendingMode := bmOpaque else currGLPlane.Material.BlendingMode := bmModulate;//bmAdditive; end; end; end; end; end; procedure Tfrm3D.cbDontShowSubstrateMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var i: Integer; childNode: TTreeNode; currGLPLane: TGLPlane; RootNode: TTreeNode; CanEnableGLPlane1: Boolean; begin if not cbDontShowSubstrate.Checked then begin //GLPlane1.BeginUpdate; //GLPlane1.Material.Texture.Disabled := True; //GLPlane1.Material.Texture.TextureFormat //GLPlane1.Material.Texture.Image.Free; if not GLPlane1.Material.Texture.Disabled then begin GLPlane1.Material.MaterialOptions := []; GLPlane1.Material.Texture.Disabled := True; GLPlane1.Material.FrontProperties.diffuse.alpha := 0; if not cbDisableSubstratesTransparency.Checked then GLPlane1.Material.BlendingMode := bmOpaque else GLPlane1.Material.BlendingMode := bmModulate;//bmAdditive; end; //GLPlane1.Visible := False; //GLPlane1.EndUpdate; //GLSceneViewer.RecreateWnd; end else begin CanEnableGLPlane1 := True; if self.tvSubStartesView.Visible then begin RootNode := tvSubStartesView.DropTarget; for i := 0 to RootNode.Count - 1 do begin if RootNode.Item[i].Data = GLPLane1 then if tvSubStartesView.ItemState[RootNode.Item[i].AbsoluteIndex] = csUnchecked then begin CanEnableGLPlane1 := False; break; end; end; end; if CanEnableGLPlane1 then begin GLPlane1.Material.MaterialOptions := []; GLPlane1.Material.Texture.Disabled := False; GLPlane1.Material.FrontProperties.diffuse.alpha := 1; if not cbDisableSubstratesTransparency.Checked then GLPlane1.Material.BlendingMode := bmOpaque else GLPlane1.Material.BlendingMode := bmModulate;//bmAdditive; end; end; if self.tvSubStartesView.Visible then begin RootNode := tvSubStartesView.DropTarget; for i := 0 to RootNode.Count - 1 do begin childNode := RootNode.Item[i]; currGLPlane := ChildNode.Data; if currGLPlane <> GLPLane1 then begin if tvSubStartesView.ItemState[childNode.AbsoluteIndex] = csChecked then currGLPlane.Visible := cbDontShowSubstrate.Checked;//cbDontShowSubstrate.Checked; if not cbDisableSubstratesTransparency.Checked then currGLPlane.Material.BlendingMode := bmOpaque else currGLPlane.Material.BlendingMode := bmModulate;//bmAdditive; end; end; end; end; procedure Tfrm3D.cbDisableSubstratesTransparencyClick(Sender: TObject); var i: Integer; currGLPlane: TGLPlane; begin if not cbDontShowSubstrate.Checked then begin for i := 0 to self.GLDummyCube1.Count - 1 do begin if self.GLDummyCube1.Children[i].ClassName = 'TGLPlane' then begin currGLPlane := TGLPlane(self.GLDummyCube1.Children[i]); currGLPlane.BeginUpdate; if not cbDisableSubstratesTransparency.Checked then currGLPlane.Material.BlendingMode := bmOpaque else currGLPlane.Material.BlendingMode := bmModulate;//bmAdditive; currGLPlane.EndUpdate; end; end; end; //GLSceneViewer.RecreateWnd; end; procedure Tfrm3D.tvSubStartesViewStateChange(Sender: TObject; Node: TTreeNode; NewState: TRzCheckState); var i: Integer; RootNode, childNode: TTreeNode; currGLPlane: TGLPlane; WasChange: Boolean; Procedure EnableNode; begin // if currGlPlane.Material.Texture.Disabled = True then begin if currGLPlane <> GLPlane1 then begin if not currGlPlane.Visible then begin currGlPlane.Visible := True; //currGlPlane.Material.Texture.Disabled := False; //currGlPlane.Material.FrontProperties.diffuse.alpha := 0; //WasChange := True; if not cbDisableSubstratesTransparency.Checked then currGlPlane.Material.BlendingMode := bmOpaque else currGlPlane.Material.BlendingMode := bmModulate;//bmAdditive; WasChange := True; end; end else begin GLPlane1.Material.MaterialOptions := []; GLPlane1.Material.Texture.Disabled := False; GLPlane1.Material.FrontProperties.diffuse.alpha := 1; if not cbDisableSubstratesTransparency.Checked then GLPlane1.Material.BlendingMode := bmOpaque else GLPlane1.Material.BlendingMode := bmModulate;//bmAdditive; end; end; end; Procedure DisableNode; begin if currGlPlane <> GLPLane1 then begin if currGlPlane.Visible then begin currGlPlane.Visible := False; //currGlPlane.Material.Texture.Disabled := True; //currGlPlane.Material.FrontProperties.diffuse.alpha := 1; if not cbDisableSubstratesTransparency.Checked then currGlPlane.Material.BlendingMode := bmOpaque else currGlPlane.Material.BlendingMode := bmModulate;//bmAdditive; WasChange := True; end; end else begin GLPlane1.Material.MaterialOptions := []; GLPlane1.Material.Texture.Disabled := True; GLPlane1.Material.FrontProperties.diffuse.alpha := 0; if not cbDisableSubstratesTransparency.Checked then GLPlane1.Material.BlendingMode := bmOpaque else GLPlane1.Material.BlendingMode := bmModulate;//bmAdditive; end; end; begin if Self.tvSubStartesView.Visible then if not cbDontShowSubstrate.Checked then begin if NewState = csPartiallyChecked then exit; WasChange := False; RootNode := tvSubStartesView.DropTarget; if Node = RootNode then begin for i := 0 to RootNode.Count - 1 do begin ChildNode := RootNode.Item[i]; currGLPlane := ChildNode.Data; if NewState = csChecked then EnableNode else if NewState = csUnchecked then DisableNode; end; end else begin ChildNode := Node; currGLPlane := TGLPlane(ChildNode.Data); if NewState = csChecked then EnableNode else if NewState = csUnchecked then DisableNode; end; end; end; procedure Tfrm3D.ShowHideAchObjectClick(Sender: TObject); var i, j: Integer; xNode: TTreeNode; xRoom: T3DRoom; xWall: T3dWall; xObject, childObj: T3DSObject; xGLObject: TGLBaseSceneObject; xSide: T3DSide; ShowNodeFigure: Boolean; Procedure ShowHideCollapsedNodes(aNode: TTreeNode); var i: Integer; Node: TTreeNode; begin for i := 0 to aNode.Count - 1 do begin Node:= aNode.Item[i]; if Node <> nil then begin if TObject(Node.Data).ClassName = 'T3DSide' then begin if T3DSide(Node.Data).FGLObject is TGLPolygon then begin TGLSceneObject(T3DSide(Node.Data).FGLObject).BeginUpdate; {if TGLSceneObject(T3DSide(Node.Data).FGLObject).Visible then TGLSceneObject(T3DSide(Node.Data).FGLObject).Visible := False else TGLSceneObject(T3DSide(Node.Data).FGLObject).Visible := True;} TGLSceneObject(T3DSide(Node.Data).FGLObject).Visible := not ShowNodeFigure; TGLSceneObject(T3DSide(Node.Data).FGLObject).EndUpdate; end; end; end; if Node.Count > 0 then ShowHideCollapsedNodes(Node); end; end; Procedure CheckShowHide(var aShowNodeFigure: Boolean; aNode: TTreeNode); var i: Integer; childNode: TTreeNode; begin if aShowNodeFigure then if aNode <> nil then begin if TObject(aNode.Data).ClassName = 'T3DSide' then begin if T3DSide(aNode.Data).FGLObject is TGLPolygon then aShowNodeFigure := TGLSceneObject(T3DSide(aNode.Data).FGLObject).Visible; end; end; if aShowNodeFigure then if aNode.Count > 0 then begin for i := 0 to aNode.Count - 1 do begin childNode := aNode.Item[i]; CheckShowHide(aShowNodeFigure, childNode); if not aShowNodeFigure then break; end; end; end; begin if ModelTree.SelectionCount > 0 then begin ShowNodeFigure := True; for i := 0 to ModelTree.SelectionCount - 1 do begin xNode := TTreeNode(ModelTree.Selections[i]); if xNode <> nil then begin CheckShowHide(ShowNodeFigure, xNode); if TObject(xNode.Data).ClassName = 'T3DSide' then begin if T3DSide(xNode.Data).FGLObject is TGLPolygon then begin TGLSceneObject(T3DSide(xNode.Data).FGLObject).BeginUpdate; TGLSceneObject(T3DSide(xNode.Data).FGLObject).Visible := not ShowNodeFigure; TGLSceneObject(T3DSide(xNode.Data).FGLObject).EndUpdate; end; end; end; if xNode.Count > 0 then ShowHideCollapsedNodes(xNode); end; { if xNode <> nil then begin xGLObject := TGLBaseSceneObject(ModelTree.Selections[0]); xObject := T3DSObject(xNode.Data); if xObject.ClassName = 'T3DRoom' then begin for i := 0 to T3DRoom(xObject).FWalls.Count - 1 do begin xWall := T3dWall(T3DRoom(xObject).FWalls[i]); for j := 0 to xWall.FSides.Count - 1 do begin xSide := T3dSide(xWall.FSides[j]); if xSide.FGLObject <> nil then if xSide.FGLObject is TGLPolygon then begin TGLSceneObject(xSide.FGLObject).BeginUpdate; if TGLSceneObject(xSide.FGLObject).Visible then TGLSceneObject(xSide.FGLObject).Visible := False else TGLSceneObject(xSide.FGLObject).Visible := True; TGLSceneObject(xSide.FGLObject).EndUpdate; end; end; end; end; end; } end; {currGLPlane := TGLPlane(self.GLDummyCube1.Children[i]); currGLPlane.BeginUpdate; if not cbDisableSubstratesTransparency.Checked then currGLPlane.Material.BlendingMode := bmOpaque else currGLPlane.Material.BlendingMode := bmModulate;//bmAdditive; currGLPlane.EndUpdate;} { try TimerOnSelectNodes.Enabled := False; DeselectGLObjectsT; // Select objects if TimerOnSelectNodes.Tag = 1 then begin SelectGLObjects(FxObjects); OnLoadProperties(FNodes); end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.TimerOnSelectNodesTimer', E.Message); end; TimerOnSelectNodes.OnTimer := nil; } end; procedure Tfrm3D.N1Click(Sender: TObject); Procedure SetObjectsTransparency(aNode: tTreeNode; TrCableChannel, TrTube, TrCorrugation: Integer); var i: Integer; childNode: TTreeNode; begin if TrCableChannel = 0 then if TrTube = 0 then if TrCorrugation = 0 then exit; for i := 0 to aNode.Count - 1 do begin ChildNode := aNode.Item[i]; if TObject(ChildNode.Data).ClassName = 'T3DLineComponent' then begin if T3DLineComponent(ChildNode.Data).FGLObject <> nil then begin if T3DLineComponent(ChildNode.Data).FGLObject.ClassName = 'TGLCube' then begin with TglCube(T3DLineComponent(ChildNode.Data).FGLObject).Material do begin BlendingMode := bmTransparency; BackProperties.Diffuse.Alpha := 1 - TrCableChannel/100; FrontProperties.Diffuse.Alpha := 1 - TrCableChannel/100; end; end else if T3DLineComponent(ChildNode.Data).FGLObject.ClassName = 'TGLCylinder' then begin if T3DLineComponent(ChildNode.Data).FSCSCompon.ComponentType.SysName = ctsnCableChannel then begin if T3DLineComponent(ChildNode.Data).FSCSCompon.ComponentType.GUID = '{80B7A366-98B3-4D3A-A115-C64A3498218E}' then begin with TglCyLinder(T3DLineComponent(ChildNode.Data).FGLObject).Material do begin BlendingMode := bmTransparency; BackProperties.Diffuse.Alpha := 1 - TrCorrugation/100; FrontProperties.Diffuse.Alpha := 1 - TrCorrugation/100; end; end; end else if T3DLineComponent(ChildNode.Data).FSCSCompon.ComponentType.SysName = ctsnTube then begin with TglCylinder(T3DLineComponent(ChildNode.Data).FGLObject).Material do begin BlendingMode := bmTransparency; BackProperties.Diffuse.Alpha := 1 - TrTube/100; FrontProperties.Diffuse.Alpha := 1 - TrTube/100; end; end; end; end; end; if ChildNode.Count > 0 then SetObjectsTransparency(ChildNode, TrCableChannel, TrTube, TrCorrugation); end; isUserTransparency := True; end; begin if ScsModelTree.Selected <> nil then begin { if UPPERCASE(TObject(ScsModelTree.Selected.Data).ClassName) = 'TF_CAD' then SetCableChannelTransparency(ScsModelTree.Selected); } if not Assigned(F_SetTransparency) then Application.CreateForm(TF_SetTransparency, F_SetTransparency); if F_SetTransparency.ShowModal = mrOk then SetObjectsTransparency(ScsModelTree.Selected, F_SetTransparency.TrCableChannel.Position, F_SetTransparency.TrTube.Position, F_SetTransparency.TrCorrugation.Position); end; end; procedure Tfrm3D.N2Click(Sender: TObject); Procedure DropObjectsTransparency(aNode: tTreeNode); var i: Integer; childNode: TTreeNode; begin for i := 0 to aNode.Count - 1 do begin ChildNode := aNode.Item[i]; if TObject(ChildNode.Data).ClassName = 'T3DLineComponent' then begin if T3DLineComponent(ChildNode.Data).FGLObject <> nil then begin if T3DLineComponent(ChildNode.Data).FGLObject.ClassName = 'TGLCube' then begin with TglCube(T3DLineComponent(ChildNode.Data).FGLObject).Material do begin BlendingMode := bmOpaque; BackProperties.Diffuse.Alpha := 1; FrontProperties.Diffuse.Alpha := 1; end; end else if T3DLineComponent(ChildNode.Data).FGLObject.ClassName = 'TGLCylinder' then begin if T3DLineComponent(ChildNode.Data).FSCSCompon.ComponentType.SysName = ctsnCableChannel then begin if T3DLineComponent(ChildNode.Data).FSCSCompon.ComponentType.GUID = '{80B7A366-98B3-4D3A-A115-C64A3498218E}' then begin with TglCyLinder(T3DLineComponent(ChildNode.Data).FGLObject).Material do begin BlendingMode := bmOpaque; BackProperties.Diffuse.Alpha := 1; FrontProperties.Diffuse.Alpha := 1; end; end; end else if T3DLineComponent(ChildNode.Data).FSCSCompon.ComponentType.SysName = ctsnTube then begin with TglCylinder(T3DLineComponent(ChildNode.Data).FGLObject).Material do begin BlendingMode := bmOpaque; BackProperties.Diffuse.Alpha := 1; FrontProperties.Diffuse.Alpha := 1; end; end; end; end; end; if ChildNode.Count > 0 then DropObjectsTransparency(ChildNode); end; isUserTransparency := False; end; begin if ScsModelTree.Selected <> nil then DropObjectsTransparency(ScsModelTree.Selected); end; end.