unit Form3d; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Keyboard, Dialogs, GLScene, GLObjects, GLWin32Viewer, GLMisc, GLTexture, 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, ComCtrls, ImgList, cxControls, cxContainer, cxEdit, cxTextEdit, cxMemo, cxMaskEdit, RzCmboBx, cxLookAndFeelPainters, cxButtons, cxImage, RzButton, RzRadChk, cxDropDownEdit, ExtDlgs, GLCadencer, glFPSMovement, GLNavigator, Menus, GeometryBB, Math; type TPropViewType = (pvtNone, pvtSingleSide, pvtMultiSides, pvtSingle3ds, pvtMulti3ds); TToolMode = (tmSelect, tmCut); TCutData = class(TMyObject) Index11: Integer; Index12: Integer; Index21: Integer; Index22: Integer; end; TResizeData = class(TMyObject) 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; Tfrm3D = class(TForm) GLScene: TGLScene; panMain: TPanel; GLCamera: TGLCamera; GLCameraFirstPerson: 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; panProps: TPanel; panTree: TPanel; ModelTree: TTreeView; Panel1: TPanel; panTexture: TPanel; panName: TPanel; panDesc: TPanel; panCoords: TPanel; panRotate: TPanel; panMirror: TPanel; Label2: TLabel; Label3: TLabel; Label4: TLabel; Label5: TLabel; Label6: TLabel; Label7: TLabel; edName: TcxTextEdit; mDesc: TcxMemo; Label8: TLabel; edCoordX: TcxMaskEdit; Label9: TLabel; edCoordY: TcxMaskEdit; Label10: TLabel; Label11: TLabel; edCoordZ: TcxMaskEdit; imgTexture: TcxImage; bTextureChange: TcxButton; bTextureClear: TcxButton; cbMirror: TRzCheckBox; edRotate: TcxMaskEdit; Label37: TLabel; cbCoordNbr: TcxComboBox; OpenTexture: TOpenPictureDialog; sbFirstFace: TSpeedButton; MainCenter: TGLDummyCube; GLCadencer: TGLCadencer; cbHashs: TcxComboBox; Label1: TLabel; pmModelTree: TPopupMenu; nAdd3DObject: TMenuItem; Open3DObject: TOpenDialog; 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; edAngleX: TcxMaskEdit; edAngleY: TcxMaskEdit; edAngleZ: TcxMaskEdit; panScale3ds: TPanel; Label20: TLabel; Label21: TLabel; Label22: TLabel; Label23: TLabel; edScaleX: TcxMaskEdit; edScaleY: TcxMaskEdit; edScaleZ: TcxMaskEdit; Label24: TLabel; Label25: TLabel; Label26: TLabel; pmCut: TPopupMenu; sbSaveModel: TSpeedButton; nDeleteAllSubSides: TMenuItem; procedure GLSceneViewerMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure GLSceneViewerMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure SpeedButton1Click(Sender: TObject); procedure SpeedButton2Click(Sender: TObject); procedure FormShow(Sender: TObject); procedure GLHeightField1GetHeight(const x, y: Single; var z: Single; var color: TVector4f; var texPoint: TTexPoint); procedure FormMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); procedure SpeedButton3Click(Sender: TObject); procedure cbViewCeilingClick(Sender: TObject); procedure GLSceneViewerDblClick(Sender: TObject); procedure ModelTreeClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure cbCoordNbrCloseUp(Sender: TObject); procedure bTextureClearClick(Sender: TObject); procedure cbMirrorClick(Sender: TObject); procedure mDescEnter(Sender: TObject); procedure sbFirstFaceClick(Sender: TObject); procedure bTextureChangeClick(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 edRotateExit(Sender: TObject); procedure edCoordYKeyPress(Sender: TObject; var Key: Char); procedure edCoordZKeyPress(Sender: TObject; var Key: Char); procedure edRotateKeyPress(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); private { Private declarations } public { Public declarations } Factor: Single; RStartPos1, RStartPos2: T3DPoint; FToolMode: TToolMode; FNodesObjectsList: TList; FCutDataList: TList; FResizeData: TResizeData; FResizer: Boolean; FMovedObject: TGLFreeForm; F3DModel: T3DModel; F3DStreamModel: T3DModel; FSelection: TList; FPropObjects: TList; FPropRecord: TPropRecord; mx, my : Integer; mdx, mdy : Integer; FaceList: TList; CPoint: T3DPoint; OPoint: T3DPoint; Camera: T3DPoint; FFileStream: String; Procedure UpdateFaces(Faces: TList; Yh: Double = 0); procedure UpdateModelTree; procedure UpdateModelTreeFromStream(Faces: TList); function CopySideProperties(aSide, aStrSide: T3DSide): T3DSide; function CopySubSideProperties(aStrSubSide: T3DSide): T3DSide; function CopyObjectProperties(aObject, aStrObject: T3DSObject): T3DSObject; 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 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); // Properties function LoadPropertiesForSingleObject(aObject: TTreeNode): TPropRecord; function LoadPropertiesForMultiObjects(aObjects: TList): TPropRecord; function LoadPropertiesForSingle3ds(aObject: TTreeNode): TPropRecord; function LoadPropertiesForMulti3ds(aObjects: TList): TPropRecord; procedure ChangeName; procedure ChangeDesc; procedure ChangeCoordX; procedure ChangeCoordY; procedure ChangeCoordZ; procedure ChangeRotate; procedure ChangePosX; procedure ChangePosY; procedure ChangePosZ; procedure ChangeAngleX; procedure ChangeAngleY; procedure ChangeAngleZ; procedure ChangeScaleX; procedure ChangeScaleY; procedure ChangeScaleZ; procedure Set3DSObjectPos(aGLObject: TGLFreeForm); // ************************** 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; 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=''); procedure LoadModelFromStream(const AFile: String=''); procedure GetModelData(Stream: TStream); procedure SetModelData(Stream: TStream); function GetModelObjectByComponID(aComponID: Integer): TObject; function GetSimilarSide(aSide: T3DSide; aObject: TObject): T3DSide; function CmpSides(aSide1, aSide2: T3DSide): Boolean; end; var frm3D: Tfrm3D; glSide11, glSide21, glSide12, glSide22: TGLSpaceText; glSpliter: TGLLines; glCubeSpliter: TGLCube; glCursorObject: TGLCustomSceneObject; rpos1, rpos2: T3DPoint; ModelObjectsList: TList; NoMoveEvent: Boolean = False; SelObjColor, ObjColor: Tvector4f; implementation uses U_ESCadClasess, U_BaseConstants, U_Constants, U_BaseCommon, U_Common, U_SCSComponent, u_main, PCDrawBox, U_ProtectionCommon, fplan, USCS_Main; {$R *.dfm} // // Classic mouse movement bits // procedure Tfrm3D.GLSceneViewerMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var Obj: TGLBaseSceneObject; begin mx := x; my := y; mdx := x; mdy := 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; end; if FToolMode = tmSelect then begin Obj := GlsceneViewer.Buffer.GetPickedobject(X, Y); if (Obj <> nil) and (Obj is TGLFreeForm) then if (FSelection.Count = 1) and (TGLBaseSceneObject(FSelection[0]) = Obj) then FMovedObject := TGLFreeForm(Obj); end; end; end; procedure Tfrm3D.GLSceneViewerMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); var dx, dy : Integer; v : TVector; mp: TPoint; ip : TVector; tileX, tileY : Integer; shiftDown : Boolean; mip, translateOffset : TVector; translating : Boolean; koefcam: single; //vx,vz: single; spd: single; dw,dh: integer; xObj: TGLBaseSceneObject; VX, VY: TVector; Camera: TGLCamera; 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; Camera := GLSceneViewer.Camera; // SELECT MODE //if FToolMode = tmSelect then if not FResizer then begin if ssLeft in Shift then begin if FMovedObject <> nil then begin GLSceneViewer.Cursor := crHandPoint; VY := VectorMake(VectorPerpendicular(YVector, VectorNormalize(Camera.Position.AsAffineVector))); VX := VectorCrossProduct(VY, VectorNormalize(Camera.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 else begin if GLSceneViewer.Camera = GLCamera then begin GLSceneViewer.Camera.MoveAroundTarget(my - y, mx - x); end 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 if Shift = [ssRight] then 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); GLSceneViewer.Camera.TransformationChanged; 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 = glSpliter) or (xObj = glCubeSpliter) then GLSceneViewer.Cursor := crSizeAll else GLSceneViewer.Cursor := crDefault; end; end else // Движение ресайзинга begin VY := VectorMake(VectorPerpendicular(YVector, VectorNormalize(Camera.Position.AsAffineVector))); VX := VectorCrossProduct(VY, VectorNormalize(Camera.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,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; tx,ty,tz,bx,by,bz,cx,cy,cz: Double; glObject: TGLBaseSceneObject; glObjClass: TGLSceneObjectClass; glObject1: TGLBaseSceneObject; glObjClass1: TGLSceneObjectClass; SCSCatalog: TSCSCatalog; xoffset, aScaleModel: single; aColorModel: TVector4f; glWallSide, glFloor, glCeiling, glDoorSide, glWindowSide, glBalconDoorSide, glBalconWindowSide: TGLPolygon; gl3DSObject: TGLFreeForm; aColor: TVector4f; tmpdir, ImgName: string; WallCoords: array [0..5] of TVector3f; FloorCoords: array of TVector3f; BegCoordIndex: integer; xNode: TTreeNode; xSide: T3DSide; xObject: T3DSObject; Angle1, Angle2, ResAng: Double; dp1, dp2: TDoublePoint; pN, pP: TVector3f; begin try FaceList := Faces; Factor := 0.15; tmpdir := ExtractDirByCategoryType(dctPictures); for i := 0 to DummyCube.Count - 1 do begin if not (DummyCube.Children[i] is TGLCamera) then DummyCube.Children[i].DeleteChildren; end; TransCube.DeleteChildren; LoadModelFromStream(FFileStream); if F3DStreamModel = nil then UpdateModelTree else UpdateModelTreeFromStream(Faces); //// *********** FACES.COUNT ************************************************* for i := 0 to Faces.Count - 1 do begin Face := TFaceRecord(faces[i]); xNode := Face.FTreeNode; xSide := nil; xObject := nil; 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); end else begin glObject := DummyCube.AddNewChild(glObjClass); end; glObject.TagObject := xNode; if xNode <> nil then begin if Face.RecType = ftNet3DSObject then begin xObject := T3DSObject(xNode.Data); xObject.FGLObject := glObject; end else begin xSide := T3DSide(xNode.Data); xSide.FGLObject := glObject; 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; 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 glLine.AddNode(p.x * factor, p.y * factor, p.z * factor); 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 glPipe.AddNode(p.x * factor, p.y * factor, p.z * factor); 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); 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; end; if Face.RecType = ftPipe then begin 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); 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 = ctsnCableChannelElement then begin aScaleModel := 0.02; aColorModel := clrBlue; end; end; end; {!!!} if TConnectorObject(Face.FFigure).Name <> cCadClasses_Mes24 then begin glObjClass1 := TGLSpaceText; p := Face.Points[0]; p := DoublePoint(p.x,p.z,p.y); glObject1 := DummyCube.AddNewChild(glObjClass1); TGLSpaceText(glObject1).Text := TConnectorObject(Face.FFigure).Name + inttostr(TConnectorObject(Face.FFigure).FIndex); TGLSpaceText(glObject1).Position.x := (p.x + xoffset)*factor; TGLSpaceText(glObject1).Position.z := p.z*factor; TGLSpaceText(glObject1).Position.y := p.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; end; {!!!} glObjClass1 := TGLFreeForm; glObject1 := DummyCube.AddNewChild(glObjClass1); try {$IF Defined(ES_GRAPH_SC)} TGLFreeForm(glObject1).LoadFromFile(ExeDir + '\3DModels\RM.3ds'); {$else} TGLFreeForm(glObject1).LoadFromFile('Map.3ds'); {$IFEND} except end; TGLFreeForm(glObject1).Position.x := p.x*factor; TGLFreeForm(glObject1).Position.z := p.z*factor; TGLFreeForm(glObject1).Position.y := p.y*factor; TGLFreeForm(glObject1).Scale.X := aScaleModel; TGLFreeForm(glObject1).Scale.Y := aScaleModel; TGLFreeForm(glObject1).Scale.Z := aScaleModel; TGLFreeForm(glObject1).Material.FrontProperties.Diffuse.Color := aColorModel; TGLFreeForm(glObject1).Material.BackProperties.Diffuse.Color := aColorModel; TGLFreeForm(glObject1).BuildOctree; {!!!} end else begin FigureID := TConnectorObject(Face.FFigure).ID; SCSCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.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; glObject1 := DummyCube.AddNewChild(glObjClass1); try {$IF Defined(ES_GRAPH_SC)} TGLFreeForm(glObject1).LoadFromFile(ExeDir + '\3DModels\RM.3ds'); {$else} TGLFreeForm(glObject1).LoadFromFile('Map.3ds'); {$IFEND} except end; TGLFreeForm(glObject1).Position.x := p.x*factor; TGLFreeForm(glObject1).Position.z := p.z*factor; TGLFreeForm(glObject1).Position.y := p.y*factor; TGLFreeForm(glObject1).Scale.X := aScaleModel; TGLFreeForm(glObject1).Scale.Y := aScaleModel; TGLFreeForm(glObject1).Scale.Z := aScaleModel; TGLFreeForm(glObject1).Material.FrontProperties.Diffuse.Color := aColorModel; TGLFreeForm(glObject1).Material.BackProperties.Diffuse.Color := aColorModel; TGLFreeForm(glObject1).BuildOctree; end; end; end; end; end; // with TGLSceneObject(glObject).Material do begin BackProperties.Ambient.AsWinColor:= Face.Color; BackProperties.Diffuse.AsWinColor := Face.Color; BackProperties.Emission.AsWinColor := Face.Color; FrontProperties.Ambient.AsWinColor := Face.Color; FrontProperties.Diffuse.AsWinColor := Face.Color; FrontProperties.Emission.AsWinColor := Face.Color; if TConnectorObject(Face.FFigure).Name = 'Anchor' then begin BackProperties.Ambient.AsWinColor:= clNone; BackProperties.Diffuse.AsWinColor := clNone; BackProperties.Emission.AsWinColor := clNone; FrontProperties.Ambient.AsWinColor := clNone; FrontProperties.Diffuse.AsWinColor := clNone; FrontProperties.Emission.AsWinColor := clNone; end; end; end; end; if Face.RecType = ftLine then begin glLine.NodeSize := 0; glLine.ShowAxes := False; if TOrthoLine(Face.FFigure).FLineType = ts_ClearTrace then gLLine.LineWidth := 1 else gLLine.LineWidth := 4; glLine.AntiAliased := True; glLine.NodesAspect := lnaInvisible; glLine.LineColor.AsWinColor := Face.Color; //clred; end else if Face.RecType = ftPolyGon then begin //glPoly.Smooth := True; glPoly.Parts := [ppTop,ppBottom]; end; {TODO} 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} // ********************** 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); 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 Texture.Image.LoadFromFile(ImgName); end else begin 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'); end; end; RotateTextureToAngleP(xSide, GLWallSide, xSide.FRotate, 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} (* 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; } SetLength(FloorCoords, pCnt); for k := 0 to pCnt - 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 >= 3 then begin for k := 0 to pCnt - 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 - 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 - 1 do begin p := Face.Points[k]; p := DoublePoint(p.x * factor, p.z * factor + FDeltaZ, p.y * factor); glFloor.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 Texture.Image.LoadFromFile(ImgName); end else begin Texture.Image.LoadFromFile(ExeDir + '\3DTextures\floor.bmp'); end; end; RotateTextureToAngleP(xSide, GLFloor, xSide.FRotate, xSide.FMirror); end; // ********************** NETFLOOR ***************************************** // ********************** NETCEILING *************************************** {TODO} (* 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; } SetLength(FloorCoords, pCnt); for k := 0 to pCnt - 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 >= 3 then begin for k := 0 to pCnt - 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 - 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 - 1 do begin p := Face.Points[k]; p := DoublePoint(p.x * factor, p.z * factor + FDeltaZ, p.y * factor); glCeiling.AddNode(p.x, p.y, p.z); xSide.FGLPoints[k] := p; end; { 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 Texture.Image.LoadFromFile(ImgName); end else begin Texture.Image.LoadFromFile(ExeDir + '\3DTextures\ceiling.bmp'); end; end; RotateTextureToAngleP(xSide, GLCeiling, xSide.FRotate, xSide.FMirror); end; // ********************** NETCEILING *************************************** // ********************** NET3DSObject ************************************* if Face.RecType = ftNet3DSObject then begin gl3DSObject.Material.Texture.Disabled := False; gl3DSObject.LoadFromFile(xObject.FPath); 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; gl3DSObject.PitchAngle := xObject.FRotate.x; gl3DSObject.TurnAngle := xObject.FRotate.y; gl3DSObject.RollAngle := xObject.FRotate.z; with gl3DSObject.Material do 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; //MaterialOptions := [moNoLighting]; end; gl3DSObject.BuildOctree; 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 glPipe.Radius := Face.Size; 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; end; //// *********** FACES.COUNT ************************************************* //GCadForm.FActiveNet; 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)} GLPlane1.Material.Texture.Image.LoadFromFile(GetPathToSCSTmpDir + '\3d.jpg'); {$ELSE} GLPlane1.Position.y := GLPlane1.Position.y - FDeltaZPlane; {$IFEND} GLPlane1.Scale.Y := GCadForm.PCad.WorkHeight * factor; GLPlane1.Scale.X := GCadForm.PCad.WorkWidth * factor; GLCameraFirstPerson.Position.x := cx; GLCameraFirstPerson.Position.y := cy; GLCameraFirstPerson.Position.z := 40; // Камера в перспективный вид glCamera.CameraStyle := csPerspective; GLCamera.FocalLength := 160; 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; lbViewType.Caption := cForm3D_Mes3; end; procedure Tfrm3D.SpeedButton2Click(Sender: TObject); begin glCamera.CameraStyle := csOrthogonal; GLCamera.FocalLength := 1.7; GLSceneViewer.Camera := GLCamera; lbViewType.Caption := cForm3D_Mes4; end; (* procedure Tfrm3D.cmbCenterClick(Sender: TObject); var xObject:TObject; begin if CmbCenter.ItemIndex = -1 then exit; xObject := CmbCenter.Items.Objects[cmbCenter.ItemIndex]; if not assigned(xObject) then exit; //GLCamera1.TargetObject := TGLDummyCube(xObject); end; *) procedure Tfrm3D.FormShow(Sender: TObject); begin // UpdateModelTree; cbViewCeiling.Checked := True; {$IF Not Defined(ES_GRAPH_SC)} cbViewCeiling.Visible := False; sbSaveModel.Visible := False; panObjects.Visible := False; Splitter1.Visible := False; {$IFEND} SetAllPanels(False); 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 s: Single; shiftDown : Boolean; ctrlDown : Boolean; i: integer; Res1: TWinControl; Pt: TPoint; begin 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 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 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; end; end; end else 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; procedure Tfrm3D.SpeedButton3Click(Sender: TObject); var Save3D: TSaveDialog; Jpeg: TJPEGImage; Bmp: TBitmap; BmpFileName: string; bmpx, bmpy: Integer; begin try if GLSceneViewer.Camera.CameraStyle = csPerspective then begin ShowMessage(cForm3D_Mes2); Exit; end; 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; 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 T3dSide(xNode.Data).FFaceType = ftNetCeiling then DummyCube.Children[i].Visible := cbViewCeiling.Checked; if T3dSide(xNode.Data).FFaceType = ftNetFloor then DummyCube.Children[i].Visible := cbViewCeiling.Checked; end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.cbViewCeilingClick', E.Message); end; 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: integer; xModelNode, xRoomNode, xCeilingNode, xFloorNode, xWallNode, xWallElementNode, xBalconElementNode, xSlopeNode, xSideNode, xNode: TTreeNode; xRoom: T3DRoom; xWall: T3DWall; xWallElement: T3DWallElement; xBalconElement: T3DBalconElement; xSlope: T3DSlope; xSide: T3DSide; begin try ModelTree.Items.Clear; xModelNode := ModelTree.Items.AddFirst(nil, F3DModel.FName); xModelNode.Data := F3DModel; xModelNode.HasChildren := True; // распарсить комнаты for i := 0 to F3DModel.FRooms.Count - 1 do begin xRoom := T3DRoom(F3DModel.FRooms[i]); xRoomNode:= ModelTree.Items.AddChild(xModelNode, xRoom.FName); xRoomNode.Data := xRoom; xRoomNode.ImageIndex := 47; // добавить потолок в комнаты xSide := xRoom.FCeiling; xNode := ModelTree.Items.AddChild(xRoomNode, xSide.FName); xNode.Data := xSide; xNode.ImageIndex := 56; xSide.FFace.FTreeNode := xNode; // добавить пол в комнату xSide := xRoom.FFloor; xNode := ModelTree.Items.AddChild(xRoomNode, xSide.FName); xNode.Data := xSide; xNode.ImageIndex := 56; xSide.FFace.FTreeNode := xNode; // распарсить стены каждой комнаты 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; // распарсить элементы каждой стены 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; // добавить откосы 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; // добавть грани откоса 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; 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; // добавить откосы 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; // добавть грани откоса 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; 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; // добавить откосы 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; // добавть грани откоса 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; 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; end; if xBalconElement.FElementType = dotWindow then begin xBalconElementNode := ModelTree.Items.AddChild(xWallElementNode, xBalconElement.FName); xBalconElementNode.ImageIndex := 52; 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; 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; end; // арка if xWallElement.FElementType = dotArc then begin xWallElementNode:= ModelTree.Items.AddChild(xWallNode, xWallElement.FName); xWallElementNode.Data := xWallElement; xWallElementNode.ImageIndex := 54; 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; 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; xSide.FFace.FTreeNode := xNode; end; end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.UpdateModelTree', E.Message); end; end; procedure Tfrm3D.UpdateModelTreeFromStream(Faces: TList); var i, j, k, ii, jj, kk, iadd: integer; xModelNode, xRoomNode, xCeilingNode, xFloorNode, xWallNode, xWallElementNode, xBalconElementNode, xSlopeNode, xSideNode, x3DSNode, xNode, xSubNode: TTreeNode; xRoom, xStrRoom: T3DRoom; xWall, xStrWall: T3DWall; xWallElement, xStrWallElement: T3DWallElement; xBalconElement, xStrBalconElement: T3DBalconElement; xSlope, xStrSlope: T3DSlope; xSide, xStrSide, xAddSide, xSubSide, xStrSubSide: T3DSide; xObject, xStrObject: T3DSObject; begin try ModelTree.Items.Clear; xModelNode := ModelTree.Items.AddFirst(nil, F3DModel.FName); xModelNode.Data := F3DModel; xModelNode.HasChildren := True; CopyModelHash; // распарсить комнаты for i := 0 to F3DModel.FRooms.Count - 1 do begin xRoom := T3DRoom(F3DModel.FRooms[i]); xStrRoom := T3DRoom(getModelObjectByComponID(xRoom.FSCSComponID)); xRoomNode:= ModelTree.Items.AddChild(xModelNode, xRoom.FName); xRoomNode.Data := xRoom; xRoomNode.ImageIndex := 47; // добавить потолок в комнату xSide := xRoom.FCeiling; xStrSide := GetSimilarSide(xSide, xStrRoom); xNode := ModelTree.Items.AddChild(xRoomNode, xSide.FName); xNode.Data := xSide; xNode.ImageIndex := 56; 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; xSubSide.FFace.FTreeNode := xSubNode; Faces.Add(xSubSide.FFace); xSubSide.FParent := xSide; xSide.FSubSides.Add(xSubSide); end; end; end; // добавить пол в комнату xSide := xRoom.FFloor; xStrSide := GetSimilarSide(xSide, xStrRoom); xNode := ModelTree.Items.AddChild(xRoomNode, xSide.FName); xNode.Data := xSide; xNode.ImageIndex := 56; 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; xSubSide.FFace.FTreeNode := xSubNode; Faces.Add(xSubSide.FFace); xSubSide.FParent := xSide; xSide.FSubSides.Add(xSubSide); end; end; end; // добавить 3дс объекты // !!! Если не изменялись размеры или месторасположение комнаты if xStrSide <> nil then begin for j := 0 to xStrRoom.F3DSObjects.Count - 1 do begin xStrObject := T3DSObject(xStrRoom.F3DSObjects[j]); xObject := CopyObjectProperties(nil, xStrObject); xNode := ModelTree.Items.AddChild(xRoomNode, xObject.FName); xNode.Data := xObject; xNode.ImageIndex := 42; xObject.FFace.FTreeNode := xNode; Faces.Add(xObject.FFace); xObject.FParent := xRoom; xRoom.F3DSObjects.Add(xObject); 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; // распарсить элементы каждой стены 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; // добавить откосы 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; // добавть грани откоса 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; 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; 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; // добавить откосы 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; // добавть грани откоса 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; 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; 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; // добавить откосы 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; // добавть грани откоса 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; 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; 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; end; if xBalconElement.FElementType = dotWindow then begin xBalconElementNode := ModelTree.Items.AddChild(xWallElementNode, xBalconElement.FName); xBalconElementNode.ImageIndex := 52; 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; 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; 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; end; // арка if xWallElement.FElementType = dotArc then begin xWallElementNode:= ModelTree.Items.AddChild(xWallNode, xWallElement.FName); xWallElementNode.Data := xWallElement; xWallElementNode.ImageIndex := 54; 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; 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; 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; 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; xSubSide.FFace.FTreeNode := xSubNode; Faces.Add(xSubSide.FFace); xSubSide.FParent := xSide; xSide.FSubSides.Add(xSubSide); end; end; end; end; end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.UpdateModelTreeFromStream', 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 := aStrSide.FDescription; xSide.FFaceType := aStrSide.FFaceType; xSide.FWallType := aStrSide.FWallType; xSide.FSideType := aStrSide.FSideType; xSide.FColor := aStrSide.FColor; xSide.FRotate := aStrSide.FRotate; 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 := aStrSubSide.FDescription; xSide.FColor := aStrSubSide.FColor; xSide.FRotate := aStrSubSide.FRotate; 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 := aStrObject.FDescription; xObject.FPath := aStrObject.FPath; xObject.FPosition := aStrObject.FPosition; xObject.FScale := aStrObject.FScale; xObject.FRotate := aStrObject.FRotate; 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; procedure Tfrm3D.GLSceneViewerDblClick(Sender: TObject); var i, j: integer; Obj: TGLBaseSceneObject; Mesh: TGLMesh; Polygon: TGLPolygon; xNode: TTreeNode; xNodes: TList; begin try Obj := GlsceneViewer.Buffer.GetPickedobject(mx, my); if Obj <> nil then begin if (Obj is TGLPolygon) or (Obj is TGLFreeForm) then begin xNodes := TList.create; if (Obj.TagObject <> nil) then begin xNode := TTreeNode(Obj.TagObject); ModelTree.Select(xNode); xNodes.Add(xNode); OnSelectNodes(xNodes); end; end; end else begin 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; begin try if ModelTree.Selected <> nil then begin xNodes := TList.create; for i := 0 to ModelTree.SelectionCount - 1 do begin xNode := ModelTree.Selections[i]; xNodes.Add(xNode); 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); // Deselect objects DeselectGLObjects; // Select objects SelectGLObjects(xObjects); // Show Properties OnLoadProperties(aNodes); except on E: Exception do AddExceptionToLogEx('Tfrm3D.OnSelectNodes', E.Message); end; end; procedure Tfrm3D.FormCreate(Sender: TObject); begin FSelection := TList.Create; FPropObjects := TList.create; FPropRecord := TPropRecord.Create; {$IF Defined(ES_GRAPH_SC)} panProps.Height := 350; {$IFEND} FMovedObject := nil; SelObjColor := clrLightWood; ObjColor := clrDarkWood; FFileStream := ''; //13.12.2010 end; function Tfrm3D.FindGLObjectsByNodes(aNodes: TList): TList; var i: integer; xObj: TGLBaseSceneObject; xNode: TTreeNode; xNodes: TList; 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); Result.Add(xObj); end; except on E: Exception do AddExceptionToLogEx('', E.Message); end; end; procedure Tfrm3D.SelectGLObjects(aObjects: TList); var i: integer; xObj: TGLBaseSceneObject; begin try FSelection := aObjects; 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 BackProperties.Ambient.Color := SelObjColor; BackProperties.Diffuse.Color := SelObjColor; BackProperties.Emission.Color := SelObjColor; FrontProperties.Ambient.Color := SelObjColor; FrontProperties.Diffuse.Color := SelObjColor; FrontProperties.Emission.Color := SelObjColor; MaterialOptions := [moNoLighting]; end; end; end; except on E: Exception do AddExceptionToLogEx('', E.Message); end; end; procedure Tfrm3D.DeselectGLObjects; var i: integer; xObj: TGLBaseSceneObject; begin try 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 BackProperties.Ambient.Color := ObjColor; BackProperties.Diffuse.Color := ObjColor; BackProperties.Emission.Color := ObjColor; FrontProperties.Ambient.Color := ObjColor; FrontProperties.Diffuse.Color := ObjColor; FrontProperties.Emission.Color := ObjColor; MaterialOptions := []; end; end; end; FSelection.Clear; except on E: Exception do AddExceptionToLogEx('', E.Message); end; end; procedure Tfrm3D.OnLoadProperties(aObjects: TList); var i: integer; ViewType: TPropViewType; begin try ViewType := GetPropViewType(aObjects); if ViewType = pvtNone then begin FPropObjects.Clear; SetAllPanels(False); end else if ViewType = pvtSingleSide then begin FPropObjects := aObjects; SetAllPanels(False); panTexture.Visible := True; panMirror.Visible := True; panRotate.Visible := True; panCoords.Visible := True; panDesc.Visible := True; panName.Visible := True; LoadPropertiesForSingleObject(TTreeNode(FPropObjects[0])); end else if ViewType = pvtMultiSides then begin FPropObjects := aObjects; SetAllPanels(False); panTexture.Visible := True; panMirror.Visible := True; panRotate.Visible := True; panCoords.Visible := True; panDesc.Visible := True; LoadPropertiesForMultiObjects(FPropObjects); end else if ViewType = pvtSingle3ds then begin FPropObjects := aObjects; SetAllPanels(False); panScale3ds.Visible := True; panRotate3ds.Visible := True; panPos3ds.Visible := True; panDesc.Visible := True; panName.Visible := True; LoadPropertiesForSingle3ds(TTreeNode(FPropObjects[0])); end else if ViewType = pvtMulti3ds then begin FPropObjects := aObjects; SetAllPanels(False); panScale3ds.Visible := True; panRotate3ds.Visible := True; panPos3ds.Visible := True; panDesc.Visible := True; LoadPropertiesForMulti3ds(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: 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)) or (TObject(xNode.Data) is T3DSObject) then Result.Add(xNode) else 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); 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); end; function Tfrm3D.GetPropViewType(aNodes: TList): TPropViewType; var i: integer; xNode: TTreeNode; begin try Result := pvtNone; 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; end else begin //Result := pvtMultiSides; 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) then exit; if (TObject(xNode.Data) is T3DSide) then begin if Result = pvtMulti3ds then begin Result := pvtNone; exit; end; Result := pvtMultiSides; end; if (TObject(xNode.Data) is T3DSObject) then begin if Result = pvtMultiSides then begin Result := pvtNone; exit; end; Result := pvtMulti3ds; 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: Integer; xMirror: Boolean; xCnt: Integer; CoordsInfo: string; begin try mDesc.Clear; cbCoordNbr.Properties.Items.Clear; for i := 0 to aObjects.Count - 1 do begin xObject := T3DSide(TTreeNode(aObjects[i]).Data); xGLObject := TGLBaseSceneObject(xObject.FGLObject); if i = 0 then begin xRotate := xObject.FRotate; xMirror := xObject.FMirror; edRotate.Text := IntToStr(xObject.FRotate); cbMirror.Checked := xObject.FMirror; xCnt := Length(xObject.FGLPoints); end else begin if edRotate.Text <> '' then if xRotate <> xObject.FRotate then edRotate.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; 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; imgTexture.Clear; cbHashs.Properties.Items.Clear; for i := 0 to F3DModel.FHashs.Count - 1 do begin cbHashs.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]); edRotate.Text := IntToStr(xObject.FRotate); 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); imgTexture.Clear; tmpfname := GetImageFileByHash(xObject.FTextureHash); if tmpfname <> '' then imgTexture.Picture.LoadFromFile(tmpfname); cbHashs.Properties.Items.Clear; for i := 0 to F3DModel.FHashs.Count - 1 do begin cbHashs.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; 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); 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; 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.bTextureChangeClick(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 imgTexture.Picture.LoadFromFile(FName); ExtStr := ExtractFileExt(FName); tmpdir := 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.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 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.Image.LoadFromFile(tmpfname); RotateTextureToAngleP(xObject, TGLPolygon(xGLObject), xObject.FRotate, xObject.FMirror); end; end; // Resfresh HASHs cbHashs.Properties.Items.Clear; for i := 0 to F3DModel.FHashs.Count - 1 do begin cbHashs.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.bTextureClearClick(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 xObject := T3DSide(TTreeNode(FPropObjects[i]).Data); xGLObject := TGLBaseSceneObject(xObject.FGLObject); xObject.FTextureHash := ''; xObject.FTexture_ext := ''; if (xGLObject is TGLPolygon) then begin imgTexture.Clear; TGLPolygon(xGLObject).Material.Texture.Disabled := True; 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 xObject := T3DSide(TTreeNode(FPropObjects[i]).Data); xGLObject := TGLBaseSceneObject(xObject.FGLObject); xObject.FMirror := cbMirror.Checked; if (xGLObject is TGLPolygon) then RotateTextureToAngleP(xObject, TGLPolygon(xGLObject), xObject.FRotate, xObject.FMirror); 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.edRotateExit(Sender: TObject); begin ChangeRotate; end; procedure Tfrm3D.edRotateKeyPress(Sender: TObject; var Key: Char); begin if Key = #13 then ChangeRotate; end; procedure Tfrm3D.ChangeCoordX; var i: integer; xObject: T3DSide; xGLObject: TGLBaseSceneObject; Index: Integer; p: TVector3f; begin try if edCoordX.Text = '' then exit; Index := cbCoordNbr.ItemIndex; for i := 0 to FPropObjects.Count - 1 do begin 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; 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; begin try if edCoordY.Text = '' then exit; Index := cbCoordNbr.ItemIndex; for i := 0 to FPropObjects.Count - 1 do begin 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; 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; begin try if edCoordZ.Text = '' then exit; Index := cbCoordNbr.ItemIndex; for i := 0 to FPropObjects.Count - 1 do begin 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; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.ChangeCoordZ', E.Message); end; end; procedure Tfrm3D.ChangeDesc; var i, j: integer; xObject: T3DSide; xGLObject: TGLBaseSceneObject; begin try if (mDesc.Text = '') or (mDesc.Lines.Count = 0) then exit; for i := 0 to FPropObjects.Count - 1 do begin xObject := T3DSide(TTreeNode(FPropObjects[i]).Data); xGLObject := TGLBaseSceneObject(xObject.FGLObject); for j := 0 to mDesc.Lines.Count - 1 do xObject.FDescription.Add(mDesc.Lines[j]); end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.ChangeDesc', E.Message); end; end; procedure Tfrm3D.ChangeName; var i: integer; xObject: T3DSide; xGLObject: TGLBaseSceneObject; begin try if edName.Text = '' then exit; for i := 0 to FPropObjects.Count - 1 do begin xObject := T3DSide(TTreeNode(FPropObjects[i]).Data); xGLObject := TGLBaseSceneObject(xObject.FGLObject); TTreeNode(FPropObjects[i]).Text := edName.Text; xObject.FName := edName.Text; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.ChangeName', E.Message); end; end; procedure Tfrm3D.ChangeRotate; var i: integer; xObject: T3DSide; xGLObject: TGLBaseSceneObject; Bmp: TBitmap; begin try if edRotate.Text = '' then exit; for i := 0 to FPropObjects.Count - 1 do begin xObject := T3DSide(TTreeNode(FPropObjects[i]).Data); xGLObject := TGLBaseSceneObject(xObject.FGLObject); if StrToInt(edRotate.Text) >= 360 then edRotate.Text := IntToStr(StrToInt(edRotate.Text) mod 360); xObject.FRotate := StrToInt(edRotate.Text); if (xGLObject is TGLMesh) then begin RotateTextureToAngleM(xObject, TGLMesh(xGLObject), xObject.FRotate, xObject.FMirror); end; if (xGLObject is TGLPolygon) then begin RotateTextureToAngleP(xObject, TGLPolygon(xGLObject), xObject.FRotate, xObject.FMirror); end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.ChangeRotate', E.Message); end; end; procedure Tfrm3D.sbFirstFaceClick(Sender: TObject); begin GLCameraFirstPerson.CameraStyle := csPerspective; GLCameraFirstPerson.FocalLength := 160; GLSceneViewer.Camera := GLCameraFirstPerson; lbViewType.Caption := cForm3D_Mes5; end; procedure Tfrm3D.GLCadencerProgress(Sender: TObject; const deltaTime, newTime: Double); var speed : Single; Pt: TPoint; begin if not GLSceneViewer.Focused then exit; // handle keypresses speed := deltaTime; 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) then begin if FToolMode <> tmSelect then begin FToolMode := tmSelect; glSpliter.Visible := False; glCubeSpliter.Visible := False; glSide11.Visible := False; glSide12.Visible := False; glSide21.Visible := False; glSide22.Visible := False; DeleteNodesObjects; RefreshSidesPoints; GLSceneViewer.Cursor := crDefault; 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; //- высота / ширина begin try if aGLObject.Nodes.Count >= 4 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; 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; 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 xScale := 1; WH_koef := 1;//Image.Width / Image.Height; HW_koef := 1;//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; 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 := 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; procedure Tfrm3D.cbHashsPropertiesCloseUp(Sender: TObject); var i, Index: Integer; xObject: T3DSide; xGLObject: TGLBaseSceneObject; tmpdir, tmpfname, ExtStr, BmpFName: string; HashStr: string; begin try Index := cbHashs.ItemIndex; HashStr := cbHashs.Properties.Items[Index]; tmpdir := ExtractDirByCategoryType(dctPictures); tmpfname := GetImageFileByHash(HashStr); ExtStr := ExtractFileExt(tmpfname); if tmpfname <> '' then begin imgTexture.Picture.LoadFromFile(tmpfname); for i := 0 to FPropObjects.Count - 1 do 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.Image.LoadFromFile(tmpfname); RotateTextureToAngleP(xObject, TGLPolygon(xGLObject), xObject.FRotate, xObject.FMirror); end; end; end except on E: Exception do AddExceptionToLogEx('Tfrm3D.cbHashsPropertiesCloseUp', E.Message); end; end; procedure Tfrm3D.nAdd3DObjectClick(Sender: TObject); var i: 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; begin try if ModelTree.SelectionCount = 1 then begin xNode := ModelTree.Selections[0]; Open3DObject.InitialDir := ExeDir + '\3DModels'; NoMoveEvent := True; if Open3DObject.Execute then begin FName := Open3DObject.FileName; xRoom := T3DRoom(xNode.Data); // создать обьект на GLScene glObjClass := TGLFreeForm; glObject := TGLFreeForm(DummyCube.AddNewChild(glObjClass)); glObject.Material.Texture.Disabled := False; glObject.LoadFromFile(FName); 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 := 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; with glObject.Material do 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; //MaterialOptions := [moNoLighting]; end; glObject.BuildOctree; // создать объект в классе xObject := T3DSObject.Create(xRoom); xObject.FPath := FName; xObject.FName := ExtractFileName(FName); xObject.FPosition.x := glObject.Position.X; xObject.FPosition.y := glObject.Position.Y; 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; glObject.TagObject := xSubNode; end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.nAdd3DObjectClick', E.Message); end; 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.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.Popup(X, Y); end; end; end; end; procedure Tfrm3D.ChangeAngleX; var i: integer; xObject: T3DSObject; xGLObject: TGLBaseSceneObject; begin try if edAngleX.Text = '' then exit; for i := 0 to FPropObjects.Count - 1 do begin xObject := T3DSObject(TTreeNode(FPropObjects[i]).Data); xGLObject := TGLBaseSceneObject(xObject.FGLObject); xObject.FRotate.x := StrToFloat_My(edAngleX.Text); if (xGLObject is TGLFreeForm) then begin TGLFreeForm(xGLObject).PitchAngle := StrToFloat_My(edAngleX.Text); end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.ChangeAngleX', E.Message); end; end; procedure Tfrm3D.ChangeAngleY; var i: integer; xObject: T3DSObject; xGLObject: TGLBaseSceneObject; begin try if edAngleY.Text = '' then exit; for i := 0 to FPropObjects.Count - 1 do begin xObject := T3DSObject(TTreeNode(FPropObjects[i]).Data); xGLObject := TGLBaseSceneObject(xObject.FGLObject); xObject.FRotate.y := StrToFloat_My(edAngleY.Text); if (xGLObject is TGLFreeForm) then begin TGLFreeForm(xGLObject).TurnAngle := StrToFloat_My(edAngleY.Text); end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.ChangeAngleY', E.Message); end; end; procedure Tfrm3D.ChangeAngleZ; var i: integer; xObject: T3DSObject; xGLObject: TGLBaseSceneObject; begin try if edAngleZ.Text = '' then exit; for i := 0 to FPropObjects.Count - 1 do begin xObject := T3DSObject(TTreeNode(FPropObjects[i]).Data); xGLObject := TGLBaseSceneObject(xObject.FGLObject); xObject.FRotate.Z := StrToFloat_My(edAngleZ.Text); if (xGLObject is TGLFreeForm) then begin TGLFreeForm(xGLObject).RollAngle := StrToFloat_My(edAngleZ.Text); end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.ChangeAngleZ', E.Message); end; end; procedure Tfrm3D.ChangePosX; var i: integer; xObject: T3DSObject; xGLObject: TGLBaseSceneObject; begin try if edPosX.Text = '' then exit; for i := 0 to FPropObjects.Count - 1 do begin xObject := T3DSObject(TTreeNode(FPropObjects[i]).Data); xGLObject := TGLBaseSceneObject(xObject.FGLObject); xObject.FPosition.x := StrToFloat_My(edPosX.Text); if (xGLObject is TGLFreeForm) then begin TGLFreeForm(xGLObject).Position.X := StrToFloat_My(edPosX.Text); end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.ChangePosX', E.Message); end; end; procedure Tfrm3D.ChangePosY; var i: integer; xObject: T3DSObject; xGLObject: TGLBaseSceneObject; begin try if edPosY.Text = '' then exit; for i := 0 to FPropObjects.Count - 1 do begin xObject := T3DSObject(TTreeNode(FPropObjects[i]).Data); xGLObject := TGLBaseSceneObject(xObject.FGLObject); xObject.FPosition.y := StrToFloat_My(edPosY.Text); if (xGLObject is TGLFreeForm) then begin TGLFreeForm(xGLObject).Position.Y := StrToFloat_My(edPosY.Text); end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.ChangePosY', E.Message); end; end; procedure Tfrm3D.ChangePosZ; var i: integer; xObject: T3DSObject; xGLObject: TGLBaseSceneObject; begin try if edPosZ.Text = '' then exit; for i := 0 to FPropObjects.Count - 1 do begin xObject := T3DSObject(TTreeNode(FPropObjects[i]).Data); xGLObject := TGLBaseSceneObject(xObject.FGLObject); xObject.FPosition.z := StrToFloat_My(edPosZ.Text); if (xGLObject is TGLFreeForm) then begin TGLFreeForm(xGLObject).Position.Z := StrToFloat_My(edPosZ.Text); end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.ChangePosZ', E.Message); end; end; procedure Tfrm3D.ChangeScaleX; var i: integer; xObject: T3DSObject; xGLObject: TGLBaseSceneObject; begin try if edScaleX.Text = '' then exit; for i := 0 to FPropObjects.Count - 1 do begin xObject := T3DSObject(TTreeNode(FPropObjects[i]).Data); xGLObject := TGLBaseSceneObject(xObject.FGLObject); xObject.FScale.x := StrToFloat_My(edScaleX.Text); if (xGLObject is TGLFreeForm) then begin TGLFreeForm(xGLObject).Scale.X := StrToFloat_My(edScaleX.Text); end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.ChangeScaleX', E.Message); end; end; procedure Tfrm3D.ChangeScaleY; var i: integer; xObject: T3DSObject; xGLObject: TGLBaseSceneObject; begin try if edScaleY.Text = '' then exit; for i := 0 to FPropObjects.Count - 1 do begin xObject := T3DSObject(TTreeNode(FPropObjects[i]).Data); xGLObject := TGLBaseSceneObject(xObject.FGLObject); xObject.FScale.y := StrToFloat_My(edScaleY.Text); if (xGLObject is TGLFreeForm) then begin TGLFreeForm(xGLObject).Scale.Y := StrToFloat_My(edScaleY.Text); end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.ChangeScaleY', E.Message); end; end; procedure Tfrm3D.ChangeScaleZ; var i: integer; xObject: T3DSObject; xGLObject: TGLBaseSceneObject; begin try if edScaleZ.Text = '' then exit; for i := 0 to FPropObjects.Count - 1 do begin xObject := T3DSObject(TTreeNode(FPropObjects[i]).Data); xGLObject := TGLBaseSceneObject(xObject.FGLObject); xObject.FScale.z := StrToFloat_My(edScaleZ.Text); if (xGLObject is TGLFreeForm) then begin TGLFreeForm(xGLObject).Scale.Z := StrToFloat_My(edScaleZ.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; panTexture.Visible := aStatus; panPos3ds.Visible := aStatus; panRotate3ds.Visible := aStatus; panScale3ds.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; pos, Camera: T3DPoint; SetPos: T3DPoint; delta, koef, len: double; begin try delta := 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; 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 := GetLineLenght(pos, Camera); 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; 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 := haCenter; xObj.Adjust.Vert := vaCenter; xObj.Font.Color := clBlue; xObj.Material.FrontProperties.Ambient.Color := clrBlue; xObj.Material.FrontProperties.Diffuse.Color := clrBlue; xObj.Material.FrontProperties.Emission.Color := clrBlue; xObj.Material.BackProperties.Ambient.Color := clrBlue; xObj.Material.BackProperties.Diffuse.Color := clrBlue; xObj.Material.BackProperties.Emission.Color := clrBlue; 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; 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]); // 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; // 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; Len: double; pos, Camera: T3DPoint; SetPos: T3DPoint; delta, koef: double; begin try delta := 0.5; Camera.x := GLSceneViewer.Camera.Position.x; Camera.y := GLSceneViewer.Camera.Position.y; Camera.z := GLSceneViewer.Camera.Position.z; 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 := GetLineLenght(pos, Camera); 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; Len := SQRT(SQR(FResizeData.Nodep11.x - rpos1.x) + SQR(FResizeData.Nodep11.y - rpos1.y) + SQR(FResizeData.Nodep11.z - rpos1.z)); glSide11.Text := FormatFloat(ffMask, Len); 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 := GetLineLenght(pos, Camera); 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; Len := SQRT(SQR(FResizeData.Nodep12.x - rpos2.x) + SQR(FResizeData.Nodep12.y - rpos2.y) + SQR(FResizeData.Nodep12.z - rpos2.z)); glSide12.Text := FormatFloat(ffMask, Len); 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 := GetLineLenght(pos, Camera); 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; Len := SQRT(SQR(FResizeData.Nodep21.x - rpos1.x) + SQR(FResizeData.Nodep21.y - rpos1.y) + SQR(FResizeData.Nodep21.z - rpos1.z)); glSide21.Text := FormatFloat(ffMask, Len); 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 := GetLineLenght(pos, Camera); 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; Len := SQRT(SQR(FResizeData.Nodep22.x - rpos2.x) + SQR(FResizeData.Nodep22.y - rpos2.y) + SQR(FResizeData.Nodep22.z - rpos2.z)); glSide22.Text := FormatFloat(ffMask, Len); 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; glCursorObject := TGLCustomSceneObject.Create(GLScene); glCursorObject.Visible := False; 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 := haCenter; glSide11.Adjust.Vert := 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 := haCenter; glSide12.Adjust.Vert := 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 := haCenter; glSide21.Adjust.Vert := 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 := haCenter; glSide22.Adjust.Vert := 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; 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 := lnaDodecahedron; glSpliter.Visible := False; glCubeSpliter := TGLCube(DummyCube.AddNewChild(TGLCube)); glCubeSpliter.CubeDepth := 0.3; // Z glCubeSpliter.CubeHeight := 0.3; // Y glCubeSpliter.CubeWidth := 0.3; // 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; except on E: Exception do AddExceptionToLogEx('Tfrm3D.AfterUpdate', E.Message); end; end; procedure Tfrm3D.GLSceneViewerMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); 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; 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; 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; 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); 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; xSide.FGLPoints[i].z := aSide.Nodes[i].Z; end; for i := 0 to Length(xSide.FPoints) - 1 do begin xSide.FPoints[i].x := aSide.Nodes[i].X / Factor; xSide.FPoints[i].z := aSide.Nodes[i].Y / Factor; xSide.FPoints[i].y := aSide.Nodes[i].Z / Factor; end; xAddSide := T3DSide.Create(xSide.FFaceType, xSide.FWallType, xSide.FSideType, xSide.FParent); xAddSide.FName := cSubSide + IntToStr(xParentNode.Count + 1); xAddSide.FDescription := xSide.FDescription; xAddSide.FGLObject := aAddSide; xAddSide.FFace := nil; xAddSide.FColor := xSide.FColor; xAddSide.FRotate := xSide.FRotate; xAddSide.FMirror := xSide.FMirror; xAddSide.FTextureHash := xSide.FTextureHash; xAddSide.FTexture_ext := xSide.FTexture_ext; SetLength(xAddSide.FPoints, aAddSide.Nodes.Count); SetLength(xAddSide.FGLPoints, aAddSide.Nodes.Count); 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; xAddSide.FGLPoints[i].z := aAddSide.Nodes[i].Z; end; for i := 0 to Length(xAddSide.FPoints) - 1 do begin xAddSide.FPoints[i].x := aAddSide.Nodes[i].X / Factor; xAddSide.FPoints[i].z := aAddSide.Nodes[i].Y / Factor; xAddSide.FPoints[i].y := aAddSide.Nodes[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; aAddSide.TagObject := xAddNode; // Apply Texture tmpdir := 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.Image.LoadFromFile(tmpfname); RotateTextureToAngleP(xAddSide, aAddSide, xAddSide.FRotate, 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; 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 := xParentSide.FDescription; xFirstSide.FGLObject := aFirstSide; xFirstSide.FFace := nil; xFirstSide.FColor := xParentSide.FColor; xFirstSide.FRotate := xParentSide.FRotate; xFirstSide.FMirror := xParentSide.FMirror; xFirstSide.FTextureHash := xParentSide.FTextureHash; xFirstSide.FTexture_ext := xParentSide.FTexture_ext; SetLength(xFirstSide.FPoints, aFirstSide.Nodes.Count); SetLength(xFirstSide.FGLPoints, aFirstSide.Nodes.Count); 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; xFirstSide.FGLPoints[i].z := aFirstSide.Nodes[i].Z; end; for i := 0 to Length(xFirstSide.FPoints) - 1 do begin xFirstSide.FPoints[i].x := aFirstSide.Nodes[i].X / Factor; xFirstSide.FPoints[i].z := aFirstSide.Nodes[i].Y / Factor; xFirstSide.FPoints[i].y := aFirstSide.Nodes[i].Z / Factor; end; xParentSide.FSubSides.Add(xFirstSide); xFirstNode := ModelTree.Items.AddChild(xParentNode, xFirstSide.FName); xFirstNode.Data := xFirstSide; xFirstNode.ImageIndex := 50; aFirstSide.TagObject := xFirstNode; // CREATE SECOND xSecondSide := T3DSide.Create(xParentSide.FFaceType, xParentSide.FWallType, xParentSide.FSideType, xParentSide); xSecondSide.FName := cSubSide + IntToStr(xParentNode.Count + 1); xSecondSide.FDescription := xParentSide.FDescription; xSecondSide.FGLObject := aSecondSide; xSecondSide.FFace := nil; xSecondSide.FColor := xParentSide.FColor; xSecondSide.FRotate := xParentSide.FRotate; xSecondSide.FMirror := xParentSide.FMirror; xSecondSide.FTextureHash := xParentSide.FTextureHash; xSecondSide.FTexture_ext := xParentSide.FTexture_ext; SetLength(xSecondSide.FPoints, aSecondSide.Nodes.Count); SetLength(xSecondSide.FGLPoints, aSecondSide.Nodes.Count); 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; xSecondSide.FGLPoints[i].z := aSecondSide.Nodes[i].Z; end; for i := 0 to Length(xSecondSide.FPoints) - 1 do begin xSecondSide.FPoints[i].x := aSecondSide.Nodes[i].X / Factor; xSecondSide.FPoints[i].z := aSecondSide.Nodes[i].Y / Factor; xSecondSide.FPoints[i].y := aSecondSide.Nodes[i].Z / Factor; end; xParentSide.FSubSides.Add(xSecondSide); xSecondNode := ModelTree.Items.AddChild(xParentNode, xSecondSide.FName); xSecondNode.Data := xSecondSide; xSecondNode.ImageIndex := 50; aSecondSide.TagObject := xSecondNode; xParentSide.FGLObject := nil; // Apply Texture tmpdir := 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.Image.LoadFromFile(tmpfname); RotateTextureToAngleP(xSecondSide, aSecondSide, xSecondSide.FRotate, xSecondSide.FMirror); end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.CreateAddForParentSide', E.Message); end; end; procedure Tfrm3D.SetSidesData; var xNode: TTreeNode; xSide1, xSide2: T3DSide; 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); xSide1.FGLPoints[FResizeData.Indexr11].x := FResizeData.Noder11.X; xSide1.FGLPoints[FResizeData.Indexr11].y := FResizeData.Noder11.Y; xSide1.FGLPoints[FResizeData.Indexr11].z := FResizeData.Noder11.Z; xSide1.FGLPoints[FResizeData.Indexr12].x := FResizeData.Noder12.X; xSide1.FGLPoints[FResizeData.Indexr12].y := FResizeData.Noder12.Y; xSide1.FGLPoints[FResizeData.Indexr12].z := FResizeData.Noder12.Z; xSide1.FPoints[FResizeData.Indexr11].x := FResizeData.Noder11.X / Factor; xSide1.FPoints[FResizeData.Indexr11].z := FResizeData.Noder11.Y / Factor; xSide1.FPoints[FResizeData.Indexr11].y := FResizeData.Noder11.Z / Factor; xSide1.FPoints[FResizeData.Indexr12].x := FResizeData.Noder12.X / Factor; xSide1.FPoints[FResizeData.Indexr12].z := FResizeData.Noder12.Y / Factor; xSide1.FPoints[FResizeData.Indexr12].y := FResizeData.Noder12.Z / Factor; xSide2.FGLPoints[FResizeData.Indexr21].x := FResizeData.Noder21.X; xSide2.FGLPoints[FResizeData.Indexr21].y := FResizeData.Noder21.Y; xSide2.FGLPoints[FResizeData.Indexr21].z := FResizeData.Noder21.Z; xSide2.FGLPoints[FResizeData.Indexr22].x := FResizeData.Noder22.X; xSide2.FGLPoints[FResizeData.Indexr22].y := FResizeData.Noder22.Y; xSide2.FGLPoints[FResizeData.Indexr22].z := FResizeData.Noder22.Z; xSide2.FPoints[FResizeData.Indexr21].x := FResizeData.Noder21.X / Factor; xSide2.FPoints[FResizeData.Indexr21].z := FResizeData.Noder21.Y / Factor; xSide2.FPoints[FResizeData.Indexr21].y := FResizeData.Noder21.Z / Factor; xSide2.FPoints[FResizeData.Indexr22].x := FResizeData.Noder22.X / Factor; xSide2.FPoints[FResizeData.Indexr22].z := FResizeData.Noder22.Y / Factor; xSide2.FPoints[FResizeData.Indexr22].y := FResizeData.Noder22.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; 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); 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; xSide1.FGLPoints[i].z := xGLSide1.Nodes[i].z; xSide1.FPoints[i].x := xGLSide1.Nodes[i].x / Factor; xSide1.FPoints[i].z := xGLSide1.Nodes[i].y / Factor; xSide1.FPoints[i].y := xGLSide1.Nodes[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); 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; xSide2.FGLPoints[i].z := xGLSide2.Nodes[i].z; xSide2.FPoints[i].x := xGLSide2.Nodes[i].x / Factor; xSide2.FPoints[i].z := xGLSide2.Nodes[i].y / Factor; xSide2.FPoints[i].y := xGLSide2.Nodes[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 Res: Integer; mess: string; begin GLCadencer.Enabled := False; {$IF Defined(ES_GRAPH_SC)} mess := 'Сохранить модель?'; Res := MessageBox(self.Handle, PAnsiChar(mess), 'Сохранение модели', MB_YESNOCANCEL); if Res = IDYES then begin SaveModelToStream(FFileStream); GSaved3DModelExist := True; end else if Res = IDCANCEL then begin CanClose := False; GLCadencer.Enabled := True; end; {$ELSE} {$IFEND} end; procedure Tfrm3D.sbSaveModelClick(Sender: TObject); begin SaveModelToStream(FFileStream); GSaved3DModelExist := True; end; procedure Tfrm3D.SaveModelToStream(const AFile: String); var fFileName: string; 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; begin try {* Здесь на самом деле нужно получить имя файла с ПМ, вот как здесь fFileName := GetCadFileNameForSaveToPM(GCadForm.FCADListID); PCad.SaveToFile(0, fFileName); это на обработчике TF_CAD.FormCloseQuery и потом на LoadModelToStream тот файл получить *} fFileName := AFile; if fFileName = '' then begin SetString(TempPath, Buffer, GetTempPath(Sizeof(Buffer) - 1, Buffer)); fFileName := TempPath + '3dmodel.pwd'; end; xStream := SafeOpenFileStream(fFileName, fmCreate or fmShareExclusive, 'Tfrm3D.SaveModelToStream'); ModelObjectsList := TList.Create; ModelObjectsList.Add(F3DModel); // распарсить комнаты for i := 0 to F3DModel.FRooms.Count - 1 do begin xRoom := T3DRoom(F3DModel.FRooms[i]); 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; // добавить пол в комнату 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; // добавить 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; xSize := 0; mStream := TMemoryStream.Create; GetModelData(mStream); xSize := mStream.Size; mStream.Seek(0, soFromBeginning); xStream.Write(xSize, 4); StreamToStream(mStream, xStream, xSize); 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); 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); var fFileName: string; 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(GCadForm.FCADListID, GCadForm.FCADListName, fFileName); if ListStream <> nil then begin SetString(TempPath, Buffer, GetTempPath(Sizeof(Buffer) - 1, Buffer)); ListStream.SaveToFile(TempPath + 'tempCAD.pwd'); GCadForm.PCad.LoadFromFile(TempPath + 'tempCAD.pwd'); end *} F3DStreamModel := nil; ModelObjectsList := TList.Create; fFileName := AFile; if fFileName = '' then begin 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.LoadModelFromStream'); xStream.Read(xSize, 4); mStream := TMemoryStream.Create; StreamToStream(xStream, mStream, xSize); mStream.Seek(0, soFromBeginning); SetModelData(mStream); FreeAndNil(mStream); FreeAndNil(xStream); 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; end; FreeAndNil(ModelObjectsList); except on E: Exception do AddExceptionToLogEx('Tfrm3D.LoadModelFromStream', E.Message); end; 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; 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; 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]; 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; 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; begin try X := mx; Y := my; if (FToolMode = tmSelect) then begin xObj := GlsceneViewer.Buffer.GetPickedobject(X, Y); 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) 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; 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.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.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): 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; begin try Result := nil; // распарсить комнаты 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; 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); 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; end.