unit Form3d; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, 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, Math, cxGroupBox, U_Cad, U_SCSLists, RzTabs, U_ESCadClasess, PowerCad; const // Koeff Cam Move kmPerspective = 0.1; //04.01.2012 в некоторых местах было 0.132 и 0.12 kmOrthogonel = 0.003; //04.01.2012 0.03; type TPropViewType = (pvtNone, pvtSingleSide, pvtMultiSides, pvtSingle3ds, pvtMulti3ds, pvtSingleConn, pvtMultiConn, pvtSingleLine, pvtMultiLine); TToolMode = (tmSelect, tmCut); TLineOrder = (loNone, loHorz, loVert, loRaise); TCoord = (cX, cY, cZ); TCutData = class(TMyObject) Index11: Integer; Index12: Integer; Index21: Integer; Index22: Integer; end; TResizeData = class(TMyObject) 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; end; TVector3fArr = array of TVector3f; Tfrm3D = class(TForm) GLScene: TGLScene; panMain: TPanel; GLCamera: TGLCamera; GLLightSource1: TGLLightSource; GLLightSource2: TGLLightSource; GLLightSource3: TGLLightSource; GLLightSource4: TGLLightSource; GLLightSource5: TGLLightSource; 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; GLLightFirstPerson: TGLLightSource; sbView: TPanel; Panel3: TPanel; SpeedButton4: TSpeedButton; 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); private { Private declarations } procedure Rotate3DSObj(aObject: TGLFreeForm; aX, aY, aZ: Double); procedure RotateConnModel(aObject: TGLFreeForm; aX, aY, aZ: Double); procedure DeselectGLObjectsT; public { Public declarations } 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); 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 GLNodesTo3DCoords(aNodes: TGLNodes; aYAsZ: Boolean=false): T3DPointArray; {$IF Defined(ES_GRAPH_SC)} Procedure ChangeAllFiguresWithPoint(aPoint:T3DPoint; Coord: TCoord); Procedure ChangeAllFiguresConnectedToModifyLine(aLine: TGLLines); {$IFEND} 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; implementation uses U_BaseConstants, U_Constants, U_BaseCommon, U_Common, U_SCSComponent, u_main, PCDrawBox, U_ProtectionCommon, fplan, USCS_Main, U_ArchCommon; {$R *.dfm} // // 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; begin mx := x; my := y; mdx := x; mdy := y; if GLSceneViewer.Camera = FirstPersonCamera then exit; Obj := GlsceneViewer.Buffer.GetPickedobject(X, Y); if 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 FMovedObject := TGLFreeForm(Obj); 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; end; end else if 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; 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); 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); var i, pCnt, pCntNormal, j, k, FigureID: 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, pP: TVector3f; //Alex(22.12.2010) xRoom: T3DRoom; RoomMin, RoomMax, RoomSize, SetPos, Scale: T3DPoint; //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;} begin try TimerOnSelectNodes.OnTimer := nil; FaceList := Faces; IsRoof := false; {$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 IsAperture := false; Face := TFaceRecord(faces[i]); //типо перегоняем запись листа в кекорд xNode := Face.FTreeNode; xConn := T3DConnector(Face.F3DObject); //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; 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; 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; 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; 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); 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 if Face.RecType in [ftPolyGon,ftLine,ftPipe,ftBar,ftSphere] 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 = ftSphere then begin glSphere.Position.X := p.x * factor; glSphere.Position.Y := p.y * factor; glSphere.Position.Z := p.z * factor; end else if Face.RecType = ftCenterCube then begin glCenter.Position.X := p.x * factor; glCenter.Position.Y := p.y * factor; glCenter.Position.Z := p.z * 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; glPipe.AddNode(p.x, p.y, p.z); if xConn <> nil then xConn.FGLPoint := p; end; 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 = ftPipe then begin 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); SCSCatalog := F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(FCAD.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; end; 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 := 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 {!!!} 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); SCSCatalog := F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(FCAD.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; // 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 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]; //Задаем точки для отрисовки полигона///////////////////////////////////////////////////////// for k := 0 to pCnt - 1 do // begin // p := Face.Points[k]; // //p := DoublePoint(p.x * factor, p.z * factor + FDeltaZ, p.y * factor); {TODO} // OK // p := DoublePoint(p.x * factor, p.z * factor + FDeltaZFloor, p.y * factor); {TODO} // OK // glFloor.AddNode(p.x, p.y, p.z); // xSide.FGLPoints[k] := p; // 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 //тут может быть ошибочка,потому, что в одной прорисовке не правильно берет координаты 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} //Добавление точек построения плоскости потолка(крыши);////////////////////// for k := 0 to pCnt - 1 do // begin // p := Face.Points[k]; // 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; // end; // xSide.FZOrder := xSide.FZOrder + FDeltaZ; { for k := 0 to pCnt - 1 do begin p := Face.Points[k]; p := DoublePoint(p.x * factor, p.z * factor, p.y * factor + FDeltaZ); glCeiling.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; 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} 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; //// *********** 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 Not Defined(ES_GRAPH_SC)} try GLPlane1.Material.Texture.Image.LoadFromFile(GetPathToSCSTmpDir + '\3d.jpg'); except ShowMessage('File not found ' + GetPathToSCSTmpDir + '\3d.jpg'); 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; //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; 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 glCamera.CameraStyle := csPerspective; GLCamera.FocalLength := 160; GLSceneViewer.Camera := GLCamera; GLLightFirstPerson.Shining := False; Light.Shining := True; lbViewType.Caption := cForm3D_Mes3; end; procedure Tfrm3D.SpeedButton2Click(Sender: TObject); begin glCamera.CameraStyle := csOrthogonal; GLCamera.FocalLength := 1.7; GLSceneViewer.Camera := GLCamera; GLLightFirstPerson.Shining := False; Light.Shining := True; 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); begin {$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; end; procedure Tfrm3D.GLHeightField1GetHeight(const x, y: Single; var z: Single; var color: TVector4f; var texPoint: TTexPoint); begin z := 0; 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 {*** 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 {*** 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; // 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 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; 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; xScsNode := ScsModelTree.Items.AddChild(xListNode, xConn.FName); xScsNode.Data := xConn; xScsNode.ImageIndex := 3; xScsNode.SelectedIndex := xScsNode.ImageIndex; xConn.FFace.FTreeNode := xScsNode; 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; 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 := GlsceneViewer.Buffer.GetPickedobject(mx, my); if Obj <> nil then begin if (Obj is TGLPolygon) or (Obj is TGLFreeForm) or (Obj is TGLPipe) or (Obj is TGLLines) 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; if (xObject is T3DConnector) or (xObject is T3DLine) then begin xTree := ScsModelTree; pcTree.ActivePage := TabScsModel; pcProps.ActivePage := TabScsProps; end; 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; 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; 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; {$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 except on E: Exception do AddExceptionToLogEx('Tfrm3D.OnSelectNodes', E.Message); end; end; procedure Tfrm3D.FormCreate(Sender: TObject); //var // xModelNode: TTreeNode; begin 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; {xModelNode := ScsModelTree.Items.GetFirstNode; if xModelNode <> nil then xModelNode.Text := cForm3D_Mes9; xModelNode := ModelTree.Items.GetFirstNode; if xModelNode <> nil then xModelNode.Text := cForm3D_Mes9;} end; function Tfrm3D.FindGLObjectsByNodes(aNodes: TList): TList; var i,j: integer; xObj: TGLBaseSceneObject; xNode: TTreeNode; xNodes: TList; xCorner: T3DCorner; xWall: T3DWall; 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); if (TObject(xNode.Data) is T3DSObject) then xObj := TGLBaseSceneObject(T3DSObject(xNode.Data).FGLObject); if (TObject(xNode.Data) is T3DConnector) then xObj := TGLBaseSceneObject(T3DConnector(xNode.Data).FGLObject); if (TObject(xNode.Data) is T3DLine) then xObj := TGLBaseSceneObject(T3DLine(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} Result.Add(xObj); //И добавляем эти объекты в лист end; 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,iWalls,iModelCnt, iobj: integer; xObj: TGLBaseSceneObject; xConn, JoinConn1, JoinConn2: T3DConnector; xLine: T3DLine; xWall{,hWall}: T3DWall; xNode{,hNode}: TTreeNode; // WallList,xWNodes, xObject: TList; 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 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); if (TObject(xNode.Data)) is T3DLine then begin xLine := T3DLine(TTreeNode(xObj.TagObject).Data); TGLLines(xObj).LineColor.AsWinColor := clYellow; 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 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: integer; xObj: TGLBaseSceneObject; xConn, JoinConn1, JoinConn2: T3DConnector; xLine: T3DLine; xWall: T3DWall; 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; 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; 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; 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 FPropObjects := aObjects; 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 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 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 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 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 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 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 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]); 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 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 if FSelection <> nil then FreeAndNil(FSelection); if FPropObjects <> nil then FreeAndNil(FPropObjects); if FxObjects <> nil then FreeAndNil(FxObjects); if FNodes <> nil then FreeAndNil(FNodes); // Это нужно обязательно - иначе на некоторых дровах видео - выпадет // 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 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; 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; begin try 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; 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; 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 FirstPersonCamera.FocalLength := 100; //160; DeselectGLObjects; GLSceneViewer.SetFocus; GLSceneViewer.Camera := FirstPersonCamera; GLLightFirstPerson.Shining := True; Light.Shining := False; lbViewType.Caption := cForm3D_Mes5; 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.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 := 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]; 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, 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, 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, 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, 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; 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 := 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; begin try if ModelTree.SelectionCount = 1 then begin xNode := ModelTree.Selections[0]; Open3DObject.InitialDir := ExeDir + '\3DModels'; NoMoveEvent := True; 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; 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; Rotate3DSObj(TGLFreeForm(gLObject), 0, 0, -45); end; 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 (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; end; procedure Tfrm3D.ChangeAngleX; var i: integer; xObject: TObject; x3dsObject: T3DSObject; xConn: T3DConnector; xGLObject, xGLObject1: TGLBaseSceneObject; 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; if xObject is 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; 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; 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; if xObject is 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; 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; 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; if xObject is T3DConnector then begin xConn := T3DConnector(xObject); 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; 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; 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 try if 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 Button = mbLeft then begin FResizer := False; RStartPos1 := rpos1; RStartPos2 := rpos2; SetSidesData; end; // при нажатии правой во время ресайзинга - сброс if 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 := MessageBox(self.Handle, PAnsiChar(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 Self.UpdateModelTreeFromStream(AFaces); Self.UpdateScsModelTreeFromStream(AFaces); 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 := GlsceneViewer.Buffer.GetPickedobject(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; 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; OnSelectNodes(SelNodes); 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; OnSelectNodes(SelNodes); 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; begin try textfname := textureFileName; tmpdir := GetWorkDir; 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 src_3ds_dir := ExtractFilePath(Open3DObject.FileName); 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; fname := src_3ds_dir + textureFileName; if FileExists(fname) then begin textureFileName := textfname; // tmpdir := GetWorkDir; // ExtractDirByCategoryType(dctPictures); // получаем HASH по загружаемому файлу 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 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; begin { if (Button = mbRight) then begin if ScsModelTree.SelectionCount = 1 then begin xNode := ScsModelTree.Selections[0]; 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; 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); 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: 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; 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 := GlsceneViewer.Buffer.GetPickedobject(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; procedure Tfrm3D.Move3DConnectorEvent(aObj: TGLBaseSceneObject); var xConn: T3DConnector; dp: T3DPoint; xGLCaption: TGLSpaceText; xGLObject: TGLPipe; begin try // 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 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; Move3DConnector(xConn, dp, true); FMovedObjectsList.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 LoadPropertiesForSingleLine(ScsModelTree.Selected); end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.Move3DConnector', E.Message); end; end; procedure Tfrm3D.Move3DLineEvent(aObj: TGLBaseSceneObject); var xLine: T3DLine; xGLLine: TGLLines; cp, dp1, dp2: T3DPoint; xGLCaption: TGLSpaceText; JoinConn1, JoinConn2: T3DConnector; begin try xGLLine := TGLLines(aObj); if TObject(TTreeNode(aObj.tagObject).Data) is T3DLine then begin xLine := T3DLine(TTreeNode(aObj.tagObject).Data); 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; 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]); if xLine.FJoinConnector1 <> nil then Move3DConnector(JoinConn1, dp1); if xLine.FJoinConnector2 <> nil then Move3DConnector(JoinConn2, dp2); 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; procedure Tfrm3D.ApplyScsModel; var i, j, k: integer; dp: T3DPoint; xConn: T3DConnector; xLine, xAddLine: T3DLine; xScsConn, xGetScsConn: TConnectorObject; xScsLine, xScsAddLine: TOrthoLine; xCadForm: TF_CAD; begin try BeginProgress('Идет применение СКС модели ...'); // 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]); xScsConn := xConn.FSCSObject; // 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; // 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; // 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; 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; // 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 on E: Exception do AddExceptionToLogEx('Tfrm3D.ApplyScsModel', E.Message); end; //UpdateAllTracesLengthAndRefreshTextBoxOnAllLists; GMoveWithRaise := True; 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; 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; xGLObject1: TGLFreeForm; begin try if (dp.x = 0) and (dp.y = 0) and (dp.z = 0) then exit; xConn := aObj; if IsConnectorMoved(xConn) then exit; // object already moved! xGLObject := TGLPipe(xConn.FGLObject); 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; 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; 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; 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; 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 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; // 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]); pos.x := xGLObject.Nodes[0].X; pos.y := xGLObject.Nodes[0].Y; pos.z := xGLObject.Nodes[0].Z; Move3DLine(xGetConn, xLine, pos); 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; begin try xConn := aObj; xLine := aLine; xGLLine := TGLLines(xLine.FGLObject); if xConn = xLine.FJoinConnector1 then begin xGLLine.Nodes[0].X := aPos.x; 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; 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; except on E: Exception do AddExceptionToLogEx('Tfrm3D.Move3DLine', E.Message); end; 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; 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.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.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; procedure Tfrm3D.FormKeyPress(Sender: TObject; var Key: Char); begin if Ord(key) = 27 then Close; end; procedure Tfrm3D.SpeedButton4Click(Sender: TObject); begin Close; end; end.