expertcad/POWERCAD30/UNITS/Form3d_or.pas
2025-05-12 10:07:51 +03:00

6339 lines
208 KiB
ObjectPascal
Raw Permalink Blame History

unit Form3d;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Keyboard, Dialogs, GLScene, GLObjects, GLWin32Viewer, GLMisc, GLTexture,
StdCtrls, ExtCtrls, Buttons,PCTypesUtils,GLGeomObjects,VectorGeometry,
GLFile3DS, GLExtrusion, GLGraph, GLVectorFileObjects, GLPortal, GLSpaceText,GLMultiPolygon, VectorTypes,
GLHUDObjects, GLWaterPlane, GLBitmapFont, GLWindowsFont, LibJPeg, Form3d_Save,
siComp, siLngLnk, GLMesh, U_Arch3D, ComCtrls, ImgList, cxControls,
cxContainer, cxEdit, cxTextEdit, cxMemo, cxMaskEdit, RzCmboBx,
cxLookAndFeelPainters, cxButtons, cxImage, RzButton, RzRadChk,
cxDropDownEdit, ExtDlgs, GLCadencer, glFPSMovement, GLNavigator, Menus, GeometryBB, Math;
type
TPropViewType = (pvtNone, pvtSingleSide, pvtMultiSides, pvtSingle3ds, pvtMulti3ds);
TToolMode = (tmSelect, tmCut);
TCutData = class(TMyObject)
Index11: Integer;
Index12: Integer;
Index21: Integer;
Index22: Integer;
end;
TResizeData = class(TMyObject)
Side1: TGLPolygon;
Side2: TGLPolygon;
Nodep11: TGLNode;
Nodep12: TGLNode;
Nodep21: TGLNode;
Nodep22: TGLNode;
Noder11: TGLNode;
Noder12: TGLNode;
Noder21: TGLNode;
Noder22: TGLNode;
Indexp11: Integer;
Indexp12: Integer;
Indexp21: Integer;
Indexp22: Integer;
Indexr11: Integer;
Indexr12: Integer;
Indexr21: Integer;
Indexr22: Integer;
end;
TPropRecord = class(TMyObject)
fName: string;
fDesc: TStringList;
fCoords: TList;
fRotate: string;
constructor Create;
end;
Tfrm3D = class(TForm)
GLScene: TGLScene;
panMain: TPanel;
GLCamera: TGLCamera;
GLCameraFirstPerson: TGLCamera;
GLLightSource1: TGLLightSource;
GLLightSource2: TGLLightSource;
GLLightSource3: TGLLightSource;
GLLightSource4: TGLLightSource;
GLLightSource5: TGLLightSource;
panUpper: TPanel;
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
DummyCube: TGLDummyCube;
TransCube: TGLDummyCube;
GLPlane1: TGLPlane;
GLDummyCube1: TGLDummyCube;
GLHUDText1: TGLHUDText;
SpeedButton3: TSpeedButton;
SaveDialog: TSaveDialog;
lbViewType: TLabel;
lng_Forms: TsiLangLinked;
cbViewCeiling: TCheckBox;
Splitter1: TSplitter;
ImageList_Dir: TImageList;
panScene: TPanel;
GLSceneViewer: TGLSceneViewer;
panObjects: TPanel;
Splitter2: TSplitter;
panProps: TPanel;
panTree: TPanel;
ModelTree: TTreeView;
Panel1: TPanel;
panTexture: TPanel;
panName: TPanel;
panDesc: TPanel;
panCoords: TPanel;
panRotate: TPanel;
panMirror: TPanel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
edName: TcxTextEdit;
mDesc: TcxMemo;
Label8: TLabel;
edCoordX: TcxMaskEdit;
Label9: TLabel;
edCoordY: TcxMaskEdit;
Label10: TLabel;
Label11: TLabel;
edCoordZ: TcxMaskEdit;
imgTexture: TcxImage;
bTextureChange: TcxButton;
bTextureClear: TcxButton;
cbMirror: TRzCheckBox;
edRotate: TcxMaskEdit;
Label37: TLabel;
cbCoordNbr: TcxComboBox;
OpenTexture: TOpenPictureDialog;
sbFirstFace: TSpeedButton;
MainCenter: TGLDummyCube;
GLCadencer: TGLCadencer;
cbHashs: TcxComboBox;
Label1: TLabel;
pmModelTree: TPopupMenu;
nAdd3DObject: TMenuItem;
Open3DObject: TOpenDialog;
panPos3ds: TPanel;
Label12: TLabel;
Label13: TLabel;
Label14: TLabel;
Label15: TLabel;
edPosX: TcxMaskEdit;
edPosY: TcxMaskEdit;
edPosZ: TcxMaskEdit;
panRotate3ds: TPanel;
Label16: TLabel;
Label17: TLabel;
Label18: TLabel;
Label19: TLabel;
edAngleX: TcxMaskEdit;
edAngleY: TcxMaskEdit;
edAngleZ: TcxMaskEdit;
panScale3ds: TPanel;
Label20: TLabel;
Label21: TLabel;
Label22: TLabel;
Label23: TLabel;
edScaleX: TcxMaskEdit;
edScaleY: TcxMaskEdit;
edScaleZ: TcxMaskEdit;
Label24: TLabel;
Label25: TLabel;
Label26: TLabel;
pmCut: TPopupMenu;
sbSaveModel: TSpeedButton;
nDeleteAllSubSides: TMenuItem;
procedure GLSceneViewerMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure GLSceneViewerMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
procedure SpeedButton1Click(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure GLHeightField1GetHeight(const x, y: Single; var z: Single;
var color: TVector4f; var texPoint: TTexPoint);
procedure FormMouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
procedure SpeedButton3Click(Sender: TObject);
procedure cbViewCeilingClick(Sender: TObject);
procedure GLSceneViewerDblClick(Sender: TObject);
procedure ModelTreeClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure cbCoordNbrCloseUp(Sender: TObject);
procedure bTextureClearClick(Sender: TObject);
procedure cbMirrorClick(Sender: TObject);
procedure mDescEnter(Sender: TObject);
procedure sbFirstFaceClick(Sender: TObject);
procedure bTextureChangeClick(Sender: TObject);
procedure GLCadencerProgress(Sender: TObject; const deltaTime,
newTime: Double);
procedure GLSceneViewerClick(Sender: TObject);
procedure cbHashsPropertiesCloseUp(Sender: TObject);
procedure nAdd3DObjectClick(Sender: TObject);
procedure ModelTreeMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure edNameExit(Sender: TObject);
procedure mDescExit(Sender: TObject);
procedure edPosXExit(Sender: TObject);
procedure edPosYExit(Sender: TObject);
procedure edPosZExit(Sender: TObject);
procedure edAngleXExit(Sender: TObject);
procedure edAngleYExit(Sender: TObject);
procedure edAngleZExit(Sender: TObject);
procedure edScaleXExit(Sender: TObject);
procedure edScaleYExit(Sender: TObject);
procedure edScaleZExit(Sender: TObject);
procedure edCoordXKeyPress(Sender: TObject; var Key: Char);
procedure edCoordXExit(Sender: TObject);
procedure edCoordYExit(Sender: TObject);
procedure edCoordZExit(Sender: TObject);
procedure edRotateExit(Sender: TObject);
procedure edCoordYKeyPress(Sender: TObject; var Key: Char);
procedure edCoordZKeyPress(Sender: TObject; var Key: Char);
procedure edRotateKeyPress(Sender: TObject; var Key: Char);
procedure edNameKeyPress(Sender: TObject; var Key: Char);
procedure mDescKeyPress(Sender: TObject; var Key: Char);
procedure edPosXKeyPress(Sender: TObject; var Key: Char);
procedure edPosYKeyPress(Sender: TObject; var Key: Char);
procedure edPosZKeyPress(Sender: TObject; var Key: Char);
procedure edAngleXKeyPress(Sender: TObject; var Key: Char);
procedure edAngleYKeyPress(Sender: TObject; var Key: Char);
procedure edAngleZKeyPress(Sender: TObject; var Key: Char);
procedure edScaleXKeyPress(Sender: TObject; var Key: Char);
procedure edScaleYKeyPress(Sender: TObject; var Key: Char);
procedure edScaleZKeyPress(Sender: TObject; var Key: Char);
procedure GLSceneViewerMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure sbSaveModelClick(Sender: TObject);
procedure nDeleteAllSubSidesClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
Factor: Single;
RStartPos1, RStartPos2: T3DPoint;
FToolMode: TToolMode;
FNodesObjectsList: TList;
FCutDataList: TList;
FResizeData: TResizeData;
FResizer: Boolean;
FMovedObject: TGLFreeForm;
F3DModel: T3DModel;
F3DStreamModel: T3DModel;
FSelection: TList;
FPropObjects: TList;
FPropRecord: TPropRecord;
mx, my : Integer;
mdx, mdy : Integer;
FaceList: TList;
CPoint: T3DPoint;
OPoint: T3DPoint;
Camera: T3DPoint;
FFileStream: String;
Procedure UpdateFaces(Faces: TList; Yh: Double = 0);
procedure UpdateModelTree;
procedure UpdateModelTreeFromStream(Faces: TList);
function CopySideProperties(aSide, aStrSide: T3DSide): T3DSide;
function CopySubSideProperties(aStrSubSide: T3DSide): T3DSide;
function CopyObjectProperties(aObject, aStrObject: T3DSObject): T3DSObject;
procedure CopyModelHash;
Procedure SetCubeBounds(var glCube:TGLCube;Points: T3dPointArray;Factor:Double);
Procedure AddWall(aWall: TGLMesh; vs: array of TVector3f);
Procedure AddFloor(aFloor: TGLMesh; vs: array of TVector3f; aSide: T3DSide);
procedure OnSelectNodes(aNodes: TList);
function FindGLObjectsByNodes(aNodes: TList): TList;
procedure SelectGLObjects(aObjects: TList);
procedure DeselectGLObjects;
function CheckGLObjectInSelectionNodes(aObject: TGLBaseSceneObject; aNodes: TList): Boolean;
function GetAllSidesNodesByNodes(aNodes: TList): TList;
function GetAllChildNodes(ANode: TTreeNode): TList;
function GetPropViewType(aNodes: TList): TPropViewType;
procedure OnLoadProperties(aObjects: TList);
function LoadTexture: string;
procedure SetAllPanels(aStatus: Boolean);
// Properties
function LoadPropertiesForSingleObject(aObject: TTreeNode): TPropRecord;
function LoadPropertiesForMultiObjects(aObjects: TList): TPropRecord;
function LoadPropertiesForSingle3ds(aObject: TTreeNode): TPropRecord;
function LoadPropertiesForMulti3ds(aObjects: TList): TPropRecord;
procedure ChangeName;
procedure ChangeDesc;
procedure ChangeCoordX;
procedure ChangeCoordY;
procedure ChangeCoordZ;
procedure ChangeRotate;
procedure ChangePosX;
procedure ChangePosY;
procedure ChangePosZ;
procedure ChangeAngleX;
procedure ChangeAngleY;
procedure ChangeAngleZ;
procedure ChangeScaleX;
procedure ChangeScaleY;
procedure ChangeScaleZ;
procedure Set3DSObjectPos(aGLObject: TGLFreeForm);
// **************************
procedure OnRightClick;
procedure RotateTextureToAngleM(aObject: T3DSide; aGLObject: TGLMesh; aAngle: Integer; aMirror: Boolean);
Procedure RotateTextureToAngleP(aObject: T3DSide; aGLObject: TGLPolygon; aAngle: Integer; aMirror: Boolean);
procedure SetPolygonTexture(aObject: TGLPolygon);
Function Rotate3DVector(vs0, vs1, vs2: TVector3f; Ang: Double): TVector3f;
Function GetImageFileByHash(aHash: string): string;
Procedure Get3DSObjectBounds(var Min, Max: T3DPoint; aObject: TGLFreeForm);
Procedure GetRoomBounds(var Min, Max: T3DPoint; aFloor, aCeiling: T3DPointArray);
procedure DeleteNodesObjects;
procedure CreateNodesObjects(aObj: TGLPolygon);
procedure SelectNodesEvent(Sender: TObject);
procedure SetSideSizes;
procedure DoResize;
procedure AfterUpdate;
procedure CreateAddForDivSide(aSide, aAddSide: TGLPolygon);
procedure CreateAddForParentSide(aFirstSide, aSecondSide: TGLPolygon);
procedure SetSidesData;
procedure RefreshSidesPoints;
procedure SaveModelToStream(const AFile: String='');
procedure LoadModelFromStream(const AFile: String='');
procedure GetModelData(Stream: TStream);
procedure SetModelData(Stream: TStream);
function GetModelObjectByComponID(aComponID: Integer): TObject;
function GetSimilarSide(aSide: T3DSide; aObject: TObject): T3DSide;
function CmpSides(aSide1, aSide2: T3DSide): Boolean;
end;
var
frm3D: Tfrm3D;
glSide11, glSide21, glSide12, glSide22: TGLSpaceText;
glSpliter: TGLLines;
glCubeSpliter: TGLCube;
glCursorObject: TGLCustomSceneObject;
rpos1, rpos2: T3DPoint;
ModelObjectsList: TList;
NoMoveEvent: Boolean = False;
SelObjColor, ObjColor: Tvector4f;
implementation
uses U_ESCadClasess, U_BaseConstants, U_Constants, U_BaseCommon, U_Common, U_SCSComponent, u_main,
PCDrawBox, U_ProtectionCommon, fplan, USCS_Main;
{$R *.dfm}
//
// Classic mouse movement bits
//
procedure Tfrm3D.GLSceneViewerMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
Obj: TGLBaseSceneObject;
begin
mx := x;
my := y;
mdx := x;
mdy := y;
if Button = mbLeft then
begin
if FToolMode = tmCut then
begin
Obj := GlsceneViewer.Buffer.GetPickedobject(X, Y);
if Obj = glCubeSpliter then
begin
glCursorObject.Position.x := glCubeSpliter.Position.x;
glCursorObject.Position.y := glCubeSpliter.Position.y;
glCursorObject.Position.z := glCubeSpliter.Position.z;
FResizer := True;
end;
end;
if FToolMode = tmSelect then
begin
Obj := GlsceneViewer.Buffer.GetPickedobject(X, Y);
if (Obj <> nil) and (Obj is TGLFreeForm) then
if (FSelection.Count = 1) and (TGLBaseSceneObject(FSelection[0]) = Obj) then
FMovedObject := TGLFreeForm(Obj);
end;
end;
end;
procedure Tfrm3D.GLSceneViewerMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
dx, dy : Integer;
v : TVector;
mp: TPoint;
ip : TVector;
tileX, tileY : Integer;
shiftDown : Boolean;
mip, translateOffset : TVector;
translating : Boolean;
koefcam: single;
//vx,vz: single;
spd: single;
dw,dh: integer;
xObj: TGLBaseSceneObject;
VX, VY: TVector;
Camera: TGLCamera;
begin
if NoMoveEvent then
begin
NoMoveEvent := False;
mx := x;
my := y;
end;
shiftDown:=(IsKeyDown(VK_LSHIFT) or IsKeyDown(VK_RSHIFT));
dx := mx - x;
dy := my - y;
if (dx = 0) and (dy = 0) then
exit;
Camera := GLSceneViewer.Camera;
// SELECT MODE
//if FToolMode = tmSelect then
if not FResizer then
begin
if ssLeft in Shift then
begin
if FMovedObject <> nil then
begin
GLSceneViewer.Cursor := crHandPoint;
VY := VectorMake(VectorPerpendicular(YVector, VectorNormalize(Camera.Position.AsAffineVector)));
VX := VectorCrossProduct(VY, VectorNormalize(Camera.Position.AsVector));
NormalizeVector(VY);
NormalizeVector(VX);
FMovedObject.Position.Translate(VectorCombine(VX, VY, -dx * 0.132 * Camera.DistanceToTarget / Camera.FocalLength, dy * 0.132 * Camera.DistanceToTarget / Camera.FocalLength));
end
else
begin
if GLSceneViewer.Camera = GLCamera then
begin
GLSceneViewer.Camera.MoveAroundTarget(my - y, mx - x);
end
else if GLSceneViewer.Camera = GLCameraFirstPerson then
begin
GLSceneViewer.Camera.MoveAroundTarget(my - y, mx - x);
//GLSceneViewer.Camera.pitch(my - y);
//DummyCube.Turn(mx - x);
//GLSceneViewer.Camera.Turn(my - y);
//GLSceneViewer.Camera.Roll(mx - x);
end;
end;
end
else
if Shift = [ssRight] then
begin
if GLSceneViewer.Camera.CameraStyle = csPerspective then
koefcam := 0.12
else
koefcam := 0.03;
if GLSceneViewer.Camera.Position.Y < 0 then
v := GLSceneViewer.Camera.ScreenDeltaToVectorXZ(-dx, -dy, koefcam * GLSceneViewer.Camera.DistanceToTarget / GLSceneViewer.Camera.FocalLength)
else
v := GLSceneViewer.Camera.ScreenDeltaToVectorXZ(-dx, dy, koefcam * GLSceneViewer.Camera.DistanceToTarget / GLSceneViewer.Camera.FocalLength);
GLDummyCube1.Position.Translate(v);
DummyCube.Position.Translate(v);
TransCube.Position.Translate(v);
GLSceneViewer.Camera.TransformationChanged;
end;
end;
// <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> (Resizing)
if (FToolMode = tmCut) then
begin
// <20><><EFBFBD>c<EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
if not FResizer then
begin
if Shift = [] then
begin
xObj := GLSceneViewer.Buffer.GetPickedobject(X, Y);
if (xObj = glSpliter) or (xObj = glCubeSpliter) then
GLSceneViewer.Cursor := crSizeAll
else
GLSceneViewer.Cursor := crDefault;
end;
end
else
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
begin
VY := VectorMake(VectorPerpendicular(YVector, VectorNormalize(Camera.Position.AsAffineVector)));
VX := VectorCrossProduct(VY, VectorNormalize(Camera.Position.AsVector));
NormalizeVector(VY);
NormalizeVector(VX);
glCursorObject.Position.Translate(VectorCombine(VX, VY, -dx * 0.132 * Camera.DistanceToTarget / Camera.FocalLength, dy * 0.132 * Camera.DistanceToTarget / Camera.FocalLength));
DoResize;
end;
end;
mx := x;
my := y;
end;
procedure Tfrm3D.UpdateFaces(Faces: TList; Yh: Double = 0);
var
i,pCnt,k, FigureID: Integer;
Face:TFaceRecord;
glPoly:TGLPolyGon;
glLine: TGLLines;
glCube: TGLCube;
glSphere: TGLSphere;
glCenter: TGLDummyCube;
glPipe: TGLPipe;
p, p1, p2, p3, p4, p5, p6, p7, p8, normal: T3dPoint;
tx,ty,tz,bx,by,bz,cx,cy,cz: Double;
glObject: TGLBaseSceneObject;
glObjClass: TGLSceneObjectClass;
glObject1: TGLBaseSceneObject;
glObjClass1: TGLSceneObjectClass;
SCSCatalog: TSCSCatalog;
xoffset, aScaleModel: single;
aColorModel: TVector4f;
glWallSide, glFloor, glCeiling, glDoorSide, glWindowSide, glBalconDoorSide, glBalconWindowSide: TGLPolygon;
gl3DSObject: TGLFreeForm;
aColor: TVector4f;
tmpdir, ImgName: string;
WallCoords: array [0..5] of TVector3f;
FloorCoords: array of TVector3f;
BegCoordIndex: integer;
xNode: TTreeNode;
xSide: T3DSide;
xObject: T3DSObject;
Angle1, Angle2, ResAng: Double;
dp1, dp2: TDoublePoint;
pN, pP: TVector3f;
begin
try
FaceList := Faces;
Factor := 0.15;
tmpdir := ExtractDirByCategoryType(dctPictures);
for i := 0 to DummyCube.Count - 1 do
begin
if not (DummyCube.Children[i] is TGLCamera) then
DummyCube.Children[i].DeleteChildren;
end;
TransCube.DeleteChildren;
LoadModelFromStream(FFileStream);
if F3DStreamModel = nil then
UpdateModelTree
else
UpdateModelTreeFromStream(Faces);
//// *********** FACES.COUNT *************************************************
for i := 0 to Faces.Count - 1 do
begin
Face := TFaceRecord(faces[i]);
xNode := Face.FTreeNode;
xSide := nil;
xObject := nil;
pCnt := Length(Face.Points);
for k := 0 to pCnt - 1 do
begin
p := Face.Points[k];
p := DoublePoint(p.x,p.z,p.y);
if (i = 0) and (k = 0) then
begin
tx := p.x; ty := p.y; tz := p.z;
bx := p.x; by := p.y; bz := p.z;
end
else
begin
if p.x > tx then tx := p.x;
if p.x < bx then bx := p.x;
if p.y > ty then ty := p.y;
if p.y < by then by := p.y;
if p.z > tz then tz := p.z;
if p.z < bz then bz := p.z;
end;
end;
case Face.RecType of
ftPolygon: glObjClass := TGLPolyGon;
ftLine : glObjClass := TGLLines;
ftPipe,ftBar : glObjClass := TGLPipe;
ftSphere: glObjClass := TGLSphere;
ftCenterCUbe: glObjClass := TGLDummyCube;
ftNetPath: glObjClass := TGLPolygon;
ftNetFloor: glObjClass := TGLPolygon;
ftNetCeiling: glObjClass := TGLPolygon;
ftNetDoor: glObjClass := TGLPolygon;
ftNetWindow: glObjClass := TGLPolygon;
ftNetBalconDoor: glObjClass := TGLPolygon;
ftNetBalconWindow: glObjClass := TGLPolygon;
ftNetFrame: glObjClass := TGLPolygon;
ftNet3DSObject: glObjClass := TGLFreeForm;
end;
if face.OpTrans then
begin
glObject := TransCube.AddNewChild(glObjClass);
end
else
begin
glObject := DummyCube.AddNewChild(glObjClass);
end;
glObject.TagObject := xNode;
if xNode <> nil then
begin
if Face.RecType = ftNet3DSObject then
begin
xObject := T3DSObject(xNode.Data);
xObject.FGLObject := glObject;
end
else
begin
xSide := T3DSide(xNode.Data);
xSide.FGLObject := glObject;
end;
end;
case Face.RecType of
ftPolygon: glPoly := TGLPolyGon(glObject);
ftLine : glLine := TGLLines(glObject);
ftPipe,ftBar : glPipe := TGLPipe(glObject);
ftSphere: glSphere := TGLSphere(glObject);
ftCenterCube: glCenter := TGLDummyCube(glObject);
ftNetPath: glWallSide := TGLPolygon(glObject);
ftNetFloor: glFloor := TGLPolygon(glObject);
ftNetCeiling: glCeiling := TGLPolygon(glObject);
ftNetDoor: glDoorSide := TGLPolyGon(glObject);
ftNetWindow: glWindowSide := TGLPolyGon(glObject);
ftNetBalconDoor: glBalconDoorSide := TGLPolyGon(glObject);
ftNetBalconWindow: glBalconWindowSide := TGLPolyGon(glObject);
ftNet3DSObject: gl3DSObject := TGLFreeForm(glObject);
end;
if Face.RecType in [ftPolyGon,ftLine,ftPipe,ftBar,ftSphere] then
begin
for k := 0 to pCnt - 1 do
begin
p := Face.Points[k];
p := DoublePoint(p.x,p.z,p.y);
if Face.RecType = ftPolyGon then
begin
glPoly.AddNode(p.x * factor, p.y * factor, p.z * factor);
end
else
if Face.RecType = ftLine then
begin
glLine.AddNode(p.x * factor, p.y * factor, p.z * factor);
end
else
if Face.RecType = ftSphere then
begin
glSphere.Position.X := p.x * factor;
glSphere.Position.Y := p.y * factor;
glSphere.Position.Z := p.z * factor;
end
else
if Face.RecType = ftCenterCube then
begin
glCenter.Position.X := p.x * factor;
glCenter.Position.Y := p.y * factor;
glCenter.Position.Z := p.z * factor;
end
else
if (Face.RecType = ftPipe) or (Face.RecType = ftBar) then
begin
glPipe.AddNode(p.x * factor, p.y * factor, p.z * factor);
end;
end;
if Face.RecType = ftLine then
begin
p := Face.Points[0];
p := DoublePoint(p.x,p.z,p.y);
p1 := Face.Points[1];
p1 := DoublePoint(p1.x,p1.z,p1.y);
glObjClass1 := TGLSpaceText;
p.x := (p.x + p1.x) * 0.5;
p.y := (p.y + p1.y) * 0.5;
p.z := (p.z + p1.z) * 0.5;
glObject1 := DummyCube.AddNewChild(glObjClass1);
if (TOrthoLine(Face.FFigure).Name = cudUpDownCaption) or (TOrthoLine(Face.FFigure).Name = cCadClasses_Mes25) then
begin
TGLSpaceText(glObject1).Text := {$IF Defined(SCS_PE)} 'Raise' {$ELSE} '<27>/<2F>' {$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
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> 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
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> TSCSComponent
if SCSCatalog.SCSComponents.Count > 0 then
begin
if SCSCatalog.SCSComponents[0].ComponentType.SysName = ctsnCableChannelElement then
begin
aScaleModel := 0.02;
aColorModel := clrBlue;
glObjClass1 := TGLFreeForm;
glObject1 := DummyCube.AddNewChild(glObjClass1);
try
{$IF Defined(ES_GRAPH_SC)}
TGLFreeForm(glObject1).LoadFromFile(ExeDir + '\3DModels\RM.3ds');
{$else}
TGLFreeForm(glObject1).LoadFromFile('Map.3ds');
{$IFEND}
except
end;
TGLFreeForm(glObject1).Position.x := p.x*factor;
TGLFreeForm(glObject1).Position.z := p.z*factor;
TGLFreeForm(glObject1).Position.y := p.y*factor;
TGLFreeForm(glObject1).Scale.X := aScaleModel;
TGLFreeForm(glObject1).Scale.Y := aScaleModel;
TGLFreeForm(glObject1).Scale.Z := aScaleModel;
TGLFreeForm(glObject1).Material.FrontProperties.Diffuse.Color := aColorModel;
TGLFreeForm(glObject1).Material.BackProperties.Diffuse.Color := aColorModel;
TGLFreeForm(glObject1).BuildOctree;
end;
end;
end;
end;
end;
//
with TGLSceneObject(glObject).Material do
begin
BackProperties.Ambient.AsWinColor:= Face.Color;
BackProperties.Diffuse.AsWinColor := Face.Color;
BackProperties.Emission.AsWinColor := Face.Color;
FrontProperties.Ambient.AsWinColor := Face.Color;
FrontProperties.Diffuse.AsWinColor := Face.Color;
FrontProperties.Emission.AsWinColor := Face.Color;
if TConnectorObject(Face.FFigure).Name = 'Anchor' then
begin
BackProperties.Ambient.AsWinColor:= clNone;
BackProperties.Diffuse.AsWinColor := clNone;
BackProperties.Emission.AsWinColor := clNone;
FrontProperties.Ambient.AsWinColor := clNone;
FrontProperties.Diffuse.AsWinColor := clNone;
FrontProperties.Emission.AsWinColor := clNone;
end;
end;
end;
end;
if Face.RecType = ftLine then
begin
glLine.NodeSize := 0;
glLine.ShowAxes := False;
if TOrthoLine(Face.FFigure).FLineType = ts_ClearTrace then
gLLine.LineWidth := 1
else
gLLine.LineWidth := 4;
glLine.AntiAliased := True;
glLine.NodesAspect := lnaInvisible;
glLine.LineColor.AsWinColor := Face.Color; //clred;
end
else
if Face.RecType = ftPolyGon then
begin
//glPoly.Smooth := True;
glPoly.Parts := [ppTop,ppBottom];
end;
{TODO}
if not (Face.RecType in [ftNetPath, ftNetDoor, ftNetWindow, ftNetBalconDoor, ftNetBalconWindow, ftNetFloor, ftNetCeiling]) then
begin
with TGLSceneObject(glObject).Material do
begin
BackProperties.Ambient.AsWinColor:= Face.Color;
BackProperties.Diffuse.AsWinColor := Face.Color;
BackProperties.Emission.AsWinColor := Face.Color;
FrontProperties.Ambient.AsWinColor := Face.Color;
FrontProperties.Diffuse.AsWinColor := Face.Color;
FrontProperties.Emission.AsWinColor := Face.Color;
if Face.RecType = ftPipe then
begin
begin
if TConnectorObject(Face.FFigure).Name = 'Anchor' then
begin
BackProperties.Ambient.AsWinColor:= clNone;
BackProperties.Diffuse.AsWinColor := clNone;
BackProperties.Emission.AsWinColor := clNone;
FrontProperties.Ambient.AsWinColor := clNone;
FrontProperties.Diffuse.AsWinColor := clNone;
FrontProperties.Emission.AsWinColor := clNone;
end;
end;
end;
end;
end;
{TODO}
// ********************** NETPATHs *****************************************
if Face.RecType = ftNetPath then
begin
for k := 0 to pCnt - 1 do
begin
p := Face.Points[k];
p := DoublePoint(p.x, p.z, p.y);
p1 := Face.Points[1];
p1 := DoublePoint(p1.x, p1.z, p1.y);
p.x := p.x * factor;
if (Face.FFaceWallType in [fwtDoorSlope, fwtWindowSlope, fwtBalconSlope, fwtNiche]) then
begin
if (p.y < 0.011) then
begin
if (p.y <> p1.y) then
p.y := p.y * factor
else
p.y := p.y * factor + FDeltaZSlope;
end
else
p.y := p.y * factor;
end
else
p.y := p.y * factor;
p.z := p.z * factor;
glWallSide.AddNode(p.x, p.y, p.z);
xSide.FGLPoints[k] := p;
end;
with TGLSceneObject(glObject).Material do
begin
aColor := clrNewTan;
BackProperties.Ambient.Color := aColor;
BackProperties.Diffuse.Color := aColor;
BackProperties.Emission.Color := aColor;
FrontProperties.Ambient.Color := aColor;
FrontProperties.Diffuse.Color := aColor;
FrontProperties.Emission.Color := aColor;
Texture.texturemode := tmDecal;
Texture.Disabled := False;
ImgName := GetImageFileByHash(xSide.FTextureHash);
if ImgName <> '' then
begin
Texture.Image.LoadFromFile(ImgName);
end
else
begin
if Face.FFaceWallType = fwtInner then
Texture.Image.LoadFromFile(ExeDir + '\3DTextures\inner_wall.bmp')
else if Face.FFaceWallType = fwtOuter then
Texture.Image.LoadFromFile(ExeDir + '\3DTextures\outer_wall.bmp')
else if Face.FFaceWallType = fwtDoorSlope then
Texture.Image.LoadFromFile(ExeDir + '\3DTextures\door_slope.bmp')
else if Face.FFaceWallType = fwtWindowSlope then
Texture.Image.LoadFromFile(ExeDir + '\3DTextures\window_slope.bmp')
else if Face.FFaceWallType = fwtArc then
Texture.Image.LoadFromFile(ExeDir + '\3DTextures\arc.bmp')
else if Face.FFaceWallType = fwtBalconSlope then
Texture.Image.LoadFromFile(ExeDir + '\3DTextures\balcon_slope.bmp')
else if Face.FFaceWallType = fwtNiche then
Texture.Image.LoadFromFile(ExeDir + '\3DTextures\niche.bmp');
end;
end;
RotateTextureToAngleP(xSide, GLWallSide, xSide.FRotate, xSide.FMirror);
end;
// ********************** NETPATHs *****************************************
// ********************** NETDOORs *****************************************
if Face.RecType = ftNetDoor then
begin
for k := 0 to pCnt - 1 do
begin
p := Face.Points[k];
p := DoublePoint(p.x, p.z, p.y);
p1 := Face.Points[1];
p1 := DoublePoint(p1.x, p1.z, p1.y);
p.x := p.x * factor;
if (p.y < 0.011) then
begin
if (p.y <> p1.y) then
p.y := p.y * factor
else
p.y := p.y * factor + FDeltaZSlope
end
else
p.y := p.y * factor;
p.z := p.z * factor;
glDoorSide.AddNode(p.x, p.y, p.z);
xSide.FGLPoints[k] := p;
end;
with TGLSceneObject(glObject).Material do
begin
aColor := clrTan;
BackProperties.Ambient.Color := aColor;
BackProperties.Diffuse.Color := aColor;
BackProperties.Emission.Color := aColor;
FrontProperties.Ambient.Color := aColor;
FrontProperties.Diffuse.Color := aColor;
FrontProperties.Emission.Color := aColor;
MaterialOptions := [moNoLighting];
end;
end;
// ********************** NETDOORs *****************************************
// ********************** NETWINDOWs ***************************************
if Face.RecType = ftNetWindow then
begin
for k := 0 to pCnt - 1 do
begin
p := Face.Points[k];
p := DoublePoint(p.x, p.z, p.y);
p1 := Face.Points[1];
p1 := DoublePoint(p1.x, p1.z, p1.y);
p.x := p.x * factor;
//if (p.y < 0.011) then
//begin
// if (p.y <> p1.y) then
// p.y := p.y * factor
// else
// p.y := p.y * factor + FDeltaZSlope
//end
//else
p.y := p.y * factor;
p.z := p.z * factor;
glWindowSide.AddNode(p.x, p.y, p.z);
xSide.FGLPoints[k] := p;
end;
with TGLSceneObject(glObject).Material do
begin
aColor := clrSilver;
BackProperties.Ambient.Color := aColor;
BackProperties.Diffuse.Color := aColor;
BackProperties.Emission.Color := aColor;
FrontProperties.Ambient.Color := aColor;
FrontProperties.Diffuse.Color := aColor;
FrontProperties.Emission.Color := aColor;
MaterialOptions := [moNoLighting];
end;
end;
// ********************** NETWINDOWs ***************************************
// ********************** NETBALCONs ***************************************
if Face.RecType = ftNetBalconDoor then
begin
for k := 0 to pCnt - 1 do
begin
p := Face.Points[k];
p := DoublePoint(p.x, p.z, p.y);
p1 := Face.Points[1];
p1 := DoublePoint(p1.x, p1.z, p1.y);
p.x := p.x * factor;
if (p.y < 0.011) then
begin
if (p.y <> p1.y) then
p.y := p.y * factor
else
p.y := p.y * factor + FDeltaZSlope
end
else
p.y := p.y * factor;
p.z := p.z * factor;
glBalconDoorSide.AddNode(p.x, p.y, p.z);
xSide.FGLPoints[k] := p;
end;
with TGLSceneObject(glObject).Material do
begin
aColor := clrGray80;
BackProperties.Ambient.Color := aColor;
BackProperties.Diffuse.Color := aColor;
BackProperties.Emission.Color := aColor;
FrontProperties.Ambient.Color := aColor;
FrontProperties.Diffuse.Color := aColor;
FrontProperties.Emission.Color := aColor;
MaterialOptions := [moNoLighting];
end;
end;
if Face.RecType = ftNetBalconWindow then
begin
for k := 0 to pCnt - 1 do
begin
p := Face.Points[k];
p := DoublePoint(p.x, p.z, p.y);
p1 := Face.Points[1];
p1 := DoublePoint(p1.x, p1.z, p1.y);
p.x := p.x * factor;
//if (p.y < 0.011) then
//begin
// if (p.y <> p1.y) then
// p.y := p.y * factor
// else
// p.y := p.y * factor + FDeltaZSlope
//end
//else
p.y := p.y * factor;
p.z := p.z * factor;
glBalconWindowSide.AddNode(p.x, p.y, p.z);
xSide.FGLPoints[k] := p;
end;
with TGLSceneObject(glObject).Material do
begin
aColor := clrSilver;
BackProperties.Ambient.Color := aColor;
BackProperties.Diffuse.Color := aColor;
BackProperties.Emission.Color := aColor;
FrontProperties.Ambient.Color := aColor;
FrontProperties.Diffuse.Color := aColor;
FrontProperties.Emission.Color := aColor;
MaterialOptions := [moNoLighting];
end;
end;
// ********************** NETBALCONs ***************************************
// ********************** NETFLOOR *****************************************
{TODO}
(*
if Face.RecType = ftNetFloor then
begin
glFloor.Direction.Y := -1;
glFloor.Direction.Z := 0;
glFloor.Direction.X := 0;
glFloor.Up.Y := 0;
glFloor.Up.Z := 1;
glFloor.Up.X := 0;
SetLength(FloorCoords, pCnt div 2);
for k := 0 to (pCnt div 2) - 1 do
begin
p := Face.Points[k];
p := DoublePoint(p.x, p.z, p.y);
FloorCoords[k][0] := p.x * factor;
FloorCoords[k][1] := p.y * factor + FDeltaZ;
FloorCoords[k][2] := p.z * factor;
end;
if (pCnt div 2) >= 3 then
begin
for k := 0 to (pCnt div 2) - 3 do
begin
dp1 := DoublePoint(FloorCoords[0][0], FloorCoords[0][2], FloorCoords[0][1]);
dp2 := DoublePoint(FloorCoords[k + 1][0], FloorCoords[k + 1][2], FloorCoords[k + 1][1]);
Angle1 := GetLineAngle(dp1, dp2);
dp1 := DoublePoint(FloorCoords[k + 1][0], FloorCoords[k + 1][2], FloorCoords[k + 1][1]);
dp2 := DoublePoint(FloorCoords[k + 2][0], FloorCoords[k + 2][2], FloorCoords[k + 2][1]);
Angle2 := GetLineAngle(dp1, dp2);
ResAng := abs(Angle1 - Angle2);
//if ResAng < 180 then
begin
pN := CalcPlaneNormal (FloorCoords[0], FloorCoords[k + 1], FloorCoords[k + 2]);
if (not isNaN(pN[0])) and (Not IsNaN(pN[1])) and (Not IsNaN(pN[2])) then
break;
end;
end;
if k > ((pCnt div 2) - 1) then
k := 0;
pN := CalcPlaneNormal (FloorCoords[0], FloorCoords[k + 1], FloorCoords[k + 2]);
end
else
pN[1] := 0;
if pN[1] >= 0 then
glFloor.Parts := [ppTop]
else
glFloor.Parts := [ppBottom];
for k := 0 to (pCnt div 2) - 1 do
begin
p := Face.Points[k];
p := DoublePoint(p.x, p.y, p.z);
glFloor.AddNode(p.x * factor, p.y * factor, p.z * factor + FDeltaZ);
end;
with TGLSceneObject(glObject).Material do
begin
aColor := clrSilver;
BackProperties.Ambient.Color := aColor;
BackProperties.Diffuse.Color := aColor;
BackProperties.Emission.Color := aColor;
FrontProperties.Ambient.Color := aColor;
FrontProperties.Diffuse.Color := aColor;
FrontProperties.Emission.Color := aColor;
Texture.texturemode := tmDecal;
Texture.Disabled := False;
Texture.Image.LoadFromFile(tex_floor);
TGLSceneObject(glObject).Tag := 998;
end;
end;
*)
if Face.RecType = ftNetFloor then
begin
{
glFloor.Direction.Y := -1;
glFloor.Direction.Z := 0;
glFloor.Direction.X := 0;
glFloor.Up.Y := 0;
glFloor.Up.Z := 1;
glFloor.Up.X := 0;
}
SetLength(FloorCoords, pCnt);
for k := 0 to pCnt - 1 do
begin
p := Face.Points[k];
p := DoublePoint(p.x, p.z, p.y);
FloorCoords[k][0] := p.x * factor;
FloorCoords[k][1] := p.y * factor + FDeltaZ;
FloorCoords[k][2] := p.z * factor;
end;
if pCnt >= 3 then
begin
for k := 0 to pCnt - 3 do
begin
dp1 := DoublePoint(FloorCoords[0][0], FloorCoords[0][2], FloorCoords[0][1]);
dp2 := DoublePoint(FloorCoords[k + 1][0], FloorCoords[k + 1][2], FloorCoords[k + 1][1]);
Angle1 := GetLineAngle(dp1, dp2);
dp1 := DoublePoint(FloorCoords[k + 1][0], FloorCoords[k + 1][2], FloorCoords[k + 1][1]);
dp2 := DoublePoint(FloorCoords[k + 2][0], FloorCoords[k + 2][2], FloorCoords[k + 2][1]);
Angle2 := GetLineAngle(dp1, dp2);
ResAng := abs(Angle1 - Angle2);
//if ResAng < 180 then
begin
pN := CalcPlaneNormal (FloorCoords[0], FloorCoords[k + 1], FloorCoords[k + 2]);
if (not isNaN(pN[0])) and (Not IsNaN(pN[1])) and (Not IsNaN(pN[2])) then
break;
end;
end;
if k > (pCnt - 1) then
k := 0;
pN := CalcPlaneNormal (FloorCoords[0], FloorCoords[k + 1], FloorCoords[k + 2]);
end
else
pN[1] := 0;
if pN[1] >= 0 then
glFloor.Parts := [ppTop]
else
glFloor.Parts := [ppBottom];
for k := 0 to pCnt - 1 do
begin
p := Face.Points[k];
p := DoublePoint(p.x * factor, p.z * factor + FDeltaZ, p.y * factor);
glFloor.AddNode(p.x, p.y, p.z);
xSide.FGLPoints[k] := p;
end;
with TGLSceneObject(glObject).Material do
begin
aColor := clrSilver;
BackProperties.Ambient.Color := aColor;
BackProperties.Diffuse.Color := aColor;
BackProperties.Emission.Color := aColor;
FrontProperties.Ambient.Color := aColor;
FrontProperties.Diffuse.Color := aColor;
FrontProperties.Emission.Color := aColor;
Texture.texturemode := tmDecal;
Texture.Disabled := False;
ImgName := GetImageFileByHash(xSide.FTextureHash);
if ImgName <> '' then
begin
Texture.Image.LoadFromFile(ImgName);
end
else
begin
Texture.Image.LoadFromFile(ExeDir + '\3DTextures\floor.bmp');
end;
end;
RotateTextureToAngleP(xSide, GLFloor, xSide.FRotate, xSide.FMirror);
end;
// ********************** NETFLOOR *****************************************
// ********************** NETCEILING ***************************************
{TODO}
(*
if Face.RecType = ftNetCeiling then
begin
glCeiling.Direction.Y := -1;
glCeiling.Direction.Z := 0;
glCeiling.Direction.X := 0;
glCeiling.Up.Y := 0;
glCeiling.Up.Z := 1;
glCeiling.Up.X := 0;
SetLength(FloorCoords, pCnt div 2);
for k := 0 to (pCnt div 2) - 1 do
begin
p := Face.Points[k];
p := DoublePoint(p.x, p.z, p.y);
FloorCoords[k][0] := p.x * factor;
FloorCoords[k][1] := p.y * factor + FDeltaZ;
FloorCoords[k][2] := p.z * factor;
end;
if (pCnt div 2) >= 3 then
begin
for k := 0 to (pCnt div 2) - 3 do
begin
dp1 := DoublePoint(FloorCoords[0][0], FloorCoords[0][2], FloorCoords[0][1]);
dp2 := DoublePoint(FloorCoords[k + 1][0], FloorCoords[k + 1][2], FloorCoords[k + 1][1]);
Angle1 := GetLineAngle(dp1, dp2);
dp1 := DoublePoint(FloorCoords[k + 1][0], FloorCoords[k + 1][2], FloorCoords[k + 1][1]);
dp2 := DoublePoint(FloorCoords[k + 2][0], FloorCoords[k + 2][2], FloorCoords[k + 2][1]);
Angle2 := GetLineAngle(dp1, dp2);
ResAng := abs(Angle1 - Angle2);
//if ResAng < 180 then
begin
pN := CalcPlaneNormal (FloorCoords[0], FloorCoords[k + 1], FloorCoords[k + 2]);
if (not isNaN(pN[0])) and (Not IsNaN(pN[1])) and (Not IsNaN(pN[2])) then
break;
end;
end;
if k > ((pCnt div 2) - 1) then
k := 0;
pN := CalcPlaneNormal (FloorCoords[0], FloorCoords[k + 1], FloorCoords[k + 2]);
end
else
pN[1] := 0;
if pN[1] >= 0 then
glCeiling.Parts := [ppBottom]
else
glCeiling.Parts := [ppTop];
for k := 0 to (pCnt div 2) - 1 do
begin
p := Face.Points[k];
p := DoublePoint(p.x, p.y, p.z);
glCeiling.AddNode(p.x * factor, p.y * factor, - (p.z * factor + FDeltaZ) );
end;
with TGLSceneObject(glObject).Material do
begin
aColor := clrSilver;
BackProperties.Ambient.Color := aColor;
BackProperties.Diffuse.Color := aColor;
BackProperties.Emission.Color := aColor;
FrontProperties.Ambient.Color := aColor;
FrontProperties.Diffuse.Color := aColor;
FrontProperties.Emission.Color := aColor;
Texture.texturemode := tmDecal;
Texture.Disabled := False;
Texture.Image.LoadFromFile(tex_ceiling);
TGLSceneObject(glObject).Tag := 999;
end;
end;
*)
if Face.RecType = ftNetCeiling then
begin
{
glCeiling.Direction.Y := -1;
glCeiling.Direction.Z := 0;
glCeiling.Direction.X := 0;
glCeiling.Up.Y := 0;
glCeiling.Up.Z := 1;
glCeiling.Up.X := 0;
}
SetLength(FloorCoords, pCnt);
for k := 0 to pCnt - 1 do
begin
p := Face.Points[k];
p := DoublePoint(p.x, p.z, p.y);
FloorCoords[k][0] := p.x * factor;
FloorCoords[k][1] := p.y * factor + FDeltaZ;
FloorCoords[k][2] := p.z * factor;
end;
if pCnt >= 3 then
begin
for k := 0 to pCnt - 3 do
begin
dp1 := DoublePoint(FloorCoords[0][0], FloorCoords[0][2], FloorCoords[0][1]);
dp2 := DoublePoint(FloorCoords[k + 1][0], FloorCoords[k + 1][2], FloorCoords[k + 1][1]);
Angle1 := GetLineAngle(dp1, dp2);
dp1 := DoublePoint(FloorCoords[k + 1][0], FloorCoords[k + 1][2], FloorCoords[k + 1][1]);
dp2 := DoublePoint(FloorCoords[k + 2][0], FloorCoords[k + 2][2], FloorCoords[k + 2][1]);
Angle2 := GetLineAngle(dp1, dp2);
ResAng := abs(Angle1 - Angle2);
//if ResAng < 180 then
begin
pN := CalcPlaneNormal (FloorCoords[0], FloorCoords[k + 1], FloorCoords[k + 2]);
if (not isNaN(pN[0])) and (Not IsNaN(pN[1])) and (Not IsNaN(pN[2])) then
break;
end;
end;
if k > (pCnt - 1) then
k := 0;
pN := CalcPlaneNormal (FloorCoords[0], FloorCoords[k + 1], FloorCoords[k + 2]);
end
else
pN[1] := 0;
if pN[1] >= 0 then
glCeiling.Parts := [ppBottom]
else
glCeiling.Parts := [ppTop];
for k := 0 to pCnt - 1 do
begin
p := Face.Points[k];
p := DoublePoint(p.x * factor, p.z * factor + FDeltaZ, p.y * factor);
glCeiling.AddNode(p.x, p.y, p.z);
xSide.FGLPoints[k] := p;
end;
{
for k := 0 to pCnt - 1 do
begin
p := Face.Points[k];
p := DoublePoint(p.x * factor, p.z * factor, p.y * factor + FDeltaZ);
glCeiling.AddNode(p.x, p.y, p.z);
xSide.FGLPoints[k] := p;
end;
}
with TGLSceneObject(glObject).Material do
begin
aColor := clrSilver;
BackProperties.Ambient.Color := aColor;
BackProperties.Diffuse.Color := aColor;
BackProperties.Emission.Color := aColor;
FrontProperties.Ambient.Color := aColor;
FrontProperties.Diffuse.Color := aColor;
FrontProperties.Emission.Color := aColor;
Texture.texturemode := tmDecal;
Texture.Disabled := False;
ImgName := GetImageFileByHash(xSide.FTextureHash);
if ImgName <> '' then
begin
Texture.Image.LoadFromFile(ImgName);
end
else
begin
Texture.Image.LoadFromFile(ExeDir + '\3DTextures\ceiling.bmp');
end;
end;
RotateTextureToAngleP(xSide, GLCeiling, xSide.FRotate, xSide.FMirror);
end;
// ********************** NETCEILING ***************************************
// ********************** NET3DSObject *************************************
if Face.RecType = ftNet3DSObject then
begin
gl3DSObject.Material.Texture.Disabled := False;
gl3DSObject.LoadFromFile(xObject.FPath);
for k := 0 to pCnt - 1 do
begin
p := Face.Points[k];
gl3DSObject.Position.x := p.x;
gl3DSObject.Position.y := p.y;
gl3DSObject.Position.z := p.z;
end;
gl3DSObject.Scale.x := xObject.FScale.x;
gl3DSObject.Scale.y := xObject.FScale.y;
gl3DSObject.Scale.z := xObject.FScale.z;
gl3DSObject.PitchAngle := xObject.FRotate.x;
gl3DSObject.TurnAngle := xObject.FRotate.y;
gl3DSObject.RollAngle := xObject.FRotate.z;
with gl3DSObject.Material do
begin
FrontProperties.Ambient.Color := ObjColor;
FrontProperties.Diffuse.Color := ObjColor;
FrontProperties.Emission.Color := ObjColor;
BackProperties.Ambient.Color := ObjColor;
BackProperties.Diffuse.Color := ObjColor;
BackProperties.Emission.Color := ObjColor;
//MaterialOptions := [moNoLighting];
end;
gl3DSObject.BuildOctree;
end;
// ********************** NET3DSObject *************************************
with TGLSceneObject(glObject).Material do
begin
if (Face.Trans) or (face.OpTrans) then
begin
BlendingMode := bmTransparency;
BackProperties.Diffuse.Alpha := 0.4;
FrontProperties.Diffuse.Alpha := 0.4;
end;
end;
if Face.RecType = ftPipe then
begin
glPipe.Radius := Face.Size;
glPipe.Parts := [ppOutSide,ppInSide,ppStartDisk,ppStopDisk];
end
else
if Face.RecType = ftBar then
begin
glPipe.Radius := 0.06;
end
else
if Face.RecType = ftSphere then
begin
glSphere.Radius := Face.Size * factor;
end
else
if Face.RecType = ftCenterCube then
begin
end
else
begin
end;
end;
//// *********** FACES.COUNT *************************************************
//GCadForm.FActiveNet;
cx := ((tx+bx) / 2) * Factor;
cy := ((ty+by) / 2) * Factor;
cz := ((tz+bz) / 2) * Factor;
Cpoint := DoublePoint(cx,cy,cz);
Opoint := DoublePoint(cx,(by * factor) - 5,tz * factor);
MainCenter.Position.X := cx;
//MainCenter.Position.Y := cy;
MainCenter.Position.Z := cz;
GLCamera.Position.x := cx;
GLCamera.Position.y := cy;
GLCamera.Position.z := tz * factor + 40;
{$IF Not Defined(ES_GRAPH_SC)}
GLPlane1.Material.Texture.Image.LoadFromFile(GetPathToSCSTmpDir + '\3d.jpg');
{$ELSE}
GLPlane1.Position.y := GLPlane1.Position.y - FDeltaZPlane;
{$IFEND}
GLPlane1.Scale.Y := GCadForm.PCad.WorkHeight * factor;
GLPlane1.Scale.X := GCadForm.PCad.WorkWidth * factor;
GLCameraFirstPerson.Position.x := cx;
GLCameraFirstPerson.Position.y := cy;
GLCameraFirstPerson.Position.z := 40;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD>
glCamera.CameraStyle := csPerspective;
GLCamera.FocalLength := 160;
lbViewType.Caption := cForm3D_Mes3;
AfterUpdate;
except
on E: Exception do AddExceptionToLogEx('Form3d.UpdateFaces', E.Message);
end;
end;
procedure Tfrm3D.SetCubeBounds(var glCube: TGLCube; Points: T3dPointArray;Factor:Double);
var p1,p2,p3,p4,p5: T3DPoint;
px,py,pz: Double;
len,w,h: Double;
mp,xp1,xp2: TDoublePoint;
mp3: T3dPoint;
begin
p1 := Points[0];
p2 := Points[1];
p3 := Points[2];
p4 := Points[3];
p5 := Points[4];
xp1 := DoublePOint(p1.x,p1.y);
xp2 := DoublePOint(p3.x,p3.y);
mp := MPoint(xp1,xp2);
pz := (p1.z+p5.z) /2;
mp3 := DoublePOint(mp,pz);
xp1 := DoublePoint(p1.x,p1.y);
xp2 := DoublePoint(p2.x,p2.y);
len := GetLineLenght(xp1,xp2);
xp1 := DoublePoint(p1.x,p1.y);
xp2 := DoublePoint(p4.x,p4.y);
w := GetLineLenght(xp1,xp2);
h := abs(p1.z-p5.z);
glCube.Position.X := mp3.x*factor;
glCube.Position.Y := mp3.z*factor;
glCube.Position.Z := mp3.y*factor;
glCube.CubeWidth := h*factor;
glCube.CubeDepth := w*factor;
glCube.CubeHeight := len*factor;
end;
procedure Tfrm3D.SpeedButton1Click(Sender: TObject);
begin
glCamera.CameraStyle := csPerspective;
GLCamera.FocalLength := 160;
GLSceneViewer.Camera := GLCamera;
lbViewType.Caption := cForm3D_Mes3;
end;
procedure Tfrm3D.SpeedButton2Click(Sender: TObject);
begin
glCamera.CameraStyle := csOrthogonal;
GLCamera.FocalLength := 1.7;
GLSceneViewer.Camera := GLCamera;
lbViewType.Caption := cForm3D_Mes4;
end;
(*
procedure Tfrm3D.cmbCenterClick(Sender: TObject);
var xObject:TObject;
begin
if CmbCenter.ItemIndex = -1 then
exit;
xObject := CmbCenter.Items.Objects[cmbCenter.ItemIndex];
if not assigned(xObject) then
exit;
//GLCamera1.TargetObject := TGLDummyCube(xObject);
end;
*)
procedure Tfrm3D.FormShow(Sender: TObject);
begin
// UpdateModelTree;
cbViewCeiling.Checked := True;
{$IF Not Defined(ES_GRAPH_SC)}
cbViewCeiling.Visible := False;
sbSaveModel.Visible := False;
panObjects.Visible := False;
Splitter1.Visible := False;
{$IFEND}
SetAllPanels(False);
GLCadencer.Enabled := True;
end;
procedure Tfrm3D.GLHeightField1GetHeight(const x, y: Single; var z: Single;
var color: TVector4f; var texPoint: TTexPoint);
begin
z := 0;
end;
procedure Tfrm3D.FormMouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
var
s: Single;
shiftDown : Boolean;
ctrlDown : Boolean;
i: integer;
Res1: TWinControl;
Pt: TPoint;
begin
GetCursorPos(Pt);
Res1 := FindControl(WindowFromPoint(Pt));
if (Res1 = nil) or (Res1.name <> 'GLSceneViewer') then
exit;
shiftDown := (IsKeyDown(VK_LShift) or IsKeyDown(VK_RSHIFT));
ctrlDown := (IsKeyDown(VK_LCONTROL) or IsKeyDown(VK_RCONTROL));
if ctrlDown then
begin
for i := 0 to DummyCube.Count - 1 do
begin
if shiftdown then
begin
if DummyCube.Children[i].ClassName = 'TGLSpaceText' then
begin
if WheelDelta < 0 then
begin
if DummyCube.Children[i].Scale.X >= 0.01 then
begin
DummyCube.Children[i].Scale.X := DummyCube.Children[i].Scale.X + WheelDelta / 24000;
DummyCube.Children[i].Scale.Y := DummyCube.Children[i].Scale.Y + WheelDelta / 24000;
DummyCube.Children[i].Scale.Z := DummyCube.Children[i].Scale.Z + WheelDelta / 24000;
end;
end
else
begin
DummyCube.Children[i].Scale.X := DummyCube.Children[i].Scale.X + WheelDelta / 24000;
DummyCube.Children[i].Scale.Y := DummyCube.Children[i].Scale.Y + WheelDelta / 24000;
DummyCube.Children[i].Scale.Z := DummyCube.Children[i].Scale.Z + WheelDelta / 24000;
end;
end;
end
else
begin
if DummyCube.Children[i].ClassName = 'TGLFreeForm' then
begin
if WheelDelta < 0 then
begin
if DummyCube.Children[i].Scale.X >= 0.01 then
begin
DummyCube.Children[i].Scale.X := DummyCube.Children[i].Scale.X + WheelDelta / 24000;
DummyCube.Children[i].Scale.Y := DummyCube.Children[i].Scale.Y + WheelDelta / 24000;
DummyCube.Children[i].Scale.Z := DummyCube.Children[i].Scale.Z + WheelDelta / 24000;
end;
end
else
begin
DummyCube.Children[i].Scale.X := DummyCube.Children[i].Scale.X + WheelDelta / 24000;
DummyCube.Children[i].Scale.Y := DummyCube.Children[i].Scale.Y + WheelDelta / 24000;
DummyCube.Children[i].Scale.Z := DummyCube.Children[i].Scale.Z + WheelDelta / 24000;
end;
end;
end;
end;
end
else
begin
s := GLSceneViewer.Camera.FocalLength;
if shiftdown then
begin
if GLSceneViewer.Camera.CameraStyle = csPerspective then
GLSceneViewer.Camera.FocalLength := s + WheelDelta / 80
else
GLSceneViewer.Camera.FocalLength := s + WheelDelta / 2420;
end
else
begin
if GLSceneViewer.Camera.CameraStyle = csPerspective then
GLSceneViewer.Camera.FocalLength := s + WheelDelta / 20
else
GLSceneViewer.Camera.FocalLength := s + WheelDelta / 540;
end;
end;
end;
procedure Tfrm3D.SpeedButton3Click(Sender: TObject);
var
Save3D: TSaveDialog;
Jpeg: TJPEGImage;
Bmp: TBitmap;
BmpFileName: string;
bmpx, bmpy: Integer;
begin
try
if GLSceneViewer.Camera.CameraStyle = csPerspective then
begin
ShowMessage(cForm3D_Mes2);
Exit;
end;
Save3D := TSaveDialog.Create(nil);
with Save3D do
begin
InitialDir := GetEXEDir;
Title := cForm3D_Mes1;
Filter := '(*.jpg)|*.jpg';
DefaultExt := '*.jpg';
FileName := '';
Options := [ofReadOnly,ofHideReadOnly,ofPathMustExist,ofFileMustExist,ofNoDereferenceLinks];
end;
if Save3D.Execute then
begin
if frm3D_Save.ShowModal = mrOk then
begin
Bmp := TBitmap.Create;
Jpeg := TJPEGImage.Create;
BmpFileName := ChangeFileExt(Save3D.FileName, '.bmp');
if frm3D_Save.rbLow.Checked then
begin
GLSceneViewer.Buffer.RenderToFile(BmpFileName, 300);
end;
if frm3D_Save.rbNormal.Checked then
begin
bmpx := GLSceneViewer.Buffer.Width * 2;
bmpy := GLSceneViewer.Buffer.Height * 2;
GLSceneViewer.Buffer.RenderToFile(BmpFileName, bmpx, bmpy);
end;
if frm3D_Save.rbHigh.Checked then
begin
bmpx := GLSceneViewer.Buffer.Width * 3;
bmpy := GLSceneViewer.Buffer.Height * 3;
GLSceneViewer.Buffer.RenderToFile(BmpFileName, bmpx, bmpy);
end;
Bmp.LoadFromFile(BmpFileName);
ConvertBMPToJpeg(Bmp, BmpFileName);
FreeAndNil(Bmp);
DeleteFile(BmpFileName);
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.SpeedButton3Click', E.Message);
end;
end;
procedure Tfrm3D.cbViewCeilingClick(Sender: TObject);
var
i: integer;
xNode: TTreeNode;
begin
try
for i := 0 to DummyCube.Count - 1 do
begin
if (DummyCube.Children[i].TagObject <> nil) then
begin
xNode := TTreeNode(DummyCube.Children[i].TagObject);
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>/<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD>
if T3dSide(xNode.Data).FFaceType = ftNetCeiling then
DummyCube.Children[i].Visible := cbViewCeiling.Checked;
if T3dSide(xNode.Data).FFaceType = ftNetFloor then
DummyCube.Children[i].Visible := cbViewCeiling.Checked;
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.cbViewCeilingClick', E.Message);
end;
end;
procedure Tfrm3D.AddWall(aWall: TGLMesh; vs: array of TVector3f);
var
vd: array [1..6] of TVertexData;
pN, pP: TVector3f;
mat: TAffineMatrix;
begin
try
pN := CalcPlaneNormal (vs[0], vs[1], vs[2]);
SetVector (mat[2], pN);
SetVector (mat[0], VectorNormalize (VectorSubtract (vs[1], vs[0])));
SetVector (mat[1], VectorCrossProduct (mat[2], mat[0]));
InvertMatrix (mat);
with vd[1] do begin
coord := vs[0];
normal := pN;
pP := VectorTransform (vs[0], mat);
textCoord := TexPointMake (pP[0], pP[1]);
end;
with vd[2] do begin
coord := vs[1];
normal := pN;
pP := VectorTransform (vs[1], mat);
textCoord := TexPointMake (pP[0], pP[1]);
end;
with vd[3] do begin
coord := vs[2];
normal := pN;
pP := VectorTransform (vs[2], mat);
textCoord := TexPointMake (pP[0], pP[1]);
end;
with vd[4] do begin
coord := vs[3];
normal := pN;
pP := VectorTransform (vs[3], mat);
textCoord := TexPointMake (pP[0], pP[1]);
end;
with vd[5] do begin
coord := vs[4];
normal := pN;
pP := VectorTransform (vs[4], mat);
textCoord := TexPointMake (pP[0], pP[1]);
end;
with vd[6] do begin
coord := vs[5];
normal := pN;
pP := VectorTransform (vs[5], mat);
textCoord := TexPointMake (pP[0], pP[1]);
end;
aWall.Vertices.AddVertex (vd[1]);
aWall.Vertices.AddVertex (vd[2]);
aWall.Vertices.AddVertex (vd[3]);
aWall.Vertices.AddVertex (vd[4]);
aWall.Vertices.AddVertex (vd[5]);
aWall.Vertices.AddVertex (vd[6]);
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.AddFloor', E.Message);
end;
end;
procedure Tfrm3D.AddFloor(aFloor: TGLMesh; vs: array of TVector3f; aSide: T3DSide);
var
vd: TVertexData;
pN, pP: TVector3f;
pN2: TVector3f;
vs0, vs1, vs2: TVector3f;
mat: TAffineMatrix;
i, k, Cnt: Integer;
Angle1, Angle2, ResAng: Double;
dp1, dp2: TDoublePoint;
begin
try
Cnt := Length(vs);
//pN := CalcPlaneNormal (vs[0], vs[1], vs[2]);
pN2[0] := 0;
pN2[1] := 1;
pN2[2] := 0;
if Cnt >= 3 then
begin
for k := 0 to Cnt - 3 do
begin
dp1 := DoublePoint(vs[0][0], vs[0][2], vs[0][1]);
dp2 := DoublePoint(vs[k + 1][0], vs[k + 1][2], vs[k + 1][1]);
Angle1 := GetLineAngle(dp1, dp2);
dp1 := DoublePoint(vs[k + 1][0], vs[k + 1][2], vs[k + 1][1]);
dp2 := DoublePoint(vs[k + 2][0], vs[k + 2][2], vs[k + 2][1]);
Angle2 := GetLineAngle(dp1, dp2);
ResAng := abs(Angle1 - Angle2);
if ResAng < 180 then
begin
pN := CalcPlaneNormal (vs[0], vs[k + 1], vs[k + 2]);
if (not isNaN(pN[0])) and (Not IsNaN(pN[1])) and (Not IsNaN(pN[2])) then
break;
end;
end;
if k > (Cnt - 1) then
k := 0;
SetVector(vs0, vs[0]);
SetVector(vs1, vs[k + 1]);
SetVector(vs2, vs[k + 2]);
end
else
begin
vs0[0] := 0; vs0[1] := 0; vs0[2] := 0;
vs1[0] := 100; vs1[1] := 0; vs1[2] := 0;
vs2[0] := 100; vs2[1] := 0; vs2[2] := 100;
end;
pN := CalcPlaneNormal (vs0, vs1, vs2);
SetVector (mat[2], pN);
SetVector (mat[0], VectorNormalize (VectorSubtract (vs1, vs0)));
SetVector (mat[1], VectorCrossProduct (mat[2], mat[0]));
InvertMatrix (mat);
for i := 0 to Cnt - 1 do
begin
vd.coord := vs[i];
vd.normal := pN;
pP := VectorTransform (vs[i], mat);
vd.textCoord := TexPointMake (pP[0], pP[1]);
aFloor.Vertices.AddVertex (vd);
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.AddFloor', E.Message);
end;
end;
procedure Tfrm3D.UpdateModelTree;
var
i, j, k, ii, jj, kk: integer;
xModelNode, xRoomNode, xCeilingNode, xFloorNode, xWallNode, xWallElementNode, xBalconElementNode, xSlopeNode, xSideNode, xNode: TTreeNode;
xRoom: T3DRoom;
xWall: T3DWall;
xWallElement: T3DWallElement;
xBalconElement: T3DBalconElement;
xSlope: T3DSlope;
xSide: T3DSide;
begin
try
ModelTree.Items.Clear;
xModelNode := ModelTree.Items.AddFirst(nil, F3DModel.FName);
xModelNode.Data := F3DModel;
xModelNode.HasChildren := True;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
for i := 0 to F3DModel.FRooms.Count - 1 do
begin
xRoom := T3DRoom(F3DModel.FRooms[i]);
xRoomNode:= ModelTree.Items.AddChild(xModelNode, xRoom.FName);
xRoomNode.Data := xRoom;
xRoomNode.ImageIndex := 47;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
xSide := xRoom.FCeiling;
xNode := ModelTree.Items.AddChild(xRoomNode, xSide.FName);
xNode.Data := xSide;
xNode.ImageIndex := 56;
xSide.FFace.FTreeNode := xNode;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
xSide := xRoom.FFloor;
xNode := ModelTree.Items.AddChild(xRoomNode, xSide.FName);
xNode.Data := xSide;
xNode.ImageIndex := 56;
xSide.FFace.FTreeNode := xNode;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
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;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>
for k := 0 to xWall.FWallElements.Count - 1 do
begin
xWallElement := T3DWallElement(xWall.FWallElements[k]);
// <20><><EFBFBD><EFBFBD>
if xWallElement.FElementType = dotWindow then
begin
xWallElementNode := ModelTree.Items.AddChild(xWallNode, xWallElement.FName);
xWallElementNode.Data := xWallElement;
xWallElementNode.ImageIndex := 52;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
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;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
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;
// <20><><EFBFBD><EFBFBD><EFBFBD>
if xWallElement.FElementType = dotDoor then
begin
xWallElementNode:= ModelTree.Items.AddChild(xWallNode, xWallElement.FName);
xWallElementNode.Data := xWallElement;
xWallElementNode.ImageIndex := 51;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
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;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
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;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
if xWallElement.FElementType = dotBalcony then
begin
xWallElementNode:= ModelTree.Items.AddChild(xWallNode, xWallElement.FName);
xWallElementNode.Data := xWallElement;
xWallElementNode.ImageIndex := 55;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
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;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
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;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
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;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
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;
// <20><><EFBFBD><EFBFBD>
if xWallElement.FElementType = dotNiche then
begin
xWallElementNode:= ModelTree.Items.AddChild(xWallNode, xWallElement.FName);
xWallElementNode.Data := xWallElement;
xWallElementNode.ImageIndex := 53;
end;
// <20><><EFBFBD><EFBFBD>
if xWallElement.FElementType = dotArc then
begin
xWallElementNode:= ModelTree.Items.AddChild(xWallNode, xWallElement.FName);
xWallElementNode.Data := xWallElement;
xWallElementNode.ImageIndex := 54;
end;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>
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;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>
for k := 0 to xWall.FSides.Count - 1 do
begin
xSide := T3DSide(xWall.FSides[k]);
xNode := ModelTree.Items.AddChild(xWallNode, xSide.FName);
xNode.Data := xSide;
xNode.ImageIndex := 50;
xSide.FFace.FTreeNode := xNode;
end;
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.UpdateModelTree', E.Message);
end;
end;
procedure Tfrm3D.UpdateModelTreeFromStream(Faces: TList);
var
i, j, k, ii, jj, kk, iadd: integer;
xModelNode, xRoomNode, xCeilingNode, xFloorNode, xWallNode, xWallElementNode, xBalconElementNode, xSlopeNode, xSideNode, x3DSNode, xNode, xSubNode: TTreeNode;
xRoom, xStrRoom: T3DRoom;
xWall, xStrWall: T3DWall;
xWallElement, xStrWallElement: T3DWallElement;
xBalconElement, xStrBalconElement: T3DBalconElement;
xSlope, xStrSlope: T3DSlope;
xSide, xStrSide, xAddSide, xSubSide, xStrSubSide: T3DSide;
xObject, xStrObject: T3DSObject;
begin
try
ModelTree.Items.Clear;
xModelNode := ModelTree.Items.AddFirst(nil, F3DModel.FName);
xModelNode.Data := F3DModel;
xModelNode.HasChildren := True;
CopyModelHash;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
for i := 0 to F3DModel.FRooms.Count - 1 do
begin
xRoom := T3DRoom(F3DModel.FRooms[i]);
xStrRoom := T3DRoom(getModelObjectByComponID(xRoom.FSCSComponID));
xRoomNode:= ModelTree.Items.AddChild(xModelNode, xRoom.FName);
xRoomNode.Data := xRoom;
xRoomNode.ImageIndex := 47;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
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;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
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;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> 3<><33> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
// !!! <20><><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
if xStrSide <> nil then
begin
for j := 0 to xStrRoom.F3DSObjects.Count - 1 do
begin
xStrObject := T3DSObject(xStrRoom.F3DSObjects[j]);
xObject := CopyObjectProperties(nil, xStrObject);
xNode := ModelTree.Items.AddChild(xRoomNode, xObject.FName);
xNode.Data := xObject;
xNode.ImageIndex := 42;
xObject.FFace.FTreeNode := xNode;
Faces.Add(xObject.FFace);
xObject.FParent := xRoom;
xRoom.F3DSObjects.Add(xObject);
end;
end;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
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;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>
for k := 0 to xWall.FWallElements.Count - 1 do
begin
xWallElement := T3DWallElement(xWall.FWallElements[k]);
xStrWallElement := T3DWallElement(getModelObjectByComponID(xWallElement.FSCSComponID));
// <20><><EFBFBD><EFBFBD>
if xWallElement.FElementType = dotWindow then
begin
xWallElementNode := ModelTree.Items.AddChild(xWallNode, xWallElement.FName);
xWallElementNode.Data := xWallElement;
xWallElementNode.ImageIndex := 52;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
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;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
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;
// <20><><EFBFBD><EFBFBD><EFBFBD>
if xWallElement.FElementType = dotDoor then
begin
xWallElementNode:= ModelTree.Items.AddChild(xWallNode, xWallElement.FName);
xWallElementNode.Data := xWallElement;
xWallElementNode.ImageIndex := 51;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
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;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
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;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
if xWallElement.FElementType = dotBalcony then
begin
xWallElementNode:= ModelTree.Items.AddChild(xWallNode, xWallElement.FName);
xWallElementNode.Data := xWallElement;
xWallElementNode.ImageIndex := 55;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
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;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
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;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
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;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
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;
// <20><><EFBFBD><EFBFBD>
if xWallElement.FElementType = dotNiche then
begin
xWallElementNode:= ModelTree.Items.AddChild(xWallNode, xWallElement.FName);
xWallElementNode.Data := xWallElement;
xWallElementNode.ImageIndex := 53;
end;
// <20><><EFBFBD><EFBFBD>
if xWallElement.FElementType = dotArc then
begin
xWallElementNode:= ModelTree.Items.AddChild(xWallNode, xWallElement.FName);
xWallElementNode.Data := xWallElement;
xWallElementNode.ImageIndex := 54;
end;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>
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;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>
for k := 0 to xWall.FSides.Count - 1 do
begin
xSide := T3DSide(xWall.FSides[k]);
xStrSide := GetSimilarSide(xSide, xStrWall);
xNode := ModelTree.Items.AddChild(xWallNode, xSide.FName);
xNode.Data := xSide;
xNode.ImageIndex := 50;
xSide.FFace.FTreeNode := xNode;
if xStrSide <> nil then
begin
CopySideProperties(xSide, xStrSide);
if xStrSide.FSubSides.Count > 0 then
begin
Faces.Remove(xSide.FFace);
for iadd := 0 to xStrSide.FSubSides.Count - 1 do
begin
xStrSubSide := T3DSide(xStrSide.FSubSides[iadd]);
xSubSide := CopySubSideProperties(xStrSubSide);
xSubNode := ModelTree.Items.AddChild(xNode, xSubSide.FName);
xSubNode.Data := xSubSide;
xSubNode.ImageIndex := 56;
xSubSide.FFace.FTreeNode := xSubNode;
Faces.Add(xSubSide.FFace);
xSubSide.FParent := xSide;
xSide.FSubSides.Add(xSubSide);
end;
end;
end;
end;
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.UpdateModelTreeFromStream', E.Message);
end;
end;
function Tfrm3D.CopySideProperties(aSide, aStrSide: T3DSide): T3DSide;
var
i, j: integer;
xSide: T3DSide;
Points: T3DPointArray;
begin
try
Result := nil;
xSide := aSide;
xSide.FName := aStrSide.FName;
xSide.FDescription := aStrSide.FDescription;
xSide.FFaceType := aStrSide.FFaceType;
xSide.FWallType := aStrSide.FWallType;
xSide.FSideType := aStrSide.FSideType;
xSide.FColor := aStrSide.FColor;
xSide.FRotate := aStrSide.FRotate;
xSide.FMirror := aStrSide.FMirror;
xSide.FTextureHash := aStrSide.FTextureHash;
xSide.FTexture_ext := aStrSide.FTexture_ext;
SetLength(xSide.FPoints, Length(aStrSide.FPoints));
for i := 0 to Length(aStrSide.FPoints) - 1 do
begin
xSide.FPoints[i].x := aStrSide.FPoints[i].x;
xSide.FPoints[i].y := aStrSide.FPoints[i].y;
xSide.FPoints[i].z := aStrSide.FPoints[i].z;
end;
SetLength(xSide.FGLPoints, Length(aStrSide.FGLPoints));
for i := 0 to Length(aStrSide.FGLPoints) - 1 do
begin
xSide.FGLPoints[i].x := aStrSide.FGLPoints[i].x;
xSide.FGLPoints[i].y := aStrSide.FGLPoints[i].y;
xSide.FGLPoints[i].z := aStrSide.FGLPoints[i].z;
end;
SetLength(xSide.FFace.Points, Length(xSide.FPoints));
for i := 0 to Length(xSide.FPoints) - 1 do
xSide.FFace.Points[i] := xSide.FPoints[i];
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.CopySideProperties', E.Message);
end;
end;
function Tfrm3D.CopySubSideProperties(aStrSubSide: T3DSide): T3DSide;
var
i, j: integer;
xSide: T3DSide;
Points: T3DPointArray;
begin
try
Result := nil;
xSide := T3DSide.Create(aStrSubSide.FFaceType, aStrSubSide.FWallType, aStrSubSide.FSideType, aStrSubSide.FParent);
xSide.FName := aStrSubSide.FName;
xSide.FDescription := aStrSubSide.FDescription;
xSide.FColor := aStrSubSide.FColor;
xSide.FRotate := aStrSubSide.FRotate;
xSide.FMirror := aStrSubSide.FMirror;
xSide.FTextureHash := aStrSubSide.FTextureHash;
xSide.FTexture_ext := aStrSubSide.FTexture_ext;
SetLength(xSide.FPoints, Length(aStrSubSide.FPoints));
for i := 0 to Length(aStrSubSide.FPoints) - 1 do
begin
xSide.FPoints[i].x := aStrSubSide.FPoints[i].x;
xSide.FPoints[i].y := aStrSubSide.FPoints[i].y;
xSide.FPoints[i].z := aStrSubSide.FPoints[i].z;
end;
SetLength(xSide.FGLPoints, Length(aStrSubSide.FGLPoints));
for i := 0 to Length(aStrSubSide.FGLPoints) - 1 do
begin
xSide.FGLPoints[i].x := aStrSubSide.FGLPoints[i].x;
xSide.FGLPoints[i].y := aStrSubSide.FGLPoints[i].y;
xSide.FGLPoints[i].z := aStrSubSide.FGLPoints[i].z;
end;
xSide.FFace := TFaceRecord.Create(xSide.FPoints, clGray, xSide.FFaceType, 1, False, nil);
xSide.FFace.FFaceWallType := xSide.FWallType;
xSide.FFace.FWallSideType := xSide.FSideType;
Result := xSide;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.CopySubSideProperties', E.Message);
end;
end;
function Tfrm3D.CopyObjectProperties(aObject, aStrObject: T3DSObject): T3DSObject;
var
i, j: integer;
xObject: T3DSObject;
Points: T3DPointArray;
begin
try
Result := nil;
xObject := aObject;
if xObject = nil then
begin
xObject := T3DSObject.Create(aStrObject.FParent);
xObject.FName := aStrObject.FName;
xObject.FDescription := aStrObject.FDescription;
xObject.FPath := aStrObject.FPath;
xObject.FPosition := aStrObject.FPosition;
xObject.FScale := aStrObject.FScale;
xObject.FRotate := aStrObject.FRotate;
SetLength(Points, 1);
Points[0].x := xObject.FPosition.x;
Points[0].y := xObject.FPosition.y;
Points[0].z := xObject.FPosition.z;
xObject.FFace := TFaceRecord.Create(Points, clGray, ftNet3DSObject, 1, False, nil);
Result := xObject;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.CopyObjectProperties', E.Message);
end;
end;
procedure Tfrm3D.GLSceneViewerDblClick(Sender: TObject);
var
i, j: integer;
Obj: TGLBaseSceneObject;
Mesh: TGLMesh;
Polygon: TGLPolygon;
xNode: TTreeNode;
xNodes: TList;
begin
try
Obj := GlsceneViewer.Buffer.GetPickedobject(mx, my);
if Obj <> nil then
begin
if (Obj is TGLPolygon) or (Obj is TGLFreeForm) then
begin
xNodes := TList.create;
if (Obj.TagObject <> nil) then
begin
xNode := TTreeNode(Obj.TagObject);
ModelTree.Select(xNode);
xNodes.Add(xNode);
OnSelectNodes(xNodes);
end;
end;
end
else
begin
DeselectGLObjects;
end;
if FNodesObjectsList.Count > 0 then
DeleteNodesObjects;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.GLSceneViewerDblClick', E.Message);
end;
end;
procedure Tfrm3D.ModelTreeClick(Sender: TObject);
var
i: Integer;
xNode: TTreeNode;
xNodes: TList;
begin
try
if ModelTree.Selected <> nil then
begin
xNodes := TList.create;
for i := 0 to ModelTree.SelectionCount - 1 do
begin
xNode := ModelTree.Selections[i];
xNodes.Add(xNode);
end;
OnSelectNodes(xNodes);
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.ModelTreeClick', E.Message);
end;
end;
procedure Tfrm3D.OnSelectNodes(aNodes: TList);
var
i: Integer;
xNode: TTreeNode;
xObjects: TList;
begin
try
// <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD>
xObjects := FindGLObjectsByNodes(aNodes);
// Deselect objects
DeselectGLObjects;
// Select objects
SelectGLObjects(xObjects);
// Show Properties
OnLoadProperties(aNodes);
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.OnSelectNodes', E.Message);
end;
end;
procedure Tfrm3D.FormCreate(Sender: TObject);
begin
FSelection := TList.Create;
FPropObjects := TList.create;
FPropRecord := TPropRecord.Create;
{$IF Defined(ES_GRAPH_SC)}
panProps.Height := 350;
{$IFEND}
FMovedObject := nil;
SelObjColor := clrLightWood;
ObjColor := clrDarkWood;
FFileStream := ''; //13.12.2010
end;
function Tfrm3D.FindGLObjectsByNodes(aNodes: TList): TList;
var
i: integer;
xObj: TGLBaseSceneObject;
xNode: TTreeNode;
xNodes: TList;
begin
try
Result := TList.Create;
xNodes := GetAllSidesNodesByNodes(aNodes);
for i := 0 to xNodes.Count - 1 do
begin
xNode := TTreeNode(xNodes[i]);
if (TObject(xNode.Data) is T3DSide) then
xObj := TGLBaseSceneObject(T3DSide(xNode.Data).FGLObject);
if (TObject(xNode.Data) is T3DSObject) then
xObj := TGLBaseSceneObject(T3DSObject(xNode.Data).FGLObject);
Result.Add(xObj);
end;
except
on E: Exception do AddExceptionToLogEx('', E.Message);
end;
end;
procedure Tfrm3D.SelectGLObjects(aObjects: TList);
var
i: integer;
xObj: TGLBaseSceneObject;
begin
try
FSelection := aObjects;
for i := 0 to FSelection.Count - 1 do
begin
xObj := TGLBaseSceneObject(FSelection[i]);
if (xObj is TGLPolygon) then
begin
TGLPolygon(xObj).Material.Texture.ImageGamma := 1.5;
TGLPolygon(xObj).Material.MaterialOptions := [];
end;
if (xObj is TGLFreeForm) then
begin
with TGLFreeForm(xObj).Material do
begin
BackProperties.Ambient.Color := SelObjColor;
BackProperties.Diffuse.Color := SelObjColor;
BackProperties.Emission.Color := SelObjColor;
FrontProperties.Ambient.Color := SelObjColor;
FrontProperties.Diffuse.Color := SelObjColor;
FrontProperties.Emission.Color := SelObjColor;
MaterialOptions := [moNoLighting];
end;
end;
end;
except
on E: Exception do AddExceptionToLogEx('', E.Message);
end;
end;
procedure Tfrm3D.DeselectGLObjects;
var
i: integer;
xObj: TGLBaseSceneObject;
begin
try
for i := 0 to FSelection.Count - 1 do
begin
xObj := TGLBaseSceneObject(FSelection[i]);
if (xObj is TGLPolygon) then
begin
TGLPolygon(xObj).Material.Texture.ImageGamma := 1;
TGLPolygon(xObj).Material.MaterialOptions := [moNoLighting];
end;
if (xObj is TGLFreeForm) then
begin
with TGLFreeForm(xObj).Material do
begin
BackProperties.Ambient.Color := ObjColor;
BackProperties.Diffuse.Color := ObjColor;
BackProperties.Emission.Color := ObjColor;
FrontProperties.Ambient.Color := ObjColor;
FrontProperties.Diffuse.Color := ObjColor;
FrontProperties.Emission.Color := ObjColor;
MaterialOptions := [];
end;
end;
end;
FSelection.Clear;
except
on E: Exception do AddExceptionToLogEx('', E.Message);
end;
end;
procedure Tfrm3D.OnLoadProperties(aObjects: TList);
var
i: integer;
ViewType: TPropViewType;
begin
try
ViewType := GetPropViewType(aObjects);
if ViewType = pvtNone then
begin
FPropObjects.Clear;
SetAllPanels(False);
end
else if ViewType = pvtSingleSide then
begin
FPropObjects := aObjects;
SetAllPanels(False);
panTexture.Visible := True;
panMirror.Visible := True;
panRotate.Visible := True;
panCoords.Visible := True;
panDesc.Visible := True;
panName.Visible := True;
LoadPropertiesForSingleObject(TTreeNode(FPropObjects[0]));
end
else if ViewType = pvtMultiSides then
begin
FPropObjects := aObjects;
SetAllPanels(False);
panTexture.Visible := True;
panMirror.Visible := True;
panRotate.Visible := True;
panCoords.Visible := True;
panDesc.Visible := True;
LoadPropertiesForMultiObjects(FPropObjects);
end
else if ViewType = pvtSingle3ds then
begin
FPropObjects := aObjects;
SetAllPanels(False);
panScale3ds.Visible := True;
panRotate3ds.Visible := True;
panPos3ds.Visible := True;
panDesc.Visible := True;
panName.Visible := True;
LoadPropertiesForSingle3ds(TTreeNode(FPropObjects[0]));
end
else if ViewType = pvtMulti3ds then
begin
FPropObjects := aObjects;
SetAllPanels(False);
panScale3ds.Visible := True;
panRotate3ds.Visible := True;
panPos3ds.Visible := True;
panDesc.Visible := True;
LoadPropertiesForMulti3ds(FPropObjects);
end;
except
on E: Exception do AddExceptionToLogEx('', E.Message);
end;
end;
function Tfrm3D.CheckGLObjectInSelectionNodes(aObject: TGLBaseSceneObject; aNodes: TList): Boolean;
var
i, j: integer;
xObj: TGLBaseSceneObject;
xNode: TTreeNode;
xSubNodes: TList;
begin
try
Result := False;
for i := 0 to aNodes.Count - 1 do
begin
xNode := TTreeNode(aNodes[i]);
// <20><><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>, <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><>
if (TObject(xNode.Data) is T3DSide) then
begin
if TTreeNode(aObject.TagObject) = xNode then
begin
Result := True;
exit;
end;
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.CheckGLObjectInSelectionNodes', E.Message);
end;
end;
function Tfrm3D.GetAllSidesNodesByNodes(aNodes: TList): TList;
var
i, j: integer;
xNode: TTreeNode;
xNodes: TList;
begin
try
Result := TList.Create;
for i := 0 to aNodes.Count - 1 do
begin
xNode := TTreeNode(aNodes[i]);
if ((TObject(xNode.Data) is T3DSide) and (T3DSide(xNode.Data).FSubSides.Count = 0)) or
(TObject(xNode.Data) is T3DSObject) then
Result.Add(xNode)
else
begin
xNodes := GetAllChildNodes(xNode);
for j := 0 to xNodes.Count - 1 do
Result.Add(xNodes[j]);
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.GetAllSidesNodesByNodes', E.Message);
end;
end;
function Tfrm3D.GetAllChildNodes(ANode: TTreeNode): TList;
procedure StepGetAllChildNodes(ACurrNode: TTreeNode);
var
CurrNode: TTreeNode;
begin
CurrNode := ACurrNode.getFirstChild;
while CurrNode <> nil do
begin
if (TObject(CurrNode.Data) is T3DSide) then
Result.Add(CurrNode);
StepGetAllChildNodes(CurrNode);
CurrNode := CurrNode.GetNextSibling;
end;
end;
begin
Result := TList.Create;
StepGetAllChildNodes(ANode);
end;
procedure Tfrm3D.FormDestroy(Sender: TObject);
begin
if FSelection <> nil then
FreeAndNil(FSelection);
if FPropObjects <> nil then
FreeAndNil(FPropObjects);
end;
function Tfrm3D.GetPropViewType(aNodes: TList): TPropViewType;
var
i: integer;
xNode: TTreeNode;
begin
try
Result := pvtNone;
if aNodes.Count > 0 then
begin
if aNodes.Count = 1 then
begin
if (TObject(TTreeNode(aNodes[0]).Data) is T3DSide) then
Result := pvtSingleSide;
if (TObject(TTreeNode(aNodes[0]).Data) is T3DSObject) then
Result := pvtSingle3ds;
end
else
begin
//Result := pvtMultiSides;
for i := 0 to aNodes.count - 1 do
begin
xNode := TTreeNode(aNodes[i]);
if not (TObject(xNode.Data) is T3DSide) and not (TObject(xNode.Data) is T3DSObject) then
exit;
if (TObject(xNode.Data) is T3DSide) then
begin
if Result = pvtMulti3ds then
begin
Result := pvtNone;
exit;
end;
Result := pvtMultiSides;
end;
if (TObject(xNode.Data) is T3DSObject) then
begin
if Result = pvtMultiSides then
begin
Result := pvtNone;
exit;
end;
Result := pvtMulti3ds;
end;
end;
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.GetPropViewType', E.Message);
end;
end;
function Tfrm3D.LoadPropertiesForMultiObjects(aObjects: TList): TPropRecord;
var
i: integer;
xObject: T3DSide;
xGLObject: TGLBaseSceneObject;
Points: T3DPointArray;
Cnt: Integer;
xRotate: Integer;
xMirror: Boolean;
xCnt: Integer;
CoordsInfo: string;
begin
try
mDesc.Clear;
cbCoordNbr.Properties.Items.Clear;
for i := 0 to aObjects.Count - 1 do
begin
xObject := T3DSide(TTreeNode(aObjects[i]).Data);
xGLObject := TGLBaseSceneObject(xObject.FGLObject);
if i = 0 then
begin
xRotate := xObject.FRotate;
xMirror := xObject.FMirror;
edRotate.Text := IntToStr(xObject.FRotate);
cbMirror.Checked := xObject.FMirror;
xCnt := Length(xObject.FGLPoints);
end
else
begin
if edRotate.Text <> '' then
if xRotate <> xObject.FRotate then
edRotate.Text := '';
if cbMirror.AllowGrayed = False then
if xMirror <> xObject.FMirror then
cbMirror.AllowGrayed := True;
if xCnt <> - 1 then
if xCnt <> Length(xObject.FGLPoints) then
xCnt := -1;
end;
end;
if xCnt > 0 then
begin
panCoords.Enabled := True;
for i := 0 to xCnt - 1 do
begin
CoordsInfo := '';{' (' + FloatToStr(xObject.FGLPoints[i].x) + '; ' +
FloatToStr(xObject.FGLPoints[i].y) + '; ' +
FloatToStr(xObject.FGLPoints[i].z) + ')';}
cbCoordNbr.Properties.Items.Add(InttoStr(i + 1) + CoordsInfo);
end;
cbCoordNbr.Text := cbCoordNbr.Properties.Items[0];
edCoordX.Text := '';
edCoordY.Text := '';
edCoordZ.Text := '';
end
else
begin
panCoords.Enabled := False;
end;
imgTexture.Clear;
cbHashs.Properties.Items.Clear;
for i := 0 to F3DModel.FHashs.Count - 1 do
begin
cbHashs.Properties.Items.Add(F3DModel.FHashs.Strings[i]);
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.LoadPropertiesForMultiObjects', E.Message);
end;
end;
function Tfrm3D.LoadPropertiesForSingleObject(aObject: TTreeNode): TPropRecord;
var
i: integer;
xObject: T3DSide;
xGLObject: TGLBaseSceneObject;
Points: T3DPointArray;
Cnt: Integer;
CoordsInfo: string;
tmpdir, tmpfname: string;
begin
try
xObject := T3DSide(aObject.Data);
xGLObject := TGLBaseSceneObject(xObject.FGLObject);
edName.Text := xObject.FName;
mDesc.Clear;
for i := 0 to xObject.FDescription.Count - 1 do
mDesc.Lines.Add(xObject.FDescription[i]);
edRotate.Text := IntToStr(xObject.FRotate);
cbMirror.Checked := xObject.FMirror;
cbCoordNbr.Properties.Items.Clear;
Cnt := Length(xObject.FGLPoints);
for i := 0 to Cnt - 1 do
begin
CoordsInfo := '';{' (' + FloatToStr(xObject.FGLPoints[i].x) + '; ' +
FloatToStr(xObject.FGLPoints[i].y) + '; ' +
FloatToStr(xObject.FGLPoints[i].z) + ')';}
cbCoordNbr.Properties.Items.Add(InttoStr(i + 1) + CoordsInfo);
end;
cbCoordNbr.Text := cbCoordNbr.Properties.Items[0];
edCoordX.Text := FloatToStr(xObject.FGLPoints[0].x);
edCoordY.Text := FloatToStr(xObject.FGLPoints[0].y);
edCoordZ.Text := FloatToStr(xObject.FGLPoints[0].z);
imgTexture.Clear;
tmpfname := GetImageFileByHash(xObject.FTextureHash);
if tmpfname <> '' then
imgTexture.Picture.LoadFromFile(tmpfname);
cbHashs.Properties.Items.Clear;
for i := 0 to F3DModel.FHashs.Count - 1 do
begin
cbHashs.Properties.Items.Add(F3DModel.FHashs.Strings[i]);
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.LoadPropertiesForSingleObject', E.Message);
end;
end;
function Tfrm3D.LoadPropertiesForSingle3ds(aObject: TTreeNode): TPropRecord;
var
i: integer;
xObject: T3DSObject;
xGLObject: TGLBaseSceneObject;
begin
try
xObject := T3DSObject(aObject.Data);
xGLObject := TGLBaseSceneObject(xObject.FGLObject);
edName.Text := xObject.FName;
mDesc.Clear;
for i := 0 to xObject.FDescription.Count - 1 do
mDesc.Lines.Add(xObject.FDescription[i]);
edPosX.Text := FloatToStr(xObject.FPosition.x);
edPosY.Text := FloatToStr(xObject.FPosition.y);
edPosZ.Text := FloatToStr(xObject.FPosition.z);
edAngleX.Text := FloatToStr(xObject.FRotate.x);
edAngleY.Text := FloatToStr(xObject.FRotate.y);
edAngleZ.Text := FloatToStr(xObject.FRotate.z);
edScaleX.Text := FloatToStr(xObject.FScale.x);
edScaleY.Text := FloatToStr(xObject.FScale.y);
edScaleZ.Text := FloatToStr(xObject.FScale.z);
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.LoadPropertiesForSingle3ds', E.Message);
end;
end;
function Tfrm3D.LoadPropertiesForMulti3ds(aObjects: TList): TPropRecord;
var
i: integer;
xObject: T3DSObject;
xGLObject: TGLBaseSceneObject;
Points: T3DPointArray;
Cnt: Integer;
xPosX, xPosY, xPosZ, xAngleX, xAngleY, xAngleZ, xScaleX, xScaleY, xScaleZ: Double;
begin
try
mDesc.Clear;
for i := 0 to aObjects.Count - 1 do
begin
xObject := T3DSObject(TTreeNode(aObjects[i]).Data);
xGLObject := TGLBaseSceneObject(xObject.FGLObject);
if i = 0 then
begin
xPosX := xObject.FPosition.x;
edPosX.Text := FloatToStr(xPosX);
xPosY := xObject.FPosition.y;
edPosY.Text := FloatToStr(xPosY);
xPosZ := xObject.FPosition.z;
edPosZ.Text := FloatToStr(xPosZ);
xAngleX := xObject.FRotate.x;
edAngleX.Text := FloatToStr(xAngleX);
xAngleY := xObject.FRotate.y;
edAngleY.Text := FloatToStr(xAngleY);
xAngleZ := xObject.FRotate.z;
edAngleZ.Text := FloatToStr(xAngleZ);
xScaleX := xObject.FScale.x;
edScaleX.Text := FloatToStr(xScaleX);
xScaleY := xObject.FScale.y;
edScaleY.Text := FloatToStr(xScaleY);
xScaleZ := xObject.FScale.z;
edScaleZ.Text := FloatToStr(xScaleZ);
end
else
begin
if edPosX.Text <> '' then
if xPosX <> xObject.FPosition.x then
edPosX.Text := '';
if edPosY.Text <> '' then
if xPosY <> xObject.FPosition.y then
edPosY.Text := '';
if edPosZ.Text <> '' then
if xPosZ <> xObject.FPosition.z then
edPosZ.Text := '';
if edAngleX.Text <> '' then
if xAngleX <> xObject.FRotate.x then
edAngleX.Text := '';
if edAngleY.Text <> '' then
if xAngleY <> xObject.FRotate.y then
edAngleY.Text := '';
if edAngleZ.Text <> '' then
if xAngleZ <> xObject.FRotate.z then
edAngleZ.Text := '';
if edScaleX.Text <> '' then
if xScaleX <> xObject.FScale.x then
edScaleX.Text := '';
if edScaleY.Text <> '' then
if xScaleY <> xObject.FScale.y then
edScaleY.Text := '';
if edScaleZ.Text <> '' then
if xScaleZ <> xObject.FScale.z then
edScaleZ.Text := '';
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.LoadPropertiesForMulti3ds', E.Message);
end;
end;
procedure Tfrm3D.cbCoordNbrCloseUp(Sender: TObject);
var
Index: Integer;
xObject: T3DSide;
begin
try
Index := cbCoordNbr.ItemIndex;
if FPropObjects.Count > 0 then
begin
if FPropObjects.Count = 1 then
begin
xObject := T3DSide(TTreeNode(FPropObjects[0]).Data);
edCoordX.Text := FloatToStr(xObject.FGLPoints[Index].x);
edCoordY.Text := FloatToStr(xObject.FGLPoints[Index].y);
edCoordZ.Text := FloatToStr(xObject.FGLPoints[Index].z);
end
else
begin
edCoordX.Text := '';
edCoordY.Text := '';
edCoordZ.Text := '';
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.cbCoordNbrCloseUp', E.Message);
end;
end;
{ TPropRecord }
constructor TPropRecord.Create;
begin
inherited Create;
fCoords := TList.Create;
fDesc := TStringList.Create;
end;
procedure Tfrm3D.bTextureChangeClick(Sender: TObject);
var
i: integer;
FName: string;
xObject: T3DSide;
xGLObject: TGLBaseSceneObject;
tmpdir, tmpfname, ExtStr, BmpFName: string;
Bmp: TBitmap;
Jpeg: TJPEGImage;
HashStr: string;
begin
try
FName := LoadTexture;
if (FName <> '') and FileExists(FName) then
begin
imgTexture.Picture.LoadFromFile(FName);
ExtStr := ExtractFileExt(FName);
tmpdir := ExtractDirByCategoryType(dctPictures);
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> HASH <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>
HashStr := GetImageHash(FName);
// <20><> HASH <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><> <20><> <20> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>
tmpfname := GetImageFileByHash(HashStr);
// <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>, <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD>
if tmpfname <> '' then
begin
end
else
// <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> - <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> HASH, <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD>, <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
begin
F3DModel.FHashs.Add(HashStr);
tmpfname := tmpdir + '\' + HashStr + '.bmp';
if (ExtStr = '.jpg') or (ExtStr = '.jpeg') then
begin
Bmp := TBitmap.Create;
Jpeg := TJPEGImage.Create;
Jpeg.LoadFromFile(FName);
Bmp.Assign(Jpeg);
Bmp.SaveTofile(tmpfname);
FreeAndNil(Bmp);
FreeAndNil(Jpeg);
end
else
CopyFile(PChar(FName), PChar(tmpfname), True);
end;
for i := 0 to FPropObjects.Count - 1 do
begin
xObject := T3DSide(TTreeNode(FPropObjects[i]).Data);
xGLObject := TGLBaseSceneObject(xObject.FGLObject);
xObject.FTextureHash := HashStr;
xObject.FTexture_ext := ExtStr;
if (xGLObject is TGLPolygon) then
begin
TGLPolygon(xGLObject).Material.Texture.Disabled := False;
TGLPolygon(xGLObject).Material.Texture.Image.LoadFromFile(tmpfname);
RotateTextureToAngleP(xObject, TGLPolygon(xGLObject), xObject.FRotate, xObject.FMirror);
end;
end;
// Resfresh HASHs
cbHashs.Properties.Items.Clear;
for i := 0 to F3DModel.FHashs.Count - 1 do
begin
cbHashs.Properties.Items.Add(F3DModel.FHashs.Strings[i]);
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.bTextureChangeClick', E.Message);
end;
end;
function Tfrm3D.LoadTexture: string;
begin
try
Result := '';
OpenTexture.InitialDir := ExeDir + '\3DTextures';
NoMoveEvent := True;
if OpenTexture.Execute then
begin
Result := OpenTexture.FileName;
end;
except
on E: Exception do AddExceptionToLogEx('', E.Message);
end;
end;
procedure Tfrm3D.edNameExit(Sender: TObject);
begin
ChangeName;
end;
procedure Tfrm3D.bTextureClearClick(Sender: TObject);
var
FName: string;
i: integer;
xObject: T3DSide;
xGLObject: TGLBaseSceneObject;
tmpdir, tmpfname, ExtStr, BmpFName: string;
Bmp: TBitmap;
Jpeg: TJPEGImage;
begin
try
for i := 0 to FPropObjects.Count - 1 do
begin
xObject := T3DSide(TTreeNode(FPropObjects[i]).Data);
xGLObject := TGLBaseSceneObject(xObject.FGLObject);
xObject.FTextureHash := '';
xObject.FTexture_ext := '';
if (xGLObject is TGLPolygon) then
begin
imgTexture.Clear;
TGLPolygon(xGLObject).Material.Texture.Disabled := True;
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.bTextureClearClick', E.Message);
end;
end;
procedure Tfrm3D.cbMirrorClick(Sender: TObject);
var
i: integer;
xObject: T3DSide;
xGLObject: TGLBaseSceneObject;
begin
try
for i := 0 to FPropObjects.Count - 1 do
begin
xObject := T3DSide(TTreeNode(FPropObjects[i]).Data);
xGLObject := TGLBaseSceneObject(xObject.FGLObject);
xObject.FMirror := cbMirror.Checked;
if (xGLObject is TGLPolygon) then
RotateTextureToAngleP(xObject, TGLPolygon(xGLObject), xObject.FRotate, xObject.FMirror);
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.cbMirrorClick', E.Message);
end;
end;
procedure Tfrm3D.mDescEnter(Sender: TObject);
begin
ChangeDesc;
end;
procedure Tfrm3D.mDescExit(Sender: TObject);
begin
ChangeDesc;
end;
procedure Tfrm3D.edNameKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
ChangeName;
end;
procedure Tfrm3D.mDescKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
ChangeDesc;
end;
procedure Tfrm3D.edCoordXKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
ChangeCoordX;
end;
procedure Tfrm3D.edCoordXExit(Sender: TObject);
begin
ChangeCoordX;
end;
procedure Tfrm3D.edCoordYExit(Sender: TObject);
begin
ChangeCoordY;
end;
procedure Tfrm3D.edCoordYKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
ChangeCoordY;
end;
procedure Tfrm3D.edCoordZKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
ChangeCoordZ;
end;
procedure Tfrm3D.edCoordZExit(Sender: TObject);
begin
ChangeCoordZ;
end;
procedure Tfrm3D.edRotateExit(Sender: TObject);
begin
ChangeRotate;
end;
procedure Tfrm3D.edRotateKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
ChangeRotate;
end;
procedure Tfrm3D.ChangeCoordX;
var
i: integer;
xObject: T3DSide;
xGLObject: TGLBaseSceneObject;
Index: Integer;
p: TVector3f;
begin
try
if edCoordX.Text = '' then
exit;
Index := cbCoordNbr.ItemIndex;
for i := 0 to FPropObjects.Count - 1 do
begin
xObject := T3DSide(TTreeNode(FPropObjects[i]).Data);
xGLObject := TGLBaseSceneObject(xObject.FGLObject);
xObject.FGLPoints[Index].x := StrToFloat_My(edCoordX.Text);
xObject.FPoints[Index].x := StrToFloat_My(edCoordX.Text) / Factor;
if (xGLObject is TGLPolygon) then
begin
TGLPolygon(xGLObject).Nodes[Index].X := StrToFloat_My(edCoordX.Text);
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.ChangeCoordX', E.Message);
end;
end;
procedure Tfrm3D.ChangeCoordY;
var
i: integer;
xObject: T3DSide;
xGLObject: TGLBaseSceneObject;
Index: Integer;
p: TVector3f;
begin
try
if edCoordY.Text = '' then
exit;
Index := cbCoordNbr.ItemIndex;
for i := 0 to FPropObjects.Count - 1 do
begin
xObject := T3DSide(TTreeNode(FPropObjects[i]).Data);
xGLObject := TGLBaseSceneObject(xObject.FGLObject);
xObject.FGLPoints[Index].y := StrToFloat_My(edCoordY.Text);
xObject.FPoints[Index].z := StrToFloat_My(edCoordY.Text) / Factor;
if (xGLObject is TGLPolygon) then
begin
TGLPolygon(xGLObject).Nodes[Index].Y := StrToFloat_My(edCoordY.Text);
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.ChangeCoordY', E.Message);
end;
end;
procedure Tfrm3D.ChangeCoordZ;
var
i: integer;
xObject: T3DSide;
xGLObject: TGLBaseSceneObject;
Index: Integer;
p: TVector3f;
begin
try
if edCoordZ.Text = '' then
exit;
Index := cbCoordNbr.ItemIndex;
for i := 0 to FPropObjects.Count - 1 do
begin
xObject := T3DSide(TTreeNode(FPropObjects[i]).Data);
xGLObject := TGLBaseSceneObject(xObject.FGLObject);
xObject.FGLPoints[Index].z := StrToFloat_My(edCoordZ.Text);
xObject.FPoints[Index].y := StrToFloat_My(edCoordZ.Text) / Factor;
if (xGLObject is TGLPolygon) then
begin
TGLPolygon(xGLObject).Nodes[Index].Z := StrToFloat_My(edCoordZ.Text);
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.ChangeCoordZ', E.Message);
end;
end;
procedure Tfrm3D.ChangeDesc;
var
i, j: integer;
xObject: T3DSide;
xGLObject: TGLBaseSceneObject;
begin
try
if (mDesc.Text = '') or (mDesc.Lines.Count = 0) then
exit;
for i := 0 to FPropObjects.Count - 1 do
begin
xObject := T3DSide(TTreeNode(FPropObjects[i]).Data);
xGLObject := TGLBaseSceneObject(xObject.FGLObject);
for j := 0 to mDesc.Lines.Count - 1 do
xObject.FDescription.Add(mDesc.Lines[j]);
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.ChangeDesc', E.Message);
end;
end;
procedure Tfrm3D.ChangeName;
var
i: integer;
xObject: T3DSide;
xGLObject: TGLBaseSceneObject;
begin
try
if edName.Text = '' then
exit;
for i := 0 to FPropObjects.Count - 1 do
begin
xObject := T3DSide(TTreeNode(FPropObjects[i]).Data);
xGLObject := TGLBaseSceneObject(xObject.FGLObject);
TTreeNode(FPropObjects[i]).Text := edName.Text;
xObject.FName := edName.Text;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.ChangeName', E.Message);
end;
end;
procedure Tfrm3D.ChangeRotate;
var
i: integer;
xObject: T3DSide;
xGLObject: TGLBaseSceneObject;
Bmp: TBitmap;
begin
try
if edRotate.Text = '' then
exit;
for i := 0 to FPropObjects.Count - 1 do
begin
xObject := T3DSide(TTreeNode(FPropObjects[i]).Data);
xGLObject := TGLBaseSceneObject(xObject.FGLObject);
if StrToInt(edRotate.Text) >= 360 then
edRotate.Text := IntToStr(StrToInt(edRotate.Text) mod 360);
xObject.FRotate := StrToInt(edRotate.Text);
if (xGLObject is TGLMesh) then
begin
RotateTextureToAngleM(xObject, TGLMesh(xGLObject), xObject.FRotate, xObject.FMirror);
end;
if (xGLObject is TGLPolygon) then
begin
RotateTextureToAngleP(xObject, TGLPolygon(xGLObject), xObject.FRotate, xObject.FMirror);
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.ChangeRotate', E.Message);
end;
end;
procedure Tfrm3D.sbFirstFaceClick(Sender: TObject);
begin
GLCameraFirstPerson.CameraStyle := csPerspective;
GLCameraFirstPerson.FocalLength := 160;
GLSceneViewer.Camera := GLCameraFirstPerson;
lbViewType.Caption := cForm3D_Mes5;
end;
procedure Tfrm3D.GLCadencerProgress(Sender: TObject; const deltaTime, newTime: Double);
var
speed : Single;
Pt: TPoint;
begin
if not GLSceneViewer.Focused then
exit;
// handle keypresses
speed := deltaTime;
if IsKeyDown(VK_RIGHT) then
DummyCube.Translate(GLSceneViewer.Camera.Position.Z * speed, 0, -GLSceneViewer.Camera.Position.X * speed);
if IsKeyDown(VK_LEFT) then
DummyCube.Translate(-GLSceneViewer.Camera.Position.Z * speed, 0, GLSceneViewer.Camera.Position.X * speed);
if IsKeyDown(VK_UP) then
DummyCube.Translate(-GLSceneViewer.Camera.Position.X * speed, 0, -GLSceneViewer.Camera.Position.Z * speed);
if IsKeyDown(VK_DOWN) then
DummyCube.Translate(GLSceneViewer.Camera.Position.X * speed, 0, GLSceneViewer.Camera.Position.Z * speed);
//<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20> w
if (IsKeyDown('<27>') or IsKeyDown('w')) then
GLSceneViewer.Camera.Move(5 * deltaTime);
//<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20> s
if (IsKeyDown('<27>') or IsKeyDown('s')) then
GLSceneViewer.Camera.Move(-5 * deltaTime);
//<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20> a
if (IsKeyDown('<27>') or IsKeyDown('a')) then
GLSceneViewer.Camera.slide(-5 * deltaTime);
//<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20> d
if (IsKeyDown('<27>') or IsKeyDown('d')) then
GLSceneViewer.Camera.slide(5 * deltaTime);
if IsKeyDown(VK_ESCAPE) then
begin
if FToolMode <> tmSelect then
begin
FToolMode := tmSelect;
glSpliter.Visible := False;
glCubeSpliter.Visible := False;
glSide11.Visible := False;
glSide12.Visible := False;
glSide21.Visible := False;
glSide22.Visible := False;
DeleteNodesObjects;
RefreshSidesPoints;
GLSceneViewer.Cursor := crDefault;
end;
end;
end;
procedure Tfrm3D.GLSceneViewerClick(Sender: TObject);
begin
try
if not GLSceneViewer.Focused then
begin
SendMessage(GLSceneViewer.Handle, WM_ACTIVATE, MakewParam(WA_ACTIVE, 0), 0);
SendMessage(GLSceneViewer.Handle, WM_SETFOCUS, 0, 0);
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.GLSceneViewerClick', E.Message);
end;
end;
procedure Tfrm3D.RotateTextureToAngleM(aObject: T3DSide; aGLObject: TGLMesh; aAngle: Integer; aMirror: Boolean);
var
pN, pP: TVector3f;
mat: TAffineMatrix;
i: Integer;
vs, vs0, vs1, vs2: TVector3f;
tp: TTexPoint;
r1, r2: T3DPoint;
rAngle: Double;
VCoords: array [1..4] of TVector3f;
axis: T3DAxis;
begin
try
//
if (aObject.FFaceType = ftNetFloor) or (aObject.FFaceType = ftNetCeiling) then
begin
VCoords[1][0] := 0; VCoords[1][1] := 0; VCoords[1][2] := 0;
VCoords[2][0] := 100; VCoords[2][1] := 0; VCoords[2][2] := 0;
VCoords[3][0] := 100; VCoords[3][1] := 0; VCoords[3][2] := 100;
VCoords[4][0] := 0; VCoords[4][1] := 0; VCoords[4][2] := 100;
axis := aZ;
end
else if (aObject.FFaceType = ftNetPath) then
begin
VCoords[1] := aGLObject.Vertices[0].coord;
VCoords[2] := aGLObject.Vertices[1].coord;
VCoords[3] := aGLObject.Vertices[3].coord;
VCoords[4] := aGLObject.Vertices[2].coord;
axis := aY;
end;
rAngle := DegToRad(aAngle);
if (aAngle >=0) and (aAngle < 90) then
begin
if not aMirror then
begin
vs0 := VCoords[1];
vs1 := VCoords[2];
end
else
begin
vs0 := VCoords[2];
vs1 := VCoords[1];
end;
vs2 := VCoords[4];
r1.x := vs0[0]; r1.y := vs0[2]; r1.z := vs0[1];
r2.x := vs1[0]; r2.y := vs1[2]; r2.z := vs1[1];
r2 := Rotate3DPoint(r1, r2, DegToRad(aAngle- 0), axis);
vs1[0] := r2.x; vs1[2] := r2.y; vs1[1] := r2.z;
end;
if (aAngle >=90) and (aAngle < 180) then
begin
if not aMirror then
begin
vs0 := VCoords[2];
vs1 := VCoords[3];
end
else
begin
vs0 := VCoords[3];
vs1 := VCoords[2];
end;
vs2 := VCoords[1];
r1.x := vs0[0]; r1.y := vs0[2]; r1.z := vs0[1];
r2.x := vs1[0]; r2.y := vs1[2]; r2.z := vs1[1];
r2 := Rotate3DPoint(r1, r2, DegToRad(aAngle - 90), axis);
vs1[0] := r2.x; vs1[2] := r2.y; vs1[1] := r2.z;
end;
if (aAngle >=180) and (aAngle < 270) then
begin
if not aMirror then
begin
vs0 := VCoords[3];
vs1 := VCoords[4];
end
else
begin
vs0 := VCoords[4];
vs1 := VCoords[3];
end;
vs2 := VCoords[2];
r1.x := vs0[0]; r1.y := vs0[2]; r1.z := vs0[1];
r2.x := vs1[0]; r2.y := vs1[2]; r2.z := vs1[1];
r2 := Rotate3DPoint(r1, r2, DegToRad(aAngle - 180), axis);
vs1[0] := r2.x; vs1[2] := r2.y; vs1[1] := r2.z;
end;
if (aAngle >=270) and (aAngle < 360) then
begin
if not aMirror then
begin
vs0 := VCoords[4];
vs1 := VCoords[1];
end
else
begin
vs0 := VCoords[1];
vs1 := VCoords[4];
end;
vs2 := VCoords[3];
r1.x := vs0[0]; r1.y := vs0[2]; r1.z := vs0[1];
r2.x := vs1[0]; r2.y := vs1[2]; r2.z := vs1[1];
r2 := Rotate3DPoint(r1, r2, DegToRad(aAngle - 270), axis);
vs1[0] := r2.x; vs1[2] := r2.y; vs1[1] := r2.z;
end;
pN := CalcPlaneNormal (vs0, vs1, vs2);
SetVector (mat[2], pN);
SetVector (mat[0], VectorNormalize (VectorSubtract (vs1, vs0)));
SetVector (mat[1], VectorCrossProduct (mat[2], mat[0]));
InvertMatrix (mat);
for i := 0 to aGLObject.Vertices.Count - 1 do
begin
vs := aGLObject.Vertices[i].coord;
pP := VectorTransform (vs, mat);
tp := TexPointMake (pP[0], pP[1]);
aGLObject.Vertices.VertexTexCoord[i] := tp;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.RotateTextureToAngle', E.Message);
end;
end;
procedure Tfrm3D.RotateTextureToAngleP(aObject: T3DSide; aGLObject: TGLPolygon; aAngle: Integer; aMirror: Boolean);
var
pN, pP: TVector3f;
mat: TAffineMatrix;
i: Integer;
vs, vs0, vs1, vs2: TVector3f;
tp: TTexPoint;
r1, r2: T3DPoint;
rAngle: Double;
VCoords: array [1..4] of TVector3f;
axis: T3DAxis;
xScale: Double;
WH_koef: double; //- <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> / <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
HW_koef: double; //- <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> / <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
begin
try
if aGLObject.Nodes.Count >= 4 then
begin
VCoords[1][0] := aGLObject.Nodes[0].x;
VCoords[1][1] := aGLObject.Nodes[0].y;
VCoords[1][2] := aGLObject.Nodes[0].z;
VCoords[2][0] := aGLObject.Nodes[1].x;
VCoords[2][1] := aGLObject.Nodes[1].y;
VCoords[2][2] := aGLObject.Nodes[1].z;
VCoords[3][0] := aGLObject.Nodes[2].x;
VCoords[3][1] := aGLObject.Nodes[2].y;
VCoords[3][2] := aGLObject.Nodes[2].z;
VCoords[4][0] := aGLObject.Nodes[3].x;
VCoords[4][1] := aGLObject.Nodes[3].y;
VCoords[4][2] := aGLObject.Nodes[3].z;
end
else
begin
VCoords[1][0] := 0; VCoords[1][1] := 0; VCoords[1][2] := 0;
VCoords[2][0] := 100; VCoords[2][1] := 0; VCoords[2][2] := 0;
VCoords[3][0] := 100; VCoords[3][1] := 0; VCoords[3][2] := 100;
VCoords[4][0] := 0; VCoords[4][1] := 0; VCoords[4][2] := 100;
end;
rAngle := DegToRad(aAngle);
if (aAngle >=0) and (aAngle < 90) then
begin
if not aMirror then
begin
vs0 := VCoords[1];
vs1 := VCoords[2];
end
else
begin
vs0 := VCoords[2];
vs1 := VCoords[1];
end;
vs2 := VCoords[4];
vs1 := Rotate3DVector(vs0, vs1, vs2, aAngle - 0);
end;
if (aAngle >=90) and (aAngle < 180) then
begin
if not aMirror then
begin
vs0 := VCoords[2];
vs1 := VCoords[3];
end
else
begin
vs0 := VCoords[3];
vs1 := VCoords[2];
end;
vs2 := VCoords[1];
vs1 := Rotate3DVector(vs0, vs1, vs2, aAngle - 90);
end;
if (aAngle >=180) and (aAngle < 270) then
begin
if not aMirror then
begin
vs0 := VCoords[3];
vs1 := VCoords[4];
end
else
begin
vs0 := VCoords[4];
vs1 := VCoords[3];
end;
vs2 := VCoords[2];
vs1 := Rotate3DVector(vs0, vs1, vs2, aAngle - 180);
end;
if (aAngle >=270) and (aAngle < 360) then
begin
if not aMirror then
begin
vs0 := VCoords[4];
vs1 := VCoords[1];
end
else
begin
vs0 := VCoords[1];
vs1 := VCoords[4];
end;
vs2 := VCoords[3];
vs1 := Rotate3DVector(vs0, vs1, vs2, aAngle - 270);
end;
pN := CalcPlaneNormal (vs0, vs1, vs2);
SetVector (mat[2], pN);
SetVector (mat[0], VectorNormalize (VectorSubtract (vs1, vs0)));
SetVector (mat[1], VectorCrossProduct (mat[2], mat[0]));
with aGLObject.Material.Texture do
begin
xScale := 1;
WH_koef := 1;//Image.Width / Image.Height;
HW_koef := 1;//Image.Height / Image.Width;
MappingMode := tmmObjectLinear;
if Image.Width > Image.Height then
begin
MappingSCoordinates.AsVector := VectorMake(mat[0][0] * (1 / xScale) * HW_koef,
mat[0][1] * (1 / xScale) * HW_koef,
mat[0][2] * (1 / xScale) * HW_koef,
0);
MappingTCoordinates.AsVector := VectorMake(mat[1][0] * (1 / xScale) * 1,
mat[1][1] * (1 / xScale) * 1,
mat[1][2] * (1 / xScale) * 1,
0);
end
else
begin
MappingSCoordinates.AsVector := VectorMake(mat[0][0] * (1 / xScale),
mat[0][1] * (1 / xScale),
mat[0][2] * (1 / xScale),
0);
MappingTCoordinates.AsVector := VectorMake(mat[1][0] * (1 / xScale) * WH_koef,
mat[1][1] * (1 / xScale) * WH_koef,
mat[1][2] * (1 / xScale) * WH_koef,
0);
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.RotateTextureToAngleP', E.Message);
end;
end;
procedure Tfrm3D.SetPolygonTexture(aObject: TGLPolygon);
var
pN: TVector3f;
mat: TAffineMatrix;
vs0, vs1, vs2: TVector3f;
VCoords: array [1..4] of TVector3f;
begin
try
if aObject.Nodes.Count <= 4 then
begin
VCoords[1][0] := aObject.Nodes[0].x;
VCoords[1][1] := aObject.Nodes[0].y;
VCoords[1][2] := aObject.Nodes[0].z;
VCoords[2][0] := aObject.Nodes[1].x;
VCoords[2][1] := aObject.Nodes[1].y;
VCoords[2][2] := aObject.Nodes[1].z;
VCoords[3][0] := aObject.Nodes[2].x;
VCoords[3][1] := aObject.Nodes[2].y;
VCoords[3][2] := aObject.Nodes[2].z;
VCoords[4][0] := aObject.Nodes[3].x;
VCoords[4][1] := aObject.Nodes[3].y;
VCoords[4][2] := aObject.Nodes[3].z;
end
else
begin
VCoords[1][0] := 0; VCoords[1][1] := 0; VCoords[1][2] := 0;
VCoords[2][0] := 100; VCoords[2][1] := 0; VCoords[2][2] := 0;
VCoords[3][0] := 100; VCoords[3][1] := 0; VCoords[3][2] := 100;
VCoords[4][0] := 0; VCoords[4][1] := 0; VCoords[4][2] := 100;
end;
vs0 := VCoords[1];
vs1 := VCoords[2];
vs2 := VCoords[3];
pN := CalcPlaneNormal (vs0, vs1, vs2);
SetVector (mat[2], pN);
SetVector (mat[0], VectorNormalize (VectorSubtract (vs1, vs0)));
SetVector (mat[1], VectorCrossProduct (mat[2], mat[0]));
with aObject.Material.Texture do
begin
MappingMode := tmmObjectLinear;
MappingSCoordinates.AsVector := VectorMake(mat[0][0], mat[0][1], mat[0][2], 0);
MappingTCoordinates.AsVector := VectorMake(mat[1][0], mat[1][1], mat[1][2], 0);
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.SetPolygonTexture', E.Message);
end;
end;
Function Tfrm3D.Rotate3DVector(vs0, vs1, vs2: TVector3f; Ang: Double): TVector3f;
var
osp: T3DPoint;
nz, nx, ny: Double;
r0, r1, r2: TDoublePoint;
k: double;
begin
r0.x := vs0[0]; r0.y := vs0[2]; r0.z := vs0[1];
r1.x := vs1[0]; r1.y := vs1[2]; r1.z := vs1[1];
r2.x := vs2[0]; r2.y := vs2[2]; r2.z := vs2[1];
k := (Ang / 90);
nx := r1.x - (r1.x - r2.x) * k;
ny := r1.y - (r1.y - r2.y) * k;
nz := r1.z - (r1.z - r2.z) * k;
Result[0] := nx;
Result[1] := nz;
Result[2] := ny;
end;
function Tfrm3D.GetImageFileByHash(aHash: string): string;
var
i: integer;
tmpdir, tmpfname, str: string;
begin
try
Result := '';
if aHash <> '' then
begin
tmpdir := ExtractDirByCategoryType(dctPictures);
for i := 0 to F3DModel.FHashs.Count - 1 do
begin
str := F3DModel.FHashs.Strings[i];
if str = aHash then
begin
tmpfname := tmpdir + '\' + str + '.bmp';
if FileExists(tmpfname) then
begin
Result := tmpfname;
exit;
end;
end;
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.GetImageFileByHash', E.Message);
end;
end;
procedure Tfrm3D.cbHashsPropertiesCloseUp(Sender: TObject);
var
i, Index: Integer;
xObject: T3DSide;
xGLObject: TGLBaseSceneObject;
tmpdir, tmpfname, ExtStr, BmpFName: string;
HashStr: string;
begin
try
Index := cbHashs.ItemIndex;
HashStr := cbHashs.Properties.Items[Index];
tmpdir := ExtractDirByCategoryType(dctPictures);
tmpfname := GetImageFileByHash(HashStr);
ExtStr := ExtractFileExt(tmpfname);
if tmpfname <> '' then
begin
imgTexture.Picture.LoadFromFile(tmpfname);
for i := 0 to FPropObjects.Count - 1 do
begin
xObject := T3DSide(TTreeNode(FPropObjects[i]).Data);
xGLObject := TGLBaseSceneObject(xObject.FGLObject);
xObject.FTextureHash := HashStr;
xObject.FTexture_ext := ExtStr;
if (xGLObject is TGLPolygon) then
begin
TGLPolygon(xGLObject).Material.Texture.Disabled := False;
TGLPolygon(xGLObject).Material.Texture.Image.LoadFromFile(tmpfname);
RotateTextureToAngleP(xObject, TGLPolygon(xGLObject), xObject.FRotate, xObject.FMirror);
end;
end;
end
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.cbHashsPropertiesCloseUp', E.Message);
end;
end;
procedure Tfrm3D.nAdd3DObjectClick(Sender: TObject);
var
i: integer;
FName: string;
xNode, xSubNode: TTreeNode;
xRoom: T3DRoom;
xObject: T3DSObject;
glObjClass: TGLSceneObjectClass;
glObject: TGLFreeForm;
ObjectMin, ObjectMax, RoomMin, RoomMax, ObjSize, RoomSize, SetPos, Scale: T3DPoint;
SetScale: Double;
begin
try
if ModelTree.SelectionCount = 1 then
begin
xNode := ModelTree.Selections[0];
Open3DObject.InitialDir := ExeDir + '\3DModels';
NoMoveEvent := True;
if Open3DObject.Execute then
begin
FName := Open3DObject.FileName;
xRoom := T3DRoom(xNode.Data);
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> GLScene
glObjClass := TGLFreeForm;
glObject := TGLFreeForm(DummyCube.AddNewChild(glObjClass));
glObject.Material.Texture.Disabled := False;
glObject.LoadFromFile(FName);
Get3DSObjectBounds(ObjectMin, ObjectMax, glObject);
GetRoomBounds(RoomMin, RoomMax, xRoom.FFloor.FGLPoints, xRoom.FCeiling.FGLPoints);
ObjSize.x := abs(ObjectMax.x - ObjectMin.x);
ObjSize.y := abs(ObjectMax.y - ObjectMin.y);
ObjSize.z := abs(ObjectMax.z - ObjectMin.z);
RoomSize.x := abs(RoomMax.x - RoomMin.x);
RoomSize.y := abs(RoomMax.y - RoomMin.y);
RoomSize.z := abs(RoomMax.z - RoomMin.z);
SetPos.x := abs(RoomMax.x + RoomMin.x) / 2;
SetPos.y := abs(RoomMax.y + RoomMin.y) / 2;
SetPos.z := abs(RoomMax.z + RoomMin.z) / 2;
Scale.X := RoomSize.x / ObjSize.x;
Scale.Y := RoomSize.y / ObjSize.y;
Scale.Z := RoomSize.z / ObjSize.z;
SetScale := MinFloat(Scale.X, Scale.Y, Scale.Z);
if SetScale > 1 then
SetScale := 1;
glObject.Position.x := SetPos.x;
glObject.Position.y := SetPos.y;
glObject.Position.z := SetPos.z;
glObject.Scale.X := SetScale;
glObject.Scale.Y := SetScale;
glObject.Scale.Z := SetScale;
with glObject.Material do
begin
FrontProperties.Ambient.Color := ObjColor;
FrontProperties.Diffuse.Color := ObjColor;
FrontProperties.Emission.Color := ObjColor;
BackProperties.Ambient.Color := ObjColor;
BackProperties.Diffuse.Color := ObjColor;
BackProperties.Emission.Color := ObjColor;
//MaterialOptions := [moNoLighting];
end;
glObject.BuildOctree;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
xObject := T3DSObject.Create(xRoom);
xObject.FPath := FName;
xObject.FName := ExtractFileName(FName);
xObject.FPosition.x := glObject.Position.X;
xObject.FPosition.y := glObject.Position.Y;
xObject.FPosition.z := glObject.Position.Z;
xObject.FScale.x := glObject.Scale.X;
xObject.FScale.y := glObject.Scale.Y;
xObject.FScale.z := glObject.Scale.Z;
xObject.FGLObject := glObject;
xRoom.F3DSObjects.Add(xObject);
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
xSubNode := ModelTree.Items.AddChild(xNode, xObject.FName);
xSubNode.Data := xObject;
xSubNode.ImageIndex := 42;
glObject.TagObject := xSubNode;
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.nAdd3DObjectClick', E.Message);
end;
end;
procedure Tfrm3D.ModelTreeMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
i: Integer;
xNode: TTreeNode;
begin
if (Button = mbRight) then
begin
if ModelTree.SelectionCount = 1 then
begin
xNode := ModelTree.Selections[0];
if (TObject(xNode.Data) is T3DRoom) then
begin
pmModelTree.Items[0].Visible := True;
pmModelTree.Items[1].Visible := False;
pmModelTree.Popup(X, Y);
end;
if (FToolMode = tmSelect) and (TObject(xNode.Data) is T3DSide) and (T3DSide(xNode.Data).FSubSides.Count > 0) then
begin
pmModelTree.Items[0].Visible := False;
pmModelTree.Items[1].Visible := True;
pmModelTree.Popup(X, Y);
end;
end;
end;
end;
procedure Tfrm3D.ChangeAngleX;
var
i: integer;
xObject: T3DSObject;
xGLObject: TGLBaseSceneObject;
begin
try
if edAngleX.Text = '' then
exit;
for i := 0 to FPropObjects.Count - 1 do
begin
xObject := T3DSObject(TTreeNode(FPropObjects[i]).Data);
xGLObject := TGLBaseSceneObject(xObject.FGLObject);
xObject.FRotate.x := StrToFloat_My(edAngleX.Text);
if (xGLObject is TGLFreeForm) then
begin
TGLFreeForm(xGLObject).PitchAngle := StrToFloat_My(edAngleX.Text);
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.ChangeAngleX', E.Message);
end;
end;
procedure Tfrm3D.ChangeAngleY;
var
i: integer;
xObject: T3DSObject;
xGLObject: TGLBaseSceneObject;
begin
try
if edAngleY.Text = '' then
exit;
for i := 0 to FPropObjects.Count - 1 do
begin
xObject := T3DSObject(TTreeNode(FPropObjects[i]).Data);
xGLObject := TGLBaseSceneObject(xObject.FGLObject);
xObject.FRotate.y := StrToFloat_My(edAngleY.Text);
if (xGLObject is TGLFreeForm) then
begin
TGLFreeForm(xGLObject).TurnAngle := StrToFloat_My(edAngleY.Text);
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.ChangeAngleY', E.Message);
end;
end;
procedure Tfrm3D.ChangeAngleZ;
var
i: integer;
xObject: T3DSObject;
xGLObject: TGLBaseSceneObject;
begin
try
if edAngleZ.Text = '' then
exit;
for i := 0 to FPropObjects.Count - 1 do
begin
xObject := T3DSObject(TTreeNode(FPropObjects[i]).Data);
xGLObject := TGLBaseSceneObject(xObject.FGLObject);
xObject.FRotate.Z := StrToFloat_My(edAngleZ.Text);
if (xGLObject is TGLFreeForm) then
begin
TGLFreeForm(xGLObject).RollAngle := StrToFloat_My(edAngleZ.Text);
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.ChangeAngleZ', E.Message);
end;
end;
procedure Tfrm3D.ChangePosX;
var
i: integer;
xObject: T3DSObject;
xGLObject: TGLBaseSceneObject;
begin
try
if edPosX.Text = '' then
exit;
for i := 0 to FPropObjects.Count - 1 do
begin
xObject := T3DSObject(TTreeNode(FPropObjects[i]).Data);
xGLObject := TGLBaseSceneObject(xObject.FGLObject);
xObject.FPosition.x := StrToFloat_My(edPosX.Text);
if (xGLObject is TGLFreeForm) then
begin
TGLFreeForm(xGLObject).Position.X := StrToFloat_My(edPosX.Text);
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.ChangePosX', E.Message);
end;
end;
procedure Tfrm3D.ChangePosY;
var
i: integer;
xObject: T3DSObject;
xGLObject: TGLBaseSceneObject;
begin
try
if edPosY.Text = '' then
exit;
for i := 0 to FPropObjects.Count - 1 do
begin
xObject := T3DSObject(TTreeNode(FPropObjects[i]).Data);
xGLObject := TGLBaseSceneObject(xObject.FGLObject);
xObject.FPosition.y := StrToFloat_My(edPosY.Text);
if (xGLObject is TGLFreeForm) then
begin
TGLFreeForm(xGLObject).Position.Y := StrToFloat_My(edPosY.Text);
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.ChangePosY', E.Message);
end;
end;
procedure Tfrm3D.ChangePosZ;
var
i: integer;
xObject: T3DSObject;
xGLObject: TGLBaseSceneObject;
begin
try
if edPosZ.Text = '' then
exit;
for i := 0 to FPropObjects.Count - 1 do
begin
xObject := T3DSObject(TTreeNode(FPropObjects[i]).Data);
xGLObject := TGLBaseSceneObject(xObject.FGLObject);
xObject.FPosition.z := StrToFloat_My(edPosZ.Text);
if (xGLObject is TGLFreeForm) then
begin
TGLFreeForm(xGLObject).Position.Z := StrToFloat_My(edPosZ.Text);
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.ChangePosZ', E.Message);
end;
end;
procedure Tfrm3D.ChangeScaleX;
var
i: integer;
xObject: T3DSObject;
xGLObject: TGLBaseSceneObject;
begin
try
if edScaleX.Text = '' then
exit;
for i := 0 to FPropObjects.Count - 1 do
begin
xObject := T3DSObject(TTreeNode(FPropObjects[i]).Data);
xGLObject := TGLBaseSceneObject(xObject.FGLObject);
xObject.FScale.x := StrToFloat_My(edScaleX.Text);
if (xGLObject is TGLFreeForm) then
begin
TGLFreeForm(xGLObject).Scale.X := StrToFloat_My(edScaleX.Text);
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.ChangeScaleX', E.Message);
end;
end;
procedure Tfrm3D.ChangeScaleY;
var
i: integer;
xObject: T3DSObject;
xGLObject: TGLBaseSceneObject;
begin
try
if edScaleY.Text = '' then
exit;
for i := 0 to FPropObjects.Count - 1 do
begin
xObject := T3DSObject(TTreeNode(FPropObjects[i]).Data);
xGLObject := TGLBaseSceneObject(xObject.FGLObject);
xObject.FScale.y := StrToFloat_My(edScaleY.Text);
if (xGLObject is TGLFreeForm) then
begin
TGLFreeForm(xGLObject).Scale.Y := StrToFloat_My(edScaleY.Text);
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.ChangeScaleY', E.Message);
end;
end;
procedure Tfrm3D.ChangeScaleZ;
var
i: integer;
xObject: T3DSObject;
xGLObject: TGLBaseSceneObject;
begin
try
if edScaleZ.Text = '' then
exit;
for i := 0 to FPropObjects.Count - 1 do
begin
xObject := T3DSObject(TTreeNode(FPropObjects[i]).Data);
xGLObject := TGLBaseSceneObject(xObject.FGLObject);
xObject.FScale.z := StrToFloat_My(edScaleZ.Text);
if (xGLObject is TGLFreeForm) then
begin
TGLFreeForm(xGLObject).Scale.Z := StrToFloat_My(edScaleZ.Text);
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.ChangeScaleZ', E.Message);
end;
end;
procedure Tfrm3D.edPosXExit(Sender: TObject);
begin
ChangePosX;
end;
procedure Tfrm3D.edPosYExit(Sender: TObject);
begin
ChangePosY;
end;
procedure Tfrm3D.edPosZExit(Sender: TObject);
begin
ChangePosZ;
end;
procedure Tfrm3D.edAngleXExit(Sender: TObject);
begin
ChangeAngleX;
end;
procedure Tfrm3D.edAngleYExit(Sender: TObject);
begin
ChangeAngleY;
end;
procedure Tfrm3D.edAngleZExit(Sender: TObject);
begin
ChangeAngleZ;
end;
procedure Tfrm3D.edScaleXExit(Sender: TObject);
begin
ChangeScaleX;
end;
procedure Tfrm3D.edScaleYExit(Sender: TObject);
begin
ChangeScaleY;
end;
procedure Tfrm3D.edScaleZExit(Sender: TObject);
begin
ChangeScaleZ;
end;
procedure Tfrm3D.edPosXKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
ChangePosX;
end;
procedure Tfrm3D.edPosYKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
ChangePosY;
end;
procedure Tfrm3D.edPosZKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
ChangePosZ;
end;
procedure Tfrm3D.edAngleXKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
ChangeAngleX;
end;
procedure Tfrm3D.edAngleYKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
ChangeAngleY;
end;
procedure Tfrm3D.edAngleZKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
ChangeAngleZ;
end;
procedure Tfrm3D.edScaleXKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
ChangeScaleX;
end;
procedure Tfrm3D.edScaleYKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
ChangeScaleY;
end;
procedure Tfrm3D.edScaleZKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
ChangeScaleZ;
end;
procedure Tfrm3D.SetAllPanels(aStatus: Boolean);
begin
{$IF Defined(ES_GRAPH_SC)}
panName.Visible := aStatus;
panDesc.Visible := aStatus;
panCoords.Visible := aStatus;
panRotate.Visible := aStatus;
panMirror.Visible := aStatus;
panTexture.Visible := aStatus;
panPos3ds.Visible := aStatus;
panRotate3ds.Visible := aStatus;
panScale3ds.Visible := aStatus;
{$IFEND}
end;
procedure Tfrm3D.Get3DSObjectBounds(var Min, Max: T3DPoint; aObject: TGLFreeForm);
var
i: Integer;
Bounds: THmgBoundingBox;
Coord: TVector4f;
begin
try
Bounds := aObject.BoundingBox;
for i := 0 to 7 do
begin
Coord := Bounds[i];
if i = 0 then
begin
Min.x := Coord[0];
Min.y := Coord[1];
Min.z := Coord[2];
Max.x := Coord[0];
Max.y := Coord[1];
Max.z := Coord[2];
end
else
begin
if Coord[0] < Min.x then
Min.x := Coord[0];
if Coord[0] > Max.x then
Max.x := Coord[0];
if Coord[1] < Min.y then
Min.y := Coord[1];
if Coord[1] > Max.y then
Max.y := Coord[1];
if Coord[2] < Min.z then
Min.z := Coord[2];
if Coord[2] > Max.z then
Max.z := Coord[2];
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.Get3DSObjectBounds', E.Message);
end;
end;
procedure Tfrm3D.GetRoomBounds(var Min, Max: T3DPoint; aFloor, aCeiling: T3DPointArray);
var
i: Integer;
Bounds: THmgBoundingBox;
Coord1, Coord2: T3DPoint;
begin
try
for i := 0 to Length(aFloor) - 1 do
begin
Coord1.x := aFloor[i].X;
Coord1.y := aFloor[i].Y;
Coord1.z := aFloor[i].Z;
Coord2.x := aCeiling[i].X;
Coord2.y := aCeiling[i].Y;
Coord2.z := aCeiling[i].Z;
if i = 0 then
begin
Min.x := Coord1.x;
Min.y := Coord1.y;
Min.z := Coord1.z;
Max.x := Coord1.x;
Max.y := Coord2.y;
Max.z := Coord1.z;
end
else
begin
if Coord1.x < Min.x then
Min.x := Coord1.x;
if Coord1.x > Max.x then
Max.x := Coord1.x;
if Coord1.y < Min.y then
Min.y := Coord1.y;
if Coord2.y > Max.y then
Max.y := Coord2.y;
if Coord1.z < Min.z then
Min.z := Coord1.z;
if Coord1.z > Max.z then
Max.z := Coord1.z;
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.GetRoomBounds', E.Message);
end;
end;
procedure Tfrm3D.CreateNodesObjects(aObj: TGLPolygon);
var
i: integer;
xObj: TGLSpaceText;
pos, Camera: T3DPoint;
SetPos: T3DPoint;
delta, koef, len: double;
begin
try
delta := 0.5;
Camera.x := GLSceneViewer.Camera.Position.x;
Camera.y := GLSceneViewer.Camera.Position.y;
Camera.z := GLSceneViewer.Camera.Position.z;
if FNodesObjectsList.Count > 0 then
DeleteNodesObjects;
for i := 0 to aObj.Nodes.Count - 1 do
begin
xObj := TGLSpaceText(DummyCube.AddNewChild(TGLSpaceText));
pos.x := aObj.Nodes[i].x;
pos.y := aObj.Nodes[i].y;
pos.z := aObj.Nodes[i].z;
len := GetLineLenght(pos, Camera);
koef := delta / len;
SetPos.x := pos.x + (camera.x - pos.x) * koef;
SetPos.y := pos.y + (camera.y - pos.y) * koef;
SetPos.z := pos.z + (camera.z - pos.z) * koef;
xObj.Position.x := SetPos.x;
xObj.Position.y := SetPos.y;
xObj.Position.z := SetPos.z;
xObj.Text := IntToStr(i + 1);
xObj.Extrusion := 0.1;
xObj.Scale.X := 0.5;
xObj.Scale.Y := 0.5;
xObj.Scale.Z := 0.5;
xObj.Adjust.Horz := haCenter;
xObj.Adjust.Vert := vaCenter;
xObj.Font.Color := clBlue;
xObj.Material.FrontProperties.Ambient.Color := clrBlue;
xObj.Material.FrontProperties.Diffuse.Color := clrBlue;
xObj.Material.FrontProperties.Emission.Color := clrBlue;
xObj.Material.BackProperties.Ambient.Color := clrBlue;
xObj.Material.BackProperties.Diffuse.Color := clrBlue;
xObj.Material.BackProperties.Emission.Color := clrBlue;
FNodesObjectsList.Add(xObj);
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.CreateNodesObjects', E.Message);
end;
end;
procedure Tfrm3D.DeleteNodesObjects;
var
i: integer;
xObj: TGLSpaceText;
begin
try
for i := 0 to FNodesObjectsList.Count - 1 do
begin
xObj := TGLSpaceText(FNodesObjectsList[i]);
DummyCube.Remove(xObj, True);
end;
FNodesObjectsList.Clear;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.DeleteNodesObjects', E.Message);
end;
end;
procedure Tfrm3D.DoResize;
var
Len1, Len2, Len3, Len13, HLen, DLen1, DLen2: Double;
LenToCursor1, LenToCursor2, LenToResizer1, LenToResizer2: Double;
Len11, Len12, Len21, Len22, LimitLen1, LimitLen2: Double;
p1, p2, hp: T3DPoint;
delta, p, S: double;
begin
try
// Calc H Length
Len1 := SQRT(SQR(glCursorObject.Position.x - RStartPos1.x) + SQR(glCursorObject.Position.y - RStartPos1.y) + SQR(glCursorObject.Position.z - RStartPos1.z));
Len2 := SQRT(SQR(glCursorObject.Position.x - RStartPos2.x) + SQR(glCursorObject.Position.y - RStartPos2.y) + SQR(glCursorObject.Position.z - RStartPos2.z));
Len3 := SQRT(SQR(RStartPos1.x - RStartPos2.x) + SQR(RStartPos1.y - RStartPos2.y) + SQR(RStartPos1.z - RStartPos2.z));
p := (Len1 + Len2 + Len3) / 2;
S := SQRT(p * (p - Len1) * (p - Len2) * (p - Len3));
HLen := 2 * S / Len3;
// Calc H point
Len13 := SQRT(SQR(Len1) - SQR(HLen));
delta := Len13 / Len3;
hp.x := RStartPos1.x + (RStartPos2.x - RStartPos1.x) * delta;
hp.y := RStartPos1.y + (RStartPos2.y - RStartPos1.y) * delta;
hp.z := RStartPos1.z + (RStartPos2.z - RStartPos1.z) * delta;
if EQD(HLen, 0) then
exit;
// Calc Sides Lengths
Len11 := SQRT(SQR(FResizeData.Nodep11.x - RStartPos1.x) + SQR(FResizeData.Nodep11.y - RStartPos1.y) + SQR(FResizeData.Nodep11.z - RStartPos1.z));
Len12 := SQRT(SQR(FResizeData.Nodep12.x - RStartPos2.x) + SQR(FResizeData.Nodep12.y - RStartPos2.y) + SQR(FResizeData.Nodep12.z - RStartPos2.z));
Len21 := SQRT(SQR(FResizeData.Nodep21.x - RStartPos1.x) + SQR(FResizeData.Nodep21.y - RStartPos1.y) + SQR(FResizeData.Nodep21.z - RStartPos1.z));
Len22 := SQRT(SQR(FResizeData.Nodep22.x - RStartPos2.x) + SQR(FResizeData.Nodep22.y - RStartPos2.y) + SQR(FResizeData.Nodep22.z - RStartPos2.z));
LimitLen1 := Min(Len11, Len12);
LimitLen2 := Min(Len21, Len22);
// Calc Lenght Vector
LenToCursor1 := SQRT(SQR(FResizeData.Nodep11.x - glCursorObject.Position.x) +
SQR(FResizeData.Nodep11.y - glCursorObject.Position.y) +
SQR(FResizeData.Nodep11.z - glCursorObject.Position.z));
LenToCursor2 := SQRT(SQR(FResizeData.Nodep21.x - glCursorObject.Position.x) +
SQR(FResizeData.Nodep21.y - glCursorObject.Position.y) +
SQR(FResizeData.Nodep21.z - glCursorObject.Position.z));
LenToResizer1 := SQRT(SQR(FResizeData.Nodep11.x - hp.x) +
SQR(FResizeData.Nodep11.y - hp.y) +
SQR(FResizeData.Nodep11.z - hp.z));
LenToResizer2 := SQRT(SQR(FResizeData.Nodep21.x - hp.x) +
SQR(FResizeData.Nodep21.y - hp.y) +
SQR(FResizeData.Nodep21.z - hp.z));
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>
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
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>
begin
if HLen > LimitLen2 then
HLen := LimitLen2;
if Len21 = 0 then
DLen1 := 0
else
DLen1 := HLen / Len21;
if Len22 = 0 then
DLen2 := 0
else
DLen2 := HLen / Len22;
rpos1.x := RStartPos1.x - (RStartPos1.x - FResizeData.Nodep21.x) * DLen1;
rpos1.y := RStartPos1.y - (RStartPos1.y - FResizeData.Nodep21.y) * DLen1;
rpos1.z := RStartPos1.z - (RStartPos1.z - FResizeData.Nodep21.z) * DLen1;
rpos2.x := RStartPos2.x - (RStartPos2.x - FResizeData.Nodep22.x) * DLen2;
rpos2.y := RStartPos2.y - (RStartPos2.y - FResizeData.Nodep22.y) * DLen2;
rpos2.z := RStartPos2.z - (RStartPos2.z - FResizeData.Nodep22.z) * DLen2;
end
else if (LimitLen1 = 0) or (LimitLen2 = 0) then
begin
rpos1.x := RStartPos1.x;
rpos1.y := RStartPos1.y;
rpos1.z := RStartPos1.z;
rpos2.x := RStartPos2.x;
rpos2.y := RStartPos2.y;
rpos2.z := RStartPos2.z;
end;
// Set Spliter Line and Cube
glSpliter.Nodes[0].X := rpos1.x;
glSpliter.Nodes[0].Y := rpos1.y;
glSpliter.Nodes[0].Z := rpos1.z;
glSpliter.Nodes[1].X := rpos2.x;
glSpliter.Nodes[1].Y := rpos2.y;
glSpliter.Nodes[1].Z := rpos2.z;
glCubeSpliter.Position.x := (rpos1.x + rpos2.x) / 2;
glCubeSpliter.Position.y := (rpos1.y + rpos2.y) / 2;
glCubeSpliter.Position.z := (rpos1.z + rpos2.z) / 2;
SetSideSizes;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.DoResize', E.Message);
end;
end;
procedure Tfrm3D.SelectNodesEvent(Sender: TObject);
var
i, j, ItemIndex, Index: Integer;
xObj: TGLPolygon;
xCutData: TCutData;
p1, p2: T3DPoint;
GLPoints1, GLPoints2: T3DPointArray;
Len: Integer;
xGLSide: TGLPolygon;
Nodep11, Nodep12, Nodep21, Nodep22, Noder11, Noder12, Noder21, Noder22: Integer;
LenX, LenY, LenZ, LenXY, LenXZ, LenXYZ :double;
xSide: T3DSide;
begin
try
Index := TMenuItem(Sender).Tag;
xObj := TGLPolygon(DummyCube.Children[Index]);
ItemIndex := TMenuItem(Sender).MenuIndex;
xCutData := TCutData(FCutDataList[ItemIndex]);
// Create Spliter
p1.x := (xObj.Nodes[xCutData.Index11].x + xObj.Nodes[xCutData.Index12].x) / 2;
p1.y := (xObj.Nodes[xCutData.Index11].y + xObj.Nodes[xCutData.Index12].y) / 2;
p1.z := (xObj.Nodes[xCutData.Index11].z + xObj.Nodes[xCutData.Index12].z) / 2;
p2.x := (xObj.Nodes[xCutData.Index21].x + xObj.Nodes[xCutData.Index22].x) / 2;
p2.y := (xObj.Nodes[xCutData.Index21].y + xObj.Nodes[xCutData.Index22].y) / 2;
p2.z := (xObj.Nodes[xCutData.Index21].z + xObj.Nodes[xCutData.Index22].z) / 2;
glSpliter.Nodes[0].x := p1.x;
glSpliter.Nodes[0].y := p1.y;
glSpliter.Nodes[0].z := p1.z;
glSpliter.Nodes[1].x := p2.x;
glSpliter.Nodes[1].y := p2.y;
glSpliter.Nodes[1].z := p2.z;
glSpliter.Visible := True;
// Create CubeSpliter
glCubeSpliter.Position.x := (p1.x + p2.x) / 2;
glCubeSpliter.Position.y := (p1.y + p2.y) / 2;
glCubeSpliter.Position.z := (p1.z + p2.z) / 2;
glCubeSpliter.Visible := True;
// Create Side1
SetLength(GLPoints1, 0);
for i := 0 to xCutData.Index11 do
begin
Len := Length(GLPoints1);
SetLength(GLPoints1, Len + 1);
GLPoints1[Len].x := xObj.Nodes[i].x;
GLPoints1[Len].y := xObj.Nodes[i].y;
GLPoints1[Len].z := xObj.Nodes[i].z;
end;
Nodep11 := Len;
Len := Length(GLPoints1);
SetLength(GLPoints1, Len + 2);
GLPoints1[Len] := p1;
Noder11 := Len;
GLPoints1[Len + 1] := p2;
Noder12 := Len + 1;
if Len + 2 <= xCutData.Index22 then
Nodep12 := Len + 2
else
Nodep12 := 0;
if xCutData.Index22 <> 0 then
begin
for i := xCutData.Index22 to xObj.Nodes.Count - 1 do
begin
Len := Length(GLPoints1);
SetLength(GLPoints1, Len + 1);
GLPoints1[Len].x := xObj.Nodes[i].x;
GLPoints1[Len].y := xObj.Nodes[i].y;
GLPoints1[Len].z := xObj.Nodes[i].z;
end;
end;
// Create Side2
xGLSide := TGLPolygon(DummyCube.AddNewChild(TGLPolygon));
SetLength(GLPoints2, 0);
Len := Length(GLPoints2);
SetLength(GLPoints2, Len + 1);
GLPoints2[Len] := p1;
Noder21 := Len;
Nodep21 := Len + 1;
for i := xCutData.Index12 to xCutData.Index21 do
begin
Len := Length(GLPoints2);
SetLength(GLPoints2, Len + 1);
GLPoints2[Len].x := xObj.Nodes[i].x;
GLPoints2[Len].y := xObj.Nodes[i].y;
GLPoints2[Len].z := xObj.Nodes[i].z;
end;
Nodep22 := Len;
Len := Length(GLPoints2);
SetLength(GLPoints2, Len + 1);
GLPoints2[Len] := p2;
Noder22 := Len;
// ***************************************
xObj.Nodes.Clear;
for i := 0 to Length(GLPoints1) - 1 do
begin
// if i > 0 then
// begin
// if not (EQD(GLPoints1[i].x, GLPoints1[i-1].x) and EQD(GLPoints1[i].y, GLPoints1[i-1].y) and EQD(GLPoints1[i].z, GLPoints1[i-1].z)) then
// xObj.AddNode(GLPoints1[i].x, GLPoints1[i].y, GLPoints1[i].z);
// end
// else
xObj.AddNode(GLPoints1[i].x, GLPoints1[i].y, GLPoints1[i].z);
end;
for i := 0 to Length(GLPoints2) - 1 do
begin
// if i > 0 then
// begin
// if not (EQD(GLPoints2[i].x, GLPoints2[i-1].x) and EQD(GLPoints2[i].y, GLPoints2[i-1].y) and EQD(GLPoints2[i].z, GLPoints2[i-1].z)) then
// xGLSide.AddNode(GLPoints2[i].x, GLPoints2[i].y, GLPoints2[i].z);
// end
// else
xGLSide.AddNode(GLPoints2[i].x, GLPoints2[i].y, GLPoints2[i].z);
end;
xSide := T3DSide(TTreeNode(xObj.TagObject).Data);
if xSide.FFaceType = ftNetCeiling then
xGLSide.Parts := [ppTop];
if xSide.FFaceType = ftNetFloor then
xGLSide.Parts := [ppBottom];
if TObject(xSide.FParent) is T3DSide then
CreateAddForDivSide(xObj, xGLSide)
else
CreateAddForParentSide(xObj, xGLSide);
FResizeData.Nodep11 := xObj.Nodes[Nodep11];
FResizeData.Nodep12 := xObj.Nodes[Nodep12];
FResizeData.Noder11 := xObj.Nodes[Noder11];
FResizeData.Noder12 := xObj.Nodes[Noder12];
FResizeData.Nodep21 := xGLSide.Nodes[Nodep21];
FResizeData.Nodep22 := xGLSide.Nodes[Nodep22];
FResizeData.Noder21 := xGLSide.Nodes[Noder21];
FResizeData.Noder22 := xGLSide.Nodes[Noder22];
FResizeData.Indexp11 := Nodep11;
FResizeData.Indexp12 := Nodep12;
FResizeData.Indexr11 := Noder11;
FResizeData.Indexr12 := Noder12;
FResizeData.Indexp21 := Nodep21;
FResizeData.Indexp22 := Nodep22;
FResizeData.Indexr21 := Noder21;
FResizeData.Indexr22 := Noder22;
FResizeData.Side1 := xObj;
FResizeData.Side2 := xGLSide;
RStartPos1 := p1;
RStartPos2 := p2;
rpos1 := RStartPos1;
rpos2 := RStartPos2;
glSide11.Visible := True;
glSide12.Visible := True;
glSide21.Visible := True;
glSide22.Visible := True;
SetSideSizes;
// ***************************************
FToolMode := tmCut;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.SelectNodesEvent', E.Message);
end;
end;
procedure Tfrm3D.SetSideSizes;
var
mp: T3DPoint;
Len: double;
pos, Camera: T3DPoint;
SetPos: T3DPoint;
delta, koef: double;
begin
try
delta := 0.5;
Camera.x := GLSceneViewer.Camera.Position.x;
Camera.y := GLSceneViewer.Camera.Position.y;
Camera.z := GLSceneViewer.Camera.Position.z;
pos.x := (FResizeData.Nodep11.x + rpos1.x) / 2;
pos.y := (FResizeData.Nodep11.y + rpos1.y) / 2;
pos.z := (FResizeData.Nodep11.z + rpos1.z) / 2;
len := GetLineLenght(pos, Camera);
koef := delta / len;
SetPos.x := pos.x + (camera.x - pos.x) * koef;
SetPos.y := pos.y + (camera.y - pos.y) * koef;
SetPos.z := pos.z + (camera.z - pos.z) * koef;
glSide11.Position.x := SetPos.x;
glSide11.Position.y := SetPos.y;
glSide11.Position.z := SetPos.z;
Len := SQRT(SQR(FResizeData.Nodep11.x - rpos1.x) + SQR(FResizeData.Nodep11.y - rpos1.y) + SQR(FResizeData.Nodep11.z - rpos1.z));
glSide11.Text := FormatFloat(ffMask, Len);
pos.x := (FResizeData.Nodep12.x + rpos2.x) / 2;
pos.y := (FResizeData.Nodep12.y + rpos2.y) / 2;
pos.z := (FResizeData.Nodep12.z + rpos2.z) / 2;
len := GetLineLenght(pos, Camera);
koef := delta / len;
SetPos.x := pos.x + (camera.x - pos.x) * koef;
SetPos.y := pos.y + (camera.y - pos.y) * koef;
SetPos.z := pos.z + (camera.z - pos.z) * koef;
glSide12.Position.x := SetPos.x;
glSide12.Position.y := SetPos.y;
glSide12.Position.z := SetPos.z;
Len := SQRT(SQR(FResizeData.Nodep12.x - rpos2.x) + SQR(FResizeData.Nodep12.y - rpos2.y) + SQR(FResizeData.Nodep12.z - rpos2.z));
glSide12.Text := FormatFloat(ffMask, Len);
pos.x := (FResizeData.Nodep21.x + rpos1.x) / 2;
pos.y := (FResizeData.Nodep21.y + rpos1.y) / 2;
pos.z := (FResizeData.Nodep21.z + rpos1.z) / 2;
len := GetLineLenght(pos, Camera);
koef := delta / len;
SetPos.x := pos.x + (camera.x - pos.x) * koef;
SetPos.y := pos.y + (camera.y - pos.y) * koef;
SetPos.z := pos.z + (camera.z - pos.z) * koef;
glSide21.Position.x := SetPos.x;
glSide21.Position.y := SetPos.y;
glSide21.Position.z := SetPos.z;
Len := SQRT(SQR(FResizeData.Nodep21.x - rpos1.x) + SQR(FResizeData.Nodep21.y - rpos1.y) + SQR(FResizeData.Nodep21.z - rpos1.z));
glSide21.Text := FormatFloat(ffMask, Len);
pos.x := (FResizeData.Nodep22.x + rpos2.x) / 2;
pos.y := (FResizeData.Nodep22.y + rpos2.y) / 2;
pos.z := (FResizeData.Nodep22.z + rpos2.z) / 2;
len := GetLineLenght(pos, Camera);
koef := delta / len;
SetPos.x := pos.x + (camera.x - pos.x) * koef;
SetPos.y := pos.y + (camera.y - pos.y) * koef;
SetPos.z := pos.z + (camera.z - pos.z) * koef;
glSide22.Position.x := SetPos.x;
glSide22.Position.y := SetPos.y;
glSide22.Position.z := SetPos.z;
Len := SQRT(SQR(FResizeData.Nodep22.x - rpos2.x) + SQR(FResizeData.Nodep22.y - rpos2.y) + SQR(FResizeData.Nodep22.z - rpos2.z));
glSide22.Text := FormatFloat(ffMask, Len);
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.SetSideSizes', E.Message);
end;
end;
procedure Tfrm3D.AfterUpdate;
var
glObjClass: TGLSceneObjectClass;
glNodeNbr: TGLSpaceText;
xColor: TVector4f;
begin
try
xColor := clrBlack;
FToolMode := tmSelect;
FNodesObjectsList := TList.Create;
FCutDataList := TList.Create;
FResizeData := TResizeData.Create;
FResizer := False;
glCursorObject := TGLCustomSceneObject.Create(GLScene);
glCursorObject.Visible := False;
glSide11 := TGLSpaceText(DummyCube.AddNewChild(TGLSpaceText));
glSide21 := TGLSpaceText(DummyCube.AddNewChild(TGLSpaceText));
glSide12 := TGLSpaceText(DummyCube.AddNewChild(TGLSpaceText));
glSide22 := TGLSpaceText(DummyCube.AddNewChild(TGLSpaceText));
glSide11.Extrusion := 0.1;
glSide11.Scale.X := 0.4;
glSide11.Scale.Y := 0.4;
glSide11.Scale.Z := 0.4;
glSide11.Adjust.Horz := haCenter;
glSide11.Adjust.Vert := vaCenter;
glSide11.Font.Color := clGray;
with glSide11.Material do
begin
FrontProperties.Ambient.Color := xColor;
FrontProperties.Diffuse.Color := xColor;
FrontProperties.Emission.Color := xColor;
BackProperties.Ambient.Color := xColor;
BackProperties.Diffuse.Color := xColor;
BackProperties.Emission.Color := xColor;
end;
glSide12.Extrusion := 0.1;
glSide12.Scale.X := 0.4;
glSide12.Scale.Y := 0.4;
glSide12.Scale.Z := 0.4;
glSide12.Adjust.Horz := haCenter;
glSide12.Adjust.Vert := vaCenter;
glSide12.Font.Color := clGray;
with glSide12.Material do
begin
FrontProperties.Ambient.Color := xColor;
FrontProperties.Diffuse.Color := xColor;
FrontProperties.Emission.Color := xColor;
BackProperties.Ambient.Color := xColor;
BackProperties.Diffuse.Color := xColor;
BackProperties.Emission.Color := xColor;
end;
glSide21.Extrusion := 0.1;
glSide21.Scale.X := 0.4;
glSide21.Scale.Y := 0.4;
glSide21.Scale.Z := 0.4;
glSide21.Adjust.Horz := haCenter;
glSide21.Adjust.Vert := vaCenter;
glSide21.Font.Color := clGray;
with glSide21.Material do
begin
FrontProperties.Ambient.Color := xColor;
FrontProperties.Diffuse.Color := xColor;
FrontProperties.Emission.Color := xColor;
BackProperties.Ambient.Color := xColor;
BackProperties.Diffuse.Color := xColor;
BackProperties.Emission.Color := xColor;
end;
glSide22.Extrusion := 0.1;
glSide22.Scale.X := 0.4;
glSide22.Scale.Y := 0.4;
glSide22.Scale.Z := 0.4;
glSide22.Adjust.Horz := haCenter;
glSide22.Adjust.Vert := vaCenter;
glSide22.Font.Color := clGray;
with glSide22.Material do
begin
FrontProperties.Ambient.Color := xColor;
FrontProperties.Diffuse.Color := xColor;
FrontProperties.Emission.Color := xColor;
BackProperties.Ambient.Color := xColor;
BackProperties.Diffuse.Color := xColor;
BackProperties.Emission.Color := xColor;
end;
glSide11.Visible := False;
glSide21.Visible := False;
glSide12.Visible := False;
glSide22.Visible := False;
glSpliter := TGLLines(DummyCube.AddNewChild(TGLLines));
glSpliter.AddNode(0, 0, 0);
glSpliter.AddNode(0, 0, 0);
glSpliter.LineColor.AsWinColor := clBlack;
glSpliter.NodeColor.AsWinColor := clBlack;
glSpliter.LineWidth := 2;
glSpliter.NodeSize := 0.3;
glSpliter.NodesAspect := lnaDodecahedron;
glSpliter.Visible := False;
glCubeSpliter := TGLCube(DummyCube.AddNewChild(TGLCube));
glCubeSpliter.CubeDepth := 0.3; // Z
glCubeSpliter.CubeHeight := 0.3; // Y
glCubeSpliter.CubeWidth := 0.3; // X
with glCubeSpliter.Material do
begin
FrontProperties.Ambient.Color := clrBlack;
FrontProperties.Diffuse.Color := clrBlack;
FrontProperties.Emission.Color := clrBlack;
BackProperties.Ambient.Color := clrBlack;
BackProperties.Diffuse.Color := clrBlack;
BackProperties.Emission.Color := clrBlack;
end;
glCubeSpliter.Visible := False;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.AfterUpdate', E.Message);
end;
end;
procedure Tfrm3D.GLSceneViewerMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
try
if Button = mbRight then
if (mdx = X) and (mdy = Y) then
OnRightClick;
if FToolMode = tmSelect then
begin
if FMovedObject <> nil then
begin
Set3DSObjectPos(FMovedObject);
FMovedObject := nil;
GLSceneViewer.Cursor := crDefault;
end;
end;
if (FToolMode = tmCut) and FResizer then
begin
// <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>, <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
if Button = mbLeft then
begin
FResizer := False;
RStartPos1 := rpos1;
RStartPos2 := rpos2;
SetSidesData;
end;
// <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> - <20><><EFBFBD><EFBFBD><EFBFBD>
if Button = mbRight then
begin
FResizer := False;
rpos1 := RStartPos1;
rpos2 := RStartPos2;
glSpliter.Nodes[0].X := rpos1.x;
glSpliter.Nodes[0].Y := rpos1.y;
glSpliter.Nodes[0].Z := rpos1.z;
glSpliter.Nodes[1].X := rpos2.x;
glSpliter.Nodes[1].Y := rpos2.y;
glSpliter.Nodes[1].Z := rpos2.z;
glCubeSpliter.Position.x := (rpos1.x + rpos2.x) / 2;
glCubeSpliter.Position.y := (rpos1.y + rpos2.y) / 2;
glCubeSpliter.Position.z := (rpos1.z + rpos2.z) / 2;
GLSceneViewer.Cursor := crDefault;
SetSideSizes;
{
//Full Reset
FToolMode := tmSelect;
glSpliter.Visible := False;
glCubeSpliter.Visible := False;
glSide11.Visible := False;
glSide12.Visible := False;
glSide21.Visible := False;
glSide22.Visible := False;
DeleteNodesObjects;
GLSceneViewer.Cursor := crDefault;
}
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.GLSceneViewerMouseUp', E.Message);
end;
end;
procedure Tfrm3D.CreateAddForDivSide(aSide, aAddSide: TGLPolygon);
var
i, j: Integer;
xNode, xParentNode, xAddNode: TTreeNode;
xParentSide, xSide, xAddSide: T3DSide;
tmpdir, tmpfname, ExtStr, BmpFName: string;
HashStr: string;
begin
try
// Create Model Object
xNode := TTreeNode(aSide.TagObject);
xParentNode := xNode.Parent;
// Create
xSide := T3DSide(xNode.Data);
SetLength(xSide.FPoints, aSide.Nodes.Count);
SetLength(xSide.FGLPoints, aSide.Nodes.Count);
for i := 0 to Length(xSide.FGLPoints) - 1 do
begin
xSide.FGLPoints[i].x := aSide.Nodes[i].X;
xSide.FGLPoints[i].y := aSide.Nodes[i].Y;
xSide.FGLPoints[i].z := aSide.Nodes[i].Z;
end;
for i := 0 to Length(xSide.FPoints) - 1 do
begin
xSide.FPoints[i].x := aSide.Nodes[i].X / Factor;
xSide.FPoints[i].z := aSide.Nodes[i].Y / Factor;
xSide.FPoints[i].y := aSide.Nodes[i].Z / Factor;
end;
xAddSide := T3DSide.Create(xSide.FFaceType, xSide.FWallType, xSide.FSideType, xSide.FParent);
xAddSide.FName := cSubSide + IntToStr(xParentNode.Count + 1);
xAddSide.FDescription := xSide.FDescription;
xAddSide.FGLObject := aAddSide;
xAddSide.FFace := nil;
xAddSide.FColor := xSide.FColor;
xAddSide.FRotate := xSide.FRotate;
xAddSide.FMirror := xSide.FMirror;
xAddSide.FTextureHash := xSide.FTextureHash;
xAddSide.FTexture_ext := xSide.FTexture_ext;
SetLength(xAddSide.FPoints, aAddSide.Nodes.Count);
SetLength(xAddSide.FGLPoints, aAddSide.Nodes.Count);
for i := 0 to Length(xAddSide.FGLPoints) - 1 do
begin
xAddSide.FGLPoints[i].x := aAddSide.Nodes[i].X;
xAddSide.FGLPoints[i].y := aAddSide.Nodes[i].Y;
xAddSide.FGLPoints[i].z := aAddSide.Nodes[i].Z;
end;
for i := 0 to Length(xAddSide.FPoints) - 1 do
begin
xAddSide.FPoints[i].x := aAddSide.Nodes[i].X / Factor;
xAddSide.FPoints[i].z := aAddSide.Nodes[i].Y / Factor;
xAddSide.FPoints[i].y := aAddSide.Nodes[i].Z / Factor;
end;
if xSide.FParent is T3DSide then
T3DSide(xSide.FParent).FSubSides.Add(xAddSide);
// Create Node
xAddNode := ModelTree.Items.AddChild(xParentNode, xAddSide.FName);
xAddNode.Data := xAddSide;
xAddNode.ImageIndex := 50;
aAddSide.TagObject := xAddNode;
// Apply Texture
tmpdir := ExtractDirByCategoryType(dctPictures);
tmpfname := tmpdir + '\tmp.bmp';
aSide.Material.Texture.Image.SaveToFile(tmpfname);
if tmpfname <> '' then
begin
aAddSide.Material.Texture.Disabled := False;
aAddSide.Material.Texture.MappingMode := tmmObjectLinear;
aAddSide.Material.Texture.Image.LoadFromFile(tmpfname);
RotateTextureToAngleP(xAddSide, aAddSide, xAddSide.FRotate, xAddSide.FMirror);
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.CreateAddForDivSide', E.Message);
end;
end;
procedure Tfrm3D.CreateAddForParentSide(aFirstSide, aSecondSide: TGLPolygon);
var
i, j: Integer;
xParentNode, xFirstNode, xSecondNode: TTreeNode;
xParentSide, xFirstSide, xSecondSide: T3DSide;
tmpdir, tmpfname, ExtStr, BmpFName: string;
HashStr: string;
begin
try
// Create Model Object
xParentNode := TTreeNode(aFirstSide.TagObject);
xParentSide := T3DSide(xParentNode.Data);
// CREATE FIRST
xFirstSide := T3DSide.Create(xParentSide.FFaceType, xParentSide.FWallType, xParentSide.FSideType, xParentSide);
xFirstSide.FName := cSubSide + IntToStr(xParentNode.Count + 1);
xFirstSide.FDescription := xParentSide.FDescription;
xFirstSide.FGLObject := aFirstSide;
xFirstSide.FFace := nil;
xFirstSide.FColor := xParentSide.FColor;
xFirstSide.FRotate := xParentSide.FRotate;
xFirstSide.FMirror := xParentSide.FMirror;
xFirstSide.FTextureHash := xParentSide.FTextureHash;
xFirstSide.FTexture_ext := xParentSide.FTexture_ext;
SetLength(xFirstSide.FPoints, aFirstSide.Nodes.Count);
SetLength(xFirstSide.FGLPoints, aFirstSide.Nodes.Count);
for i := 0 to Length(xFirstSide.FGLPoints) - 1 do
begin
xFirstSide.FGLPoints[i].x := aFirstSide.Nodes[i].X;
xFirstSide.FGLPoints[i].y := aFirstSide.Nodes[i].Y;
xFirstSide.FGLPoints[i].z := aFirstSide.Nodes[i].Z;
end;
for i := 0 to Length(xFirstSide.FPoints) - 1 do
begin
xFirstSide.FPoints[i].x := aFirstSide.Nodes[i].X / Factor;
xFirstSide.FPoints[i].z := aFirstSide.Nodes[i].Y / Factor;
xFirstSide.FPoints[i].y := aFirstSide.Nodes[i].Z / Factor;
end;
xParentSide.FSubSides.Add(xFirstSide);
xFirstNode := ModelTree.Items.AddChild(xParentNode, xFirstSide.FName);
xFirstNode.Data := xFirstSide;
xFirstNode.ImageIndex := 50;
aFirstSide.TagObject := xFirstNode;
// CREATE SECOND
xSecondSide := T3DSide.Create(xParentSide.FFaceType, xParentSide.FWallType, xParentSide.FSideType, xParentSide);
xSecondSide.FName := cSubSide + IntToStr(xParentNode.Count + 1);
xSecondSide.FDescription := xParentSide.FDescription;
xSecondSide.FGLObject := aSecondSide;
xSecondSide.FFace := nil;
xSecondSide.FColor := xParentSide.FColor;
xSecondSide.FRotate := xParentSide.FRotate;
xSecondSide.FMirror := xParentSide.FMirror;
xSecondSide.FTextureHash := xParentSide.FTextureHash;
xSecondSide.FTexture_ext := xParentSide.FTexture_ext;
SetLength(xSecondSide.FPoints, aSecondSide.Nodes.Count);
SetLength(xSecondSide.FGLPoints, aSecondSide.Nodes.Count);
for i := 0 to Length(xSecondSide.FGLPoints) - 1 do
begin
xSecondSide.FGLPoints[i].x := aSecondSide.Nodes[i].X;
xSecondSide.FGLPoints[i].y := aSecondSide.Nodes[i].Y;
xSecondSide.FGLPoints[i].z := aSecondSide.Nodes[i].Z;
end;
for i := 0 to Length(xSecondSide.FPoints) - 1 do
begin
xSecondSide.FPoints[i].x := aSecondSide.Nodes[i].X / Factor;
xSecondSide.FPoints[i].z := aSecondSide.Nodes[i].Y / Factor;
xSecondSide.FPoints[i].y := aSecondSide.Nodes[i].Z / Factor;
end;
xParentSide.FSubSides.Add(xSecondSide);
xSecondNode := ModelTree.Items.AddChild(xParentNode, xSecondSide.FName);
xSecondNode.Data := xSecondSide;
xSecondNode.ImageIndex := 50;
aSecondSide.TagObject := xSecondNode;
xParentSide.FGLObject := nil;
// Apply Texture
tmpdir := ExtractDirByCategoryType(dctPictures);
tmpfname := tmpdir + '\tmp.bmp';
aFirstSide.Material.Texture.Image.SaveToFile(tmpfname);
if tmpfname <> '' then
begin
aSecondSide.Material.Texture.Disabled := False;
aSecondSide.Material.Texture.MappingMode := tmmObjectLinear;
aSecondSide.Material.Texture.Image.LoadFromFile(tmpfname);
RotateTextureToAngleP(xSecondSide, aSecondSide, xSecondSide.FRotate, xSecondSide.FMirror);
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.CreateAddForParentSide', E.Message);
end;
end;
procedure Tfrm3D.SetSidesData;
var
xNode: TTreeNode;
xSide1, xSide2: T3DSide;
begin
try
FResizeData.Noder11.X := rpos1.x;
FResizeData.Noder11.Y := rpos1.y;
FResizeData.Noder11.Z := rpos1.z;
FResizeData.Noder12.X := rpos2.x;
FResizeData.Noder12.Y := rpos2.y;
FResizeData.Noder12.Z := rpos2.z;
FResizeData.Noder21.X := rpos1.x;
FResizeData.Noder21.Y := rpos1.y;
FResizeData.Noder21.Z := rpos1.z;
FResizeData.Noder22.X := rpos2.x;
FResizeData.Noder22.Y := rpos2.y;
FResizeData.Noder22.Z := rpos2.z;
xNode := TTreeNode(FResizeData.Side1.TagObject);
xSide1 := T3DSide(xNode.Data);
xNode := TTreeNode(FResizeData.Side2.TagObject);
xSide2 := T3DSide(xNode.Data);
xSide1.FGLPoints[FResizeData.Indexr11].x := FResizeData.Noder11.X;
xSide1.FGLPoints[FResizeData.Indexr11].y := FResizeData.Noder11.Y;
xSide1.FGLPoints[FResizeData.Indexr11].z := FResizeData.Noder11.Z;
xSide1.FGLPoints[FResizeData.Indexr12].x := FResizeData.Noder12.X;
xSide1.FGLPoints[FResizeData.Indexr12].y := FResizeData.Noder12.Y;
xSide1.FGLPoints[FResizeData.Indexr12].z := FResizeData.Noder12.Z;
xSide1.FPoints[FResizeData.Indexr11].x := FResizeData.Noder11.X / Factor;
xSide1.FPoints[FResizeData.Indexr11].z := FResizeData.Noder11.Y / Factor;
xSide1.FPoints[FResizeData.Indexr11].y := FResizeData.Noder11.Z / Factor;
xSide1.FPoints[FResizeData.Indexr12].x := FResizeData.Noder12.X / Factor;
xSide1.FPoints[FResizeData.Indexr12].z := FResizeData.Noder12.Y / Factor;
xSide1.FPoints[FResizeData.Indexr12].y := FResizeData.Noder12.Z / Factor;
xSide2.FGLPoints[FResizeData.Indexr21].x := FResizeData.Noder21.X;
xSide2.FGLPoints[FResizeData.Indexr21].y := FResizeData.Noder21.Y;
xSide2.FGLPoints[FResizeData.Indexr21].z := FResizeData.Noder21.Z;
xSide2.FGLPoints[FResizeData.Indexr22].x := FResizeData.Noder22.X;
xSide2.FGLPoints[FResizeData.Indexr22].y := FResizeData.Noder22.Y;
xSide2.FGLPoints[FResizeData.Indexr22].z := FResizeData.Noder22.Z;
xSide2.FPoints[FResizeData.Indexr21].x := FResizeData.Noder21.X / Factor;
xSide2.FPoints[FResizeData.Indexr21].z := FResizeData.Noder21.Y / Factor;
xSide2.FPoints[FResizeData.Indexr21].y := FResizeData.Noder21.Z / Factor;
xSide2.FPoints[FResizeData.Indexr22].x := FResizeData.Noder22.X / Factor;
xSide2.FPoints[FResizeData.Indexr22].z := FResizeData.Noder22.Y / Factor;
xSide2.FPoints[FResizeData.Indexr22].y := FResizeData.Noder22.Z / Factor;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.SetSidesData', E.Message);
end;
end;
procedure Tfrm3D.RefreshSidesPoints;
var
i, j: integer;
xGLSide1, xGLSide2: TGLPolygon;
xNode: TTreeNode;
xSide1, xSide2: T3DSide;
begin
try
xGLSide1 := FResizeData.Side1;
xGLSide2 := FResizeData.Side2;
xNode := TTreeNode(xGLSide1.TagObject);
xSide1 := T3DSide(xNode.Data);
xNode := TTreeNode(xGLSide2.TagObject);
xSide2 := T3DSide(xNode.Data);
i := 0;
while i < xGLSide1.Nodes.Count do
begin
if i > 0 then
begin
if EQD(xGLSide1.Nodes[i].x, xGLSide1.Nodes[i-1].x) and EQD(xGLSide1.Nodes[i].y, xGLSide1.Nodes[i-1].y) and EQD(xGLSide1.Nodes[i].z, xGLSide1.Nodes[i-1].z) then
xGLSide1.Nodes.Delete(i)
else
i := i + 1;
end
else
i := i + 1;
end;
SetLength(xSide1.FGLPoints, xGLSide1.Nodes.Count);
SetLength(xSide1.FPoints, xGLSide1.Nodes.Count);
for i := 0 to xGLSide1.Nodes.Count - 1 do
begin
xSide1.FGLPoints[i].x := xGLSide1.Nodes[i].x;
xSide1.FGLPoints[i].y := xGLSide1.Nodes[i].y;
xSide1.FGLPoints[i].z := xGLSide1.Nodes[i].z;
xSide1.FPoints[i].x := xGLSide1.Nodes[i].x / Factor;
xSide1.FPoints[i].z := xGLSide1.Nodes[i].y / Factor;
xSide1.FPoints[i].y := xGLSide1.Nodes[i].z / Factor;
end;
i := 0;
while i < xGLSide2.Nodes.Count do
begin
if i > 0 then
begin
if EQD(xGLSide2.Nodes[i].x, xGLSide2.Nodes[i-1].x) and EQD(xGLSide2.Nodes[i].y, xGLSide2.Nodes[i-1].y) and EQD(xGLSide2.Nodes[i].z, xGLSide2.Nodes[i-1].z) then
xGLSide2.Nodes.Delete(i)
else
i := i + 1;
end
else
i := i + 1;
end;
SetLength(xSide2.FGLPoints, xGLSide2.Nodes.Count);
SetLength(xSide2.FPoints, xGLSide2.Nodes.Count);
for i := 0 to xGLSide2.Nodes.Count - 1 do
begin
xSide2.FGLPoints[i].x := xGLSide2.Nodes[i].x;
xSide2.FGLPoints[i].y := xGLSide2.Nodes[i].y;
xSide2.FGLPoints[i].z := xGLSide2.Nodes[i].z;
xSide2.FPoints[i].x := xGLSide2.Nodes[i].x / Factor;
xSide2.FPoints[i].z := xGLSide2.Nodes[i].y / Factor;
xSide2.FPoints[i].y := xGLSide2.Nodes[i].z / Factor;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.RefreshSidesPoints', E.Message);
end;
end;
procedure Tfrm3D.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
var
Res: Integer;
mess: string;
begin
GLCadencer.Enabled := False;
{$IF Defined(ES_GRAPH_SC)}
mess := '<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>?';
Res := MessageBox(self.Handle, PAnsiChar(mess), '<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>', MB_YESNOCANCEL);
if Res = IDYES then
begin
SaveModelToStream(FFileStream);
GSaved3DModelExist := True;
end
else if Res = IDCANCEL then
begin
CanClose := False;
GLCadencer.Enabled := True;
end;
{$ELSE}
{$IFEND}
end;
procedure Tfrm3D.sbSaveModelClick(Sender: TObject);
begin
SaveModelToStream(FFileStream);
GSaved3DModelExist := True;
end;
procedure Tfrm3D.SaveModelToStream(const AFile: String);
var
fFileName: string;
Buffer: array[0..1023] of Char;
TempPath: string;
xStream: TFileStream;
xSize: Integer;
mStream: TMemoryStream;
i, j, k, ii, jj, kk, s: integer;
xRoom: T3DRoom;
xWall: T3DWall;
xWallElement: T3DWallElement;
xBalconElement: T3DBalconElement;
xSlope: T3DSlope;
xSide, xSubSide: T3DSide;
x3DSObject: T3DSObject;
begin
try
{* <20><><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20> <20><>, <20><><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>
fFileName := GetCadFileNameForSaveToPM(GCadForm.FCADListID);
PCad.SaveToFile(0, fFileName);
<20><><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> TF_CAD.FormCloseQuery <20> <20><><EFBFBD><EFBFBD><EFBFBD> <20><> LoadModelToStream <20><><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
*}
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);
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
for i := 0 to F3DModel.FRooms.Count - 1 do
begin
xRoom := T3DRoom(F3DModel.FRooms[i]);
ModelObjectsList.Add(xRoom);
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
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;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
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;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> 3<><33> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
for j := 0 to xRoom.F3DSObjects.Count - 1 do
begin
x3DSObject := T3DSObject(xRoom.F3DSObjects[j]);
ModelObjectsList.Add(x3DSObject);
end;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
for j := 0 to xRoom.FWalls.Count - 1 do
begin
xWall := T3DWall(xRoom.FWalls[j]);
ModelObjectsList.Add(xWall);
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>
for k := 0 to xWall.FWallElements.Count - 1 do
begin
xWallElement := T3DWallElement(xWall.FWallElements[k]);
ModelObjectsList.Add(xWallElement);
// <20><><EFBFBD><EFBFBD>
if xWallElement.FElementType = dotWindow then
begin
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
for ii := 0 to xWallElement.FSlopes.Count - 1 do
begin
xSlope := T3DSlope(xWallElement.FSlopes[ii]);
ModelObjectsList.Add(xSlope);
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
for jj := 0 to xSlope.FSides.Count - 1 do
begin
xSide := T3DSide(xSlope.FSides[jj]);
ModelObjectsList.Add(xSide);
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
for s := 0 to xSide.FSubSides.Count - 1 do
begin
xSubSide := T3DSide(xSide.FSubSides[s]);
ModelObjectsList.Add(xSubSide);
end;
end;
end;
end;
// <20><><EFBFBD><EFBFBD><EFBFBD>
if xWallElement.FElementType = dotDoor then
begin
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
for ii := 0 to xWallElement.FSlopes.Count - 1 do
begin
xSlope := T3DSlope(xWallElement.FSlopes[ii]);
ModelObjectsList.Add(xSlope);
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
for jj := 0 to xSlope.FSides.Count - 1 do
begin
xSide := T3DSide(xSlope.FSides[jj]);
ModelObjectsList.Add(xSide);
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
for s := 0 to xSide.FSubSides.Count - 1 do
begin
xSubSide := T3DSide(xSide.FSubSides[s]);
ModelObjectsList.Add(xSubSide);
end;
end;
end;
end;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
if xWallElement.FElementType = dotBalcony then
begin
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
for ii := 0 to xWallElement.FSlopes.Count - 1 do
begin
xSlope := T3DSlope(xWallElement.FSlopes[ii]);
ModelObjectsList.Add(xSlope);
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
for jj := 0 to xSlope.FSides.Count - 1 do
begin
xSide := T3DSide(xSlope.FSides[jj]);
ModelObjectsList.Add(xSide);
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
for s := 0 to xSide.FSubSides.Count - 1 do
begin
xSubSide := T3DSide(xSide.FSubSides[s]);
ModelObjectsList.Add(xSubSide);
end;
end;
end;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
for ii := 0 to xWallElement.FBalconElements.Count - 1 do
begin
xBalconElement := T3DBalconElement(xWallElement.FBalconElements[ii]);
ModelObjectsList.Add(xBalconElement);
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
for jj := 0 to xBalconElement.FSides.Count - 1 do
begin
xSide := T3DSide(xBalconElement.FSides[jj]);
ModelObjectsList.Add(xSide);
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
for s := 0 to xSide.FSubSides.Count - 1 do
begin
xSubSide := T3DSide(xSide.FSubSides[s]);
ModelObjectsList.Add(xSubSide);
end;
end;
end;
end;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>
for ii := 0 to xWallElement.FSides.Count - 1 do
begin
xSide := T3DSide(xWallElement.FSides[ii]);
ModelObjectsList.Add(xSide);
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
for s := 0 to xSide.FSubSides.Count - 1 do
begin
xSubSide := T3DSide(xSide.FSubSides[s]);
ModelObjectsList.Add(xSubSide);
end;
end;
end;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>
for k := 0 to xWall.FSides.Count - 1 do
begin
xSide := T3DSide(xWall.FSides[k]);
ModelObjectsList.Add(xSide);
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
for s := 0 to xSide.FSubSides.Count - 1 do
begin
xSubSide := T3DSide(xSide.FSubSides[s]);
ModelObjectsList.Add(xSubSide);
end;
end;
end;
end;
xSize := 0;
mStream := TMemoryStream.Create;
GetModelData(mStream);
xSize := mStream.Size;
mStream.Seek(0, soFromBeginning);
xStream.Write(xSize, 4);
StreamToStream(mStream, xStream, xSize);
FreeAndNil(mStream);
FreeAndNil(xStream);
FreeAndNil(ModelObjectsList);
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.SaveModelToStream', E.Message);
end;
end;
procedure Tfrm3D.GetModelData(Stream: TStream);
var
i, xCount: integer;
xSize: Integer;
objStream: TMemoryStream;
xObject: TObject;
begin
try
xCount := ModelObjectsList.Count;
Stream.Write(xCount, 4);
for i := 0 to xCount - 1 do
begin
xObject := TObject(ModelObjectsList[i]);
objStream := TMemoryStream.Create;
if xObject is T3DModel then
T3DModel(xObject).WriteToStream(objStream);
if xObject is T3DRoom then
T3DRoom(xObject).WriteToStream(objStream);
if xObject is T3DWall then
T3DWall(xObject).WriteToStream(objStream);
if xObject is T3DWallElement then
T3DWallElement(xObject).WriteToStream(objStream);
if xObject is T3DBalconElement then
T3DBalconElement(xObject).WriteToStream(objStream);
if xObject is T3DSlope then
T3DSlope(xObject).WriteToStream(objStream);
if xObject is T3DSide then
T3DSide(xObject).WriteToStream(objStream);
if xObject is T3DSObject then
T3DSObject(xObject).WriteToStream(objStream);
xSize := objStream.Size;
objStream.Seek(0,soFromBeginning);
Stream.Write(xSize, 4);
StreamToStream(objStream, Stream, xSize);
FreeAndNil(objStream);
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.GetModelData', E.Message);
end;
end;
procedure Tfrm3D.LoadModelFromStream(const AFile: String);
var
fFileName: string;
Buffer: array[0..1023] of Char;
TempPath: string;
xStream: TFileStream;
xSize: Integer;
mStream: TMemoryStream;
i, j, k, ii, jj, kk: integer;
xModel: T3DModel;
xRoom: T3DRoom;
xWall: T3DWall;
xWallElement: T3DWallElement;
xBalconElement: T3DBalconElement;
xSlope: T3DSlope;
xCeiling, xFloor, xSide: T3DSide;
xObject: TObject;
begin
try
{* <20><><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>, <20><><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20>
<20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> OpenListsInProject
ListStream := OpenListInPM(GCadForm.FCADListID, GCadForm.FCADListName, fFileName);
if ListStream <> nil then
begin
SetString(TempPath, Buffer, GetTempPath(Sizeof(Buffer) - 1, Buffer));
ListStream.SaveToFile(TempPath + 'tempCAD.pwd');
GCadForm.PCad.LoadFromFile(TempPath + 'tempCAD.pwd');
end
*}
F3DStreamModel := nil;
ModelObjectsList := TList.Create;
fFileName := AFile;
if fFileName = '' then
begin
SetString(TempPath, Buffer, GetTempPath(Sizeof(Buffer) - 1, Buffer));
fFileName := TempPath + '3dmodel.pwd';
end;
if not FileExists(fFileName) then
exit;
xStream := SafeOpenFileStream(fFileName, fmOpenRead or fmShareExclusive, 'Tfrm3D.LoadModelFromStream');
xStream.Read(xSize, 4);
mStream := TMemoryStream.Create;
StreamToStream(xStream, mStream, xSize);
mStream.Seek(0, soFromBeginning);
SetModelData(mStream);
FreeAndNil(mStream);
FreeAndNil(xStream);
for i := 0 to ModelObjectsList.Count - 1 do
begin
xObject := TObject(ModelObjectsList[i]);
if xObject is T3DModel then
T3DModel(xObject).SetRelations;
if xObject is T3DRoom then
T3DRoom(xObject).SetRelations;
if xObject is T3DWall then
T3DWall(xObject).SetRelations;
if xObject is T3DWallElement then
T3DWallElement(xObject).SetRelations;
if xObject is T3DBalconElement then
T3DBalconElement(xObject).SetRelations;
if xObject is T3DSlope then
T3DSlope(xObject).SetRelations;
if xObject is T3DSide then
T3DSide(xObject).SetRelations;
if xObject is T3DSObject then
T3DSObject(xObject).SetRelations;
end;
FreeAndNil(ModelObjectsList);
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.LoadModelFromStream', E.Message);
end;
end;
procedure Tfrm3D.SetModelData(Stream: TStream);
var
i,xCount: integer;
xObject: TObject;
xSize: Integer;
objStream: TMemoryStream;
TypeName: string;
xModel: T3DModel;
xRoom: T3DRoom;
xWall: T3DWall;
xWallElement: T3DWallElement;
xBalconElement: T3DBalconElement;
xSlope: T3DSlope;
xSide: T3DSide;
x3DSObject: T3DSObject;
begin
try
Stream.Read(xCount, 4);
xModel := nil; //14.12.2010
for i := 0 to xCount - 1 do
begin
Stream.Read(xSize, 4);
objStream := TMemoryStream.Create;
StreamToStream(Stream, objStream, xSize);
objStream.Seek(0,soFromBeginning);
TypeName := ReadStringFromStream(objStream);
if TypeName = 'T3DModel' then
begin
xModel := T3DModel.Create;
xModel.ReadFromStream(objStream);
ModelObjectsList.Add(xModel);
end;
if TypeName = 'T3DRoom' then
begin
xRoom := T3DRoom.Create(nil, nil, nil);
xRoom.ReadFromStream(objStream);
ModelObjectsList.Add(xRoom);
end;
if TypeName = 'T3DWall' then
begin
xWall := T3DWall.Create(nil, nil, nil);
xWall.ReadFromStream(objStream);
ModelObjectsList.Add(xWall);
end;
if TypeName = 'T3DWallElement' then
begin
xWallElement := T3DWallElement.Create(nil, nil, dotNone, nil);
xWallElement.ReadFromStream(objStream);
ModelObjectsList.Add(xWallElement);
end;
if TypeName = 'T3DBalconElement' then
begin
xBalconElement := T3DBalconElement.Create(nil, dotNone, nil);
xBalconElement.ReadFromStream(objStream);
ModelObjectsList.Add(xBalconElement);
end;
if TypeName = 'T3DSlope' then
begin
xSlope := T3DSlope.Create(nil, nil, nil);
xSlope.ReadFromStream(objStream);
ModelObjectsList.Add(xSlope);
end;
if TypeName = 'T3DSide' then
begin
xSide := T3DSide.Create(ftNetPath, fwtNone, wstNone, nil);
xSide.ReadFromStream(objStream);
ModelObjectsList.Add(xSide);
end;
if TypeName = 'T3DSObject' then
begin
x3DSObject := T3DSObject.Create(nil);
x3DSObject.ReadFromStream(objStream);
ModelObjectsList.Add(x3DSObject);
end;
FreeAndNil(objStream);
end;
frm3D.F3DStreamModel := xModel;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.SetModelData', E.Message);
end;
end;
procedure Tfrm3D.CopyModelHash;
var
i, j: integer;
xStr: string;
CanAdd: Boolean;
begin
try
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> HASH
for i := 0 to F3DStreamModel.FHashs.Count - 1 do
begin
xStr := F3DStreamModel.FHashs[i];
CanAdd := True;
for j := 0 to F3DModel.FHashs.Count - 1 do
begin
if F3DModel.FHashs[j] = xStr then
CanAdd := False;
end;
if CanAdd then
F3DModel.FHashs.Add(xStr);
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.CopyModelHash', E.Message);
end;
end;
procedure Tfrm3D.OnRightClick;
var
xObj: TGLBaseSceneObject;
Item: TMenuItem;
i, j, Index: integer;
Str: string;
xCutData: TCutData;
X, Y: Integer;
xSide: T3DSide;
begin
try
X := mx;
Y := my;
if (FToolMode = tmSelect) then
begin
xObj := GlsceneViewer.Buffer.GetPickedobject(X, Y);
if (xObj <> nil) and (xObj is TGLPolygon) then
begin
xSide := T3DSide(TTreeNode(xObj.TagObject).Data);
if ((xSide.FFaceType = ftNetPath) and ((xSide.FWallType = fwtInner) or (xSide.FWallType = fwtOuter))) or
(xSide.FFaceType = ftNetCeiling) or (xSide.FFaceType = ftNetFloor) then
begin
if (FSelection.Count = 1) and (TGLBaseSceneObject(FSelection[0]) = xObj) then
begin
// Create Nodes Texts
CreateNodesObjects(TGLPolygon(xObj));
// Create PopumMenu
Index := DummyCube.IndexOfChild(xObj);
FCutDataList.Clear;
pmCut.Items.Clear;
for i := 0 to TGLPolygon(xObj).Nodes.Count - 1 do
begin
Str := '';
for j := i + 2 to TGLPolygon(xObj).Nodes.Count - 1 do
begin
Str := '<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>: ' + IntToStr(i+1) + ',' + IntToStr(i+2) + '-';
if j + 1 < TGLPolygon(xObj).Nodes.Count then
begin
Str := Str + IntToStr(j+1) + ',' + IntToStr(j+2);
Item := TMenuItem.Create(pmCut);
Item.Caption := Str;
pmCut.Items.Add(Item);
Item.Tag := Index;
Item.OnClick := SelectNodesEvent;
xCutData := TCutData.create;
xCutData.Index11 := i;
xCutData.Index12 := i + 1;
xCutData.Index21 := j;
xCutData.Index22 := j + 1;
FCutDataList.Add(xCutData);
end
else
begin
if i <> 0 then
begin
Str := Str + IntToStr(j+1) + ',' + IntToStr(1);
Item := TMenuItem.Create(pmCut);
Item.Caption := Str;
pmCut.Items.Add(Item);
Item.Tag := Index;
Item.OnClick := SelectNodesEvent;
xCutData := TCutData.create;
xCutData.Index11 := i;
xCutData.Index12 := i + 1;
xCutData.Index21 := j;
xCutData.Index22 := 0;
FCutDataList.Add(xCutData);
end;
end;
end;
end;
pmCut.Popup(X, Y);
end;
end;
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.OnRightClick', E.Message);
end;
end;
procedure Tfrm3D.Set3DSObjectPos(aGLObject: TGLFreeForm);
var
i: integer;
xObject: T3DSObject;
begin
try
xObject := T3DSObject(TTreeNode(aGLObject.TagObject).Data);
xObject.FPosition.x := aGLObject.Position.x;
xObject.FPosition.y := aGLObject.Position.y;
xObject.FPosition.z := aGLObject.Position.z;
edPosX.Text := FloatToStr(xObject.FPosition.x);
edPosY.Text := FloatToStr(xObject.FPosition.y);
edPosZ.Text := FloatToStr(xObject.FPosition.z);
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.Set3DSObjectPos', E.Message);
end;
end;
procedure Tfrm3D.nDeleteAllSubSidesClick(Sender: TObject);
var
i, j: Integer;
xSide, xSubSide: T3DSide;
xSideNode, xSubSideNode: TTreeNode;
xGLObject, xGLSubObject: TGLBaseSceneObject;
begin
try
if ModelTree.SelectionCount = 1 then
begin
xSideNode := ModelTree.Selections[0];
xSide := T3DSide(xSideNode.Data);
xGLObject := TGLBaseSceneObject(xSide.FGLObject);
for i := 0 to xSideNode.Count - 1 do
begin
xSubSideNode := xSideNode.Item[i];
xSubSide := T3DSide(xSubSideNode.Data);
xGLSubObject := TGLBaseSceneObject(xSubSide.FGLObject);
if i = 0 then
begin
xSide.FGLObject := xGLSubObject;
xGLSubObject.TagObject := xSideNode;
TGLPolygon(xGLSubObject).Nodes.Clear;
for j := 0 to Length(xSide.FGLPoints) - 1 do
begin
TGLPolygon(xGLSubObject).AddNode(xSide.FGLPoints[j].x, xSide.FGLPoints[j].y, xSide.FGLPoints[j].z);
end;
end
else
begin
DummyCube.Remove(xGLSubObject, True);
end;
end;
xSideNode.DeleteChildren;
xSide.FSubSides.Clear;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.nDeleteAllSubSidesClick', E.Message);
end;
end;
function Tfrm3D.GetModelObjectByComponID(aComponID: Integer): TObject;
var
i, j, k, ii, jj, kk, s: integer;
xRoom: T3DRoom;
xWall: T3DWall;
xWallElement: T3DWallElement;
xBalconElement: T3DBalconElement;
xSlope: T3DSlope;
xSide, xSubSide: T3DSide;
x3DSObject: T3DSObject;
begin
try
Result := nil;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
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;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
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;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>
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;
// <20><><EFBFBD><EFBFBD>
if xWallElement.FElementType = dotWindow then
begin
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
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;
// <20><><EFBFBD><EFBFBD><EFBFBD>
if xWallElement.FElementType = dotDoor then
begin
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
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;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
if xWallElement.FElementType = dotBalcony then
begin
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
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;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
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;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
for i := 0 to SidesList.Count - 1 do
begin
xSide := T3DSide(SidesList[i]);
if CmpSides(aSide, xSide) then
begin
Result := xSide;
exit;
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.GetSimilarSide', E.Message);
end;
end;
function Tfrm3D.CmpSides(aSide1, aSide2: T3DSide): Boolean;
var
i, j: integer;
begin
try
Result := True;
if aSide1.FWallType <> aSide2.FWallType then
begin
Result := False;
exit;
end;
if Length(aSide1.FPoints) <> Length(aSide2.FPoints) then
begin
Result := False;
exit;
end;
for i := 0 to Length(aSide1.FPoints) - 1 do
begin
if not EQD(aSide1.FPoints[i].x, aSide2.FPoints[i].x) then
begin
Result := False;
exit;
end;
if not EQD(aSide1.FPoints[i].y, aSide2.FPoints[i].y) then
begin
Result := False;
exit;
end;
if not EQD(aSide1.FPoints[i].z, aSide2.FPoints[i].z) then
begin
Result := False;
exit;
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.CmpSides', E.Message);
end;
end;
end.