unit Form3d; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Keyboard, Dialogs, GLScene, GLObjects, GLWin32Viewer, GLMisc, GLTexture, jpeg, StdCtrls, ExtCtrls, Buttons,PCTypesUtils,GLGeomObjects,VectorGeometry, GLFile3DS, GLExtrusion, GLGraph, GLVectorFileObjects, GLPortal, GLSpaceText,GLMultiPolygon, VectorTypes, GLHUDObjects, GLWaterPlane, GLBitmapFont, GLWindowsFont, LibJPeg, Form3d_Save, siComp, siLngLnk, GLMesh, {U_Arch3D}U_Arch3DNew, ComCtrls, ImgList, cxControls, cxContainer, cxEdit, cxTextEdit, cxMemo, cxMaskEdit, RzCmboBx, cxLookAndFeelPainters, cxButtons, cxImage, RzButton, RzRadChk, cxDropDownEdit, ExtDlgs, GLCadencer, glFPSMovement, GLNavigator, Menus, GeometryBB, Math, cxGroupBox, U_Cad, U_SCSLists; 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) BasisNodes: T3DPointArray; Side1: TGLPolygon; Side2: TGLPolygon; Nodep11: TGLNode; Nodep12: TGLNode; Nodep21: TGLNode; Nodep22: TGLNode; Noder11: TGLNode; Noder12: TGLNode; Noder21: TGLNode; Noder22: TGLNode; Indexp11: Integer; Indexp12: Integer; Indexp21: Integer; Indexp22: Integer; Indexr11: Integer; Indexr12: Integer; Indexr21: Integer; Indexr22: Integer; end; TPropRecord = class(TMyObject) fName: string; fDesc: TStringList; fCoords: TList; fRotate: string; constructor Create; end; Tfrm3D = class(TForm) GLScene: TGLScene; panMain: TPanel; GLCamera: TGLCamera; GLLightSource1: TGLLightSource; GLLightSource2: TGLLightSource; GLLightSource3: TGLLightSource; GLLightSource4: TGLLightSource; GLLightSource5: TGLLightSource; panUpper: TPanel; SpeedButton1: TSpeedButton; SpeedButton2: TSpeedButton; DummyCube: TGLDummyCube; TransCube: TGLDummyCube; GLPlane1: TGLPlane; GLDummyCube1: TGLDummyCube; GLHUDText1: TGLHUDText; SpeedButton3: TSpeedButton; SaveDialog: TSaveDialog; lbViewType: TLabel; lng_Forms: TsiLangLinked; cbViewCeiling: TCheckBox; Splitter1: TSplitter; ImageList_Dir: TImageList; panScene: TPanel; GLSceneViewer: TGLSceneViewer; panObjects: TPanel; Splitter2: TSplitter; panProps: TPanel; panTree: TPanel; ModelTree: TTreeView; Panel1: TPanel; panSideTexture: 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; imgSideTexture: TcxImage; bSideTextureChange: TcxButton; bSideTextureClear: TcxButton; cbMirror: TRzCheckBox; edTextureRotate: TcxMaskEdit; Label37: TLabel; cbCoordNbr: TcxComboBox; OpenTexture: TOpenPictureDialog; sbFirstFace: TSpeedButton; MainCenter: TGLDummyCube; GLCadencer: TGLCadencer; cbSideHashs: 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; FirstPerson: TGLDummyCube; FirstPersonCamera: TGLCamera; GLNavigator1: TGLNavigator; GLFPSMovementManager1: TGLFPSMovementManager; Edit1: TEdit; Edit2: TEdit; btnEmpty: TSpeedButton; NDel3DObject: TMenuItem; cbShowTraceCaptions: TCheckBox; cxGroupBox1: TcxGroupBox; cbLists: TcxComboBox; cbObjectsTypes: TcxComboBox; edTextureScale: TcxMaskEdit; Label27: TLabel; Label28: TLabel; MatLib: TGLMaterialLibrary; panObjectTexture: TPanel; Label29: TLabel; Label30: TLabel; imgObjectTexture: TcxImage; bObjectTextureChange: TcxButton; cbObjectHashs: TcxComboBox; bObjectTextureClear: TcxButton; TimerOnSelectNodes: TTimer; Light: TGLLightSource; GLLightFirstPerson: TGLLightSource; procedure GLSceneViewerMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure GLSceneViewerMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure SpeedButton1Click(Sender: TObject); procedure SpeedButton2Click(Sender: TObject); procedure FormShow(Sender: TObject); procedure GLHeightField1GetHeight(const x, y: Single; var z: Single; var color: TVector4f; var texPoint: TTexPoint); procedure FormMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); procedure SpeedButton3Click(Sender: TObject); procedure cbViewCeilingClick(Sender: TObject); procedure GLSceneViewerDblClick(Sender: TObject); procedure ModelTreeClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure cbCoordNbrCloseUp(Sender: TObject); procedure bSideTextureClearClick(Sender: TObject); procedure cbMirrorClick(Sender: TObject); procedure mDescEnter(Sender: TObject); procedure sbFirstFaceClick(Sender: TObject); procedure bSideTextureChangeClick(Sender: TObject); procedure GLCadencerProgress(Sender: TObject; const deltaTime, newTime: Double); procedure GLSceneViewerClick(Sender: TObject); procedure cbHashsPropertiesCloseUp(Sender: TObject); procedure nAdd3DObjectClick(Sender: TObject); procedure ModelTreeMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure edNameExit(Sender: TObject); procedure mDescExit(Sender: TObject); procedure edPosXExit(Sender: TObject); procedure edPosYExit(Sender: TObject); procedure edPosZExit(Sender: TObject); procedure edAngleXExit(Sender: TObject); procedure edAngleYExit(Sender: TObject); procedure edAngleZExit(Sender: TObject); procedure edScaleXExit(Sender: TObject); procedure edScaleYExit(Sender: TObject); procedure edScaleZExit(Sender: TObject); procedure edCoordXKeyPress(Sender: TObject; var Key: Char); procedure edCoordXExit(Sender: TObject); procedure edCoordYExit(Sender: TObject); procedure edCoordZExit(Sender: TObject); procedure edTextureRotateExit(Sender: TObject); procedure edCoordYKeyPress(Sender: TObject; var Key: Char); procedure edCoordZKeyPress(Sender: TObject; var Key: Char); procedure edTextureRotateKeyPress(Sender: TObject; var Key: Char); procedure edNameKeyPress(Sender: TObject; var Key: Char); procedure mDescKeyPress(Sender: TObject; var Key: Char); procedure edPosXKeyPress(Sender: TObject; var Key: Char); procedure edPosYKeyPress(Sender: TObject; var Key: Char); procedure edPosZKeyPress(Sender: TObject; var Key: Char); procedure edAngleXKeyPress(Sender: TObject; var Key: Char); procedure edAngleYKeyPress(Sender: TObject; var Key: Char); procedure edAngleZKeyPress(Sender: TObject; var Key: Char); procedure edScaleXKeyPress(Sender: TObject; var Key: Char); procedure edScaleYKeyPress(Sender: TObject; var Key: Char); procedure edScaleZKeyPress(Sender: TObject; var Key: Char); procedure GLSceneViewerMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); procedure sbSaveModelClick(Sender: TObject); procedure nDeleteAllSubSidesClick(Sender: TObject); procedure Edit2Exit(Sender: TObject); procedure btnEmptyClick(Sender: TObject); procedure NDel3DObjectClick(Sender: TObject); procedure cbShowTraceCaptionsClick(Sender: TObject); procedure cbListsPropertiesCloseUp(Sender: TObject); procedure cbObjectsTypesPropertiesCloseUp(Sender: TObject); procedure edTextureScaleExit(Sender: TObject); procedure edTextureScaleKeyPress(Sender: TObject; var Key: Char); procedure cbObjectHashsPropertiesCloseUp(Sender: TObject); procedure bObjectTextureClearClick(Sender: TObject); procedure bObjectTextureChangeClick(Sender: TObject); procedure MatLibTextureNeeded(Sender: TObject; var textureFileName: String); procedure TimerOnSelectNodesTimer(Sender: TObject); private procedure Rotate3DSObj(aObject: TGLFreeForm; aX, aY, aZ: Double); procedure DeselectGLObjectsT; { Private declarations } public { Public declarations } Factor: Single; mx, my : Integer; mdx, mdy : Integer; last_x, last_y: Integer; FResizer: Boolean; RStartPos1, RStartPos2: T3DPoint; CPoint: T3DPoint; OPoint: T3DPoint; Camera: T3DPoint; FZOrder: Double; FToolMode: TToolMode; FPropRecord: TPropRecord; FNodesObjectsList: TList; FCutDataList: TList; FSelection: TList; FxObjects: TList; FNodes: TList; FPropObjects: TList; FaceList: TList; FResizeData: TResizeData; FMovedObject, FRotatedObject: TGLFreeForm; F3DModel: T3DModel; F3DStreamModel: T3DModel; FFileStream: String; FIdsStream: TIntList; FFilesStream: TStringList; 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 ChangeTextureRotate; procedure ChangeTextureScale; procedure ChangePosX; procedure ChangePosY; procedure ChangePosZ; procedure ChangeAngleX; procedure ChangeAngleY; procedure ChangeAngleZ; procedure ChangeScaleX; procedure ChangeScaleY; procedure ChangeScaleZ; procedure Set3DSObjectPos(aGLObject: TGLFreeForm); // ************************** procedure OnRightClick; procedure RotateTextureToAngleM(aObject: T3DSide; aGLObject: TGLMesh; aAngle: Integer; aMirror: Boolean); Procedure RotateTextureToAngleP(aObject: T3DSide; aGLObject: TGLPolygon; aAngle: Integer; aMirror: Boolean); procedure SetPolygonTexture(aObject: TGLPolygon); Function Rotate3DVector(vs0, vs1, vs2: TVector3f; Ang: Double): TVector3f; Function GetImageFileByHash(aHash: string): string; Function GetObjectFileByHash(aHash: string): string; Procedure Get3DSObjectBounds(var Min, Max: T3DPoint; aObject: TGLFreeForm); Procedure GetRoomBounds(var Min, Max: T3DPoint; aFloor, aCeiling: T3DPointArray); procedure DeleteNodesObjects; procedure CreateNodesObjects(aObj: TGLPolygon); procedure SelectNodesEvent(Sender: TObject); procedure SetSideSizes; procedure DoResize; procedure AfterUpdate; procedure CreateAddForDivSide(aSide, aAddSide: TGLPolygon); procedure CreateAddForParentSide(aFirstSide, aSecondSide: TGLPolygon); procedure SetSidesData; procedure RefreshSidesPoints; procedure SaveModelToStream(const AFile: String=''; AListID: Integer = 0); procedure LoadModelFromStream(const AFile: String=''; AListID: Integer = 0); procedure SaveModelAddParamsToStream(const AFile: String=''); procedure LoadModelAddParamsFromStream(const AFile: String=''); procedure GetModelData(Stream: TStream); procedure SetModelData(Stream: TStream); procedure GetFileData(Stream: TStream); procedure SetFileData(Stream: TStream); function GetModelObjectByComponID(aComponID: Integer): TObject; function GetSimilarSide(aSide: T3DSide; aObject: TObject): T3DSide; function CmpSides(aSide1, aSide2: T3DSide): Boolean; procedure ToggleTraceCaptions(AShow: Boolean); procedure LoadSelectionData; procedure FindSelectNodesByType(aType: Integer); function is3DSObject(aObj: TGLBaseSceneObject): Boolean; function GetDistAngle(AP1, AP2: TDoublePoint): Double; procedure UndoCutSides; end; var frm3D: Tfrm3D; glSide11, glSide21, glSide12, glSide22: TGLSpaceText; glSpliter: TGLLines; glCubeSpliter, glCubeSpliter1, glCubeSpliter2: TGLCube; glCursorObject: TGLCustomSceneObject; rpos1, rpos2: T3DPoint; ModelObjectsList: TList; NoMoveEvent: Boolean = False; SelObjColor, ObjColor: Tvector4f; behav: TGLBFPSMovement; yangle:double=90; xangle:double=0; FTextures: TStringList; FisCreate3DS: Boolean; FCurrObject: T3DSObject; //Alex(20.12.2010) FirstCameraPosIsSet:Boolean = False; 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 GLSceneViewer.Camera = FirstPersonCamera then exit; Obj := GlsceneViewer.Buffer.GetPickedobject(X, Y); if Button = mbLeft then begin if FToolMode = tmCut then begin Obj := GlsceneViewer.Buffer.GetPickedobject(X, Y); if Obj = glCubeSpliter then begin glCursorObject.Position.x := glCubeSpliter.Position.x; glCursorObject.Position.y := glCubeSpliter.Position.y; glCursorObject.Position.z := glCubeSpliter.Position.z; FResizer := True; end; if Obj = glCubeSpliter1 then begin glCursorObject.Position.x := glCubeSpliter1.Position.x; glCursorObject.Position.y := glCubeSpliter1.Position.y; glCursorObject.Position.z := glCubeSpliter1.Position.z; FResizer := True; end; if Obj = glCubeSpliter2 then begin glCursorObject.Position.x := glCubeSpliter2.Position.x; glCursorObject.Position.y := glCubeSpliter2.Position.y; glCursorObject.Position.z := glCubeSpliter2.Position.z; FResizer := True; end; end; if FToolMode = tmSelect then begin if (Obj <> nil) and (Obj is TGLFreeForm) then if (FSelection.Count = 1) and (TGLBaseSceneObject(FSelection[0]) = Obj) then FMovedObject := TGLFreeForm(Obj); end; end else if Button = mbRight then begin if (Obj <> nil) and (Obj is TGLFreeForm) then if (FSelection.Count = 1) and (TGLBaseSceneObject(FSelection[0]) = Obj) then begin FRotatedObject := TGLFreeForm(Obj); last_x := x; last_y := y; end; 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; glObject: TGLFreeForm; xObject: T3DSObject; AngX, AngY, AngZ: Double; mult: integer; VC: TVector4f; begin if NoMoveEvent then begin NoMoveEvent := False; mx := x; my := y; end; shiftDown:=(IsKeyDown(VK_LSHIFT) or IsKeyDown(VK_RSHIFT)); dx := mx - x; dy := my - y; if (dx = 0) and (dy = 0) then exit; if GLSceneViewer.Camera = FirstPersonCamera then exit; Camera := GLSceneViewer.Camera; // SELECT MODE //if FToolMode = tmSelect then if not FResizer then begin if ssLeft in Shift then begin if FMovedObject <> nil then begin GLSceneViewer.Cursor := crHandPoint; VY := VectorMake(VectorPerpendicular(YVector, VectorNormalize(VectorSubtract(Camera.Position.AsAffineVector, MainCenter.Position.AsAffineVector)))); VX := VectorCrossProduct(VY, VectorNormalize( VectorSubtract(Camera.Position.AsVector, MainCenter.Position.AsVector))); //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)); //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; //Alex(17.12.2010) Закоментировал движение камеры мышкой при виде от первого лица {else if GLSceneViewer.Camera = GLCameraFirstPerson then begin GLSceneViewer.Camera.MoveAroundTarget(my - y, mx - x); //GLSceneViewer.Camera.pitch(my - y); //DummyCube.Turn(mx - x); //GLSceneViewer.Camera.Turn(my - y); //GLSceneViewer.Camera.Roll(mx - x); end; } end; end else //Alex(22.12.2010) Если FirstPerson то не перемещаем if ((ssRight in Shift) and (GLSceneViewer.Camera <> FirstPersonCamera)) then begin // ********************* 3ds Rotate ****************************************** if (FRotatedObject <> nil) then begin glObject := FRotatedObject; (* if abs(x - last_x) >= 10 then begin if x > last_x then begin if (ssShift in Shift) then edAngleY.Text := FloatToStr(StrToFloat_My(edAngleY.Text) + 1) else edAngleY.Text := FloatToStr(StrToFloat_My(edAngleY.Text) + 15); end else begin if (ssShift in Shift) then edAngleY.Text := FloatToStr(StrToFloat_My(edAngleY.Text) - 1) else edAngleY.Text := FloatToStr(StrToFloat_My(edAngleY.Text) - 15); end; last_x := x; last_y := y; end; if abs(y - last_y) >= 10 then begin if ssCtrl in Shift then begin if y > last_y then begin if (ssShift in Shift) then edAngleZ.Text := FloatToStr(StrToFloat_My(edAngleZ.Text) - 1) else edAngleZ.Text := FloatToStr(StrToFloat_My(edAngleZ.Text) - 15); end else begin if (ssShift in Shift) then edAngleZ.Text := FloatToStr(StrToFloat_My(edAngleZ.Text) + 1) else edAngleZ.Text := FloatToStr(StrToFloat_My(edAngleZ.Text) + 15); end; end else begin if y > last_y then begin if (ssShift in Shift) then edAngleX.Text := FloatToStr(StrToFloat_My(edAngleX.Text) - 1) else edAngleX.Text := FloatToStr(StrToFloat_My(edAngleX.Text) - 15); end else begin if (ssShift in Shift) then edAngleX.Text := FloatToStr(StrToFloat_My(edAngleX.Text) + 1) else edAngleX.Text := FloatToStr(StrToFloat_My(edAngleX.Text) + 15); end; end; last_x := x; last_y := y; end; xObject := T3DSObject(TTreeNode(glObject.TagObject).Data); AngX := StrToFloat_My(edAngleX.Text); AngY := StrToFloat_My(edAngleY.Text); AngZ := StrToFloat_My(edAngleZ.Text); // correct *** AngX := round(AngX) mod 360; AngY := round(AngY) mod 360; AngZ := round(AngZ) mod 360; edAngleX.Text := FloatToStr(AngX); edAngleY.Text := FloatToStr(AngY); edAngleZ.Text := FloatToStr(AngZ); // correct *** xObject.FRotate.x := AngX; xObject.FRotate.y := AngY; xObject.FRotate.z := AngZ; Set3dsRotate(glObject, AngX, AngY, AngZ); *) Camera := GLSceneViewer.Camera; dx := mx - x; dy := my - y; VY := VectorMake(VectorPerpendicular(YVector, VectorNormalize(Camera.Position.AsAffineVector))); VX := VectorCrossProduct(VY, VectorNormalize(Camera.Position.AsVector)); NormalizeVector(VY); NormalizeVector(VX); VC := VectorCombine(VX, VY, -dx * 0.132 * Camera.DistanceToTarget / Camera.FocalLength, dy * 0.132 * Camera.DistanceToTarget / Camera.FocalLength); if abs(x - last_x) >= 10 then begin if Not (ssCtrl in Shift) then begin mult := 1; if VC[0] < 0 then mult := -1; if (ssShift in Shift) then edAngleY.Text := FloatToStr(StrToFloat_My(edAngleY.Text) - 1 * mult) else edAngleY.Text := FloatToStr(StrToFloat_My(edAngleY.Text) - 15 * mult); last_x := x; last_y := y; end else begin mult := 1; if VC[2] < 0 then mult := -1; if (ssShift in Shift) then edAngleX.Text := FloatToStr(StrToFloat_My(edAngleX.Text) - 1 * mult) else edAngleX.Text := FloatToStr(StrToFloat_My(edAngleX.Text) - 15 * mult); end; last_x := x; last_y := y; Rotate3DSObj(glObject, StrToFloat_My(edAngleX.Text), StrToFloat_My(edAngleY.Text), StrToFloat_My(edAngleZ.Text)); end; if abs(y - last_y) >= 10 then begin if Not (ssCtrl in Shift) then begin mult := 1; if VC[0] > 0 then mult := -1; if (ssShift in Shift) then edAngleZ.Text := FloatToStr(StrToFloat_My(edAngleZ.Text) - 1 * mult) else edAngleZ.Text := FloatToStr(StrToFloat_My(edAngleZ.Text) - 15 * mult); end else begin mult := 1; if VC[2] < 0 then mult := -1; if (ssShift in Shift) then edAngleX.Text := FloatToStr(StrToFloat_My(edAngleX.Text) - 1 * mult) else edAngleX.Text := FloatToStr(StrToFloat_My(edAngleX.Text) - 15 * mult); end; last_x := x; last_y := y; Rotate3DSObj(glObject, StrToFloat_My(edAngleX.Text), StrToFloat_My(edAngleY.Text), StrToFloat_My(edAngleZ.Text)); end; end else begin if GLSceneViewer.Camera.CameraStyle = csPerspective then koefcam := 0.12 else koefcam := 0.03; if GLSceneViewer.Camera.Position.Y < 0 then v := GLSceneViewer.Camera.ScreenDeltaToVectorXZ(-dx, -dy, koefcam * GLSceneViewer.Camera.DistanceToTarget / GLSceneViewer.Camera.FocalLength) else v := GLSceneViewer.Camera.ScreenDeltaToVectorXZ(-dx, dy, koefcam * GLSceneViewer.Camera.DistanceToTarget / GLSceneViewer.Camera.FocalLength); GLDummyCube1.Position.Translate(v); DummyCube.Position.Translate(v); TransCube.Position.Translate(v); //Alex(22.12.2010) FirstPerson.Position.Translate(v); GLSceneViewer.Camera.TransformationChanged; end; end; end; // Режим Разрезки (Resizing) if (FToolMode = tmCut) then begin // поиcк обьекта для ресайзинга if not FResizer then begin if Shift = [] then begin xObj := GLSceneViewer.Buffer.GetPickedobject(X, Y); if (xObj = glCubeSpliter) or (xObj = glCubeSpliter1) or (xObj = glCubeSpliter2) then GLSceneViewer.Cursor := crSizeAll else GLSceneViewer.Cursor := crDefault; end; end else // Движение ресайзинга begin VY := VectorMake(VectorPerpendicular(YVector, VectorNormalize(VectorSubtract(Camera.Position.AsAffineVector, MainCenter.Position.AsAffineVector)))); VX := VectorCrossProduct(VY, VectorNormalize( VectorSubtract(Camera.Position.AsVector, MainCenter.Position.AsVector))); NormalizeVector(VY); NormalizeVector(VX); glCursorObject.Position.Translate(VectorCombine(VX, VY, -dx * 0.132 * Camera.DistanceToTarget / Camera.FocalLength, dy * 0.132 * Camera.DistanceToTarget / Camera.FocalLength)); DoResize; end; end; mx := x; my := y; end; procedure Tfrm3D.UpdateFaces(Faces: TList; Yh: Double = 0); var i, pCnt, j, k, FigureID: Integer; Face:TFaceRecord; glPoly:TGLPolyGon; glLine: TGLLines; glCube: TGLCube; glSphere: TGLSphere; glCenter: TGLDummyCube; glPipe: TGLPipe; p, p1, p2, p3, p4, p5, p6, p7, p8, normal: T3dPoint; 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, ImgName1: string; WallCoords: array [0..5] of TVector3f; FloorCoords: array of TVector3f; BegCoordIndex: integer; xNode: TTreeNode; xSide: T3DSide; xObject: T3DSObject; PrevxNode: TTreeNode; PrevxSide: T3DSide; Angle1, Angle2, ResAng: Double; dp1, dp2: TDoublePoint; pN, pP: TVector3f; //Alex(22.12.2010) xRoom: T3DRoom; RoomMin, RoomMax, RoomSize, SetPos, Scale: T3DPoint; begin try FaceList := Faces; {$IF Not Defined(ES_GRAPH_SC)} Factor := 0.15; {$ELSE} Factor := 0.15 * 10 / FScaleDelta; {$IFEND} tmpdir := ExtractDirByCategoryType(dctPictures); PrevxSide := nil; PrevxNode := nil; for i := 0 to DummyCube.Count - 1 do begin if not (DummyCube.Children[i] is TGLCamera) then DummyCube.Children[i].DeleteChildren; end; TransCube.DeleteChildren; // Beg - 2011-05-10 //LoadModelFromStream(FFileStream); //if F3DStreamModel = nil then // UpdateModelTree //else // UpdateModelTreeFromStream(Faces); // End - 2011-05-10 //// *********** FACES.COUNT ************************************************* for i := 0 to Faces.Count - 1 do begin Face := TFaceRecord(faces[i]); xNode := Face.FTreeNode; xSide := nil; xObject := nil; if xNode <> nil then begin PrevxSide := xSide; PrevxNode := xNode; end else begin if Face.RecType = ftNetPath then begin xNode := PrevxNode; Face.FTreeNode := PrevxNode; end; end; pCnt := Length(Face.Points); for k := 0 to pCnt - 1 do begin p := Face.Points[k]; p := DoublePoint(p.x,p.z,p.y); if (i = 0) and (k = 0) then begin tx := p.x; ty := p.y; tz := p.z; bx := p.x; by := p.y; bz := p.z; end else begin if p.x > tx then tx := p.x; if p.x < bx then bx := p.x; if p.y > ty then ty := p.y; if p.y < by then by := p.y; if p.z > tz then tz := p.z; if p.z < bz then bz := p.z; end; end; case Face.RecType of ftPolygon: glObjClass := TGLPolyGon; ftLine : glObjClass := TGLLines; ftPipe,ftBar : glObjClass := TGLPipe; ftSphere: glObjClass := TGLSphere; ftCenterCUbe: glObjClass := TGLDummyCube; ftNetPath: glObjClass := TGLPolygon; ftNetFloor: glObjClass := TGLPolygon; ftNetCeiling: glObjClass := TGLPolygon; ftNetDoor: glObjClass := TGLPolygon; ftNetWindow: glObjClass := TGLPolygon; ftNetBalconDoor: glObjClass := TGLPolygon; ftNetBalconWindow: glObjClass := TGLPolygon; ftNetFrame: glObjClass := TGLPolygon; ftNet3DSObject: glObjClass := TGLFreeForm; end; if face.OpTrans then begin //glObject := TransCube.AddNewChild(glObjClass); glObject := DummyCube.AddNewChild(glObjClass); end else begin glObject := DummyCube.AddNewChild(glObjClass); end; glObject.TagObject := xNode; if xNode <> nil then begin if Face.RecType = ftNet3DSObject then begin xObject := T3DSObject(xNode.Data); xObject.FZOrder := FZOrder * UOMToMetre(1000 / GCadForm.PCad.MapScale) * factor; xObject.FGLObject := glObject; end else begin xSide := T3DSide(xNode.Data); xSide.FZOrder := FZOrder * UOMToMetre(1000 / GCadForm.PCad.MapScale) * factor; if Face.RecType = ftNetFloor then begin T3DRoom(xSide.FParent).FZOrder := xSide.FZOrder; end; // только для первой делать if xSide.FGLObject = nil then xSide.FGLObject := glObject; end; end; if xSide <> nil then begin if Pos('empty', AnsiLowerCase(xSide.FDescription.Text)) = 1 then begin if GLObject <> nil then GLObject.Visible := False; if xNode <> nil then if xNode.ImageIndex < 999 then xNode.ImageIndex := xNode.ImageIndex + 1000; end else begin if GLObject <> nil then GLObject.Visible := True; if xNode <> nil then if xNode.ImageIndex > 999 then xNode.ImageIndex := xNode.ImageIndex - 1000; end; end; case Face.RecType of ftPolygon: glPoly := TGLPolyGon(glObject); ftLine : glLine := TGLLines(glObject); ftPipe,ftBar : glPipe := TGLPipe(glObject); ftSphere: glSphere := TGLSphere(glObject); ftCenterCube: glCenter := TGLDummyCube(glObject); ftNetPath: glWallSide := TGLPolygon(glObject); ftNetFloor: glFloor := TGLPolygon(glObject); ftNetCeiling: glCeiling := TGLPolygon(glObject); ftNetDoor: glDoorSide := TGLPolyGon(glObject); ftNetWindow: glWindowSide := TGLPolyGon(glObject); ftNetBalconDoor: glBalconDoorSide := TGLPolyGon(glObject); ftNetBalconWindow: glBalconWindowSide := TGLPolyGon(glObject); ftNet3DSObject: gl3DSObject := TGLFreeForm(glObject); end; // ADD ZORDER TO Z for k := 0 to pCnt - 1 do begin p := Face.Points[k]; if Face.RecType <> ftNet3DSObject then Face.Points[k] := DoublePoint(p.x, p.y, p.z + FZOrder * UOMToMetre(1000 / GCadForm.PCad.MapScale)) else Face.Points[k] := DoublePoint(p.x, p.y + FZOrder * UOMToMetre(1000 / GCadForm.PCad.MapScale) * Factor, p.z); 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); glObject1.Tag := Integer(Face.FFigure); //29.03.2011 if (TOrthoLine(Face.FFigure).Name = cudUpDownCaption) or (TOrthoLine(Face.FFigure).Name = cCadClasses_Mes25) then begin TGLSpaceText(glObject1).Text := {$IF Defined(SCS_PE)} 'Raise' {$ELSE} 'С/П' {$IFEND} + inttostr(TOrthoLine(Face.FFigure).FIndex); TGLSpaceText(glObject1).Scale.X := 0.2; TGLSpaceText(glObject1).Scale.y := 0.2; TGLSpaceText(glObject1).Scale.z := 0.2; end else begin TGLSpaceText(glObject1).Text := TOrthoLine(Face.FFigure).Name + inttostr(TOrthoLine(Face.FFigure).FIndex); TGLSpaceText(glObject1).Scale.X := 0.4; TGLSpaceText(glObject1).Scale.y := 0.4; TGLSpaceText(glObject1).Scale.z := 0.4; end; TGLSpaceText(glObject1).Position.x := p.x*factor; TGLSpaceText(glObject1).Position.z := p.z*factor; if Face.Points[0].z = Face.Points[1].z then TGLSpaceText(glObject1).Position.y := (p.y + 2) * factor else TGLSpaceText(glObject1).Position.y := (p.y - 2) * factor; TGLSpaceText(glObject1).Extrusion := 0.05; TGLSpaceText(glObject1).Font.Color := clRed; TGLSpaceText(glObject1).Material.FrontProperties.Diffuse.Color := clrRed; TGLSpaceText(glObject1).Material.BackProperties.Diffuse.Color := clrRed; // with TGLSceneObject(glObject).Material do begin BackProperties.Ambient.AsWinColor:= Face.Color; BackProperties.Diffuse.AsWinColor := Face.Color; BackProperties.Emission.AsWinColor := Face.Color; FrontProperties.Ambient.AsWinColor := Face.Color; FrontProperties.Diffuse.AsWinColor := Face.Color; FrontProperties.Emission.AsWinColor := Face.Color; end; 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); if xSide <> nil then xSide.FGLPoints[k] := p; end; with TGLSceneObject(glObject).Material do begin aColor := clrNewTan; BackProperties.Ambient.Color := aColor; BackProperties.Diffuse.Color := aColor; BackProperties.Emission.Color := aColor; FrontProperties.Ambient.Color := aColor; FrontProperties.Diffuse.Color := aColor; FrontProperties.Emission.Color := aColor; Texture.texturemode := tmDecal; Texture.Disabled := False; ImgName := GetImageFileByHash(xSide.FTextureHash); if ImgName <> '' then begin 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.FTextureRotate, xSide.FMirror); end; // ********************** NETPATHs ***************************************** // ********************** NETDOORs ***************************************** if Face.RecType = ftNetDoor then begin for k := 0 to pCnt - 1 do begin p := Face.Points[k]; p := DoublePoint(p.x, p.z, p.y); p1 := Face.Points[1]; p1 := DoublePoint(p1.x, p1.z, p1.y); p.x := p.x * factor; if (p.y < 0.011) then begin if (p.y <> p1.y) then p.y := p.y * factor else p.y := p.y * factor + FDeltaZSlope end else p.y := p.y * factor; p.z := p.z * factor; glDoorSide.AddNode(p.x, p.y, p.z); xSide.FGLPoints[k] := p; end; with TGLSceneObject(glObject).Material do begin aColor := clrTan; BackProperties.Ambient.Color := aColor; BackProperties.Diffuse.Color := aColor; BackProperties.Emission.Color := aColor; FrontProperties.Ambient.Color := aColor; FrontProperties.Diffuse.Color := aColor; FrontProperties.Emission.Color := aColor; MaterialOptions := [moNoLighting]; end; end; // ********************** NETDOORs ***************************************** // ********************** NETWINDOWs *************************************** if Face.RecType = ftNetWindow then begin for k := 0 to pCnt - 1 do begin p := Face.Points[k]; p := DoublePoint(p.x, p.z, p.y); p1 := Face.Points[1]; p1 := DoublePoint(p1.x, p1.z, p1.y); p.x := p.x * factor; //if (p.y < 0.011) then //begin // if (p.y <> p1.y) then // p.y := p.y * factor // else // p.y := p.y * factor + FDeltaZSlope //end //else p.y := p.y * factor; p.z := p.z * factor; glWindowSide.AddNode(p.x, p.y, p.z); xSide.FGLPoints[k] := p; end; with TGLSceneObject(glObject).Material do begin aColor := clrSilver; BackProperties.Ambient.Color := aColor; BackProperties.Diffuse.Color := aColor; BackProperties.Emission.Color := aColor; FrontProperties.Ambient.Color := aColor; FrontProperties.Diffuse.Color := aColor; FrontProperties.Emission.Color := aColor; MaterialOptions := [moNoLighting]; end; end; // ********************** NETWINDOWs *************************************** // ********************** NETBALCONs *************************************** if Face.RecType = ftNetBalconDoor then begin for k := 0 to pCnt - 1 do begin p := Face.Points[k]; p := DoublePoint(p.x, p.z, p.y); p1 := Face.Points[1]; p1 := DoublePoint(p1.x, p1.z, p1.y); p.x := p.x * factor; if (p.y < 0.011) then begin if (p.y <> p1.y) then p.y := p.y * factor else p.y := p.y * factor + FDeltaZSlope end else p.y := p.y * factor; p.z := p.z * factor; glBalconDoorSide.AddNode(p.x, p.y, p.z); xSide.FGLPoints[k] := p; end; with TGLSceneObject(glObject).Material do begin aColor := clrGray80; BackProperties.Ambient.Color := aColor; BackProperties.Diffuse.Color := aColor; BackProperties.Emission.Color := aColor; FrontProperties.Ambient.Color := aColor; FrontProperties.Diffuse.Color := aColor; FrontProperties.Emission.Color := aColor; MaterialOptions := [moNoLighting]; end; end; if Face.RecType = ftNetBalconWindow then begin for k := 0 to pCnt - 1 do begin p := Face.Points[k]; p := DoublePoint(p.x, p.z, p.y); p1 := Face.Points[1]; p1 := DoublePoint(p1.x, p1.z, p1.y); p.x := p.x * factor; //if (p.y < 0.011) then //begin // if (p.y <> p1.y) then // p.y := p.y * factor // else // p.y := p.y * factor + FDeltaZSlope //end //else p.y := p.y * factor; p.z := p.z * factor; glBalconWindowSide.AddNode(p.x, p.y, p.z); xSide.FGLPoints[k] := p; end; with TGLSceneObject(glObject).Material do begin aColor := clrSilver; BackProperties.Ambient.Color := aColor; BackProperties.Diffuse.Color := aColor; BackProperties.Emission.Color := aColor; FrontProperties.Ambient.Color := aColor; FrontProperties.Diffuse.Color := aColor; FrontProperties.Emission.Color := aColor; MaterialOptions := [moNoLighting]; end; end; // ********************** NETBALCONs *************************************** // ********************** NETFLOOR ***************************************** {TODO} (* 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 + FDeltaZFloor; //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); {TODO} p := DoublePoint(p.x * factor, p.z * factor + FDeltaZFloor, p.y * factor); {TODO} glFloor.AddNode(p.x, p.y, p.z); xSide.FGLPoints[k] := p; end; xSide.FZOrder := xSide.FZOrder + FDeltaZFloor; with TGLSceneObject(glObject).Material do begin aColor := clrSilver; BackProperties.Ambient.Color := aColor; BackProperties.Diffuse.Color := aColor; BackProperties.Emission.Color := aColor; FrontProperties.Ambient.Color := aColor; FrontProperties.Diffuse.Color := aColor; FrontProperties.Emission.Color := aColor; Texture.texturemode := tmDecal; Texture.Disabled := False; ImgName := GetImageFileByHash(xSide.FTextureHash); if ImgName <> '' then begin Texture.Image.LoadFromFile(ImgName); end else begin Texture.Image.LoadFromFile(ExeDir + '\3DTextures\floor.bmp'); end; end; RotateTextureToAngleP(xSide, GLFloor, xSide.FTextureRotate, 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; xSide.FZOrder := xSide.FZOrder + FDeltaZ; { for k := 0 to pCnt - 1 do begin p := Face.Points[k]; p := DoublePoint(p.x * factor, p.z * factor, p.y * factor + FDeltaZ); glCeiling.AddNode(p.x, p.y, p.z); xSide.FGLPoints[k] := p; end; } with TGLSceneObject(glObject).Material do begin aColor := clrSilver; BackProperties.Ambient.Color := aColor; BackProperties.Diffuse.Color := aColor; BackProperties.Emission.Color := aColor; FrontProperties.Ambient.Color := aColor; FrontProperties.Diffuse.Color := aColor; FrontProperties.Emission.Color := aColor; Texture.texturemode := tmDecal; Texture.Disabled := False; ImgName := GetImageFileByHash(xSide.FTextureHash); if ImgName <> '' then begin Texture.Image.LoadFromFile(ImgName); end else begin Texture.Image.LoadFromFile(ExeDir + '\3DTextures\ceiling.bmp'); end; end; RotateTextureToAngleP(xSide, GLCeiling, xSide.FTextureRotate, xSide.FMirror); end; // ********************** NETCEILING *************************************** // ********************** NET3DSObject ************************************* if Face.RecType = ftNet3DSObject then begin gl3DSObject.Material.Texture.Disabled := False; try // на поднятии подменяем на текущий savedir! { if FileExists(ExeDir + '\' + dnSave + '\' + ExtractFileName(xObject.FPath)) then xObject.FPath := ExeDir + '\' + dnSave + '\' + ExtractFileName(xObject.FPath) else begin // если нет такого знач просто буковку текущего диска подставим. xObject.FPath := copy(ExeDir, 1, 1) + copy(xObject.FPath, 2, $FFFF); end; } ImgName := GetObjectFileByHash(xObject.FObjectHash); if ImgName <> '' then begin gl3DSObject.MaterialLibrary := MatLib; FTextures.Clear; FisCreate3DS := False; FCurrObject := xObject; gl3DSObject.LoadFromFile(ImgName); for k := 0 to MatLib.Materials.Count - 1 do MatLib.Materials[k].Material.Texture.MappingMode := tmmCubeMapCamera; for k := 0 to pCnt - 1 do begin p := Face.Points[k]; gl3DSObject.Position.x := p.x; gl3DSObject.Position.y := p.y; gl3DSObject.Position.z := p.z; end; gl3DSObject.Scale.x := xObject.FScale.x; gl3DSObject.Scale.y := xObject.FScale.y; gl3DSObject.Scale.z := xObject.FScale.z; Rotate3DSObj(gl3DSObject, xObject.FRotate.x, xObject.FRotate.y, xObject.FRotate.z); //gl3DSObject.PitchAngle := xObject.FRotate.x; //gl3DSObject.TurnAngle := xObject.FRotate.y; //gl3DSObject.RollAngle := xObject.FRotate.z; with gl3DSObject.Material do begin if Texture.Disabled then begin FrontProperties.Ambient.Color := ObjColor; FrontProperties.Diffuse.Color := ObjColor; FrontProperties.Emission.Color := ObjColor; BackProperties.Ambient.Color := ObjColor; BackProperties.Diffuse.Color := ObjColor; BackProperties.Emission.Color := ObjColor; end; end; gl3DSObject.Material.MaterialOptions := []; gl3DSObject.Material.Texture.Disabled := False; // gl3DSObject.BuildOctree; // - тормоза // LOAD texture from Hash ImgName1 := GetImageFileByHash(xObject.FTextureHash); if ImgName1 <> '' then begin gl3DSObject.MaterialLibrary := nil; gl3DSObject.Material.Texture.Image.LoadFromFile(ImgName1); gl3DSObject.Material.Texture.MappingMode := tmmCubeMapCamera; end end; except end; end; // ********************** NET3DSObject ************************************* with TGLSceneObject(glObject).Material do begin if (Face.Trans) or (face.OpTrans) then begin BlendingMode := bmTransparency; BackProperties.Diffuse.Alpha := 0.4; FrontProperties.Diffuse.Alpha := 0.4; end; end; if Face.RecType = ftPipe then begin {$IF Defined(ES_GRAPH_SC)} glPipe.Radius := 0; {$ELSE} glPipe.Radius := Face.Size; {$IFEND} glPipe.Parts := [ppOutSide,ppInSide,ppStartDisk,ppStopDisk]; end else if Face.RecType = ftBar then begin glPipe.Radius := 0.06; end else if Face.RecType = ftSphere then begin glSphere.Radius := Face.Size * factor; end else if Face.RecType = ftCenterCube then begin end else begin end; end; //// *********** FACES.COUNT ************************************************* //GCadForm.FActiveNet; // Factor := 0.15; 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; //Alex(20.12.2010) FirstCameraPosIsSet := False; try if F3DModel.FRooms.Count > 0 then begin xRoom := T3DRoom(F3DModel.FRooms[0]); if ((xRoom.FFloor <> nil) and (xRoom.FCeiling <> nil)) then begin GetRoomBounds(RoomMin, RoomMax, xRoom.FFloor.FGLPoints, xRoom.FCeiling.FGLPoints); RoomSize.x := abs(RoomMax.x - RoomMin.x); RoomSize.y := abs(RoomMax.y - RoomMin.y); RoomSize.z := abs(RoomMax.z - RoomMin.z); SetPos.x := abs(RoomMax.x + RoomMin.x) / 2; SetPos.y := abs(RoomMax.y + RoomMin.y) / 2; SetPos.z := abs(RoomMax.z + RoomMin.z) / 2; FirstCameraPosIsSet := True; end else FirstCameraPosIsSet := False; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.sbFirstFaceClick', E.Message); end; if not FirstCameraPosIsSet then begin SetPos.x := 0; SetPos.y := 2.7; SetPos.z := 0; FirstCameraPosIsSet := True; end; FirstPerson.Position.X := SetPos.x; FirstPerson.Position.Y := SetPos.y; FirstPerson.Position.Z := SetPos.z; //-- // Камера в перспективный вид glCamera.CameraStyle := csPerspective; GLCamera.FocalLength := 160; if Factor > 0.15 then begin GLCamera.DepthOfView := Trunc(100 * Factor / 0.15); FirstPersonCamera.DepthOfView := Trunc(100 * Factor / 0.15); end; lbViewType.Caption := cForm3D_Mes3; AfterUpdate; except on E: Exception do AddExceptionToLogEx('Form3d.UpdateFaces', E.Message); end; end; procedure Tfrm3D.SetCubeBounds(var glCube: TGLCube; Points: T3dPointArray; Factor:Double); var p1,p2,p3,p4,p5: T3DPoint; px,py,pz: Double; len,w,h: Double; mp,xp1,xp2: TDoublePoint; mp3: T3dPoint; begin p1 := Points[0]; p2 := Points[1]; p3 := Points[2]; p4 := Points[3]; p5 := Points[4]; xp1 := DoublePOint(p1.x,p1.y); xp2 := DoublePOint(p3.x,p3.y); mp := MPoint(xp1,xp2); pz := (p1.z+p5.z) /2; mp3 := DoublePOint(mp,pz); xp1 := DoublePoint(p1.x,p1.y); xp2 := DoublePoint(p2.x,p2.y); len := GetLineLenght(xp1,xp2); xp1 := DoublePoint(p1.x,p1.y); xp2 := DoublePoint(p4.x,p4.y); w := GetLineLenght(xp1,xp2); h := abs(p1.z-p5.z); glCube.Position.X := mp3.x*factor; glCube.Position.Y := mp3.z*factor; glCube.Position.Z := mp3.y*factor; glCube.CubeWidth := h*factor; glCube.CubeDepth := w*factor; glCube.CubeHeight := len*factor; end; procedure Tfrm3D.SpeedButton1Click(Sender: TObject); begin glCamera.CameraStyle := csPerspective; GLCamera.FocalLength := 160; GLSceneViewer.Camera := GLCamera; GLLightFirstPerson.Shining := False; Light.Shining := True; lbViewType.Caption := cForm3D_Mes3; end; procedure Tfrm3D.SpeedButton2Click(Sender: TObject); begin glCamera.CameraStyle := csOrthogonal; GLCamera.FocalLength := 1.7; GLSceneViewer.Camera := GLCamera; lbViewType.Caption := cForm3D_Mes4; GLLightFirstPerson.Shining := False; Light.Shining := True; 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); LoadSelectionData; GLCadencer.Enabled := True; end; procedure Tfrm3D.GLHeightField1GetHeight(const x, y: Single; var z: Single; var color: TVector4f; var texPoint: TTexPoint); begin z := 0; end; procedure Tfrm3D.FormMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); var s: Single; shiftDown : Boolean; ctrlDown : Boolean; i: integer; Res1: TWinControl; Pt: TPoint; glObject: TGLFreeForm; pScale: Double; begin pScale := 0.1; // 10% pScale := WheelDelta / 120 * pScale; GetCursorPos(Pt); Res1 := FindControl(WindowFromPoint(Pt)); if (Res1 = nil) or (Res1.name <> 'GLSceneViewer') then exit; shiftDown := (IsKeyDown(VK_LShift) or IsKeyDown(VK_RSHIFT)); ctrlDown := (IsKeyDown(VK_LCONTROL) or IsKeyDown(VK_RCONTROL)); if ctrlDown then begin if (FSelection.Count = 1) and is3DSObject(TGLBaseSceneObject(FSelection[0])) then begin glObject := TGLFreeForm(FSelection[0]); if WheelDelta < 0 then begin if glObject.Scale.X >= 0.01 then begin glObject.Scale.X := glObject.Scale.X + glObject.Scale.X * pScale; glObject.Scale.Y := glObject.Scale.Y + glObject.Scale.Y * pScale; glObject.Scale.Z := glObject.Scale.Z + glObject.Scale.Z * pScale; end; end else begin glObject.Scale.X := glObject.Scale.X + glObject.Scale.X * pScale; glObject.Scale.Y := glObject.Scale.Y + glObject.Scale.Y * pScale; glObject.Scale.Z := glObject.Scale.Z + glObject.Scale.Z * pScale; end; edScaleX.Text := FloatToStr(glObject.Scale.X); edScaleY.Text := FloatToStr(glObject.Scale.Y); edScaleZ.Text := FloatToStr(glObject.Scale.Z); T3DSObject(TTreeNode(glObject.TagObject).Data).FScale := DoublePoint(glObject.Scale.X, glObject.Scale.Y, glObject.Scale.Z); end else begin for i := 0 to DummyCube.Count - 1 do begin if shiftdown then begin if DummyCube.Children[i].ClassName = 'TGLSpaceText' then begin if WheelDelta < 0 then begin if DummyCube.Children[i].Scale.X >= 0.01 then begin DummyCube.Children[i].Scale.X := DummyCube.Children[i].Scale.X + WheelDelta / 24000; DummyCube.Children[i].Scale.Y := DummyCube.Children[i].Scale.Y + WheelDelta / 24000; DummyCube.Children[i].Scale.Z := DummyCube.Children[i].Scale.Z + WheelDelta / 24000; end; end else begin DummyCube.Children[i].Scale.X := DummyCube.Children[i].Scale.X + WheelDelta / 24000; DummyCube.Children[i].Scale.Y := DummyCube.Children[i].Scale.Y + WheelDelta / 24000; DummyCube.Children[i].Scale.Z := DummyCube.Children[i].Scale.Z + WheelDelta / 24000; end; end; end else begin {$IF Defined(ES_GRAPH_SC)} {$ELSE} if DummyCube.Children[i].ClassName = 'TGLFreeForm' then begin if WheelDelta < 0 then begin if DummyCube.Children[i].Scale.X >= 0.01 then begin DummyCube.Children[i].Scale.X := DummyCube.Children[i].Scale.X + WheelDelta / 24000; DummyCube.Children[i].Scale.Y := DummyCube.Children[i].Scale.Y + WheelDelta / 24000; DummyCube.Children[i].Scale.Z := DummyCube.Children[i].Scale.Z + WheelDelta / 24000; end; end else begin DummyCube.Children[i].Scale.X := DummyCube.Children[i].Scale.X + WheelDelta / 24000; DummyCube.Children[i].Scale.Y := DummyCube.Children[i].Scale.Y + WheelDelta / 24000; DummyCube.Children[i].Scale.Z := DummyCube.Children[i].Scale.Z + WheelDelta / 24000; end; end; {$IFEND} end; end; end; end else begin //Alex(17.12.2010) Откл изменения FocalLength при виде от первого лица if GLSceneViewer.Camera = FirstPersonCamera then begin if WheelDelta > 0 then FirstPersonCamera.FocalLength := FirstPersonCamera.FocalLength + 5 else FirstPersonCamera.FocalLength := FirstPersonCamera.FocalLength - 5; end; if GLSceneViewer.Camera <> FirstPersonCamera then begin s := GLSceneViewer.Camera.FocalLength; if shiftdown then begin if GLSceneViewer.Camera.CameraStyle = csPerspective then GLSceneViewer.Camera.FocalLength := s + WheelDelta / 80 else GLSceneViewer.Camera.FocalLength := s + WheelDelta / 2420; end else begin if GLSceneViewer.Camera.CameraStyle = csPerspective then GLSceneViewer.Camera.FocalLength := s + WheelDelta / 20 else GLSceneViewer.Camera.FocalLength := s + WheelDelta / 540; end; end; end end; procedure Tfrm3D.SpeedButton3Click(Sender: TObject); var Save3D: TSaveDialog; Jpeg: TJPEGImage; Bmp: TBitmap; BmpFileName: string; bmpx, bmpy: Integer; begin try {$IF Defined(ES_GRAPH_SC)} if GLSceneViewer.Camera = FirstPersonCamera then begin ShowMessage('Недоступно в режиме просмотра "От первого лица"!'); Exit; end; {$ELSE} if GLSceneViewer.Camera.CameraStyle = csPerspective then begin ShowMessage(cForm3D_Mes2); Exit; end; {$IFEND} Save3D := TSaveDialog.Create(nil); with Save3D do begin InitialDir := GetEXEDir; Title := cForm3D_Mes1; Filter := '(*.jpg)|*.jpg'; DefaultExt := '*.jpg'; FileName := ''; Options := [ofReadOnly,ofHideReadOnly,ofPathMustExist,ofFileMustExist,ofNoDereferenceLinks]; end; if Save3D.Execute then begin if frm3D_Save.ShowModal = mrOk then begin Bmp := TBitmap.Create; Jpeg := TJPEGImage.Create; BmpFileName := ChangeFileExt(Save3D.FileName, '.bmp'); if frm3D_Save.rbLow.Checked then begin GLSceneViewer.Buffer.RenderToFile(BmpFileName, 300); end; if frm3D_Save.rbNormal.Checked then begin bmpx := GLSceneViewer.Buffer.Width * 2; bmpy := GLSceneViewer.Buffer.Height * 2; GLSceneViewer.Buffer.RenderToFile(BmpFileName, bmpx, bmpy); end; if frm3D_Save.rbHigh.Checked then begin bmpx := GLSceneViewer.Buffer.Width * 3; bmpy := GLSceneViewer.Buffer.Height * 3; GLSceneViewer.Buffer.RenderToFile(BmpFileName, bmpx, bmpy); end; Bmp.LoadFromFile(BmpFileName); ConvertBMPToJpeg(Bmp, BmpFileName); FreeAndNil(Bmp); DeleteFile(BmpFileName); end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.SpeedButton3Click', E.Message); end; end; procedure Tfrm3D.cbViewCeilingClick(Sender: TObject); var i: integer; xNode: TTreeNode; begin try for i := 0 to DummyCube.Count - 1 do begin if (DummyCube.Children[i].TagObject <> nil) then begin xNode := TTreeNode(DummyCube.Children[i].TagObject); // включить/выключить потолок и пол if cbViewCeiling.Checked then begin if T3dSide(xNode.Data).FFaceType = ftNetCeiling then begin if xNode <> nil then begin if xNode.ImageIndex < 1000 then DummyCube.Children[i].Visible := True; end else DummyCube.Children[i].Visible := True; end; if T3dSide(xNode.Data).FFaceType = ftNetFloor then begin if xNode <> nil then begin if xNode.ImageIndex < 1000 then DummyCube.Children[i].Visible := True; end else DummyCube.Children[i].Visible := True; end; end else begin if T3dSide(xNode.Data).FFaceType = ftNetCeiling then DummyCube.Children[i].Visible := False; if T3dSide(xNode.Data).FFaceType = ftNetFloor then DummyCube.Children[i].Visible := False; end; 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, xListNode, xRoomNode, xCeilingNode, xFloorNode, xWallNode, xWallElementNode, xBalconElementNode, xSlopeNode, xSideNode, xNode: TTreeNode; xRoom: T3DRoom; xWall: T3DWall; xWallElement: T3DWallElement; xBalconElement: T3DBalconElement; xSlope: T3DSlope; xSide: T3DSide; Str: string; begin try // 2011-05-10 ModelTree.Items.Clear; xModelNode := ModelTree.Items.GetFirstNode; // добавить лист Str := GCadForm.FCADListName + ' ' + IntToStr(GCadForm.FCADListIndex); xListNode:= ModelTree.Items.AddChild(xModelNode, Str); xListNode.Data := GCadForm; xListNode.ImageIndex := 1; // распарсить комнаты for i := 0 to F3DModel.FRooms.Count - 1 do begin xRoom := T3DRoom(F3DModel.FRooms[i]); if (xRoom.FListID <> GCadForm.FCADListID) or (not xRoom.FVisible) then continue; xRoomNode:= ModelTree.Items.AddChild(xListNode, 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, xListNode, 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; FName: string; Str: string; begin try // 2011-05-10 ModelTree.Items.Clear; xModelNode := ModelTree.Items.GetFirstNode; CopyModelHash; // добавить лист Str := GCadForm.FCADListName + ' ' + IntToStr(GCadForm.FCADListIndex); xListNode:= ModelTree.Items.AddChild(xModelNode, Str); xListNode.Data := GCadForm; xListNode.ImageIndex := 1; // распарсить комнаты for i := 0 to F3DModel.FRooms.Count - 1 do begin xRoom := T3DRoom(F3DModel.FRooms[i]); if (xRoom.FListID <> GCadForm.FCADListID) or (not xRoom.FVisible) then continue; xStrRoom := T3DRoom(getModelObjectByComponID(xRoom.FSCSComponID)); xRoomNode:= ModelTree.Items.AddChild(xListNode, xRoom.FName); xRoomNode.Data := xRoom; xRoomNode.ImageIndex := 47; // добавить потолок в комнату 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 FName := GetObjectFileByHash(T3DSObject(xStrRoom.F3DSObjects[j]).FObjectHash); if FileExists(FName) then begin xStrObject := T3DSObject(xStrRoom.F3DSObjects[j]); xObject := CopyObjectProperties(nil, xStrObject); xNode := ModelTree.Items.AddChild(xRoomNode, xObject.FName); xNode.Data := xObject; xNode.ImageIndex := 42; xObject.FFace.FTreeNode := xNode; Faces.Add(xObject.FFace); xObject.FParent := xRoom; xRoom.F3DSObjects.Add(xObject); end; end; end; // распарсить стены каждой комнаты for j := 0 to xRoom.FWalls.Count - 1 do begin xWall := T3DWall(xRoom.FWalls[j]); xStrWall := T3DWall(getModelObjectByComponID(xWall.FSCSComponID)); xWallNode:= ModelTree.Items.AddChild(xRoomNode, xWall.FName); xWallNode.Data := xWall; xWallNode.ImageIndex := 49; // распарсить элементы каждой стены 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.Text := aStrSide.FDescription.Text; xSide.FFaceType := aStrSide.FFaceType; xSide.FWallType := aStrSide.FWallType; xSide.FSideType := aStrSide.FSideType; xSide.FColor := aStrSide.FColor; xSide.FTextureRotate := aStrSide.FTextureRotate; xSide.FTextureScale := aStrSide.FTextureScale; xSide.FMirror := aStrSide.FMirror; xSide.FTextureHash := aStrSide.FTextureHash; xSide.FTexture_ext := aStrSide.FTexture_ext; SetLength(xSide.FPoints, Length(aStrSide.FPoints)); for i := 0 to Length(aStrSide.FPoints) - 1 do begin xSide.FPoints[i].x := aStrSide.FPoints[i].x; xSide.FPoints[i].y := aStrSide.FPoints[i].y; xSide.FPoints[i].z := aStrSide.FPoints[i].z; end; SetLength(xSide.FGLPoints, Length(aStrSide.FGLPoints)); for i := 0 to Length(aStrSide.FGLPoints) - 1 do begin xSide.FGLPoints[i].x := aStrSide.FGLPoints[i].x; xSide.FGLPoints[i].y := aStrSide.FGLPoints[i].y; xSide.FGLPoints[i].z := aStrSide.FGLPoints[i].z; end; SetLength(xSide.FFace.Points, Length(xSide.FPoints)); for i := 0 to Length(xSide.FPoints) - 1 do xSide.FFace.Points[i] := xSide.FPoints[i]; except on E: Exception do AddExceptionToLogEx('Tfrm3D.CopySideProperties', E.Message); end; end; function Tfrm3D.CopySubSideProperties(aStrSubSide: T3DSide): T3DSide; var i, j: integer; xSide: T3DSide; Points: T3DPointArray; begin try Result := nil; xSide := T3DSide.Create(aStrSubSide.FFaceType, aStrSubSide.FWallType, aStrSubSide.FSideType, aStrSubSide.FParent); xSide.FName := aStrSubSide.FName; xSide.FDescription.Text := aStrSubSide.FDescription.Text; xSide.FColor := aStrSubSide.FColor; xSide.FTextureRotate := aStrSubSide.FTextureRotate; xSide.FTextureScale := aStrSubSide.FTextureScale; xSide.FMirror := aStrSubSide.FMirror; xSide.FTextureHash := aStrSubSide.FTextureHash; xSide.FTexture_ext := aStrSubSide.FTexture_ext; SetLength(xSide.FPoints, Length(aStrSubSide.FPoints)); for i := 0 to Length(aStrSubSide.FPoints) - 1 do begin xSide.FPoints[i].x := aStrSubSide.FPoints[i].x; xSide.FPoints[i].y := aStrSubSide.FPoints[i].y; xSide.FPoints[i].z := aStrSubSide.FPoints[i].z; end; SetLength(xSide.FGLPoints, Length(aStrSubSide.FGLPoints)); for i := 0 to Length(aStrSubSide.FGLPoints) - 1 do begin xSide.FGLPoints[i].x := aStrSubSide.FGLPoints[i].x; xSide.FGLPoints[i].y := aStrSubSide.FGLPoints[i].y; xSide.FGLPoints[i].z := aStrSubSide.FGLPoints[i].z; end; xSide.FFace := TFaceRecord.Create(xSide.FPoints, clGray, xSide.FFaceType, 1, False, nil); xSide.FFace.FFaceWallType := xSide.FWallType; xSide.FFace.FWallSideType := xSide.FSideType; Result := xSide; except on E: Exception do AddExceptionToLogEx('Tfrm3D.CopySubSideProperties', E.Message); end; end; function Tfrm3D.CopyObjectProperties(aObject, aStrObject: T3DSObject): T3DSObject; var i, j: integer; xObject: T3DSObject; Points: T3DPointArray; begin try Result := nil; xObject := aObject; if xObject = nil then begin xObject := T3DSObject.Create(aStrObject.FParent); xObject.FName := aStrObject.FName; xObject.FDescription.Text := aStrObject.FDescription.Text; xObject.FObjectHash := aStrObject.FObjectHash; xObject.FTextureHash := aStrObject.FTextureHash; xObject.FTexture_ext := aStrObject.FTexture_ext; xObject.FPosition := aStrObject.FPosition; xObject.FScale := aStrObject.FScale; xObject.FRotate := aStrObject.FRotate; for i := 0 to aStrObject.FFiles.Count - 1 do xObject.FFiles.Add(aStrObject.FFiles[i]); for i := 0 to aStrObject.FHashs.Count - 1 do xObject.FHashs.Add(aStrObject.FHashs[i]); SetLength(Points, 1); Points[0].x := xObject.FPosition.x; Points[0].y := xObject.FPosition.y; Points[0].z := xObject.FPosition.z; xObject.FFace := TFaceRecord.Create(Points, clGray, ftNet3DSObject, 1, False, nil); Result := xObject; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.CopyObjectProperties', E.Message); end; end; procedure Tfrm3D.GLSceneViewerDblClick(Sender: TObject); var i, j: integer; Obj: TGLBaseSceneObject; Mesh: TGLMesh; Polygon: TGLPolygon; xNode: TTreeNode; xNodes: TList; isExists: boolean; ctrlDown: boolean; begin if GLSceneViewer.Camera = FirstPersonCamera then exit; try Obj := GlsceneViewer.Buffer.GetPickedobject(mx, my); if Obj <> nil then begin if (Obj is TGLPolygon) or (Obj is TGLFreeForm) then begin xNodes := TList.create; ctrlDown := (IsKeyDown(VK_LCONTROL) or IsKeyDown(VK_RCONTROL)); if (Obj.TagObject <> nil) then begin for i := 0 to ModelTree.SelectionCount - 1 do begin xNode := ModelTree.Selections[i]; if TObject(xNode.Data) is T3DSObject then ctrlDown := False; if TObject(xNode.Data).ClassName <> TObject(TTreeNode(Obj.TagObject).Data).ClassName then ctrlDown := False; end; if ctrlDown and (Obj is TGLPolygon) then begin xNode := TTreeNode(Obj.TagObject); //ModelTree.Select(xNode); //xNodes.Add(xNode); isExists := False; for i := 0 to ModelTree.SelectionCount - 1 do begin xNode := ModelTree.Selections[i]; if TTreeNode(Obj.TagObject) = xNode then begin isExists := True; if Not xNode.Selected then xNodes.Add(xNode); end else xNodes.Add(xNode); end; if Not isExists then xNodes.Add(TTreeNode(Obj.TagObject)); ModelTree.ClearSelection; for i := 0 to xNodes.Count - 1 do begin xNode := TTreeNode(xNodes.Items[i]); xNode.Selected := True; end; OnSelectNodes(xNodes); end else begin xNode := TTreeNode(Obj.TagObject); ModelTree.Select(xNode); xNodes.Add(xNode); OnSelectNodes(xNodes); end; end; end else DeselectGLObjects; 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; ClearSelected: boolean; begin try if ModelTree.Selected <> nil then begin ClearSelected := False; for i := 0 to ModelTree.SelectionCount - 1 do begin xNode := ModelTree.Selections[i]; if TObject(xNode.Data) is T3DSObject then ClearSelected := True; if TObject(xNode.Data).ClassName <> TObject(ModelTree.Selected.Data).ClassName then ClearSelected := True; end; if ClearSelected then begin xNode := ModelTree.Selected; ModelTree.ClearSelection; xNode.Selected := True; end; xNodes := TList.create; for i := 0 to ModelTree.SelectionCount - 1 do begin xNode := ModelTree.Selections[i]; xNodes.Add(xNode); end; OnSelectNodes(xNodes); end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.ModelTreeClick', E.Message); end; end; procedure Tfrm3D.OnSelectNodes(aNodes: TList); var i: Integer; xNode: TTreeNode; xObjects: TList; begin try // найти все обьекты с Нодов xObjects := FindGLObjectsByNodes(aNodes); FNodes.Clear; for i := 0 to aNodes.Count - 1 do FNodes.Add(aNodes.Items[i]); if not Assigned(TimerOnSelectNodes.OnTimer) then begin FxObjects.Clear; for i := 0 to xObjects.Count - 1 do FxObjects.Add(xObjects.Items[i]); TimerOnSelectNodes.OnTimer := TimerOnSelectNodesTimer; TimerOnSelectNodes.Tag := 1; TimerOnSelectNodes.Enabled := True; end; { DeselectGLObjects; // Select objects SelectGLObjects(xObjects); } // Show Properties except on E: Exception do AddExceptionToLogEx('Tfrm3D.OnSelectNodes', E.Message); end; end; procedure Tfrm3D.FormCreate(Sender: TObject); begin FSelection := TList.Create; FxObjects := TList.Create; FNodes := TList.Create; FPropObjects := TList.create; FPropRecord := TPropRecord.Create; {$IF Defined(ES_GRAPH_SC)} panProps.Height := 350; {$IFEND} FMovedObject := nil; FRotatedObject := nil; SelObjColor := clrDarkWood; // clrLightWood; ObjColor := clrDarkBrown; // clrDarkWood; FFileStream := ''; //13.12.2010 FIdsStream := TIntList.Create; FFilesStream := TStringList.Create; FTextures := TStringList.Create; //Alex behav:= GetFPSMovement(FirstPerson); 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.Clear; for i := 0 to aObjects.Count - 1 do FSelection.Add(aObjects.Items[i]); for i := 0 to FSelection.Count - 1 do begin xObj := TGLBaseSceneObject(FSelection[i]); if (xObj is TGLPolygon) then begin TGLPolygon(xObj).Material.Texture.ImageGamma := 1.5; TGLPolygon(xObj).Material.MaterialOptions := []; end; if (xObj is TGLFreeForm) then begin with TGLFreeForm(xObj).Material do begin if (TGLFreeForm(xObj).Material.MaterialOptions = []) and (TGLFreeForm(xObj).Material.Texture.Disabled = False) then begin TGLFreeForm(xObj).Material.MaterialOptions := [moNoLighting]; TGLFreeForm(xObj).Material.Texture.Disabled := True; end else begin BackProperties.Ambient.Color := SelObjColor; BackProperties.Diffuse.Color := SelObjColor; BackProperties.Emission.Color := SelObjColor; FrontProperties.Ambient.Color := SelObjColor; FrontProperties.Diffuse.Color := SelObjColor; FrontProperties.Emission.Color := SelObjColor; end; end; end; end; except on E: Exception do AddExceptionToLogEx('', E.Message); end; end; procedure Tfrm3D.DeselectGLObjects; begin if not Assigned(TimerOnSelectNodes.OnTimer) then begin TimerOnSelectNodes.OnTimer := TimerOnSelectNodesTimer; TimerOnSelectNodes.Tag := 0; TimerOnSelectNodes.Enabled := True; end; end; procedure Tfrm3D.DeselectGLObjectsT; var i: integer; xObj: TGLBaseSceneObject; 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 if (TGLFreeForm(xObj).Material.MaterialOptions = [moNoLighting]) and (TGLFreeForm(xObj).Material.Texture.Disabled = True) then begin TGLFreeForm(xObj).Material.MaterialOptions := []; TGLFreeForm(xObj).Material.Texture.Disabled := False; end else begin BackProperties.Ambient.Color := ObjColor; BackProperties.Diffuse.Color := ObjColor; BackProperties.Emission.Color := ObjColor; FrontProperties.Ambient.Color := ObjColor; FrontProperties.Diffuse.Color := ObjColor; FrontProperties.Emission.Color := ObjColor; end; end; end; end; FSelection.Clear; SetAllPanels(False); 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); panSideTexture.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); panSideTexture.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); panObjectTexture.Visible := True; 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); panObjectTexture.Visible := True; 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) then begin Result.Add(xNode); end else if TObject(xNode.Data) is T3DSObject then begin Result.Add(xNode); end 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); if (TObject(CurrNode.Data) is T3DSObject) then Result.Add(CurrNode); StepGetAllChildNodes(CurrNode); CurrNode := CurrNode.GetNextSibling; end; end; begin Result := TList.Create; StepGetAllChildNodes(ANode); end; procedure Tfrm3D.FormDestroy(Sender: TObject); begin if FSelection <> nil then FreeAndNil(FSelection); if FPropObjects <> nil then FreeAndNil(FPropObjects); if FxObjects <> nil then FreeAndNil(FxObjects); if FNodes <> nil then FreeAndNil(FNodes); 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, xScale: Integer; xMirror: Boolean; xCnt: Integer; CoordsInfo: string; begin try mDesc.Clear; cbCoordNbr.Properties.Items.Clear; for i := 0 to aObjects.Count - 1 do begin xObject := T3DSide(TTreeNode(aObjects[i]).Data); xGLObject := TGLBaseSceneObject(xObject.FGLObject); if i = 0 then begin xRotate := xObject.FTextureRotate; xScale := xObject.FTextureScale; xMirror := xObject.FMirror; edTextureRotate.Text := IntToStr(xObject.FTextureRotate); edTextureScale.Text := IntToStr(xObject.FTextureScale); cbMirror.Checked := xObject.FMirror; xCnt := Length(xObject.FGLPoints); end else begin if edTextureRotate.Text <> '' then if xRotate <> xObject.FTextureRotate then edTextureRotate.Text := ''; if edTextureScale.Text <> '' then if xScale <> xObject.FTextureScale then edTextureScale.Text := ''; if cbMirror.AllowGrayed = False then if xMirror <> xObject.FMirror then cbMirror.AllowGrayed := True; if xCnt <> - 1 then if xCnt <> Length(xObject.FGLPoints) then xCnt := -1; end; end; if xCnt > 0 then begin //panCoords.Enabled := True; for i := 0 to xCnt - 1 do begin CoordsInfo := '';{' (' + FloatToStr(xObject.FGLPoints[i].x) + '; ' + FloatToStr(xObject.FGLPoints[i].y) + '; ' + FloatToStr(xObject.FGLPoints[i].z) + ')';} cbCoordNbr.Properties.Items.Add(InttoStr(i + 1) + CoordsInfo); end; cbCoordNbr.Text := cbCoordNbr.Properties.Items[0]; edCoordX.Text := ''; edCoordY.Text := ''; edCoordZ.Text := ''; end else begin //panCoords.Enabled := False; end; imgSideTexture.Clear; cbSideHashs.Properties.Items.Clear; for i := 0 to F3DModel.FHashs.Count - 1 do begin cbSideHashs.Properties.Items.Add(F3DModel.FHashs.Strings[i]); end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.LoadPropertiesForMultiObjects', E.Message); end; end; function Tfrm3D.LoadPropertiesForSingleObject(aObject: TTreeNode): TPropRecord; var i: integer; xObject: T3DSide; xGLObject: TGLBaseSceneObject; Points: T3DPointArray; Cnt: Integer; CoordsInfo: string; tmpdir, tmpfname: string; begin try xObject := T3DSide(aObject.Data); xGLObject := TGLBaseSceneObject(xObject.FGLObject); edName.Text := xObject.FName; mDesc.Clear; for i := 0 to xObject.FDescription.Count - 1 do mDesc.Lines.Add(xObject.FDescription[i]); if Pos('empty', AnsiLowerCase(mDesc.Lines.Text)) = 1 then begin if xGLObject <> nil then begin xGLObject.Visible := False; if xObject.FAsArc and (AnsiLowerCase(xObject.ClassName) <> 't3dsobject') then RotateTextureToAngleP(xObject, TGLPolygon(xGLObject), xObject.FTextureRotate, xObject.FMirror); end; btnEmpty.GroupIndex := 1; btnEmpty.Down := True; if aObject.ImageIndex < 999 then aObject.ImageIndex := aObject.ImageIndex + 1000; end else begin btnEmpty.GroupIndex := 0; btnEmpty.Down := False; if xGLObject <> nil then begin xGLObject.Visible := True; if xObject.FAsArc and (AnsiLowerCase(xObject.ClassName) <> 't3dsobject') then RotateTextureToAngleP(xObject, TGLPolygon(xGLObject), xObject.FTextureRotate, xObject.FMirror); end; if aObject.ImageIndex > 999 then aObject.ImageIndex := aObject.ImageIndex - 1000; end; edTextureRotate.Text := IntToStr(xObject.FTextureRotate); edTextureScale.Text := IntToStr(xObject.FTextureScale); cbMirror.Checked := xObject.FMirror; cbCoordNbr.Properties.Items.Clear; Cnt := Length(xObject.FGLPoints); for i := 0 to Cnt - 1 do begin CoordsInfo := '';{' (' + FloatToStr(xObject.FGLPoints[i].x) + '; ' + FloatToStr(xObject.FGLPoints[i].y) + '; ' + FloatToStr(xObject.FGLPoints[i].z) + ')';} cbCoordNbr.Properties.Items.Add(InttoStr(i + 1) + CoordsInfo); end; cbCoordNbr.Text := cbCoordNbr.Properties.Items[0]; edCoordX.Text := FloatToStr(xObject.FGLPoints[0].x); edCoordY.Text := FloatToStr(xObject.FGLPoints[0].y); edCoordZ.Text := FloatToStr(xObject.FGLPoints[0].z); imgSideTexture.Clear; tmpfname := GetImageFileByHash(xObject.FTextureHash); if tmpfname <> '' then imgSideTexture.Picture.LoadFromFile(tmpfname); cbSideHashs.Properties.Items.Clear; for i := 0 to F3DModel.FHashs.Count - 1 do begin cbSideHashs.Properties.Items.Add(F3DModel.FHashs.Strings[i]); end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.LoadPropertiesForSingleObject', E.Message); end; end; function Tfrm3D.LoadPropertiesForSingle3ds(aObject: TTreeNode): TPropRecord; var i: integer; xObject: T3DSObject; xGLObject: TGLBaseSceneObject; tmpdir, tmpfname: string; begin try xObject := T3DSObject(aObject.Data); xGLObject := TGLBaseSceneObject(xObject.FGLObject); edName.Text := xObject.FName; mDesc.Clear; for i := 0 to xObject.FDescription.Count - 1 do mDesc.Lines.Add(xObject.FDescription[i]); edPosX.Text := FloatToStr(xObject.FPosition.x); edPosY.Text := FloatToStr(xObject.FPosition.y); edPosZ.Text := FloatToStr(xObject.FPosition.z); edAngleX.Text := FloatToStr(xObject.FRotate.x); edAngleY.Text := FloatToStr(xObject.FRotate.y); edAngleZ.Text := FloatToStr(xObject.FRotate.z); edScaleX.Text := FloatToStr(xObject.FScale.x); edScaleY.Text := FloatToStr(xObject.FScale.y); edScaleZ.Text := FloatToStr(xObject.FScale.z); imgObjectTexture.Clear; tmpfname := GetImageFileByHash(xObject.FTextureHash); if tmpfname <> '' then imgObjectTexture.Picture.LoadFromFile(tmpfname); cbObjectHashs.Properties.Items.Clear; for i := 0 to F3DModel.FHashs.Count - 1 do begin cbObjectHashs.Properties.Items.Add(F3DModel.FHashs.Strings[i]); end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.LoadPropertiesForSingle3ds', E.Message); end; end; function Tfrm3D.LoadPropertiesForMulti3ds(aObjects: TList): TPropRecord; var i: integer; xObject: T3DSObject; xGLObject: TGLBaseSceneObject; Points: T3DPointArray; Cnt: Integer; xPosX, xPosY, xPosZ, xAngleX, xAngleY, xAngleZ, xScaleX, xScaleY, xScaleZ: Double; begin try mDesc.Clear; for i := 0 to aObjects.Count - 1 do begin xObject := T3DSObject(TTreeNode(aObjects[i]).Data); xGLObject := TGLBaseSceneObject(xObject.FGLObject); if i = 0 then begin xPosX := xObject.FPosition.x; edPosX.Text := FloatToStr(xPosX); xPosY := xObject.FPosition.y; edPosY.Text := FloatToStr(xPosY); xPosZ := xObject.FPosition.z; edPosZ.Text := FloatToStr(xPosZ); xAngleX := xObject.FRotate.x; edAngleX.Text := FloatToStr(xAngleX); xAngleY := xObject.FRotate.y; edAngleY.Text := FloatToStr(xAngleY); xAngleZ := xObject.FRotate.z; edAngleZ.Text := FloatToStr(xAngleZ); xScaleX := xObject.FScale.x; edScaleX.Text := FloatToStr(xScaleX); xScaleY := xObject.FScale.y; edScaleY.Text := FloatToStr(xScaleY); xScaleZ := xObject.FScale.z; edScaleZ.Text := FloatToStr(xScaleZ); end else begin if edPosX.Text <> '' then if xPosX <> xObject.FPosition.x then edPosX.Text := ''; if edPosY.Text <> '' then if xPosY <> xObject.FPosition.y then edPosY.Text := ''; if edPosZ.Text <> '' then if xPosZ <> xObject.FPosition.z then edPosZ.Text := ''; if edAngleX.Text <> '' then if xAngleX <> xObject.FRotate.x then edAngleX.Text := ''; if edAngleY.Text <> '' then if xAngleY <> xObject.FRotate.y then edAngleY.Text := ''; if edAngleZ.Text <> '' then if xAngleZ <> xObject.FRotate.z then edAngleZ.Text := ''; if edScaleX.Text <> '' then if xScaleX <> xObject.FScale.x then edScaleX.Text := ''; if edScaleY.Text <> '' then if xScaleY <> xObject.FScale.y then edScaleY.Text := ''; if edScaleZ.Text <> '' then if xScaleZ <> xObject.FScale.z then edScaleZ.Text := ''; end; end; imgObjectTexture.Clear; cbObjectHashs.Properties.Items.Clear; for i := 0 to F3DModel.FHashs.Count - 1 do begin cbObjectHashs.Properties.Items.Add(F3DModel.FHashs.Strings[i]); end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.LoadPropertiesForMulti3ds', E.Message); end; end; procedure Tfrm3D.cbCoordNbrCloseUp(Sender: TObject); var Index: Integer; xObject: T3DSide; begin try Index := cbCoordNbr.ItemIndex; if FPropObjects.Count > 0 then begin if FPropObjects.Count = 1 then begin xObject := T3DSide(TTreeNode(FPropObjects[0]).Data); edCoordX.Text := FloatToStr(xObject.FGLPoints[Index].x); edCoordY.Text := FloatToStr(xObject.FGLPoints[Index].y); edCoordZ.Text := FloatToStr(xObject.FGLPoints[Index].z); end else begin edCoordX.Text := ''; edCoordY.Text := ''; edCoordZ.Text := ''; end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.cbCoordNbrCloseUp', E.Message); end; end; { TPropRecord } constructor TPropRecord.Create; begin inherited Create; fCoords := TList.Create; fDesc := TStringList.Create; end; procedure Tfrm3D.bSideTextureChangeClick(Sender: TObject); var i: integer; FName: string; xObject: T3DSide; xGLObject: TGLBaseSceneObject; tmpdir, tmpfname, ExtStr, BmpFName: string; Bmp: TBitmap; Jpeg: TJPEGImage; HashStr: string; begin try FName := LoadTexture; if (FName <> '') and FileExists(FName) then begin imgSideTexture.Picture.LoadFromFile(FName); ExtStr := ExtractFileExt(FName); tmpdir := ExtractDirByCategoryType(dctPictures); // получаем HASH по загружаемому файлу HashStr := GetImageHash(FName); // по HASH ищем есть ли он в нашей базе tmpfname := GetImageFileByHash(HashStr); // если найден, то грузим его if tmpfname <> '' then begin end else // не найден - создаем для файла HASH, копируем в темп, грузим begin F3DModel.FHashs.Add(HashStr); tmpfname := tmpdir + '\' + HashStr + '.bmp'; if (ExtStr = '.jpg') or (ExtStr = '.jpeg') then begin Bmp := TBitmap.Create; Jpeg := TJPEGImage.Create; jpeg.CompressionQuality := 100; {Default Value} Jpeg.LoadFromFile(FName); Bmp.Assign(Jpeg); Bmp.SaveTofile(tmpfname); FreeAndNil(Bmp); FreeAndNil(Jpeg); end else CopyFile(PChar(FName), PChar(tmpfname), True); end; for i := 0 to FPropObjects.Count - 1 do begin xObject := T3DSide(TTreeNode(FPropObjects[i]).Data); xGLObject := TGLBaseSceneObject(xObject.FGLObject); xObject.FTextureHash := HashStr; xObject.FTexture_ext := ExtStr; if (xGLObject is TGLPolygon) then begin TGLPolygon(xGLObject).Material.Texture.Disabled := False; TGLPolygon(xGLObject).Material.Texture.DestroyHandles; TGLPolygon(xGLObject).Material.Texture.Image.LoadFromFile(tmpfname); RotateTextureToAngleP(xObject, TGLPolygon(xGLObject), xObject.FTextureRotate, xObject.FMirror); end; end; // Resfresh HASHs cbSideHashs.Properties.Items.Clear; for i := 0 to F3DModel.FHashs.Count - 1 do begin cbSideHashs.Properties.Items.Add(F3DModel.FHashs.Strings[i]); end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.bTextureChangeClick', E.Message); end; end; function Tfrm3D.LoadTexture: string; begin try Result := ''; OpenTexture.InitialDir := ExeDir + '\3DTextures'; NoMoveEvent := True; if OpenTexture.Execute then begin Result := OpenTexture.FileName; end; except on E: Exception do AddExceptionToLogEx('', E.Message); end; end; procedure Tfrm3D.edNameExit(Sender: TObject); begin ChangeName; end; procedure Tfrm3D.bSideTextureClearClick(Sender: TObject); var FName: string; i: integer; xObject: T3DSide; xGLObject: TGLBaseSceneObject; tmpdir, tmpfname, ExtStr, BmpFName: string; Bmp: TBitmap; Jpeg: TJPEGImage; begin try for i := 0 to FPropObjects.Count - 1 do begin xObject := T3DSide(TTreeNode(FPropObjects[i]).Data); xGLObject := TGLBaseSceneObject(xObject.FGLObject); xObject.FTextureHash := ''; xObject.FTexture_ext := ''; if (xGLObject is TGLPolygon) then begin imgSideTexture.Clear; TGLPolygon(xGLObject).Material.Texture.Disabled := True; end; end; 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.FTextureRotate, 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.edTextureRotateExit(Sender: TObject); begin ChangeTextureRotate; end; procedure Tfrm3D.edTextureRotateKeyPress(Sender: TObject; var Key: Char); begin if Key = #13 then ChangeTextureRotate; 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); xObject.FDescription.Clear; for j := 0 to mDesc.Lines.Count - 1 do xObject.FDescription.Add(mDesc.Lines[j]); if Pos('empty', AnsiLowerCase(mDesc.Lines.Text)) = 1 then begin if xGLObject <> nil then begin xGLObject.Visible := False; if xObject.FAsArc and (AnsiLowerCase(xObject.ClassName) <> 't3dsobject') then RotateTextureToAngleP(xObject, TGLPolygon(xGLObject), xObject.FTextureRotate, xObject.FMirror); end; btnEmpty.GroupIndex := 1; btnEmpty.Down := True; if TTreeNode(FPropObjects[i]).ImageIndex < 999 then TTreeNode(FPropObjects[i]).ImageIndex := TTreeNode(FPropObjects[i]).ImageIndex + 1000; end else begin btnEmpty.GroupIndex := 0; btnEmpty.Down := False; if xGLObject <> nil then begin xGLObject.Visible := True; if xObject.FAsArc and (AnsiLowerCase(xObject.ClassName) <> 't3dsobject') then RotateTextureToAngleP(xObject, TGLPolygon(xGLObject), xObject.FTextureRotate, xObject.FMirror); end; if TTreeNode(FPropObjects[i]).ImageIndex > 999 then TTreeNode(FPropObjects[i]).ImageIndex := TTreeNode(FPropObjects[i]).ImageIndex - 1000; end; 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.ChangeTextureRotate; var i: integer; xObject: T3DSide; xGLObject: TGLBaseSceneObject; Bmp: TBitmap; begin try if edTextureRotate.Text = '' then exit; for i := 0 to FPropObjects.Count - 1 do begin xObject := T3DSide(TTreeNode(FPropObjects[i]).Data); xGLObject := TGLBaseSceneObject(xObject.FGLObject); if StrToInt(edTextureRotate.Text) >= 360 then edTextureRotate.Text := IntToStr(StrToInt(edTextureRotate.Text) mod 360); xObject.FTextureRotate := StrToInt(edTextureRotate.Text); if (xGLObject is TGLMesh) then begin RotateTextureToAngleM(xObject, TGLMesh(xGLObject), xObject.FTextureRotate, xObject.FMirror); end; if (xGLObject is TGLPolygon) then begin RotateTextureToAngleP(xObject, TGLPolygon(xGLObject), xObject.FTextureRotate, xObject.FMirror); end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.ChangeTextureRotate', E.Message); end; end; //Alex(20.12.2010) procedure Tfrm3D.sbFirstFaceClick(Sender: TObject); begin FirstPersonCamera.FocalLength := 100; //160; DeselectGLObjects; GLSceneViewer.SetFocus; GLSceneViewer.Camera := FirstPersonCamera; GLLightFirstPerson.Shining := True; Light.Shining := False; lbViewType.Caption := cForm3D_Mes5; end; procedure Tfrm3D.GLCadencerProgress(Sender: TObject; const deltaTime, newTime: Double); var speed : Single; Pt: TPoint; //Alex movementScale: single; shiftDown: Boolean; begin if not GLSceneViewer.Focused then exit; // handle keypresses speed := deltaTime; shiftDown:=(IsKeyDown(VK_LSHIFT) or IsKeyDown(VK_RSHIFT)); //Alex(16.12.2010) if GLSceneViewer.Camera = FirstPersonCamera then begin movementScale:= GLFPSMovementManager1.movementScale; //Вверх if IsKeyDown(VK_PRIOR) then begin if shiftDown then behav.StrafeVertical(MovementScale*deltaTime) else behav.turnVertical(70*deltatime); end; //Вниз if IsKeyDown(VK_NEXT) then begin if shiftDown then behav.StrafeVertical(-MovementScale*deltaTime) else behav.turnVertical(-70*deltatime); end; //Движение влево if IsKeyDown(VK_LEFT) then begin if shiftDown then behav.StrafeHorizontal(-MovementScale*deltaTime * 2) else behav.TurnHorizontal(-100*deltatime); end; //Движение вправо if IsKeyDown(VK_RIGHT) then begin if shiftDown then behav.StrafeHorizontal(MovementScale*deltaTime * 2) else behav.TurnHorizontal(100*deltatime); end; //Движение вперед if IsKeyDown(VK_UP) then begin //if shiftDown then // behav.turnVertical(70*deltatime) //else if shiftDown then behav.MoveForward(MovementScale*deltaTime * 4) else behav.MoveForward(MovementScale*deltaTime * 2); end; //Движение назад if IsKeyDown(VK_DOWN) then begin //if shiftDown then // behav.turnVertical(-70*deltatime) //else if shiftDown then behav.MoveForward(-MovementScale*deltaTime * 4) else behav.MoveForward(-MovementScale*deltaTime * 2); end; GLSceneViewer.Invalidate; end else begin if IsKeyDown(VK_RIGHT) then DummyCube.Translate(GLSceneViewer.Camera.Position.Z * speed, 0, -GLSceneViewer.Camera.Position.X * speed); if IsKeyDown(VK_LEFT) then DummyCube.Translate(-GLSceneViewer.Camera.Position.Z * speed, 0, GLSceneViewer.Camera.Position.X * speed); if IsKeyDown(VK_UP) then DummyCube.Translate(-GLSceneViewer.Camera.Position.X * speed, 0, -GLSceneViewer.Camera.Position.Z * speed); if IsKeyDown(VK_DOWN) then DummyCube.Translate(GLSceneViewer.Camera.Position.X * speed, 0, GLSceneViewer.Camera.Position.Z * speed); //Движение вперед по клавишам ц и w if (IsKeyDown('ц') or IsKeyDown('w')) then GLSceneViewer.Camera.Move(5 * deltaTime); //Движение назад по клавишам ы и s if (IsKeyDown('ы') or IsKeyDown('s')) then GLSceneViewer.Camera.Move(-5 * deltaTime); //Поворот влево по клавишам ф и a if (IsKeyDown('ф') or IsKeyDown('a')) then GLSceneViewer.Camera.slide(-5 * deltaTime); //Поворот вправо по клавишам в и d if (IsKeyDown('в') or IsKeyDown('d')) then GLSceneViewer.Camera.slide(5 * deltaTime); if IsKeyDown(VK_ESCAPE) or IsKeyDown(VK_RETURN) then begin if FToolMode <> tmSelect then begin FToolMode := tmSelect; glSpliter.Visible := False; glCubeSpliter.Visible := False; glCubeSpliter1.Visible := False; glCubeSpliter2.Visible := False; glSide11.Visible := False; glSide12.Visible := False; glSide21.Visible := False; glSide22.Visible := False; GLSceneViewer.Cursor := crDefault; DeleteNodesObjects; RefreshSidesPoints; // **** Undo Cut ***************** if IsKeyDown(VK_ESCAPE) then begin UndoCutSides; end; end; end; end; end; procedure Tfrm3D.GLSceneViewerClick(Sender: TObject); begin try if not GLSceneViewer.Focused then begin SendMessage(GLSceneViewer.Handle, WM_ACTIVATE, MakewParam(WA_ACTIVE, 0), 0); SendMessage(GLSceneViewer.Handle, WM_SETFOCUS, 0, 0); end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.GLSceneViewerClick', E.Message); end; end; procedure Tfrm3D.RotateTextureToAngleM(aObject: T3DSide; aGLObject: TGLMesh; aAngle: Integer; aMirror: Boolean); var pN, pP: TVector3f; mat: TAffineMatrix; i: Integer; vs, vs0, vs1, vs2: TVector3f; tp: TTexPoint; r1, r2: T3DPoint; rAngle: Double; VCoords: array [1..4] of TVector3f; axis: T3DAxis; begin try // if (aObject.FFaceType = ftNetFloor) or (aObject.FFaceType = ftNetCeiling) then begin VCoords[1][0] := 0; VCoords[1][1] := 0; VCoords[1][2] := 0; VCoords[2][0] := 100; VCoords[2][1] := 0; VCoords[2][2] := 0; VCoords[3][0] := 100; VCoords[3][1] := 0; VCoords[3][2] := 100; VCoords[4][0] := 0; VCoords[4][1] := 0; VCoords[4][2] := 100; axis := aZ; end else if (aObject.FFaceType = ftNetPath) then begin VCoords[1] := aGLObject.Vertices[0].coord; VCoords[2] := aGLObject.Vertices[1].coord; VCoords[3] := aGLObject.Vertices[3].coord; VCoords[4] := aGLObject.Vertices[2].coord; axis := aY; end; rAngle := DegToRad(aAngle); if (aAngle >=0) and (aAngle < 90) then begin if not aMirror then begin vs0 := VCoords[1]; vs1 := VCoords[2]; end else begin vs0 := VCoords[2]; vs1 := VCoords[1]; end; vs2 := VCoords[4]; r1.x := vs0[0]; r1.y := vs0[2]; r1.z := vs0[1]; r2.x := vs1[0]; r2.y := vs1[2]; r2.z := vs1[1]; r2 := Rotate3DPoint(r1, r2, DegToRad(aAngle- 0), axis); vs1[0] := r2.x; vs1[2] := r2.y; vs1[1] := r2.z; end; if (aAngle >=90) and (aAngle < 180) then begin if not aMirror then begin vs0 := VCoords[2]; vs1 := VCoords[3]; end else begin vs0 := VCoords[3]; vs1 := VCoords[2]; end; vs2 := VCoords[1]; r1.x := vs0[0]; r1.y := vs0[2]; r1.z := vs0[1]; r2.x := vs1[0]; r2.y := vs1[2]; r2.z := vs1[1]; r2 := Rotate3DPoint(r1, r2, DegToRad(aAngle - 90), axis); vs1[0] := r2.x; vs1[2] := r2.y; vs1[1] := r2.z; end; if (aAngle >=180) and (aAngle < 270) then begin if not aMirror then begin vs0 := VCoords[3]; vs1 := VCoords[4]; end else begin vs0 := VCoords[4]; vs1 := VCoords[3]; end; vs2 := VCoords[2]; r1.x := vs0[0]; r1.y := vs0[2]; r1.z := vs0[1]; r2.x := vs1[0]; r2.y := vs1[2]; r2.z := vs1[1]; r2 := Rotate3DPoint(r1, r2, DegToRad(aAngle - 180), axis); vs1[0] := r2.x; vs1[2] := r2.y; vs1[1] := r2.z; end; if (aAngle >=270) and (aAngle < 360) then begin if not aMirror then begin vs0 := VCoords[4]; vs1 := VCoords[1]; end else begin vs0 := VCoords[1]; vs1 := VCoords[4]; end; vs2 := VCoords[3]; r1.x := vs0[0]; r1.y := vs0[2]; r1.z := vs0[1]; r2.x := vs1[0]; r2.y := vs1[2]; r2.z := vs1[1]; r2 := Rotate3DPoint(r1, r2, DegToRad(aAngle - 270), axis); vs1[0] := r2.x; vs1[2] := r2.y; vs1[1] := r2.z; end; pN := CalcPlaneNormal (vs0, vs1, vs2); SetVector (mat[2], pN); SetVector (mat[0], VectorNormalize (VectorSubtract (vs1, vs0))); SetVector (mat[1], VectorCrossProduct (mat[2], mat[0])); InvertMatrix (mat); for i := 0 to aGLObject.Vertices.Count - 1 do begin vs := aGLObject.Vertices[i].coord; pP := VectorTransform (vs, mat); tp := TexPointMake (pP[0], pP[1]); aGLObject.Vertices.VertexTexCoord[i] := tp; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.RotateTextureToAngle', E.Message); end; end; procedure Tfrm3D.RotateTextureToAngleP(aObject: T3DSide; aGLObject: TGLPolygon; aAngle: Integer; aMirror: Boolean); var pN, pP: TVector3f; mat: TAffineMatrix; i: Integer; vs, vs0, vs1, vs2: TVector3f; tp: TTexPoint; r1, r2: T3DPoint; rAngle: Double; VCoords: array [1..4] of TVector3f; axis: T3DAxis; xScale: Double; WH_koef: double; //- ширина / высота HW_koef: double; //- высота / ширина f_find_other_GLObject: Boolean; f_face_index: integer; f_first_Object: T3DSide; f_Face: TFaceRecord; f_GLObject: TGLBaseSceneObject; tmpdir: string; tmpfname: string; begin try f_find_other_GLObject := True; f_face_index := 0; f_first_Object := aObject; f_GLObject := aGLObject; tmpfname := ''; if (f_GLObject is TGLPolygon) and (f_GLObject.TagObject <> nil) then begin if (T3DSide(TTreeNode(f_GLObject.TagObject).Data).FAsArc) then begin //tmpdir := ExtractDirByCategoryType(dctPictures); //tmpfname := tmpdir + '\tmp.bmp'; //aGLObject.Material.Texture.Image.SaveToFile(tmpfname); end; end; while f_find_other_GLObject do begin {TODO} // перепроверить //if aObject.FAsArc then begin VCoords[1][0] := 0; VCoords[1][1] := 0; VCoords[1][2] := 0; VCoords[2][0] := 100; VCoords[2][1] := 0; VCoords[2][2] := 0; VCoords[3][0] := 100; VCoords[3][1] := 100; VCoords[3][2] := 0; VCoords[4][0] := 0; VCoords[4][1] := 100; VCoords[4][2] := 0; end; //else begin if aGLObject.Nodes.Count >= 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; end; rAngle := DegToRad(aAngle); if (aAngle >=0) and (aAngle < 90) then begin if not aMirror then begin vs0 := VCoords[1]; vs1 := VCoords[2]; end else begin vs0 := VCoords[2]; vs1 := VCoords[1]; end; vs2 := VCoords[4]; vs1 := Rotate3DVector(vs0, vs1, vs2, aAngle - 0); end; if (aAngle >=90) and (aAngle < 180) then begin if not aMirror then begin vs0 := VCoords[2]; vs1 := VCoords[3]; end else begin vs0 := VCoords[3]; vs1 := VCoords[2]; end; vs2 := VCoords[1]; vs1 := Rotate3DVector(vs0, vs1, vs2, aAngle - 90); end; if (aAngle >=180) and (aAngle < 270) then begin if not aMirror then begin vs0 := VCoords[3]; vs1 := VCoords[4]; end else begin vs0 := VCoords[4]; vs1 := VCoords[3]; end; vs2 := VCoords[2]; vs1 := Rotate3DVector(vs0, vs1, vs2, aAngle - 180); end; if (aAngle >=270) and (aAngle < 360) then begin if not aMirror then begin vs0 := VCoords[4]; vs1 := VCoords[1]; end else begin vs0 := VCoords[1]; vs1 := VCoords[4]; end; vs2 := VCoords[3]; vs1 := Rotate3DVector(vs0, vs1, vs2, aAngle - 270); end; pN := CalcPlaneNormal (vs0, vs1, vs2); SetVector (mat[2], pN); SetVector (mat[0], VectorNormalize (VectorSubtract (vs1, vs0))); SetVector (mat[1], VectorCrossProduct (mat[2], mat[0])); with aGLObject.Material.Texture do begin {TODO} // применять текущий масштаб + применение заданого пользователем xScale := aObject.FTextureScale / 100; // 1; WH_koef := Image.Width / Image.Height; HW_koef := Image.Height / Image.Width; MappingMode := tmmObjectLinear; // MappingSCoordinates.AsVector := VectorMake(mat[0][0] * 0.5 , mat[0][1] * 0.5, mat[0][2] * 0.5, 0); // MappingTCoordinates.AsVector := VectorMake(mat[1][0] * 0.5 * 0.66, mat[1][1] * 0.5 * 0.66, mat[1][2] * 0.5 * 0.66, 0); if Image.Width > Image.Height then begin MappingSCoordinates.AsVector := VectorMake(mat[0][0] * (1 / xScale) * HW_koef, mat[0][1] * (1 / xScale) * HW_koef, mat[0][2] * (1 / xScale) * HW_koef, 0); MappingTCoordinates.AsVector := VectorMake(mat[1][0] * (1 / xScale) * 1, mat[1][1] * (1 / xScale) * 1, mat[1][2] * (1 / xScale) * 1, 0); end else begin MappingSCoordinates.AsVector := VectorMake(mat[0][0] * (1 / xScale), mat[0][1] * (1 / xScale), mat[0][2] * (1 / xScale), 0); MappingTCoordinates.AsVector := VectorMake(mat[1][0] * (1 / xScale) * WH_koef, mat[1][1] * (1 / xScale) * WH_koef, mat[1][2] * (1 / xScale) * WH_koef, 0); end; end; f_find_other_GLObject := False; if aObject.FAsArc then begin //xSide := T3DSide(TTreeNode(xObj.TagObject).Data); while f_face_index < DummyCube.Count do begin if DummyCube.Children[f_face_index] <> f_GLObject then begin if (DummyCube.Children[f_face_index] is TGLPolygon) and (DummyCube.Children[f_face_index].TagObject <> nil) then begin if (T3DSide(TTreeNode(DummyCube.Children[f_face_index].TagObject).Data).FAsArc) and (DummyCube.Children[f_face_index].TagObject = f_GLObject.TagObject) and (DummyCube.Children[f_face_index].TagObject = f_first_Object.FFace.FTreeNode) then begin f_find_other_GLObject := True; aGLObject := TGLPolygon(DummyCube.Children[f_face_index]); //if tmpfname <> '' then begin aGLObject.Visible := f_GLObject.Visible; aGLObject.Material.Texture.Disabled := False; aGLObject.Material.Texture.MappingMode := tmmObjectLinear; aGLObject.Material.Texture.DestroyHandles; //aGLObject.Material.Texture.Image.LoadFromFile(tmpfname); aGLObject.Material.Texture.Image.Assign(TGLPolygon(f_GLObject).Material.Texture.Image); end; f_face_index := f_face_index + 1; break; end; end; end; f_face_index := f_face_index + 1; end; end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.RotateTextureToAngleP', E.Message); end; end; procedure Tfrm3D.SetPolygonTexture(aObject: TGLPolygon); var pN: TVector3f; mat: TAffineMatrix; vs0, vs1, vs2: TVector3f; VCoords: array [1..4] of TVector3f; begin try if aObject.Nodes.Count <= 4 then begin VCoords[1][0] := aObject.Nodes[0].x; VCoords[1][1] := aObject.Nodes[0].y; VCoords[1][2] := aObject.Nodes[0].z; VCoords[2][0] := aObject.Nodes[1].x; VCoords[2][1] := aObject.Nodes[1].y; VCoords[2][2] := aObject.Nodes[1].z; VCoords[3][0] := aObject.Nodes[2].x; VCoords[3][1] := aObject.Nodes[2].y; VCoords[3][2] := aObject.Nodes[2].z; VCoords[4][0] := aObject.Nodes[3].x; VCoords[4][1] := aObject.Nodes[3].y; VCoords[4][2] := aObject.Nodes[3].z; end else begin VCoords[1][0] := 0; VCoords[1][1] := 0; VCoords[1][2] := 0; VCoords[2][0] := 100; VCoords[2][1] := 0; VCoords[2][2] := 0; VCoords[3][0] := 100; VCoords[3][1] := 0; VCoords[3][2] := 100; VCoords[4][0] := 0; VCoords[4][1] := 0; VCoords[4][2] := 100; end; vs0 := VCoords[1]; vs1 := VCoords[2]; vs2 := VCoords[3]; pN := CalcPlaneNormal (vs0, vs1, vs2); SetVector (mat[2], pN); SetVector (mat[0], VectorNormalize (VectorSubtract (vs1, vs0))); SetVector (mat[1], VectorCrossProduct (mat[2], mat[0])); with aObject.Material.Texture do begin MappingMode := tmmObjectLinear; MappingSCoordinates.AsVector := VectorMake(mat[0][0], mat[0][1], mat[0][2], 0); MappingTCoordinates.AsVector := VectorMake(mat[1][0], mat[1][1], mat[1][2], 0); end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.SetPolygonTexture', E.Message); end; end; Function Tfrm3D.Rotate3DVector(vs0, vs1, vs2: TVector3f; Ang: Double): TVector3f; var osp: T3DPoint; nz, nx, ny: Double; r0, r1, r2: TDoublePoint; k: double; begin r0.x := vs0[0]; r0.y := vs0[2]; r0.z := vs0[1]; r1.x := vs1[0]; r1.y := vs1[2]; r1.z := vs1[1]; r2.x := vs2[0]; r2.y := vs2[2]; r2.z := vs2[1]; k := (Ang / 90); nx := r1.x - (r1.x - r2.x) * k; ny := r1.y - (r1.y - r2.y) * k; nz := r1.z - (r1.z - r2.z) * k; Result[0] := nx; Result[1] := nz; Result[2] := ny; end; function Tfrm3D.GetImageFileByHash(aHash: string): string; var i: integer; tmpdir, tmpfname, str: string; begin try Result := ''; if aHash <> '' then begin tmpdir := 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 := cbSideHashs.ItemIndex; if Index >= 0 then begin HashStr := cbSideHashs.Properties.Items[Index]; tmpdir := ExtractDirByCategoryType(dctPictures); tmpfname := GetImageFileByHash(HashStr); ExtStr := ExtractFileExt(tmpfname); if tmpfname <> '' then begin imgSideTexture.Picture.LoadFromFile(tmpfname); for i := 0 to FPropObjects.Count - 1 do begin xObject := T3DSide(TTreeNode(FPropObjects[i]).Data); xGLObject := TGLBaseSceneObject(xObject.FGLObject); xObject.FTextureHash := HashStr; xObject.FTexture_ext := ExtStr; if (xGLObject is TGLPolygon) then begin TGLPolygon(xGLObject).Material.Texture.Disabled := False; TGLPolygon(xGLObject).Material.Texture.DestroyHandles; TGLPolygon(xGLObject).Material.Texture.Image.LoadFromFile(tmpfname); RotateTextureToAngleP(xObject, TGLPolygon(xGLObject), xObject.FTextureRotate, xObject.FMirror); // TGLPolygon(xGLObject).Material.Texture.ApplyMappingMode; // TGLPolygon(xGLObject).Material.Texture.TexHeight := 100; // TGLPolygon(xGLObject).Material.Texture.TexWidth := 100; end; end; end end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.cbHashsPropertiesCloseUp', E.Message); end; end; procedure Tfrm3D.nAdd3DObjectClick(Sender: TObject); var i, j: integer; FName: string; xNode, xSubNode: TTreeNode; xRoom: T3DRoom; xObject: T3DSObject; glObjClass: TGLSceneObjectClass; glObject: TGLFreeForm; ObjectMin, ObjectMax, RoomMin, RoomMax, ObjSize, RoomSize, SetPos, Scale: T3DPoint; SetScale: Double; tmpdir, tmpfname: string; HashStr: string; begin try if ModelTree.SelectionCount = 1 then begin xNode := ModelTree.Selections[0]; Open3DObject.InitialDir := ExeDir + '\3DModels'; NoMoveEvent := True; if Open3DObject.Execute then begin //todo - на поднятии подменяется на текущий savedir! tmpdir := AddCreateDirToPath(ExtractFileDir(Application.ExeName), dnSave); //CopyFile(PChar(Open3DObject.FileName), PChar(ExeDir + '\' + dnSave + '\' + ExtractFileName(Open3DObject.FileName)), True); //if FileExists(ExeDir + '\' + dnSave + '\' + ExtractFileName(Open3DObject.FileName)) then // FName := ExeDir + '\' + dnSave + '\' + ExtractFileName(Open3DObject.FileName) //else // FName := Open3DObject.FileName; CopyFile(PChar(Open3DObject.FileName), PChar(tmpdir + '\' + ExtractFileName(Open3DObject.FileName)), True); if FileExists(tmpdir + '\' + ExtractFileName(Open3DObject.FileName)) then FName := tmpdir + '\' + ExtractFileName(Open3DObject.FileName) else FName := Open3DObject.FileName; xRoom := T3DRoom(xNode.Data); // MARK tmpdir := ExtractDirByCategoryType(dctPictures); // получаем HASH по загружаемому файлу HashStr := GetObjectHash(FName); // по HASH ищем есть ли он в нашей базе tmpfname := GetObjectFileByHash(HashStr); // если найден, то грузим его if tmpfname <> '' then begin end else // не найден - создаем для файла HASH, копируем в темп, грузим begin F3DModel.FHashs.Add(HashStr); tmpfname := tmpdir + '\' + HashStr + '.3ds'; CopyFile(PChar(FName), PChar(tmpfname), True); end; // MARK BeginProgress('Идет загрузка 3ds объекта ...'); // *** // создать обьект на GLScene glObjClass := TGLFreeForm; glObject := TGLFreeForm(DummyCube.AddNewChild(glObjClass)); glObject.Material.Texture.Disabled := False; glObject.MaterialLibrary := MatLib; xObject := T3DSObject.Create(xRoom); FTextures.Clear; FisCreate3DS := True; FCurrObject := xObject; glObject.LoadFromFile(FName); for i := 0 to MatLib.Materials.Count - 1 do MatLib.Materials[i].Material.Texture.MappingMode := tmmCubeMapCamera; Get3DSObjectBounds(ObjectMin, ObjectMax, glObject); GetRoomBounds(RoomMin, RoomMax, xRoom.FFloor.FGLPoints, xRoom.FCeiling.FGLPoints); ObjSize.x := abs(ObjectMax.x - ObjectMin.x); ObjSize.y := abs(ObjectMax.y - ObjectMin.y); ObjSize.z := abs(ObjectMax.z - ObjectMin.z); RoomSize.x := abs(RoomMax.x - RoomMin.x); RoomSize.y := abs(RoomMax.y - RoomMin.y); RoomSize.z := abs(RoomMax.z - RoomMin.z); SetPos.x := abs(RoomMax.x + RoomMin.x) / 2; SetPos.y := RoomMin.y + FDeltaZFloor; //abs(RoomMax.y + RoomMin.y) / 2; SetPos.z := abs(RoomMax.z + RoomMin.z) / 2; Scale.X := RoomSize.x / ObjSize.x; Scale.Y := RoomSize.y / ObjSize.y; Scale.Z := RoomSize.z / ObjSize.z; SetScale := MinFloat(Scale.X, Scale.Y, Scale.Z); //if SetScale > 1 then // SetScale := 1; glObject.Position.x := SetPos.x; glObject.Position.y := SetPos.y; glObject.Position.z := SetPos.z; glObject.Scale.X := SetScale; glObject.Scale.Y := SetScale; glObject.Scale.Z := SetScale; if glObject.Material.Texture.Disabled then begin glObject.Material.FrontProperties.Ambient.Color := ObjColor; glObject.Material.FrontProperties.Diffuse.Color := ObjColor; glObject.Material.FrontProperties.Emission.Color := ObjColor; glObject.Material.BackProperties.Ambient.Color := ObjColor; glObject.Material.BackProperties.Diffuse.Color := ObjColor; glObject.Material.BackProperties.Emission.Color := ObjColor; end; glObject.Material.Texture.MappingMode := tmmCubeMapCamera; //// glObject.BuildOctree; тормоза //glObject.Material.MaterialOptions := [moNoLighting]; glObject.Material.MaterialOptions := []; glObject.Material.Texture.Disabled := False; // создать объект в классе xObject.FZOrder := xObject.FParent.FZOrder; xObject.FObjectHash := HashStr; xObject.FName := ExtractFileName(FName); xObject.FPosition.x := glObject.Position.X; xObject.FPosition.y := glObject.Position.Y - xObject.FZOrder; xObject.FPosition.z := glObject.Position.Z; xObject.FScale.x := glObject.Scale.X; xObject.FScale.y := glObject.Scale.Y; xObject.FScale.z := glObject.Scale.Z; xObject.FGLObject := glObject; xRoom.F3DSObjects.Add(xObject); if (GLObject is TGLFreeForm) then begin //TGLFreeForm(GLObject).PitchAngle := 90; end; // создать Нод в дереве 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; EndProgress; end; procedure Tfrm3D.ModelTreeMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var i: Integer; xNode: TTreeNode; begin if (Button = mbRight) then begin if ModelTree.SelectionCount = 1 then begin xNode := ModelTree.Selections[0]; if (TObject(xNode.Data) is T3DRoom) then begin pmModelTree.Items[0].Visible := True; pmModelTree.Items[1].Visible := False; pmModelTree.Items[2].Visible := False; pmModelTree.Popup(X, Y); end; if (FToolMode = tmSelect) and (TObject(xNode.Data) is T3DSide) and (T3DSide(xNode.Data).FSubSides.Count > 0) then begin pmModelTree.Items[0].Visible := False; pmModelTree.Items[1].Visible := True; pmModelTree.Items[2].Visible := False; pmModelTree.Popup(X, Y); end; if (TObject(xNode.Data) is T3DSObject) then begin pmModelTree.Items[0].Visible := False; pmModelTree.Items[1].Visible := False; pmModelTree.Items[2].Visible := True; pmModelTree.Popup(X, Y); end; end; end; end; procedure Tfrm3D.ChangeAngleX; var i: integer; xObject: 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 Rotate3DSObj(TGLFreeForm(xGLObject), xObject.FRotate.x, xObject.FRotate.y, xObject.FRotate.z); 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 Rotate3DSObj(TGLFreeForm(xGLObject), xObject.FRotate.x, xObject.FRotate.y, xObject.FRotate.z); 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 Rotate3DSObj(TGLFreeForm(xGLObject), xObject.FRotate.x, xObject.FRotate.y, xObject.FRotate.z); 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; panSideTexture.Visible := aStatus; //panPos3ds.Visible := aStatus; panRotate3ds.Visible := aStatus; panScale3ds.Visible := aStatus; panObjectTexture.Visible := aStatus; {$IFEND} end; procedure Tfrm3D.Get3DSObjectBounds(var Min, Max: T3DPoint; aObject: TGLFreeForm); var i: Integer; Bounds: THmgBoundingBox; Coord: TVector4f; begin try Bounds := aObject.BoundingBox; for i := 0 to 7 do begin Coord := Bounds[i]; if i = 0 then begin Min.x := Coord[0]; Min.y := Coord[1]; Min.z := Coord[2]; Max.x := Coord[0]; Max.y := Coord[1]; Max.z := Coord[2]; end else begin if Coord[0] < Min.x then Min.x := Coord[0]; if Coord[0] > Max.x then Max.x := Coord[0]; if Coord[1] < Min.y then Min.y := Coord[1]; if Coord[1] > Max.y then Max.y := Coord[1]; if Coord[2] < Min.z then Min.z := Coord[2]; if Coord[2] > Max.z then Max.z := Coord[2]; end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.Get3DSObjectBounds', E.Message); end; end; procedure Tfrm3D.GetRoomBounds(var Min, Max: T3DPoint; aFloor, aCeiling: T3DPointArray); var i: Integer; Bounds: THmgBoundingBox; Coord1, Coord2: T3DPoint; begin try for i := 0 to Length(aFloor) - 1 do begin Coord1.x := aFloor[i].X; Coord1.y := aFloor[i].Y; Coord1.z := aFloor[i].Z; Coord2.x := aCeiling[i].X; Coord2.y := aCeiling[i].Y; Coord2.z := aCeiling[i].Z; if i = 0 then begin Min.x := Coord1.x; Min.y := Coord1.y; Min.z := Coord1.z; Max.x := Coord1.x; Max.y := Coord2.y; Max.z := Coord1.z; end else begin if Coord1.x < Min.x then Min.x := Coord1.x; if Coord1.x > Max.x then Max.x := Coord1.x; if Coord1.y < Min.y then Min.y := Coord1.y; if Coord2.y > Max.y then Max.y := Coord2.y; if Coord1.z < Min.z then Min.z := Coord1.z; if Coord1.z > Max.z then Max.z := Coord1.z; end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.GetRoomBounds', E.Message); end; end; procedure Tfrm3D.CreateNodesObjects(aObj: TGLPolygon); var i: integer; xObj: TGLSpaceText; cpos, pos, Camera: T3DPoint; SetPos: T3DPoint; delta, offset, koef, len: double; ang: double; coord1, coord2: TDoublePoint; xSide: T3DSide; begin try xSide := T3DSide(TTreeNode(aObj.TagObject).Data); delta := 0.2; if xSide.FFaceType in [ftNetFloor, ftNetCeiling] then offset := 0.8 else offset := 0.5; Camera.x := GLSceneViewer.Camera.Position.x; Camera.y := GLSceneViewer.Camera.Position.y; Camera.z := GLSceneViewer.Camera.Position.z; if FNodesObjectsList.Count > 0 then DeleteNodesObjects; cpos := DoublePoint(0, 0, 0); for i := 0 to aObj.Nodes.Count - 1 do cpos := DoublePoint(cpos.x + aObj.Nodes[i].x, cpos.y + aObj.Nodes[i].y, cpos.z + aObj.Nodes[i].z); cpos := DoublePoint(cpos.x / aObj.Nodes.Count, cpos.y / aObj.Nodes.Count, cpos.z / aObj.Nodes.Count); for i := 0 to aObj.Nodes.Count - 1 do begin xObj := TGLSpaceText(DummyCube.AddNewChild(TGLSpaceText)); pos.x := aObj.Nodes[i].x; pos.y := aObj.Nodes[i].y; pos.z := aObj.Nodes[i].z; len := SQRT(SQR(cpos.x - pos.x) + SQR(cpos.y - pos.y) + SQR(cpos.z - pos.z)); koef := offset / len; SetPos.x := pos.x + (cpos.x - pos.x) * koef; SetPos.y := pos.y + (cpos.y - pos.y) * koef; SetPos.z := pos.z + (cpos.z - pos.z) * koef; pos.x := SetPos.x; pos.y := SetPos.y; pos.z := SetPos.z; len := SQRT(SQR(camera.x - pos.x) + SQR(camera.y - pos.y) + SQR(camera.z - pos.z)); koef := delta / len; SetPos.x := pos.x + (camera.x - pos.x) * koef; SetPos.y := pos.y + (camera.y - pos.y) * koef; SetPos.z := pos.z + (camera.z - pos.z) * koef; xObj.Position.x := SetPos.x; xObj.Position.y := SetPos.y; xObj.Position.z := SetPos.z; coord1.x := pos.x; coord2.x := camera.x; if xSide.FFaceType in [ftNetFloor, ftNetCeiling] then begin coord1.y := pos.y; coord2.y := camera.y; xObj.PitchAngle := 90; end else begin coord1.y := pos.z; coord2.y := camera.z; xObj.PitchAngle := 0; end; ang := GetDistAngle(coord1, coord2); xObj.TurnAngle := ang; xObj.Text := IntToStr(i + 1); xObj.Extrusion := 0.1; xObj.Scale.X := 0.5; xObj.Scale.Y := 0.5; xObj.Scale.Z := 0.5; xObj.Adjust.Horz := haCenter; xObj.Adjust.Vert := vaCenter; xObj.Font.Color := clBlue; with xObj.Material do begin FrontProperties.Ambient.Color := clrBlue; FrontProperties.Diffuse.Color := clrBlue; FrontProperties.Emission.Color := clrBlue; BackProperties.Ambient.Color := clrBlue; BackProperties.Diffuse.Color := clrBlue; BackProperties.Emission.Color := clrBlue; end; FNodesObjectsList.Add(xObj); end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.CreateNodesObjects', E.Message); end; end; procedure Tfrm3D.DeleteNodesObjects; var i: integer; xObj: TGLSpaceText; begin try for i := 0 to FNodesObjectsList.Count - 1 do begin xObj := TGLSpaceText(FNodesObjectsList[i]); DummyCube.Remove(xObj, True); end; FNodesObjectsList.Clear; except on E: Exception do AddExceptionToLogEx('Tfrm3D.DeleteNodesObjects', E.Message); end; end; procedure Tfrm3D.DoResize; var Len1, Len2, Len3, Len13, HLen, DLen1, DLen2: Double; LenToCursor1, LenToCursor2, LenToResizer1, LenToResizer2: Double; Len11, Len12, Len21, Len22, LimitLen1, LimitLen2: Double; p1, p2, hp: T3DPoint; delta, p, S: double; begin try // Calc H Length Len1 := SQRT(SQR(glCursorObject.Position.x - RStartPos1.x) + SQR(glCursorObject.Position.y - RStartPos1.y) + SQR(glCursorObject.Position.z - RStartPos1.z)); Len2 := SQRT(SQR(glCursorObject.Position.x - RStartPos2.x) + SQR(glCursorObject.Position.y - RStartPos2.y) + SQR(glCursorObject.Position.z - RStartPos2.z)); Len3 := SQRT(SQR(RStartPos1.x - RStartPos2.x) + SQR(RStartPos1.y - RStartPos2.y) + SQR(RStartPos1.z - RStartPos2.z)); p := (Len1 + Len2 + Len3) / 2; S := SQRT(p * (p - Len1) * (p - Len2) * (p - Len3)); HLen := 2 * S / Len3; // Calc H point Len13 := SQRT(SQR(Len1) - SQR(HLen)); delta := Len13 / Len3; hp.x := RStartPos1.x + (RStartPos2.x - RStartPos1.x) * delta; hp.y := RStartPos1.y + (RStartPos2.y - RStartPos1.y) * delta; hp.z := RStartPos1.z + (RStartPos2.z - RStartPos1.z) * delta; if EQD(HLen, 0) then exit; // Calc Sides Lengths Len11 := SQRT(SQR(FResizeData.Nodep11.x - RStartPos1.x) + SQR(FResizeData.Nodep11.y - RStartPos1.y) + SQR(FResizeData.Nodep11.z - RStartPos1.z)); Len12 := SQRT(SQR(FResizeData.Nodep12.x - RStartPos2.x) + SQR(FResizeData.Nodep12.y - RStartPos2.y) + SQR(FResizeData.Nodep12.z - RStartPos2.z)); Len21 := SQRT(SQR(FResizeData.Nodep21.x - RStartPos1.x) + SQR(FResizeData.Nodep21.y - RStartPos1.y) + SQR(FResizeData.Nodep21.z - RStartPos1.z)); Len22 := SQRT(SQR(FResizeData.Nodep22.x - RStartPos2.x) + SQR(FResizeData.Nodep22.y - RStartPos2.y) + SQR(FResizeData.Nodep22.z - RStartPos2.z)); LimitLen1 := Min(Len11, Len12); LimitLen2 := Min(Len21, Len22); // Calc Lenght Vector LenToCursor1 := SQRT(SQR(FResizeData.Nodep11.x - glCursorObject.Position.x) + SQR(FResizeData.Nodep11.y - glCursorObject.Position.y) + SQR(FResizeData.Nodep11.z - glCursorObject.Position.z)); LenToCursor2 := SQRT(SQR(FResizeData.Nodep21.x - glCursorObject.Position.x) + SQR(FResizeData.Nodep21.y - glCursorObject.Position.y) + SQR(FResizeData.Nodep21.z - glCursorObject.Position.z)); LenToResizer1 := SQRT(SQR(FResizeData.Nodep11.x - hp.x) + SQR(FResizeData.Nodep11.y - hp.y) + SQR(FResizeData.Nodep11.z - hp.z)); LenToResizer2 := SQRT(SQR(FResizeData.Nodep21.x - hp.x) + SQR(FResizeData.Nodep21.y - hp.y) + SQR(FResizeData.Nodep21.z - hp.z)); // Движение к точкам первой грани if LenToCursor1 < LenToResizer1 then begin if HLen > LimitLen1 then HLen := LimitLen1; if Len11 = 0 then DLen1 := 0 else DLen1 := HLen / Len11; if Len12 = 0 then DLen2 := 0 else DLen2 := HLen / Len12; rpos1.x := RStartPos1.x - (RStartPos1.x - FResizeData.Nodep11.x) * DLen1; rpos1.y := RStartPos1.y - (RStartPos1.y - FResizeData.Nodep11.y) * DLen1; rpos1.z := RStartPos1.z - (RStartPos1.z - FResizeData.Nodep11.z) * DLen1; rpos2.x := RStartPos2.x - (RStartPos2.x - FResizeData.Nodep12.x) * DLen2; rpos2.y := RStartPos2.y - (RStartPos2.y - FResizeData.Nodep12.y) * DLen2; rpos2.z := RStartPos2.z - (RStartPos2.z - FResizeData.Nodep12.z) * DLen2; end else if LenToCursor2 < LenToResizer2 then // Движение к точкам второй грани begin if HLen > LimitLen2 then HLen := LimitLen2; if Len21 = 0 then DLen1 := 0 else DLen1 := HLen / Len21; if Len22 = 0 then DLen2 := 0 else DLen2 := HLen / Len22; rpos1.x := RStartPos1.x - (RStartPos1.x - FResizeData.Nodep21.x) * DLen1; rpos1.y := RStartPos1.y - (RStartPos1.y - FResizeData.Nodep21.y) * DLen1; rpos1.z := RStartPos1.z - (RStartPos1.z - FResizeData.Nodep21.z) * DLen1; rpos2.x := RStartPos2.x - (RStartPos2.x - FResizeData.Nodep22.x) * DLen2; rpos2.y := RStartPos2.y - (RStartPos2.y - FResizeData.Nodep22.y) * DLen2; rpos2.z := RStartPos2.z - (RStartPos2.z - FResizeData.Nodep22.z) * DLen2; end else if (LimitLen1 = 0) or (LimitLen2 = 0) then begin rpos1.x := RStartPos1.x; rpos1.y := RStartPos1.y; rpos1.z := RStartPos1.z; rpos2.x := RStartPos2.x; rpos2.y := RStartPos2.y; rpos2.z := RStartPos2.z; end; // Set Spliter Line and Cube glSpliter.Nodes[0].X := rpos1.x; glSpliter.Nodes[0].Y := rpos1.y; glSpliter.Nodes[0].Z := rpos1.z; glSpliter.Nodes[1].X := rpos2.x; glSpliter.Nodes[1].Y := rpos2.y; glSpliter.Nodes[1].Z := rpos2.z; glCubeSpliter.Position.x := (rpos1.x + rpos2.x) / 2; glCubeSpliter.Position.y := (rpos1.y + rpos2.y) / 2; glCubeSpliter.Position.z := (rpos1.z + rpos2.z) / 2; glCubeSpliter1.Position.x := rpos1.x; glCubeSpliter1.Position.y := rpos1.y; glCubeSpliter1.Position.z := rpos1.z; glCubeSpliter2.Position.x := rpos2.x; glCubeSpliter2.Position.y := rpos2.y; glCubeSpliter2.Position.z := rpos2.z; SetSideSizes; except on E: Exception do AddExceptionToLogEx('Tfrm3D.DoResize', E.Message); end; end; procedure Tfrm3D.SelectNodesEvent(Sender: TObject); var i, j, ItemIndex, Index: Integer; xObj: TGLPolygon; xCutData: TCutData; p1, p2: T3DPoint; GLPoints1, GLPoints2: T3DPointArray; Len: Integer; xGLSide: TGLPolygon; Nodep11, Nodep12, Nodep21, Nodep22, Noder11, Noder12, Noder21, Noder22: Integer; LenX, LenY, LenZ, LenXY, LenXZ, LenXYZ :double; xSide: T3DSide; begin try Index := TMenuItem(Sender).Tag; xObj := TGLPolygon(DummyCube.Children[Index]); ItemIndex := TMenuItem(Sender).MenuIndex; xCutData := TCutData(FCutDataList[ItemIndex]); // Basis Nodes SetLength(FResizeData.BasisNodes, xObj.Nodes.Count); for i := 0 to xObj.Nodes.Count - 1 do begin FResizeData.BasisNodes[i].x := xObj.Nodes[i].X; FResizeData.BasisNodes[i].y := xObj.Nodes[i].Y; FResizeData.BasisNodes[i].z := xObj.Nodes[i].Z; end; // Create Spliter p1.x := (xObj.Nodes[xCutData.Index11].x + xObj.Nodes[xCutData.Index12].x) / 2; p1.y := (xObj.Nodes[xCutData.Index11].y + xObj.Nodes[xCutData.Index12].y) / 2; p1.z := (xObj.Nodes[xCutData.Index11].z + xObj.Nodes[xCutData.Index12].z) / 2; p2.x := (xObj.Nodes[xCutData.Index21].x + xObj.Nodes[xCutData.Index22].x) / 2; p2.y := (xObj.Nodes[xCutData.Index21].y + xObj.Nodes[xCutData.Index22].y) / 2; p2.z := (xObj.Nodes[xCutData.Index21].z + xObj.Nodes[xCutData.Index22].z) / 2; glSpliter.Nodes[0].x := p1.x; glSpliter.Nodes[0].y := p1.y; glSpliter.Nodes[0].z := p1.z; glSpliter.Nodes[1].x := p2.x; glSpliter.Nodes[1].y := p2.y; glSpliter.Nodes[1].z := p2.z; glSpliter.Visible := True; // Create CubeSpliter glCubeSpliter.Position.x := (p1.x + p2.x) / 2; glCubeSpliter.Position.y := (p1.y + p2.y) / 2; glCubeSpliter.Position.z := (p1.z + p2.z) / 2; glCubeSpliter.Visible := True; glCubeSpliter1.Position.x := p1.x; glCubeSpliter1.Position.y := p1.y; glCubeSpliter1.Position.z := p1.z; glCubeSpliter1.Visible := True; glCubeSpliter2.Position.x := p2.x; glCubeSpliter2.Position.y := p2.y; glCubeSpliter2.Position.z := p2.z; glCubeSpliter2.Visible := True; // Create Side1 SetLength(GLPoints1, 0); for i := 0 to xCutData.Index11 do begin Len := Length(GLPoints1); SetLength(GLPoints1, Len + 1); GLPoints1[Len].x := xObj.Nodes[i].x; GLPoints1[Len].y := xObj.Nodes[i].y; GLPoints1[Len].z := xObj.Nodes[i].z; end; Nodep11 := Len; Len := Length(GLPoints1); SetLength(GLPoints1, Len + 2); GLPoints1[Len] := p1; Noder11 := Len; GLPoints1[Len + 1] := p2; Noder12 := Len + 1; if Len + 2 <= xCutData.Index22 then Nodep12 := Len + 2 else Nodep12 := 0; if xCutData.Index22 <> 0 then begin for i := xCutData.Index22 to xObj.Nodes.Count - 1 do begin Len := Length(GLPoints1); SetLength(GLPoints1, Len + 1); GLPoints1[Len].x := xObj.Nodes[i].x; GLPoints1[Len].y := xObj.Nodes[i].y; GLPoints1[Len].z := xObj.Nodes[i].z; end; end; // Create Side2 xGLSide := TGLPolygon(DummyCube.AddNewChild(TGLPolygon)); SetLength(GLPoints2, 0); Len := Length(GLPoints2); SetLength(GLPoints2, Len + 1); GLPoints2[Len] := p1; Noder21 := Len; Nodep21 := Len + 1; for i := xCutData.Index12 to xCutData.Index21 do begin Len := Length(GLPoints2); SetLength(GLPoints2, Len + 1); GLPoints2[Len].x := xObj.Nodes[i].x; GLPoints2[Len].y := xObj.Nodes[i].y; GLPoints2[Len].z := xObj.Nodes[i].z; end; Nodep22 := Len; Len := Length(GLPoints2); SetLength(GLPoints2, Len + 1); GLPoints2[Len] := p2; Noder22 := Len; // *************************************** xObj.Nodes.Clear; for i := 0 to Length(GLPoints1) - 1 do begin // if i > 0 then // begin // if not (EQD(GLPoints1[i].x, GLPoints1[i-1].x) and EQD(GLPoints1[i].y, GLPoints1[i-1].y) and EQD(GLPoints1[i].z, GLPoints1[i-1].z)) then // xObj.AddNode(GLPoints1[i].x, GLPoints1[i].y, GLPoints1[i].z); // end // else xObj.AddNode(GLPoints1[i].x, GLPoints1[i].y, GLPoints1[i].z); end; for i := 0 to Length(GLPoints2) - 1 do begin // if i > 0 then // begin // if not (EQD(GLPoints2[i].x, GLPoints2[i-1].x) and EQD(GLPoints2[i].y, GLPoints2[i-1].y) and EQD(GLPoints2[i].z, GLPoints2[i-1].z)) then // xGLSide.AddNode(GLPoints2[i].x, GLPoints2[i].y, GLPoints2[i].z); // end // else xGLSide.AddNode(GLPoints2[i].x, GLPoints2[i].y, GLPoints2[i].z); end; xSide := T3DSide(TTreeNode(xObj.TagObject).Data); if xSide.FFaceType = ftNetCeiling then xGLSide.Parts := [ppTop]; if xSide.FFaceType = ftNetFloor then xGLSide.Parts := [ppBottom]; if TObject(xSide.FParent) is T3DSide then CreateAddForDivSide(xObj, xGLSide) else CreateAddForParentSide(xObj, xGLSide); FResizeData.Nodep11 := xObj.Nodes[Nodep11]; FResizeData.Nodep12 := xObj.Nodes[Nodep12]; FResizeData.Noder11 := xObj.Nodes[Noder11]; FResizeData.Noder12 := xObj.Nodes[Noder12]; FResizeData.Nodep21 := xGLSide.Nodes[Nodep21]; FResizeData.Nodep22 := xGLSide.Nodes[Nodep22]; FResizeData.Noder21 := xGLSide.Nodes[Noder21]; FResizeData.Noder22 := xGLSide.Nodes[Noder22]; FResizeData.Indexp11 := Nodep11; FResizeData.Indexp12 := Nodep12; FResizeData.Indexr11 := Noder11; FResizeData.Indexr12 := Noder12; FResizeData.Indexp21 := Nodep21; FResizeData.Indexp22 := Nodep22; FResizeData.Indexr21 := Noder21; FResizeData.Indexr22 := Noder22; FResizeData.Side1 := xObj; FResizeData.Side2 := xGLSide; RStartPos1 := p1; RStartPos2 := p2; rpos1 := RStartPos1; rpos2 := RStartPos2; glSide11.Visible := True; glSide12.Visible := True; glSide21.Visible := True; glSide22.Visible := True; SetSideSizes; // *************************************** FToolMode := tmCut; except on E: Exception do AddExceptionToLogEx('Tfrm3D.SelectNodesEvent', E.Message); end; end; procedure Tfrm3D.SetSideSizes; var mp: T3DPoint; pos, cpos1, cpos2, Camera: T3DPoint; SetPos: T3DPoint; delta, offset, koef, len: double; ang: double; coord1, coord2: TDoublePoint; xSide: T3DSide; begin try xSide := T3dSide(TTreeNode(FResizeData.Side1.tagObject).Data); delta := 0.4; if xSide.FFaceType in [ftNetFloor, ftNetCeiling] then offset := 0.6 else offset := 0.4; Camera.x := GLSceneViewer.Camera.Position.x; Camera.y := GLSceneViewer.Camera.Position.y; Camera.z := GLSceneViewer.Camera.Position.z; cpos1 := DoublePoint((FResizeData.Nodep11.x + FResizeData.Nodep21.x + rpos1.x + rpos2.x) / 4, (FResizeData.Nodep11.y + FResizeData.Nodep21.y + rpos1.y + rpos2.y) / 4, (FResizeData.Nodep11.z + FResizeData.Nodep21.z + rpos1.z + rpos2.z) / 4); cpos2 := DoublePoint((FResizeData.Nodep21.x + FResizeData.Nodep22.x + rpos1.x + rpos2.x) / 4, (FResizeData.Nodep21.y + FResizeData.Nodep22.y + rpos1.y + rpos2.y) / 4, (FResizeData.Nodep21.z + FResizeData.Nodep22.z + rpos1.z + rpos2.z) / 4); // ********** 11 ************************************************************* pos.x := (FResizeData.Nodep11.x + rpos1.x) / 2; pos.y := (FResizeData.Nodep11.y + rpos1.y) / 2; pos.z := (FResizeData.Nodep11.z + rpos1.z) / 2; len := SQRT(SQR(cpos1.x - pos.x) + SQR(cpos1.y - pos.y) + SQR(cpos1.z - pos.z)); koef := offset / len; SetPos.x := pos.x + (cpos1.x - pos.x) * koef; SetPos.y := pos.y + (cpos1.y - pos.y) * koef; SetPos.z := pos.z + (cpos1.z - pos.z) * koef; pos.x := SetPos.x; pos.y := SetPos.y; pos.z := SetPos.z; len := SQRT(SQR(camera.x - pos.x) + SQR(camera.y - pos.y) + SQR(camera.z - pos.z)); koef := delta / len; SetPos.x := pos.x + (camera.x - pos.x) * koef; SetPos.y := pos.y + (camera.y - pos.y) * koef; SetPos.z := pos.z + (camera.z - pos.z) * koef; glSide11.Position.x := SetPos.x; glSide11.Position.y := SetPos.y; glSide11.Position.z := SetPos.z; coord1.x := pos.x; coord2.x := camera.x; if xSide.FFaceType in [ftNetFloor, ftNetCeiling] then begin coord1.y := pos.y; coord2.y := camera.y; glSide11.PitchAngle := 90; end else begin coord1.y := pos.z; coord2.y := camera.z; glSide11.PitchAngle := 0; end; ang := GetDistAngle(coord1, coord2); glSide11.TurnAngle := ang; Len := SQRT(SQR((FResizeData.Nodep11.x - rpos1.x) / Factor) + SQR((FResizeData.Nodep11.y - rpos1.y) / Factor) + SQR((FResizeData.Nodep11.z - rpos1.z) / Factor)); glSide11.Text := FormatFloat(ffMask, Len / FScaleDelta); // ********** 12 ************************************************************* pos.x := (FResizeData.Nodep12.x + rpos2.x) / 2; pos.y := (FResizeData.Nodep12.y + rpos2.y) / 2; pos.z := (FResizeData.Nodep12.z + rpos2.z) / 2; len := SQRT(SQR(cpos1.x - pos.x) + SQR(cpos1.y - pos.y) + SQR(cpos1.z - pos.z)); koef := offset / len; SetPos.x := pos.x + (cpos1.x - pos.x) * koef; SetPos.y := pos.y + (cpos1.y - pos.y) * koef; SetPos.z := pos.z + (cpos1.z - pos.z) * koef; pos.x := SetPos.x; pos.y := SetPos.y; pos.z := SetPos.z; len := SQRT(SQR(camera.x - pos.x) + SQR(camera.y - pos.y) + SQR(camera.z - pos.z)); koef := delta / len; SetPos.x := pos.x + (camera.x - pos.x) * koef; SetPos.y := pos.y + (camera.y - pos.y) * koef; SetPos.z := pos.z + (camera.z - pos.z) * koef; glSide12.Position.x := SetPos.x; glSide12.Position.y := SetPos.y; glSide12.Position.z := SetPos.z; coord1.x := pos.x; coord2.x := camera.x; if xSide.FFaceType in [ftNetFloor, ftNetCeiling] then begin coord1.y := pos.y; coord2.y := camera.y; glSide12.PitchAngle := 90; end else begin coord1.y := pos.z; coord2.y := camera.z; glSide12.PitchAngle := 0; end; ang := GetDistAngle(coord1, coord2); glSide12.TurnAngle := ang; Len := SQRT(SQR((FResizeData.Nodep12.x - rpos2.x) / Factor) + SQR((FResizeData.Nodep12.y - rpos2.y) / Factor) + SQR((FResizeData.Nodep12.z - rpos2.z) / Factor)); glSide12.Text := FormatFloat(ffMask, Len / FScaleDelta); // ********** 21 ************************************************************* pos.x := (FResizeData.Nodep21.x + rpos1.x) / 2; pos.y := (FResizeData.Nodep21.y + rpos1.y) / 2; pos.z := (FResizeData.Nodep21.z + rpos1.z) / 2; len := SQRT(SQR(cpos2.x - pos.x) + SQR(cpos2.y - pos.y) + SQR(cpos2.z - pos.z)); koef := offset / len; SetPos.x := pos.x + (cpos2.x - pos.x) * koef; SetPos.y := pos.y + (cpos2.y - pos.y) * koef; SetPos.z := pos.z + (cpos2.z - pos.z) * koef; pos.x := SetPos.x; pos.y := SetPos.y; pos.z := SetPos.z; len := SQRT(SQR(camera.x - pos.x) + SQR(camera.y - pos.y) + SQR(camera.z - pos.z)); koef := delta / len; SetPos.x := pos.x + (camera.x - pos.x) * koef; SetPos.y := pos.y + (camera.y - pos.y) * koef; SetPos.z := pos.z + (camera.z - pos.z) * koef; glSide21.Position.x := SetPos.x; glSide21.Position.y := SetPos.y; glSide21.Position.z := SetPos.z; coord1.x := pos.x; coord2.x := camera.x; if xSide.FFaceType in [ftNetFloor, ftNetCeiling] then begin coord1.y := pos.y; coord2.y := camera.y; glSide21.PitchAngle := 90; end else begin coord1.y := pos.z; coord2.y := camera.z; glSide21.PitchAngle := 0; end; ang := GetDistAngle(coord1, coord2); glSide21.TurnAngle := ang; Len := SQRT(SQR((FResizeData.Nodep21.x - rpos1.x) / Factor) + SQR((FResizeData.Nodep21.y - rpos1.y) / Factor) + SQR((FResizeData.Nodep21.z - rpos1.z) / Factor)); glSide21.Text := FormatFloat(ffMask, Len / FScaleDelta); // ********** 22 ************************************************************* pos.x := (FResizeData.Nodep22.x + rpos2.x) / 2; pos.y := (FResizeData.Nodep22.y + rpos2.y) / 2; pos.z := (FResizeData.Nodep22.z + rpos2.z) / 2; len := SQRT(SQR(cpos2.x - pos.x) + SQR(cpos2.y - pos.y) + SQR(cpos2.z - pos.z)); koef := offset / len; SetPos.x := pos.x + (cpos2.x - pos.x) * koef; SetPos.y := pos.y + (cpos2.y - pos.y) * koef; SetPos.z := pos.z + (cpos2.z - pos.z) * koef; pos.x := SetPos.x; pos.y := SetPos.y; pos.z := SetPos.z; len := SQRT(SQR(camera.x - pos.x) + SQR(camera.y - pos.y) + SQR(camera.z - pos.z)); koef := delta / len; SetPos.x := pos.x + (camera.x - pos.x) * koef; SetPos.y := pos.y + (camera.y - pos.y) * koef; SetPos.z := pos.z + (camera.z - pos.z) * koef; glSide22.Position.x := SetPos.x; glSide22.Position.y := SetPos.y; glSide22.Position.z := SetPos.z; coord1.x := pos.x; coord2.x := camera.x; if xSide.FFaceType in [ftNetFloor, ftNetCeiling] then begin coord1.y := pos.y; coord2.y := camera.y; glSide22.PitchAngle := 90; end else begin coord1.y := pos.z; coord2.y := camera.z; glSide22.PitchAngle := 0; end; ang := GetDistAngle(coord1, coord2); glSide22.TurnAngle := ang; Len := SQRT(SQR((FResizeData.Nodep22.x - rpos2.x) / Factor) + SQR((FResizeData.Nodep22.y - rpos2.y) / Factor) + SQR((FResizeData.Nodep22.z - rpos2.z) / Factor)); glSide22.Text := FormatFloat(ffMask, Len / FScaleDelta); except on E: Exception do AddExceptionToLogEx('Tfrm3D.SetSideSizes', E.Message); end; end; procedure Tfrm3D.AfterUpdate; var glObjClass: TGLSceneObjectClass; glNodeNbr: TGLSpaceText; xColor: TVector4f; begin try xColor := clrBlack; FToolMode := tmSelect; FNodesObjectsList := TList.Create; FCutDataList := TList.Create; FResizeData := TResizeData.Create; FResizer := False; 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 := lnaInvisible; glSpliter.Visible := False; glCubeSpliter := TGLCube(DummyCube.AddNewChild(TGLCube)); glCubeSpliter.CubeDepth := 0.3; // Z glCubeSpliter.CubeHeight := 0.3; // Y glCubeSpliter.CubeWidth := 0.3; // X glCubeSpliter1 := TGLCube(DummyCube.AddNewChild(TGLCube)); glCubeSpliter1.CubeDepth := 0.2; // Z glCubeSpliter1.CubeHeight := 0.2; // Y glCubeSpliter1.CubeWidth := 0.2; // X glCubeSpliter2 := TGLCube(DummyCube.AddNewChild(TGLCube)); glCubeSpliter2.CubeDepth := 0.2; // Z glCubeSpliter2.CubeHeight := 0.2; // Y glCubeSpliter2.CubeWidth := 0.2; // X with glCubeSpliter.Material do begin FrontProperties.Ambient.Color := clrBlack; FrontProperties.Diffuse.Color := clrBlack; FrontProperties.Emission.Color := clrBlack; BackProperties.Ambient.Color := clrBlack; BackProperties.Diffuse.Color := clrBlack; BackProperties.Emission.Color := clrBlack; end; glCubeSpliter.Visible := False; with glCubeSpliter1.Material do begin FrontProperties.Ambient.Color := clrBlack; FrontProperties.Diffuse.Color := clrBlack; FrontProperties.Emission.Color := clrBlack; BackProperties.Ambient.Color := clrBlack; BackProperties.Diffuse.Color := clrBlack; BackProperties.Emission.Color := clrBlack; end; glCubeSpliter1.Visible := False; with glCubeSpliter2.Material do begin FrontProperties.Ambient.Color := clrBlack; FrontProperties.Diffuse.Color := clrBlack; FrontProperties.Emission.Color := clrBlack; BackProperties.Ambient.Color := clrBlack; BackProperties.Diffuse.Color := clrBlack; BackProperties.Emission.Color := clrBlack; end; glCubeSpliter2.Visible := False; ToggleTraceCaptions(cbShowTraceCaptions.Checked); //29.03.2011 except on E: Exception do AddExceptionToLogEx('Tfrm3D.AfterUpdate', E.Message); end; end; procedure Tfrm3D.GLSceneViewerMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin try if Button = mbRight then if (mdx = X) and (mdy = Y) then OnRightClick; if FToolMode = tmSelect then begin if FMovedObject <> nil then begin Set3DSObjectPos(FMovedObject); FMovedObject := nil; GLSceneViewer.Cursor := crDefault; end; if FRotatedObject <> nil then begin FRotatedObject := nil; 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; glCubeSpliter1.Position.x := rpos1.x; glCubeSpliter1.Position.y := rpos1.y; glCubeSpliter1.Position.z := rpos1.z; glCubeSpliter2.Position.x := rpos2.x; glCubeSpliter2.Position.y := rpos2.y; glCubeSpliter2.Position.z := rpos2.z; GLSceneViewer.Cursor := crDefault; SetSideSizes; { //Full Reset FToolMode := tmSelect; glSpliter.Visible := False; glCubeSpliter.Visible := False; glSide11.Visible := False; glSide12.Visible := False; glSide21.Visible := False; glSide22.Visible := False; DeleteNodesObjects; GLSceneViewer.Cursor := crDefault; } end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.GLSceneViewerMouseUp', E.Message); end; end; procedure Tfrm3D.CreateAddForDivSide(aSide, aAddSide: TGLPolygon); var i, j: Integer; xNode, xParentNode, xAddNode: TTreeNode; xParentSide, xSide, xAddSide: T3DSide; tmpdir, tmpfname, ExtStr, BmpFName: string; HashStr: string; ZOrder: Double; begin try // Create Model Object xNode := TTreeNode(aSide.TagObject); xParentNode := xNode.Parent; // Create xSide := T3DSide(xNode.Data); SetLength(xSide.FPoints, aSide.Nodes.Count); SetLength(xSide.FGLPoints, aSide.Nodes.Count); ZOrder := xSide.FZOrder; for i := 0 to Length(xSide.FGLPoints) - 1 do begin xSide.FGLPoints[i].x := aSide.Nodes[i].X; xSide.FGLPoints[i].y := aSide.Nodes[i].Y - ZOrder; xSide.FGLPoints[i].z := aSide.Nodes[i].Z; end; for i := 0 to Length(xSide.FPoints) - 1 do begin xSide.FPoints[i].x := xSide.FGLPoints[i].x / Factor; xSide.FPoints[i].z := xSide.FGLPoints[i].y / Factor; xSide.FPoints[i].y := xSide.FGLPoints[i].z / Factor; end; xAddSide := T3DSide.Create(xSide.FFaceType, xSide.FWallType, xSide.FSideType, xSide.FParent); xAddSide.FName := cSubSide + IntToStr(xParentNode.Count + 1); xAddSide.FDescription.Text := xSide.FDescription.Text; xAddSide.FGLObject := aAddSide; xAddSide.FFace := nil; xAddSide.FColor := xSide.FColor; xAddSide.FTextureRotate := xSide.FTextureRotate; xAddSide.FTextureScale := xSide.FTextureScale; xAddSide.FMirror := xSide.FMirror; xAddSide.FTextureHash := xSide.FTextureHash; xAddSide.FTexture_ext := xSide.FTexture_ext; xAddSide.FZOrder := xSide.FZOrder; SetLength(xAddSide.FPoints, aAddSide.Nodes.Count); SetLength(xAddSide.FGLPoints, aAddSide.Nodes.Count); ZOrder := xAddSide.FZOrder; for i := 0 to Length(xAddSide.FGLPoints) - 1 do begin xAddSide.FGLPoints[i].x := aAddSide.Nodes[i].X; xAddSide.FGLPoints[i].y := aAddSide.Nodes[i].Y - ZOrder; xAddSide.FGLPoints[i].z := aAddSide.Nodes[i].Z; end; for i := 0 to Length(xAddSide.FPoints) - 1 do begin xAddSide.FPoints[i].x := xAddSide.FGLPoints[i].x / Factor; xAddSide.FPoints[i].z := xAddSide.FGLPoints[i].y / Factor; xAddSide.FPoints[i].y := xAddSide.FGLPoints[i].z / Factor; end; if xSide.FParent is T3DSide then T3DSide(xSide.FParent).FSubSides.Add(xAddSide); // Create Node xAddNode := ModelTree.Items.AddChild(xParentNode, xAddSide.FName); xAddNode.Data := xAddSide; xAddNode.ImageIndex := 50; 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.DestroyHandles; //aAddSide.Material.Texture.Image.LoadFromFile(tmpfname); aAddSide.Material.Texture.Image.Assign(aSide.Material.Texture.Image); RotateTextureToAngleP(xAddSide, aAddSide, xAddSide.FTextureRotate, xAddSide.FMirror); end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.CreateAddForDivSide', E.Message); end; end; procedure Tfrm3D.CreateAddForParentSide(aFirstSide, aSecondSide: TGLPolygon); var i, j: Integer; xParentNode, xFirstNode, xSecondNode: TTreeNode; xParentSide, xFirstSide, xSecondSide: T3DSide; tmpdir, tmpfname, ExtStr, BmpFName: string; HashStr: string; ZOrder: Double; begin try // Create Model Object xParentNode := TTreeNode(aFirstSide.TagObject); xParentSide := T3DSide(xParentNode.Data); // CREATE FIRST xFirstSide := T3DSide.Create(xParentSide.FFaceType, xParentSide.FWallType, xParentSide.FSideType, xParentSide); xFirstSide.FName := cSubSide + IntToStr(xParentNode.Count + 1); xFirstSide.FDescription.Text := xParentSide.FDescription.Text; xFirstSide.FGLObject := aFirstSide; xFirstSide.FFace := nil; xFirstSide.FColor := xParentSide.FColor; xFirstSide.FTextureRotate := xParentSide.FTextureRotate; xFirstSide.FTextureScale := xParentSide.FTextureScale; xFirstSide.FMirror := xParentSide.FMirror; xFirstSide.FTextureHash := xParentSide.FTextureHash; xFirstSide.FTexture_ext := xParentSide.FTexture_ext; xFirstSide.FZOrder := xParentSide.FZOrder; SetLength(xFirstSide.FPoints, aFirstSide.Nodes.Count); SetLength(xFirstSide.FGLPoints, aFirstSide.Nodes.Count); ZOrder := xFirstSide.FZOrder; for i := 0 to Length(xFirstSide.FGLPoints) - 1 do begin xFirstSide.FGLPoints[i].x := aFirstSide.Nodes[i].X; xFirstSide.FGLPoints[i].y := aFirstSide.Nodes[i].Y - ZOrder; xFirstSide.FGLPoints[i].z := aFirstSide.Nodes[i].Z; end; for i := 0 to Length(xFirstSide.FPoints) - 1 do begin xFirstSide.FPoints[i].x := xFirstSide.FGLPoints[i].x / Factor; xFirstSide.FPoints[i].z := xFirstSide.FGLPoints[i].y / Factor; xFirstSide.FPoints[i].y := xFirstSide.FGLPoints[i].z / Factor; end; xParentSide.FSubSides.Add(xFirstSide); xFirstNode := ModelTree.Items.AddChild(xParentNode, xFirstSide.FName); xFirstNode.Data := xFirstSide; xFirstNode.ImageIndex := 50; aFirstSide.TagObject := xFirstNode; // CREATE SECOND xSecondSide := T3DSide.Create(xParentSide.FFaceType, xParentSide.FWallType, xParentSide.FSideType, xParentSide); xSecondSide.FName := cSubSide + IntToStr(xParentNode.Count + 1); xSecondSide.FDescription.Text := xParentSide.FDescription.Text; xSecondSide.FGLObject := aSecondSide; xSecondSide.FFace := nil; xSecondSide.FColor := xParentSide.FColor; xSecondSide.FTextureRotate := xParentSide.FTextureRotate; xSecondSide.FTextureScale := xParentSide.FTextureScale; xSecondSide.FMirror := xParentSide.FMirror; xSecondSide.FTextureHash := xParentSide.FTextureHash; xSecondSide.FTexture_ext := xParentSide.FTexture_ext; xSecondSide.FZOrder := xParentSide.FZOrder; SetLength(xSecondSide.FPoints, aSecondSide.Nodes.Count); SetLength(xSecondSide.FGLPoints, aSecondSide.Nodes.Count); ZOrder := xSecondSide.FZOrder; for i := 0 to Length(xSecondSide.FGLPoints) - 1 do begin xSecondSide.FGLPoints[i].x := aSecondSide.Nodes[i].X; xSecondSide.FGLPoints[i].y := aSecondSide.Nodes[i].Y - ZOrder; xSecondSide.FGLPoints[i].z := aSecondSide.Nodes[i].Z; end; for i := 0 to Length(xSecondSide.FPoints) - 1 do begin xSecondSide.FPoints[i].x := xSecondSide.FGLPoints[i].x / Factor; xSecondSide.FPoints[i].z := xSecondSide.FGLPoints[i].y / Factor; xSecondSide.FPoints[i].y := xSecondSide.FGLPoints[i].z / Factor; end; xParentSide.FSubSides.Add(xSecondSide); xSecondNode := ModelTree.Items.AddChild(xParentNode, xSecondSide.FName); xSecondNode.Data := xSecondSide; xSecondNode.ImageIndex := 50; 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.DestroyHandles; //aSecondSide.Material.Texture.Image.LoadFromFile(tmpfname); aSecondSide.Material.Texture.Image.Assign(aFirstSide.Material.Texture.Image); RotateTextureToAngleP(xSecondSide, aSecondSide, xSecondSide.FTextureRotate, xSecondSide.FMirror); end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.CreateAddForParentSide', E.Message); end; end; procedure Tfrm3D.SetSidesData; var xNode: TTreeNode; xSide1, xSide2: T3DSide; ZOrder: Double; begin try FResizeData.Noder11.X := rpos1.x; FResizeData.Noder11.Y := rpos1.y; FResizeData.Noder11.Z := rpos1.z; FResizeData.Noder12.X := rpos2.x; FResizeData.Noder12.Y := rpos2.y; FResizeData.Noder12.Z := rpos2.z; FResizeData.Noder21.X := rpos1.x; FResizeData.Noder21.Y := rpos1.y; FResizeData.Noder21.Z := rpos1.z; FResizeData.Noder22.X := rpos2.x; FResizeData.Noder22.Y := rpos2.y; FResizeData.Noder22.Z := rpos2.z; xNode := TTreeNode(FResizeData.Side1.TagObject); xSide1 := T3DSide(xNode.Data); xNode := TTreeNode(FResizeData.Side2.TagObject); xSide2 := T3DSide(xNode.Data); ZOrder := xSide1.FZOrder; xSide1.FGLPoints[FResizeData.Indexr11].x := FResizeData.Noder11.X; xSide1.FGLPoints[FResizeData.Indexr11].y := FResizeData.Noder11.Y - ZOrder; xSide1.FGLPoints[FResizeData.Indexr11].z := FResizeData.Noder11.Z; xSide1.FGLPoints[FResizeData.Indexr12].x := FResizeData.Noder12.X; xSide1.FGLPoints[FResizeData.Indexr12].y := FResizeData.Noder12.Y - ZOrder; xSide1.FGLPoints[FResizeData.Indexr12].z := FResizeData.Noder12.Z; xSide1.FPoints[FResizeData.Indexr11].x := xSide1.FGLPoints[FResizeData.Indexr11].x / Factor; xSide1.FPoints[FResizeData.Indexr11].z := xSide1.FGLPoints[FResizeData.Indexr11].y / Factor; xSide1.FPoints[FResizeData.Indexr11].y := xSide1.FGLPoints[FResizeData.Indexr11].z / Factor; xSide1.FPoints[FResizeData.Indexr12].x := xSide1.FGLPoints[FResizeData.Indexr12].x / Factor; xSide1.FPoints[FResizeData.Indexr12].z := xSide1.FGLPoints[FResizeData.Indexr12].y / Factor; xSide1.FPoints[FResizeData.Indexr12].y := xSide1.FGLPoints[FResizeData.Indexr12].z / Factor; ZOrder := xSide2.FZOrder; xSide2.FGLPoints[FResizeData.Indexr21].x := FResizeData.Noder21.X; xSide2.FGLPoints[FResizeData.Indexr21].y := FResizeData.Noder21.Y - ZOrder; xSide2.FGLPoints[FResizeData.Indexr21].z := FResizeData.Noder21.Z; xSide2.FGLPoints[FResizeData.Indexr22].x := FResizeData.Noder22.X; xSide2.FGLPoints[FResizeData.Indexr22].y := FResizeData.Noder22.Y - ZOrder; xSide2.FGLPoints[FResizeData.Indexr22].z := FResizeData.Noder22.Z; xSide2.FPoints[FResizeData.Indexr21].x := xSide2.FGLPoints[FResizeData.Indexr21].x / Factor; xSide2.FPoints[FResizeData.Indexr21].z := xSide2.FGLPoints[FResizeData.Indexr21].y / Factor; xSide2.FPoints[FResizeData.Indexr21].y := xSide2.FGLPoints[FResizeData.Indexr21].z / Factor; xSide2.FPoints[FResizeData.Indexr22].x := xSide2.FGLPoints[FResizeData.Indexr22].x / Factor; xSide2.FPoints[FResizeData.Indexr22].z := xSide2.FGLPoints[FResizeData.Indexr22].y / Factor; xSide2.FPoints[FResizeData.Indexr22].y := xSide2.FGLPoints[FResizeData.Indexr22].z / Factor; except on E: Exception do AddExceptionToLogEx('Tfrm3D.SetSidesData', E.Message); end; end; procedure Tfrm3D.RefreshSidesPoints; var i, j: integer; xGLSide1, xGLSide2: TGLPolygon; xNode: TTreeNode; xSide1, xSide2: T3DSide; ZOrder: Double; begin try xGLSide1 := FResizeData.Side1; xGLSide2 := FResizeData.Side2; xNode := TTreeNode(xGLSide1.TagObject); xSide1 := T3DSide(xNode.Data); xNode := TTreeNode(xGLSide2.TagObject); xSide2 := T3DSide(xNode.Data); i := 0; while i < xGLSide1.Nodes.Count do begin if i > 0 then begin if EQD(xGLSide1.Nodes[i].x, xGLSide1.Nodes[i-1].x) and EQD(xGLSide1.Nodes[i].y, xGLSide1.Nodes[i-1].y) and EQD(xGLSide1.Nodes[i].z, xGLSide1.Nodes[i-1].z) then xGLSide1.Nodes.Delete(i) else i := i + 1; end else i := i + 1; end; SetLength(xSide1.FGLPoints, xGLSide1.Nodes.Count); SetLength(xSide1.FPoints, xGLSide1.Nodes.Count); ZOrder := xSide1.FZOrder; for i := 0 to xGLSide1.Nodes.Count - 1 do begin xSide1.FGLPoints[i].x := xGLSide1.Nodes[i].x; xSide1.FGLPoints[i].y := xGLSide1.Nodes[i].y - ZOrder; xSide1.FGLPoints[i].z := xGLSide1.Nodes[i].z; xSide1.FPoints[i].x := xSide1.FGLPoints[i].x / Factor; xSide1.FPoints[i].z := xSide1.FGLPoints[i].y / Factor; xSide1.FPoints[i].y := xSide1.FGLPoints[i].z / Factor; end; i := 0; while i < xGLSide2.Nodes.Count do begin if i > 0 then begin if EQD(xGLSide2.Nodes[i].x, xGLSide2.Nodes[i-1].x) and EQD(xGLSide2.Nodes[i].y, xGLSide2.Nodes[i-1].y) and EQD(xGLSide2.Nodes[i].z, xGLSide2.Nodes[i-1].z) then xGLSide2.Nodes.Delete(i) else i := i + 1; end else i := i + 1; end; SetLength(xSide2.FGLPoints, xGLSide2.Nodes.Count); SetLength(xSide2.FPoints, xGLSide2.Nodes.Count); ZOrder := xSide2.FZOrder; for i := 0 to xGLSide2.Nodes.Count - 1 do begin xSide2.FGLPoints[i].x := xGLSide2.Nodes[i].x; xSide2.FGLPoints[i].y := xGLSide2.Nodes[i].y - ZOrder; xSide2.FGLPoints[i].z := xGLSide2.Nodes[i].z; xSide2.FPoints[i].x := xSide2.FGLPoints[i].x / Factor; xSide2.FPoints[i].z := xSide2.FGLPoints[i].y / Factor; xSide2.FPoints[i].y := xSide2.FGLPoints[i].z / Factor; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.RefreshSidesPoints', E.Message); end; end; procedure Tfrm3D.FormCloseQuery(Sender: TObject; var CanClose: Boolean); var i, Res: Integer; mess: string; xIDList: integer; xFileStream: string; begin try GLCadencer.Enabled := False; {$IF Defined(ES_GRAPH_SC)} mess := 'Сохранить модель?'; Res := MessageBox(self.Handle, PAnsiChar(mess), 'Сохранение модели', MB_YESNOCANCEL); if Res = IDYES then begin if FToolMode <> tmSelect then begin RefreshSidesPoints; UndoCutSides; end; for i := 0 to FIdsStream.Count - 1 do begin xIDList := FIdsStream.Items[i]; xFileStream := FFilesStream.Strings[i]; SaveModelToStream(xFileStream, xIDList); end; GSaved3DModelExist := True; end else if Res = IDNO then begin { if FToolMode <> tmSelect then begin RefreshSidesPoints; UndoCutSides; end; } end else if Res = IDCANCEL then begin CanClose := False; GLCadencer.Enabled := True; end; {$ELSE} {$IFEND} except on E: Exception do AddExceptionToLogEx('Tfrm3D.FormCloseQuery', E.Message); end; end; procedure Tfrm3D.sbSaveModelClick(Sender: TObject); var i: integer; xIDList: integer; xFileStream: string; begin try for i := 0 to FIdsStream.Count - 1 do begin xIDList := FIdsStream.Items[i]; xFileStream := FFilesStream.Strings[i]; SaveModelToStream(xFileStream, xIDList); end; GSaved3DModelExist := True; except on E: Exception do AddExceptionToLogEx('Tfrm3D.sbSaveModelClick', E.Message); end; end; procedure Tfrm3D.SaveModelToStream(const AFile: String; AListID: Integer); var fFileName: string; 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]); if (xRoom.FListID <> AListID) or (not xRoom.FVisible) then continue; ModelObjectsList.Add(xRoom); // добавить потолок в комнаты xSide := xRoom.FCeiling; ModelObjectsList.Add(xSide); for j := 0 to xSide.FSubSides.Count - 1 do begin xSubSide := T3DSide(xSide.FSubSides[j]); ModelObjectsList.Add(xSubSide); end; // добавить пол в комнату 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; AListID: Integer); 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 begin FreeAndNil(ModelObjectsList); exit; end; xStream := SafeOpenFileStream(fFileName, fmOpenRead or fmShareExclusive, 'Tfrm3D.LoadModelFromStream'); if xStream.Size = 0 then begin try FreeAndNil(xStream); except end; FreeAndNil(ModelObjectsList); exit; end; xStream.Read(xSize, 4); mStream := TMemoryStream.Create; StreamToStream(xStream, mStream, xSize); mStream.Seek(0, soFromBeginning); SetModelData(mStream); FreeAndNil(mStream); 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)) and (Not xSide.FAsArc) then begin if (FSelection.Count = 1) and (TGLBaseSceneObject(FSelection[0]) = xObj) then begin // Create Nodes Texts CreateNodesObjects(TGLPolygon(xObj)); // Create PopumMenu Index := DummyCube.IndexOfChild(xObj); FCutDataList.Clear; pmCut.Items.Clear; for i := 0 to TGLPolygon(xObj).Nodes.Count - 1 do begin Str := ''; for j := i + 2 to TGLPolygon(xObj).Nodes.Count - 1 do begin Str := 'Разрезать: ' + IntToStr(i+1) + ',' + IntToStr(i+2) + '-'; if j + 1 < TGLPolygon(xObj).Nodes.Count then begin Str := Str + IntToStr(j+1) + ',' + IntToStr(j+2); Item := TMenuItem.Create(pmCut); Item.Caption := Str; pmCut.Items.Add(Item); Item.Tag := Index; Item.OnClick := SelectNodesEvent; xCutData := TCutData.create; xCutData.Index11 := i; xCutData.Index12 := i + 1; xCutData.Index21 := j; xCutData.Index22 := j + 1; FCutDataList.Add(xCutData); end else begin if i <> 0 then begin Str := Str + IntToStr(j+1) + ',' + IntToStr(1); Item := TMenuItem.Create(pmCut); Item.Caption := Str; pmCut.Items.Add(Item); Item.Tag := Index; Item.OnClick := SelectNodesEvent; xCutData := TCutData.create; xCutData.Index11 := i; xCutData.Index12 := i + 1; xCutData.Index21 := j; xCutData.Index22 := 0; FCutDataList.Add(xCutData); end; end; end; end; pmCut.Popup(X, Y); end; end; end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.OnRightClick', E.Message); end; end; procedure Tfrm3D.Set3DSObjectPos(aGLObject: TGLFreeForm); var i: integer; xObject: T3DSObject; begin try xObject := T3DSObject(TTreeNode(aGLObject.TagObject).Data); xObject.FPosition.x := aGLObject.Position.x; xObject.FPosition.y := aGLObject.Position.y - xObject.FZOrder; xObject.FPosition.z := aGLObject.Position.z; edPosX.Text := FloatToStr(xObject.FPosition.x); edPosY.Text := FloatToStr(xObject.FPosition.y); edPosZ.Text := FloatToStr(xObject.FPosition.z); except on E: Exception do AddExceptionToLogEx('Tfrm3D.Set3DSObjectPos', E.Message); end; end; procedure Tfrm3D.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; procedure Tfrm3D.ToggleTraceCaptions(AShow: Boolean); var i: integer; GLBaseSceneObject: TGLBaseSceneObject; begin for i := 0 to DummyCube.Count - 1 do begin GLBaseSceneObject := DummyCube.Children[i]; if GLBaseSceneObject.ClassName = 'TGLSpaceText' then if (GLBaseSceneObject.Tag <> 0) and (TObject(GLBaseSceneObject.Tag) is TOrthoLine) then GLBaseSceneObject.Visible := AShow; end; end; procedure Tfrm3D.Edit2Exit(Sender: TObject); begin FirstPersonCamera.FocalLength := strtoint(Edit2.Text); GLCamera.FocalLength := strtoint(Edit2.Text); GLCamera.DepthOfView := 100; end; procedure Tfrm3D.btnEmptyClick(Sender: TObject); begin if btnEmpty.Down then begin mDesc.Lines.Text := ''; end else mDesc.Lines.Text := 'empty'; if btnEmpty.GroupIndex <> 0 then begin mDesc.Lines.Text := ''; end else mDesc.Lines.Text := 'empty'; ChangeDesc; end; procedure Tfrm3D.NDel3DObjectClick(Sender: TObject); var i, j: Integer; x3DObject: T3DSObject; xSideNode: TTreeNode; xGLObject: TGLBaseSceneObject; xRoom: T3DRoom; begin try if ModelTree.SelectionCount = 1 then begin xSideNode := ModelTree.Selections[0]; x3DObject := T3DSObject(xSideNode.Data); xGLObject := TGLBaseSceneObject(x3DObject.FGLObject); FSelection.Remove(xGLObject); //add DummyCube.Remove(xGLObject, True); xSideNode.Free; xRoom := x3DObject.FParent; xRoom.F3DSObjects.Delete(xRoom.F3DSObjects.IndexOf(x3DObject)); FreeAndNil(x3DObject); end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.nDelete3DObjectClick', E.Message); end; end; function Tfrm3D.GetObjectFileByHash(aHash: string): string; var i: integer; tmpdir, tmpfname, str: string; begin try Result := ''; if aHash <> '' then begin tmpdir := 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 + '.3ds'; if FileExists(tmpfname) then begin Result := tmpfname; exit; end; end; end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.GetObjectFileByHash', E.Message); end; end; procedure Tfrm3D.LoadModelAddParamsFromStream(const AFile: String); var fFileName: string; Buffer: array[0..1023] of Char; TempPath: string; xStream: TFileStream; xSize: Integer; mStream: TMemoryStream; begin try 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.LoadModelAddParamsFromStream'); if xStream.Size = 0 then begin try FreeAndNil(xStream); except end; exit; end; xStream.Read(xSize, 4); mStream := TMemoryStream.Create; StreamToStream(xStream, mStream, xSize); mStream.Seek(0, soFromBeginning); SetFileData(mStream); FreeAndNil(mStream); FreeAndNil(xStream); except on E: Exception do AddExceptionToLogEx('Tfrm3D.LoadModelAddParamsFromStream', E.Message); end; end; procedure Tfrm3D.SaveModelAddParamsToStream(const AFile: String); var fFileName: string; Buffer: array[0..1023] of Char; TempPath: string; xStream: TFileStream; xSize: Integer; mStream: TMemoryStream; begin try 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.SaveModelAddParamsToStream'); xSize := 0; mStream := TMemoryStream.Create; GetFileData(mStream); xSize := mStream.Size; mStream.Seek(0, soFromBeginning); xStream.Write(xSize, 4); StreamToStream(mStream, xStream, xSize); FreeAndNil(mStream); FreeAndNil(xStream); except on E: Exception do AddExceptionToLogEx('Tfrm3D.SaveModelAddParamsToStream', E.Message); end; end; procedure Tfrm3D.GetFileData(Stream: TStream); var i, xCount: integer; xSize: Integer; xStream: TFileStream; xFiles: TStringList; SearchRec: TSearchRec; tmpdir, FName: string; begin try tmpdir := ExtractDirByCategoryType(dctPictures); xFiles := TStringList.Create; // Save sides textures if (FindFirst(tmpdir + '\*.bmp', faAnyFile, SearchRec) = 0) or (FindFirst(tmpdir + '\*.jpg', faAnyFile, SearchRec) = 0) then begin repeat if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then begin if not (SearchRec.Attr and faDirectory = faDirectory) then xFiles.Add(SearchRec.Name); end; until FindNext(SearchRec) <> 0; FindClose(SearchRec); end; xCount := xFiles.Count; Stream.Write(xCount, 4); for i := 0 to xCount - 1 do begin WriteString(Stream, xFiles.Strings[i]); FName := tmpdir + '\' + xFiles.Strings[i]; xStream := TFileStream.Create(FName, fmOpenRead); xSize := xStream.Size; xStream.Seek(0,soFromBeginning); Stream.Write(xSize, 4); StreamToStream(xStream, Stream, xSize); FreeAndNil(xStream); end; xFiles.Clear; // Save 3ds Objects if FindFirst(tmpdir + '\*.3ds', faAnyFile, SearchRec) = 0 then begin repeat if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then begin if not (SearchRec.Attr and faDirectory = faDirectory) then xFiles.Add(SearchRec.Name); end; until FindNext(SearchRec) <> 0; FindClose(SearchRec); end; xCount := xFiles.Count; Stream.Write(xCount, 4); for i := 0 to xCount - 1 do begin WriteString(Stream, xFiles.Strings[i]); FName := tmpdir + '\' + xFiles.Strings[i]; xStream := TFileStream.Create(FName, fmOpenRead); xSize := xStream.Size; xStream.Seek(0,soFromBeginning); Stream.Write(xSize, 4); StreamToStream(xStream, Stream, xSize); FreeAndNil(xStream); end; FreeAndNil(xFiles); except on E: Exception do AddExceptionToLogEx('Tfrm3D.GetFileData', E.Message); end; end; procedure Tfrm3D.SetFileData(Stream: TStream); var i, xCount: integer; xSize: Integer; xStream: TMemoryStream; //TFileStream; xFiles: TStringList; SearchRec: TSearchRec; tmpdir, FName, xFileName: string; begin try tmpdir := ExtractDirByCategoryType(dctPictures); // Load Sides Textures Stream.Read(xCount, 4); for i := 0 to xCount - 1 do begin xFileName := ReadStringFromStream(Stream); FName := tmpdir + '\test_texture\' + xFileName; Stream.Read(xSize, 4); xStream := TMemoryStream.Create; StreamToStream(Stream, xStream, xSize); xStream.Seek(0,soFromBeginning); if not FileExists(FName) then xStream.SaveToFile(FName); FreeAndNil(xStream); end; // Load 3ds Objects Stream.Read(xCount, 4); for i := 0 to xCount - 1 do begin xFileName := ReadStringFromStream(Stream); FName := tmpdir + '\test_3ds\' + xFileName; Stream.Read(xSize, 4); xStream := TMemoryStream.Create; StreamToStream(Stream, xStream, xSize); xStream.Seek(0,soFromBeginning); if not FileExists(FName) then xStream.SaveToFile(FName); FreeAndNil(xStream); end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.SetFileData', E.Message); end; end; procedure Tfrm3D.LoadSelectionData; var i, j: integer; Cad: TF_Cad; xName: string; begin try cbLists.Properties.Items.Clear; if G3DModelForProject then // for project begin for i := 0 to FSCS_Main.MDIChildCount - 1 do begin Cad := TF_CAD(FSCS_Main.MDIChildren[i]); xName := Cad.FCADListName + ' ' + IntToStr(Cad.FCADListIndex); cbLists.Properties.Items.Add(xName); if FSCS_Main.ActiveMDIChild = Cad then cbLists.ItemIndex := i; end; end else // for list only begin Cad := TF_CAD(FSCS_Main.ActiveMDIChild); xName := Cad.FCADListName + ' ' + IntToStr(Cad.FCADListIndex); cbLists.Properties.Items.Add(xName); cbLists.ItemIndex := 0; end; cbObjectsTypes.Properties.Items.Clear; cbObjectsTypes.Properties.Items.Add(''); // 0 cbObjectsTypes.Properties.Items.Add('Стены'); // 1 cbObjectsTypes.Properties.Items.Add('Двери'); // 2 cbObjectsTypes.Properties.Items.Add('Окна'); // 3 cbObjectsTypes.Properties.Items.Add('Балконы'); // 4 cbObjectsTypes.Properties.Items.Add('Откосы'); // 5 cbObjectsTypes.Properties.Items.Add('Арки'); // 6 cbObjectsTypes.Properties.Items.Add('Ниши'); // 7 cbObjectsTypes.Properties.Items.Add('Полы'); // 8 cbObjectsTypes.Properties.Items.Add('Потолки'); // 9 cbObjectsTypes.Properties.Items.Add('Внутренние грани'); // 10 cbObjectsTypes.Properties.Items.Add('Внешние грани'); // 11 cbObjectsTypes.Properties.Items.Add('3ds объекты'); // 12 cbObjectsTypes.ItemIndex := 0; except on E: Exception do AddExceptionToLogEx('Tfrm3D.LoadSelectionData', E.Message); end; end; procedure Tfrm3D.cbListsPropertiesCloseUp(Sender: TObject); begin try cbObjectsTypes.ItemIndex := 0; ModelTree.ClearSelection; DeselectGLObjects; except on E: Exception do AddExceptionToLogEx('Tfrm3D.cbListsPropertiesCloseUp', E.Message); end; end; procedure Tfrm3D.cbObjectsTypesPropertiesCloseUp(Sender: TObject); begin try ModelTree.ClearSelection; if cbObjectsTypes.ItemIndex = 0 then begin DeselectGLObjects; end else begin FindSelectNodesByType(cbObjectsTypes.ItemIndex); end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.cbObjectsTypesPropertiesCloseUp', E.Message); end; end; procedure Tfrm3D.FindSelectNodesByType(aType: Integer); var i: integer; xModelNode, xNode: TTreeNode; xNodes, xSides, SelNodes: TList; xSide: T3DSide; xObject: T3DSObject; begin try xNodes := TList.Create; xModelNode := ModelTree.Items.GetFirstNode; xNode := xModelNode.getFirstChild; while xNode <> nil do begin if xNode.Text = cbLists.Text then break; xNode := xNode.GetNextSibling; end; xNodes.Add(xNode); xSides := GetAllSidesNodesByNodes(xNodes); FreeAndNil(xNodes); SelNodes := TList.Create; for i := 0 to xSides.Count - 1 do begin xNode := TTreeNode(xSides[i]); case aType of 1: begin if TObject(xNode.Data) is T3DSide then begin xSide := T3DSide(xNode.Data); if xSide.FFaceType = ftNetPath then begin ModelTree.Select(xNode, [ssCtrl]); SelNodes.Add(xNode); end; end; end; 2: begin if TObject(xNode.Data) is T3DSide then begin xSide := T3DSide(xNode.Data); if xSide.FFaceType = ftNetDoor then begin ModelTree.Select(xNode, [ssCtrl]); SelNodes.Add(xNode); end; end; end; 3: begin if TObject(xNode.Data) is T3DSide then begin xSide := T3DSide(xNode.Data); if xSide.FFaceType = ftNetWindow then begin ModelTree.Select(xNode, [ssCtrl]); SelNodes.Add(xNode); end; end; end; 4: begin if TObject(xNode.Data) is T3DSide then begin xSide := T3DSide(xNode.Data); if (xSide.FFaceType = ftNetBalconDoor) or (xSide.FFaceType = ftNetBalconWindow) then begin ModelTree.Select(xNode, [ssCtrl]); SelNodes.Add(xNode); end; end; end; 5: begin if TObject(xNode.Data) is T3DSide then begin xSide := T3DSide(xNode.Data); if xSide.FWallType in [fwtDoorSlope, fwtWindowSlope, fwtBalconSlope] then begin ModelTree.Select(xNode, [ssCtrl]); SelNodes.Add(xNode); end; end; end; 6: begin if TObject(xNode.Data) is T3DSide then begin xSide := T3DSide(xNode.Data); if xSide.FWallType = fwtArc then begin ModelTree.Select(xNode, [ssCtrl]); SelNodes.Add(xNode); end; end; end; 7: begin if TObject(xNode.Data) is T3DSide then begin xSide := T3DSide(xNode.Data); if xSide.FWallType = fwtNiche then begin ModelTree.Select(xNode, [ssCtrl]); SelNodes.Add(xNode); end; end; end; 8: begin if TObject(xNode.Data) is T3DSide then begin xSide := T3DSide(xNode.Data); if xSide.FFaceType = ftNetFloor then begin ModelTree.Select(xNode, [ssCtrl]); SelNodes.Add(xNode); end; end; end; 9: begin if TObject(xNode.Data) is T3DSide then begin xSide := T3DSide(xNode.Data); if xSide.FFaceType = ftNetCeiling then begin ModelTree.Select(xNode, [ssCtrl]); SelNodes.Add(xNode); end; end; end; 10: begin if TObject(xNode.Data) is T3DSide then begin xSide := T3DSide(xNode.Data); if xSide.FWallType = fwtInner then begin ModelTree.Select(xNode, [ssCtrl]); SelNodes.Add(xNode); end; end; end; 11: begin if TObject(xNode.Data) is T3DSide then begin xSide := T3DSide(xNode.Data); if xSide.FWallType = fwtOuter then begin ModelTree.Select(xNode, [ssCtrl]); SelNodes.Add(xNode); end; end; end; 12: begin if TObject(xNode.Data) is T3DSObject then begin xObject := T3DSObject(xNode.Data); ModelTree.Select(xNode, [ssCtrl]); SelNodes.Add(xNode); end; end; end; end; OnSelectNodes(SelNodes); except on E: Exception do AddExceptionToLogEx('Tfrm3D.FindSelectNodesByType', E.Message); end; end; procedure Tfrm3D.ChangeTextureScale; var i: integer; xObject: T3DSide; xGLObject: TGLBaseSceneObject; Bmp: TBitmap; begin try if edTextureScale.Text = '' then exit; for i := 0 to FPropObjects.Count - 1 do begin xObject := T3DSide(TTreeNode(FPropObjects[i]).Data); xGLObject := TGLBaseSceneObject(xObject.FGLObject); xObject.FTextureScale := StrToInt(edTextureScale.Text); if (xGLObject is TGLMesh) then begin RotateTextureToAngleM(xObject, TGLMesh(xGLObject), xObject.FTextureRotate, xObject.FMirror); end; if (xGLObject is TGLPolygon) then begin RotateTextureToAngleP(xObject, TGLPolygon(xGLObject), xObject.FTextureRotate, xObject.FMirror); end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.ChangeTextureScale', E.Message); end; end; procedure Tfrm3D.edTextureScaleExit(Sender: TObject); begin ChangeTextureScale; end; procedure Tfrm3D.edTextureScaleKeyPress(Sender: TObject; var Key: Char); begin if Key = #13 then ChangeTextureScale; end; function Tfrm3D.is3DSObject(aObj: TGLBaseSceneObject): Boolean; var xNode: TTreeNode; xObject: TObject; Obj: TGLBaseSceneObject; begin try Result := False; xNode := TTreeNode(aObj.tagObject); Obj := GlsceneViewer.Buffer.GetPickedobject(mx, my); if TObject(xNode.Data) is T3DSObject then begin Result := True; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.is3DSObject', E.Message); end; end; function Tfrm3D.GetDistAngle(AP1, AP2: TDoublePoint): Double; var Len_X, Len_Y: Double; AngleRad: Double; AddAngle: Double; begin Result := 0; try Len_X := Abs(AP1.x - AP2.x); Len_Y := Abs(AP1.y - AP2.y); // проверки и вычиление угла в градусах AddAngle := 0; AngleRad := 0; // для неортогональных линий if (AP1.x < AP2.x) and (AP1.y < AP2.y) then // 1 begin AngleRad := ArcTan2(Len_X, Len_Y); // угол в радианах AddAngle := 0; end; if (AP1.x < AP2.x) and (AP1.y > AP2.y) then //4 begin AngleRad := ArcTan2(Len_Y, Len_X); // угол в радианах AddAngle := 90; end; if (AP1.x > AP2.x) and (AP1.y > AP2.y) then //3 begin AngleRad := ArcTan2(Len_X, Len_Y); // угол в радианах AddAngle := 180; end; if (AP1.x > Ap2.x) and (AP1.y < AP2.y) then //2 begin AngleRad := ArcTan2(Len_Y, Len_X); // угол в радианах AddAngle := 270; end; Result := Round(AngleRad * 180 / pi) + AddAngle; // для ортогональных линий if (AP1.y = AP2.y) and (AP1.x < AP2.x) then Result := 90; if (AP1.y = AP2.y) and (AP1.x > AP2.x) then Result := 270; if (AP1.x = AP2.x) and (AP1.y < AP2.y) then Result := 0; if (AP1.x = AP2.x) and (AP1.y > AP2.y) then Result := 180; except on E: Exception do AddExceptionToLogEx('Tfrm3D.GetDistAngle', E.Message); end; end; procedure Tfrm3D.UndoCutSides; var i, j, cnt: Integer; xGLSide1, xGLSide2: TGLPolygon; xNodeSide1, xNodeSide2, xNodeParentSide: TTreeNode; xSide1, xSide2, xParentSide: T3DSide; xSideNode, xSubSideNode: TTreeNode; xGLObject, xGLSubObject: TGLBaseSceneObject; ZOrder: Double; begin try xGLSide1 := FResizeData.Side1; xGLSide2 := FResizeData.Side2; xNodeSide1 := TTreeNode(xGLSide1.TagObject); xNodeSide2 := TTreeNode(xGLSide2.TagObject); xSide1 := T3DSide(xNodeSide1.Data); xSide2 := T3DSide(xNodeSide2.Data); xParentSide := T3DSide(xSide1.FParent); xNodeParentSide := xNodeSide1.Parent; // delete Side2 DummyCube.Remove(xGLSide2, True); xNodeSide2.Delete; xParentSide.FSubSides.Remove(xSide2); // backup params to Side1 cnt := Length(FResizeData.BasisNodes); xGLSide1.Nodes.Clear; SetLength(xSide1.FGLPoints, cnt); SetLength(xSide1.FPoints, cnt); ZOrder := xSide1.FZOrder; for i := 0 to cnt - 1 do begin xGLSide1.AddNode(FResizeData.BasisNodes[i].x, FResizeData.BasisNodes[i].y, FResizeData.BasisNodes[i].z); xSide1.FGLPoints[i].x := FResizeData.BasisNodes[i].x; xSide1.FGLPoints[i].y := FResizeData.BasisNodes[i].y - ZOrder; xSide1.FGLPoints[i].z := FResizeData.BasisNodes[i].z; xSide1.FPoints[i].x := xSide1.FGLPoints[i].x / Factor; xSide1.FPoints[i].z := xSide1.FGLPoints[i].y / Factor; xSide1.FPoints[i].y := xSide1.FGLPoints[i].z / Factor; end; // if Side1 is single SubSide if (xParentSide.FSubSides.Count = 1) and (xNodeParentSide.Count = 1) then begin xNodeSide1.Delete; xParentSide.FSubSides.Remove(xSide1); xParentSide.FGLObject := xGLSide1; xGLSide1.TagObject := xNodeParentSide; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.UndoCutSides', E.Message); end; end; procedure Tfrm3D.cbObjectHashsPropertiesCloseUp(Sender: TObject); var i, Index: Integer; xObject: T3DSObject; xGLObject: TGLFreeForm; tmpdir, tmpfname, ExtStr, BmpFName: string; HashStr: string; begin try Index := cbObjectHashs.ItemIndex; if Index >= 0 then begin HashStr := cbObjectHashs.Properties.Items[Index]; tmpdir := ExtractDirByCategoryType(dctPictures); tmpfname := GetImageFileByHash(HashStr); ExtStr := ExtractFileExt(tmpfname); if tmpfname <> '' then begin imgObjectTexture.Picture.LoadFromFile(tmpfname); for i := 0 to FPropObjects.Count - 1 do begin xObject := T3DSObject(TTreeNode(FPropObjects[i]).Data); xGLObject := TGLFreeForm(xObject.FGLObject); xObject.FTextureHash := HashStr; xObject.FTexture_ext := ExtStr; xGLObject.Material.Texture.Image.LoadFromFile(tmpfname); xGLObject.Material.Texture.MappingMode := tmmCubeMapCamera; end; end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.cbObjectHashsPropertiesCloseUp', E.Message); end; end; procedure Tfrm3D.bObjectTextureClearClick(Sender: TObject); var FName: string; i: integer; xObject: T3DSObject; xGLObject: TGLFreeForm; tmpdir, tmpfname, ExtStr, BmpFName: string; Bmp: TBitmap; Jpeg: TJPEGImage; begin try for i := 0 to FPropObjects.Count - 1 do begin xObject := T3DSObject(TTreeNode(FPropObjects[i]).Data); xGLObject := TGLFreeForm(xObject.FGLObject); xObject.FTextureHash := ''; xObject.FTexture_ext := ''; imgObjectTexture.Clear; xGLObject.Material.Texture.Disabled := True; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.bObjectTextureClearClick', E.Message); end; end; procedure Tfrm3D.bObjectTextureChangeClick(Sender: TObject); var i: integer; FName: string; xObject: T3DSObject; xGLObject: TGLFreeForm; tmpdir, tmpfname, ExtStr, BmpFName: string; Bmp: TBitmap; Jpeg: TJPEGImage; HashStr: string; begin try FName := LoadTexture; if (FName <> '') and FileExists(FName) then begin imgObjectTexture.Picture.LoadFromFile(FName); ExtStr := ExtractFileExt(FName); tmpdir := ExtractDirByCategoryType(dctPictures); // получаем HASH по загружаемому файлу HashStr := GetImageHash(FName); // по HASH ищем есть ли он в нашей базе tmpfname := GetImageFileByHash(HashStr); // если найден, то грузим его if tmpfname <> '' then begin end else // не найден - создаем для файла HASH, копируем в темп, грузим begin F3DModel.FHashs.Add(HashStr); tmpfname := tmpdir + '\' + HashStr + '.bmp'; if (ExtStr = '.jpg') or (ExtStr = '.jpeg') then begin Bmp := TBitmap.Create; Jpeg := TJPEGImage.Create; jpeg.CompressionQuality := 100; {Default Value} Jpeg.LoadFromFile(FName); Bmp.Assign(Jpeg); Bmp.SaveTofile(tmpfname); FreeAndNil(Bmp); FreeAndNil(Jpeg); end else CopyFile(PChar(FName), PChar(tmpfname), True); end; for i := 0 to FPropObjects.Count - 1 do begin xObject := T3DSObject(TTreeNode(FPropObjects[i]).Data); xGLObject := TGLFreeForm(xObject.FGLObject); xObject.FTextureHash := HashStr; xObject.FTexture_ext := ExtStr; xGLObject.MaterialLibrary := nil; xGLObject.Material.Texture.Disabled := False; xGLObject.Material.Texture.Image.LoadFromFile(tmpfname); xGLObject.Material.Texture.MappingMode := tmmCubeMapCamera; end; // Resfresh HASHs cbObjectHashs.Properties.Items.Clear; for i := 0 to F3DModel.FHashs.Count - 1 do begin cbObjectHashs.Properties.Items.Add(F3DModel.FHashs.Strings[i]); end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.bObjectTextureChangeClick', E.Message); end; end; procedure Tfrm3D.MatLibTextureNeeded(Sender: TObject; var textureFileName: String); var tmpdir, fname, textfname, tmpfname, HashStr: string; i, xIndex: Integer; begin try textfname := textureFileName; // На создании 3ДС if FisCreate3DS then begin tmpdir := ExtractFilePath(Open3DObject.FileName); fname := tmpdir + textureFileName; if FileExists(fname) then begin MatLib.TexturePaths := tmpdir; textureFileName := textfname; tmpdir := ExtractDirByCategoryType(dctPictures); // получаем HASH по загружаемому файлу FName := ExtractFilePath(Open3DObject.FileName) + textfname; HashStr := GetImageHash(FName); // по HASH ищем есть ли он в нашей базе tmpfname := GetImageFileByHash(HashStr); FCurrObject.FFiles.Add(textfname); FCurrObject.FHashs.Add(HashStr); // не найден - создаем для файла HASH, копируем в темп, грузим if tmpfname = '' then begin tmpfname := tmpdir + '\' + HashStr + '.jpg'; CopyFile(PChar(FName), PChar(tmpfname), True); end; end else begin MatLib.TexturePaths := ExeDir + '\3DTextures'; textureFileName := 'empty.bmp'; end; end else // На поднятии 3ДС begin xIndex := FCurrObject.FFiles.IndexOf(textfname); if xIndex <> - 1 then begin tmpdir := ExtractDirByCategoryType(dctPictures); tmpfname := FCurrObject.FHashs[xIndex] + ExtractFileExt(textfname); fname := tmpdir + '\' + tmpfname; if FileExists(fname) then begin MatLib.TexturePaths := tmpdir; textureFileName := tmpfname; end else begin MatLib.TexturePaths := ExeDir + '\3DTextures'; textureFileName := 'empty.bmp'; end; end else begin MatLib.TexturePaths := ExeDir + '\3DTextures'; textureFileName := 'empty.bmp'; end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.MatLibTextureNeeded', E.Message); end; end; procedure Tfrm3D.Rotate3DSObj(aObject: TGLFreeForm; aX, aY, aZ: Double); var xObject: T3DSObject; begin aObject.ResetAndPitchTurnRoll(aZ, aY, aX); xObject := T3DSObject(TTreeNode(aObject.TagObject).Data); xObject.FRotate.x := aX; xObject.FRotate.y := aY; xObject.FRotate.z := aZ; end; procedure Tfrm3D.TimerOnSelectNodesTimer(Sender: TObject); begin try TimerOnSelectNodes.Enabled := False; DeselectGLObjectsT; // Select objects if TimerOnSelectNodes.Tag = 1 then begin SelectGLObjects(FxObjects); OnLoadProperties(FNodes); end; except end; TimerOnSelectNodes.OnTimer := nil; end; procedure Tfrm3D.cbShowTraceCaptionsClick(Sender: TObject); begin ToggleTraceCaptions(cbShowTraceCaptions.Checked); //29.03.2011 end; end.