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

14099 lines
487 KiB
ObjectPascal

unit Form3d;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Keyboard, Dialogs, GLScene, GLObjects, GLWin32Viewer, GLMisc, GLTexture,
jpeg, StdCtrls, ExtCtrls, Buttons,PCTypesUtils,GLGeomObjects,VectorGeometry,
GLFile3DS, GLExtrusion, GLGraph, GLVectorFileObjects, GLPortal, GLSpaceText,GLMultiPolygon, VectorTypes,
GLHUDObjects, GLWaterPlane, GLBitmapFont, GLWindowsFont, LibJPeg, Form3d_Save,
siComp, siLngLnk, GLMesh, {U_Arch3D}U_Arch3DNew, ComCtrls, ImgList, cxControls,
cxContainer, cxEdit, cxTextEdit, cxMemo, cxMaskEdit, RzCmboBx,
cxLookAndFeelPainters, cxButtons, cxImage, RzButton, RzRadChk,
cxDropDownEdit, ExtDlgs, GLCadencer, glFPSMovement, GLNavigator, Menus, GeometryBB, Math,
cxGroupBox, U_Cad, U_SCSLists, RzTabs, U_ESCadClasess, PowerCad;
const
// Koeff Cam Move
kmPerspective = 0.1; //04.01.2012 â íåêîòîðûõ ìåñòàõ áûëî 0.132 è 0.12
kmOrthogonel = 0.003; //04.01.2012 0.03;
type
TPropViewType = (pvtNone, pvtSingleSide, pvtMultiSides, pvtSingle3ds, pvtMulti3ds,
pvtSingleConn, pvtMultiConn, pvtSingleLine, pvtMultiLine);
TToolMode = (tmSelect, tmCut);
TLineOrder = (loNone, loHorz, loVert, loRaise);
TCoord = (cX, cY, cZ);
TCutData = class(TMyObject)
Index11: Integer;
Index12: Integer;
Index21: Integer;
Index22: Integer;
end;
TResizeData = class(TMyObject)
BasisNodes: T3DPointArray;
Side1: TGLPolygon;
Side2: TGLPolygon;
Nodep11: TGLNode;
Nodep12: TGLNode;
Nodep21: TGLNode;
Nodep22: TGLNode;
Noder11: TGLNode;
Noder12: TGLNode;
Noder21: TGLNode;
Noder22: TGLNode;
Indexp11: Integer;
Indexp12: Integer;
Indexp21: Integer;
Indexp22: Integer;
Indexr11: Integer;
Indexr12: Integer;
Indexr21: Integer;
Indexr22: Integer;
end;
TPropRecord = class(TMyObject)
fName: string;
fDesc: TStringList;
fCoords: TList;
fRotate: string;
constructor Create;
end;
TVector3fArr = array of TVector3f;
Tfrm3D = class(TForm)
GLScene: TGLScene;
panMain: TPanel;
GLCamera: TGLCamera;
GLLightSource1: TGLLightSource;
GLLightSource2: TGLLightSource;
GLLightSource3: TGLLightSource;
GLLightSource4: TGLLightSource;
GLLightSource5: TGLLightSource;
panUpper: TPanel;
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
DummyCube: TGLDummyCube;
TransCube: TGLDummyCube;
GLPlane1: TGLPlane;
GLDummyCube1: TGLDummyCube;
GLHUDText1: TGLHUDText;
SpeedButton3: TSpeedButton;
SaveDialog: TSaveDialog;
lbViewType: TLabel;
lng_Forms: TsiLangLinked;
cbViewCeiling: TCheckBox;
Splitter1: TSplitter;
ImageList_Dir: TImageList;
panScene: TPanel;
GLSceneViewer: TGLSceneViewer;
panObjects: TPanel;
Splitter2: TSplitter;
Label10: TLabel;
OpenTexture: TOpenPictureDialog;
sbFirstFace: TSpeedButton;
MainCenter: TGLDummyCube;
GLCadencer: TGLCadencer;
pmModelTree: TPopupMenu;
nAdd3DObject: TMenuItem;
Open3DObject: TOpenDialog;
pmCut: TPopupMenu;
sbSaveModel: TSpeedButton;
nDeleteAllSubSides: TMenuItem;
FirstPerson: TGLDummyCube;
FirstPersonCamera: TGLCamera;
GLNavigator1: TGLNavigator;
GLFPSMovementManager1: TGLFPSMovementManager;
Edit1: TEdit;
Edit2: TEdit;
NDel3DObject: TMenuItem;
MatLib: TGLMaterialLibrary;
pcTree: TRzPageControl;
pcProps: TRzPageControl;
TabArchModel: TRzTabSheet;
TabScsModel: TRzTabSheet;
TabArchProps: TRzTabSheet;
TabScsProps: TRzTabSheet;
cxGroupBox1: TcxGroupBox;
cbLists: TcxComboBox;
cbObjectsTypes: TcxComboBox;
ModelTree: TTreeView;
Panel1: TPanel;
panName: TPanel;
Label2: TLabel;
edName: TcxTextEdit;
panDesc: TPanel;
Label3: TLabel;
btnEmpty: TSpeedButton;
mDesc: TcxMemo;
panCoords: TPanel;
Label4: TLabel;
Label8: TLabel;
Label9: TLabel;
Label11: TLabel;
edCoordX: TcxMaskEdit;
edCoordY: TcxMaskEdit;
edCoordZ: TcxMaskEdit;
cbCoordNbr: TcxComboBox;
panSideTexture: TPanel;
Label7: TLabel;
Label1: TLabel;
imgSideTexture: TcxImage;
bSideTextureChange: TcxButton;
bSideTextureClear: TcxButton;
cbSideHashs: TcxComboBox;
panRotate: TPanel;
Label5: TLabel;
Label37: TLabel;
Label27: TLabel;
Label28: TLabel;
edTextureRotate: TcxMaskEdit;
edTextureScale: TcxMaskEdit;
panMirror: TPanel;
Label6: TLabel;
cbMirror: TRzCheckBox;
panPos3ds: TPanel;
Label12: TLabel;
Label13: TLabel;
Label14: TLabel;
Label15: TLabel;
edPosX: TcxMaskEdit;
edPosY: TcxMaskEdit;
edPosZ: TcxMaskEdit;
panRotate3ds: TPanel;
Label16: TLabel;
Label17: TLabel;
Label18: TLabel;
Label19: TLabel;
Label24: TLabel;
Label25: TLabel;
Label26: TLabel;
edAngleX: TcxMaskEdit;
edAngleY: TcxMaskEdit;
edAngleZ: TcxMaskEdit;
panScale3ds: TPanel;
Label20: TLabel;
Label21: TLabel;
Label22: TLabel;
Label23: TLabel;
edScaleX: TcxMaskEdit;
edScaleY: TcxMaskEdit;
edScaleZ: TcxMaskEdit;
panObjectTexture: TPanel;
Label29: TLabel;
Label30: TLabel;
imgObjectTexture: TcxImage;
bObjectTextureChange: TcxButton;
cbObjectHashs: TcxComboBox;
bObjectTextureClear: TcxButton;
Panel2: TPanel;
panScsName: TPanel;
Label31: TLabel;
edScsName: TcxTextEdit;
panScsDesc: TPanel;
Label32: TLabel;
btnScsEmpty: TSpeedButton;
mScsDesc: TcxMemo;
cxGroupBox2: TcxGroupBox;
cbScsLists: TcxComboBox;
cbScsObjectsTypes: TcxComboBox;
ScsModelTree: TTreeView;
pmScsPopup: TPopupMenu;
nDivLine: TMenuItem;
panScsOffset: TPanel;
Label33: TLabel;
Label34: TLabel;
Label35: TLabel;
Label36: TLabel;
edScsOffsetX: TcxMaskEdit;
edScsOffsetY: TcxMaskEdit;
edScsOffsetZ: TcxMaskEdit;
panScsRotate: TPanel;
Label38: TLabel;
Label39: TLabel;
Label40: TLabel;
Label41: TLabel;
Label42: TLabel;
Label43: TLabel;
Label44: TLabel;
edScsAngleX: TcxMaskEdit;
edScsAngleY: TcxMaskEdit;
edScsAngleZ: TcxMaskEdit;
panScsScale: TPanel;
Label45: TLabel;
Label46: TLabel;
Label47: TLabel;
Label48: TLabel;
edScsScaleX: TcxMaskEdit;
edScsScaleY: TcxMaskEdit;
edScsScaleZ: TcxMaskEdit;
panScsObjectTexture: TPanel;
Label49: TLabel;
bScsLoadModel: TcxButton;
sbApplyScsModel: TSpeedButton;
edScsIndex: TcxMaskEdit;
Label50: TLabel;
mScsCaption: TcxMemo;
Label51: TLabel;
Label52: TLabel;
mScsNote: TcxMemo;
panScsLength: TPanel;
lbScsLength: TLabel;
edScsLength: TcxMaskEdit;
panScsConnCoords: TPanel;
Label54: TLabel;
Label55: TLabel;
Label56: TLabel;
Label57: TLabel;
edScsConnX: TcxMaskEdit;
edScsConnY: TcxMaskEdit;
edScsConnZ: TcxMaskEdit;
panScsLineCoords: TPanel;
Label58: TLabel;
Label59: TLabel;
Label60: TLabel;
Label61: TLabel;
edScsLineX1: TcxMaskEdit;
edScsLineY1: TcxMaskEdit;
edScsLineZ1: TcxMaskEdit;
lbScsLineX2: TLabel;
edScsLineX2: TcxMaskEdit;
lbScsLineY2: TLabel;
edScsLineY2: TcxMaskEdit;
lbScsLineZ2: TLabel;
edScsLineZ2: TcxMaskEdit;
Label65: TLabel;
lbScsLine2: TLabel;
cbShowTraceCaptions: TCheckBox;
TimerOnSelectNodes: TTimer;
Light: TGLLightSource;
GLLightFirstPerson: TGLLightSource;
sbView: TPanel;
Panel3: TPanel;
SpeedButton4: TSpeedButton;
procedure GLSceneViewerMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure GLSceneViewerMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
procedure SpeedButton1Click(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure GLHeightField1GetHeight(const x, y: Single; var z: Single;
var color: TVector4f; var texPoint: TTexPoint);
procedure FormMouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
procedure SpeedButton3Click(Sender: TObject);
procedure cbViewCeilingClick(Sender: TObject);
procedure GLSceneViewerDblClick(Sender: TObject);
procedure ModelTreeClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure cbCoordNbrCloseUp(Sender: TObject);
procedure bSideTextureClearClick(Sender: TObject);
procedure cbMirrorClick(Sender: TObject);
procedure mDescEnter(Sender: TObject);
procedure sbFirstFaceClick(Sender: TObject);
procedure bSideTextureChangeClick(Sender: TObject);
procedure GLCadencerProgress(Sender: TObject; const deltaTime,
newTime: Double);
procedure GLSceneViewerClick(Sender: TObject);
procedure cbHashsPropertiesCloseUp(Sender: TObject);
procedure nAdd3DObjectClick(Sender: TObject);
procedure ModelTreeMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure edNameExit(Sender: TObject);
procedure mDescExit(Sender: TObject);
procedure edPosXExit(Sender: TObject);
procedure edPosYExit(Sender: TObject);
procedure edPosZExit(Sender: TObject);
procedure edAngleXExit(Sender: TObject);
procedure edAngleYExit(Sender: TObject);
procedure edAngleZExit(Sender: TObject);
procedure edScaleXExit(Sender: TObject);
procedure edScaleYExit(Sender: TObject);
procedure edScaleZExit(Sender: TObject);
procedure edCoordXKeyPress(Sender: TObject; var Key: Char);
procedure edCoordXExit(Sender: TObject);
procedure edCoordYExit(Sender: TObject);
procedure edCoordZExit(Sender: TObject);
procedure edTextureRotateExit(Sender: TObject);
procedure edCoordYKeyPress(Sender: TObject; var Key: Char);
procedure edCoordZKeyPress(Sender: TObject; var Key: Char);
procedure edTextureRotateKeyPress(Sender: TObject; var Key: Char);
procedure edNameKeyPress(Sender: TObject; var Key: Char);
procedure mDescKeyPress(Sender: TObject; var Key: Char);
procedure edPosXKeyPress(Sender: TObject; var Key: Char);
procedure edPosYKeyPress(Sender: TObject; var Key: Char);
procedure edPosZKeyPress(Sender: TObject; var Key: Char);
procedure edAngleXKeyPress(Sender: TObject; var Key: Char);
procedure edAngleYKeyPress(Sender: TObject; var Key: Char);
procedure edAngleZKeyPress(Sender: TObject; var Key: Char);
procedure edScaleXKeyPress(Sender: TObject; var Key: Char);
procedure edScaleYKeyPress(Sender: TObject; var Key: Char);
procedure edScaleZKeyPress(Sender: TObject; var Key: Char);
procedure GLSceneViewerMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure sbSaveModelClick(Sender: TObject);
procedure nDeleteAllSubSidesClick(Sender: TObject);
procedure Edit2Exit(Sender: TObject);
procedure btnEmptyClick(Sender: TObject);
procedure NDel3DObjectClick(Sender: TObject);
procedure cbListsPropertiesCloseUp(Sender: TObject);
procedure cbObjectsTypesPropertiesCloseUp(Sender: TObject);
procedure edTextureScaleExit(Sender: TObject);
procedure edTextureScaleKeyPress(Sender: TObject; var Key: Char);
procedure cbObjectHashsPropertiesCloseUp(Sender: TObject);
procedure bObjectTextureClearClick(Sender: TObject);
procedure bObjectTextureChangeClick(Sender: TObject);
procedure MatLibTextureNeeded(Sender: TObject;
var textureFileName: String);
procedure pcTreeTabClick(Sender: TObject);
procedure cbScsListsPropertiesCloseUp(Sender: TObject);
procedure cbScsObjectsTypesPropertiesCloseUp(Sender: TObject);
procedure ScsModelTreeMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ScsModelTreeClick(Sender: TObject);
procedure bScsLoadModelClick(Sender: TObject);
procedure sbApplyScsModelClick(Sender: TObject);
procedure nDivLineClick(Sender: TObject);
procedure cbShowTraceCaptionsClick(Sender: TObject);
procedure TimerOnSelectNodesTimer(Sender: TObject);
procedure FormKeyPress(Sender: TObject; var Key: Char);
procedure SpeedButton4Click(Sender: TObject);
private
{ Private declarations }
procedure Rotate3DSObj(aObject: TGLFreeForm; aX, aY, aZ: Double);
procedure RotateConnModel(aObject: TGLFreeForm; aX, aY, aZ: Double);
procedure DeselectGLObjectsT;
public
{ Public declarations }
Factor: Double; //04.01.2012 Single;
mx, my : Integer;
mdx, mdy : Integer;
last_x, last_y: Integer;
FResizer: Boolean;
RStartPos1, RStartPos2, MovedStartPos, MovedStartPos1, MovedStartPos2: T3DPoint;
CPoint: T3DPoint;
OPoint: T3DPoint;
Camera: T3DPoint;
FZOrder: Double;
FGridStep: Double;
FToolMode: TToolMode;
FPropRecord: TPropRecord;
FNodesObjectsList: TList;
FCutDataList: TList;
FSelection: TList;
FPropObjects: TList;
FaceList: TList;
FResizeData: TResizeData;
FMovedObject, FRotatedObject: TGLFreeForm;
FMovedFullConnector: TGLFreeForm;
FMovedEmptyConnector: TGLCube;
FMovedLine: TGLLines;
FOffsetObjects, FRotatedObjects: Boolean;
F3DModel: T3DModel;
F3DStreamModel: T3DModel;
//FFileStream: String;
FIdsStream: TIntList;
FFilesStream: TStringList;
FMovedObjectsList: TList;
FShadowObjects: TList;
FCAD: TF_CAD; //16.09.2011 //#From Oleg#
FxObjects: TList;
FNodes: TList;
Procedure UpdateFaces(Faces: TList; Yh: Double = 0);
procedure UpdateModelTree;
procedure UpdateScsModelTree;
procedure UpdateModelTreeFromStream(Faces: TList);
procedure UpdateScsModelTreeFromStream(Faces: TList);
function CopySideProperties(aSide, aStrSide: T3DSide): T3DSide;
function CopySubSideProperties(aStrSubSide: T3DSide): T3DSide;
function CopyObjectProperties(aObject, aStrObject: T3DSObject): T3DSObject;
function CopyConnectorProperties(aObject, aStrObject: T3DConnector): T3DConnector;
function CopyLineProperties(aObject, aStrObject: T3DLine): T3DLine;
procedure CopyModelHash;
Procedure SetCubeBounds(var glCube:TGLCube;Points: T3dPointArray; Factor:Double);
Procedure AddWall(aWall: TGLMesh; vs: array of TVector3f);
Procedure AddFloor(aFloor: TGLMesh; vs: array of TVector3f; aSide: T3DSide);
procedure OnSelectNodes(aNodes: TList);
function FindGLObjectsByNodes(aNodes: TList): TList;
procedure SelectGLObjects(aObjects: TList);
procedure SelectGLObjects_GOOD(aObjects: TList);
procedure DeselectGLObjects;
function CheckGLObjectInSelectionNodes(aObject: TGLBaseSceneObject; aNodes: TList): Boolean;
function GetAllSidesNodesByNodes(aNodes: TList): TList;
function GetAllChildNodes(ANode: TTreeNode): TList;
function GetPropViewType(aNodes: TList): TPropViewType;
procedure OnLoadProperties(aObjects: TList);
function LoadTexture: string;
procedure SetAllPanels(aStatus: Boolean);
procedure SetAllScsPanels(aStatus: Boolean);
// Properties
function LoadPropertiesForSingleObject(aObject: TTreeNode): TPropRecord;
function LoadPropertiesForMultiObjects(aObjects: TList): TPropRecord;
function LoadPropertiesForSingle3ds(aObject: TTreeNode): TPropRecord;
function LoadPropertiesForMulti3ds(aObjects: TList): TPropRecord;
function LoadPropertiesForSingleConn(aObject: TTreeNode): TPropRecord;
function LoadPropertiesForMultiConn(aObjects: TList): TPropRecord;
function LoadPropertiesForSingleLine(aObject: TTreeNode): TPropRecord;
function LoadPropertiesForMultiLine(aObjects: TList): TPropRecord;
procedure ChangeName;
procedure ChangeDesc;
procedure ChangeCoordX;
procedure ChangeCoordY;
procedure ChangeCoordZ;
procedure ChangeTextureRotate;
procedure ChangeTextureScale;
procedure ChangePosX;
procedure ChangePosY;
procedure ChangePosZ;
procedure ChangeAngleX;
procedure ChangeAngleY;
procedure ChangeAngleZ;
procedure ChangeScaleX;
procedure ChangeScaleY;
procedure ChangeScaleZ;
procedure Set3DSObjectPos(aGLObject: TGLFreeForm);
procedure SetConnectorsOffset(aGLObjects: TList);
// **************************
procedure OnRightClick;
procedure RotateTextureToAngleM(aObject: T3DSide; aGLObject: TGLMesh; aAngle: Integer; aMirror: Boolean);
Procedure RotateTextureToAngleP(aObject: T3DSide; aGLObject: TGLPolygon; aAngle: Integer; aMirror: Boolean);
procedure SetPolygonTexture(aObject: TGLPolygon);
Function Rotate3DVector(vs0, vs1, vs2: TVector3f; Ang: Double): TVector3f;
Function GetImageFileByHash(aHash: string): string;
function GetTextureFileByHash(aHash: string): string;
Function GetObjectFileByHash(aHash: string): string;
Procedure Get3DSObjectBounds(var Min, Max: T3DPoint; aObject: TGLFreeForm);
Procedure GetRoomBounds(var Min, Max: T3DPoint; aFloor, aCeiling: T3DPointArray);
procedure DeleteNodesObjects;
procedure CreateNodesObjects(aObj: TGLPolygon);
procedure SelectNodesEvent(Sender: TObject);
procedure SetSideSizes;
procedure DoResize;
procedure AfterUpdate;
procedure CreateAddForDivSide(aSide, aAddSide: TGLPolygon);
procedure CreateAddForParentSide(aFirstSide, aSecondSide: TGLPolygon);
procedure SetSidesData;
procedure RefreshSidesPoints;
procedure SaveModelToStream(const AFile: String=''; AListID: Integer = 0);
procedure LoadModelFromStream(const AFile: String=''; AListID: Integer = 0);
procedure SyncModelFromStream(const AFile: String=''; AListID: Integer = 0; AFaces: TList=nil); //16.09.2011 //#From Oleg#
procedure GetModelData(Stream: TStream);
procedure SetModelData(Stream: TStream);
procedure SaveModelAddParamsToStream(const AFile: String='');
procedure GetFileData(Stream: TStream);
procedure CollectFileDataFromModel(Stream: TStream);
procedure LoadModelAddParamsFromStream(const AFile: String='');
procedure SetFileData(Stream: TStream);
procedure ExtractAllFiles(Stream: TStream);
function GetModelObjectByComponID(aComponID: Integer; aModelType: Byte = 1): TObject;
function GetSimilarSide(aSide: T3DSide; aObject: TObject): T3DSide;
function CmpSides(aSide1, aSide2: T3DSide): Boolean;
procedure ToggleTraceCaptions(AShow: Boolean);
procedure LoadSelectionData;
procedure FindSelectNodesByType(aType: Integer);
procedure FindSelectScsNodesByType(aType: Integer);
function is3DSObject(aObj: TGLBaseSceneObject): Boolean;
function isConnectorObject(aObj: TGLBaseSceneObject; aCmpObj: TGLBaseSceneObject = nil): Boolean;
function isLineObject(aObj: TGLBaseSceneObject; aCmpObj: TGLBaseSceneObject = nil): Boolean;
function GetDistAngle(AP1, AP2: TDoublePoint): Double;
procedure UndoCutSides;
//procedure SetFreeFormRotate(aObject: TGLFreeForm; aX, aY, aZ: Double);
//procedure ResetFreeFormRotate(aObject: TGLFreeForm);
procedure DoScale3dsObject(aWheelDelta: Integer);
procedure DoScaleConnectorObjects(aWheelDelta: Integer);
procedure DoRotate3dsObject(Shift: TShiftState; X, Y: Integer);
procedure DoRotateConnectorObjects(Shift: TShiftState; X, Y: Integer);
function GetPointToDivTrace(X, Y: Integer; aLine: TGLLines): T3DPoint;
function CanDrag(aObj: TGLBaseSceneObject; X, Y: Integer): Boolean;
procedure Move3DConnectorEvent(aObj: TGLBaseSceneObject);
procedure Move3DLineEvent(aObj: TGLBaseSceneObject);
procedure Move3DConnector(aObj: T3DConnector; dp: T3DPoint; AIsFirstObject: Boolean=false);
procedure Move3DRaiseConnector(aObj: T3DConnector; dp: T3DPoint);
procedure Move3DBetweenRaiseConnector(aObj: T3DConnector; dp: T3DPoint);
procedure Move3DLine(aObj: T3DConnector; aLine: T3DLine; aPos: T3DPoint);
procedure Trace3DConnector(aObj: TGLBaseSceneObject; dx, dy: Integer);
procedure Trace3DLine(aObj: TGLBaseSceneObject; dx, dy: Integer);
function Get3DConnectorByConnector(aConn: TConnectorObject): T3DConnector;
function Get3DLineByOrtholine(aLine: TOrthoLine): T3DLine;
function IsConnectorMoved(aConn: T3DConnector): Boolean;
function GetLineOrder(aLine: TGLLines): TLineOrder;
function GetFullConnectorInfo(aObj: TGLFreeForm): string;
function GetEmptyConnectorInfo(aObj: TGLCube): string;
function GetLineInfo(aObj: TGLLines): string;
function GetPosWithGridStep(aPos: Double): Double;
procedure ApplyCutting;
procedure ApplyScsModel;
procedure ValidateActiveControl;
procedure CreateModel;
procedure CreateTopNode;
procedure CreateTopSCSNode;
function GetKoefMoveCam: Double;
function GetPointsForNormal(arr: T3DPointArray): T3DPointArray;
function GLNodesTo3DCoords(aNodes: TGLNodes; aYAsZ: Boolean=false): T3DPointArray;
{$IF Defined(ES_GRAPH_SC)}
Procedure ChangeAllFiguresWithPoint(aPoint:T3DPoint; Coord: TCoord);
Procedure ChangeAllFiguresConnectedToModifyLine(aLine: TGLLines);
{$IFEND}
end;
var
frm3D: Tfrm3D;
glSide11, glSide21, glSide12, glSide22: TGLSpaceText;
glSpliter: TGLLines;
glCubeSpliter, glCubeSpliter1, glCubeSpliter2: TGLCube;
glConn1, glConn2: TGLCube;
glCursorObject: TGLCustomSceneObject;
glCursorLine: TGLLines;
rpos1, rpos2: T3DPoint;
ModelObjectsList: TList;
NoMoveEvent: Boolean = False;
SelObjColor, ObjColor: Tvector4f;
behav: TGLBFPSMovement;
yangle:double=90;
xangle:double=0;
// FTextures: TStringList;
FisCreate3DS: Boolean;
FCurrObject: TObject;
StartDragX: Integer = -999;
StartDragY: Integer = -999;
Gtx: double;
//Alex(20.12.2010)
FirstCameraPosIsSet:Boolean = False;
implementation
uses U_BaseConstants, U_Constants, U_BaseCommon, U_Common, U_SCSComponent, u_main,
PCDrawBox, U_ProtectionCommon, fplan, USCS_Main, U_ArchCommon;
{$R *.dfm}
//
// Classic mouse movement bits
//
{$IF Defined(ES_GRAPH_SC)}
function GetCornerIndex(Selections: TList): integer;
var i: integer;
begin
result := 0;
for i := 0 to Selections.Count - 1 do
if TObject(TTreeNode(TGLBaseSceneObject(Selections[i]).TagObject).Data) is T3dCorner then
begin
Result := i;
break;
end;
end;
{$IFEND}
procedure Tfrm3D.GLSceneViewerMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
Obj: TGLBaseSceneObject;
xStr: string;
begin
mx := x;
my := y;
mdx := x;
mdy := y;
if GLSceneViewer.Camera = FirstPersonCamera then
exit;
Obj := GlsceneViewer.Buffer.GetPickedobject(X, Y);
if Button = mbLeft then
begin
if FToolMode = tmCut then
begin
Obj := GlsceneViewer.Buffer.GetPickedobject(X, Y);
if Obj = glCubeSpliter then
begin
glCursorObject.Position.x := glCubeSpliter.Position.x;
glCursorObject.Position.y := glCubeSpliter.Position.y;
glCursorObject.Position.z := glCubeSpliter.Position.z;
FResizer := True;
end;
if Obj = glCubeSpliter1 then
begin
glCursorObject.Position.x := glCubeSpliter1.Position.x;
glCursorObject.Position.y := glCubeSpliter1.Position.y;
glCursorObject.Position.z := glCubeSpliter1.Position.z;
FResizer := True;
end;
if Obj = glCubeSpliter2 then
begin
glCursorObject.Position.x := glCubeSpliter2.Position.x;
glCursorObject.Position.y := glCubeSpliter2.Position.y;
glCursorObject.Position.z := glCubeSpliter2.Position.z;
FResizer := True;
end;
end;
if FToolMode = tmSelect then
begin
// Move 3ds Object
if (Obj <> nil) and (Obj is TGLFreeForm) then
if (FSelection.Count = 1) and (TGLBaseSceneObject(FSelection[0]) = Obj) then
FMovedObject := TGLFreeForm(Obj);
if (Obj <> nil) and (Obj is TGLFreeForm) then
begin
// Offset Connector Model
if (ssCtrl in Shift) then
begin
if (FSelection.Count > 0) and (isConnectorObject(Obj)) then
FOffsetObjects := True;
end
else
// Move Connector Object
begin
if (FSelection.Count = 1) and (isConnectorObject(TGLBaseSceneObject(FSelection[0]), Obj)) then
begin
FMovedFullConnector := TGLFreeForm(Obj);
glCursorObject.Position.x := FMovedFullConnector.Position.x;
glCursorObject.Position.y := FMovedFullConnector.Position.y;
glCursorObject.Position.z := FMovedFullConnector.Position.z;
MovedStartPos.x := FMovedFullConnector.Position.x;
MovedStartPos.y := FMovedFullConnector.Position.y;
MovedStartPos.z := FMovedFullConnector.Position.z;
StartDragX := X;
StartDragY := Y;
sbView.Caption := GetFullConnectorInfo(FMovedFullConnector);
end;
end;
end;
// Move Clean Connector
if (Obj <> nil) and (Obj is TGLCube) then
if (Obj = glConn1) or (Obj = glConn2) then
begin
FMovedEmptyConnector := TGLCube(Obj);
glCursorObject.Position.x := FMovedEmptyConnector.Position.x;
glCursorObject.Position.y := FMovedEmptyConnector.Position.y;
glCursorObject.Position.z := FMovedEmptyConnector.Position.z;
MovedStartPos.x := FMovedEmptyConnector.Position.x;
MovedStartPos.y := FMovedEmptyConnector.Position.y;
MovedStartPos.z := FMovedEmptyConnector.Position.z;
StartDragX := X;
StartDragY := Y;
sbView.Caption := GetEmptyConnectorInfo(FMovedEmptyConnector);
end;
// Move Line Object
if (Obj <> nil) and (Obj is TGLLines) then
{$IF Defined(ES_GRAPH_SC)}
if FSelection.Count <= 3 then
if isLineObject(TGLBaseSceneObject(FSelection[GetCornerIndex(FSelection)]), Obj) then
{$ELSE}
if FSelection.Count = 1 then
if isLineObject(TGLBaseSceneObject(FSelection[0]), Obj) then
{$IFEND}
begin
FMovedLine := TGLLines(Obj);
glCursorLine.Nodes[0].X := FMovedLine.Nodes[0].X;
glCursorLine.Nodes[0].Y := FMovedLine.Nodes[0].Y;
glCursorLine.Nodes[0].Z := FMovedLine.Nodes[0].Z;
glCursorLine.Nodes[1].X := FMovedLine.Nodes[1].X;
glCursorLine.Nodes[1].Y := FMovedLine.Nodes[1].Y;
glCursorLine.Nodes[1].Z := FMovedLine.Nodes[1].Z;
MovedStartPos1.x := FMovedLine.Nodes[0].X;
MovedStartPos1.y := FMovedLine.Nodes[0].Y;
MovedStartPos1.z := FMovedLine.Nodes[0].Z;
MovedStartPos2.x := FMovedLine.Nodes[1].X;
MovedStartPos2.y := FMovedLine.Nodes[1].Y;
MovedStartPos2.z := FMovedLine.Nodes[1].Z;
StartDragX := X;
StartDragY := Y;
sbView.Caption := GetLineInfo(FMovedLine);
end;
end;
end
else
if Button = mbRight then
begin
if (Obj <> nil) and (Obj is TGLFreeForm) then
if (FSelection.Count = 1) and (TGLBaseSceneObject(FSelection[0]) = Obj) then
begin
FRotatedObject := TGLFreeForm(Obj);
last_x := x;
last_y := y;
end;
if (Obj <> nil) and (Obj is TGLFreeForm) then
if isConnectorObject(Obj) then
begin
FRotatedObjects := True;
last_x := x;
last_y := y;
end;
end;
end;
{$IF Defined(ES_GRAPH_SC)}
Procedure Tfrm3D.ChangeAllFiguresConnectedToModifyLine(aLine: TGLLines); //Ïðîöåäóðà ïåðåðèñîâêè ôèãóð, ïðèñîåäåíåííûõ ê êëèíèè aLine
var
j,k: integer;
//xNode: TtreeNode;
GLPoint: T3DPoint;
aLinePoints: T3DPointArray;
GlNode: TGLNodes;
GlLineNode: TGLLinesNodes;
xGLObject: TGLBaseSceneObject;
xSide: T3dSide;
xLine: T3DWall;
xCorner: T3dCorner;
begin
/////////////////////////// ROOF /////////////////////////////
if (StartDragX = -999) and (StartDragY = -999) then
begin
SetLength(aLinePoints,2); //Óñòàíàâëèâàåì äëèíó ìàññèâà â 2
//Çàïîëíÿåì ìàññèâ òî÷åê
aLinePoints[0] := DoublePoint(aLIne.Nodes[0].X,aLIne.Nodes[0].Y,aLIne.Nodes[0].Z);
aLinePoints[1] := DoublePoint(aLIne.Nodes[1].X,aLIne.Nodes[1].Y,aLIne.Nodes[1].Z);
//Ïðîõîäèìñÿ ïî âñåì ýëåìåíòàì, êîòîðûå âèäíû â 3Ä
for j := 0 to DummyCube.Count - 1 do
begin
xLine := nil;
xCorner := nil;
if DummyCube.Children[j] is TGLPolygon then //Åñëè ôèãóðà - ïîëèãîí
begin
GlNode := TGLPolygon(DummyCube.Children[j]).Nodes;
//Ïðîõîäèì ïî âñåì òî÷êàì ôèãóðû
for k := 0 to GlNode.Count - 1 do
begin
GLPoint := DoublePoint(GlNode[k].X,GlNode[k].y,GlNode[k].z); //Ïðåîáðàçîâûâàåì òî÷êè ôèãóðû â óäîáíûé âèä
if EQDPZ(GLPoint,MovedStartPos1) then //Åñëè íàøëè òðåáóåìóþ òî÷êó
begin
if TOBject(TTreeNode(TGLPolygon(DummyCube.Children[j]).TagObject).Data) is T3DSide then
begin
xSide := T3DSide(TTreeNode(TGLPolygon(DummyCube.Children[j]).TagObject).Data);
xGLObject := TGLBaseSceneObject(xSide.FGLObject);
end;
//Ìåíÿåì íàéäåííîé òî÷êå êîîðäèíàòû 3Ä/////
GlNode[k].X := aLinePoints[0].x; //
GlNode[k].Y := aLinePoints[0].y; //
GlNode[k].Z := aLinePoints[0].z; //
//Ìåíÿå êîîðäèíàòû ýëåìåíòà â äåðåâå/////////////////
xSide.FGLPoints[k] := aLinePoints[0]; //
xSide.FPoints[k].X := aLinePoints[0].x / Factor; //
xSide.FPoints[k].Y := aLinePoints[0].y / Factor; //
xSide.FPoints[k].Z := aLinePoints[0].z / Factor; //
end;
//âñå òî æå ñàìîå, ÷òî è ñ òî÷êîé 1
if EQDPZ(GLPoint,MovedStartPos2) then
begin
if TOBject(TTreeNode(TGLPolygon(DummyCube.Children[j]).TagObject).Data) is T3DSide then
begin
xSide := T3DSide(TTreeNode(TGLPolygon(DummyCube.Children[j]).TagObject).Data);
xGLObject := TGLBaseSceneObject(xSide.FGLObject);
end;
GlNode[k].X := aLinePoints[1].x;
GlNode[k].Y := aLinePoints[1].y;
GlNode[k].Z := aLinePoints[1].z;
xSide.FGLPoints[k] := aLinePoints[1];
xSide.FPoints[k].X := aLinePoints[1].x / Factor;
xSide.FPoints[k].Y := aLinePoints[1].y / Factor;
xSide.FPoints[k].Z := aLinePoints[1].z / Factor;
end;
end;
end;
if DummyCube.Children[j] is TGLLines then //Åñëè ôèãóðà - ýòî ëèíèÿ
begin
GlLineNode := TGLLines(DummyCube.Children[j]).Nodes;
for k := 0 to GlLineNode.Count - 1 do
begin
GLPoint := DoublePoint(GlLineNode[k].X,GlLineNode[k].Y,GlLineNode[k].Z);
if EQDPZ(GLPoint,MovedStartPos1) then
begin
//Ëèíèè ìîãóò áèòü äâóõ âèäîâ: óãîë - Ýòî T3DCorner, Ãðàíü êðûøè - ýòî T3DWall
if TOBject(TTreeNode(TGLPolygon(DummyCube.Children[j]).TagObject).Data) is T3DWall then
begin
xLine := T3DWall(TTreeNode(TGLPolygon(DummyCube.Children[j]).TagObject).Data);
xGLObject := TGLBaseSceneObject(xLine.FGLObject);
end;
if TOBject(TTreeNode(TGLPolygon(DummyCube.Children[j]).TagObject).Data) is T3DCorner then
begin
xCorner := T3DCorner(TTreeNode(TGLPolygon(DummyCube.Children[j]).TagObject).Data);
xGLObject := TGLBaseSceneObject(xCorner.FGLObject);
end;
GlLineNode[k].X := aLinePoints[0].x;
GlLineNode[k].Y := aLinePoints[0].y;
GlLineNode[k].Z := aLinePoints[0].z;
if TObject(TTreenode(TGLLines(DummyCube.Children[j]).TagObject).Data) is T3dCorner then
begin
GlLineNode[k+1].X := aLinePoints[0].x;
GlLineNode[k+1].Y := aLinePoints[0].Y + (1 * Factor + FDeltaZ);
GlLineNode[k+1].Z := aLinePoints[0].z;
end;
if xLine <> nil then
begin
xLine.FGLPOints[k] := aLinePoints[0];
xLine.FPoints[k].x := aLinePoints[0].x / Factor;
xLine.FPoints[k].y := aLinePoints[0].y / Factor;
xLine.FPoints[k].z := aLinePoints[0].z / Factor;
end;
if xCorner <> nil then
begin
xCorner.FGLPOints[k] := aLinePoints[0];
xCorner.FPoints.x := aLinePoints[0].x / Factor;
xCorner.FPoints.y := aLinePoints[0].y / Factor;
xCorner.FPoints.z := aLinePoints[0].z / Factor;
end;
end;
if EQDPZ(GLPoint,MovedStartPos2) then
begin
if TOBject(TTreeNode(TGLPolygon(DummyCube.Children[j]).TagObject).Data) is T3DWall then
begin
xLine := T3DWall(TTreeNode(TGLPolygon(DummyCube.Children[j]).TagObject).Data);
xGLObject := TGLBaseSceneObject(xLine.FGLObject);
end;
if TOBject(TTreeNode(TGLPolygon(DummyCube.Children[j]).TagObject).Data) is T3DCorner then
begin
xCorner := T3DCorner(TTreeNode(TGLPolygon(DummyCube.Children[j]).TagObject).Data);
xGLObject := TGLBaseSceneObject(xCorner.FGLObject);
end;
GlLineNode[k].X := aLinePoints[1].x;
GlLineNode[k].Y := aLinePoints[1].y;
GlLineNode[k].Z := aLinePoints[1].z;
if TObject(TTreenode(TGLLines(DummyCube.Children[j]).TagObject).Data) is T3dCorner then
begin
GlLineNode[k+1].X := aLinePoints[1].x;
GlLineNode[k+1].Y := aLinePoints[1].Y + (1 * Factor + FDeltaZ);
GlLineNode[k+1].Z := aLinePoints[1].z;
end;
if xLine <> nil then
begin
xLine.FGLPOints[k] := aLinePoints[1];
xLine.FPoints[k].x := aLinePoints[1].x / Factor;
xLine.FPoints[k].y := aLinePoints[1].y / Factor;
xLine.FPoints[k].z := aLinePoints[1].z / Factor;
end;
if xCorner <> nil then
begin
xCorner.FGLPOints[k] := aLinePoints[1];
xCorner.FPoints.x := aLinePoints[1].x / Factor;
xCorner.FPoints.y := aLinePoints[1].y / Factor;
xCorner.FPoints.z := aLinePoints[1].z / Factor;
end;
end;
end;
end;
end;
end;
////////////////////////// \ROOF /////////////////////////////
end;
{$IFEND}
procedure Tfrm3D.GLSceneViewerMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
i, j, dx, dy : Integer;
v : TVector;
mp: TPoint;
ip : TVector;
tileX, tileY : Integer;
shiftDown : Boolean;
mip, translateOffset : TVector;
translating : Boolean;
koefcam: Double; //04.01.2012 single;
//vx,vz: single;
spd: Double; //04.01.2012 single;
dw,dh: integer;
xObj: TGLBaseSceneObject;
VX, VY: TVector;
Camera: TGLCamera;
glObject, glObject1: TGLFreeForm;
xObject: T3DSObject;
AngX, AngY, AngZ: Double;
xConn: T3DConnector;
VX3, VY3, V3: TVector3f;
begin
if NoMoveEvent then
begin
NoMoveEvent := False;
mx := x;
my := y;
end;
shiftDown:=(IsKeyDown(VK_LSHIFT) or IsKeyDown(VK_RSHIFT));
dx := mx - x;
dy := my - y;
if (dx = 0) and (dy = 0) then
exit;
if GLSceneViewer.Camera = FirstPersonCamera then
exit;
Camera := GLSceneViewer.Camera;
// SELECT MODE
//if FToolMode = tmSelect then
if not FResizer then
begin
if ssLeft in Shift then
begin
// Do Move 3ds Object
if FMovedObject <> nil then
begin
GLSceneViewer.Cursor := crHandPoint;
VY := VectorMake(VectorPerpendicular(YVector, VectorNormalize(VectorSubtract(Camera.Position.AsAffineVector, MainCenter.Position.AsAffineVector))));
VX := VectorCrossProduct(VY, VectorNormalize( VectorSubtract(Camera.Position.AsVector, MainCenter.Position.AsVector)));
NormalizeVector(VY);
NormalizeVector(VX);
FMovedObject.Position.Translate(VectorCombine(VX, VY, -dx * 0.132 * Camera.DistanceToTarget / Camera.FocalLength, dy * 0.132 * Camera.DistanceToTarget / Camera.FocalLength));
end
// Do Move Fulll Connector
else if FMovedFullConnector <> nil then
begin
if CanDrag(FMovedFullConnector, X, Y) then
Trace3DConnector(FMovedFullConnector, dx, dy);
end
// Do Move Empty Connector
else if FMovedEmptyConnector <> nil then
begin
if CanDrag(FMovedEmptyConnector, X, Y) then
Trace3DConnector(FMovedEmptyConnector, dx, dy);
end
// Do Move Line
else if FMovedLine <> nil then
begin
if CanDrag(FMovedLine, X, Y) then
Trace3DLine(FMovedLine, dx, dy);
end
// Do Offset Connector Model
else if (ssCtrl in Shift) and FOffsetObjects then
// ********************* Offset ******************************************
begin
GLSceneViewer.Cursor := crHandPoint;
VY := VectorMake(VectorPerpendicular(YVector, VectorNormalize(VectorSubtract(Camera.Position.AsAffineVector, MainCenter.Position.AsAffineVector))));
VX := VectorCrossProduct(VY, VectorNormalize( VectorSubtract(Camera.Position.AsVector, MainCenter.Position.AsVector)));
NormalizeVector(VY);
NormalizeVector(VX);
for i := 0 to FSelection.Count - 1 do
begin
glObject := TGLFreeForm(FSelection[i]);
{$IF Defined(ES_GRAPH_SC)}
if TObject(TTreeNode(glObject.tagObject).Data) is T3DConnector then
begin
xConn := T3DConnector(TTreeNode(glObject.tagObject).Data);
glObject1 := TGLFreeForm(xConn.FGLObject1);
glObject1.Position.Translate(VectorCombine(VX, VY, -dx * 0.132 * Camera.DistanceToTarget / Camera.FocalLength, dy * 0.132 * Camera.DistanceToTarget / Camera.FocalLength));
end;
{$ELSE}
xConn := T3DConnector(TTreeNode(glObject.tagObject).Data);
glObject1 := TGLFreeForm(xConn.FGLObject1);
glObject1.Position.Translate(VectorCombine(VX, VY, -dx * 0.132 * Camera.DistanceToTarget / Camera.FocalLength, dy * 0.132 * Camera.DistanceToTarget / Camera.FocalLength));
{$IFEND}
end;
end
// ********************* Offset ******************************************
else
begin
if GLSceneViewer.Camera = GLCamera then
begin
GLSceneViewer.Camera.MoveAroundTarget(my - y, mx - x);
end;
//Alex(17.12.2010) Çàêîìåíòèðîâàë äâèæåíèå êàìåðû ìûøêîé ïðè âèäå îò ïåðâîãî ëèöà
{else if GLSceneViewer.Camera = GLCameraFirstPerson then
begin
GLSceneViewer.Camera.MoveAroundTarget(my - y, mx - x);
//GLSceneViewer.Camera.pitch(my - y);
//DummyCube.Turn(mx - x);
//GLSceneViewer.Camera.Turn(my - y);
//GLSceneViewer.Camera.Roll(mx - x);
end; }
end;
end
else
//Alex(22.12.2010) Åñëè FirstPerson òî íå ïåðåìåùàåì
if ((ssRight in Shift) and (GLSceneViewer.Camera <> FirstPersonCamera)) then
begin
// ********************* Rotate ******************************************
if (FRotatedObject <> nil) then
begin
DoRotate3dsObject(Shift, X, Y);
end
else if FRotatedObjects then
begin
DoRotateConnectorObjects(Shift, X, Y);
end
// ********************* Rotate ******************************************
else
begin
if GLSceneViewer.Camera.CameraStyle = csPerspective then
koefcam := 0.12
else
koefcam := 0.03;
if GLSceneViewer.Camera.Position.Y < 0 then
v := GLSceneViewer.Camera.ScreenDeltaToVectorXZ(-dx, -dy, koefcam * GLSceneViewer.Camera.DistanceToTarget / GLSceneViewer.Camera.FocalLength)
else
v := GLSceneViewer.Camera.ScreenDeltaToVectorXZ(-dx, dy, koefcam * GLSceneViewer.Camera.DistanceToTarget / GLSceneViewer.Camera.FocalLength);
GLDummyCube1.Position.Translate(v);
DummyCube.Position.Translate(v);
TransCube.Position.Translate(v);
//Alex(22.12.2010)
FirstPerson.Position.Translate(v);
GLSceneViewer.Camera.TransformationChanged;
end;
end;
end;
// Ðåæèì Ðàçðåçêè (Resizing)
if (FToolMode = tmCut) then
begin
// ïîècê îáüåêòà äëÿ ðåñàéçèíãà
if not FResizer then
begin
if Shift = [] then
begin
xObj := GLSceneViewer.Buffer.GetPickedobject(X, Y);
if (xObj = glCubeSpliter) or (xObj = glCubeSpliter1) or (xObj = glCubeSpliter2) then
GLSceneViewer.Cursor := crSizeAll
else
GLSceneViewer.Cursor := crDefault;
end;
end
else
// Äâèæåíèå ðåñàéçèíãà
begin
VY := VectorMake(VectorPerpendicular(YVector, VectorNormalize(VectorSubtract(Camera.Position.AsAffineVector, MainCenter.Position.AsAffineVector))));
VX := VectorCrossProduct(VY, VectorNormalize( VectorSubtract(Camera.Position.AsVector, MainCenter.Position.AsVector)));
NormalizeVector(VY);
NormalizeVector(VX);
glCursorObject.Position.Translate(VectorCombine(VX, VY, -dx * 0.132 * Camera.DistanceToTarget / Camera.FocalLength, dy * 0.132 * Camera.DistanceToTarget / Camera.FocalLength));
DoResize;
end;
end;
mx := x;
my := y;
end;
procedure Tfrm3D.UpdateFaces(Faces: TList; Yh: Double = 0);
var
i, pCnt, pCntNormal, j, k, FigureID: Integer;
Face:TFaceRecord;
glPoly:TGLPolyGon;
glLine: TGLLines;
glCube: TGLCube;
glSphere: TGLSphere;
glCenter: TGLDummyCube;
glPipe: TGLPipe;
p, p1, p2, p3, p4, p5, p6, p7, p8, normal: T3dPoint;
TmpP: T3dPoint;
tx,ty,tz,bx,by,bz,cx,cy,cz: Double;
glObject: TGLBaseSceneObject;
glObjClass: TGLSceneObjectClass;
glObject1: TGLBaseSceneObject;
glObjClass1: TGLSceneObjectClass;
SCSCatalog: TSCSCatalog;
xoffset, aScaleModel: Double; //04.01.2012 single;
aColorModel: TVector4f;
glWallSide, glFloor, glCeiling, glDoorSide, glWindowSide, glBalconDoorSide, glBalconWindowSide: TGLPolygon;
gl3DSObject, glModelObject: TGLFreeForm;
aColor: TVector4f;
tmpdir, ImgName, ImgName1: string;
WallCoords: array [0..5] of TVector3f;
FloorCoords: array of TVector3f;
NormalPoints: T3DPointArray; //19.06.2012 - Êîîðäèíàòû äëÿ îïðåäåëåíèÿ íîðìàëè
BegCoordIndex: integer;
xNode: TTreeNode;
xSide: T3DSide; //ýòî òå îáüåêòû ïîëèãîíîâ è ìýøåé, êîòîðûå äîáàâëÿþòñÿ â Faces è îòðèñîâûâàþòñÿ
xObject: T3DSObject; //îáúåêòû ñ 3ds
xConn: T3DConnector; //Êîíåêòîð
xLine: T3DLine; //Ëèíèÿ
//**ROOF**
ParentWallNOde,WallNode, CornerNode: TTreeNode;
Wall: T3DWall;
iWall, iModelCnt, iCorner: Integer;
xCorner: T3DCorner;
pArr: TDoublePointArr;
isRoof,IsAperture: boolean;
xNet:TNet;
//*\ROOF**
PrevxNode: TTreeNode;
PrevxSide: T3DSide;
Angle1, Angle2, ResAng: Double;
dp1, dp2: TDoublePoint;
pN, pP: TVector3f;
//Alex(22.12.2010)
xRoom: T3DRoom;
RoomMin, RoomMax, RoomSize, SetPos, Scale: T3DPoint;
//19.06.2012 - âåðíåò êîîðäèíàòû äëÿ îïðåäåëåíèÿ íîðìàëè
{function GetPointsForNormal(arr: T3DPointArray): T3DPointArray;
var
i, j: Integer;
ChkPt, LineP1, LineP2: P3DPoint;
ProjPoint: T3DPoint;
ValidPt: Boolean;
begin
SetLength(Result, 0);
for i := 0 to Length(arr) - 1 do
begin
ChkPt := @arr[i];
ValidPt := true;
if Length(Result) >= 2 then
begin
// Ïðîâåðÿåì åñòü ëè òàêàÿ óæå
for j := 0 to Length(Result) - 1 do
if EQDP(ChkPt^, Result[j]) then
begin
ValidPt := false;
Break; //// BREAK ////
end;
if ValidPt then
begin
// Åñëè ïîñëåäíÿÿ äîáàâëåííàÿ â ðåçóëüòàòû íà îäíîé ëèíèè ñ äîáàâëÿåìîé
LineP1 := @Result[Length(Result)-1];
LineP2 := @Result[Length(Result)-2];
if IsPointInLine(LineP2^, ChkPt^, LineP1^, 1, 0) then
begin
////Result[Length(Result)-1] := ChkPt^;
LineP1^ := ChkPt^;
ValidPt := false;
end
else
// Åñëè òî÷êà íå íàëèíè, ïðîâåðÿåì íå ðÿäîì ëè îíà, ÷åðåç ïðîåöèðîâàíèå åå íà ëèíèþ
begin
ProjPoint := LineP1^;
PointToLineByAngle(LineP2^, ChkPt^, ProjPoint);
if GetLineLength(LineP1^, ProjPoint) < 4 then
begin
//LineP1^ := ChkPt^;
//ValidPt := false;
end;
end;
end;
end;
if ValidPt then
begin
SetLength(Result, Length(Result) + 1);
Result[Length(Result) - 1] := arr[i];
end;
end;
end;}
begin
try
TimerOnSelectNodes.OnTimer := nil;
FaceList := Faces;
IsRoof := false;
{$IF Not Defined(ES_GRAPH_SC)}
Factor := 0.15;
{$ELSE}
Factor := 0.15 * 10 / FScaleDelta;
{$IFEND}
FGridStep := FCAD.PCad.GridStep * factor;
tmpdir := GetWorkDir; // ExtractDirByCategoryType(dctPictures);
PrevxSide := nil;
PrevxNode := nil;
//Åñëè åñòü êàêèå ëèáî îáúåêòû â DummyCube, î÷èùÿåì åãî////
for i := 0 to DummyCube.Count - 1 do //
begin //
if not (DummyCube.Children[i] is TGLCamera) then //
DummyCube.Children[i].DeleteChildren; //
end; //
TransCube.DeleteChildren; //
// Beg - 2011-05-10
//LoadModelFromStream(FFileStream);
//if F3DStreamModel = nil then
// UpdateModelTree
//else
// UpdateModelTreeFromStream(Faces);
// End - 2011-05-10
//// *********** FACES.COUNT *************************************************
for i := 0 to Faces.Count - 1 do
begin
IsAperture := false;
Face := TFaceRecord(faces[i]); //òèïî ïåðåãîíÿåì çàïèñü ëèñòà â êåêîðä
xNode := Face.FTreeNode;
xConn := T3DConnector(Face.F3DObject);
//if xConn <> nil then
// beep;
xSide := nil;
xObject := nil;
if xNode <> nil then
begin
PrevxSide := xSide;
PrevxNode := xNode;
end
else
begin
if Face.RecType = ftNetPath then
begin
xNode := PrevxNode;
Face.FTreeNode := PrevxNode;
end;
end;
pCnt := Length(Face.Points);
for k := 0 to pCnt - 1 do
begin
p := Face.Points[k];
p := DoublePoint(p.x,p.z,p.y);
if (i = 0) and (k = 0) then
begin
tx := p.x; ty := p.y; tz := p.z;
bx := p.x; by := p.y; bz := p.z;
end
else
begin
if p.x > tx then tx := p.x;
if p.x < bx then bx := p.x;
if p.y > ty then ty := p.y;
if p.y < by then by := p.y;
if p.z > tz then tz := p.z;
if p.z < bz then bz := p.z;
end;
end;
case Face.RecType of
ftPolygon: glObjClass := TGLPolyGon;
ftLine : glObjClass := TGLLines;
ftPipe,ftBar : glObjClass := TGLPipe;
ftSphere: glObjClass := TGLSphere;
ftCenterCUbe: glObjClass := TGLDummyCube;
ftNetPath: glObjClass := TGLPolygon;
ftNetFloor: glObjClass := TGLPolygon;
ftNetCeiling: glObjClass := TGLPolygon;
ftNetDoor: glObjClass := TGLPolygon;
ftNetWindow: glObjClass := TGLPolygon;
ftNetBalconDoor: glObjClass := TGLPolygon;
ftNetBalconWindow: glObjClass := TGLPolygon;
ftNetFrame: glObjClass := TGLPolygon;
ftNet3DSObject: glObjClass := TGLFreeForm;
end;
if face.OpTrans then
begin
//glObject := TransCube.AddNewChild(glObjClass);
glObject := DummyCube.AddNewChild(glObjClass);
end
else
begin
glObject := DummyCube.AddNewChild(glObjClass); //Äîáàâëåíèå òèïî ôèãóðó â DummyCube
end;
glObject.TagObject := xNode;
if xNode <> nil then
begin
// 3DS Object
if Face.RecType = ftNet3DSObject then
begin
xObject := T3DSObject(xNode.Data);
xObject.FZOrder := FZOrder * UOMToMetre(1000 / FCAD.PCad.MapScale) * factor;
xObject.FGLObject := glObject;
end
else if Face.RecType = ftPipe then
// 3D Connector
begin
xConn := T3DConnector(xNode.Data);
xConn.FZOrder := FZOrder * UOMToMetre(1000 / FCAD.PCad.MapScale) * factor;
if xConn.FGLObject = nil then
xConn.FGLObject := glObject;
end
else if Face.RecType = ftLine then
// 3D Line
begin
xLine := T3DLine(xNode.Data);
xLine.FZOrder := FZOrder * UOMToMetre(1000 / FCAD.PCad.MapScale) * factor;
if xLine.FGLObject = nil then
xLine.FGLObject := glObject;
end
else
// Arch Objects
begin
xSide := T3DSide(xNode.Data);
xSide.FZOrder := FZOrder * UOMToMetre(1000 / FCAD.PCad.MapScale) * factor;
if Face.RecType = ftNetFloor then
begin
T3DRoom(xSide.FParent).FZOrder := xSide.FZOrder;
end;
// òîëüêî äëÿ ïåðâîé äåëàòü
if xSide.FGLObject = nil then
xSide.FGLObject := glObject;
end;
end
else if xConn <> nil then
begin
xConn.FZOrder := FZOrder * UOMToMetre(1000 / FCAD.PCad.MapScale) * factor;
xConn.FGLObject := glObject;
end;
if xSide <> nil then
begin
if Pos('empty', AnsiLowerCase(xSide.FDescription.Text)) = 1 then
begin
if GLObject <> nil then
GLObject.Visible := False;
if xNode <> nil then
if xNode.ImageIndex < 999 then
begin
xNode.ImageIndex := xNode.ImageIndex + 1000;
xNode.SelectedIndex := xNode.ImageIndex;
end;
end
else
begin
if GLObject <> nil then
GLObject.Visible := True;
//Ýòî êàðòèíêà, êîòîðàÿ îòîáðàæàåòñÿ â ModelTree
if xNode <> nil then
if xNode.ImageIndex > 999 then
begin
xNode.ImageIndex := xNode.ImageIndex - 1000;
xNode.SelectedIndex := xNode.ImageIndex;
end;
end;
end;
case Face.RecType of
ftPolygon: glPoly := TGLPolyGon(glObject);
ftLine : glLine := TGLLines(glObject);
ftPipe,ftBar : glPipe := TGLPipe(glObject);
ftSphere: glSphere := TGLSphere(glObject);
ftCenterCube: glCenter := TGLDummyCube(glObject);
ftNetPath: glWallSide := TGLPolygon(glObject);
ftNetFloor: glFloor := TGLPolygon(glObject);
ftNetCeiling: glCeiling := TGLPolygon(glObject);
ftNetDoor: glDoorSide := TGLPolyGon(glObject);
ftNetWindow: glWindowSide := TGLPolyGon(glObject);
ftNetBalconDoor: glBalconDoorSide := TGLPolyGon(glObject);
ftNetBalconWindow: glBalconWindowSide := TGLPolyGon(glObject);
ftNet3DSObject: gl3DSObject := TGLFreeForm(glObject);
end;
// ADD ZORDER TO Z
//Íà ðóññêîì çâó÷èò ïðèìåðíî òàê: êîãäà ñòðîèòüñÿ âåñü ïðîåêò, ó÷èòûâàþòñÿ êîîðäèíàòû ðàíüøå ïîñòðîåííûõ ëèñòîâ
for k := 0 to pCnt - 1 do
begin
p := Face.Points[k];
if Face.RecType <> ftNet3DSObject then
Face.Points[k] := DoublePoint(p.x, p.y, p.z + FZOrder * UOMToMetre(1000 / FCAD.PCad.MapScale))
else
Face.Points[k] := DoublePoint(p.x, p.y + FZOrder * UOMToMetre(1000 / FCAD.PCad.MapScale) * Factor, p.z);
end;
//glCompon.AddNode(x,y,z) - äîáàâëåíèå êîîðäèíàò êîìïîíåíòó,êîòîðûé íàõîäèòüñÿ â DummyCube,
//ãäå glCompon èìååò òàêîé æå àäðåññ, êàê è êîìïîíåíò â DummyCube
if Face.RecType in [ftPolyGon,ftLine,ftPipe,ftBar,ftSphere] then
begin
for k := 0 to pCnt - 1 do
begin
p := Face.Points[k];
p := DoublePoint(p.x,p.z,p.y);
if Face.RecType = ftPolyGon then
begin
glPoly.AddNode(p.x * factor, p.y * factor, p.z * factor);
end
else
if Face.RecType = ftLine then
begin
p.x := p.x * factor;
p.y := p.y * factor;
p.z := p.z * factor;
glLine.AddNode(p.x, p.y, p.z);
if k = 0 then
xLine.FGLPoint1 := p;
if k = 1 then
xLine.FGLPoint2 := p;
end
else
if Face.RecType = ftSphere then
begin
glSphere.Position.X := p.x * factor;
glSphere.Position.Y := p.y * factor;
glSphere.Position.Z := p.z * factor;
end
else
if Face.RecType = ftCenterCube then
begin
glCenter.Position.X := p.x * factor;
glCenter.Position.Y := p.y * factor;
glCenter.Position.Z := p.z * factor;
end
else
if (Face.RecType = ftPipe) or (Face.RecType = ftBar) then
begin
p.x := p.x * factor;
p.y := p.y * factor;
p.z := p.z * factor;
glPipe.AddNode(p.x, p.y, p.z);
if xConn <> nil then
xConn.FGLPoint := p;
end;
end;
if Face.RecType = ftLine then
begin
p := Face.Points[0];
p := DoublePoint(p.x,p.z,p.y);
p1 := Face.Points[1];
p1 := DoublePoint(p1.x,p1.z,p1.y);
glObjClass1 := TGLSpaceText;
p.x := (p.x + p1.x) * 0.5;
p.y := (p.y + p1.y) * 0.5;
p.z := (p.z + p1.z) * 0.5;
glObject1 := DummyCube.AddNewChild(glObjClass1);
glObject1.Tag := Integer(Face.FFigure); //29.03.2011
if (TOrthoLine(Face.FFigure).Name = cudUpDownCaption) or (TOrthoLine(Face.FFigure).Name = cCadClasses_Mes25) then
begin
TGLSpaceText(glObject1).Text := {$IF Defined(SCS_PE)} 'Raise' {$ELSE} 'Ñ/Ï' {$IFEND} + inttostr(TOrthoLine(Face.FFigure).FIndex);
TGLSpaceText(glObject1).Scale.X := 0.2;
TGLSpaceText(glObject1).Scale.y := 0.2;
TGLSpaceText(glObject1).Scale.z := 0.2;
end
else
begin
TGLSpaceText(glObject1).Text := TOrthoLine(Face.FFigure).Name + inttostr(TOrthoLine(Face.FFigure).FIndex);
TGLSpaceText(glObject1).Scale.X := 0.4;
TGLSpaceText(glObject1).Scale.y := 0.4;
TGLSpaceText(glObject1).Scale.z := 0.4;
end;
TGLSpaceText(glObject1).Position.x := p.x*factor;
TGLSpaceText(glObject1).Position.z := p.z*factor;
if Face.Points[0].z = Face.Points[1].z then
TGLSpaceText(glObject1).Position.y := (p.y + 2) * factor
else
TGLSpaceText(glObject1).Position.y := (p.y - 2) * factor;
TGLSpaceText(glObject1).Extrusion := 0.05;
TGLSpaceText(glObject1).Font.Color := clRed;
TGLSpaceText(glObject1).Material.FrontProperties.Diffuse.Color := clrRed;
TGLSpaceText(glObject1).Material.BackProperties.Diffuse.Color := clrRed;
//
with TGLSceneObject(glObject).Material do
begin
BackProperties.Ambient.AsWinColor:= Face.Color;
BackProperties.Diffuse.AsWinColor := Face.Color;
BackProperties.Emission.AsWinColor := Face.Color;
FrontProperties.Ambient.AsWinColor := Face.Color;
FrontProperties.Diffuse.AsWinColor := Face.Color;
FrontProperties.Emission.AsWinColor := Face.Color;
end;
xLine.FGLCaption := glObject1;
end;
if Face.RecType = ftPipe then
begin
p := Face.Points[0];
p := DoublePoint(p.x,p.z,p.y);
if TConnectorObject(Face.FFigure).ConnectorType <> ct_Clear then
begin
if TConnectorObject(Face.FFigure).Name <> ctnConnector then
begin
aScaleModel := 0.05;
aColorModel := clrGreen;
xoffset := 3;
FigureID := TConnectorObject(Face.FFigure).ID;
//SCSCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(FigureID);
//òàê òîæ êðèâî - PObjectData(Face.FTreeNode.Data).ListID).ListID - íå òîò çäåñü ÈÄ.
//SCSCatalog := F_ProjMan.GSCSBase.CurrProject.GetListByID(TSCSList(PObjectData(Face.FTreeNode.Data).ListID).ListID).GetCatalogFromReferencesBySCSID(FigureID);
// è òàê êðèâî, òîæ íå òîò ÈÄ:
//SCSCatalog := F_ProjMan.GSCSBase.CurrProject.GetListByID(FCAD.FCADListID).GetCatalogFromReferencesBySCSID(FigureID);
SCSCatalog := F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(FCAD.FCADListID).GetCatalogFromReferencesBySCSID(FigureID);
if SCSCatalog <> nil then
begin
// Ñïèñîê âñåõ êîìïîíåíòîâ âåðõíåãî óðîâíÿ TSCSComponent
if SCSCatalog.SCSComponents.Count > 0 then
begin
if SCSCatalog.SCSComponents[0].ComponentType.SysName = ctsnCupboard then
begin
aScaleModel := 0.1;
aColorModel := clrBrown;
xoffset := 4;
end;
if SCSCatalog.SCSComponents[0].ComponentType.SysName = ctsnBox then
begin
aScaleModel := 0.07;
aColorModel := clrBrown;
//xoffset := 4;
end;
if SCSCatalog.SCSComponents[0].ComponentType.SysName = ctsnCableChannelElement then
begin
aScaleModel := 0.02;
aColorModel := clrBlue;
end;
end;
end;
if TConnectorObject(Face.FFigure).Name <> cCadClasses_Mes24 then
begin
glObjClass1 := TGLSpaceText;
TmpP := p; //Face.Points[0];
//TmpP := DoublePoint(TmpP.x,TmpP.z,TmpP.y);
glObject1 := DummyCube.AddNewChild(glObjClass1);
TGLSpaceText(glObject1).Text := TConnectorObject(Face.FFigure).Name + inttostr(TConnectorObject(Face.FFigure).FIndex);
TGLSpaceText(glObject1).Position.x := (TmpP.x + xoffset)*factor;
TGLSpaceText(glObject1).Position.z := TmpP.z*factor;
TGLSpaceText(glObject1).Position.y := TmpP.y*factor;
TGLSpaceText(glObject1).Extrusion := 0.05;
TGLSpaceText(glObject1).Font.Color := clRed;
TGLSpaceText(glObject1).Scale.X := 0.4;
TGLSpaceText(glObject1).Scale.y := 0.4;
TGLSpaceText(glObject1).Scale.z := 0.4;
TGLSpaceText(glObject1).Material.FrontProperties.Diffuse.Color := clrRed;
TGLSpaceText(glObject1).Material.BackProperties.Diffuse.Color := clrRed;
xConn.FGLCaption := glObject1;
end;
glObjClass1 := TGLFreeForm;
glModelObject := TGLFreeForm(DummyCube.AddNewChild(glObjClass1));
{!!!}
ImgName := GetObjectFileByHash(xConn.FObjectHash);
// Exist Loaded Model
if ImgName <> '' then
begin
glModelObject.Material.Texture.Disabled := False;
glModelObject.MaterialLibrary := MatLib;
// FTextures.Clear;
FisCreate3DS := False;
FCurrObject := xConn;
glModelObject.LoadFromFile(ImgName);
{TODO - ïðîâåðèòü - âîçìîæíî ýòî òàêè íóæíî áóäåò äåëàòü!}
//for k := 0 to MatLib.Materials.Count - 1 do
// MatLib.Materials[k].Material.Texture.MappingMode := tmmCubeMapCamera;
glModelObject.Position.x := (p.x + xConn.FOffset.x) * factor;
glModelObject.Position.z := (p.z + xConn.FOffset.y) * factor;
glModelObject.Position.y := (p.y + xConn.FOffset.z) * factor;
glModelObject.Scale.X := xConn.FScale.x;
glModelObject.Scale.Y := xConn.FScale.y;
glModelObject.Scale.Z := xConn.FScale.z;
end
else
begin
{$IF Defined(ES_GRAPH_SC)}
glModelObject.LoadFromFile(ExeDir + '\3DModels\RM.3ds');
{$else}
glModelObject.LoadFromFile(ExeDir + '\Map.3ds');
{$IFEND}
glModelObject.Position.x := (p.x + xConn.FOffset.x) * factor;
glModelObject.Position.z := (p.z + xConn.FOffset.y) * factor;
glModelObject.Position.y := (p.y + xConn.FOffset.z) * factor;
glModelObject.Scale.X := aScaleModel;
glModelObject.Scale.Y := aScaleModel;
glModelObject.Scale.Z := aScaleModel;
xConn.FScale.x := glModelObject.Scale.X;
xConn.FScale.y := glModelObject.Scale.Y;
xConn.FScale.z := glModelObject.Scale.Z;
end;
glModelObject.TagObject := xNode;
RotateConnModel(glModelObject, xConn.FRotate.x, xConn.FRotate.y, xConn.FRotate.z);
//SetFreeFormRotate(glModelObject, xConn.FRotate.x, xConn.FRotate.y, xConn.FRotate.z);
with glModelObject.Material do
begin
if Texture.Disabled then
begin
FrontProperties.Ambient.Color := aColorModel;
FrontProperties.Diffuse.Color := aColorModel;
FrontProperties.Emission.Color := aColorModel;
BackProperties.Ambient.Color := aColorModel;
BackProperties.Diffuse.Color := aColorModel;
BackProperties.Emission.Color := aColorModel;
end;
end;
glModelObject.Material.MaterialOptions := [];
glModelObject.Material.Texture.Disabled := False;
// glModelObject.BuildOctree; // - òîðìîçà
xConn.FColor := aColorModel;
xConn.FGLObject1 := glModelObject;
{TODO} // ïîñìîòðåòü ÷òî çäåñü âîîáùå!!!
ImgName1 := GetImageFileByHash(xConn.FTextureHash);
if ImgName1 <> '' then
begin
glModelObject.MaterialLibrary := nil;
try
glModelObject.Material.Texture.Image.LoadFromFile(ImgName1);
except
ShowMessage('File not found ' + ImgName1);
end;
//glModelObject.Material.Texture.MappingMode := tmmCubeMapCamera;
end
{!!!}
end
else
begin
FigureID := TConnectorObject(Face.FFigure).ID;
//SCSCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(FigureID);
//SCSCatalog := F_ProjMan.GSCSBase.CurrProject.GetListByID(TSCSList(PObjectData(Face.FTreeNode.Data).ListID).ListID).GetCatalogFromReferencesBySCSID(FigureID);
//SCSCatalog := F_ProjMan.GSCSBase.CurrProject.GetListByID(FCAD.FCADListID).GetCatalogFromReferencesBySCSID(FigureID);
SCSCatalog := F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(FCAD.FCADListID).GetCatalogFromReferencesBySCSID(FigureID);
if SCSCatalog <> nil then
begin
// Ñïèñîê âñåõ êîìïîíåíòîâ âåðõíåãî óðîâíÿ TSCSComponent
if SCSCatalog.SCSComponents.Count > 0 then
begin
if SCSCatalog.SCSComponents[0].ComponentType.SysName = ctsnCableChannelElement then
begin
aScaleModel := 0.02;
aColorModel := clrBlue;
glObjClass1 := TGLFreeForm;
glModelObject := TGLFreeForm(DummyCube.AddNewChild(glObjClass1));
{!!!}
ImgName := GetObjectFileByHash(xConn.FObjectHash);
// Exist Loaded Model
if ImgName <> '' then
begin
glModelObject.Material.Texture.Disabled := False;
glModelObject.MaterialLibrary := MatLib;
// FTextures.Clear;
FisCreate3DS := False;
FCurrObject := xConn;
glModelObject.LoadFromFile(ImgName);
{TODO - ïðîâåðèòü - âîçìîæíî ýòî òàêè íóæíî áóäåò äåëàòü!}
//for k := 0 to MatLib.Materials.Count - 1 do
// MatLib.Materials[k].Material.Texture.MappingMode := tmmCubeMapCamera;
glModelObject.Position.x := (p.x + xConn.FOffset.x) * factor;
glModelObject.Position.z := (p.z + xConn.FOffset.y) * factor;
glModelObject.Position.y := (p.y + xConn.FOffset.z) * factor;
glModelObject.Scale.X := xConn.FScale.x;
glModelObject.Scale.Y := xConn.FScale.y;
glModelObject.Scale.Z := xConn.FScale.z;
end
else
begin
{$IF Defined(ES_GRAPH_SC)}
glModelObject.LoadFromFile(ExeDir + '\3DModels\RM.3ds');
{$else}
glModelObject.LoadFromFile(ExeDir + '\Map.3ds');
{$IFEND}
glModelObject.Position.x := (p.x + xConn.FOffset.x) * factor;
glModelObject.Position.z := (p.z + xConn.FOffset.y) * factor;
glModelObject.Position.y := (p.y + xConn.FOffset.z) * factor;
glModelObject.Scale.X := aScaleModel;
glModelObject.Scale.Y := aScaleModel;
glModelObject.Scale.Z := aScaleModel;
xConn.FScale.x := glModelObject.Scale.X;
xConn.FScale.y := glModelObject.Scale.Y;
xConn.FScale.z := glModelObject.Scale.Z;
end;
glModelObject.TagObject := xNode;
RotateConnModel(glModelObject, xConn.FRotate.x, xConn.FRotate.y, xConn.FRotate.z);
//SetFreeFormRotate(glModelObject, xConn.FRotate.x, xConn.FRotate.y, xConn.FRotate.z);
with glModelObject.Material do
begin
if Texture.Disabled then
begin
FrontProperties.Ambient.Color := ObjColor;
FrontProperties.Diffuse.Color := ObjColor;
FrontProperties.Emission.Color := ObjColor;
BackProperties.Ambient.Color := ObjColor;
BackProperties.Diffuse.Color := ObjColor;
BackProperties.Emission.Color := ObjColor;
end;
end;
glModelObject.Material.MaterialOptions := [];
glModelObject.Material.Texture.Disabled := False;
// glModelObject.BuildOctree; // - òîðìîçà
xConn.FColor := aColorModel;
xConn.FGLObject1 := glModelObject;
{TODO} // ïîñìîòðåòü ÷òî çäåñü âîîáùå!!!
ImgName1 := GetImageFileByHash(xConn.FTextureHash);
if ImgName1 <> '' then
begin
glModelObject.MaterialLibrary := nil;
try
glModelObject.Material.Texture.Image.LoadFromFile(ImgName1);
except
ShowMessage('File not found ' + ImgName1);
end;
//glModelObject.Material.Texture.MappingMode := tmmCubeMapCamera;
end
{!!!}
end;
end;
end;
end;
end
else
begin
glPipe.Visible := false;
//EmptyProcedure;
end;
//
with TGLSceneObject(glObject).Material do
begin
BackProperties.Ambient.AsWinColor:= Face.Color;
BackProperties.Diffuse.AsWinColor := Face.Color;
BackProperties.Emission.AsWinColor := Face.Color;
FrontProperties.Ambient.AsWinColor := Face.Color;
FrontProperties.Diffuse.AsWinColor := Face.Color;
FrontProperties.Emission.AsWinColor := Face.Color;
if TConnectorObject(Face.FFigure).Name = 'Anchor' then
begin
BackProperties.Ambient.AsWinColor:= clNone;
BackProperties.Diffuse.AsWinColor := clNone;
BackProperties.Emission.AsWinColor := clNone;
FrontProperties.Ambient.AsWinColor := clNone;
FrontProperties.Diffuse.AsWinColor := clNone;
FrontProperties.Emission.AsWinColor := clNone;
end;
end;
end;
end;
if Face.RecType = ftLine then
begin
glLine.NodeSize := 0;
glLine.ShowAxes := False;
if TOrthoLine(Face.FFigure).FLineType = ts_ClearTrace then
gLLine.LineWidth := 1
else
gLLine.LineWidth := 4;
glLine.AntiAliased := True;
glLine.NodesAspect := lnaInvisible;
glLine.LineColor.AsWinColor := Face.Color; //clred;
xLine.FColor := Face.Color;
end
else
if Face.RecType = ftPolyGon then
begin
//glPoly.Smooth := True;
glPoly.Parts := [ppTop,ppBottom];
end;
{TODO}
// OK
if not (Face.RecType in [ftNetPath, ftNetDoor, ftNetWindow, ftNetBalconDoor, ftNetBalconWindow, ftNetFloor, ftNetCeiling]) then
begin
with TGLSceneObject(glObject).Material do
begin
BackProperties.Ambient.AsWinColor:= Face.Color;
BackProperties.Diffuse.AsWinColor := Face.Color;
BackProperties.Emission.AsWinColor := Face.Color;
FrontProperties.Ambient.AsWinColor := Face.Color;
FrontProperties.Diffuse.AsWinColor := Face.Color;
FrontProperties.Emission.AsWinColor := Face.Color;
if Face.RecType = ftPipe then
begin
begin
if TConnectorObject(Face.FFigure).Name = 'Anchor' then
begin
BackProperties.Ambient.AsWinColor:= clNone;
BackProperties.Diffuse.AsWinColor := clNone;
BackProperties.Emission.AsWinColor := clNone;
FrontProperties.Ambient.AsWinColor := clNone;
FrontProperties.Diffuse.AsWinColor := clNone;
FrontProperties.Emission.AsWinColor := clNone;
end;
end;
end;
end;
end;
{TODO}
// OK
// ********************** NETPATHs *****************************************
if Face.RecType = ftNetPath then
begin
for k := 0 to pCnt - 1 do
begin
p := Face.Points[k];
p := DoublePoint(p.x, p.z, p.y);
p1 := Face.Points[1];
p1 := DoublePoint(p1.x, p1.z, p1.y);
p.x := p.x * factor;
if (Face.FFaceWallType in [fwtDoorSlope, fwtWindowSlope, fwtBalconSlope, fwtNiche]) then
begin
if (p.y < 0.011) then
begin
if (p.y <> p1.y) then
p.y := p.y * factor
else
p.y := p.y * factor + FDeltaZSlope;
end
else
p.y := p.y * factor;
end
else
p.y := p.y * factor;
p.z := p.z * factor;
// çàâèñèìîñòè îò òîãî, ñêîëüêî ðàç ïðîéäåò öèê ÔÎÐ, ñòîëüêî òî÷åê è áóäåò çàäàíî
//â ïîëèãîíå
glWallSide.AddNode(p.x, p.y, p.z);
if xSide <> nil then
xSide.FGLPoints[k] := p;
end;
with TGLSceneObject(glObject).Material do
begin
aColor := clrNewTan;
BackProperties.Ambient.Color := aColor;
BackProperties.Diffuse.Color := aColor;
BackProperties.Emission.Color := aColor;
FrontProperties.Ambient.Color := aColor;
FrontProperties.Diffuse.Color := aColor;
FrontProperties.Emission.Color := aColor;
Texture.texturemode := tmDecal;
Texture.Disabled := False;
ImgName := GetImageFileByHash(xSide.FTextureHash);
if ImgName <> '' then
begin
try
Texture.Image.LoadFromFile(ImgName);
except
ShowMessage('File not found ' + ImgName);
end;
end
else
begin
try
if Face.FFaceWallType = fwtInner then
Texture.Image.LoadFromFile(ExeDir + '\3DTextures\inner_wall.bmp')
else if Face.FFaceWallType = fwtOuter then
Texture.Image.LoadFromFile(ExeDir + '\3DTextures\outer_wall.bmp')
else if Face.FFaceWallType = fwtDoorSlope then
Texture.Image.LoadFromFile(ExeDir + '\3DTextures\door_slope.bmp')
else if Face.FFaceWallType = fwtWindowSlope then
Texture.Image.LoadFromFile(ExeDir + '\3DTextures\window_slope.bmp')
else if Face.FFaceWallType = fwtArc then
Texture.Image.LoadFromFile(ExeDir + '\3DTextures\arc.bmp')
else if Face.FFaceWallType = fwtBalconSlope then
Texture.Image.LoadFromFile(ExeDir + '\3DTextures\balcon_slope.bmp')
else if Face.FFaceWallType = fwtNiche then
Texture.Image.LoadFromFile(ExeDir + '\3DTextures\niche.bmp');
except
ShowMessage('Texture File not found');
end;
end;
end;
RotateTextureToAngleP(xSide, GLWallSide, xSide.FTextureRotate, xSide.FMirror);
end;
// ********************** NETPATHs *****************************************
// ********************** NETDOORs *****************************************
if Face.RecType = ftNetDoor then
begin
for k := 0 to pCnt - 1 do
begin
p := Face.Points[k];
p := DoublePoint(p.x, p.z, p.y);
p1 := Face.Points[1];
p1 := DoublePoint(p1.x, p1.z, p1.y);
p.x := p.x * factor;
if (p.y < 0.011) then
begin
if (p.y <> p1.y) then
p.y := p.y * factor
else
p.y := p.y * factor + FDeltaZSlope
end
else
p.y := p.y * factor;
p.z := p.z * factor;
glDoorSide.AddNode(p.x, p.y, p.z);
xSide.FGLPoints[k] := p;
end;
with TGLSceneObject(glObject).Material do
begin
aColor := clrTan;
BackProperties.Ambient.Color := aColor;
BackProperties.Diffuse.Color := aColor;
BackProperties.Emission.Color := aColor;
FrontProperties.Ambient.Color := aColor;
FrontProperties.Diffuse.Color := aColor;
FrontProperties.Emission.Color := aColor;
MaterialOptions := [moNoLighting];
end;
end;
// ********************** NETDOORs *****************************************
// ********************** NETWINDOWs ***************************************
if Face.RecType = ftNetWindow then
begin
for k := 0 to pCnt - 1 do
begin
p := Face.Points[k];
p := DoublePoint(p.x, p.z, p.y);
p1 := Face.Points[1];
p1 := DoublePoint(p1.x, p1.z, p1.y);
p.x := p.x * factor;
//if (p.y < 0.011) then
//begin
// if (p.y <> p1.y) then
// p.y := p.y * factor
// else
// p.y := p.y * factor + FDeltaZSlope
//end
//else
p.y := p.y * factor;
p.z := p.z * factor;
glWindowSide.AddNode(p.x, p.y, p.z);
xSide.FGLPoints[k] := p;
end;
with TGLSceneObject(glObject).Material do
begin
aColor := clrSilver;
BackProperties.Ambient.Color := aColor;
BackProperties.Diffuse.Color := aColor;
BackProperties.Emission.Color := aColor;
FrontProperties.Ambient.Color := aColor;
FrontProperties.Diffuse.Color := aColor;
FrontProperties.Emission.Color := aColor;
MaterialOptions := [moNoLighting];
end;
end;
// ********************** NETWINDOWs ***************************************
// ********************** NETBALCONs ***************************************
if Face.RecType = ftNetBalconDoor then
begin
for k := 0 to pCnt - 1 do
begin
p := Face.Points[k];
p := DoublePoint(p.x, p.z, p.y);
p1 := Face.Points[1];
p1 := DoublePoint(p1.x, p1.z, p1.y);
p.x := p.x * factor;
if (p.y < 0.011) then
begin
if (p.y <> p1.y) then
p.y := p.y * factor
else
p.y := p.y * factor + FDeltaZSlope
end
else
p.y := p.y * factor;
p.z := p.z * factor;
glBalconDoorSide.AddNode(p.x, p.y, p.z);
xSide.FGLPoints[k] := p;
end;
with TGLSceneObject(glObject).Material do
begin
aColor := clrGray80;
BackProperties.Ambient.Color := aColor;
BackProperties.Diffuse.Color := aColor;
BackProperties.Emission.Color := aColor;
FrontProperties.Ambient.Color := aColor;
FrontProperties.Diffuse.Color := aColor;
FrontProperties.Emission.Color := aColor;
MaterialOptions := [moNoLighting];
end;
end;
if Face.RecType = ftNetBalconWindow then
begin
for k := 0 to pCnt - 1 do
begin
p := Face.Points[k];
p := DoublePoint(p.x, p.z, p.y);
p1 := Face.Points[1];
p1 := DoublePoint(p1.x, p1.z, p1.y);
p.x := p.x * factor;
//if (p.y < 0.011) then
//begin
// if (p.y <> p1.y) then
// p.y := p.y * factor
// else
// p.y := p.y * factor + FDeltaZSlope
//end
//else
p.y := p.y * factor;
p.z := p.z * factor;
glBalconWindowSide.AddNode(p.x, p.y, p.z);
xSide.FGLPoints[k] := p;
end;
with TGLSceneObject(glObject).Material do
begin
aColor := clrSilver;
BackProperties.Ambient.Color := aColor;
BackProperties.Diffuse.Color := aColor;
BackProperties.Emission.Color := aColor;
FrontProperties.Ambient.Color := aColor;
FrontProperties.Diffuse.Color := aColor;
FrontProperties.Emission.Color := aColor;
MaterialOptions := [moNoLighting];
end;
end;
// ********************** NETBALCONs ***************************************
// ********************** NETFLOOR *****************************************
{TODO}
// OK
(*
if Face.RecType = ftNetFloor then
begin
glFloor.Direction.Y := -1;
glFloor.Direction.Z := 0;
glFloor.Direction.X := 0;
glFloor.Up.Y := 0;
glFloor.Up.Z := 1;
glFloor.Up.X := 0;
SetLength(FloorCoords, pCnt div 2);
for k := 0 to (pCnt div 2) - 1 do
begin
p := Face.Points[k];
p := DoublePoint(p.x, p.z, p.y);
FloorCoords[k][0] := p.x * factor;
FloorCoords[k][1] := p.y * factor + FDeltaZ;
FloorCoords[k][2] := p.z * factor;
end;
if (pCnt div 2) >= 3 then
begin
for k := 0 to (pCnt div 2) - 3 do
begin
dp1 := DoublePoint(FloorCoords[0][0], FloorCoords[0][2], FloorCoords[0][1]);
dp2 := DoublePoint(FloorCoords[k + 1][0], FloorCoords[k + 1][2], FloorCoords[k + 1][1]);
Angle1 := GetLineAngle(dp1, dp2);
dp1 := DoublePoint(FloorCoords[k + 1][0], FloorCoords[k + 1][2], FloorCoords[k + 1][1]);
dp2 := DoublePoint(FloorCoords[k + 2][0], FloorCoords[k + 2][2], FloorCoords[k + 2][1]);
Angle2 := GetLineAngle(dp1, dp2);
ResAng := abs(Angle1 - Angle2);
//if ResAng < 180 then
begin
pN := CalcPlaneNormal (FloorCoords[0], FloorCoords[k + 1], FloorCoords[k + 2]);
if (not isNaN(pN[0])) and (Not IsNaN(pN[1])) and (Not IsNaN(pN[2])) then
break;
end;
end;
if k > ((pCnt div 2) - 1) then
k := 0;
pN := CalcPlaneNormal (FloorCoords[0], FloorCoords[k + 1], FloorCoords[k + 2]);
end
else
pN[1] := 0;
if pN[1] >= 0 then
glFloor.Parts := [ppTop]
else
glFloor.Parts := [ppBottom];
for k := 0 to (pCnt div 2) - 1 do
begin
p := Face.Points[k];
p := DoublePoint(p.x, p.y, p.z);
glFloor.AddNode(p.x * factor, p.y * factor, p.z * factor + FDeltaZ);
end;
with TGLSceneObject(glObject).Material do
begin
aColor := clrSilver;
BackProperties.Ambient.Color := aColor;
BackProperties.Diffuse.Color := aColor;
BackProperties.Emission.Color := aColor;
FrontProperties.Ambient.Color := aColor;
FrontProperties.Diffuse.Color := aColor;
FrontProperties.Emission.Color := aColor;
Texture.texturemode := tmDecal;
Texture.Disabled := False;
Texture.Image.LoadFromFile(tex_floor);
TGLSceneObject(glObject).Tag := 998;
end;
end;
*)
if Face.RecType = ftNetFloor then
begin
{
glFloor.Direction.Y := -1;
glFloor.Direction.Z := 0;
glFloor.Direction.X := 0;
glFloor.Up.Y := 0;
glFloor.Up.Z := 1;
glFloor.Up.X := 0;
}
//19.06.2012
NormalPoints := GetPointsForNormal(Face.Points);
pCntNormal := Length(NormalPoints);
SetLength(FloorCoords, pCntNormal);
for k := 0 to pCntNormal - 1 do
begin
p := NormalPoints[k]; //19.06.2012 Face.Points[k];
p := DoublePoint(p.x, p.z, p.y);
FloorCoords[k][0] := p.x * factor;
FloorCoords[k][1] := p.y * factor + FDeltaZFloor; //FDeltaZ;
FloorCoords[k][2] := p.z * factor;
end;
if pCntNormal >= 3 then
begin
for k := 0 to pCntNormal - 3 do
begin
dp1 := DoublePoint(FloorCoords[0][0], FloorCoords[0][2], FloorCoords[0][1]);
dp2 := DoublePoint(FloorCoords[k + 1][0], FloorCoords[k + 1][2], FloorCoords[k + 1][1]);
Angle1 := GetLineAngle(dp1, dp2);
dp1 := DoublePoint(FloorCoords[k + 1][0], FloorCoords[k + 1][2], FloorCoords[k + 1][1]);
dp2 := DoublePoint(FloorCoords[k + 2][0], FloorCoords[k + 2][2], FloorCoords[k + 2][1]);
Angle2 := GetLineAngle(dp1, dp2);
ResAng := abs(Angle1 - Angle2);
//if ResAng < 180 then
begin
pN := CalcPlaneNormal (FloorCoords[0], FloorCoords[k + 1], FloorCoords[k + 2]);
if (not isNaN(pN[0])) and (Not IsNaN(pN[1])) and (Not IsNaN(pN[2])) then
break;
end;
end;
if k > (pCntNormal - 1) then
k := 0;
pN := CalcPlaneNormal (FloorCoords[0], FloorCoords[k + 1], FloorCoords[k + 2]);
end
else
pN[1] := 0;
{$IF Defined(ES_GRAPH_SC)}
IsRoof := ifFiguraISRoof(GetNetByComponID(t3droom(xSide.FParent).FSCSCOmpon.ID,GCadForm));
//Îòîáðàæàåò ïëîñêîñòè êðûøè åñëè ñìîòðåòü è ñâåðõó è ñíèçó...Ïîòîìó è çàëî÷èë
if not ISRoof then
{$IFEND}
if pN[1] >= 0 then
glFloor.Parts := [ppTop]
else
glFloor.Parts := [ppBottom];
//Çàäàåì òî÷êè äëÿ îòðèñîâêè ïîëèãîíà/////////////////////////////////////////////////////////
for k := 0 to pCnt - 1 do //
begin //
p := Face.Points[k]; //
//p := DoublePoint(p.x * factor, p.z * factor + FDeltaZ, p.y * factor); {TODO} // OK //
p := DoublePoint(p.x * factor, p.z * factor + FDeltaZFloor, p.y * factor); {TODO} // OK //
glFloor.AddNode(p.x, p.y, p.z); //
xSide.FGLPoints[k] := p; //
end; //
xSide.FZOrder := xSide.FZOrder + FDeltaZFloor;
with TGLSceneObject(glObject).Material do
begin
aColor := clrSilver;
BackProperties.Ambient.Color := aColor;
BackProperties.Diffuse.Color := aColor;
BackProperties.Emission.Color := aColor;
FrontProperties.Ambient.Color := aColor;
FrontProperties.Diffuse.Color := aColor;
FrontProperties.Emission.Color := aColor;
Texture.texturemode := tmDecal;
Texture.Disabled := False;
ImgName := GetImageFileByHash(xSide.FTextureHash);
if ImgName <> '' then
begin
try
Texture.Image.LoadFromFile(ImgName);
except
ShowMessage('File not found ' + ImgName);
end;
end
else
begin
try
Texture.Image.LoadFromFile(ExeDir + '\3DTextures\floor.bmp');
except
ShowMessage('File not found ' + ExeDir + '\3DTextures\floor.bmp');
end;
end;
end;
RotateTextureToAngleP(xSide, GLFloor, xSide.FTextureRotate, xSide.FMirror);
end;
// ********************** NETFLOOR *****************************************
// ********************** NETCEILING ***************************************
{TODO}
// OK
(*
if Face.RecType = ftNetCeiling then
begin
glCeiling.Direction.Y := -1;
glCeiling.Direction.Z := 0;
glCeiling.Direction.X := 0;
glCeiling.Up.Y := 0;
glCeiling.Up.Z := 1;
glCeiling.Up.X := 0;
SetLength(FloorCoords, pCnt div 2);
for k := 0 to (pCnt div 2) - 1 do
begin
p := Face.Points[k];
p := DoublePoint(p.x, p.z, p.y);
FloorCoords[k][0] := p.x * factor;
FloorCoords[k][1] := p.y * factor + FDeltaZ;
FloorCoords[k][2] := p.z * factor;
end;
if (pCnt div 2) >= 3 then
begin
for k := 0 to (pCnt div 2) - 3 do
begin
dp1 := DoublePoint(FloorCoords[0][0], FloorCoords[0][2], FloorCoords[0][1]);
dp2 := DoublePoint(FloorCoords[k + 1][0], FloorCoords[k + 1][2], FloorCoords[k + 1][1]);
Angle1 := GetLineAngle(dp1, dp2);
dp1 := DoublePoint(FloorCoords[k + 1][0], FloorCoords[k + 1][2], FloorCoords[k + 1][1]);
dp2 := DoublePoint(FloorCoords[k + 2][0], FloorCoords[k + 2][2], FloorCoords[k + 2][1]);
Angle2 := GetLineAngle(dp1, dp2);
ResAng := abs(Angle1 - Angle2);
//if ResAng < 180 then
begin
pN := CalcPlaneNormal (FloorCoords[0], FloorCoords[k + 1], FloorCoords[k + 2]);
if (not isNaN(pN[0])) and (Not IsNaN(pN[1])) and (Not IsNaN(pN[2])) then
break;
end;
end;
if k > ((pCnt div 2) - 1) then
k := 0;
pN := CalcPlaneNormal (FloorCoords[0], FloorCoords[k + 1], FloorCoords[k + 2]);
end
else
pN[1] := 0;
if pN[1] >= 0 then
glCeiling.Parts := [ppBottom]
else
glCeiling.Parts := [ppTop];
for k := 0 to (pCnt div 2) - 1 do
begin
p := Face.Points[k];
p := DoublePoint(p.x, p.y, p.z);
glCeiling.AddNode(p.x * factor, p.y * factor, - (p.z * factor + FDeltaZ) );
end;
with TGLSceneObject(glObject).Material do
begin
aColor := clrSilver;
BackProperties.Ambient.Color := aColor;
BackProperties.Diffuse.Color := aColor;
BackProperties.Emission.Color := aColor;
FrontProperties.Ambient.Color := aColor;
FrontProperties.Diffuse.Color := aColor;
FrontProperties.Emission.Color := aColor;
Texture.texturemode := tmDecal;
Texture.Disabled := False;
Texture.Image.LoadFromFile(tex_ceiling);
TGLSceneObject(glObject).Tag := 999;
end;
end;
*)
if Face.RecType = ftNetCeiling then //Òóò,ÿ òàê ïîíÿë è íóæíî êîâûðíóòü, ÷òîá ïîòîëîê ðèñîâàëñÿ ïðàâèëüíî
begin
{
glCeiling.Direction.Y := -1;
glCeiling.Direction.Z := 0;
glCeiling.Direction.X := 0;
glCeiling.Up.Y := 0;
glCeiling.Up.Z := 1;
glCeiling.Up.X := 0;
}
//19.06.2012
//òóò ìîæåò áûòü îøèáî÷êà,ïîòîìó, ÷òî â îäíîé ïðîðèñîâêå íå ïðàâèëüíî áåðåò êîîðäèíàòû
NormalPoints := GetPointsForNormal(Face.Points);
pCntNormal := Length(NormalPoints);
SetLength(FloorCoords, pCntNormal);
for k := 0 to pCntNormal - 1 do
begin
p := NormalPoints[k]; //19.06.2012 Face.Points[k];
p := DoublePoint(p.x, p.z, p.y);
FloorCoords[k][0] := p.x * factor;
FloorCoords[k][1] := p.y * factor + FDeltaZ;
FloorCoords[k][2] := p.z * factor;
end;
if pCntNormal >= 3 then
begin
for k := 0 to pCntNormal - 3 do
begin
dp1 := DoublePoint(FloorCoords[0][0], FloorCoords[0][2], FloorCoords[0][1]);
dp2 := DoublePoint(FloorCoords[k + 1][0], FloorCoords[k + 1][2], FloorCoords[k + 1][1]);
//äîñòàåì óãîë ìåæäó äâóìÿ òî÷êàìè â ïðîñòðàíñòâå
Angle1 := GetLineAngle(dp1, dp2);
dp1 := DoublePoint(FloorCoords[k + 1][0], FloorCoords[k + 1][2], FloorCoords[k + 1][1]);
dp2 := DoublePoint(FloorCoords[k + 2][0], FloorCoords[k + 2][2], FloorCoords[k + 2][1]);
Angle2 := GetLineAngle(dp1, dp2);
ResAng := abs(Angle1 - Angle2);
//if ResAng < 180 then
begin
pN := CalcPlaneNormal (FloorCoords[0], FloorCoords[k + 1], FloorCoords[k + 2]);
if (not isNaN(pN[0])) and (Not IsNaN(pN[1])) and (Not IsNaN(pN[2])) then
break;
end;
end;
if k > (pCntNormal - 1) then
k := 0;
pN := CalcPlaneNormal (FloorCoords[0], FloorCoords[k + 1], FloorCoords[k + 2]);
end
else
pN[1] := 0;
{$IF Defined(ES_GRAPH_SC)}
if TOBject(xSide.FParent) is t3droom then
IsRoof := ifFiguraISRoof(GetNetByComponID(t3droom(xSide.FParent).FSCSCompon.ID,GCadForm));
//Îòîáðàæàåò ïëîñêîñòè êðûøè åñëè ñìîòðåòü è ñâåðõó è ñíèçó...Ïîòîìó è çàëî÷èë
if not ISRoof then
{$IFEND}
if pN[1] >= 0 then
glCeiling.Parts := [ppBottom]
else
glCeiling.Parts := [ppTop];
{$IF Defined(ES_GRAPH_SC)}
if TOBject(xSide.FParent) is t3droom then
for k := 0 to t3droom(xSide.FParent).FSCSCompon.Properties.Count - 1 do
if PProperty(t3droom(xSide.FParent).FSCSCompon.Properties[k]).SysName = 'RESIDUE' then
begin
IsAperture := True;
break;
end;
{$IFEND}
//Äîáàâëåíèå òî÷åê ïîñòðîåíèÿ ïëîñêîñòè ïîòîëêà(êðûøè);//////////////////////
for k := 0 to pCnt - 1 do //
begin //
p := Face.Points[k]; //
p := DoublePoint(p.x * factor, p.z * factor + FDeltaZ, p.y * factor); //
{$IF Defined(ES_GRAPH_SC)}
if IsAperture then //
glCeiling.AddNode(p.x, p.y+0.03, p.z) //
else //
{$IFEND}
glCeiling.AddNode(p.x, p.y, p.z); //
xSide.FGLPoints[k] := p; //
end; //
xSide.FZOrder := xSide.FZOrder + FDeltaZ;
{
for k := 0 to pCnt - 1 do
begin
p := Face.Points[k];
p := DoublePoint(p.x * factor, p.z * factor, p.y * factor + FDeltaZ);
glCeiling.AddNode(p.x, p.y, p.z);
xSide.FGLPoints[k] := p;
end;
}
with TGLSceneObject(glObject).Material do
begin
aColor := clrSilver;
BackProperties.Ambient.Color := aColor;
BackProperties.Diffuse.Color := aColor;
BackProperties.Emission.Color := aColor;
FrontProperties.Ambient.Color := aColor;
FrontProperties.Diffuse.Color := aColor;
FrontProperties.Emission.Color := aColor;
Texture.texturemode := tmDecal;
Texture.Disabled := False;
ImgName := GetImageFileByHash(xSide.FTextureHash);
if ImgName <> '' then
begin
try
Texture.Image.LoadFromFile(ImgName);
except
ShowMessage('File not found ' + ImgName);
end;
end
else
begin
if not IsAperture then
begin
try
Texture.Image.LoadFromFile(ExeDir + '\3DTextures\ceiling.bmp')
except
ShowMessage('File not found ' + ExeDir + '\3DTextures\ceiling.bmp');
end;
end
else
begin
//ïðîåì âîîáùå îñòàâèì áåç òåêñòóðû ïîêà
//try
// Texture.Image.LoadFromFile(ExeDir + '\3DTextures\window_slope.bmp');
//except
// ShowMessage('File not found ' + ExeDir + '\3DTextures\window_slope.bmp');
//end;
end;
end;
end;
RotateTextureToAngleP(xSide, GLCeiling, xSide.FTextureRotate, xSide.FMirror);//Ïîâåðíóòü òåêñòóðó íà çàäàííûé óãîë
end;
// ********************** NETCEILING ***************************************
// ********************** NET3DSObject *************************************
if Face.RecType = ftNet3DSObject then
begin
gl3DSObject.Material.Texture.Disabled := False;
try
// íà ïîäíÿòèè ïîäìåíÿåì íà òåêóùèé savedir!
{
if FileExists(ExeDir + '\' + dnSave + '\' + ExtractFileName(xObject.FPath)) then
xObject.FPath := ExeDir + '\' + dnSave + '\' + ExtractFileName(xObject.FPath)
else
begin
// åñëè íåò òàêîãî çíà÷ ïðîñòî áóêîâêó òåêóùåãî äèñêà ïîäñòàâèì.
xObject.FPath := copy(ExeDir, 1, 1) + copy(xObject.FPath, 2, $FFFF);
end;
}
ImgName := GetObjectFileByHash(xObject.FObjectHash);
if ImgName <> '' then
begin
gl3DSObject.Material.Texture.Disabled := False;
gl3DSObject.MaterialLibrary := MatLib;
// FTextures.Clear;
FisCreate3DS := False;
FCurrObject := xObject;
gl3DSObject.LoadFromFile(ImgName);
{TODO - ïðîâåðèòü - âîçìîæíî ýòî òàêè íóæíî áóäåò äåëàòü!}
//for k := 0 to MatLib.Materials.Count - 1 do
// MatLib.Materials[k].Material.Texture.MappingMode := tmmCubeMapCamera;
for k := 0 to pCnt - 1 do
begin
p := Face.Points[k];
gl3DSObject.Position.x := p.x;
gl3DSObject.Position.y := p.y;
gl3DSObject.Position.z := p.z;
end;
gl3DSObject.Scale.x := xObject.FScale.x;
gl3DSObject.Scale.y := xObject.FScale.y;
gl3DSObject.Scale.z := xObject.FScale.z;
Rotate3DSObj(gl3DSObject, xObject.FRotate.x, xObject.FRotate.y, xObject.FRotate.z);
//SetFreeFormRotate(gl3DSObject, xObject.FRotate.x, xObject.FRotate.y, xObject.FRotate.z);
with gl3DSObject.Material do
begin
if Texture.Disabled then
begin
FrontProperties.Ambient.Color := ObjColor;
FrontProperties.Diffuse.Color := ObjColor;
FrontProperties.Emission.Color := ObjColor;
BackProperties.Ambient.Color := ObjColor;
BackProperties.Diffuse.Color := ObjColor;
BackProperties.Emission.Color := ObjColor;
end;
end;
gl3DSObject.Material.MaterialOptions := [];
gl3DSObject.Material.Texture.Disabled := False;
// gl3DSObject.BuildOctree; // - òîðìîçà
// LOAD texture from Hash
{TODO} // ïîñìîòðåòü ÷òî çäåñü âîîáùå!!!
{TODO} // Ïåðåñìîòðåòü ÷òî çäåñü çà õðåíü âîîáùå ïûòàåòñÿ ãðóçèòñÿ!!!
ImgName1 := GetImageFileByHash(xObject.FTextureHash);
if ImgName1 <> '' then
begin
gl3DSObject.MaterialLibrary := nil;
try
gl3DSObject.Material.Texture.Image.LoadFromFile(ImgName1);
except
ShowMessage('File not found ' + ImgName1);
end;
//gl3DSObject.Material.Texture.MappingMode := tmmCubeMapCamera;
end
end;
except
end;
end;
// ********************** NET3DSObject *************************************
with TGLSceneObject(glObject).Material do
begin
if (Face.Trans) or (face.OpTrans) then
begin
BlendingMode := bmTransparency;
BackProperties.Diffuse.Alpha := 0.4;
FrontProperties.Diffuse.Alpha := 0.4;
end;
end;
if Face.RecType = ftPipe then
begin
{$IF Defined(ES_GRAPH_SC)}
glPipe.Radius := 0;
{$ELSE}
glPipe.Radius := Face.Size;
{$IFEND}
glPipe.Parts := [ppOutSide,ppInSide,ppStartDisk,ppStopDisk];
end
else
if Face.RecType = ftBar then
begin
glPipe.Radius := 0.06;
end
else
if Face.RecType = ftSphere then
begin
glSphere.Radius := Face.Size * factor;
end
else
if Face.RecType = ftCenterCube then
begin
end
else
begin
end;
//*******************ROOF*******************
if IsRoof then
begin
if xNode <> nil then //Åñëè òàêîé íîä ñóùåñòâóåò â äåðåâå
begin
if (TObject(xNode.Data) is T3dside)and(TObject(T3dside(xNode.Data).FParent) is t3droom) then
begin
if t3droom(T3dside(xNode.Data).FParent).FWalls <> nil then //Åñëè ó íåãî åñòü ñòåíû
begin
for iWall:= 0 to t3droom(T3dside(xNode.Data).FParent).FWalls.count-1 do //Ïðîõîäèìñÿ ïî âñåì ñòåíàì
begin
Wall := T3DWall(t3droom(T3dside(xNode.Data).FParent).FWalls[iWall]); //Ïîðÿäêîâûé íîìåð ñòåíû
for iModelCnt := 0 to ModelTree.Items.Count - 1 do //Íàõîäèì ñîîòâåòñòâóþùóþ ñòåíó ñ ModelTree////
if AnsiUpperCase(Wall.FName) = AnsiUpperCase(ModelTree.Items[iModelCnt].Text) then //
begin //
if Wall.FParent.FName = ModelTree.Items[iModelCnt].Parent.Text then //
begin //
WallNode := ModelTree.Items[iModelCnt]; // Çàïîìèíàåì íàéäåííûé íîä â äåðåâå
glObject := DummyCube.AddNewChild(TGLLines); //Äîáàâëåíèå ôèãóðû â DummyCube (ëèíèÿ)
glObject.TagObject := WallNode; //ñâÿçûâàåì å¸ ñ âåòêîé íîäà
Wall.FZOrder := FZOrder * UOMToMetre(1000 / FCAD.PCad.MapScale) * factor;
if Wall.FGLObject = nil then
Wall.FGLObject := glObject; //çàïîìèíàåì ó ñòåíû êàêîé åé ïðåíàäëåæèò îáúåêò GLScene
glLine := TGLLines(glObject);
//Ðàñïðåäåëÿåì êîîðäèíàòû...
case Face.RecType of
ftNetCeiling: pArr := Wall.FParent.FCeilingConture;
ftNetFloor: pArr := Wall.FParent.FFloorConture;
end;
pCnt := length(pArr);
{ //Êîððåêòèðîâêà êîîðäèíàòû Z////////////////////////////////////////////////////////
for k := 0 to pCnt-1 do //
begin //
p := pArr[k]; //
if (p.x = Wall.FPlanObject.p1.x)and(p.y = Wall.FPlanObject.p1.y) then //
Wall.FPlanObject.p1.z := p.z+ FZOrder * UOMToMetre(1000 / FCAD.PCad.MapScale);//
if (p.x = Wall.FPlanObject.p2.x)and(p.y = Wall.FPlanObject.p2.y) then //
Wall.FPlanObject.p2.z := p.z+ FZOrder * UOMToMetre(1000 / FCAD.PCad.MapScale);//
if (p.x = Wall.FPlanObject.l1.x)and(p.y = Wall.FPlanObject.l1.y) then //
Wall.FPlanObject.p1.z := p.z+ FZOrder * UOMToMetre(1000 / FCAD.PCad.MapScale);//
if (p.x = Wall.FPlanObject.l2.x)and(p.y = Wall.FPlanObject.l2.y) then //
Wall.FPlanObject.p2.z := p.z+ FZOrder * UOMToMetre(1000 / FCAD.PCad.MapScale);//
if (p.x = Wall.FPlanObject.r1.x)and(p.y = Wall.FPlanObject.r1.y) then //
Wall.FPlanObject.p1.z := p.z+ FZOrder * UOMToMetre(1000 / FCAD.PCad.MapScale);//
if (p.x = Wall.FPlanObject.r2.x)and(p.y = Wall.FPlanObject.r2.y) then //
Wall.FPlanObject.p2.z := p.z+ FZOrder * UOMToMetre(1000 / FCAD.PCad.MapScale);//
end; } //
xNet := t3droom(T3dside(xNode.Data).FParent).FPlanObject;
//Êîððåêòèðîâêà êîîðäèíàòû Z â òî÷êàõ P1 è P2
Wall.FPlanObject.p1.z := GetZPoint(xNet,Wall.FPlanObject.p1) + FZOrder * UOMToMetre(1000 / FCAD.PCad.MapScale);
Wall.FPlanObject.p2.z := GetZPoint(xNet,Wall.FPlanObject.p2) + FZOrder * UOMToMetre(1000 / FCAD.PCad.MapScale);
p := DoublePoint(Wall.FPlanObject.p1.x * factor, Wall.FPlanObject.p1.z * factor + FDeltaZ, Wall.FPlanObject.p1.y * factor);
glLine.AddNode(p.x, p.y, p.z); //Êîîðäèíàòû òî÷êè 1 ëèíèè(ãðàíè)
Wall.FGLPOints[0] := p;
p := DoublePoint(Wall.FPlanObject.p2.x * factor, Wall.FPlanObject.p2.z * factor + FDeltaZ,Wall.FPlanObject.p2.y * factor);
glLine.AddNode(p.x, p.y, p.z); //êîîðäèíàòû òî÷êè 2 ëèíèè(ãðàíè)
Wall.FGLPOints[1] := p;
glLine.NodeSize := 0;
glLine.ShowAxes := False;
gLLine.LineWidth := 2;
glLine.AntiAliased := True;
glLine.NodesAspect := lnaInvisible;
glLine.Visible := false;
glLine.LineColor.AsWinColor := clYellow;
break;
end;
end;
end;
end;
//Ðàñïàðñèâàåì óãëû
if (TObject(xNode.Data) is T3dside) and
(TObject(T3dside(xNode.Data).FParent) is t3droom) then
begin
if t3droom(T3dside(xNode.Data).FParent).FCorner <> nil then
begin
for iCorner := 0 to t3droom(T3dside(xNode.Data).FParent).FCorner.Count - 1 do
begin
xCorner := T3DCorner(t3droom(T3dside(xNode.Data).FParent).FCorner[icorner]);
for iModelCnt := 0 to ModelTree.Items.Count - 1 do //Íàõîäèì ñîîòâåòñòâóþùóþ ñòåíó ñ ModelTree////
begin
{ if AnsiUpperCase(Wall.FName) = AnsiUpperCase(ModelTree.Items[iModelCnt].Text) then //
begin //
if Wall.FParent.FName = ModelTree.Items[iModelCnt].Parent.Text then //
begin }
if TObject(ModelTree.Items[iModelCnt].Data) is T3DCorner then
begin
if T3DCorner(ModelTree.Items[iModelCnt].Data) = xCorner then //
begin
CornerNode := ModelTree.Items[iModelCnt]; // Çàïîìèíàåì íàéäåííûé íîä â äåðåâå
glObject := DummyCube.AddNewChild(TGLLines); //Äîáàâëåíèå ôèãóðû â DummyCube (ëèíèÿ)
glObject.TagObject := CornerNode; //ñâÿçûâàåì å¸ ñ âåòêîé íîäà
xCorner.FZOrder := FZOrder * UOMToMetre(1000 / FCAD.PCad.MapScale) * factor;
if xCorner.FGLObject = nil then
xCorner.FGLObject := glObject; //çàïîìèíàåì ó ñòåíû êàêîé åé ïðåíàäëåæèò îáúåêò GLScene
glLine := TGLLines(glObject);
//Ðàñïðåäåëÿåì êîîðäèíàòû...
case Face.RecType of
ftNetCeiling: pArr := xCorner.FParent.FCeilingConture;
end;
pCnt := length(pArr);
{ //Êîððåêòèðîâêà êîîðäèíàòû Z///////////////////////////////////////////////////
for k := 0 to pCnt-1 do //
begin //
p := pArr[k]; //
//if (Round(xCorner.FPoints.x) = Round(p.x))and (Round(xCorner.FPoints.y) = Round(p.y)) then
if (EQDP(xCorner.FPoints,p))then
xCorner.FPoints.z := p.z+ FZOrder * UOMToMetre(1000 / FCAD.PCad.MapScale);
end; }
xCorner.FPoints.z := xCorner.FPoints.z + FZOrder * UOMToMetre(1000 / FCAD.PCad.MapScale);
p := DoublePoint(xCorner.FPoints.x* factor,xCorner.FPoints.z* factor + FDeltaZ,xCorner.FPoints.y* factor);
glLine.AddNode(p.x, p.y, p.z); //Êîîðäèíàòû òî÷êè 1 ëèíèè(ãðàíè)
SetLength(xCorner.FGLPOints,1);
xCorner.FGLPOints[0] := p;
p.y := (xCorner.FPoints.z+1) * factor + FDeltaZ;
glLine.AddNode(p.x, p.y, p.z); //êîîðäèíàòû òî÷êè 2 ëèíèè(ãðàíè)
glLine.NodeSize := 0;
glLine.ShowAxes := False;
gLLine.LineWidth := 6;
glLine.AntiAliased := True;
glLine.NodesAspect := lnaInvisible;
glLine.Visible := false;
glLine.LineColor.AsWinColor := clGreen;
break;
end;
end;
end;
end;
end;
end;
end;
end;
end;
//******************\ROOF*******************
end;
//// *********** FACES.COUNT *************************************************
//FCAD.FActiveNet;
// Factor := 0.15;
if tx > tz then
Gtx := tx
else
Gtx := tz;
cx := ((tx+bx) / 2) * Factor;
cy := ((ty+by) / 2) * Factor;
cz := ((tz+bz) / 2) * Factor;
Cpoint := DoublePoint(cx,cy,cz);
Opoint := DoublePoint(cx,(by * factor) - 5,tz * factor);
MainCenter.Position.X := cx;
//MainCenter.Position.Y := cy;
MainCenter.Position.Z := cz;
//Ýòî ïîä êàêèì îáçîðîì êàìåðà ñìîòðèò íà ïîñòðîåííóþ ìîäåëü//////
GLCamera.Position.x := cx; //
GLCamera.Position.y := cy; //
GLCamera.Position.z := tz * factor + 40; //
{$IF Not Defined(ES_GRAPH_SC)}
try
GLPlane1.Material.Texture.Image.LoadFromFile(GetPathToSCSTmpDir + '\3d.jpg');
except
ShowMessage('File not found ' + GetPathToSCSTmpDir + '\3d.jpg');
end;
GLPlane1.Position.y := GLPlane1.Position.y - 0.032;
{$ELSE}
GLPlane1.Position.y := GLPlane1.Position.y - FDeltaZPlane; //
{$IFEND}
GLPlane1.Scale.Y := FCAD.PCad.WorkHeight * factor;
GLPlane1.Scale.X := FCAD.PCad.WorkWidth * factor;
//Alex(20.12.2010)
FirstCameraPosIsSet := False;
try
if F3DModel.FRooms.Count > 0 then
begin
xRoom := T3DRoom(F3DModel.FRooms[0]);
if ((xRoom.FFloor <> nil) and (xRoom.FCeiling <> nil)) then
begin
GetRoomBounds(RoomMin, RoomMax, xRoom.FFloor.FGLPoints, xRoom.FCeiling.FGLPoints);
RoomSize.x := abs(RoomMax.x - RoomMin.x);
RoomSize.y := abs(RoomMax.y - RoomMin.y);
RoomSize.z := abs(RoomMax.z - RoomMin.z);
SetPos.x := abs(RoomMax.x + RoomMin.x) / 2;
SetPos.y := abs(RoomMax.y + RoomMin.y) / 2;
SetPos.z := abs(RoomMax.z + RoomMin.z) / 2;
FirstCameraPosIsSet := True;
end else
FirstCameraPosIsSet := False;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.sbFirstFaceClick', E.Message);
end;
if not FirstCameraPosIsSet then
begin
SetPos.x := 0;
SetPos.y := 2.7;
SetPos.z := 0;
FirstCameraPosIsSet := True;
end;
FirstPerson.Position.X := SetPos.x;
FirstPerson.Position.Y := SetPos.y;
FirstPerson.Position.Z := SetPos.z;
//--
// Êàìåðà â ïåðñïåêòèâíûé âèä
glCamera.CameraStyle := csPerspective;
GLCamera.FocalLength := 160;
GLCamera.DepthOfView := Trunc(100 * gtx/400);
if GLCamera.DepthOfView > 500 then
GLCamera.DepthOfView := 500;
if GLCamera.DepthOfView < 100 then
GLCamera.DepthOfView := 100;
if Factor > 0.15 then
begin
GLCamera.DepthOfView := Trunc(100 * Factor / 0.15);
FirstPersonCamera.DepthOfView := Trunc(100 * Factor / 0.15);
end;
lbViewType.Caption := cForm3D_Mes3;
AfterUpdate;
except
on E: Exception do AddExceptionToLogEx('Form3d.UpdateFaces', E.Message);
end;
end;
procedure Tfrm3D.SetCubeBounds(var glCube: TGLCube; Points: T3dPointArray; Factor:Double);
var p1,p2,p3,p4,p5: T3DPoint;
px,py,pz: Double;
len,w,h: Double;
mp,xp1,xp2: TDoublePoint;
mp3: T3dPoint;
begin
p1 := Points[0];
p2 := Points[1];
p3 := Points[2];
p4 := Points[3];
p5 := Points[4];
xp1 := DoublePOint(p1.x,p1.y);
xp2 := DoublePOint(p3.x,p3.y);
mp := MPoint(xp1,xp2);
pz := (p1.z+p5.z) /2;
mp3 := DoublePOint(mp,pz);
xp1 := DoublePoint(p1.x,p1.y);
xp2 := DoublePoint(p2.x,p2.y);
len := GetLineLenght(xp1,xp2);
xp1 := DoublePoint(p1.x,p1.y);
xp2 := DoublePoint(p4.x,p4.y);
w := GetLineLenght(xp1,xp2);
h := abs(p1.z-p5.z);
glCube.Position.X := mp3.x*factor;
glCube.Position.Y := mp3.z*factor;
glCube.Position.Z := mp3.y*factor;
glCube.CubeWidth := h*factor;
glCube.CubeDepth := w*factor;
glCube.CubeHeight := len*factor;
end;
procedure Tfrm3D.SpeedButton1Click(Sender: TObject);
begin
glCamera.CameraStyle := csPerspective;
GLCamera.FocalLength := 160;
GLSceneViewer.Camera := GLCamera;
GLLightFirstPerson.Shining := False;
Light.Shining := True;
lbViewType.Caption := cForm3D_Mes3;
end;
procedure Tfrm3D.SpeedButton2Click(Sender: TObject);
begin
glCamera.CameraStyle := csOrthogonal;
GLCamera.FocalLength := 1.7;
GLSceneViewer.Camera := GLCamera;
GLLightFirstPerson.Shining := False;
Light.Shining := True;
lbViewType.Caption := cForm3D_Mes4;
end;
(*
procedure Tfrm3D.cmbCenterClick(Sender: TObject);
var xObject:TObject;
begin
if CmbCenter.ItemIndex = -1 then
exit;
xObject := CmbCenter.Items.Objects[cmbCenter.ItemIndex];
if not assigned(xObject) then
exit;
//GLCamera1.TargetObject := TGLDummyCube(xObject);
end;
*)
procedure Tfrm3D.FormShow(Sender: TObject);
begin
{$IF Defined(ES_GRAPH_SC)}
// Íåëüçÿ íàçíà÷àòü çäåñü òàéìåð
//TimerOnSelectNodes.OnTimer := TimerOnSelectNodesTimer;
{$IFEND}
if GReadOnlyMode then
sbApplyScsModel.Enabled := False;
// UpdateModelTree;
cbViewCeiling.Checked := True;
{$IF Not Defined(ES_GRAPH_SC)}
cbViewCeiling.Visible := False;
//20.12.2011 sbSaveModel.Visible := False;
//20.12.2011 panObjects.Visible := False;
//20.12.2011 Splitter1.Visible := False;
TabArchModel.TabVisible := false;
TabScsModel.TabVisible := false;
pcTree.ActivePage := TabScsModel;
TabArchProps.TabVisible := false;
TabArchModel.TabVisible := false;
pcProps.ActivePage := TabArchModel;
cbShowTraceCaptions.Top := 11;
{$IFEND}
{$if Defined(ES_GRAPH_SC)}
sbApplyScsModel.Visible := False;
cbShowTraceCaptions.Visible := False;
TabScsModel.TabVisible := False;
{$ifend}
SetAllPanels(False);
SetAllScsPanels(False);
LoadSelectionData;
GLCadencer.Enabled := True;
end;
procedure Tfrm3D.GLHeightField1GetHeight(const x, y: Single; var z: Single;
var color: TVector4f; var texPoint: TTexPoint);
begin
z := 0;
end;
procedure Tfrm3D.FormMouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
var
i, j: integer;
s: Single;
shiftDown : Boolean;
ctrlDown : Boolean;
Res1: TWinControl;
Pt: TPoint;
glObject, glObject1: TGLFreeForm;
pScale: Double;
xConn: T3DConnector;
begin
pScale := 0.1; // 10%
pScale := WheelDelta / 120 * pScale;
GetCursorPos(Pt);
Res1 := FindControl(WindowFromPoint(Pt));
if (Res1 = nil) or (Res1.name <> 'GLSceneViewer') then
exit;
shiftDown := (IsKeyDown(VK_LShift) or IsKeyDown(VK_RSHIFT));
ctrlDown := (IsKeyDown(VK_LCONTROL) or IsKeyDown(VK_RCONTROL));
if ctrlDown then
begin
{*** Scaling FreeForm ***}
if (FSelection.Count = 1) and is3DSObject(TGLBaseSceneObject(FSelection[0])) then
begin
DoScale3dsObject(WheelDelta);
end
else if isConnectorObject(TGLBaseSceneObject(FSelection[0])) then
begin
DoScaleConnectorObjects(WheelDelta);
end
{*** Scaling FreeForm ***}
else
begin
for i := 0 to DummyCube.Count - 1 do
begin
if shiftdown then
begin
if DummyCube.Children[i].ClassName = 'TGLSpaceText' then
begin
if WheelDelta < 0 then
begin
if DummyCube.Children[i].Scale.X >= 0.01 then
begin
DummyCube.Children[i].Scale.X := DummyCube.Children[i].Scale.X + WheelDelta / 24000;
DummyCube.Children[i].Scale.Y := DummyCube.Children[i].Scale.Y + WheelDelta / 24000;
DummyCube.Children[i].Scale.Z := DummyCube.Children[i].Scale.Z + WheelDelta / 24000;
end;
end
else
begin
DummyCube.Children[i].Scale.X := DummyCube.Children[i].Scale.X + WheelDelta / 24000;
DummyCube.Children[i].Scale.Y := DummyCube.Children[i].Scale.Y + WheelDelta / 24000;
DummyCube.Children[i].Scale.Z := DummyCube.Children[i].Scale.Z + WheelDelta / 24000;
end;
end;
end
else
begin
{$IF Defined(ES_GRAPH_SC)}
{$ELSE}
if DummyCube.Children[i].ClassName = 'TGLFreeForm' then
begin
if WheelDelta < 0 then
begin
if DummyCube.Children[i].Scale.X >= 0.01 then
begin
DummyCube.Children[i].Scale.X := DummyCube.Children[i].Scale.X + WheelDelta / 24000;
DummyCube.Children[i].Scale.Y := DummyCube.Children[i].Scale.Y + WheelDelta / 24000;
DummyCube.Children[i].Scale.Z := DummyCube.Children[i].Scale.Z + WheelDelta / 24000;
end;
end
else
begin
DummyCube.Children[i].Scale.X := DummyCube.Children[i].Scale.X + WheelDelta / 24000;
DummyCube.Children[i].Scale.Y := DummyCube.Children[i].Scale.Y + WheelDelta / 24000;
DummyCube.Children[i].Scale.Z := DummyCube.Children[i].Scale.Z + WheelDelta / 24000;
end;
end;
{$IFEND}
end;
end;
end;
end
else
begin
//Alex(17.12.2010) Îòêë èçìåíåíèÿ FocalLength ïðè âèäå îò ïåðâîãî ëèöà
if GLSceneViewer.Camera = FirstPersonCamera then
begin
if WheelDelta > 0 then
FirstPersonCamera.FocalLength := FirstPersonCamera.FocalLength + 5
else
FirstPersonCamera.FocalLength := FirstPersonCamera.FocalLength - 5;
end;
if GLSceneViewer.Camera <> FirstPersonCamera then
begin
s := GLSceneViewer.Camera.FocalLength;
if shiftdown then
begin
if GLSceneViewer.Camera.CameraStyle = csPerspective then
GLSceneViewer.Camera.FocalLength := s + WheelDelta / 80
else
GLSceneViewer.Camera.FocalLength := s + WheelDelta / 2420;
end
else
begin
if GLSceneViewer.Camera.CameraStyle = csPerspective then
GLSceneViewer.Camera.FocalLength := s + WheelDelta / 20
else
GLSceneViewer.Camera.FocalLength := s + WheelDelta / 540;
end;
end;
end
end;
procedure Tfrm3D.SpeedButton3Click(Sender: TObject);
var
Save3D: TSaveDialog;
Jpeg: TJPEGImage;
Bmp: TBitmap;
BmpFileName: string;
bmpx, bmpy: Integer;
begin
try
if GLSceneViewer.Camera = FirstPersonCamera then
begin
ShowMessage('Íåäîñòóïíî â ðåæèìå ïðîñìîòðà "Îò ïåðâîãî ëèöà"!');
Exit;
end;
{$IF Defined(ES_GRAPH_SC)}
{$ELSE}
{//04.01.2012
if GLSceneViewer.Camera.CameraStyle = csPerspective then
begin
ShowMessage(cForm3D_Mes2);
Exit;
end;}
{$IFEND}
Save3D := TSaveDialog.Create(nil);
with Save3D do
begin
InitialDir := GetEXEDir;
Title := cForm3D_Mes1;
Filter := '(*.jpg)|*.jpg';
DefaultExt := '*.jpg';
FileName := '';
Options := [ofReadOnly,ofHideReadOnly,ofPathMustExist,ofFileMustExist,ofNoDereferenceLinks];
end;
if Save3D.Execute then
begin
if frm3D_Save.ShowModal = mrOk then
begin
Bmp := TBitmap.Create;
Jpeg := TJPEGImage.Create;
BmpFileName := ChangeFileExt(Save3D.FileName, '.bmp');
if frm3D_Save.rbLow.Checked then
begin
GLSceneViewer.Buffer.RenderToFile(BmpFileName, 300);
end;
if frm3D_Save.rbNormal.Checked then
begin
bmpx := GLSceneViewer.Buffer.Width * 2;
bmpy := GLSceneViewer.Buffer.Height * 2;
GLSceneViewer.Buffer.RenderToFile(BmpFileName, bmpx, bmpy);
end;
if frm3D_Save.rbHigh.Checked then
begin
bmpx := GLSceneViewer.Buffer.Width * 3;
bmpy := GLSceneViewer.Buffer.Height * 3;
GLSceneViewer.Buffer.RenderToFile(BmpFileName, bmpx, bmpy);
end;
Bmp.LoadFromFile(BmpFileName);
ConvertBMPToJpeg(Bmp, BmpFileName);
FreeAndNil(Bmp);
DeleteFile(BmpFileName);
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.SpeedButton3Click', E.Message);
end;
end;
{$IF Defined(ES_GRAPH_SC)}
function IfNodeSelectedInTree(aNode: TTreeNode): Boolean;
var i: Integer;
begin
Result := False;
for i := 0 to frm3D.ModelTree.SelectionCount -1 do
begin
if aNode = frm3D.ModelTree.Selections[i] then
begin
Result := true;
Break;
end;
end;
end;
procedure ShowCornerSides(aCorner: T3DCorner);
var
i,j: Integer;
xNode: TTreeNode;
xWall: T3DWall;
begin
if aCorner.JoinedWalls = nil then Exit;
for i := 0 to frm3D.DummyCube.Count - 1 do
begin
xNode := TTreeNode(frm3D.DummyCube.Children[i].TagObject);
if xNode <> nil then
for j := 0 to aCorner.JoinedWalls.Count - 1 do
begin
xWall:= T3DWall(aCorner.JoinedWalls[j]);
if xNode.Data = xWall then
begin
frm3D.DummyCube.Children[i].Visible := True;
Break;
end;
end;
end;
end;
procedure ShowSideSubSides(aSide: T3DSide);
var
i,j: Integer;
xNode: TTreeNode;
xWall: T3DWall;
xCorner: T3DCorner;
begin
if not (TObject(aSide.FParent) is T3DRoom) then Exit;
for i := 0 to frm3D.DummyCube.Count - 1 do
begin
xNode := TTreeNode(frm3D.DummyCube.Children[i].TagObject);
if xNode <> nil then
begin
for j := 0 to T3DRoom(aSide.FParent).FWalls.Count - 1 do
begin
xWall:= T3DWall(T3DRoom(aSide.FParent).FWalls[j]);
if xNode.Data = xWall then
begin
frm3D.DummyCube.Children[i].Visible := True;
Break;
end;
end;
for j := 0 to T3DRoom(aSide.FParent).FCorner.Count - 1 do
begin
xCorner := T3DCorner(T3DRoom(aSide.FParent).FCorner[j]);
if xNode.Data = xCorner then
begin
frm3D.DummyCube.Children[i].Visible := True;
Break;
end;
end;
end;
end;
end;
{$IFEND}
procedure Tfrm3D.cbViewCeilingClick(Sender: TObject);
var
i: integer;
xNode: TTreeNode;
begin
try
for i := 0 to DummyCube.Count - 1 do
begin
if (DummyCube.Children[i].TagObject <> nil) then
begin
xNode := TTreeNode(DummyCube.Children[i].TagObject);
// âêëþ÷èòü/âûêëþ÷èòü ïîòîëîê è ïîë
if cbViewCeiling.Checked then
begin
{$IF Defined(ES_GRAPH_SC)}
if TObject(xNode.Data) is T3dSide then
begin
if T3dSide(xNode.Data).FFaceType = ftNetCeiling then
begin
if xNode <> nil then
begin
if xNode.ImageIndex < 1000 then
DummyCube.Children[i].Visible := True;
end
else
DummyCube.Children[i].Visible := True;
end;
if T3dSide(xNode.Data).FFaceType = ftNetFloor then
begin
if xNode <> nil then
begin
if xNode.ImageIndex < 1000 then
DummyCube.Children[i].Visible := True;
end
else
DummyCube.Children[i].Visible := True;
end;
end;
//Äîáàâëåíî 13.12.2013 Ìèòÿé Ä.Â.
//Îòîáðàæåíèå ðåáåð ñòåíû(Ëèíèé)
if IfNodeSelectedInTree(xNode) then
begin
if TObject(xNode.Data) is T3DWall then
DummyCube.Children[i].Visible := True;
if TObject(xNode.Data) is T3DCorner then
begin
ShowCornerSides(T3DCorner(xNode.Data));
DummyCube.Children[i].Visible := True;
end;
if TObject(xNode.Data) is T3DSide then
begin
DummyCube.Children[i].Visible := True;
ShowSideSubSides(T3DSide(xNode.Data));
end;
end;
{$ELSE}
if T3dSide(xNode.Data).FFaceType = ftNetCeiling then
begin
if xNode <> nil then
begin
if xNode.ImageIndex < 1000 then
DummyCube.Children[i].Visible := True;
end
else
DummyCube.Children[i].Visible := True;
end;
if T3dSide(xNode.Data).FFaceType = ftNetFloor then
begin
if xNode <> nil then
begin
if xNode.ImageIndex < 1000 then
DummyCube.Children[i].Visible := True;
end
else
DummyCube.Children[i].Visible := True;
end;
{$IFEND}
end
else
begin
{$IF Defined(ES_GRAPH_SC)}
if TObject(xNode.Data) is T3dSide then
begin
if T3dSide(xNode.Data).FFaceType = ftNetCeiling then
DummyCube.Children[i].Visible := False;
if T3dSide(xNode.Data).FFaceType = ftNetFloor then
DummyCube.Children[i].Visible := False;
end;
//Äîáàâëåíî 10.12.2013 Ìèòÿé Ä.Â.
//Ñêðûòèå îòîáðàæåíèÿ ðåáåð ñòåíû(Ëèíèé)
if TObject(xNode.Data) is T3DWall then
DummyCube.Children[i].Visible := False;
if TObject(xNode.Data) is T3DCorner then
DummyCube.Children[i].Visible := False;
{$ELSE}
if T3dSide(xNode.Data).FFaceType = ftNetCeiling then
DummyCube.Children[i].Visible := False;
if T3dSide(xNode.Data).FFaceType = ftNetFloor then
DummyCube.Children[i].Visible := False;
{$IFEND}
end;
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.cbViewCeilingClick', E.Message);
end;
GLSceneViewer.SetFocus;
end;
procedure Tfrm3D.AddWall(aWall: TGLMesh; vs: array of TVector3f);
var
vd: array [1..6] of TVertexData;
pN, pP: TVector3f;
mat: TAffineMatrix;
begin
try
pN := CalcPlaneNormal (vs[0], vs[1], vs[2]);
SetVector (mat[2], pN);
SetVector (mat[0], VectorNormalize (VectorSubtract (vs[1], vs[0])));
SetVector (mat[1], VectorCrossProduct (mat[2], mat[0]));
InvertMatrix (mat);
with vd[1] do begin
coord := vs[0];
normal := pN;
pP := VectorTransform (vs[0], mat);
textCoord := TexPointMake (pP[0], pP[1]);
end;
with vd[2] do begin
coord := vs[1];
normal := pN;
pP := VectorTransform (vs[1], mat);
textCoord := TexPointMake (pP[0], pP[1]);
end;
with vd[3] do begin
coord := vs[2];
normal := pN;
pP := VectorTransform (vs[2], mat);
textCoord := TexPointMake (pP[0], pP[1]);
end;
with vd[4] do begin
coord := vs[3];
normal := pN;
pP := VectorTransform (vs[3], mat);
textCoord := TexPointMake (pP[0], pP[1]);
end;
with vd[5] do begin
coord := vs[4];
normal := pN;
pP := VectorTransform (vs[4], mat);
textCoord := TexPointMake (pP[0], pP[1]);
end;
with vd[6] do begin
coord := vs[5];
normal := pN;
pP := VectorTransform (vs[5], mat);
textCoord := TexPointMake (pP[0], pP[1]);
end;
aWall.Vertices.AddVertex (vd[1]);
aWall.Vertices.AddVertex (vd[2]);
aWall.Vertices.AddVertex (vd[3]);
aWall.Vertices.AddVertex (vd[4]);
aWall.Vertices.AddVertex (vd[5]);
aWall.Vertices.AddVertex (vd[6]);
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.AddFloor', E.Message);
end;
end;
procedure Tfrm3D.AddFloor(aFloor: TGLMesh; vs: array of TVector3f; aSide: T3DSide);
var
vd: TVertexData;
pN, pP: TVector3f;
pN2: TVector3f;
vs0, vs1, vs2: TVector3f;
mat: TAffineMatrix;
i, k, Cnt: Integer;
Angle1, Angle2, ResAng: Double;
dp1, dp2: TDoublePoint;
begin
try
Cnt := Length(vs);
//pN := CalcPlaneNormal (vs[0], vs[1], vs[2]);
pN2[0] := 0;
pN2[1] := 1;
pN2[2] := 0;
if Cnt >= 3 then
begin
for k := 0 to Cnt - 3 do
begin
dp1 := DoublePoint(vs[0][0], vs[0][2], vs[0][1]);
dp2 := DoublePoint(vs[k + 1][0], vs[k + 1][2], vs[k + 1][1]);
Angle1 := GetLineAngle(dp1, dp2);
dp1 := DoublePoint(vs[k + 1][0], vs[k + 1][2], vs[k + 1][1]);
dp2 := DoublePoint(vs[k + 2][0], vs[k + 2][2], vs[k + 2][1]);
Angle2 := GetLineAngle(dp1, dp2);
ResAng := abs(Angle1 - Angle2);
if ResAng < 180 then
begin
pN := CalcPlaneNormal (vs[0], vs[k + 1], vs[k + 2]);
if (not isNaN(pN[0])) and (Not IsNaN(pN[1])) and (Not IsNaN(pN[2])) then
break;
end;
end;
if k > (Cnt - 1) then
k := 0;
SetVector(vs0, vs[0]);
SetVector(vs1, vs[k + 1]);
SetVector(vs2, vs[k + 2]);
end
else
begin
vs0[0] := 0; vs0[1] := 0; vs0[2] := 0;
vs1[0] := 100; vs1[1] := 0; vs1[2] := 0;
vs2[0] := 100; vs2[1] := 0; vs2[2] := 100;
end;
pN := CalcPlaneNormal (vs0, vs1, vs2);
SetVector (mat[2], pN);
SetVector (mat[0], VectorNormalize (VectorSubtract (vs1, vs0)));
SetVector (mat[1], VectorCrossProduct (mat[2], mat[0]));
InvertMatrix (mat);
for i := 0 to Cnt - 1 do
begin
vd.coord := vs[i];
vd.normal := pN;
pP := VectorTransform (vs[i], mat);
vd.textCoord := TexPointMake (pP[0], pP[1]);
aFloor.Vertices.AddVertex (vd);
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.AddFloor', E.Message);
end;
end;
procedure Tfrm3D.UpdateModelTree;
var
i, j, k, ii, jj, kk, cld: integer;
xModelNode, xListNode, xRoomNode, xCeilingNode, xFloorNode, xWallNode, xWallElementNode, xBalconElementNode, xSlopeNode, xSideNode, xNode: TTreeNode;
xRoom: T3DRoom;
xWall,xSecondWall: T3DWall;
xWallElement: T3DWallElement;
xBalconElement: T3DBalconElement;
xSlope: T3DSlope;
xSide: T3DSide;
ItsRoof: Boolean;
Str: string;
ip: TDoublePoint;
p: PDoublePoint;
CornerNode: TTreeNode;
xCorner: T3DCorner;
CornerName: string;
begin
try
xSecondWall := nil;
xModelNode := ModelTree.Items.GetFirstNode;
// äîáàâèòü ëèñò
Str := FCAD.FCADListName + ' ' + IntToStr(FCAD.FCADListIndex);
xListNode:= ModelTree.Items.AddChild(xModelNode, Str);
xListNode.Data := FCAD;
xListNode.ImageIndex := 1;
xListNode.SelectedIndex := xListNode.ImageIndex;
// ðàñïàðñèòü êîìíàòû
for i := 0 to F3DModel.FRooms.Count - 1 do
begin
ItsRoof := false;
xRoom := T3DRoom(F3DModel.FRooms[i]);
if (xRoom.FListID <> FCAD.FCADListID) or (not xRoom.FVisible) then
continue;
xRoomNode:= ModelTree.Items.AddChild(xListNode, xRoom.FName);
xRoomNode.Data := xRoom;
xRoomNode.ImageIndex := 47;
xRoomNode.SelectedIndex := xRoomNode.ImageIndex;
//26.11.2013 - Äîáàâëåíî Ìèòÿé Äìèòðèé ///////////////////////////////////////////////
// äîáàâèòü ïîòîëîê â êîìíàòû //
xSide := xRoom.FCeiling; //
for j := 0 to xRoom.FSCSCompon.Properties.Count - 1 do //
begin //
if PProperty(xRoom.FSCSCompon.Properties[j]).SysName = 'MATERIAL_TYPE' then //
begin //
ItsRoof := true; //
break; //
end; //
if PProperty(xRoom.FSCSCompon.Properties[j]).SysName = 'RESIDUE' then //
begin //
ItsRoof := true; //
break; //
end; //
end; //
if ItsRoof then //Åñëè ýòî êðûøà, çíà÷èò ìåíÿåì "Ïîòîëîê" íà "Ãðàíü êðûøè" //
xSide.FName := 'Ãðàíü êðûøè';
xNode := ModelTree.Items.AddChild(xRoomNode, xSide.FName);
xNode.Data := xSide;
xNode.ImageIndex := 56;
xNode.SelectedIndex := xNode.ImageIndex;
xSide.FFace.FTreeNode := xNode;
// äîáàâèòü ïîë â êîìíàòó, åñëè îí èìååòñÿ
if xRoom.FFloor <> nil then
begin
xSide := xRoom.FFloor;
xNode := ModelTree.Items.AddChild(xRoomNode, xSide.FName);
xNode.Data := xSide;
xNode.ImageIndex := 56;
xNode.SelectedIndex := xNode.ImageIndex;
xSide.FFace.FTreeNode := xNode;
end;
// ðàñïàðñèòü ñòåíû êàæäîé êîìíàòû
for j := 0 to xRoom.FWalls.Count - 1 do
begin
xWall := T3DWall(xRoom.FWalls[j]);
xWallNode:= ModelTree.Items.AddChild(xRoomNode, xWall.FName);
xWallNode.Data := xWall;
xWallNode.ImageIndex := 49;
xWallNode.SelectedIndex := xWallNode.ImageIndex;
// ðàñïàðñèòü ýëåìåíòû êàæäîé ñòåíû
for k := 0 to xWall.FWallElements.Count - 1 do
begin
xWallElement := T3DWallElement(xWall.FWallElements[k]);
// îêíî
if xWallElement.FElementType = dotWindow then
begin
xWallElementNode := ModelTree.Items.AddChild(xWallNode, xWallElement.FName);
xWallElementNode.Data := xWallElement;
xWallElementNode.ImageIndex := 52;
xWallElementNode.SelectedIndex := xWallElementNode.ImageIndex;
// äîáàâèòü îòêîñû
for ii := 0 to xWallElement.FSlopes.Count - 1 do
begin
xSlope := T3DSlope(xWallElement.FSlopes[ii]);
xSlopeNode := ModelTree.Items.AddChild(xWallElementNode, xSlope.FName);
xSlopeNode.Data := xSlope;
xSlopeNode.ImageIndex := 57;
xSlopeNode.SelectedIndex := xSlopeNode.ImageIndex;
// äîáàâòü ãðàíè îòêîñà
for jj := 0 to xSlope.FSides.Count - 1 do
begin
xSide := T3DSide(xSlope.FSides[jj]);
xNode := ModelTree.Items.AddChild(xSlopeNode, xSide.FName);
xNode.Data := xSide;
xNode.ImageIndex := 50;
xNode.SelectedIndex := xNode.ImageIndex;
xSide.FFace.FTreeNode := xNode;
end;
end;
end;
// äâåðü
if xWallElement.FElementType = dotDoor then
begin
xWallElementNode:= ModelTree.Items.AddChild(xWallNode, xWallElement.FName);
xWallElementNode.Data := xWallElement;
xWallElementNode.ImageIndex := 51;
xWallElementNode.SelectedIndex := xWallElementNode.ImageIndex;
// äîáàâèòü îòêîñû
for ii := 0 to xWallElement.FSlopes.Count - 1 do
begin
xSlope := T3DSlope(xWallElement.FSlopes[ii]);
xSlopeNode := ModelTree.Items.AddChild(xWallElementNode, xSlope.FName);
xSlopeNode.Data := xSlope;
xSlopeNode.ImageIndex := 57;
xSlopeNode.SelectedIndex := xSlopeNode.ImageIndex;
// äîáàâòü ãðàíè îòêîñà
for jj := 0 to xSlope.FSides.Count - 1 do
begin
xSide := T3DSide(xSlope.FSides[jj]);
xNode := ModelTree.Items.AddChild(xSlopeNode, xSide.FName);
xNode.Data := xSide;
xNode.ImageIndex := 50;
xNode.SelectedIndex := xNode.ImageIndex;
xSide.FFace.FTreeNode := xNode;
end;
end;
end;
// áàëêîí
if xWallElement.FElementType = dotBalcony then
begin
xWallElementNode:= ModelTree.Items.AddChild(xWallNode, xWallElement.FName);
xWallElementNode.Data := xWallElement;
xWallElementNode.ImageIndex := 55;
xWallElementNode.SelectedIndex := xWallElementNode.ImageIndex;
// äîáàâèòü îòêîñû
for ii := 0 to xWallElement.FSlopes.Count - 1 do
begin
xSlope := T3DSlope(xWallElement.FSlopes[ii]);
xSlopeNode := ModelTree.Items.AddChild(xWallElementNode, xSlope.FName);
xSlopeNode.Data := xSlope;
xSlopeNode.ImageIndex := 57;
xSlopeNode.SelectedIndex := xSlopeNode.ImageIndex;
// äîáàâòü ãðàíè îòêîñà
for jj := 0 to xSlope.FSides.Count - 1 do
begin
xSide := T3DSide(xSlope.FSides[jj]);
xNode := ModelTree.Items.AddChild(xSlopeNode, xSide.FName);
xNode.Data := xSide;
xNode.ImageIndex := 50;
xNode.SelectedIndex := xNode.ImageIndex;
xSide.FFace.FTreeNode := xNode;
end;
end;
// äîáàâèòü ýëåìåíòû áàëêîíà
for ii := 0 to xWallElement.FBalconElements.Count - 1 do
begin
xBalconElement := T3DBalconElement(xWallElement.FBalconElements[ii]);
if xBalconElement.FElementType = dotDoor then
begin
xBalconElementNode := ModelTree.Items.AddChild(xWallElementNode, xBalconElement.FName);
xBalconElementNode.ImageIndex := 51;
xBalconElementNode.SelectedIndex := xBalconElementNode.ImageIndex;
end;
if xBalconElement.FElementType = dotWindow then
begin
xBalconElementNode := ModelTree.Items.AddChild(xWallElementNode, xBalconElement.FName);
xBalconElementNode.ImageIndex := 52;
xBalconElementNode.SelectedIndex := xBalconElementNode.ImageIndex;
end;
xBalconElementNode.Data := xBalconElement;
// äîáàâòü ãðàíè ýëåìåíòà áàëêîíà
for jj := 0 to xBalconElement.FSides.Count - 1 do
begin
xSide := T3DSide(xBalconElement.FSides[jj]);
xNode := ModelTree.Items.AddChild(xBalconElementNode, xSide.FName);
xNode.Data := xSide;
xNode.ImageIndex := 50;
xNode.SelectedIndex := xNode.ImageIndex;
xSide.FFace.FTreeNode := xNode;
end;
end;
end;
// íèøà
if xWallElement.FElementType = dotNiche then
begin
xWallElementNode:= ModelTree.Items.AddChild(xWallNode, xWallElement.FName);
xWallElementNode.Data := xWallElement;
xWallElementNode.ImageIndex := 53;
xWallElementNode.SelectedIndex := xWallElementNode.ImageIndex;
end;
// àðêà
if xWallElement.FElementType = dotArc then
begin
xWallElementNode:= ModelTree.Items.AddChild(xWallNode, xWallElement.FName);
xWallElementNode.Data := xWallElement;
xWallElementNode.ImageIndex := 54;
xWallElementNode.SelectedIndex := xWallElementNode.ImageIndex;
end;
// äîáàâèòü ãðàíè äàííîãî ýëåìåíòà ñòåíû
for ii := 0 to xWallElement.FSides.Count - 1 do
begin
xSide := T3DSide(xWallElement.FSides[ii]);
xNode := ModelTree.Items.AddChild(xWallElementNode, xSide.FName);
xNode.Data := xSide;
xNode.ImageIndex := 50;
xNode.SelectedIndex := xNode.ImageIndex;
xSide.FFace.FTreeNode := xNode;
end;
end;
// äîáàâèòü ãðàíè ñòåíû
for k := 0 to xWall.FSides.Count - 1 do
begin
xSide := T3DSide(xWall.FSides[k]);
xNode := ModelTree.Items.AddChild(xWallNode, xSide.FName);
xNode.Data := xSide;
xNode.ImageIndex := 50;
xNode.SelectedIndex := xNode.ImageIndex;
xSide.FFace.FTreeNode := xNode;
end;
{
//Òóò ðàñïàðñèòü óãëû.Òàê êàê ïî÷òè âñÿ ïðîãà ïîñòðîåíà íà óêàçàòåëÿõ,
//øàã âïðàâî, øàã âëåâî - âçðûâ))) Ïîòîìó äîáàâëÿòü óãëû áóäåì ñëåäóþùèì îáðàçîì:
//Áåðåì äâå ñòåíû, òî÷íåå - èõ êîîðäèíàòû, è ïðîâåðÿåì íà ïåðåñåêàåìîñòü.
//Åñëè åñòü òî÷êà ïåðåñå÷åíèÿ - çíà÷èò ýòî óãîë, äîáàâëÿåì åãî. Ïîêà òàê...
for cld := j+1 to xRoom.FWalls.Count - 1 do
begin
xSecondWall := T3DWall(xRoom.FWalls[cld]);
if LinesCross(xSecondWall.FPlanObject.IP1^, xSecondWall.FPlanObject.IP2^, xWall.FPlanObject.IP1^, xWall.FPlanObject.IP2^) then
begin
//íàõîäèì òî÷êó ïåðåñå÷åíèÿ
if GetInterSectionPoint(xSecondWall.FPlanObject.IP1^, xSecondWall.FPlanObject.IP2^, xWall.FPlanObject.IP1^, xWall.FPlanObject.IP2^, ip) then
begin
CornerName := 'Óãîë äëÿ: ' + xSecondWall.FName + '/' + xWall.FName;
xCorner := T3DCorner.Create(xRoom,CornerName);
xCorner.JoinedWalls.Add(xSecondWall);
xCorner.JoinedWalls.Add(xWall);
CornerNode := ModelTree.Items.AddChild(xRoomNode, CornerName);
CornerNode.Data := xCorner;
CornerNode.ImageIndex := 3;
CornerNode.SelectedIndex := CornerNode.ImageIndex;
end;
end;
end; }
end;
//*****************ROOF***********************
{$IF Defined(ES_GRAPH_SC)}
if xRoom.FCorner <> nil then
begin
for cld := 0 to xRoom.FCorner.Count - 1 do
begin
xCorner := T3DCorner(xRoom.FCorner[cld]);
CornerNode := ModelTree.Items.AddChild(xRoomNode, xCorner.FName);
CornerNode.Data := xCorner;
CornerNode.ImageIndex := 3;
CornerNode.SelectedIndex := CornerNode.ImageIndex;
end;
end;
{$IFEND}
//*****************\ROOF**********************
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.UpdateModelTree', E.Message);
end;
end;
procedure Tfrm3D.UpdateScsModelTree;
var
i, j, k, ii, jj, kk: integer;
xModelNode, xListNode, xScsNode: TTreeNode;
xConn: T3DConnector;
xLine: T3DLine;
Str: string;
begin
try
xModelNode := ScsModelTree.Items.GetFirstNode;
// äîáàâèòü ëèñò
Str := FCAD.FCADListName + ' ' + IntToStr(FCAD.FCADListIndex);
xListNode:= ScsModelTree.Items.AddChild(xModelNode, Str);
xListNode.Data := FCAD;
xListNode.ImageIndex := 1;
xListNode.SelectedIndex := xListNode.ImageIndex;
// ðàñïàðñèòü êîìíàòû
for i := 0 to F3DModel.FScsObjects.Count - 1 do
begin
if TObject(F3DModel.FScsObjects[i]) is T3DConnector then
begin
xConn := T3DConnector(F3DModel.FScsObjects[i]);
if (xConn.FListID <> FCAD.FCADListID) then
Continue;
if (xConn.FConnType = ct_Empty) then
begin
xConn.FFace.F3DObject := xConn;
Continue;
end;
xScsNode := ScsModelTree.Items.AddChild(xListNode, xConn.FName);
xScsNode.Data := xConn;
xScsNode.ImageIndex := 3;
xScsNode.SelectedIndex := xScsNode.ImageIndex;
xConn.FFace.FTreeNode := xScsNode;
end;
if TObject(F3DModel.FScsObjects[i]) is T3DLine then
begin
xLine := T3DLine(F3DModel.FScsObjects[i]);
if (xLine.FListID <> FCAD.FCADListID) then
Continue;
xScsNode:= ScsModelTree.Items.AddChild(xListNode, xLine.FName);
xScsNode.Data := xLine;
xScsNode.ImageIndex := 2;
xScsNode.SelectedIndex := xScsNode.ImageIndex;
xLine.FFace.FTreeNode := xScsNode;
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.UpdateScsModelTree', E.Message);
end;
end;
procedure Tfrm3D.UpdateModelTreeFromStream(Faces: TList);
var
i, j, k, ii, jj, kk, iadd, cld: integer;
xModelNode, xListNode, xRoomNode, xCeilingNode, xFloorNode, xWallNode, xWallElementNode, xBalconElementNode, xSlopeNode, xSideNode, x3DSNode, xNode, xSubNode: TTreeNode;
xRoom, xStrRoom: T3DRoom;
xWall, xStrWall,xSecondWall: T3DWall;
xWallElement, xStrWallElement: T3DWallElement;
xBalconElement, xStrBalconElement: T3DBalconElement;
xSlope, xStrSlope: T3DSlope;
xSide, xStrSide, xAddSide, xSubSide, xStrSubSide: T3DSide;
xObject, xStrObject: T3DSObject;
FName: string;
Str: string;
CornerNode: TTreeNode;
ItsRoof: Boolean;
ip: TDoublePoint;
xCorner: T3DCorner;
CornerName: string;
begin
try
xModelNode := ModelTree.Items.GetFirstNode;
CopyModelHash;
// äîáàâèòü ëèñò
Str := FCAD.FCADListName + ' ' + IntToStr(FCAD.FCADListIndex);
xListNode:= ModelTree.Items.AddChild(xModelNode, Str);
xListNode.Data := FCAD;
xListNode.ImageIndex := 1;
xListNode.SelectedIndex := xListNode.ImageIndex;
// ðàñïàðñèòü êîìíàòû
for i := 0 to F3DModel.FRooms.Count - 1 do
begin
xRoom := T3DRoom(F3DModel.FRooms[i]);
ItsRoof := False;
if (xRoom.FListID <> FCAD.FCADListID) or (not xRoom.FVisible) then
continue;
xStrRoom := T3DRoom(getModelObjectByComponID(xRoom.FSCSComponID));
xRoomNode:= ModelTree.Items.AddChild(xListNode, xRoom.FName);
xRoomNode.Data := xRoom;
xRoomNode.ImageIndex := 47;
xRoomNode.SelectedIndex := xRoomNode.ImageIndex;
// äîáàâèòü ïîòîëîê â êîìíàòó
xSide := xRoom.FCeiling;
xStrSide := GetSimilarSide(xSide, xStrRoom);
//Ïðîâåðêà íà òî, êàê äîáàâëÿòü: "Ïîòîëîê" èëè "Ãðàíü êðûøè"//////////////////////////
for j := 0 to xRoom.FSCSCompon.Properties.Count - 1 do //
begin //
if PProperty(xRoom.FSCSCompon.Properties[j]).SysName = 'MATERIAL_TYPE' then //
begin //
ItsRoof := true; //
break; //
end; //
if PProperty(xRoom.FSCSCompon.Properties[j]).SysName = 'RESIDUE' then //
begin //
ItsRoof := true; //
break; //
end; //
end; //
if ItsRoof then //Åñëè ýòî êðûøà, çíà÷èò ìåíÿåì "Ïîòîëîê" íà "Ãðàíü êðûøè" //
xSide.FName := 'Ãðàíü êðûøè';
xNode := ModelTree.Items.AddChild(xRoomNode, xSide.FName);
xNode.Data := xSide;
xNode.ImageIndex := 56;
xNode.SelectedIndex := xNode.ImageIndex;
xSide.FFace.FTreeNode := xNode;
if xStrSide <> nil then
begin
CopySideProperties(xSide, xStrSide);
if xStrSide.FSubSides.Count > 0 then
begin
Faces.Remove(xSide.FFace);
for iadd := 0 to xStrSide.FSubSides.Count - 1 do
begin
xStrSubSide := T3DSide(xStrSide.FSubSides[iadd]);
xSubSide := CopySubSideProperties(xStrSubSide);
xSubNode := ModelTree.Items.AddChild(xNode, xSubSide.FName);
xSubNode.Data := xSubSide;
xSubNode.ImageIndex := 56;
xSubNode.SelectedIndex := xSubNode.ImageIndex;
xSubSide.FFace.FTreeNode := xSubNode;
Faces.Add(xSubSide.FFace);
xSubSide.FParent := xSide;
xSide.FSubSides.Add(xSubSide);
end;
end;
end;
// äîáàâèòü ïîë â êîìíàòó
if xRoom.FFloor <> nil then
begin
xSide := xRoom.FFloor;
xStrSide := GetSimilarSide(xSide, xStrRoom);
xNode := ModelTree.Items.AddChild(xRoomNode, xSide.FName);
xNode.Data := xSide;
xNode.ImageIndex := 56;
xNode.SelectedIndex := xNode.ImageIndex;
xSide.FFace.FTreeNode := xNode;
if xStrSide <> nil then
begin
CopySideProperties(xSide, xStrSide);
if xStrSide.FSubSides.Count > 0 then
begin
Faces.Remove(xSide.FFace);
for iadd := 0 to xStrSide.FSubSides.Count - 1 do
begin
xStrSubSide := T3DSide(xStrSide.FSubSides[iadd]);
xSubSide := CopySubSideProperties(xStrSubSide);
xSubNode := ModelTree.Items.AddChild(xNode, xSubSide.FName);
xSubNode.Data := xSubSide;
xSubNode.ImageIndex := 56;
xSubNode.SelectedIndex := xSubNode.ImageIndex;
xSubSide.FFace.FTreeNode := xSubNode;
Faces.Add(xSubSide.FFace);
xSubSide.FParent := xSide;
xSide.FSubSides.Add(xSubSide);
end;
end;
end;
end;
// äîáàâèòü 3äñ îáúåêòû
// !!! Åñëè íå èçìåíÿëèñü ðàçìåðû èëè ìåñòîðàñïîëîæåíèå êîìíàòû
if xStrSide <> nil then
begin
for j := 0 to xStrRoom.F3DSObjects.Count - 1 do
begin
FName := GetObjectFileByHash(T3DSObject(xStrRoom.F3DSObjects[j]).FObjectHash);
if FileExists(FName) then
begin
xStrObject := T3DSObject(xStrRoom.F3DSObjects[j]);
xObject := CopyObjectProperties(nil, xStrObject);
xNode := ModelTree.Items.AddChild(xRoomNode, xObject.FName);
xNode.Data := xObject;
xNode.ImageIndex := 42;
xNode.SelectedIndex := xNode.ImageIndex;
xObject.FFace.FTreeNode := xNode;
Faces.Add(xObject.FFace);
xObject.FParent := xRoom;
xRoom.F3DSObjects.Add(xObject);
end;
end;
end;
// ðàñïàðñèòü ñòåíû êàæäîé êîìíàòû
for j := 0 to xRoom.FWalls.Count - 1 do
begin
xWall := T3DWall(xRoom.FWalls[j]);
xStrWall := T3DWall(getModelObjectByComponID(xWall.FSCSComponID));
xWallNode:= ModelTree.Items.AddChild(xRoomNode, xWall.FName);
xWallNode.Data := xWall;
xWallNode.ImageIndex := 49;
xWallNode.SelectedIndex := xWallNode.ImageIndex;
// ðàñïàðñèòü ýëåìåíòû êàæäîé ñòåíû
for k := 0 to xWall.FWallElements.Count - 1 do
begin
xWallElement := T3DWallElement(xWall.FWallElements[k]);
xStrWallElement := T3DWallElement(getModelObjectByComponID(xWallElement.FSCSComponID));
// îêíî
if xWallElement.FElementType = dotWindow then
begin
xWallElementNode := ModelTree.Items.AddChild(xWallNode, xWallElement.FName);
xWallElementNode.Data := xWallElement;
xWallElementNode.ImageIndex := 52;
xWallElementNode.SelectedIndex := xWallElementNode.ImageIndex;
// äîáàâèòü îòêîñû
for ii := 0 to xWallElement.FSlopes.Count - 1 do
begin
xSlope := T3DSlope(xWallElement.FSlopes[ii]);
xStrSlope := T3DSlope(getModelObjectByComponID(xSlope.FSCSComponID));
xSlopeNode := ModelTree.Items.AddChild(xWallElementNode, xSlope.FName);
xSlopeNode.Data := xSlope;
xSlopeNode.ImageIndex := 57;
xSlopeNode.SelectedIndex := xSlopeNode.ImageIndex;
// äîáàâòü ãðàíè îòêîñà
for jj := 0 to xSlope.FSides.Count - 1 do
begin
xSide := T3DSide(xSlope.FSides[jj]);
xStrSide := GetSimilarSide(xSide, xStrSlope);
xNode := ModelTree.Items.AddChild(xSlopeNode, xSide.FName);
xNode.Data := xSide;
xNode.ImageIndex := 50;
xNode.SelectedIndex := xNode.ImageIndex;
xSide.FFace.FTreeNode := xNode;
if xStrSide <> nil then
begin
CopySideProperties(xSide, xStrSide);
if xStrSide.FSubSides.Count > 0 then
begin
Faces.Remove(xSide.FFace);
for iadd := 0 to xStrSide.FSubSides.Count - 1 do
begin
xStrSubSide := T3DSide(xStrSide.FSubSides[iadd]);
xSubSide := CopySubSideProperties(xStrSubSide);
xSubNode := ModelTree.Items.AddChild(xNode, xSubSide.FName);
xSubNode.Data := xSubSide;
xSubNode.ImageIndex := 56;
xSubNode.SelectedIndex := xSubNode.ImageIndex;
xSubSide.FFace.FTreeNode := xSubNode;
Faces.Add(xSubSide.FFace);
xSubSide.FParent := xSide;
xSide.FSubSides.Add(xSubSide);
end;
end;
end;
end;
end;
end;
// äâåðü
if xWallElement.FElementType = dotDoor then
begin
xWallElementNode:= ModelTree.Items.AddChild(xWallNode, xWallElement.FName);
xWallElementNode.Data := xWallElement;
xWallElementNode.ImageIndex := 51;
xWallElementNode.SelectedIndex := xWallElementNode.ImageIndex;
// äîáàâèòü îòêîñû
for ii := 0 to xWallElement.FSlopes.Count - 1 do
begin
xSlope := T3DSlope(xWallElement.FSlopes[ii]);
xStrSlope := T3DSlope(getModelObjectByComponID(xSlope.FSCSComponID));
xSlopeNode := ModelTree.Items.AddChild(xWallElementNode, xSlope.FName);
xSlopeNode.Data := xSlope;
xSlopeNode.ImageIndex := 57;
xSlopeNode.SelectedIndex := xSlopeNode.ImageIndex;
// äîáàâòü ãðàíè îòêîñà
for jj := 0 to xSlope.FSides.Count - 1 do
begin
xSide := T3DSide(xSlope.FSides[jj]);
xStrSide := GetSimilarSide(xSide, xStrSlope);
xNode := ModelTree.Items.AddChild(xSlopeNode, xSide.FName);
xNode.Data := xSide;
xNode.ImageIndex := 50;
xNode.SelectedIndex := xNode.ImageIndex;
xSide.FFace.FTreeNode := xNode;
if xStrSide <> nil then
begin
CopySideProperties(xSide, xStrSide);
if xStrSide.FSubSides.Count > 0 then
begin
Faces.Remove(xSide.FFace);
for iadd := 0 to xStrSide.FSubSides.Count - 1 do
begin
xStrSubSide := T3DSide(xStrSide.FSubSides[iadd]);
xSubSide := CopySubSideProperties(xStrSubSide);
xSubNode := ModelTree.Items.AddChild(xNode, xSubSide.FName);
xSubNode.Data := xSubSide;
xSubNode.ImageIndex := 56;
xSubNode.SelectedIndex := xSubNode.ImageIndex;
xSubSide.FFace.FTreeNode := xSubNode;
Faces.Add(xSubSide.FFace);
xSubSide.FParent := xSide;
xSide.FSubSides.Add(xSubSide);
end;
end;
end;
end;
end;
end;
// áàëêîí
if xWallElement.FElementType = dotBalcony then
begin
xWallElementNode:= ModelTree.Items.AddChild(xWallNode, xWallElement.FName);
xWallElementNode.Data := xWallElement;
xWallElementNode.ImageIndex := 55;
xWallElementNode.SelectedIndex := xWallElementNode.ImageIndex;
// äîáàâèòü îòêîñû
for ii := 0 to xWallElement.FSlopes.Count - 1 do
begin
xSlope := T3DSlope(xWallElement.FSlopes[ii]);
xStrSlope := T3DSlope(getModelObjectByComponID(xSlope.FSCSComponID));
xSlopeNode := ModelTree.Items.AddChild(xWallElementNode, xSlope.FName);
xSlopeNode.Data := xSlope;
xSlopeNode.ImageIndex := 57;
xSlopeNode.SelectedIndex := xSlopeNode.ImageIndex;
// äîáàâòü ãðàíè îòêîñà
for jj := 0 to xSlope.FSides.Count - 1 do
begin
xSide := T3DSide(xSlope.FSides[jj]);
xStrSide := GetSimilarSide(xSide, xStrSlope);
xNode := ModelTree.Items.AddChild(xSlopeNode, xSide.FName);
xNode.Data := xSide;
xNode.ImageIndex := 50;
xNode.SelectedIndex := xNode.ImageIndex;
xSide.FFace.FTreeNode := xNode;
if xStrSide <> nil then
begin
CopySideProperties(xSide, xStrSide);
if xStrSide.FSubSides.Count > 0 then
begin
Faces.Remove(xSide.FFace);
for iadd := 0 to xStrSide.FSubSides.Count - 1 do
begin
xStrSubSide := T3DSide(xStrSide.FSubSides[iadd]);
xSubSide := CopySubSideProperties(xStrSubSide);
xSubNode := ModelTree.Items.AddChild(xNode, xSubSide.FName);
xSubNode.Data := xSubSide;
xSubNode.ImageIndex := 56;
xSubNode.SelectedIndex := xSubNode.ImageIndex;
xSubSide.FFace.FTreeNode := xSubNode;
Faces.Add(xSubSide.FFace);
xSubSide.FParent := xSide;
xSide.FSubSides.Add(xSubSide);
end;
end;
end;
end;
end;
// äîáàâèòü ýëåìåíòû áàëêîíà
for ii := 0 to xWallElement.FBalconElements.Count - 1 do
begin
xBalconElement := T3DBalconElement(xWallElement.FBalconElements[ii]);
xStrBalconElement := T3DBalconElement(getModelObjectByComponID(xBalconElement.FSCSComponID));
if xBalconElement.FElementType = dotDoor then
begin
xBalconElementNode := ModelTree.Items.AddChild(xWallElementNode, xBalconElement.FName);
xBalconElementNode.ImageIndex := 51;
xBalconElementNode.SelectedIndex := xBalconElementNode.ImageIndex;
end;
if xBalconElement.FElementType = dotWindow then
begin
xBalconElementNode := ModelTree.Items.AddChild(xWallElementNode, xBalconElement.FName);
xBalconElementNode.ImageIndex := 52;
xBalconElementNode.SelectedIndex := xBalconElementNode.ImageIndex;
end;
xBalconElementNode.Data := xBalconElement;
// äîáàâòü ãðàíè ýëåìåíòà áàëêîíà
for jj := 0 to xBalconElement.FSides.Count - 1 do
begin
xSide := T3DSide(xBalconElement.FSides[jj]);
xStrSide := GetSimilarSide(xSide, xStrBalconElement);
xNode := ModelTree.Items.AddChild(xBalconElementNode, xSide.FName);
xNode.Data := xSide;
xNode.ImageIndex := 50;
xNode.SelectedIndex := xNode.ImageIndex;
xSide.FFace.FTreeNode := xNode;
if xStrSide <> nil then
begin
CopySideProperties(xSide, xStrSide);
if xStrSide.FSubSides.Count > 0 then
begin
Faces.Remove(xSide.FFace);
for iadd := 0 to xStrSide.FSubSides.Count - 1 do
begin
xStrSubSide := T3DSide(xStrSide.FSubSides[iadd]);
xSubSide := CopySubSideProperties(xStrSubSide);
xSubNode := ModelTree.Items.AddChild(xNode, xSubSide.FName);
xSubNode.Data := xSubSide;
xSubNode.ImageIndex := 56;
xSubNode.SelectedIndex := xSubNode.ImageIndex;
xSubSide.FFace.FTreeNode := xSubNode;
Faces.Add(xSubSide.FFace);
xSubSide.FParent := xSide;
xSide.FSubSides.Add(xSubSide);
end;
end;
end;
end;
end;
end;
// íèøà
if xWallElement.FElementType = dotNiche then
begin
xWallElementNode:= ModelTree.Items.AddChild(xWallNode, xWallElement.FName);
xWallElementNode.Data := xWallElement;
xWallElementNode.ImageIndex := 53;
xWallElementNode.SelectedIndex := xWallElementNode.ImageIndex;
end;
// àðêà
if xWallElement.FElementType = dotArc then
begin
xWallElementNode:= ModelTree.Items.AddChild(xWallNode, xWallElement.FName);
xWallElementNode.Data := xWallElement;
xWallElementNode.ImageIndex := 54;
xWallElementNode.SelectedIndex := xWallElementNode.ImageIndex;
end;
// äîáàâèòü ãðàíè äàííîãî ýëåìåíòà ñòåíû
for ii := 0 to xWallElement.FSides.Count - 1 do
begin
xSide := T3DSide(xWallElement.FSides[ii]);
xStrSide := GetSimilarSide(xSide, xStrWallElement);
xNode := ModelTree.Items.AddChild(xWallElementNode, xSide.FName);
xNode.Data := xSide;
xNode.ImageIndex := 50;
xNode.SelectedIndex := xNode.ImageIndex;
xSide.FFace.FTreeNode := xNode;
if xStrSide <> nil then
begin
CopySideProperties(xSide, xStrSide);
if xStrSide.FSubSides.Count > 0 then
begin
Faces.Remove(xSide.FFace);
for iadd := 0 to xStrSide.FSubSides.Count - 1 do
begin
xStrSubSide := T3DSide(xStrSide.FSubSides[iadd]);
xSubSide := CopySubSideProperties(xStrSubSide);
xSubNode := ModelTree.Items.AddChild(xNode, xSubSide.FName);
xSubNode.Data := xSubSide;
xSubNode.ImageIndex := 56;
xSubNode.SelectedIndex := xSubNode.ImageIndex;
xSubSide.FFace.FTreeNode := xSubNode;
Faces.Add(xSubSide.FFace);
xSubSide.FParent := xSide;
xSide.FSubSides.Add(xSubSide);
end;
end;
end;
end;
end;
// äîáàâèòü ãðàíè ñòåíû
for k := 0 to xWall.FSides.Count - 1 do
begin
xSide := T3DSide(xWall.FSides[k]);
xStrSide := GetSimilarSide(xSide, xStrWall);
xNode := ModelTree.Items.AddChild(xWallNode, xSide.FName);
xNode.Data := xSide;
xNode.ImageIndex := 50;
xNode.SelectedIndex := xNode.ImageIndex;
xSide.FFace.FTreeNode := xNode;
if xStrSide <> nil then
begin
CopySideProperties(xSide, xStrSide);
if xStrSide.FSubSides.Count > 0 then
begin
Faces.Remove(xSide.FFace);
for iadd := 0 to xStrSide.FSubSides.Count - 1 do
begin
xStrSubSide := T3DSide(xStrSide.FSubSides[iadd]);
xSubSide := CopySubSideProperties(xStrSubSide);
xSubNode := ModelTree.Items.AddChild(xNode, xSubSide.FName);
xSubNode.Data := xSubSide;
xSubNode.ImageIndex := 56;
xSubNode.SelectedIndex := xSubNode.ImageIndex;
xSubSide.FFace.FTreeNode := xSubNode;
Faces.Add(xSubSide.FFace);
xSubSide.FParent := xSide;
xSide.FSubSides.Add(xSubSide);
end;
end;
end;
end;
//*****************ROOF***********************
//Òóò ðàñïàðñèòü óãëû.Òàê êàê ïî÷òè âñÿ ïðîãà ïîñòðîåíà íà óêàçàòåëÿõ,
//øàã âïðàâî, øàã âëåâî - âçðûâ))) Ïîòîìó äîáàâëÿòü óãëû áóäåì ñëåäóþùèì îáðàçîì:
//Áåðåì äâå ñòåíû, òî÷íåå - èõ êîîðäèíàòû, è ïðîâåðÿåì íà ïåðåñåêàåìîñòü.
//Åñëè åñòü òî÷êà ïåðåñå÷åíèÿ - çíà÷èò ýòî óãîë, äîáàâëÿåì åãî. Ïîêà òàê...
{ for cld := j+1 to xRoom.FWalls.Count - 1 do
begin
xSecondWall := T3DWall(xRoom.FWalls[cld]);
if LinesCross(xSecondWall.FPlanObject.IP1^, xSecondWall.FPlanObject.IP2^, xWall.FPlanObject.IP1^, xWall.FPlanObject.IP2^) then
begin
//íàõîäèì òî÷êó ïåðåñå÷åíèÿ
if GetInterSectionPoint(xSecondWall.FPlanObject.IP1^, xSecondWall.FPlanObject.IP2^, xWall.FPlanObject.IP1^, xWall.FPlanObject.IP2^, ip) then
begin
CornerName := 'Óãîë äëÿ: ' + xSecondWall.FName + '/' + xWall.FName;
xCorner := T3DCorner.Create(xRoom,CornerName);
xCorner.JoinedWalls.Add(xSecondWall);
xCorner.JoinedWalls.Add(xWall);
CornerNode := ModelTree.Items.AddChild(xRoomNode, CornerName);
CornerNode.Data := xCorner;
CornerNode.ImageIndex := 3;
CornerNode.SelectedIndex := CornerNode.ImageIndex;
end;
end;
end;
}
//*****************\ROOF**********************
end;
//*****************ROOF***********************
{$IF Defined(ES_GRAPH_SC)}
if xRoom.FCorner <> nil then
begin
for cld := 0 to xRoom.FCorner.Count - 1 do
begin
xCorner := T3DCorner(xRoom.FCorner[cld]);
CornerNode := ModelTree.Items.AddChild(xRoomNode, xCorner.FName);
CornerNode.Data := xCorner;
CornerNode.ImageIndex := 3;
CornerNode.SelectedIndex := CornerNode.ImageIndex;
end;
end;
{$IFEND}
//*****************\ROOF**********************
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.UpdateModelTreeFromStream', E.Message);
end;
end;
procedure Tfrm3D.UpdateScsModelTreeFromStream(Faces: TList);
var
i, j, k, ii, jj, kk, iadd: integer;
xModelNode, xListNode, xScsNode: TTreeNode;
xConn, xStrConn: T3DConnector;
xLine, xStrLine: T3DLine;
FName: string;
Str: string;
begin
try
xModelNode := ScsModelTree.Items.GetFirstNode;
// äîáàâèòü ëèñò
Str := FCAD.FCADListName + ' ' + IntToStr(FCAD.FCADListIndex);
xListNode:= ScsModelTree.Items.AddChild(xModelNode, Str);
xListNode.Data := FCAD;
xListNode.ImageIndex := 1;
xListNode.SelectedIndex := xListNode.ImageIndex;
for i := 0 to F3DModel.FScsObjects.Count - 1 do
begin
if TObject(F3DModel.FScsObjects[i]) is T3DConnector then
begin
xConn := T3DConnector(F3DModel.FScsObjects[i]);
if (xConn.FListID <> FCAD.FCADListID) then
Continue;
if (xConn.FConnType = ct_Empty) then
begin
xConn.FFace.F3DObject := xConn;
Continue;
end;
xStrConn := T3DConnector(getModelObjectByComponID(xConn.FSCSComponID, 2));
xScsNode:= ScsModelTree.Items.AddChild(xListNode, xConn.FName);
xScsNode.Data := xConn;
xScsNode.ImageIndex := 3;
xScsNode.SelectedIndex := xScsNode.ImageIndex;
xConn.FFace.FTreeNode := xScsNode;
if xStrConn <> nil then
begin
CopyConnectorProperties(xConn, xStrConn);
end;
end;
if TObject(F3DModel.FScsObjects[i]) is T3DLine then
begin
xLine := T3DLine(F3DModel.FScsObjects[i]);
if (xLine.FListID <> FCAD.FCADListID) then
Continue;
xStrLine := T3DLine(getModelObjectByComponID(xLine.FSCSComponID, 2));
xScsNode:= ScsModelTree.Items.AddChild(xListNode, xLine.FName);
xScsNode.Data := xLine;
xScsNode.ImageIndex := 2;
xScsNode.SelectedIndex := xScsNode.ImageIndex;
xLine.FFace.FTreeNode := xScsNode;
if xStrLine <> nil then
begin
CopyLineProperties(xLine, xStrLine);
end;
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.UpdateScsModelTreeFromStream', E.Message);
end;
end;
function Tfrm3D.CopySideProperties(aSide, aStrSide: T3DSide): T3DSide;
var
i, j: integer;
xSide: T3DSide;
Points: T3DPointArray;
begin
try
Result := nil;
xSide := aSide;
xSide.FName := aStrSide.FName;
xSide.FDescription.Text := aStrSide.FDescription.Text;
xSide.FFaceType := aStrSide.FFaceType;
xSide.FWallType := aStrSide.FWallType;
xSide.FSideType := aStrSide.FSideType;
xSide.FColor := aStrSide.FColor;
xSide.FTextureRotate := aStrSide.FTextureRotate;
xSide.FTextureScale := aStrSide.FTextureScale;
xSide.FMirror := aStrSide.FMirror;
xSide.FTextureHash := aStrSide.FTextureHash;
xSide.FTexture_ext := aStrSide.FTexture_ext;
SetLength(xSide.FPoints, Length(aStrSide.FPoints));
for i := 0 to Length(aStrSide.FPoints) - 1 do
begin
xSide.FPoints[i].x := aStrSide.FPoints[i].x;
xSide.FPoints[i].y := aStrSide.FPoints[i].y;
xSide.FPoints[i].z := aStrSide.FPoints[i].z;
end;
SetLength(xSide.FGLPoints, Length(aStrSide.FGLPoints));
for i := 0 to Length(aStrSide.FGLPoints) - 1 do
begin
xSide.FGLPoints[i].x := aStrSide.FGLPoints[i].x;
xSide.FGLPoints[i].y := aStrSide.FGLPoints[i].y;
xSide.FGLPoints[i].z := aStrSide.FGLPoints[i].z;
end;
SetLength(xSide.FFace.Points, Length(xSide.FPoints));
for i := 0 to Length(xSide.FPoints) - 1 do
xSide.FFace.Points[i] := xSide.FPoints[i];
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.CopySideProperties', E.Message);
end;
end;
function Tfrm3D.CopySubSideProperties(aStrSubSide: T3DSide): T3DSide;
var
i, j: integer;
xSide: T3DSide;
Points: T3DPointArray;
begin
try
Result := nil;
xSide := T3DSide.Create(aStrSubSide.FFaceType, aStrSubSide.FWallType, aStrSubSide.FSideType, aStrSubSide.FParent);
xSide.FName := aStrSubSide.FName;
xSide.FDescription.Text := aStrSubSide.FDescription.Text;
xSide.FColor := aStrSubSide.FColor;
xSide.FTextureRotate := aStrSubSide.FTextureRotate;
xSide.FTextureScale := aStrSubSide.FTextureScale;
xSide.FMirror := aStrSubSide.FMirror;
xSide.FTextureHash := aStrSubSide.FTextureHash;
xSide.FTexture_ext := aStrSubSide.FTexture_ext;
SetLength(xSide.FPoints, Length(aStrSubSide.FPoints));
for i := 0 to Length(aStrSubSide.FPoints) - 1 do
begin
xSide.FPoints[i].x := aStrSubSide.FPoints[i].x;
xSide.FPoints[i].y := aStrSubSide.FPoints[i].y;
xSide.FPoints[i].z := aStrSubSide.FPoints[i].z;
end;
SetLength(xSide.FGLPoints, Length(aStrSubSide.FGLPoints));
for i := 0 to Length(aStrSubSide.FGLPoints) - 1 do
begin
xSide.FGLPoints[i].x := aStrSubSide.FGLPoints[i].x;
xSide.FGLPoints[i].y := aStrSubSide.FGLPoints[i].y;
xSide.FGLPoints[i].z := aStrSubSide.FGLPoints[i].z;
end;
xSide.FFace := TFaceRecord.Create(xSide.FPoints, clGray, xSide.FFaceType, 1, False, nil);
xSide.FFace.FFaceWallType := xSide.FWallType;
xSide.FFace.FWallSideType := xSide.FSideType;
Result := xSide;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.CopySubSideProperties', E.Message);
end;
end;
function Tfrm3D.CopyObjectProperties(aObject, aStrObject: T3DSObject): T3DSObject;
var
i, j: integer;
xObject: T3DSObject;
Points: T3DPointArray;
begin
try
Result := nil;
xObject := aObject;
if xObject = nil then
begin
xObject := T3DSObject.Create(aStrObject.FParent);
xObject.FName := aStrObject.FName;
xObject.FDescription.Text := aStrObject.FDescription.Text;
xObject.FObjectHash := aStrObject.FObjectHash;
xObject.FTextureHash := aStrObject.FTextureHash;
xObject.FTexture_ext := aStrObject.FTexture_ext;
xObject.FPosition := aStrObject.FPosition;
xObject.FScale := aStrObject.FScale;
xObject.FRotate := aStrObject.FRotate;
//for i := 0 to aStrObject.FFiles.Count - 1 do
// xObject.FFiles.Add(aStrObject.FFiles[i]);
//for i := 0 to aStrObject.FHashs.Count - 1 do
// xObject.FHashs.Add(aStrObject.FHashs[i]);
SetLength(Points, 1);
Points[0].x := xObject.FPosition.x;
Points[0].y := xObject.FPosition.y;
Points[0].z := xObject.FPosition.z;
xObject.FFace := TFaceRecord.Create(Points, clGray, ftNet3DSObject, 1, False, nil);
Result := xObject;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.CopyObjectProperties', E.Message);
end;
end;
function Tfrm3D.CopyConnectorProperties(aObject, aStrObject: T3DConnector): T3DConnector;
var
i: integer;
xConn: T3DConnector;
begin
try
Result := nil;
xConn := aObject;
xConn.FName := aStrObject.FName;
xConn.FDescription.Text := aStrObject.FDescription.Text;
xConn.FOffset := aStrObject.FOffset;
xConn.FScale := aStrObject.FScale;
xConn.FRotate := aStrObject.FRotate;
xConn.FObjectHash := aStrObject.FObjectHash;
xConn.FTextureHash := aStrObject.FTextureHash;
xConn.FTexture_ext := aStrObject.FTexture_ext;
//for i := 0 to aStrObject.FFiles.Count - 1 do
// xConn.FFiles.Add(aStrObject.FFiles[i]);
//for i := 0 to aStrObject.FHashs.Count - 1 do
// xConn.FHashs.Add(aStrObject.FHashs[i]);
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.CopyConnectorProperties', E.Message);
end;
end;
function Tfrm3D.CopyLineProperties(aObject, aStrObject: T3DLine): T3DLine;
var
i: integer;
xLine: T3DLine;
begin
try
Result := nil;
xLine := aObject;
xLine.FName := aStrObject.FName;
xLine.FDescription.Text := aStrObject.FDescription.Text;
{
xConn.FOffset := aStrObject.FOffset;
xConn.FScale := aStrObject.FOffset;
xConn.FRotate := aStrObject.FOffset;
xConn.FObjectHash := aStrObject.FObjectHash;
xConn.FTextureHash := aStrObject.FTextureHash;
xConn.FTexture_ext := aStrObject.FTexture_ext;
for i := 0 to aStrObject.FFiles.Count - 1 do
xConn.FFiles.Add(aStrObject.FFiles[i]);
for i := 0 to aStrObject.FHashs.Count - 1 do
xConn.FHashs.Add(aStrObject.FHashs[i]);
}
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.CopyLineProperties', E.Message);
end;
end;
procedure Tfrm3D.GLSceneViewerDblClick(Sender: TObject);
var
i, j: integer;
Obj: TGLBaseSceneObject;
Mesh: TGLMesh;
Polygon: TGLPolygon;
xNode: TTreeNode;
xNodes: TList;
isExists: boolean;
ctrlDown: boolean;
xObject: TObject;
xTree: TTreeView;
WallList: TList;
hWall: T3DWall;
iWalls,iModelCnt,iCorner: Integer;
xCorner: T3DCorner;
xRoom: T3DRoom;
begin
if GLSceneViewer.Camera = FirstPersonCamera then
exit;
try
Obj := GlsceneViewer.Buffer.GetPickedobject(mx, my);
if Obj <> nil then
begin
if (Obj is TGLPolygon) or (Obj is TGLFreeForm) or (Obj is TGLPipe) or (Obj is TGLLines) then
begin
xNodes := TList.create;
ctrlDown := (IsKeyDown(VK_LCONTROL) or IsKeyDown(VK_RCONTROL));
if (Obj.TagObject <> nil) then
begin
xObject := TObject(TTreeNode(Obj.TagObject).Data);
if (xObject is T3DSide) or (xObject is T3DSObject)or(xObject is T3DWall)or(xObject is T3DCorner) then
begin
xTree := ModelTree;
pcTree.ActivePage := TabArchModel;
pcProps.ActivePage := TabArchProps;
end;
if (xObject is T3DConnector) or (xObject is T3DLine) then
begin
xTree := ScsModelTree;
pcTree.ActivePage := TabScsModel;
pcProps.ActivePage := TabScsProps;
end;
for i := 0 to xTree.SelectionCount - 1 do
begin
xNode := xTree.Selections[i];
if TObject(xNode.Data) is T3DSObject then
ctrlDown := False;
if TObject(xNode.Data).ClassName <> TObject(TTreeNode(Obj.TagObject).Data).ClassName then
ctrlDown := False;
end;
if ctrlDown then
begin
xNode := TTreeNode(Obj.TagObject);
isExists := False;
for i := 0 to xTree.SelectionCount - 1 do
begin
xNode := xTree.Selections[i];
if TTreeNode(Obj.TagObject) = xNode then
begin
isExists := True;
if Not xNode.Selected then
xNodes.Add(xNode);
end
else
xNodes.Add(xNode);
end;
if Not isExists then
xNodes.Add(TTreeNode(Obj.TagObject));
xTree.ClearSelection;
for i := 0 to xNodes.Count - 1 do
begin
xNode := TTreeNode(xNodes.Items[i]);
xNode.Selected := True;
end;
OnSelectNodes(xNodes);
end
else
begin
xNode := TTreeNode(Obj.TagObject);
xTree.Select(xNode);
xNodes.Add(xNode);
{$IF Defined(ES_GRAPH_SC)}
//Äîáàâèòü ëèíèè ãðàíè, åñëè ýòî T3DSide
//************************** ROOF ******************************************
if TObject(xNode.Data) is T3DSide then //Åñëè ýòî ãðàíü êðûøè
if TObject(T3DSide(xNode.Data).FParent) is T3DRoom then //Åñëè Ïàðåíò - êîìíàòà
begin
xRoom := T3DRoom(T3DSide(xNode.Data).FParent);
if ifFiguraISRoof(xRoom.FSCSCOmpon) then
begin
if xRoom.FWalls <> nil then //Åñëè ñòåíû ó êîìíàòû èìåþòñÿ
begin
WallList := xRoom.FWalls;
for iWalls := 0 to WallList.Count - 1 do //Ïðîáåãàåìñÿ ïî âñåì ñòåíàì
begin
hWall := T3DWall(WallList[iWalls]);
for iModelCnt := 0 to ModelTree.Items.Count - 1 do //Íàõîäèì ñîîòâåòñòâóþùóþ ñòåíó ñ ModelTree////
if AnsiUpperCase(hWall.FName) = AnsiUpperCase(ModelTree.Items[iModelCnt].Text) then //
begin //
if hWall.FParent.FName = ModelTree.Items[iModelCnt].Parent.Text then //
begin
xNode := ModelTree.Items[iModelCnt];
xNodes.Add(xNode); //Äîáàâëÿåì ÍÎÄ â ëèñò äëÿ äàëüíåéøåé ðàáîòû
break;
end;
end;
end;
end;
if xRoom.FCorner <> nil then
begin
for iCorner := 0 to xRoom.FCorner.Count - 1 do //Ïðîáåãàåìñÿ ïî âñåì ñòåíàì
begin
xCorner := T3DCorner(xRoom.FCorner[iCorner]);
for iModelCnt := 0 to ModelTree.Items.Count - 1 do //Íàõîäèì ñîîòâåòñòâóþùóþ ñòåíó ñ ModelTree////
if TObject(ModelTree.Items[iModelCnt].Data) is T3DCorner then //
begin //
if xCorner = T3DCorner(ModelTree.Items[iModelCnt].Data) then //
begin
xNode := ModelTree.Items[iModelCnt];
xNodes.Add(xNode); //Äîáàâëÿåì ÍÎÄ â ëèñò äëÿ äàëüíåéøåé ðàáîòû
break;
end;
end;
end;
end;
end;
end;
//************************** \ROOF *****************************************
{$IFEND}
OnSelectNodes(xNodes);
end;
end;
end
else
begin
ModelTree.ClearSelection;
ScsModelTree.ClearSelection;
DeselectGLObjects;
end;
end
else
begin
ModelTree.ClearSelection;
ScsModelTree.ClearSelection;
DeselectGLObjects;
end;
if FNodesObjectsList.Count > 0 then
DeleteNodesObjects;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.GLSceneViewerDblClick', E.Message);
end;
end;
procedure Tfrm3D.ModelTreeClick(Sender: TObject);
var
i: Integer;
xNode: TTreeNode;
xNodes: TList;
ClearSelected: boolean;
hWall: T3DWall;
WallList: TList;
iWalls,iModelCnt,iCorner : Integer;
xCorner: T3DCorner;
xRoom: T3DRoom;
begin
try
if ModelTree.Selected <> nil then
begin
ClearSelected := False;
for i := 0 to ModelTree.SelectionCount - 1 do
begin
xNode := ModelTree.Selections[i];
if TObject(xNode.Data) is T3DSObject then
ClearSelected := True;
if TObject(xNode.Data).ClassName <> TObject(ModelTree.Selected.Data).ClassName then
ClearSelected := True;
end;
if ClearSelected then
begin
xNode := ModelTree.Selected;
ModelTree.ClearSelection;
xNode.Selected := True;
end;
xNodes := TList.create;
for i := 0 to ModelTree.SelectionCount - 1 do
begin
xNode := ModelTree.Selections[i];
xNodes.Add(xNode);
{$IF Defined(ES_GRAPH_SC)}
//************************** ROOF ******************************************
if TObject(xNode.Data) is T3DSide then //Åñëè ýòî ãðàíü êðûøè
if (TObject(T3DSide(xNode.Data).FParent) is T3DRoom)and(IfFiguraIsRoof(T3droom(T3DSide(xNode.Data).Fparent).FSCSCompon)) then //Åñëè Ïàðåíò - êîìíàòà
begin
xRoom := T3DRoom(T3DSide(xNode.Data).FParent);
if xRoom.FWalls <> nil then //Åñëè ñòåíû ó êîìíàòû èìåþòñÿ
begin
WallList := xRoom.FWalls;
for iWalls := 0 to WallList.Count - 1 do //Ïðîáåãàåìñÿ ïî âñåì ñòåíàì
begin
hWall := T3DWall(WallList[iWalls]);
for iModelCnt := 0 to ModelTree.Items.Count - 1 do //Íàõîäèì ñîîòâåòñòâóþùóþ ñòåíó ñ ModelTree////
if AnsiUpperCase(hWall.FName) = AnsiUpperCase(ModelTree.Items[iModelCnt].Text) then //
begin //
if hWall.FParent.FName = ModelTree.Items[iModelCnt].Parent.Text then //
begin
xNode := ModelTree.Items[iModelCnt];
xNodes.Add(xNode); //Äîáàâëÿåì ÍÎÄ â ëèñò äëÿ äàëüíåéøåé ðàáîòû
break;
end;
end;
end;
end;
if xRoom.FCorner <> nil then
begin
for iCorner := 0 to xRoom.FCorner.Count - 1 do //Ïðîáåãàåìñÿ ïî âñåì ñòåíàì
begin
xCorner := T3DCorner(xRoom.FCorner[iCorner]);
for iModelCnt := 0 to ModelTree.Items.Count - 1 do //Íàõîäèì ñîîòâåòñòâóþùóþ ñòåíó ñ ModelTree////
if TObject(ModelTree.Items[iModelCnt].Data) is T3DCorner then //
begin //
if xCorner = T3DCorner(ModelTree.Items[iModelCnt].Data) then //
begin
xNode := ModelTree.Items[iModelCnt];
xNodes.Add(xNode); //Äîáàâëÿåì ÍÎÄ â ëèñò äëÿ äàëüíåéøåé ðàáîòû
break;
end;
end;
end;
end;
end;
{$IFEND}
//************************** \ROOF *****************************************
end;
OnSelectNodes(xNodes);
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.ModelTreeClick', E.Message);
end;
end;
procedure Tfrm3D.OnSelectNodes(aNodes: TList);
var
i: Integer;
xNode: TTreeNode;
xObjects: TList;
begin
try
// íàéòè âñå îáüåêòû ñ Íîäîâ
xObjects := FindGLObjectsByNodes(aNodes);
FNodes.Clear;
for i := 0 to aNodes.Count - 1 do
FNodes.Add(aNodes.Items[i]);
if not Assigned(TimerOnSelectNodes.OnTimer) then
begin
FxObjects.Clear;
for i := 0 to xObjects.Count - 1 do
FxObjects.Add(xObjects.Items[i]);
TimerOnSelectNodes.OnTimer := TimerOnSelectNodesTimer;
TimerOnSelectNodes.Tag := 1;
TimerOnSelectNodes.Enabled := True;
end;
{
DeselectGLObjects;
// Select objects
SelectGLObjects(xObjects);
}
// Show Properties
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.OnSelectNodes', E.Message);
end;
end;
procedure Tfrm3D.FormCreate(Sender: TObject);
//var
// xModelNode: TTreeNode;
begin
FSelection := TList.Create;
FPropObjects := TList.create;
FPropRecord := TPropRecord.Create;
FxObjects := TList.Create;
FNodes := TList.Create;
{$IF Defined(ES_GRAPH_SC)}
//pcProps.Height := 420;
{$IFEND}
FMovedObject := nil;
FRotatedObject := nil;
FMovedFullConnector := nil;
FMovedEmptyConnector := nil;
FMovedLine := nil;
FOffsetObjects := False;
FRotatedObjects := False;
SelObjColor := clrDarkWood; // clrLightWood;
ObjColor := clrDarkBrown; // clrDarkWood;
//FFileStream := ''; //13.12.2010
FIdsStream := TIntList.Create;
FFilesStream := TStringList.Create;
// FTextures := TStringList.Create;
FMovedObjectsList := TList.Create;
FShadowObjects := TList.Create;
//Alex
behav:= GetFPSMovement(FirstPerson);
TabArchProps.TabVisible := false;
TabScsProps.TabVisible := false;
FCAD := nil;
{xModelNode := ScsModelTree.Items.GetFirstNode;
if xModelNode <> nil then
xModelNode.Text := cForm3D_Mes9;
xModelNode := ModelTree.Items.GetFirstNode;
if xModelNode <> nil then
xModelNode.Text := cForm3D_Mes9;}
end;
function Tfrm3D.FindGLObjectsByNodes(aNodes: TList): TList;
var
i,j: integer;
xObj: TGLBaseSceneObject;
xNode: TTreeNode;
xNodes: TList;
xCorner: T3DCorner;
xWall: T3DWall;
begin
try
Result := TList.Create;
xNodes := GetAllSidesNodesByNodes(aNodes);
for i := 0 to xNodes.Count - 1 do
begin
xNode := TTreeNode(xNodes[i]);
if (TObject(xNode.Data) is T3DSide) then
xObj := TGLBaseSceneObject(T3DSide(xNode.Data).FGLObject);
if (TObject(xNode.Data) is T3DSObject) then
xObj := TGLBaseSceneObject(T3DSObject(xNode.Data).FGLObject);
if (TObject(xNode.Data) is T3DConnector) then
xObj := TGLBaseSceneObject(T3DConnector(xNode.Data).FGLObject);
if (TObject(xNode.Data) is T3DLine) then
xObj := TGLBaseSceneObject(T3DLine(xNode.Data).FGLObject);
{$IF Defined(ES_GRAPH_SC)}
//Òóò íàõîäèì Îáúåêò â GLSCene, êîòîðûé îòâå÷àåò íóæíîìó ÍÎÄÓ äåðåâà
if (TObject(xNode.Data) is T3DWall) then
xObj := TGLBaseSceneObject(T3DWall(xNode.Data).FGLObject);
if (TObject(xNode.Data) is T3DCorner) then
begin
xCorner := T3DCorner(xNode.Data);
if xCorner.JoinedWalls <> nil then
for j := 0 to xCorner.JoinedWalls.Count - 1 do
begin
xWall := T3DWall(xCorner.JoinedWalls[j]);
xObj := TGLBaseSceneObject(xWall.FGLObject);
Result.Add(xObj); //È äîáàâëÿåì ýòè îáúåêòû â ëèñò
end;
xObj := TGLBaseSceneObject(xCorner.FGLObject);
end;
{$IFEND}
Result.Add(xObj); //È äîáàâëÿåì ýòè îáúåêòû â ëèñò
end;
except
on E: Exception do AddExceptionToLogEx('', E.Message);
end;
end;
procedure Tfrm3D.SelectGLObjects_GOOD(aObjects: TList);
var
i: integer;
xObj: TGLBaseSceneObject;
begin
try
FSelection.Clear;
for i := 0 to aObjects.Count - 1 do
FSelection.Add(aObjects.Items[i]);
for i := 0 to FSelection.Count - 1 do
begin
xObj := TGLBaseSceneObject(FSelection[i]);
if (xObj is TGLPolygon) then
begin
TGLPolygon(xObj).Material.Texture.ImageGamma := 1.5;
TGLPolygon(xObj).Material.MaterialOptions := [];
end;
if (xObj is TGLFreeForm) then
begin
with TGLFreeForm(xObj).Material do
begin
if (TGLFreeForm(xObj).Material.MaterialOptions = []) and (TGLFreeForm(xObj).Material.Texture.Disabled = False) then
begin
TGLFreeForm(xObj).Material.MaterialOptions := [moNoLighting];
TGLFreeForm(xObj).Material.Texture.Disabled := True;
end
else
begin
BackProperties.Ambient.Color := SelObjColor;
BackProperties.Diffuse.Color := SelObjColor;
BackProperties.Emission.Color := SelObjColor;
FrontProperties.Ambient.Color := SelObjColor;
FrontProperties.Diffuse.Color := SelObjColor;
FrontProperties.Emission.Color := SelObjColor;
end;
end;
end;
end;
except
on E: Exception do AddExceptionToLogEx('', E.Message);
end;
end;
procedure Tfrm3D.SelectGLObjects(aObjects: TList);
var
i,iWalls,iModelCnt, iobj: integer;
xObj: TGLBaseSceneObject;
xConn, JoinConn1, JoinConn2: T3DConnector;
xLine: T3DLine;
xWall{,hWall}: T3DWall;
xNode{,hNode}: TTreeNode;
// WallList,xWNodes, xObject: TList;
begin
try
FSelection.Clear;
for i := 0 to aObjects.Count - 1 do
FSelection.Add(aObjects.Items[i]);
JoinConn1 := nil;
JoinConn2 := nil;
for i := 0 to FSelection.Count - 1 do
begin
xObj := TGLBaseSceneObject(FSelection[i]);
if (xObj is TGLPolygon) then
begin
TGLPolygon(xObj).Material.Texture.ImageGamma := 1.5;
TGLPolygon(xObj).Material.MaterialOptions := [];
end;
if (xObj is TGLFreeForm) then
begin
with TGLFreeForm(xObj).Material do
begin
if (TGLFreeForm(xObj).Material.MaterialOptions = []) and (TGLFreeForm(xObj).Material.Texture.Disabled = False) then
begin
TGLFreeForm(xObj).Material.MaterialOptions := [moNoLighting];
TGLFreeForm(xObj).Material.Texture.Disabled := True;
end
else
begin
BackProperties.Ambient.Color := SelObjColor;
BackProperties.Diffuse.Color := SelObjColor;
BackProperties.Emission.Color := SelObjColor;
FrontProperties.Ambient.Color := SelObjColor;
FrontProperties.Diffuse.Color := SelObjColor;
FrontProperties.Emission.Color := SelObjColor;
end;
end;
end;
if (xObj is TGLLines) then
begin
glConn1.Visible := False;
glConn2.Visible := False;
if JoinConn1 <> nil then
JoinConn1.FGLObject1 := nil;
if JoinConn2 <> nil then
JoinConn2.FGLObject1 := nil;
xNode := TTreeNode(xObj.TagObject);
if (TObject(xNode.Data)) is T3DLine then
begin
xLine := T3DLine(TTreeNode(xObj.TagObject).Data);
TGLLines(xObj).LineColor.AsWinColor := clYellow;
JoinConn1 := xLine.FJoinConnector1;
JoinConn2 := xLine.FJoinConnector2;
// Its not connected conn
if JoinConn1.FJoinedConnectorsList.Count = 0 then
begin
glConn1.Position.x := TGLPipe(JoinConn1.FGLObject).Nodes[0].x;
glConn1.Position.y := TGLPipe(JoinConn1.FGLObject).Nodes[0].y;
glConn1.Position.z := TGLPipe(JoinConn1.FGLObject).Nodes[0].z;
glConn1.TagObject := JoinConn1;
JoinConn1.FGLObject1 := glConn1;
glConn1.Visible := True;
end;
if JoinConn2.FJoinedConnectorsList.Count = 0 then
begin
glConn2.Position.x := TGLPipe(JoinConn2.FGLObject).Nodes[0].x;
glConn2.Position.y := TGLPipe(JoinConn2.FGLObject).Nodes[0].y;
glConn2.Position.z := TGLPipe(JoinConn2.FGLObject).Nodes[0].z;
glConn2.TagObject := JoinConn2;
JoinConn2.FGLObject1 := glConn2;
glConn2.Visible := True;
end;
end
else
if (TObject(xNode.Data)) is T3DWall then
begin
TGLLines(xObj).Visible := True;
end
else
if (TObject(xNode.Data)) is T3DCorner then
begin
TGLLines(xObj).Visible := True;
end;
end;
if (xObj is TGLPipe) then
begin
xConn := T3DConnector(TTreeNode(xObj.TagObject).Data);
// TO
if xConn.FConnType = ct_Full then
begin
if (xConn.FGLObject1 is TGLFreeForm) then
begin
with TGLFreeForm(xConn.FGLObject1).Material do
begin
if (TGLFreeForm(xConn.FGLObject1).Material.MaterialOptions = []) and (TGLFreeForm(xConn.FGLObject1).Material.Texture.Disabled = False) then
begin
TGLFreeForm(xConn.FGLObject1).Material.MaterialOptions := [moNoLighting];
TGLFreeForm(xConn.FGLObject1).Material.Texture.Disabled := True;
end
else
begin
BackProperties.Ambient.Color := SelObjColor;
BackProperties.Diffuse.Color := SelObjColor;
BackProperties.Emission.Color := SelObjColor;
FrontProperties.Ambient.Color := SelObjColor;
FrontProperties.Diffuse.Color := SelObjColor;
FrontProperties.Emission.Color := SelObjColor;
end;
end;
end;
end
else
// Clear Connector
begin
end;
end;
end;
except
on E: Exception do AddExceptionToLogEx('', E.Message);
end;
end;
{TODO 22.07.2011} // Ñðàâíèòü ñ êîäîì èç ÑÑ èëè èç UP3 íà ñ÷åò ñåëåêòîâ äåñåëåêòîâ è óñòàíîâêè òåêñòóð âîîáùå
// OK
procedure Tfrm3D.DeselectGLObjects;
begin
if not Assigned(TimerOnSelectNodes.OnTimer) then
begin
TimerOnSelectNodes.OnTimer := TimerOnSelectNodesTimer;
TimerOnSelectNodes.Tag := 0;
TimerOnSelectNodes.Enabled := True;
end;
end;
procedure Tfrm3D.DeselectGLObjectsT;
var
i: integer;
xObj: TGLBaseSceneObject;
xConn, JoinConn1, JoinConn2: T3DConnector;
xLine: T3DLine;
xWall: T3DWall;
begin
try
JoinConn1 := nil;
JoinConn2 := nil;
for i := 0 to FSelection.Count - 1 do
begin
xObj := TGLBaseSceneObject(FSelection[i]);
if (xObj is TGLPolygon) then
begin
TGLPolygon(xObj).Material.Texture.ImageGamma := 1;
TGLPolygon(xObj).Material.MaterialOptions := [moNoLighting];
end;
if (xObj is TGLFreeForm) then
begin
with TGLFreeForm(xObj).Material do
begin
if (TGLFreeForm(xObj).Material.MaterialOptions = [moNoLighting]) and (TGLFreeForm(xObj).Material.Texture.Disabled = True) then
begin
TGLFreeForm(xObj).Material.MaterialOptions := [];
TGLFreeForm(xObj).Material.Texture.Disabled := False;
end
else
begin
BackProperties.Ambient.Color := ObjColor;
BackProperties.Diffuse.Color := ObjColor;
BackProperties.Emission.Color := ObjColor;
FrontProperties.Ambient.Color := ObjColor;
FrontProperties.Diffuse.Color := ObjColor;
FrontProperties.Emission.Color := ObjColor;
end;
end;
end;
if (xObj is TGLLines) then
begin
if (TObject(TTreeNode(xObj.TagObject).Data)) is T3DLine then
begin
xLine := T3DLine(TTreeNode(xObj.TagObject).Data);
TGLLines(xObj).LineColor.AsWinColor := xLine.FColor;
JoinConn1 := xLine.FJoinConnector1;
JoinConn2 := xLine.FJoinConnector2;
if JoinConn1.FGLObject1 <> nil then
begin
JoinConn1.FGLObject1 := nil;
glConn1.Visible := False;
end;
if JoinConn2.FGLObject1 <> nil then
begin
JoinConn2.FGLObject1 := nil;
glConn2.Visible := False;
end;
end
else
if ((TObject(TTreeNode(xObj.TagObject).Data)) is T3DWall)and( IfFiguraIsRoof(T3DWall(TTreeNode(xObj.TagObject).Data).FSCSCompon) ) then
begin
TGLLines(xObj).Visible := False;
end
else
if (TObject(TTreeNode(xObj.TagObject).Data)) is T3DCorner then
begin
TGLLines(xObj).Visible := False;
end;
end;
if (xObj is TGLPipe) then
begin
xConn := T3DConnector(TTreeNode(xObj.TagObject).Data);
if (xConn.FGLObject1 is TGLFreeForm) then
begin
with TGLFreeForm(xConn.FGLObject1).Material do
begin
if (TGLFreeForm(xConn.FGLObject1).Material.MaterialOptions = [moNoLighting]) and (TGLFreeForm(xConn.FGLObject1).Material.Texture.Disabled = True) then
begin
TGLFreeForm(xConn.FGLObject1).Material.MaterialOptions := [];
TGLFreeForm(xConn.FGLObject1).Material.Texture.Disabled := False;
end
else
begin
BackProperties.Ambient.Color := xConn.FColor;
BackProperties.Diffuse.Color := xConn.FColor;
BackProperties.Emission.Color := xConn.FColor;
FrontProperties.Ambient.Color := xConn.FColor;
FrontProperties.Diffuse.Color := xConn.FColor;
FrontProperties.Emission.Color := xConn.FColor;
end;
end;
end;
end;
end;
FSelection.Clear;
SetAllPanels(False);
SetAllScsPanels(False);
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.DeselectGLObjectsT', E.Message);
end;
end;
procedure Tfrm3D.OnLoadProperties(aObjects: TList);
var
i: integer;
ViewType: TPropViewType;
begin
try
ViewType := GetPropViewType(aObjects);
// None
if ViewType = pvtNone then
begin
FPropObjects.Clear;
SetAllPanels(False);
SetAllScsPanels(False);
end
// Single Side
else if ViewType = pvtSingleSide then
begin
FPropObjects := aObjects;
SetAllPanels(False);
panSideTexture.Visible := True;
panMirror.Visible := True;
panRotate.Visible := True;
// panCoords.Visible := True;
panDesc.Visible := True;
panName.Visible := True;
LoadPropertiesForSingleObject(TTreeNode(FPropObjects[0]));
end
// Multi Sides
else if ViewType = pvtMultiSides then
begin
FPropObjects := aObjects;
SetAllPanels(False);
panSideTexture.Visible := True;
panMirror.Visible := True;
panRotate.Visible := True;
// panCoords.Visible := True;
panDesc.Visible := True;
LoadPropertiesForMultiObjects(FPropObjects);
end
// Single 3ds object
else if ViewType = pvtSingle3ds then
begin
FPropObjects := aObjects;
SetAllPanels(False);
panObjectTexture.Visible := True;
panScale3ds.Visible := True;
panRotate3ds.Visible := True;
//panPos3ds.Visible := True;
panDesc.Visible := True;
panName.Visible := True;
LoadPropertiesForSingle3ds(TTreeNode(FPropObjects[0]));
end
// Multi 3ds objects
else if ViewType = pvtMulti3ds then
begin
FPropObjects := aObjects;
SetAllPanels(False);
panObjectTexture.Visible := True;
panScale3ds.Visible := True;
panRotate3ds.Visible := True;
//panPos3ds.Visible := True;
panDesc.Visible := True;
LoadPropertiesForMulti3ds(FPropObjects);
end
// Single Connector
else if ViewType = pvtSingleConn then
begin
FPropObjects := aObjects;
SetAllScsPanels(False);
panScsObjectTexture.Visible := True;
panScsScale.Visible := True;
panScsRotate.Visible := True;
panScsOffset.Visible := True;
panScsConnCoords.Visible := True;
panScsDesc.Visible := True;
panScsName.Visible := True;
LoadPropertiesForSingleConn(TTreeNode(FPropObjects[0]));
end
// Multi Connectors
else if ViewType = pvtMultiConn then
begin
FPropObjects := aObjects;
SetAllScsPanels(False);
panScsObjectTexture.Visible := True;
panScsScale.Visible := True;
panScsRotate.Visible := True;
panScsOffset.Visible := True;
panScsConnCoords.Visible := True;
panScsDesc.Visible := True;
LoadPropertiesForMultiConn(FPropObjects);
end
// Single Line
else if ViewType = pvtSingleLine then
begin
FPropObjects := aObjects;
SetAllScsPanels(False);
panScsLineCoords.Visible := True;
panScsLength.Visible := True;
panScsDesc.Visible := True;
panScsName.Visible := True;
LoadPropertiesForSingleLine(TTreeNode(FPropObjects[0]));
end
// Multi Lines
else if ViewType = pvtMultiLine then
begin
FPropObjects := aObjects;
SetAllScsPanels(False);
panScsLineCoords.Visible := True;
panScsLength.Visible := True;
panScsDesc.Visible := True;
LoadPropertiesForMultiLine(FPropObjects);
end;
except
on E: Exception do AddExceptionToLogEx('', E.Message);
end;
end;
function Tfrm3D.CheckGLObjectInSelectionNodes(aObject: TGLBaseSceneObject; aNodes: TList): Boolean;
var
i, j: integer;
xObj: TGLBaseSceneObject;
xNode: TTreeNode;
xSubNodes: TList;
begin
try
Result := False;
for i := 0 to aNodes.Count - 1 do
begin
xNode := TTreeNode(aNodes[i]);
// åñëè ýòî ãðàíü, òî ïðîâåðèòü åå
if (TObject(xNode.Data) is T3DSide) then
begin
if TTreeNode(aObject.TagObject) = xNode then
begin
Result := True;
exit;
end;
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.CheckGLObjectInSelectionNodes', E.Message);
end;
end;
function Tfrm3D.GetAllSidesNodesByNodes(aNodes: TList): TList;
var
i, j: integer;
xNode, hNode: TTreeNode;
xNodes: TList;
begin
try
Result := TList.Create;
for i := 0 to aNodes.Count - 1 do
begin
xNode := TTreeNode(aNodes[i]);
if (TObject(xNode.Data) is T3DSide) and (T3DSide(xNode.Data).FSubSides.Count = 0) then
begin
Result.Add(xNode);
end
else if TObject(xNode.Data) is T3DSObject then
begin
Result.Add(xNode);
end
else if TObject(xNode.Data) is T3DConnector then
begin
Result.Add(xNode);
end
else if TObject(xNode.Data) is T3DLine then
begin
Result.Add(xNode);
end
else
//**ROOF**
if (TObject(xNode.Data) is T3DWall)and(IFFiguraIsRoof(T3dWall(xNode.Data).FSCSCompon)) then
begin
Result.Add(xNode);
end
else
if (TObject(xNode.Data) is T3DCorner)and(IFFiguraIsRoof(T3DCorner(xNode.Data).FParent.FSCSCOmpon)) then
begin
Result.Add(xNode);
end
else
//*\ROOF**
begin
xNodes := GetAllChildNodes(xNode);
for j := 0 to xNodes.Count - 1 do
Result.Add(xNodes[j]);
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.GetAllSidesNodesByNodes', E.Message);
end;
end;
function Tfrm3D.GetAllChildNodes(ANode: TTreeNode): TList;
procedure StepGetAllChildNodes(ACurrNode: TTreeNode);
var
CurrNode: TTreeNode;
begin
CurrNode := ACurrNode.getFirstChild;
while CurrNode <> nil do
begin
if (TObject(CurrNode.Data) is T3DSide) then
Result.Add(CurrNode);
if (TObject(CurrNode.Data) is T3DSObject) then
Result.Add(CurrNode);
if (TObject(CurrNode.Data) is T3DConnector) then
Result.Add(CurrNode);
if (TObject(CurrNode.Data) is T3DLine) then
Result.Add(CurrNode);
if (TObject(CurrNode.Data) is T3DWall) then
Result.Add(CurrNode);
if (TObject(CurrNode.Data) is T3DCorner) then
Result.Add(CurrNode);
StepGetAllChildNodes(CurrNode);
CurrNode := CurrNode.GetNextSibling;
end;
end;
begin
Result := TList.Create;
StepGetAllChildNodes(ANode);
end;
procedure Tfrm3D.FormDestroy(Sender: TObject);
begin
if FSelection <> nil then
FreeAndNil(FSelection);
if FPropObjects <> nil then
FreeAndNil(FPropObjects);
if FxObjects <> nil then
FreeAndNil(FxObjects);
if FNodes <> nil then
FreeAndNil(FNodes);
// Ýòî íóæíî îáÿçàòåëüíî - èíà÷å íà íåêîòîðûõ äðîâàõ âèäåî - âûïàäåò
// Context Activation Failed: C0070006
GLSceneViewer.Free;
end;
function Tfrm3D.GetPropViewType(aNodes: TList): TPropViewType;
var
i: integer;
xNode: TTreeNode;
HalpList: TList;
begin
try
Result := pvtNone;
{$IF Defined(ES_GRAPH_SC)}
HalpList := tlist.Create;
HalpList.Assign(aNodes);
aNodes.Clear;
for i := 0 to HalpList.count - 1 do
begin
xNode := TTreeNode(HalpList[i]);
if (TObject(xNode.Data) is T3DSide) or (TObject(xNode.Data) is T3DSObject) or
(TObject(xNode.Data) is T3DConnector) or (TObject(xNode.Data) is T3DLine) then
aNodes.Add(xNode);
end;
FreeAndNil(HalpList);
{$IFEND}
if aNodes.Count > 0 then
begin
if aNodes.Count = 1 then
begin
if (TObject(TTreeNode(aNodes[0]).Data) is T3DSide) then
Result := pvtSingleSide;
if (TObject(TTreeNode(aNodes[0]).Data) is T3DSObject) then
Result := pvtSingle3ds;
if (TObject(TTreeNode(aNodes[0]).Data) is T3DLine) then
Result := pvtSingleLine;
if (TObject(TTreeNode(aNodes[0]).Data) is T3DConnector) then
if T3DConnector(TTreeNode(aNodes[0]).Data).FConnType = ct_Full then
Result := pvtSingleConn;
end
else
begin
for i := 0 to aNodes.count - 1 do
begin
xNode := TTreeNode(aNodes[i]);
if not (TObject(xNode.Data) is T3DSide) and not (TObject(xNode.Data) is T3DSObject) and
not (TObject(xNode.Data) is T3DConnector) and not (TObject(xNode.Data) is T3DLine) then
exit;
if (TObject(xNode.Data) is T3DSide) then
begin
if (Result <> pvtNone) and (Result <> pvtMultiSides) then
begin
Result := pvtNone;
exit;
end;
Result := pvtMultiSides;
end;
if (TObject(xNode.Data) is T3DSObject) then
begin
if (Result <> pvtNone) and (Result <> pvtMulti3ds) then
begin
Result := pvtNone;
exit;
end;
Result := pvtMulti3ds;
end;
if (TObject(xNode.Data) is T3DLine) then
begin
if (Result <> pvtNone) and (Result <> pvtMultiLine) then
begin
Result := pvtNone;
exit;
end;
Result := pvtMultiLine;
end;
if (TObject(xNode.Data) is T3DConnector) then
begin
if (Result <> pvtNone) and (Result <> pvtMultiConn) then
begin
Result := pvtNone;
exit;
end;
if T3DConnector(xNode.Data).FConnType = ct_Empty then
begin
Result := pvtNone;
exit;
end;
Result := pvtMultiConn;
end;
end;
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.GetPropViewType', E.Message);
end;
end;
function Tfrm3D.LoadPropertiesForMultiObjects(aObjects: TList): TPropRecord;
var
i: integer;
xObject: T3DSide;
xGLObject: TGLBaseSceneObject;
Points: T3DPointArray;
Cnt: Integer;
xRotate, xScale: Integer;
xMirror: Boolean;
xCnt: Integer;
CoordsInfo: string;
begin
try
mDesc.Clear;
cbCoordNbr.Properties.Items.Clear;
for i := 0 to aObjects.Count - 1 do
begin
{$IF Defined(ES_GRAPH_SC)}
if TObject(TTreeNode(aObjects[i]).Data) is T3DSide then
{$IFEND}
begin
xObject := T3DSide(TTreeNode(aObjects[i]).Data);
xGLObject := TGLBaseSceneObject(xObject.FGLObject);
if i = 0 then
begin
xRotate := xObject.FTextureRotate;
xScale := xObject.FTextureScale;
xMirror := xObject.FMirror;
edTextureRotate.Text := IntToStr(xObject.FTextureRotate);
edTextureScale.Text := IntToStr(xObject.FTextureScale);
cbMirror.Checked := xObject.FMirror;
xCnt := Length(xObject.FGLPoints);
end
else
begin
if edTextureRotate.Text <> '' then
if xRotate <> xObject.FTextureRotate then
edTextureRotate.Text := '';
if edTextureScale.Text <> '' then
if xScale <> xObject.FTextureScale then
edTextureScale.Text := '';
if cbMirror.AllowGrayed = False then
if xMirror <> xObject.FMirror then
cbMirror.AllowGrayed := True;
if xCnt <> - 1 then
if xCnt <> Length(xObject.FGLPoints) then
xCnt := -1;
end;
end;
end;
if xCnt > 0 then
begin
//panCoords.Enabled := True;
for i := 0 to xCnt - 1 do
begin
CoordsInfo := '';{' (' + FloatToStr(xObject.FGLPoints[i].x) + '; ' +
FloatToStr(xObject.FGLPoints[i].y) + '; ' +
FloatToStr(xObject.FGLPoints[i].z) + ')';}
cbCoordNbr.Properties.Items.Add(InttoStr(i + 1) + CoordsInfo);
end;
cbCoordNbr.Text := cbCoordNbr.Properties.Items[0];
edCoordX.Text := '';
edCoordY.Text := '';
edCoordZ.Text := '';
end
else
begin
//panCoords.Enabled := False;
end;
imgSideTexture.Clear;
cbSideHashs.Properties.Items.Clear;
for i := 0 to F3DModel.FHashs.Count - 1 do
begin
cbSideHashs.Properties.Items.Add(F3DModel.FHashs.Strings[i]);
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.LoadPropertiesForMultiObjects', E.Message);
end;
end;
function Tfrm3D.LoadPropertiesForSingleObject(aObject: TTreeNode): TPropRecord;
var
i: integer;
xObject: T3DSide;
xGLObject: TGLBaseSceneObject;
Points: T3DPointArray;
Cnt: Integer;
CoordsInfo: string;
tmpdir, tmpfname: string;
begin
try
xObject := T3DSide(aObject.Data);
xGLObject := TGLBaseSceneObject(xObject.FGLObject);
edName.Text := xObject.FName;
mDesc.Clear;
for i := 0 to xObject.FDescription.Count - 1 do
mDesc.Lines.Add(xObject.FDescription[i]);
if Pos('empty', AnsiLowerCase(mDesc.Lines.Text)) = 1 then
begin
if xGLObject <> nil then
begin
xGLObject.Visible := False;
if xObject.FAsArc and (AnsiLowerCase(xObject.ClassName) <> 't3dsobject') then
RotateTextureToAngleP(xObject, TGLPolygon(xGLObject), xObject.FTextureRotate, xObject.FMirror);
end;
btnEmpty.GroupIndex := 1;
btnEmpty.Down := True;
if aObject.ImageIndex < 999 then
begin
aObject.ImageIndex := aObject.ImageIndex + 1000;
aobject.SelectedIndex := aObject.ImageIndex;
end;
end
else
begin
btnEmpty.GroupIndex := 0;
btnEmpty.Down := False;
if xGLObject <> nil then
begin
xGLObject.Visible := True;
if xObject.FAsArc and (AnsiLowerCase(xObject.ClassName) <> 't3dsobject') then
RotateTextureToAngleP(xObject, TGLPolygon(xGLObject), xObject.FTextureRotate, xObject.FMirror);
end;
if aObject.ImageIndex > 999 then
begin
aObject.ImageIndex := aObject.ImageIndex - 1000;
aobject.SelectedIndex := aObject.ImageIndex;
end;
end;
edTextureRotate.Text := IntToStr(xObject.FTextureRotate);
edTextureScale.Text := IntToStr(xObject.FTextureScale);
cbMirror.Checked := xObject.FMirror;
cbCoordNbr.Properties.Items.Clear;
Cnt := Length(xObject.FGLPoints);
for i := 0 to Cnt - 1 do
begin
CoordsInfo := '';{' (' + FloatToStr(xObject.FGLPoints[i].x) + '; ' +
FloatToStr(xObject.FGLPoints[i].y) + '; ' +
FloatToStr(xObject.FGLPoints[i].z) + ')';}
cbCoordNbr.Properties.Items.Add(InttoStr(i + 1) + CoordsInfo);
end;
cbCoordNbr.Text := cbCoordNbr.Properties.Items[0];
edCoordX.Text := FloatToStr(xObject.FGLPoints[0].x);
edCoordY.Text := FloatToStr(xObject.FGLPoints[0].y);
edCoordZ.Text := FloatToStr(xObject.FGLPoints[0].z);
imgSideTexture.Clear;
tmpfname := GetImageFileByHash(xObject.FTextureHash);
if tmpfname <> '' then
imgSideTexture.Picture.LoadFromFile(tmpfname);
cbSideHashs.Properties.Items.Clear;
for i := 0 to F3DModel.FHashs.Count - 1 do
begin
cbSideHashs.Properties.Items.Add(F3DModel.FHashs.Strings[i]);
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.LoadPropertiesForSingleObject', E.Message);
end;
end;
function Tfrm3D.LoadPropertiesForSingle3ds(aObject: TTreeNode): TPropRecord;
var
i: integer;
xObject: T3DSObject;
xGLObject: TGLBaseSceneObject;
tmpdir, tmpfname: string;
begin
try
xObject := T3DSObject(aObject.Data);
xGLObject := TGLBaseSceneObject(xObject.FGLObject);
edName.Text := xObject.FName;
mDesc.Clear;
for i := 0 to xObject.FDescription.Count - 1 do
mDesc.Lines.Add(xObject.FDescription[i]);
edPosX.Text := FloatToStr(xObject.FPosition.x);
edPosY.Text := FloatToStr(xObject.FPosition.y);
edPosZ.Text := FloatToStr(xObject.FPosition.z);
edAngleX.Text := FloatToStr(xObject.FRotate.x);
edAngleY.Text := FloatToStr(xObject.FRotate.y);
edAngleZ.Text := FloatToStr(xObject.FRotate.z);
edScaleX.Text := FloatToStr(xObject.FScale.x);
edScaleY.Text := FloatToStr(xObject.FScale.y);
edScaleZ.Text := FloatToStr(xObject.FScale.z);
imgObjectTexture.Clear;
tmpfname := GetImageFileByHash(xObject.FTextureHash);
if tmpfname <> '' then
imgObjectTexture.Picture.LoadFromFile(tmpfname);
cbObjectHashs.Properties.Items.Clear;
for i := 0 to F3DModel.FHashs.Count - 1 do
begin
cbObjectHashs.Properties.Items.Add(F3DModel.FHashs.Strings[i]);
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.LoadPropertiesForSingle3ds', E.Message);
end;
end;
function Tfrm3D.LoadPropertiesForMulti3ds(aObjects: TList): TPropRecord;
var
i: integer;
xObject: T3DSObject;
xGLObject: TGLBaseSceneObject;
Points: T3DPointArray;
Cnt: Integer;
xPosX, xPosY, xPosZ, xAngleX, xAngleY, xAngleZ, xScaleX, xScaleY, xScaleZ: Double;
begin
try
mDesc.Clear;
for i := 0 to aObjects.Count - 1 do
begin
xObject := T3DSObject(TTreeNode(aObjects[i]).Data);
xGLObject := TGLBaseSceneObject(xObject.FGLObject);
if i = 0 then
begin
xPosX := xObject.FPosition.x;
edPosX.Text := FloatToStr(xPosX);
xPosY := xObject.FPosition.y;
edPosY.Text := FloatToStr(xPosY);
xPosZ := xObject.FPosition.z;
edPosZ.Text := FloatToStr(xPosZ);
xAngleX := xObject.FRotate.x;
edAngleX.Text := FloatToStr(xAngleX);
xAngleY := xObject.FRotate.y;
edAngleY.Text := FloatToStr(xAngleY);
xAngleZ := xObject.FRotate.z;
edAngleZ.Text := FloatToStr(xAngleZ);
xScaleX := xObject.FScale.x;
edScaleX.Text := FloatToStr(xScaleX);
xScaleY := xObject.FScale.y;
edScaleY.Text := FloatToStr(xScaleY);
xScaleZ := xObject.FScale.z;
edScaleZ.Text := FloatToStr(xScaleZ);
end
else
begin
if edPosX.Text <> '' then
if xPosX <> xObject.FPosition.x then
edPosX.Text := '';
if edPosY.Text <> '' then
if xPosY <> xObject.FPosition.y then
edPosY.Text := '';
if edPosZ.Text <> '' then
if xPosZ <> xObject.FPosition.z then
edPosZ.Text := '';
if edAngleX.Text <> '' then
if xAngleX <> xObject.FRotate.x then
edAngleX.Text := '';
if edAngleY.Text <> '' then
if xAngleY <> xObject.FRotate.y then
edAngleY.Text := '';
if edAngleZ.Text <> '' then
if xAngleZ <> xObject.FRotate.z then
edAngleZ.Text := '';
if edScaleX.Text <> '' then
if xScaleX <> xObject.FScale.x then
edScaleX.Text := '';
if edScaleY.Text <> '' then
if xScaleY <> xObject.FScale.y then
edScaleY.Text := '';
if edScaleZ.Text <> '' then
if xScaleZ <> xObject.FScale.z then
edScaleZ.Text := '';
end;
end;
imgObjectTexture.Clear;
cbObjectHashs.Properties.Items.Clear;
for i := 0 to F3DModel.FHashs.Count - 1 do
begin
cbObjectHashs.Properties.Items.Add(F3DModel.FHashs.Strings[i]);
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.LoadPropertiesForMulti3ds', E.Message);
end;
end;
procedure Tfrm3D.cbCoordNbrCloseUp(Sender: TObject);
var
Index: Integer;
xObject: T3DSide;
begin
try
Index := cbCoordNbr.ItemIndex;
if FPropObjects.Count > 0 then
begin
if FPropObjects.Count = 1 then
begin
xObject := T3DSide(TTreeNode(FPropObjects[0]).Data);
edCoordX.Text := FloatToStr(xObject.FGLPoints[Index].x);
edCoordY.Text := FloatToStr(xObject.FGLPoints[Index].y);
edCoordZ.Text := FloatToStr(xObject.FGLPoints[Index].z);
end
else
begin
edCoordX.Text := '';
edCoordY.Text := '';
edCoordZ.Text := '';
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.cbCoordNbrCloseUp', E.Message);
end;
end;
{ TPropRecord }
constructor TPropRecord.Create;
begin
inherited Create;
fCoords := TList.Create;
fDesc := TStringList.Create;
end;
procedure Tfrm3D.bSideTextureChangeClick(Sender: TObject);
var
i: integer;
FName: string;
xObject: T3DSide;
xGLObject: TGLBaseSceneObject;
tmpdir, tmpfname, ExtStr, BmpFName: string;
Bmp: TBitmap;
Jpeg: TJPEGImage;
HashStr: string;
begin
try
FName := LoadTexture;
if (FName <> '') and FileExists(FName) then
begin
imgSideTexture.Picture.LoadFromFile(FName);
ExtStr := ExtractFileExt(FName);
tmpdir := GetWorkDir; //ExtractDirByCategoryType(dctPictures);
// ïîëó÷àåì HASH ïî çàãðóæàåìîìó ôàéëó
HashStr := GetImageHash(FName);
// ïî HASH èùåì åñòü ëè îí â íàøåé áàçå
tmpfname := GetImageFileByHash(HashStr);
// åñëè íàéäåí, òî ãðóçèì åãî
if tmpfname <> '' then
begin
end
else
// íå íàéäåí - ñîçäàåì äëÿ ôàéëà HASH, êîïèðóåì â òåìï, ãðóçèì
begin
F3DModel.FHashs.Add(HashStr);
tmpfname := tmpdir + '\' + HashStr + '.bmp';
if (ExtStr = '.jpg') or (ExtStr = '.jpeg') then
begin
Bmp := TBitmap.Create;
Jpeg := TJPEGImage.Create;
jpeg.CompressionQuality := 100; {Default Value}
Jpeg.LoadFromFile(FName);
Bmp.Assign(Jpeg);
Bmp.SaveTofile(tmpfname);
FreeAndNil(Bmp);
FreeAndNil(Jpeg);
end
else
CopyFile(PChar(FName), PChar(tmpfname), True);
end;
for i := 0 to FPropObjects.Count - 1 do
begin
if TObject(TTreeNode(FPropObjects[i]).Data) is T3DSide then
begin
xObject := T3DSide(TTreeNode(FPropObjects[i]).Data);
xGLObject := TGLBaseSceneObject(xObject.FGLObject);
xObject.FTextureHash := HashStr;
xObject.FTexture_ext := ExtStr;
if (xGLObject is TGLPolygon) then
begin
TGLPolygon(xGLObject).Material.Texture.Disabled := False;
TGLPolygon(xGLObject).Material.Texture.DestroyHandles;
try
TGLPolygon(xGLObject).Material.Texture.Image.LoadFromFile(tmpfname);
except
ShowMessage('File not found ' + tmpfname);
end;
RotateTextureToAngleP(xObject, TGLPolygon(xGLObject), xObject.FTextureRotate, xObject.FMirror);
end;
end;
end;
// Resfresh HASHs
cbSideHashs.Properties.Items.Clear;
for i := 0 to F3DModel.FHashs.Count - 1 do
begin
cbSideHashs.Properties.Items.Add(F3DModel.FHashs.Strings[i]);
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.bTextureChangeClick', E.Message);
end;
end;
function Tfrm3D.LoadTexture: string;
begin
try
Result := '';
OpenTexture.InitialDir := ExeDir + '\3DTextures';
NoMoveEvent := True;
if OpenTexture.Execute then
begin
Result := OpenTexture.FileName;
end;
except
on E: Exception do AddExceptionToLogEx('', E.Message);
end;
end;
procedure Tfrm3D.edNameExit(Sender: TObject);
begin
ChangeName;
end;
procedure Tfrm3D.bSideTextureClearClick(Sender: TObject);
var
FName: string;
i: integer;
xObject: T3DSide;
xGLObject: TGLBaseSceneObject;
tmpdir, tmpfname, ExtStr, BmpFName: string;
Bmp: TBitmap;
Jpeg: TJPEGImage;
begin
try
for i := 0 to FPropObjects.Count - 1 do
begin
if TOBject(TTreeNode(FPropObjects[i]).Data) is T3DSide then
begin
xObject := T3DSide(TTreeNode(FPropObjects[i]).Data);
xGLObject := TGLBaseSceneObject(xObject.FGLObject);
xObject.FTextureHash := '';
xObject.FTexture_ext := '';
if (xGLObject is TGLPolygon) then
begin
imgSideTexture.Clear;
TGLPolygon(xGLObject).Material.Texture.Disabled := True;
end;
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.bTextureClearClick', E.Message);
end;
end;
procedure Tfrm3D.cbMirrorClick(Sender: TObject);
var
i: integer;
xObject: T3DSide;
xGLObject: TGLBaseSceneObject;
begin
try
for i := 0 to FPropObjects.Count - 1 do
begin
if TObject(TTreeNode(FPropObjects[i]).Data) is T3DSide then
begin
xObject := T3DSide(TTreeNode(FPropObjects[i]).Data);
xGLObject := TGLBaseSceneObject(xObject.FGLObject);
xObject.FMirror := cbMirror.Checked;
if (xGLObject is TGLPolygon) then
RotateTextureToAngleP(xObject, TGLPolygon(xGLObject), xObject.FTextureRotate, xObject.FMirror);
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.cbMirrorClick', E.Message);
end;
end;
procedure Tfrm3D.mDescEnter(Sender: TObject);
begin
ChangeDesc;
end;
procedure Tfrm3D.mDescExit(Sender: TObject);
begin
ChangeDesc;
end;
procedure Tfrm3D.edNameKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
ChangeName;
end;
procedure Tfrm3D.mDescKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
ChangeDesc;
end;
procedure Tfrm3D.edCoordXKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
ChangeCoordX;
end;
procedure Tfrm3D.edCoordXExit(Sender: TObject);
begin
ChangeCoordX;
end;
procedure Tfrm3D.edCoordYExit(Sender: TObject);
begin
ChangeCoordY;
end;
procedure Tfrm3D.edCoordYKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
ChangeCoordY;
end;
procedure Tfrm3D.edCoordZKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
ChangeCoordZ;
end;
procedure Tfrm3D.edCoordZExit(Sender: TObject);
begin
ChangeCoordZ;
end;
procedure Tfrm3D.edTextureRotateExit(Sender: TObject);
begin
ChangeTextureRotate;
end;
procedure Tfrm3D.edTextureRotateKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
ChangeTextureRotate;
end;
{$IF Defined(ES_GRAPH_SC)}
Procedure Tfrm3D.ChangeAllFiguresWithPoint(aPoint:T3DPoint; Coord: TCoord); //Ïðîöåäóðà ïåðåðèñîâêè âñåõ òî÷åê,êàê aPoint
var
j,k: integer;
xNode: TtreeNode;
GLPoint: T3DPoint;
GlNode: TGLNodes;
GlLineNode: TGLLinesNodes;
xGLObject: TGLBaseSceneObject;
xSide: T3dSide;
xLine: T3DWall;
xCorner: T3dCorner;
begin
/////////////////////////// ROOF /////////////////////////////
for j := 0 to DummyCube.Count - 1 do
begin
xLine := nil;
xCorner := nil;
if DummyCube.Children[j] is TGLPolygon then
begin
GlNode := TGLPolygon(DummyCube.Children[j]).Nodes;
for k := 0 to GlNode.Count - 1 do
begin
GLPoint := DoublePoint(GlNode[k].X,GlNode[k].y,GlNode[k].z);
if EQDPZ(GLPoint,aPoint) then
begin
if TOBject(TTreeNode(TGLPolygon(DummyCube.Children[j]).TagObject).Data) is T3DSide then
begin
xSide := T3DSide(TTreeNode(TGLPolygon(DummyCube.Children[j]).TagObject).Data);
xGLObject := TGLBaseSceneObject(xSide.FGLObject);
end;
case Coord of
cX: begin
GlNode[k].X := StrToFloat_My(edCoordX.Text);
xSide.FGLPoints[k].x := StrToFloat_My(edCoordX.Text);
xSide.FPoints[k].x := StrToFloat_My(edCoordX.Text) / Factor;
end;
cY: begin
GlNode[k].Y := StrToFloat_My(edCoordY.Text);
xSide.FGLPoints[k].Y := StrToFloat_My(edCoordY.Text);
xSide.FPoints[k].Y := StrToFloat_My(edCoordY.Text) / Factor;
end;
cZ: begin
GlNode[k].Z := StrToFloat_My(edCoordZ.Text);
xSide.FGLPoints[k].Z := StrToFloat_My(edCoordZ.Text);
xSide.FPoints[k].Z := StrToFloat_My(edCoordZ.Text) / Factor;
end;
end;
break;
end;
end;
end;
if DummyCube.Children[j] is TGLLines then
begin
GlLineNode := TGLLines(DummyCube.Children[j]).Nodes;
for k := 0 to GlLineNode.Count - 1 do
begin
GLPoint := DoublePoint(GlLineNode[k].X,GlLineNode[k].Y,GlLineNode[k].Z);
if EQDPZ(GLPoint,aPoint) then
begin
if TOBject(TTreeNode(TGLPolygon(DummyCube.Children[j]).TagObject).Data) is T3DWall then
begin
xLine := T3DWall(TTreeNode(TGLPolygon(DummyCube.Children[j]).TagObject).Data);
xGLObject := TGLBaseSceneObject(xLine.FGLObject);
end;
if TOBject(TTreeNode(TGLPolygon(DummyCube.Children[j]).TagObject).Data) is T3DCorner then
begin
xCorner := T3DCorner(TTreeNode(TGLPolygon(DummyCube.Children[j]).TagObject).Data);
xGLObject := TGLBaseSceneObject(xCorner.FGLObject);
end;
case Coord of
cX: begin
if xLine <> nil then
begin
xLine.FGLPOints[k].x := StrToFloat_My(edCoordX.Text);
xLine.FPoints[k].x := StrToFloat_My(edCoordX.Text) / Factor;
end;
if xCorner <> nil then
begin
xCorner.FGLPOints[k].x := StrToFloat_My(edCoordX.Text);
xCorner.FPoints.x := StrToFloat_My(edCoordX.Text) / Factor;
end;
GlLineNode[k].X := StrToFloat_My(edCoordX.Text);
if TObject(TTreenode(TGLLines(DummyCube.Children[j]).TagObject).Data) is T3dCorner then
GlLineNode[k+1].X := StrToFloat_My(edCoordX.Text);
end;
cY: begin
if xLine <> nil then
begin
xLine.FGLPOints[k].y := StrToFloat_My(edCoordy.Text);
xLine.FPoints[k].y := StrToFloat_My(edCoordy.Text) / Factor;
end;
if xCorner <> nil then
begin
xCorner.FGLPOints[k].y := StrToFloat_My(edCoordY.Text);
xCorner.FPoints.y := StrToFloat_My(edCoordY.Text) / Factor;
end;
GlLineNode[k].Y := StrToFloat_My(edCoordY.Text);
if TObject(TTreenode(TGLLines(DummyCube.Children[j]).TagObject).Data) is T3dCorner then
begin
GlLineNode[k+1].Y := GlLineNode[k].Y + (1 * Factor + FDeltaZ);
end;
end;
cZ: begin
if xLine <> nil then
begin
xLine.FGLPOints[k].z := StrToFloat_My(edCoordz.Text);
xLine.FPoints[k].z := StrToFloat_My(edCoordz.Text) / Factor;
end;
if xCorner <> nil then
begin
xCorner.FGLPOints[k].z := StrToFloat_My(edCoordZ.Text);
xCorner.FPoints.z := StrToFloat_My(edCoordZ.Text) / Factor;
end;
GlLineNode[k].Z := StrToFloat_My(edCoordZ.Text);
if TObject(TTreenode(TGLLines(DummyCube.Children[j]).TagObject).Data) is T3dCorner then
begin
GlLineNode[k+1].Z := StrToFloat_My(edCoordZ.Text);
end;
end;
end;
break;
end;
end;
end;
end;
////////////////////////// \ROOF /////////////////////////////
end;
{$IFEND}
procedure Tfrm3D.ChangeCoordX;
var
i,j,k: integer;
xObject: T3DSide;
xGLObject: TGLBaseSceneObject;
Index: Integer;
p: TVector3f;
Point3D: T3DPoint;
begin
try
if edCoordX.Text = '' then
exit;
Index := cbCoordNbr.ItemIndex;
for i := 0 to FPropObjects.Count - 1 do
begin
{$IF Defined(ES_GRAPH_SC)}
if TOBject(TTreeNode(FPropObjects[i]).Data) is T3DSide then
begin
xObject := T3DSide(TTreeNode(FPropObjects[i]).Data);
xGLObject := TGLBaseSceneObject(xObject.FGLObject);
Point3D := xObject.FGLPoints[Index];
xObject.FGLPoints[Index].x := StrToFloat_My(edCoordX.Text);
xObject.FPoints[Index].x := StrToFloat_My(edCoordX.Text) / Factor;
if (xGLObject is TGLPolygon) then
begin
TGLPolygon(xGLObject).Nodes[Index].X := StrToFloat_My(edCoordX.Text);
end;
ChangeAllFiguresWithPoint(Point3D, cX);
end;
{$ELSE}
xObject := T3DSide(TTreeNode(FPropObjects[i]).Data);
xGLObject := TGLBaseSceneObject(xObject.FGLObject);
xObject.FGLPoints[Index].x := StrToFloat_My(edCoordX.Text);
xObject.FPoints[Index].x := StrToFloat_My(edCoordX.Text) / Factor;
if (xGLObject is TGLPolygon) then
begin
TGLPolygon(xGLObject).Nodes[Index].X := StrToFloat_My(edCoordX.Text);
end;
{$IFEND}
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.ChangeCoordX', E.Message);
end;
end;
procedure Tfrm3D.ChangeCoordY;
var
i: integer;
xObject: T3DSide;
xGLObject: TGLBaseSceneObject;
Index: Integer;
p: TVector3f;
Point3D: T3DPoint;
begin
try
if edCoordY.Text = '' then
exit;
Index := cbCoordNbr.ItemIndex;
for i := 0 to FPropObjects.Count - 1 do
begin
{$IF Defined(ES_GRAPH_SC)}
if TOBject(TTreeNode(FPropObjects[i]).Data) is T3DSide then
begin
xObject := T3DSide(TTreeNode(FPropObjects[i]).Data);
xGLObject := TGLBaseSceneObject(xObject.FGLObject);
Point3D := xObject.FGLPoints[Index];
xObject.FGLPoints[Index].y := StrToFloat_My(edCoordY.Text);
xObject.FPoints[Index].z := StrToFloat_My(edCoordY.Text) / Factor;
if (xGLObject is TGLPolygon) then
begin
TGLPolygon(xGLObject).Nodes[Index].Y := StrToFloat_My(edCoordY.Text);
end;
ChangeAllFiguresWithPoint(Point3D, cY);
end;
{$ELSE}
xObject := T3DSide(TTreeNode(FPropObjects[i]).Data);
xGLObject := TGLBaseSceneObject(xObject.FGLObject);
xObject.FGLPoints[Index].y := StrToFloat_My(edCoordY.Text);
xObject.FPoints[Index].z := StrToFloat_My(edCoordY.Text) / Factor;
if (xGLObject is TGLPolygon) then
begin
TGLPolygon(xGLObject).Nodes[Index].Y := StrToFloat_My(edCoordY.Text);
end;
{$IFEND}
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.ChangeCoordY', E.Message);
end;
end;
procedure Tfrm3D.ChangeCoordZ;
var
i: integer;
xObject: T3DSide;
xGLObject: TGLBaseSceneObject;
Index: Integer;
p: TVector3f;
Point3D: T3DPoint;
begin
try
if edCoordZ.Text = '' then
exit;
Index := cbCoordNbr.ItemIndex;
for i := 0 to FPropObjects.Count - 1 do
begin
{$IF Defined(ES_GRAPH_SC)}
if TOBject(TTreeNode(FPropObjects[i]).Data) is T3DSide then
begin
xObject := T3DSide(TTreeNode(FPropObjects[i]).Data);
xGLObject := TGLBaseSceneObject(xObject.FGLObject);
Point3D := xObject.FGLPoints[Index];
xObject.FGLPoints[Index].z := StrToFloat_My(edCoordZ.Text);
xObject.FPoints[Index].y := StrToFloat_My(edCoordZ.Text) / Factor;
if (xGLObject is TGLPolygon) then
begin
TGLPolygon(xGLObject).Nodes[Index].Z := StrToFloat_My(edCoordZ.Text);
end;
ChangeAllFiguresWithPoint(Point3D, cZ);
end;
{$ELSE}
xObject := T3DSide(TTreeNode(FPropObjects[i]).Data);
xGLObject := TGLBaseSceneObject(xObject.FGLObject);
xObject.FGLPoints[Index].z := StrToFloat_My(edCoordZ.Text);
xObject.FPoints[Index].y := StrToFloat_My(edCoordZ.Text) / Factor;
if (xGLObject is TGLPolygon) then
begin
TGLPolygon(xGLObject).Nodes[Index].Z := StrToFloat_My(edCoordZ.Text);
end;
{$IFEND}
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.ChangeCoordZ', E.Message);
end;
end;
procedure Tfrm3D.ChangeDesc;
var
i, j: integer;
xObject: TObject;
xSide: T3DSide;
x3DSObject: T3DSObject;
xConn: T3DConnector;
xLine: T3DLine;
xGLObject, xGLObject1: TGLBaseSceneObject;
begin
try
for i := 0 to FPropObjects.Count - 1 do
begin
xObject := TObject(TTreeNode(FPropObjects[i]).Data);
if xObject is T3DSide then
begin
xSide := T3DSide(xObject);
xGLObject := TGLBaseSceneObject(xSide.FGLObject);
xSide.FDescription.Clear;
for j := 0 to mDesc.Lines.Count - 1 do
xSide.FDescription.Add(mDesc.Lines[j]);
if Pos('empty', AnsiLowerCase(mDesc.Lines.Text)) = 1 then
begin
if xGLObject <> nil then
begin
xGLObject.Visible := False;
if xSide.FAsArc then
RotateTextureToAngleP(xSide, TGLPolygon(xGLObject), xSide.FTextureRotate, xSide.FMirror);
end;
btnEmpty.GroupIndex := 1;
btnEmpty.Down := True;
if TTreeNode(FPropObjects[i]).ImageIndex < 999 then
begin
TTreeNode(FPropObjects[i]).ImageIndex := TTreeNode(FPropObjects[i]).ImageIndex + 1000;
TTreeNode(FPropObjects[i]).SelectedIndex := TTreeNode(FPropObjects[i]).ImageIndex;
end;
end
else
begin
btnEmpty.GroupIndex := 0;
btnEmpty.Down := False;
if xGLObject <> nil then
begin
xGLObject.Visible := True;
if xSide.FAsArc then
RotateTextureToAngleP(xSide, TGLPolygon(xGLObject), xSide.FTextureRotate, xSide.FMirror);
end;
if TTreeNode(FPropObjects[i]).ImageIndex > 999 then
begin
TTreeNode(FPropObjects[i]).ImageIndex := TTreeNode(FPropObjects[i]).ImageIndex - 1000;
TTreeNode(FPropObjects[i]).SelectedIndex := TTreeNode(FPropObjects[i]).ImageIndex;
end;
end;
end;
if xObject is T3DSObject then
begin
x3DSObject := T3DSObject(xObject);
xGLObject := TGLBaseSceneObject(x3DSObject.FGLObject);
x3DSObject.FDescription.Clear;
for j := 0 to mDesc.Lines.Count - 1 do
x3DSObject.FDescription.Add(mDesc.Lines[j]);
if Pos('empty', AnsiLowerCase(mDesc.Lines.Text)) = 1 then
begin
if xGLObject <> nil then
xGLObject.Visible := False;
btnEmpty.GroupIndex := 1;
btnEmpty.Down := True;
end
else
begin
btnEmpty.GroupIndex := 0;
btnEmpty.Down := False;
if xGLObject <> nil then
xGLObject.Visible := True;
end;
end;
if xObject is T3DConnector then
begin
xConn := T3DConnector(xObject);
xGLObject := TGLBaseSceneObject(xConn.FGLObject);
xGLObject1 := TGLBaseSceneObject(xConn.FGLObject1);
xConn.FDescription.Clear;
for j := 0 to mScsDesc.Lines.Count - 1 do
xConn.FDescription.Add(mScsDesc.Lines[j]);
if Pos('empty', AnsiLowerCase(mScsDesc.Lines.Text)) = 1 then
begin
if xGLObject <> nil then
xGLObject.Visible := False;
btnEmpty.GroupIndex := 1;
btnEmpty.Down := True;
end
else
begin
btnEmpty.GroupIndex := 0;
btnEmpty.Down := False;
if xGLObject <> nil then
xGLObject.Visible := True;
end;
end;
if xObject is T3DLine then
begin
xLine := T3DLine(xObject);
xGLObject := TGLBaseSceneObject(xLine.FGLObject);
xLine.FDescription.Clear;
for j := 0 to mScsDesc.Lines.Count - 1 do
xLine.FDescription.Add(mScsDesc.Lines[j]);
if Pos('empty', AnsiLowerCase(mScsDesc.Lines.Text)) = 1 then
begin
if xGLObject <> nil then
xGLObject.Visible := False;
btnEmpty.GroupIndex := 1;
btnEmpty.Down := True;
end
else
begin
btnEmpty.GroupIndex := 0;
btnEmpty.Down := False;
if xGLObject <> nil then
xGLObject.Visible := True;
end;
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.ChangeDesc', E.Message);
end;
end;
procedure Tfrm3D.ChangeName;
var
i: integer;
xObject: TObject;
xSide: T3DSide;
x3DSObject: T3DSObject;
xConn: T3DConnector;
xLine: T3DLine;
xGLObject: TGLBaseSceneObject;
begin
try
if (pcProps.ActivePage = TabArchProps) and (edName.Text = '') then
exit;
if (pcProps.ActivePage = TabScsProps) and (edScsName.Text = '') then
exit;
for i := 0 to FPropObjects.Count - 1 do
begin
xObject := TObject(TTreeNode(FPropObjects[i]).Data);
if xObject is T3DSide then
begin
xSide := T3DSide(xObject);
xGLObject := TGLBaseSceneObject(xSide.FGLObject);
TTreeNode(FPropObjects[i]).Text := edName.Text;
xSide.FName := edName.Text;
end;
if xObject is T3DSObject then
begin
x3DSObject := T3DSObject(xObject);
xGLObject := TGLBaseSceneObject(x3DSObject.FGLObject);
TTreeNode(FPropObjects[i]).Text := edName.Text;
x3DSObject.FName := edName.Text;
end;
if xObject is T3DConnector then
begin
xConn := T3DConnector(xObject);
xGLObject := TGLBaseSceneObject(xConn.FGLObject);
TTreeNode(FPropObjects[i]).Text := edScsName.Text;
xConn.FName := edScsName.Text;
end;
if xObject is T3DLine then
begin
xLine := T3DLine(xObject);
xGLObject := TGLBaseSceneObject(xLine.FGLObject);
TTreeNode(FPropObjects[i]).Text := edScsName.Text;
xLine.FName := edScsName.Text;
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.ChangeName', E.Message);
end;
end;
procedure Tfrm3D.ChangeTextureRotate;
var
i: integer;
xObject: T3DSide;
xGLObject: TGLBaseSceneObject;
Bmp: TBitmap;
begin
try
if edTextureRotate.Text = '' then
exit;
for i := 0 to FPropObjects.Count - 1 do
begin
if TOBject(TTreeNode(FPropObjects[i]).Data) is T3DSide then
begin
xObject := T3DSide(TTreeNode(FPropObjects[i]).Data);
xGLObject := TGLBaseSceneObject(xObject.FGLObject);
if StrToInt(edTextureRotate.Text) >= 360 then
edTextureRotate.Text := IntToStr(StrToInt(edTextureRotate.Text) mod 360);
xObject.FTextureRotate := StrToInt(edTextureRotate.Text);
if (xGLObject is TGLMesh) then
begin
RotateTextureToAngleM(xObject, TGLMesh(xGLObject), xObject.FTextureRotate, xObject.FMirror);
end;
if (xGLObject is TGLPolygon) then
begin
RotateTextureToAngleP(xObject, TGLPolygon(xGLObject), xObject.FTextureRotate, xObject.FMirror);
end;
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.ChangeTextureRotate', E.Message);
end;
end;
//Alex(20.12.2010)
procedure Tfrm3D.sbFirstFaceClick(Sender: TObject);
begin
FirstPersonCamera.FocalLength := 100; //160;
DeselectGLObjects;
GLSceneViewer.SetFocus;
GLSceneViewer.Camera := FirstPersonCamera;
GLLightFirstPerson.Shining := True;
Light.Shining := False;
lbViewType.Caption := cForm3D_Mes5;
end;
procedure Tfrm3D.GLCadencerProgress(Sender: TObject; const deltaTime, newTime: Double);
var
i: integer;
speed : Single;
Pt: TPoint;
//Alex
movementScale: single;
shiftDown: Boolean;
begin
if not GLSceneViewer.Focused then
exit;
// handle keypresses
speed := deltaTime;
shiftDown:=(IsKeyDown(VK_LSHIFT) or IsKeyDown(VK_RSHIFT));
//Alex(16.12.2010)
if GLSceneViewer.Camera = FirstPersonCamera then
begin
movementScale:= GLFPSMovementManager1.movementScale;
//Ââåðõ
if IsKeyDown(VK_PRIOR) then
begin
if shiftDown then
behav.StrafeVertical(MovementScale*deltaTime)
else
behav.turnVertical(70*deltatime);
end;
//Âíèç
if IsKeyDown(VK_NEXT) then
begin
if shiftDown then
behav.StrafeVertical(-MovementScale*deltaTime)
else
behav.turnVertical(-70*deltatime);
end;
//Äâèæåíèå âëåâî
if IsKeyDown(VK_LEFT) then
begin
if shiftDown then
behav.StrafeHorizontal(-MovementScale*deltaTime * 2)
else
behav.TurnHorizontal(-100*deltatime);
end;
//Äâèæåíèå âïðàâî
if IsKeyDown(VK_RIGHT) then
begin
if shiftDown then
behav.StrafeHorizontal(MovementScale*deltaTime * 2)
else
behav.TurnHorizontal(100*deltatime);
end;
//Äâèæåíèå âïåðåä
if IsKeyDown(VK_UP) then
begin
//if shiftDown then
// behav.turnVertical(70*deltatime)
//else
if shiftDown then
behav.MoveForward(MovementScale*deltaTime * 4)
else
behav.MoveForward(MovementScale*deltaTime * 2);
end;
//Äâèæåíèå íàçàä
if IsKeyDown(VK_DOWN) then
begin
//if shiftDown then
// behav.turnVertical(-70*deltatime)
//else
if shiftDown then
behav.MoveForward(-MovementScale*deltaTime * 4)
else
behav.MoveForward(-MovementScale*deltaTime * 2);
end;
GLSceneViewer.Invalidate;
end
else
begin
//if IsKeyDown(VK_RIGHT) then
// DummyCube.Translate(GLSceneViewer.Camera.Position.Z * speed, 0, -GLSceneViewer.Camera.Position.X * speed);
//if IsKeyDown(VK_LEFT) then
// DummyCube.Translate(-GLSceneViewer.Camera.Position.Z * speed, 0, GLSceneViewer.Camera.Position.X * speed);
//if IsKeyDown(VK_UP) then
// DummyCube.Translate(-GLSceneViewer.Camera.Position.X * speed, 0, -GLSceneViewer.Camera.Position.Z * speed);
//if IsKeyDown(VK_DOWN) then
// DummyCube.Translate(GLSceneViewer.Camera.Position.X * speed, 0, GLSceneViewer.Camera.Position.Z * speed);
//Äâèæåíèå âïåðåä ïî êëàâèøàì ö è w
if (IsKeyDown('ö') or IsKeyDown('w')) then
GLSceneViewer.Camera.Move(5 * deltaTime);
//Äâèæåíèå íàçàä ïî êëàâèøàì û è s
if (IsKeyDown('û') or IsKeyDown('s')) then
GLSceneViewer.Camera.Move(-5 * deltaTime);
//Ïîâîðîò âëåâî ïî êëàâèøàì ô è a
if (IsKeyDown('ô') or IsKeyDown('a')) then
GLSceneViewer.Camera.slide(-5 * deltaTime);
//Ïîâîðîò âïðàâî ïî êëàâèøàì â è d
if (IsKeyDown('â') or IsKeyDown('d')) then
GLSceneViewer.Camera.slide(5 * deltaTime);
if IsKeyDown(VK_ESCAPE) or IsKeyDown(VK_RETURN) then
begin
if FToolMode <> tmSelect then
begin
//21.09.2011
//FToolMode := tmSelect;
// glSpliter.Visible := False;
// glCubeSpliter.Visible := False;
// glCubeSpliter1.Visible := False;
// glCubeSpliter2.Visible := False;
// glSide11.Visible := False;
// glSide12.Visible := False;
// glSide21.Visible := False;
// glSide22.Visible := False;
// GLSceneViewer.Cursor := crDefault;
// DeleteNodesObjects;
// RefreshSidesPoints;
ApplyCutting;
// **** Undo Cut *****************
if IsKeyDown(VK_ESCAPE) then
begin
UndoCutSides;
end;
end
else
// Check Escape On Object Tracing
begin
if FMovedFullConnector <> nil then
begin
FMovedFullConnector.Position.X := MovedStartPos.x;
FMovedFullConnector.Position.Y := MovedStartPos.y;
FMovedFullConnector.Position.Z := MovedStartPos.z;
for i := 0 to FShadowObjects.Count - 1 do
DummyCube.Remove(TGLLines(FShadowObjects[i]), True);
FShadowObjects.Clear;
FMovedFullConnector := nil;
GLSceneViewer.Cursor := crDefault;
sbView.Caption := '';
end;
if FMovedEmptyConnector <> nil then
begin
FMovedEmptyConnector.Position.X := MovedStartPos.x;
FMovedEmptyConnector.Position.Y := MovedStartPos.y;
FMovedEmptyConnector.Position.Z := MovedStartPos.z;
for i := 0 to FShadowObjects.Count - 1 do
DummyCube.Remove(TGLLines(FShadowObjects[i]), True);
FShadowObjects.Clear;
FMovedEmptyConnector := nil;
GLSceneViewer.Cursor := crDefault;
sbView.Caption := '';
end;
if FMovedLine <> nil then
begin
FMovedLine.Nodes[0].X := MovedStartPos1.x;
FMovedLine.Nodes[0].Y := MovedStartPos1.y;
FMovedLine.Nodes[0].Z := MovedStartPos1.z;
FMovedLine.Nodes[1].X := MovedStartPos2.x;
FMovedLine.Nodes[1].Y := MovedStartPos2.y;
FMovedLine.Nodes[1].Z := MovedStartPos2.z;
FMovedLine := nil;
GLSceneViewer.Cursor := crDefault;
sbView.Caption := '';
end;
end;
end;
end;
end;
procedure Tfrm3D.GLSceneViewerClick(Sender: TObject);
begin
try
if not GLSceneViewer.Focused then
begin
SendMessage(GLSceneViewer.Handle, WM_ACTIVATE, MakewParam(WA_ACTIVE, 0), 0);
SendMessage(GLSceneViewer.Handle, WM_SETFOCUS, 0, 0);
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.GLSceneViewerClick', E.Message);
end;
end;
procedure Tfrm3D.RotateTextureToAngleM(aObject: T3DSide; aGLObject: TGLMesh; aAngle: Integer; aMirror: Boolean);
var
pN, pP: TVector3f;
mat: TAffineMatrix;
i: Integer;
vs, vs0, vs1, vs2: TVector3f;
tp: TTexPoint;
r1, r2: T3DPoint;
rAngle: Double;
VCoords: array [1..4] of TVector3f;
axis: T3DAxis;
begin
try
//
if (aObject.FFaceType = ftNetFloor) or (aObject.FFaceType = ftNetCeiling) then
begin
VCoords[1][0] := 0; VCoords[1][1] := 0; VCoords[1][2] := 0;
VCoords[2][0] := 100; VCoords[2][1] := 0; VCoords[2][2] := 0;
VCoords[3][0] := 100; VCoords[3][1] := 0; VCoords[3][2] := 100;
VCoords[4][0] := 0; VCoords[4][1] := 0; VCoords[4][2] := 100;
axis := aZ;
end
else if (aObject.FFaceType = ftNetPath) then
begin
VCoords[1] := aGLObject.Vertices[0].coord;
VCoords[2] := aGLObject.Vertices[1].coord;
VCoords[3] := aGLObject.Vertices[3].coord;
VCoords[4] := aGLObject.Vertices[2].coord;
axis := aY;
end;
rAngle := DegToRad(aAngle);
if (aAngle >=0) and (aAngle < 90) then
begin
if not aMirror then
begin
vs0 := VCoords[1];
vs1 := VCoords[2];
end
else
begin
vs0 := VCoords[2];
vs1 := VCoords[1];
end;
vs2 := VCoords[4];
r1.x := vs0[0]; r1.y := vs0[2]; r1.z := vs0[1];
r2.x := vs1[0]; r2.y := vs1[2]; r2.z := vs1[1];
r2 := Rotate3DPoint(r1, r2, DegToRad(aAngle- 0), axis);
vs1[0] := r2.x; vs1[2] := r2.y; vs1[1] := r2.z;
end;
if (aAngle >=90) and (aAngle < 180) then
begin
if not aMirror then
begin
vs0 := VCoords[2];
vs1 := VCoords[3];
end
else
begin
vs0 := VCoords[3];
vs1 := VCoords[2];
end;
vs2 := VCoords[1];
r1.x := vs0[0]; r1.y := vs0[2]; r1.z := vs0[1];
r2.x := vs1[0]; r2.y := vs1[2]; r2.z := vs1[1];
r2 := Rotate3DPoint(r1, r2, DegToRad(aAngle - 90), axis);
vs1[0] := r2.x; vs1[2] := r2.y; vs1[1] := r2.z;
end;
if (aAngle >=180) and (aAngle < 270) then
begin
if not aMirror then
begin
vs0 := VCoords[3];
vs1 := VCoords[4];
end
else
begin
vs0 := VCoords[4];
vs1 := VCoords[3];
end;
vs2 := VCoords[2];
r1.x := vs0[0]; r1.y := vs0[2]; r1.z := vs0[1];
r2.x := vs1[0]; r2.y := vs1[2]; r2.z := vs1[1];
r2 := Rotate3DPoint(r1, r2, DegToRad(aAngle - 180), axis);
vs1[0] := r2.x; vs1[2] := r2.y; vs1[1] := r2.z;
end;
if (aAngle >=270) and (aAngle < 360) then
begin
if not aMirror then
begin
vs0 := VCoords[4];
vs1 := VCoords[1];
end
else
begin
vs0 := VCoords[1];
vs1 := VCoords[4];
end;
vs2 := VCoords[3];
r1.x := vs0[0]; r1.y := vs0[2]; r1.z := vs0[1];
r2.x := vs1[0]; r2.y := vs1[2]; r2.z := vs1[1];
r2 := Rotate3DPoint(r1, r2, DegToRad(aAngle - 270), axis);
vs1[0] := r2.x; vs1[2] := r2.y; vs1[1] := r2.z;
end;
pN := CalcPlaneNormal (vs0, vs1, vs2);
SetVector (mat[2], pN);
SetVector (mat[0], VectorNormalize (VectorSubtract (vs1, vs0)));
SetVector (mat[1], VectorCrossProduct (mat[2], mat[0]));
InvertMatrix (mat);
for i := 0 to aGLObject.Vertices.Count - 1 do
begin
vs := aGLObject.Vertices[i].coord;
pP := VectorTransform (vs, mat);
tp := TexPointMake (pP[0], pP[1]);
aGLObject.Vertices.VertexTexCoord[i] := tp;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.RotateTextureToAngle', E.Message);
end;
end;
procedure Tfrm3D.RotateTextureToAngleP(aObject: T3DSide; aGLObject: TGLPolygon; aAngle: Integer; aMirror: Boolean);
var
pN, pP: TVector3f;
mat: TAffineMatrix;
i: Integer;
vs, vs0, vs1, vs2: TVector3f;
tp: TTexPoint;
r1, r2: T3DPoint;
rAngle: Double;
VCoords: array [1..4] of TVector3f;
axis: T3DAxis;
xScale: Double;
WH_koef: double; //- øèðèíà / âûñîòà
HW_koef: double; //- âûñîòà / øèðèíà
f_find_other_GLObject: Boolean;
f_face_index: integer;
f_first_Object: T3DSide;
f_Face: TFaceRecord;
f_GLObject: TGLBaseSceneObject;
tmpdir: string;
tmpfname: string;
Coords3D: T3DPointArray;
begin
try
f_find_other_GLObject := True;
f_face_index := 0;
f_first_Object := aObject;
f_GLObject := aGLObject;
tmpfname := '';
if (f_GLObject is TGLPolygon) and (f_GLObject.TagObject <> nil) then
begin
if (T3DSide(TTreeNode(f_GLObject.TagObject).Data).FAsArc) then
begin
//tmpdir := GetWorkDir; //ExtractDirByCategoryType(dctPictures);
//tmpfname := tmpdir + '\tmp.bmp';
//aGLObject.Material.Texture.Image.SaveToFile(tmpfname);
end;
end;
while f_find_other_GLObject do
begin
{TODO} // ïåðåïðîâåðèòü
//if aObject.FAsArc then
begin
//Çàäàþòñÿ 4 òî÷êè â ïðîñòðàíñòâå ïî ÷àñîâîé ñòðåëêå ïî óìîë÷àíèþ-
//ñòåíà, ëåæàùàÿ íà îñè Õ
VCoords[1][0] := 0; VCoords[1][1] := 0; VCoords[1][2] := 0;
VCoords[2][0] := 100; VCoords[2][1] := 0; VCoords[2][2] := 0;
VCoords[3][0] := 100; VCoords[3][1] := 100; VCoords[3][2] := 0;
VCoords[4][0] := 0; VCoords[4][1] := 100; VCoords[4][2] := 0;
end;
//else
begin
if aGLObject.Nodes.Count >= 3 then
begin
//VCoords[1][0] := aGLObject.Nodes[0].x;
//VCoords[1][1] := aGLObject.Nodes[0].y;
//VCoords[1][2] := aGLObject.Nodes[0].z;
//VCoords[2][0] := aGLObject.Nodes[1].x;
//VCoords[2][1] := aGLObject.Nodes[1].y;
//VCoords[2][2] := aGLObject.Nodes[1].z;
//VCoords[3][0] := aGLObject.Nodes[2].x;
//VCoords[3][1] := aGLObject.Nodes[2].y;
//VCoords[3][2] := aGLObject.Nodes[2].z;
//VCoords[4][0] := aGLObject.Nodes[3].x;
//VCoords[4][1] := aGLObject.Nodes[3].y;
//VCoords[4][2] := aGLObject.Nodes[3].z;
//28.08.2012 Coords3D := GetPointsForNormal(GLNodesTo3DCoords(aGLObject.Nodes, true));
//Coords3D := GLNodesTo3DCoords(aGLObject.Nodes, true);
if (AObject.FFaceType = ftNetFloor) or (AObject.FFaceType = ftNetCeiling) then
Coords3D := GetPointsForNormal(GLNodesTo3DCoords(aGLObject.Nodes, true))
else
Coords3D := GLNodesTo3DCoords(aGLObject.Nodes, true);
for i := 0 to Length(Coords3D) -1 do
begin
if Length(VCoords) >= (i+1) then
begin
VCoords[i+1][0] := Coords3D[i].x;
//VCoords[i+1][1] := Coords3D[i].y;
//VCoords[i+1][2] := Coords3D[i].z;
VCoords[i+1][1] := Coords3D[i].z;
VCoords[i+1][2] := Coords3D[i].y;
end
else
Break; //// BREAK ////
end;
end
else
begin
//Ïîëó÷àåòñÿ ÷òî-òî,íàïîäîáèè ñòåíû
VCoords[1][0] := 0; VCoords[1][1] := 0; VCoords[1][2] := 0;
VCoords[2][0] := 100; VCoords[2][1] := 0; VCoords[2][2] := 0;
VCoords[3][0] := 100; VCoords[3][1] := 0; VCoords[3][2] := 100;
VCoords[4][0] := 0; VCoords[4][1] := 0; VCoords[4][2] := 100;
end;
end;
rAngle := DegToRad(aAngle);
if (aAngle >=0) and (aAngle < 90) then
begin
if not aMirror then
begin
vs0 := VCoords[1];
vs1 := VCoords[2];
end
else
begin
vs0 := VCoords[2];
vs1 := VCoords[1];
end;
vs2 := VCoords[4];
vs1 := Rotate3DVector(vs0, vs1, vs2, aAngle - 0);
end;
if (aAngle >=90) and (aAngle < 180) then
begin
if not aMirror then
begin
vs0 := VCoords[2];
vs1 := VCoords[3];
end
else
begin
vs0 := VCoords[3];
vs1 := VCoords[2];
end;
vs2 := VCoords[1];
vs1 := Rotate3DVector(vs0, vs1, vs2, aAngle - 90);
end;
if (aAngle >=180) and (aAngle < 270) then
begin
if not aMirror then
begin
vs0 := VCoords[3];
vs1 := VCoords[4];
end
else
begin
vs0 := VCoords[4];
vs1 := VCoords[3];
end;
vs2 := VCoords[2];
vs1 := Rotate3DVector(vs0, vs1, vs2, aAngle - 180);
end;
if (aAngle >=270) and (aAngle < 360) then
begin
if not aMirror then
begin
vs0 := VCoords[4];
vs1 := VCoords[1];
end
else
begin
vs0 := VCoords[1];
vs1 := VCoords[4];
end;
vs2 := VCoords[3];
vs1 := Rotate3DVector(vs0, vs1, vs2, aAngle - 270);
end;
pN := CalcPlaneNormal (vs0, vs1, vs2);
SetVector (mat[2], pN);
SetVector (mat[0], VectorNormalize (VectorSubtract (vs1, vs0)));
SetVector (mat[1], VectorCrossProduct (mat[2], mat[0]));
with aGLObject.Material.Texture do
begin
{TODO} // ïðèìåíÿòü òåêóùèé ìàñøòàá + ïðèìåíåíèå çàäàíîãî ïîëüçîâàòåëåì
// OK
xScale := aObject.FTextureScale / 100; // 1;
WH_koef := Image.Width / Image.Height;
HW_koef := Image.Height / Image.Width;
MappingMode := tmmObjectLinear;
if Image.Width > Image.Height then
begin
MappingSCoordinates.AsVector := VectorMake(mat[0][0] * (1 / xScale) * HW_koef,
mat[0][1] * (1 / xScale) * HW_koef,
mat[0][2] * (1 / xScale) * HW_koef,
0);
MappingTCoordinates.AsVector := VectorMake(mat[1][0] * (1 / xScale) * 1,
mat[1][1] * (1 / xScale) * 1,
mat[1][2] * (1 / xScale) * 1,
0);
end
else
begin
MappingSCoordinates.AsVector := VectorMake(mat[0][0] * (1 / xScale),
mat[0][1] * (1 / xScale),
mat[0][2] * (1 / xScale),
0);
MappingTCoordinates.AsVector := VectorMake(mat[1][0] * (1 / xScale) * WH_koef,
mat[1][1] * (1 / xScale) * WH_koef,
mat[1][2] * (1 / xScale) * WH_koef,
0);
end;
end;
f_find_other_GLObject := False;
if aObject.FAsArc then
begin
//xSide := T3DSide(TTreeNode(xObj.TagObject).Data);
while f_face_index < DummyCube.Count do
begin
if DummyCube.Children[f_face_index] <> f_GLObject then
begin
if (DummyCube.Children[f_face_index] is TGLPolygon) and (DummyCube.Children[f_face_index].TagObject <> nil) then
begin
if (T3DSide(TTreeNode(DummyCube.Children[f_face_index].TagObject).Data).FAsArc) and
(DummyCube.Children[f_face_index].TagObject = f_GLObject.TagObject) and
(DummyCube.Children[f_face_index].TagObject = f_first_Object.FFace.FTreeNode) then
begin
f_find_other_GLObject := True;
aGLObject := TGLPolygon(DummyCube.Children[f_face_index]);
//if tmpfname <> '' then
begin
aGLObject.Visible := f_GLObject.Visible;
aGLObject.Material.Texture.Disabled := False;
aGLObject.Material.Texture.MappingMode := tmmObjectLinear;
aGLObject.Material.Texture.DestroyHandles;
//aGLObject.Material.Texture.Image.LoadFromFile(tmpfname);
aGLObject.Material.Texture.Image.Assign(TGLPolygon(f_GLObject).Material.Texture.Image);
end;
f_face_index := f_face_index + 1;
break;
end;
end;
end;
f_face_index := f_face_index + 1;
end;
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.RotateTextureToAngleP', E.Message);
end;
end;
procedure Tfrm3D.SetPolygonTexture(aObject: TGLPolygon);
var
pN: TVector3f;
mat: TAffineMatrix;
vs0, vs1, vs2: TVector3f;
VCoords: array [1..4] of TVector3f;
begin
try
if aObject.Nodes.Count <= 4 then
begin
VCoords[1][0] := aObject.Nodes[0].x;
VCoords[1][1] := aObject.Nodes[0].y;
VCoords[1][2] := aObject.Nodes[0].z;
VCoords[2][0] := aObject.Nodes[1].x;
VCoords[2][1] := aObject.Nodes[1].y;
VCoords[2][2] := aObject.Nodes[1].z;
VCoords[3][0] := aObject.Nodes[2].x;
VCoords[3][1] := aObject.Nodes[2].y;
VCoords[3][2] := aObject.Nodes[2].z;
VCoords[4][0] := aObject.Nodes[3].x;
VCoords[4][1] := aObject.Nodes[3].y;
VCoords[4][2] := aObject.Nodes[3].z;
end
else
begin
VCoords[1][0] := 0; VCoords[1][1] := 0; VCoords[1][2] := 0;
VCoords[2][0] := 100; VCoords[2][1] := 0; VCoords[2][2] := 0;
VCoords[3][0] := 100; VCoords[3][1] := 0; VCoords[3][2] := 100;
VCoords[4][0] := 0; VCoords[4][1] := 0; VCoords[4][2] := 100;
end;
vs0 := VCoords[1];
vs1 := VCoords[2];
vs2 := VCoords[3];
pN := CalcPlaneNormal (vs0, vs1, vs2);
SetVector (mat[2], pN);
SetVector (mat[0], VectorNormalize (VectorSubtract (vs1, vs0)));
SetVector (mat[1], VectorCrossProduct (mat[2], mat[0]));
with aObject.Material.Texture do
begin
MappingMode := tmmObjectLinear;
MappingSCoordinates.AsVector := VectorMake(mat[0][0], mat[0][1], mat[0][2], 0);
MappingTCoordinates.AsVector := VectorMake(mat[1][0], mat[1][1], mat[1][2], 0);
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.SetPolygonTexture', E.Message);
end;
end;
Function Tfrm3D.Rotate3DVector(vs0, vs1, vs2: TVector3f; Ang: Double): TVector3f;
var
osp: T3DPoint;
nz, nx, ny: Double;
r0, r1, r2: TDoublePoint;
k: double;
begin
r0.x := vs0[0]; r0.y := vs0[2]; r0.z := vs0[1];
r1.x := vs1[0]; r1.y := vs1[2]; r1.z := vs1[1];
r2.x := vs2[0]; r2.y := vs2[2]; r2.z := vs2[1];
k := (Ang / 90);
nx := r1.x - (r1.x - r2.x) * k;
ny := r1.y - (r1.y - r2.y) * k;
nz := r1.z - (r1.z - r2.z) * k;
Result[0] := nx;
Result[1] := nz;
Result[2] := ny;
end;
function Tfrm3D.GetImageFileByHash(aHash: string): string;
var
i: integer;
tmpdir, tmpfname, str: string;
begin
try
Result := '';
if aHash <> '' then
begin
tmpdir := GetWorkDir; // ExtractDirByCategoryType(dctPictures);
for i := 0 to F3DModel.FHashs.Count - 1 do
begin
str := F3DModel.FHashs.Strings[i];
if str = aHash then
begin
tmpfname := tmpdir + '\' + str + '.bmp';
if FileExists(tmpfname) then
begin
Result := tmpfname;
exit;
end;
end;
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.GetImageFileByHash', E.Message);
end;
end;
function Tfrm3D.GetTextureFileByHash(aHash: string): string;
var
i: integer;
tmpdir, tmpfname, str: string;
begin
try
Result := '';
if aHash <> '' then
begin
tmpdir := GetWorkDir;
i := F3DModel.FFilesHashs.IndexOf(aHash);
if i >= 0 then
begin
str := F3DModel.FFilesHashs.Strings[i];
tmpfname := tmpdir + '\' + str;
if FileExists(tmpfname) then
begin
Result := tmpfname;
exit;
end;
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.GetTextureFileByHash', E.Message);
end;
end;
procedure Tfrm3D.cbHashsPropertiesCloseUp(Sender: TObject);
var
i, Index: Integer;
xObject: T3DSide;
xGLObject: TGLBaseSceneObject;
tmpdir, tmpfname, ExtStr, BmpFName: string;
HashStr: string;
begin
try
Index := cbSideHashs.ItemIndex;
if Index >= 0 then
begin
HashStr := cbSideHashs.Properties.Items[Index];
tmpdir := GetWorkDir; //ExtractDirByCategoryType(dctPictures);
tmpfname := GetImageFileByHash(HashStr);
ExtStr := ExtractFileExt(tmpfname);
if tmpfname <> '' then
begin
imgSideTexture.Picture.LoadFromFile(tmpfname);
for i := 0 to FPropObjects.Count - 1 do
begin
if TOBject(TTreeNode(FPropObjects[i]).Data) is T3DSide then
begin
xObject := T3DSide(TTreeNode(FPropObjects[i]).Data);
xGLObject := TGLBaseSceneObject(xObject.FGLObject);
xObject.FTextureHash := HashStr;
xObject.FTexture_ext := ExtStr;
if (xGLObject is TGLPolygon) then
begin
TGLPolygon(xGLObject).Material.Texture.Disabled := False;
TGLPolygon(xGLObject).Material.Texture.DestroyHandles;
try
TGLPolygon(xGLObject).Material.Texture.Image.LoadFromFile(tmpfname);
except
ShowMessage('File not found ' + tmpfname);
end;
RotateTextureToAngleP(xObject, TGLPolygon(xGLObject), xObject.FTextureRotate, xObject.FMirror);
// TGLPolygon(xGLObject).Material.Texture.ApplyMappingMode;
// TGLPolygon(xGLObject).Material.Texture.TexHeight := 100;
// TGLPolygon(xGLObject).Material.Texture.TexWidth := 100;
end;
end;
end;
end
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.cbHashsPropertiesCloseUp', E.Message);
end;
end;
procedure Tfrm3D.nAdd3DObjectClick(Sender: TObject);
var
i, j: integer;
FName: string;
xNode, xSubNode: TTreeNode;
xRoom: T3DRoom;
xObject: T3DSObject;
glObjClass: TGLSceneObjectClass;
glObject: TGLFreeForm;
ObjectMin, ObjectMax, RoomMin, RoomMax, ObjSize, RoomSize, SetPos, Scale: T3DPoint;
SetScale: Double;
tmpdir, tmpfname: string;
HashStr: string;
begin
try
if ModelTree.SelectionCount = 1 then
begin
xNode := ModelTree.Selections[0];
Open3DObject.InitialDir := ExeDir + '\3DModels';
NoMoveEvent := True;
if Open3DObject.Execute then
begin
// ýòî ìîæíî íå äåëàòü!
//tmpdir := AddCreateDirToPath(ExtractFileDir(Application.ExeName), dnSave);
//CopyFile(PChar(Open3DObject.FileName), PChar(tmpdir + '\' + ExtractFileName(Open3DObject.FileName)), True);
//if FileExists(tmpdir + '\' + ExtractFileName(Open3DObject.FileName)) then
// FName := tmpdir + '\' + ExtractFileName(Open3DObject.FileName)
//else
FName := Open3DObject.FileName;
xRoom := T3DRoom(xNode.Data);
tmpdir := GetWorkDir; //ExtractDirByCategoryType(dctPictures);
// MARK
// ïîëó÷àåì HASH ïî çàãðóæàåìîìó ôàéëó
HashStr := GetObjectHash(FName);
// ïî HASH èùåì åñòü ëè îí â íàøåé áàçå
tmpfname := GetObjectFileByHash(HashStr);
// åñëè íàéäåí, òî ãðóçèì åãî
if tmpfname <> '' then
begin
end
else
// íå íàéäåí - ñîçäàåì äëÿ ôàéëà HASH, êîïèðóåì â òåìï, ãðóçèì
begin
F3DModel.F3DSHashs.Add(HashStr);
tmpfname := tmpdir + '\' + HashStr + '.3ds';
CopyFile(PChar(FName), PChar(tmpfname), True);
end;
// MARK
BeginProgress('Èäåò çàãðóçêà 3ds îáúåêòà ...'); // ***
// ñîçäàòü îáüåêò íà GLScene
glObjClass := TGLFreeForm;
glObject := TGLFreeForm(DummyCube.AddNewChild(glObjClass));
glObject.Material.Texture.Disabled := False;
glObject.MaterialLibrary := MatLib;
xObject := T3DSObject.Create(xRoom);
// FTextures.Clear;
FisCreate3DS := True;
FCurrObject := xObject;
//glObject.LoadFromFile(FName);
xObject.FObjectHash := HashStr;
//glObject.UseMeshMaterials := True;
glObject.LoadFromFile(tmpfname);
//glObject.BuildOctree; //òîðìîçà
//glObject.StructureChanged;
{TODO - ïåðåïðîâåðèòü - âîçìîæíî è íóæíî ýòî äåëàòü! }
//for i := 0 to MatLib.Materials.Count - 1 do
// MatLib.Materials[i].Material.Texture.MappingMode := tmmCubeMapCamera;
Get3DSObjectBounds(ObjectMin, ObjectMax, glObject);
GetRoomBounds(RoomMin, RoomMax, xRoom.FFloor.FGLPoints, xRoom.FCeiling.FGLPoints);
ObjSize.x := abs(ObjectMax.x - ObjectMin.x);
ObjSize.y := abs(ObjectMax.y - ObjectMin.y);
ObjSize.z := abs(ObjectMax.z - ObjectMin.z);
RoomSize.x := abs(RoomMax.x - RoomMin.x);
RoomSize.y := abs(RoomMax.y - RoomMin.y);
RoomSize.z := abs(RoomMax.z - RoomMin.z);
SetPos.x := abs(RoomMax.x + RoomMin.x) / 2;
SetPos.y := RoomMin.y + FDeltaZFloor; //abs(RoomMax.y + RoomMin.y) / 2;
SetPos.z := abs(RoomMax.z + RoomMin.z) / 2;
Scale.X := RoomSize.x / ObjSize.x;
Scale.Y := RoomSize.y / ObjSize.y;
Scale.Z := RoomSize.z / ObjSize.z;
SetScale := MinFloat(Scale.X, Scale.Y, Scale.Z);
//if SetScale > 1 then
// SetScale := 1;
glObject.Position.x := SetPos.x;
glObject.Position.y := SetPos.y;
glObject.Position.z := SetPos.z;
glObject.Scale.X := SetScale;
glObject.Scale.Y := SetScale;
glObject.Scale.Z := SetScale;
if glObject.Material.Texture.Disabled then
begin
glObject.Material.FrontProperties.Ambient.Color := ObjColor;
glObject.Material.FrontProperties.Diffuse.Color := ObjColor;
glObject.Material.FrontProperties.Emission.Color := ObjColor;
glObject.Material.BackProperties.Ambient.Color := ObjColor;
glObject.Material.BackProperties.Diffuse.Color := ObjColor;
glObject.Material.BackProperties.Emission.Color := ObjColor;
end;
// ÝÒÎ ÄÅËÀÒÜ ÍÅËÜÇß ÍÀ 3Ä ìîäåëÿõ!
//glObject.Material.Texture.MappingMode := tmmCubeMapCamera;
//// glObject.BuildOctree; òîðìîçà
//glObject.Material.MaterialOptions := [moNoLighting];
glObject.Material.MaterialOptions := [];
glObject.Material.Texture.Disabled := False;
// ñîçäàòü îáúåêò â êëàññå
xObject.FZOrder := xObject.FParent.FZOrder;
//xObject.FName := ExtractFileName(FName);
// çàïèøåì ëó÷øå ïîëíûé ïóòü ê ôàéëó ÷òî áû íà ïîëó÷åíèè òåêñòóð þçàòü ïóòü!
xObject.FName := FName;
xObject.FPosition.x := glObject.Position.X;
xObject.FPosition.y := glObject.Position.Y - xObject.FZOrder;
xObject.FPosition.z := glObject.Position.Z;
xObject.FScale.x := glObject.Scale.X;
xObject.FScale.y := glObject.Scale.Y;
xObject.FScale.z := glObject.Scale.Z;
xObject.FGLObject := glObject;
xRoom.F3DSObjects.Add(xObject);
// ñîçäàòü Íîä â äåðåâå
xSubNode := ModelTree.Items.AddChild(xNode, xObject.FName);
xSubNode.Data := xObject;
xSubNode.ImageIndex := 42;
xSubNode.SelectedIndex := xSubNode.ImageIndex;
glObject.TagObject := xSubNode;
Rotate3DSObj(TGLFreeForm(gLObject), 0, 0, -45);
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.nAdd3DObjectClick', E.Message);
end;
EndProgress;
end;
procedure Tfrm3D.ModelTreeMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
i: Integer;
xNode: TTreeNode;
begin
if (Button = mbRight) then
begin
if ModelTree.SelectionCount = 1 then
begin
xNode := ModelTree.Selections[0];
if (TObject(xNode.Data) is T3DRoom) then
begin
pmModelTree.Items[0].Visible := True;
pmModelTree.Items[1].Visible := False;
pmModelTree.Items[2].Visible := False;
pmModelTree.Popup(X, Y);
end;
if (FToolMode = tmSelect) and (TObject(xNode.Data) is T3DSide) and (T3DSide(xNode.Data).FSubSides.Count > 0) then
begin
pmModelTree.Items[0].Visible := False;
pmModelTree.Items[1].Visible := True;
pmModelTree.Items[2].Visible := False;
pmModelTree.Popup(X, Y);
end;
if (TObject(xNode.Data) is T3DSObject) then
begin
pmModelTree.Items[0].Visible := False;
pmModelTree.Items[1].Visible := False;
pmModelTree.Items[2].Visible := True;
pmModelTree.Popup(X, Y);
end;
end;
end;
end;
procedure Tfrm3D.ChangeAngleX;
var
i: integer;
xObject: TObject;
x3dsObject: T3DSObject;
xConn: T3DConnector;
xGLObject, xGLObject1: TGLBaseSceneObject;
begin
try
if (pcProps.ActivePage = TabArchProps) and (edAngleX.Text = '') then
exit;
if (pcProps.ActivePage = TabScsProps) and (edScsAngleX.Text = '') then
exit;
for i := 0 to FPropObjects.Count - 1 do
begin
xObject := TObject(TTreeNode(FPropObjects[i]).Data);
if xObject is T3DSObject then
begin
x3dsObject := T3DSObject(xObject);
xGLObject := TGLBaseSceneObject(x3dsObject.FGLObject);
x3dsObject.FRotate.x := StrToFloat_My(edAngleX.Text);
if (xGLObject is TGLFreeForm) then
begin
Rotate3DSObj(TGLFreeForm(xGLObject), x3dsObject.FRotate.x, x3dsObject.FRotate.y, x3dsObject.FRotate.z);
end;
end;
if xObject is T3DConnector then
begin
xConn := T3DConnector(xObject);
xGLObject := TGLBaseSceneObject(xConn.FGLObject);
xGLObject1 := TGLBaseSceneObject(xConn.FGLObject1);
xConn.FRotate.x := StrToFloat_My(edScsAngleX.Text);
RotateConnModel(TGLFreeForm(xGLObject1), xConn.FRotate.x, xConn.FRotate.y, xConn.FRotate.z);
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.ChangeAngleX', E.Message);
end;
end;
procedure Tfrm3D.ChangeAngleY;
var
i: integer;
xObject: TObject;
x3dsObject: T3DSObject;
xConn: T3DConnector;
xGLObject, xGLObject1: TGLBaseSceneObject;
begin
try
if (pcProps.ActivePage = TabArchProps) and (edAngleY.Text = '') then
exit;
if (pcProps.ActivePage = TabScsProps) and (edScsAngleY.Text = '') then
exit;
for i := 0 to FPropObjects.Count - 1 do
begin
xObject := TObject(TTreeNode(FPropObjects[i]).Data);
if xObject is T3DSObject then
begin
x3dsObject := T3DSObject(xObject);
xGLObject := TGLBaseSceneObject(x3dsObject.FGLObject);
x3dsObject.FRotate.y := StrToFloat_My(edAngleY.Text);
if (xGLObject is TGLFreeForm) then
begin
Rotate3DSObj(TGLFreeForm(xGLObject), x3dsObject.FRotate.x, x3dsObject.FRotate.y, x3dsObject.FRotate.z);
end;
end;
if xObject is T3DConnector then
begin
xConn := T3DConnector(xObject);
xGLObject := TGLBaseSceneObject(xConn.FGLObject);
xGLObject1 := TGLBaseSceneObject(xConn.FGLObject1);
xConn.FRotate.y := StrToFloat_My(edScsAngleY.Text);
RotateConnModel(TGLFreeForm(xGLObject1), xConn.FRotate.x, xConn.FRotate.y, xConn.FRotate.z);
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.ChangeAngleY', E.Message);
end;
end;
procedure Tfrm3D.ChangeAngleZ;
var
i: integer;
xObject: TObject;
x3dsObject: T3DSObject;
xConn: T3DConnector;
xGLObject, xGLObject1: TGLBaseSceneObject;
begin
try
if (pcProps.ActivePage = TabArchProps) and (edAngleZ.Text = '') then
exit;
if (pcProps.ActivePage = TabScsProps) and (edScsAngleZ.Text = '') then
exit;
for i := 0 to FPropObjects.Count - 1 do
begin
xObject := TObject(TTreeNode(FPropObjects[i]).Data);
if xObject is T3DSObject then
begin
x3dsObject := T3DSObject(xObject);
xGLObject := TGLBaseSceneObject(x3dsObject.FGLObject);
x3dsObject.FRotate.Z := StrToFloat_My(edAngleZ.Text);
if (xGLObject is TGLFreeForm) then
begin
Rotate3DSObj(TGLFreeForm(xGLObject), x3dsObject.FRotate.x, x3dsObject.FRotate.y, x3dsObject.FRotate.z);
end;
end;
if xObject is T3DConnector then
begin
xConn := T3DConnector(xObject);
xGLObject := TGLBaseSceneObject(xConn.FGLObject);
xGLObject1 := TGLBaseSceneObject(xConn.FGLObject1);
xConn.FRotate.Z := StrToFloat_My(edScsAngleZ.Text);
RotateConnModel(TGLFreeForm(xGLObject1), xConn.FRotate.x, xConn.FRotate.y, xConn.FRotate.z);
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.ChangeAngleZ', E.Message);
end;
end;
procedure Tfrm3D.ChangePosX;
var
i: integer;
xObject: TObject;
x3dsObject: T3DSObject;
xConn: T3DConnector;
xGLObject, xGLObject1: TGLBaseSceneObject;
begin
try
if (pcProps.ActivePage = TabArchProps) and (edPosX.Text = '') then
exit;
if (pcProps.ActivePage = TabScsProps) and (edScsOffsetX.Text = '') then
exit;
for i := 0 to FPropObjects.Count - 1 do
begin
xObject := TObject(TTreeNode(FPropObjects[i]).Data);
if xObject is T3DSObject then
begin
x3dsObject := T3DSObject(xObject);
xGLObject := TGLBaseSceneObject(x3dsObject.FGLObject);
x3dsObject.FPosition.x := StrToFloat_My(edPosX.Text);
if (xGLObject is TGLFreeForm) then
begin
TGLFreeForm(xGLObject).Position.X := StrToFloat_My(edPosX.Text);
end;
end;
if xObject is T3DConnector then
begin
xConn := T3DConnector(xObject);
xGLObject := TGLBaseSceneObject(xConn.FGLObject);
xGLObject1 := TGLBaseSceneObject(xConn.FGLObject1);
TGLFreeForm(xGLObject1).Position.X := xConn.FGLPoint.x + StrToFloat_My(edScsOffsetX.Text);
xConn.FOffset.x := StrToFloat_My(edScsOffsetX.Text) / Factor;
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.ChangePosX', E.Message);
end;
end;
procedure Tfrm3D.ChangePosY;
var
i: integer;
xObject: TObject;
x3dsObject: T3DSObject;
xConn: T3DConnector;
xGLObject, xGLObject1: TGLBaseSceneObject;
begin
try
if (pcProps.ActivePage = TabArchProps) and (edPosY.Text = '') then
exit;
if (pcProps.ActivePage = TabScsProps) and (edScsOffsetY.Text = '') then
exit;
for i := 0 to FPropObjects.Count - 1 do
begin
xObject := TObject(TTreeNode(FPropObjects[i]).Data);
if xObject is T3DSObject then
begin
x3dsObject := T3DSObject(xObject);
xGLObject := TGLBaseSceneObject(x3dsObject.FGLObject);
x3dsObject.FPosition.y := StrToFloat_My(edPosY.Text);
if (xGLObject is TGLFreeForm) then
begin
TGLFreeForm(xGLObject).Position.Y := StrToFloat_My(edPosY.Text);
end;
end;
if xObject is T3DConnector then
begin
xConn := T3DConnector(xObject);
xGLObject := TGLBaseSceneObject(xConn.FGLObject);
xGLObject1 := TGLBaseSceneObject(xConn.FGLObject1);
TGLFreeForm(xGLObject1).Position.Y := xConn.FGLPoint.y + StrToFloat_My(edScsOffsetY.Text);
xConn.FOffset.y := StrToFloat_My(edScsOffsetY.Text) / Factor;
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.ChangePosY', E.Message);
end;
end;
procedure Tfrm3D.ChangePosZ;
var
i: integer;
xObject: TObject;
x3dsObject: T3DSObject;
xConn: T3DConnector;
xGLObject, xGLObject1: TGLBaseSceneObject;
begin
try
if (pcProps.ActivePage = TabArchProps) and (edPosZ.Text = '') then
exit;
if (pcProps.ActivePage = TabScsProps) and (edScsOffsetZ.Text = '') then
exit;
for i := 0 to FPropObjects.Count - 1 do
begin
xObject := TObject(TTreeNode(FPropObjects[i]).Data);
if xObject is T3DSObject then
begin
x3dsObject := T3DSObject(xObject);
xGLObject := TGLBaseSceneObject(x3dsObject.FGLObject);
x3dsObject.FPosition.z := StrToFloat_My(edPosZ.Text);
if (xGLObject is TGLFreeForm) then
begin
TGLFreeForm(xGLObject).Position.Z := StrToFloat_My(edPosZ.Text);
end;
end;
if xObject is T3DConnector then
begin
xConn := T3DConnector(xObject);
xGLObject := TGLBaseSceneObject(xConn.FGLObject);
xGLObject1 := TGLBaseSceneObject(xConn.FGLObject1);
TGLFreeForm(xGLObject1).Position.Z := xConn.FGLPoint.z + StrToFloat_My(edScsOffsetZ.Text);
xConn.FOffset.Z := StrToFloat_My(edScsOffsetZ.Text) / Factor;
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.ChangePosZ', E.Message);
end;
end;
procedure Tfrm3D.ChangeScaleX;
var
i: integer;
xObject: TObject;
x3dsObject: T3DSObject;
xConn: T3DConnector;
xGLObject, xGLObject1: TGLBaseSceneObject;
begin
try
if (pcProps.ActivePage = TabArchProps) and (edScaleX.Text = '') then
exit;
if (pcProps.ActivePage = TabScsProps) and (edScsScaleX.Text = '') then
exit;
for i := 0 to FPropObjects.Count - 1 do
begin
xObject := TObject(TTreeNode(FPropObjects[i]).Data);
if xObject is T3DSObject then
begin
x3dsObject := T3DSObject(xObject);
xGLObject := TGLBaseSceneObject(x3dsObject.FGLObject);
x3dsObject.FScale.x := StrToFloat_My(edScaleX.Text);
if (xGLObject is TGLFreeForm) then
begin
TGLFreeForm(xGLObject).Scale.X := StrToFloat_My(edScaleX.Text);
end;
end;
if xObject is T3DConnector then
begin
xConn := T3DConnector(xObject);
xGLObject := TGLBaseSceneObject(xConn.FGLObject);
xGLObject1 := TGLBaseSceneObject(xConn.FGLObject1);
xConn.FScale.x := StrToFloat_My(edScsScaleX.Text);
TGLFreeForm(xGLObject1).Scale.X := StrToFloat_My(edScsScaleX.Text);
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.ChangeScaleX', E.Message);
end;
end;
procedure Tfrm3D.ChangeScaleY;
var
i: integer;
xObject: TObject;
x3dsObject: T3DSObject;
xConn: T3DConnector;
xGLObject, xGLObject1: TGLBaseSceneObject;
begin
try
if (pcProps.ActivePage = TabArchProps) and (edScaleY.Text = '') then
exit;
if (pcProps.ActivePage = TabScsProps) and (edScsScaleY.Text = '') then
exit;
for i := 0 to FPropObjects.Count - 1 do
begin
xObject := TObject(TTreeNode(FPropObjects[i]).Data);
if xObject is T3DSObject then
begin
x3dsObject := T3DSObject(xObject);
xGLObject := TGLBaseSceneObject(x3dsObject.FGLObject);
x3dsObject.FScale.y := StrToFloat_My(edScaleY.Text);
if (xGLObject is TGLFreeForm) then
begin
TGLFreeForm(xGLObject).Scale.Y := StrToFloat_My(edScaleY.Text);
end;
end;
if xObject is T3DConnector then
begin
xConn := T3DConnector(xObject);
xGLObject := TGLBaseSceneObject(xConn.FGLObject);
xGLObject1 := TGLBaseSceneObject(xConn.FGLObject1);
xConn.FScale.y := StrToFloat_My(edScsScaleY.Text);
TGLFreeForm(xGLObject1).Scale.Y := StrToFloat_My(edScsScaleY.Text);
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.ChangeScaleY', E.Message);
end;
end;
procedure Tfrm3D.ChangeScaleZ;
var
i: integer;
xObject: TObject;
x3dsObject: T3DSObject;
xConn: T3DConnector;
xGLObject, xGLObject1: TGLBaseSceneObject;
begin
try
if (pcProps.ActivePage = TabArchProps) and (edScaleZ.Text = '') then
exit;
if (pcProps.ActivePage = TabScsProps) and (edScsScaleZ.Text = '') then
exit;
for i := 0 to FPropObjects.Count - 1 do
begin
xObject := TObject(TTreeNode(FPropObjects[i]).Data);
if xObject is T3DSObject then
begin
x3dsObject := T3DSObject(xObject);
xGLObject := TGLBaseSceneObject(x3dsObject.FGLObject);
x3dsObject.FScale.z := StrToFloat_My(edScaleZ.Text);
if (xGLObject is TGLFreeForm) then
begin
TGLFreeForm(xGLObject).Scale.Z := StrToFloat_My(edScaleZ.Text);
end;
end;
if xObject is T3DConnector then
begin
xConn := T3DConnector(xObject);
xGLObject := TGLBaseSceneObject(xConn.FGLObject);
xGLObject1 := TGLBaseSceneObject(xConn.FGLObject1);
xConn.FScale.z := StrToFloat_My(edScsScaleZ.Text);
TGLFreeForm(xGLObject1).Scale.Z := StrToFloat_My(edScsScaleZ.Text);
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.ChangeScaleZ', E.Message);
end;
end;
procedure Tfrm3D.edPosXExit(Sender: TObject);
begin
ChangePosX;
end;
procedure Tfrm3D.edPosYExit(Sender: TObject);
begin
ChangePosY;
end;
procedure Tfrm3D.edPosZExit(Sender: TObject);
begin
ChangePosZ;
end;
procedure Tfrm3D.edAngleXExit(Sender: TObject);
begin
ChangeAngleX;
end;
procedure Tfrm3D.edAngleYExit(Sender: TObject);
begin
ChangeAngleY;
end;
procedure Tfrm3D.edAngleZExit(Sender: TObject);
begin
ChangeAngleZ;
end;
procedure Tfrm3D.edScaleXExit(Sender: TObject);
begin
ChangeScaleX;
end;
procedure Tfrm3D.edScaleYExit(Sender: TObject);
begin
ChangeScaleY;
end;
procedure Tfrm3D.edScaleZExit(Sender: TObject);
begin
ChangeScaleZ;
end;
procedure Tfrm3D.edPosXKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
ChangePosX;
end;
procedure Tfrm3D.edPosYKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
ChangePosY;
end;
procedure Tfrm3D.edPosZKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
ChangePosZ;
end;
procedure Tfrm3D.edAngleXKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
ChangeAngleX;
end;
procedure Tfrm3D.edAngleYKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
ChangeAngleY;
end;
procedure Tfrm3D.edAngleZKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
ChangeAngleZ;
end;
procedure Tfrm3D.edScaleXKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
ChangeScaleX;
end;
procedure Tfrm3D.edScaleYKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
ChangeScaleY;
end;
procedure Tfrm3D.edScaleZKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
ChangeScaleZ;
end;
procedure Tfrm3D.SetAllPanels(aStatus: Boolean);
begin
{$IF Defined(ES_GRAPH_SC)}
panName.Visible := aStatus;
panDesc.Visible := aStatus;
// panCoords.Visible := aStatus;
panRotate.Visible := aStatus;
panMirror.Visible := aStatus;
panSideTexture.Visible := aStatus;
//panPos3ds.Visible := aStatus;
panRotate3ds.Visible := aStatus;
panScale3ds.Visible := aStatus;
panObjectTexture.Visible := aStatus;
{$IFEND}
end;
procedure Tfrm3D.SetAllScsPanels(aStatus: Boolean);
begin
{$IF Defined(ES_GRAPH_SC)}
panScsName.Visible := aStatus;
panScsDesc.Visible := aStatus;
panScsLength.Visible := aStatus;
panScsConnCoords.Visible := aStatus;
panScsLineCoords.Visible := aStatus;
panScsOffset.Visible := aStatus;
panScsRotate.Visible := aStatus;
panScsScale.Visible := aStatus;
panScsObjectTexture.Visible := aStatus;
{$IFEND}
end;
procedure Tfrm3D.Get3DSObjectBounds(var Min, Max: T3DPoint; aObject: TGLFreeForm);
var
i: Integer;
Bounds: THmgBoundingBox;
Coord: TVector4f;
begin
try
Bounds := aObject.BoundingBox;
for i := 0 to 7 do
begin
Coord := Bounds[i];
if i = 0 then
begin
Min.x := Coord[0];
Min.y := Coord[1];
Min.z := Coord[2];
Max.x := Coord[0];
Max.y := Coord[1];
Max.z := Coord[2];
end
else
begin
if Coord[0] < Min.x then
Min.x := Coord[0];
if Coord[0] > Max.x then
Max.x := Coord[0];
if Coord[1] < Min.y then
Min.y := Coord[1];
if Coord[1] > Max.y then
Max.y := Coord[1];
if Coord[2] < Min.z then
Min.z := Coord[2];
if Coord[2] > Max.z then
Max.z := Coord[2];
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.Get3DSObjectBounds', E.Message);
end;
end;
procedure Tfrm3D.GetRoomBounds(var Min, Max: T3DPoint; aFloor, aCeiling: T3DPointArray);
var
i: Integer;
Bounds: THmgBoundingBox;
Coord1, Coord2: T3DPoint;
begin
try
for i := 0 to Length(aFloor) - 1 do
begin
Coord1.x := aFloor[i].X;
Coord1.y := aFloor[i].Y;
Coord1.z := aFloor[i].Z;
Coord2.x := aCeiling[i].X;
Coord2.y := aCeiling[i].Y;
Coord2.z := aCeiling[i].Z;
if i = 0 then
begin
Min.x := Coord1.x;
Min.y := Coord1.y;
Min.z := Coord1.z;
Max.x := Coord1.x;
Max.y := Coord2.y;
Max.z := Coord1.z;
end
else
begin
if Coord1.x < Min.x then
Min.x := Coord1.x;
if Coord1.x > Max.x then
Max.x := Coord1.x;
if Coord1.y < Min.y then
Min.y := Coord1.y;
if Coord2.y > Max.y then
Max.y := Coord2.y;
if Coord1.z < Min.z then
Min.z := Coord1.z;
if Coord1.z > Max.z then
Max.z := Coord1.z;
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.GetRoomBounds', E.Message);
end;
end;
procedure Tfrm3D.CreateNodesObjects(aObj: TGLPolygon);
var
i: integer;
xObj: TGLSpaceText;
cpos, pos, Camera: T3DPoint;
SetPos: T3DPoint;
delta, offset, koef, len: double;
ang: double;
coord1, coord2: TDoublePoint;
xSide: T3DSide;
begin
try
xSide := T3DSide(TTreeNode(aObj.TagObject).Data);
delta := 0.2;
if xSide.FFaceType in [ftNetFloor, ftNetCeiling] then
offset := 0.8
else
offset := 0.5;
Camera.x := GLSceneViewer.Camera.Position.x;
Camera.y := GLSceneViewer.Camera.Position.y;
Camera.z := GLSceneViewer.Camera.Position.z;
if FNodesObjectsList.Count > 0 then
DeleteNodesObjects;
cpos := DoublePoint(0, 0, 0);
for i := 0 to aObj.Nodes.Count - 1 do
cpos := DoublePoint(cpos.x + aObj.Nodes[i].x, cpos.y + aObj.Nodes[i].y, cpos.z + aObj.Nodes[i].z);
cpos := DoublePoint(cpos.x / aObj.Nodes.Count, cpos.y / aObj.Nodes.Count, cpos.z / aObj.Nodes.Count);
for i := 0 to aObj.Nodes.Count - 1 do
begin
xObj := TGLSpaceText(DummyCube.AddNewChild(TGLSpaceText));
pos.x := aObj.Nodes[i].x;
pos.y := aObj.Nodes[i].y;
pos.z := aObj.Nodes[i].z;
len := SQRT(SQR(cpos.x - pos.x) + SQR(cpos.y - pos.y) + SQR(cpos.z - pos.z));
koef := offset / len;
SetPos.x := pos.x + (cpos.x - pos.x) * koef;
SetPos.y := pos.y + (cpos.y - pos.y) * koef;
SetPos.z := pos.z + (cpos.z - pos.z) * koef;
pos.x := SetPos.x;
pos.y := SetPos.y;
pos.z := SetPos.z;
len := SQRT(SQR(camera.x - pos.x) + SQR(camera.y - pos.y) + SQR(camera.z - pos.z));
koef := delta / len;
SetPos.x := pos.x + (camera.x - pos.x) * koef;
SetPos.y := pos.y + (camera.y - pos.y) * koef;
SetPos.z := pos.z + (camera.z - pos.z) * koef;
xObj.Position.x := SetPos.x;
xObj.Position.y := SetPos.y;
xObj.Position.z := SetPos.z;
coord1.x := pos.x;
coord2.x := camera.x;
if xSide.FFaceType in [ftNetFloor, ftNetCeiling] then
begin
coord1.y := pos.y;
coord2.y := camera.y;
xObj.PitchAngle := 90;
end
else
begin
coord1.y := pos.z;
coord2.y := camera.z;
xObj.PitchAngle := 0;
end;
ang := GetDistAngle(coord1, coord2);
xObj.TurnAngle := ang;
xObj.Text := IntToStr(i + 1);
xObj.Extrusion := 0.1;
xObj.Scale.X := 0.5;
xObj.Scale.Y := 0.5;
xObj.Scale.Z := 0.5;
xObj.Adjust.Horz := TGLTextHorzAdjust(haCenter);
xObj.Adjust.Vert := TGLTextVertAdjust(vaCenter);
xObj.Font.Color := clBlue;
with xObj.Material do
begin
FrontProperties.Ambient.Color := clrBlue;
FrontProperties.Diffuse.Color := clrBlue;
FrontProperties.Emission.Color := clrBlue;
BackProperties.Ambient.Color := clrBlue;
BackProperties.Diffuse.Color := clrBlue;
BackProperties.Emission.Color := clrBlue;
end;
FNodesObjectsList.Add(xObj);
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.CreateNodesObjects', E.Message);
end;
end;
procedure Tfrm3D.DeleteNodesObjects;
var
i: integer;
xObj: TGLSpaceText;
begin
try
for i := 0 to FNodesObjectsList.Count - 1 do
begin
xObj := TGLSpaceText(FNodesObjectsList[i]);
DummyCube.Remove(xObj, True);
end;
FNodesObjectsList.Clear;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.DeleteNodesObjects', E.Message);
end;
end;
procedure Tfrm3D.DoResize;
var
Len1, Len2, Len3, Len13, HLen, DLen1, DLen2: Double;
LenToCursor1, LenToCursor2, LenToResizer1, LenToResizer2: Double;
Len11, Len12, Len21, Len22, LimitLen1, LimitLen2: Double;
p1, p2, hp: T3DPoint;
delta, p, S: double;
begin
try
// Calc H Length
Len1 := SQRT(SQR(glCursorObject.Position.x - RStartPos1.x) + SQR(glCursorObject.Position.y - RStartPos1.y) + SQR(glCursorObject.Position.z - RStartPos1.z));
Len2 := SQRT(SQR(glCursorObject.Position.x - RStartPos2.x) + SQR(glCursorObject.Position.y - RStartPos2.y) + SQR(glCursorObject.Position.z - RStartPos2.z));
Len3 := SQRT(SQR(RStartPos1.x - RStartPos2.x) + SQR(RStartPos1.y - RStartPos2.y) + SQR(RStartPos1.z - RStartPos2.z));
p := (Len1 + Len2 + Len3) / 2;
S := SQRT(p * (p - Len1) * (p - Len2) * (p - Len3));
HLen := 2 * S / Len3;
// Calc H point
Len13 := SQRT(SQR(Len1) - SQR(HLen));
delta := Len13 / Len3;
hp.x := RStartPos1.x + (RStartPos2.x - RStartPos1.x) * delta;
hp.y := RStartPos1.y + (RStartPos2.y - RStartPos1.y) * delta;
hp.z := RStartPos1.z + (RStartPos2.z - RStartPos1.z) * delta;
if EQD(HLen, 0) then
exit;
// Calc Sides Lengths
Len11 := SQRT(SQR(FResizeData.Nodep11.x - RStartPos1.x) + SQR(FResizeData.Nodep11.y - RStartPos1.y) + SQR(FResizeData.Nodep11.z - RStartPos1.z));
Len12 := SQRT(SQR(FResizeData.Nodep12.x - RStartPos2.x) + SQR(FResizeData.Nodep12.y - RStartPos2.y) + SQR(FResizeData.Nodep12.z - RStartPos2.z));
Len21 := SQRT(SQR(FResizeData.Nodep21.x - RStartPos1.x) + SQR(FResizeData.Nodep21.y - RStartPos1.y) + SQR(FResizeData.Nodep21.z - RStartPos1.z));
Len22 := SQRT(SQR(FResizeData.Nodep22.x - RStartPos2.x) + SQR(FResizeData.Nodep22.y - RStartPos2.y) + SQR(FResizeData.Nodep22.z - RStartPos2.z));
LimitLen1 := Min(Len11, Len12);
LimitLen2 := Min(Len21, Len22);
// Calc Lenght Vector
LenToCursor1 := SQRT(SQR(FResizeData.Nodep11.x - glCursorObject.Position.x) +
SQR(FResizeData.Nodep11.y - glCursorObject.Position.y) +
SQR(FResizeData.Nodep11.z - glCursorObject.Position.z));
LenToCursor2 := SQRT(SQR(FResizeData.Nodep21.x - glCursorObject.Position.x) +
SQR(FResizeData.Nodep21.y - glCursorObject.Position.y) +
SQR(FResizeData.Nodep21.z - glCursorObject.Position.z));
LenToResizer1 := SQRT(SQR(FResizeData.Nodep11.x - hp.x) +
SQR(FResizeData.Nodep11.y - hp.y) +
SQR(FResizeData.Nodep11.z - hp.z));
LenToResizer2 := SQRT(SQR(FResizeData.Nodep21.x - hp.x) +
SQR(FResizeData.Nodep21.y - hp.y) +
SQR(FResizeData.Nodep21.z - hp.z));
// Äâèæåíèå ê òî÷êàì ïåðâîé ãðàíè
if LenToCursor1 < LenToResizer1 then
begin
if HLen > LimitLen1 then
HLen := LimitLen1;
if Len11 = 0 then
DLen1 := 0
else
DLen1 := HLen / Len11;
if Len12 = 0 then
DLen2 := 0
else
DLen2 := HLen / Len12;
rpos1.x := RStartPos1.x - (RStartPos1.x - FResizeData.Nodep11.x) * DLen1;
rpos1.y := RStartPos1.y - (RStartPos1.y - FResizeData.Nodep11.y) * DLen1;
rpos1.z := RStartPos1.z - (RStartPos1.z - FResizeData.Nodep11.z) * DLen1;
rpos2.x := RStartPos2.x - (RStartPos2.x - FResizeData.Nodep12.x) * DLen2;
rpos2.y := RStartPos2.y - (RStartPos2.y - FResizeData.Nodep12.y) * DLen2;
rpos2.z := RStartPos2.z - (RStartPos2.z - FResizeData.Nodep12.z) * DLen2;
end
else if LenToCursor2 < LenToResizer2 then
// Äâèæåíèå ê òî÷êàì âòîðîé ãðàíè
begin
if HLen > LimitLen2 then
HLen := LimitLen2;
if Len21 = 0 then
DLen1 := 0
else
DLen1 := HLen / Len21;
if Len22 = 0 then
DLen2 := 0
else
DLen2 := HLen / Len22;
rpos1.x := RStartPos1.x - (RStartPos1.x - FResizeData.Nodep21.x) * DLen1;
rpos1.y := RStartPos1.y - (RStartPos1.y - FResizeData.Nodep21.y) * DLen1;
rpos1.z := RStartPos1.z - (RStartPos1.z - FResizeData.Nodep21.z) * DLen1;
rpos2.x := RStartPos2.x - (RStartPos2.x - FResizeData.Nodep22.x) * DLen2;
rpos2.y := RStartPos2.y - (RStartPos2.y - FResizeData.Nodep22.y) * DLen2;
rpos2.z := RStartPos2.z - (RStartPos2.z - FResizeData.Nodep22.z) * DLen2;
end
else if (LimitLen1 = 0) or (LimitLen2 = 0) then
begin
rpos1.x := RStartPos1.x;
rpos1.y := RStartPos1.y;
rpos1.z := RStartPos1.z;
rpos2.x := RStartPos2.x;
rpos2.y := RStartPos2.y;
rpos2.z := RStartPos2.z;
end;
// Set Spliter Line and Cube
glSpliter.Nodes[0].X := rpos1.x;
glSpliter.Nodes[0].Y := rpos1.y;
glSpliter.Nodes[0].Z := rpos1.z;
glSpliter.Nodes[1].X := rpos2.x;
glSpliter.Nodes[1].Y := rpos2.y;
glSpliter.Nodes[1].Z := rpos2.z;
glCubeSpliter.Position.x := (rpos1.x + rpos2.x) / 2;
glCubeSpliter.Position.y := (rpos1.y + rpos2.y) / 2;
glCubeSpliter.Position.z := (rpos1.z + rpos2.z) / 2;
glCubeSpliter1.Position.x := rpos1.x;
glCubeSpliter1.Position.y := rpos1.y;
glCubeSpliter1.Position.z := rpos1.z;
glCubeSpliter2.Position.x := rpos2.x;
glCubeSpliter2.Position.y := rpos2.y;
glCubeSpliter2.Position.z := rpos2.z;
SetSideSizes;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.DoResize', E.Message);
end;
end;
procedure Tfrm3D.SelectNodesEvent(Sender: TObject);
var
i, j, ItemIndex, Index: Integer;
xObj: TGLPolygon;
xCutData: TCutData;
p1, p2: T3DPoint;
GLPoints1, GLPoints2: T3DPointArray;
Len: Integer;
xGLSide: TGLPolygon;
Nodep11, Nodep12, Nodep21, Nodep22, Noder11, Noder12, Noder21, Noder22: Integer;
LenX, LenY, LenZ, LenXY, LenXZ, LenXYZ :double;
xSide: T3DSide;
begin
try
Index := TMenuItem(Sender).Tag;
xObj := TGLPolygon(DummyCube.Children[Index]);
ItemIndex := TMenuItem(Sender).MenuIndex;
xCutData := TCutData(FCutDataList[ItemIndex]);
// Basis Nodes
SetLength(FResizeData.BasisNodes, xObj.Nodes.Count);
for i := 0 to xObj.Nodes.Count - 1 do
begin
FResizeData.BasisNodes[i].x := xObj.Nodes[i].X;
FResizeData.BasisNodes[i].y := xObj.Nodes[i].Y;
FResizeData.BasisNodes[i].z := xObj.Nodes[i].Z;
end;
// Create Spliter
p1.x := (xObj.Nodes[xCutData.Index11].x + xObj.Nodes[xCutData.Index12].x) / 2;
p1.y := (xObj.Nodes[xCutData.Index11].y + xObj.Nodes[xCutData.Index12].y) / 2;
p1.z := (xObj.Nodes[xCutData.Index11].z + xObj.Nodes[xCutData.Index12].z) / 2;
p2.x := (xObj.Nodes[xCutData.Index21].x + xObj.Nodes[xCutData.Index22].x) / 2;
p2.y := (xObj.Nodes[xCutData.Index21].y + xObj.Nodes[xCutData.Index22].y) / 2;
p2.z := (xObj.Nodes[xCutData.Index21].z + xObj.Nodes[xCutData.Index22].z) / 2;
glSpliter.Nodes[0].x := p1.x;
glSpliter.Nodes[0].y := p1.y;
glSpliter.Nodes[0].z := p1.z;
glSpliter.Nodes[1].x := p2.x;
glSpliter.Nodes[1].y := p2.y;
glSpliter.Nodes[1].z := p2.z;
glSpliter.Visible := True;
// Create CubeSpliter
glCubeSpliter.Position.x := (p1.x + p2.x) / 2;
glCubeSpliter.Position.y := (p1.y + p2.y) / 2;
glCubeSpliter.Position.z := (p1.z + p2.z) / 2;
glCubeSpliter.Visible := True;
glCubeSpliter1.Position.x := p1.x;
glCubeSpliter1.Position.y := p1.y;
glCubeSpliter1.Position.z := p1.z;
glCubeSpliter1.Visible := True;
glCubeSpliter2.Position.x := p2.x;
glCubeSpliter2.Position.y := p2.y;
glCubeSpliter2.Position.z := p2.z;
glCubeSpliter2.Visible := True;
// Create Side1
SetLength(GLPoints1, 0);
for i := 0 to xCutData.Index11 do
begin
Len := Length(GLPoints1);
SetLength(GLPoints1, Len + 1);
GLPoints1[Len].x := xObj.Nodes[i].x;
GLPoints1[Len].y := xObj.Nodes[i].y;
GLPoints1[Len].z := xObj.Nodes[i].z;
end;
Nodep11 := Len;
Len := Length(GLPoints1);
SetLength(GLPoints1, Len + 2);
GLPoints1[Len] := p1;
Noder11 := Len;
GLPoints1[Len + 1] := p2;
Noder12 := Len + 1;
if Len + 2 <= xCutData.Index22 then
Nodep12 := Len + 2
else
Nodep12 := 0;
if xCutData.Index22 <> 0 then
begin
for i := xCutData.Index22 to xObj.Nodes.Count - 1 do
begin
Len := Length(GLPoints1);
SetLength(GLPoints1, Len + 1);
GLPoints1[Len].x := xObj.Nodes[i].x;
GLPoints1[Len].y := xObj.Nodes[i].y;
GLPoints1[Len].z := xObj.Nodes[i].z;
end;
end;
// Create Side2
xGLSide := TGLPolygon(DummyCube.AddNewChild(TGLPolygon));
SetLength(GLPoints2, 0);
Len := Length(GLPoints2);
SetLength(GLPoints2, Len + 1);
GLPoints2[Len] := p1;
Noder21 := Len;
Nodep21 := Len + 1;
for i := xCutData.Index12 to xCutData.Index21 do
begin
Len := Length(GLPoints2);
SetLength(GLPoints2, Len + 1);
GLPoints2[Len].x := xObj.Nodes[i].x;
GLPoints2[Len].y := xObj.Nodes[i].y;
GLPoints2[Len].z := xObj.Nodes[i].z;
end;
Nodep22 := Len;
Len := Length(GLPoints2);
SetLength(GLPoints2, Len + 1);
GLPoints2[Len] := p2;
Noder22 := Len;
// ***************************************
xObj.Nodes.Clear;
for i := 0 to Length(GLPoints1) - 1 do
begin
// if i > 0 then
// begin
// if not (EQD(GLPoints1[i].x, GLPoints1[i-1].x) and EQD(GLPoints1[i].y, GLPoints1[i-1].y) and EQD(GLPoints1[i].z, GLPoints1[i-1].z)) then
// xObj.AddNode(GLPoints1[i].x, GLPoints1[i].y, GLPoints1[i].z);
// end
// else
xObj.AddNode(GLPoints1[i].x, GLPoints1[i].y, GLPoints1[i].z);
end;
for i := 0 to Length(GLPoints2) - 1 do
begin
// if i > 0 then
// begin
// if not (EQD(GLPoints2[i].x, GLPoints2[i-1].x) and EQD(GLPoints2[i].y, GLPoints2[i-1].y) and EQD(GLPoints2[i].z, GLPoints2[i-1].z)) then
// xGLSide.AddNode(GLPoints2[i].x, GLPoints2[i].y, GLPoints2[i].z);
// end
// else
xGLSide.AddNode(GLPoints2[i].x, GLPoints2[i].y, GLPoints2[i].z);
end;
xSide := T3DSide(TTreeNode(xObj.TagObject).Data);
if xSide.FFaceType = ftNetCeiling then
xGLSide.Parts := [ppTop];
if xSide.FFaceType = ftNetFloor then
xGLSide.Parts := [ppBottom];
if TObject(xSide.FParent) is T3DSide then
CreateAddForDivSide(xObj, xGLSide)
else
CreateAddForParentSide(xObj, xGLSide);
FResizeData.Nodep11 := xObj.Nodes[Nodep11];
FResizeData.Nodep12 := xObj.Nodes[Nodep12];
FResizeData.Noder11 := xObj.Nodes[Noder11];
FResizeData.Noder12 := xObj.Nodes[Noder12];
FResizeData.Nodep21 := xGLSide.Nodes[Nodep21];
FResizeData.Nodep22 := xGLSide.Nodes[Nodep22];
FResizeData.Noder21 := xGLSide.Nodes[Noder21];
FResizeData.Noder22 := xGLSide.Nodes[Noder22];
FResizeData.Indexp11 := Nodep11;
FResizeData.Indexp12 := Nodep12;
FResizeData.Indexr11 := Noder11;
FResizeData.Indexr12 := Noder12;
FResizeData.Indexp21 := Nodep21;
FResizeData.Indexp22 := Nodep22;
FResizeData.Indexr21 := Noder21;
FResizeData.Indexr22 := Noder22;
FResizeData.Side1 := xObj;
FResizeData.Side2 := xGLSide;
RStartPos1 := p1;
RStartPos2 := p2;
rpos1 := RStartPos1;
rpos2 := RStartPos2;
glSide11.Visible := True;
glSide12.Visible := True;
glSide21.Visible := True;
glSide22.Visible := True;
SetSideSizes;
// ***************************************
FToolMode := tmCut;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.SelectNodesEvent', E.Message);
end;
end;
procedure Tfrm3D.SetSideSizes;
var
mp: T3DPoint;
pos, cpos1, cpos2, Camera: T3DPoint;
SetPos: T3DPoint;
delta, offset, koef, len: double;
ang: double;
coord1, coord2: TDoublePoint;
xSide: T3DSide;
begin
try
xSide := T3dSide(TTreeNode(FResizeData.Side1.tagObject).Data);
delta := 0.4;
if xSide.FFaceType in [ftNetFloor, ftNetCeiling] then
offset := 0.6
else
offset := 0.4;
Camera.x := GLSceneViewer.Camera.Position.x;
Camera.y := GLSceneViewer.Camera.Position.y;
Camera.z := GLSceneViewer.Camera.Position.z;
cpos1 := DoublePoint((FResizeData.Nodep11.x + FResizeData.Nodep21.x + rpos1.x + rpos2.x) / 4,
(FResizeData.Nodep11.y + FResizeData.Nodep21.y + rpos1.y + rpos2.y) / 4,
(FResizeData.Nodep11.z + FResizeData.Nodep21.z + rpos1.z + rpos2.z) / 4);
cpos2 := DoublePoint((FResizeData.Nodep21.x + FResizeData.Nodep22.x + rpos1.x + rpos2.x) / 4,
(FResizeData.Nodep21.y + FResizeData.Nodep22.y + rpos1.y + rpos2.y) / 4,
(FResizeData.Nodep21.z + FResizeData.Nodep22.z + rpos1.z + rpos2.z) / 4);
// ********** 11 *************************************************************
pos.x := (FResizeData.Nodep11.x + rpos1.x) / 2;
pos.y := (FResizeData.Nodep11.y + rpos1.y) / 2;
pos.z := (FResizeData.Nodep11.z + rpos1.z) / 2;
len := SQRT(SQR(cpos1.x - pos.x) + SQR(cpos1.y - pos.y) + SQR(cpos1.z - pos.z));
koef := offset / len;
SetPos.x := pos.x + (cpos1.x - pos.x) * koef;
SetPos.y := pos.y + (cpos1.y - pos.y) * koef;
SetPos.z := pos.z + (cpos1.z - pos.z) * koef;
pos.x := SetPos.x;
pos.y := SetPos.y;
pos.z := SetPos.z;
len := SQRT(SQR(camera.x - pos.x) + SQR(camera.y - pos.y) + SQR(camera.z - pos.z));
koef := delta / len;
SetPos.x := pos.x + (camera.x - pos.x) * koef;
SetPos.y := pos.y + (camera.y - pos.y) * koef;
SetPos.z := pos.z + (camera.z - pos.z) * koef;
glSide11.Position.x := SetPos.x;
glSide11.Position.y := SetPos.y;
glSide11.Position.z := SetPos.z;
coord1.x := pos.x;
coord2.x := camera.x;
if xSide.FFaceType in [ftNetFloor, ftNetCeiling] then
begin
coord1.y := pos.y;
coord2.y := camera.y;
glSide11.PitchAngle := 90;
end
else
begin
coord1.y := pos.z;
coord2.y := camera.z;
glSide11.PitchAngle := 0;
end;
ang := GetDistAngle(coord1, coord2);
glSide11.TurnAngle := ang;
Len := SQRT(SQR((FResizeData.Nodep11.x - rpos1.x) / Factor) +
SQR((FResizeData.Nodep11.y - rpos1.y) / Factor) +
SQR((FResizeData.Nodep11.z - rpos1.z) / Factor));
glSide11.Text := FormatFloat(ffMask, Len / FScaleDelta);
// ********** 12 *************************************************************
pos.x := (FResizeData.Nodep12.x + rpos2.x) / 2;
pos.y := (FResizeData.Nodep12.y + rpos2.y) / 2;
pos.z := (FResizeData.Nodep12.z + rpos2.z) / 2;
len := SQRT(SQR(cpos1.x - pos.x) + SQR(cpos1.y - pos.y) + SQR(cpos1.z - pos.z));
koef := offset / len;
SetPos.x := pos.x + (cpos1.x - pos.x) * koef;
SetPos.y := pos.y + (cpos1.y - pos.y) * koef;
SetPos.z := pos.z + (cpos1.z - pos.z) * koef;
pos.x := SetPos.x;
pos.y := SetPos.y;
pos.z := SetPos.z;
len := SQRT(SQR(camera.x - pos.x) + SQR(camera.y - pos.y) + SQR(camera.z - pos.z));
koef := delta / len;
SetPos.x := pos.x + (camera.x - pos.x) * koef;
SetPos.y := pos.y + (camera.y - pos.y) * koef;
SetPos.z := pos.z + (camera.z - pos.z) * koef;
glSide12.Position.x := SetPos.x;
glSide12.Position.y := SetPos.y;
glSide12.Position.z := SetPos.z;
coord1.x := pos.x;
coord2.x := camera.x;
if xSide.FFaceType in [ftNetFloor, ftNetCeiling] then
begin
coord1.y := pos.y;
coord2.y := camera.y;
glSide12.PitchAngle := 90;
end
else
begin
coord1.y := pos.z;
coord2.y := camera.z;
glSide12.PitchAngle := 0;
end;
ang := GetDistAngle(coord1, coord2);
glSide12.TurnAngle := ang;
Len := SQRT(SQR((FResizeData.Nodep12.x - rpos2.x) / Factor) +
SQR((FResizeData.Nodep12.y - rpos2.y) / Factor) +
SQR((FResizeData.Nodep12.z - rpos2.z) / Factor));
glSide12.Text := FormatFloat(ffMask, Len / FScaleDelta);
// ********** 21 *************************************************************
pos.x := (FResizeData.Nodep21.x + rpos1.x) / 2;
pos.y := (FResizeData.Nodep21.y + rpos1.y) / 2;
pos.z := (FResizeData.Nodep21.z + rpos1.z) / 2;
len := SQRT(SQR(cpos2.x - pos.x) + SQR(cpos2.y - pos.y) + SQR(cpos2.z - pos.z));
koef := offset / len;
SetPos.x := pos.x + (cpos2.x - pos.x) * koef;
SetPos.y := pos.y + (cpos2.y - pos.y) * koef;
SetPos.z := pos.z + (cpos2.z - pos.z) * koef;
pos.x := SetPos.x;
pos.y := SetPos.y;
pos.z := SetPos.z;
len := SQRT(SQR(camera.x - pos.x) + SQR(camera.y - pos.y) + SQR(camera.z - pos.z));
koef := delta / len;
SetPos.x := pos.x + (camera.x - pos.x) * koef;
SetPos.y := pos.y + (camera.y - pos.y) * koef;
SetPos.z := pos.z + (camera.z - pos.z) * koef;
glSide21.Position.x := SetPos.x;
glSide21.Position.y := SetPos.y;
glSide21.Position.z := SetPos.z;
coord1.x := pos.x;
coord2.x := camera.x;
if xSide.FFaceType in [ftNetFloor, ftNetCeiling] then
begin
coord1.y := pos.y;
coord2.y := camera.y;
glSide21.PitchAngle := 90;
end
else
begin
coord1.y := pos.z;
coord2.y := camera.z;
glSide21.PitchAngle := 0;
end;
ang := GetDistAngle(coord1, coord2);
glSide21.TurnAngle := ang;
Len := SQRT(SQR((FResizeData.Nodep21.x - rpos1.x) / Factor) +
SQR((FResizeData.Nodep21.y - rpos1.y) / Factor) +
SQR((FResizeData.Nodep21.z - rpos1.z) / Factor));
glSide21.Text := FormatFloat(ffMask, Len / FScaleDelta);
// ********** 22 *************************************************************
pos.x := (FResizeData.Nodep22.x + rpos2.x) / 2;
pos.y := (FResizeData.Nodep22.y + rpos2.y) / 2;
pos.z := (FResizeData.Nodep22.z + rpos2.z) / 2;
len := SQRT(SQR(cpos2.x - pos.x) + SQR(cpos2.y - pos.y) + SQR(cpos2.z - pos.z));
koef := offset / len;
SetPos.x := pos.x + (cpos2.x - pos.x) * koef;
SetPos.y := pos.y + (cpos2.y - pos.y) * koef;
SetPos.z := pos.z + (cpos2.z - pos.z) * koef;
pos.x := SetPos.x;
pos.y := SetPos.y;
pos.z := SetPos.z;
len := SQRT(SQR(camera.x - pos.x) + SQR(camera.y - pos.y) + SQR(camera.z - pos.z));
koef := delta / len;
SetPos.x := pos.x + (camera.x - pos.x) * koef;
SetPos.y := pos.y + (camera.y - pos.y) * koef;
SetPos.z := pos.z + (camera.z - pos.z) * koef;
glSide22.Position.x := SetPos.x;
glSide22.Position.y := SetPos.y;
glSide22.Position.z := SetPos.z;
coord1.x := pos.x;
coord2.x := camera.x;
if xSide.FFaceType in [ftNetFloor, ftNetCeiling] then
begin
coord1.y := pos.y;
coord2.y := camera.y;
glSide22.PitchAngle := 90;
end
else
begin
coord1.y := pos.z;
coord2.y := camera.z;
glSide22.PitchAngle := 0;
end;
ang := GetDistAngle(coord1, coord2);
glSide22.TurnAngle := ang;
Len := SQRT(SQR((FResizeData.Nodep22.x - rpos2.x) / Factor) +
SQR((FResizeData.Nodep22.y - rpos2.y) / Factor) +
SQR((FResizeData.Nodep22.z - rpos2.z) / Factor));
glSide22.Text := FormatFloat(ffMask, Len / FScaleDelta);
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.SetSideSizes', E.Message);
end;
end;
procedure Tfrm3D.AfterUpdate;
var
glObjClass: TGLSceneObjectClass;
glNodeNbr: TGLSpaceText;
xColor: TVector4f;
begin
try
xColor := clrBlack;
FToolMode := tmSelect;
FNodesObjectsList := TList.Create;
FCutDataList := TList.Create;
FResizeData := TResizeData.Create;
FResizer := False;
// Add Cursor Object (3ds and Connector Move)
glCursorObject := TGLCustomSceneObject.Create(GLScene);
glCursorObject.Visible := False;
// Add Cursor Line (Line Move)
glCursorLine := TGLLines.Create(GLScene);
glCursorLine.AddNode(0, 0, 0); // add 1 node
glCursorLine.AddNode(0, 0, 0); // add 2 node
glCursorLine.Visible := False;
// Add Sides Caption for Resizer
glSide11 := TGLSpaceText(DummyCube.AddNewChild(TGLSpaceText));
glSide21 := TGLSpaceText(DummyCube.AddNewChild(TGLSpaceText));
glSide12 := TGLSpaceText(DummyCube.AddNewChild(TGLSpaceText));
glSide22 := TGLSpaceText(DummyCube.AddNewChild(TGLSpaceText));
glSide11.Extrusion := 0.1;
glSide11.Scale.X := 0.4;
glSide11.Scale.Y := 0.4;
glSide11.Scale.Z := 0.4;
glSide11.Adjust.Horz := TGLTextHorzAdjust(haCenter);
glSide11.Adjust.Vert := TGLTextVertAdjust(vaCenter);
glSide11.Font.Color := clGray;
with glSide11.Material do
begin
FrontProperties.Ambient.Color := xColor;
FrontProperties.Diffuse.Color := xColor;
FrontProperties.Emission.Color := xColor;
BackProperties.Ambient.Color := xColor;
BackProperties.Diffuse.Color := xColor;
BackProperties.Emission.Color := xColor;
end;
glSide12.Extrusion := 0.1;
glSide12.Scale.X := 0.4;
glSide12.Scale.Y := 0.4;
glSide12.Scale.Z := 0.4;
glSide12.Adjust.Horz := TGLTextHorzAdjust(haCenter);
glSide12.Adjust.Vert := TGLTextVertAdjust(vaCenter);
glSide12.Font.Color := clGray;
with glSide12.Material do
begin
FrontProperties.Ambient.Color := xColor;
FrontProperties.Diffuse.Color := xColor;
FrontProperties.Emission.Color := xColor;
BackProperties.Ambient.Color := xColor;
BackProperties.Diffuse.Color := xColor;
BackProperties.Emission.Color := xColor;
end;
glSide21.Extrusion := 0.1;
glSide21.Scale.X := 0.4;
glSide21.Scale.Y := 0.4;
glSide21.Scale.Z := 0.4;
glSide21.Adjust.Horz := TGLTextHorzAdjust(haCenter);
glSide21.Adjust.Vert := TGLTextVertAdjust(vaCenter);
glSide21.Font.Color := clGray;
with glSide21.Material do
begin
FrontProperties.Ambient.Color := xColor;
FrontProperties.Diffuse.Color := xColor;
FrontProperties.Emission.Color := xColor;
BackProperties.Ambient.Color := xColor;
BackProperties.Diffuse.Color := xColor;
BackProperties.Emission.Color := xColor;
end;
glSide22.Extrusion := 0.1;
glSide22.Scale.X := 0.4;
glSide22.Scale.Y := 0.4;
glSide22.Scale.Z := 0.4;
glSide22.Adjust.Horz := TGLTextHorzAdjust(haCenter);
glSide22.Adjust.Vert := TGLTextVertAdjust(vaCenter);
glSide22.Font.Color := clGray;
with glSide22.Material do
begin
FrontProperties.Ambient.Color := xColor;
FrontProperties.Diffuse.Color := xColor;
FrontProperties.Emission.Color := xColor;
BackProperties.Ambient.Color := xColor;
BackProperties.Diffuse.Color := xColor;
BackProperties.Emission.Color := xColor;
end;
glSide11.Visible := False;
glSide21.Visible := False;
glSide12.Visible := False;
glSide22.Visible := False;
// *** Spliters ***
// Spliter Line
glSpliter := TGLLines(DummyCube.AddNewChild(TGLLines));
glSpliter.AddNode(0, 0, 0);
glSpliter.AddNode(0, 0, 0);
glSpliter.LineColor.AsWinColor := clBlack;
glSpliter.NodeColor.AsWinColor := clBlack;
glSpliter.LineWidth := 2;
glSpliter.NodeSize := 0.3;
glSpliter.NodesAspect := lnaInvisible;
glSpliter.Visible := False;
// Spliter Center Cube
glCubeSpliter := TGLCube(DummyCube.AddNewChild(TGLCube));
glCubeSpliter.CubeDepth := 0.3; // Z
glCubeSpliter.CubeHeight := 0.3; // Y
glCubeSpliter.CubeWidth := 0.3; // X
// Spliter Sides Cube
glCubeSpliter1 := TGLCube(DummyCube.AddNewChild(TGLCube));
glCubeSpliter1.CubeDepth := 0.2; // Z
glCubeSpliter1.CubeHeight := 0.2; // Y
glCubeSpliter1.CubeWidth := 0.2; // X
glCubeSpliter2 := TGLCube(DummyCube.AddNewChild(TGLCube));
glCubeSpliter2.CubeDepth := 0.2; // Z
glCubeSpliter2.CubeHeight := 0.2; // Y
glCubeSpliter2.CubeWidth := 0.2; // X
with glCubeSpliter.Material do
begin
FrontProperties.Ambient.Color := clrBlack;
FrontProperties.Diffuse.Color := clrBlack;
FrontProperties.Emission.Color := clrBlack;
BackProperties.Ambient.Color := clrBlack;
BackProperties.Diffuse.Color := clrBlack;
BackProperties.Emission.Color := clrBlack;
end;
glCubeSpliter.Visible := False;
with glCubeSpliter1.Material do
begin
FrontProperties.Ambient.Color := clrBlack;
FrontProperties.Diffuse.Color := clrBlack;
FrontProperties.Emission.Color := clrBlack;
BackProperties.Ambient.Color := clrBlack;
BackProperties.Diffuse.Color := clrBlack;
BackProperties.Emission.Color := clrBlack;
end;
glCubeSpliter1.Visible := False;
with glCubeSpliter2.Material do
begin
FrontProperties.Ambient.Color := clrBlack;
FrontProperties.Diffuse.Color := clrBlack;
FrontProperties.Emission.Color := clrBlack;
BackProperties.Ambient.Color := clrBlack;
BackProperties.Diffuse.Color := clrBlack;
BackProperties.Emission.Color := clrBlack;
end;
glCubeSpliter2.Visible := False;
// *** Joined Conns Cubes ***
glConn1 := TGLCube(DummyCube.AddNewChild(TGLCube));
glConn1.CubeDepth := 0.2; // Z
glConn1.CubeHeight := 0.2; // Y
glConn1.CubeWidth := 0.2; // X
glConn2 := TGLCube(DummyCube.AddNewChild(TGLCube));
glConn2.CubeDepth := 0.2; // Z
glConn2.CubeHeight := 0.2; // Y
glConn2.CubeWidth := 0.2; // X
with glConn1.Material do
begin
FrontProperties.Ambient.Color := clrBlue;
FrontProperties.Diffuse.Color := clrBlue;
FrontProperties.Emission.Color := clrBlue;
BackProperties.Ambient.Color := clrBlue;
BackProperties.Diffuse.Color := clrBlue;
BackProperties.Emission.Color := clrBlue;
end;
glConn1.Visible := False;
with glConn2.Material do
begin
FrontProperties.Ambient.Color := clrBlue;
FrontProperties.Diffuse.Color := clrBlue;
FrontProperties.Emission.Color := clrBlue;
BackProperties.Ambient.Color := clrBlue;
BackProperties.Diffuse.Color := clrBlue;
BackProperties.Emission.Color := clrBlue;
end;
glConn2.Visible := False;
ToggleTraceCaptions(cbShowTraceCaptions.Checked); //29.03.2011
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.AfterUpdate', E.Message);
end;
end;
procedure Tfrm3D.GLSceneViewerMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
i: integer;
xConn: T3DConnector;
begin
try
if Button = mbRight then
if (mdx = X) and (mdy = Y) then
OnRightClick;
if FToolMode = tmSelect then
begin
if FMovedObject <> nil then
begin
Set3DSObjectPos(FMovedObject);
FMovedObject := nil;
GLSceneViewer.Cursor := crDefault;
end;
if FMovedFullConnector <> nil then
begin
for i := 0 to FShadowObjects.Count - 1 do
DummyCube.Remove(TGLLines(FShadowObjects[i]), True);
FShadowObjects.Clear;
Move3DConnectorEvent(FMovedFullConnector);
FMovedFullConnector := nil;
GLSceneViewer.Cursor := crDefault;
sbView.Caption := '';
end;
if FMovedEmptyConnector <> nil then
begin
for i := 0 to FShadowObjects.Count - 1 do
DummyCube.Remove(TGLLines(FShadowObjects[i]), True);
FShadowObjects.Clear;
Move3DConnectorEvent(FMovedEmptyConnector);
FMovedEmptyConnector := nil;
GLSceneViewer.Cursor := crDefault;
sbView.Caption := '';
end;
if FMovedLine <> nil then
begin
Move3DLineEvent(FMovedLine);
FMovedLine := nil;
GLSceneViewer.Cursor := crDefault;
sbView.Caption := '';
end;
if FOffsetObjects then
begin
SetConnectorsOffset(FSelection);
FOffsetObjects := False;
GLSceneViewer.Cursor := crDefault;
end;
if FRotatedObject <> nil then
FRotatedObject := nil;
if FRotatedObjects then
FRotatedObjects := False;
end;
if (FToolMode = tmCut) and FResizer then
begin
// ïðè îòïóñêàíèè, ïðèìåíèòü ðåñàéçèíã ê ãðàíÿì
if Button = mbLeft then
begin
FResizer := False;
RStartPos1 := rpos1;
RStartPos2 := rpos2;
SetSidesData;
end;
// ïðè íàæàòèè ïðàâîé âî âðåìÿ ðåñàéçèíãà - ñáðîñ
if Button = mbRight then
begin
FResizer := False;
rpos1 := RStartPos1;
rpos2 := RStartPos2;
glSpliter.Nodes[0].X := rpos1.x;
glSpliter.Nodes[0].Y := rpos1.y;
glSpliter.Nodes[0].Z := rpos1.z;
glSpliter.Nodes[1].X := rpos2.x;
glSpliter.Nodes[1].Y := rpos2.y;
glSpliter.Nodes[1].Z := rpos2.z;
glCubeSpliter.Position.x := (rpos1.x + rpos2.x) / 2;
glCubeSpliter.Position.y := (rpos1.y + rpos2.y) / 2;
glCubeSpliter.Position.z := (rpos1.z + rpos2.z) / 2;
glCubeSpliter1.Position.x := rpos1.x;
glCubeSpliter1.Position.y := rpos1.y;
glCubeSpliter1.Position.z := rpos1.z;
glCubeSpliter2.Position.x := rpos2.x;
glCubeSpliter2.Position.y := rpos2.y;
glCubeSpliter2.Position.z := rpos2.z;
GLSceneViewer.Cursor := crDefault;
SetSideSizes;
{
//Full Reset
FToolMode := tmSelect;
glSpliter.Visible := False;
glCubeSpliter.Visible := False;
glSide11.Visible := False;
glSide12.Visible := False;
glSide21.Visible := False;
glSide22.Visible := False;
DeleteNodesObjects;
GLSceneViewer.Cursor := crDefault;
}
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.GLSceneViewerMouseUp', E.Message);
end;
end;
procedure Tfrm3D.CreateAddForDivSide(aSide, aAddSide: TGLPolygon);
var
i, j: Integer;
xNode, xParentNode, xAddNode: TTreeNode;
xParentSide, xSide, xAddSide: T3DSide;
tmpdir, tmpfname, ExtStr, BmpFName: string;
HashStr: string;
ZOrder: Double;
begin
try
// Create Model Object
xNode := TTreeNode(aSide.TagObject);
xParentNode := xNode.Parent;
// Create
xSide := T3DSide(xNode.Data);
SetLength(xSide.FPoints, aSide.Nodes.Count);
SetLength(xSide.FGLPoints, aSide.Nodes.Count);
ZOrder := xSide.FZOrder;
for i := 0 to Length(xSide.FGLPoints) - 1 do
begin
xSide.FGLPoints[i].x := aSide.Nodes[i].X;
xSide.FGLPoints[i].y := aSide.Nodes[i].Y - ZOrder;
xSide.FGLPoints[i].z := aSide.Nodes[i].Z;
end;
for i := 0 to Length(xSide.FPoints) - 1 do
begin
xSide.FPoints[i].x := xSide.FGLPoints[i].x / Factor;
xSide.FPoints[i].z := xSide.FGLPoints[i].y / Factor;
xSide.FPoints[i].y := xSide.FGLPoints[i].z / Factor;
end;
xAddSide := T3DSide.Create(xSide.FFaceType, xSide.FWallType, xSide.FSideType, xSide.FParent);
xAddSide.FName := cSubSide + IntToStr(xParentNode.Count + 1);
xAddSide.FDescription.Text := xSide.FDescription.Text;
xAddSide.FGLObject := aAddSide;
xAddSide.FFace := nil;
xAddSide.FColor := xSide.FColor;
xAddSide.FTextureRotate := xSide.FTextureRotate;
xAddSide.FTextureScale := xSide.FTextureScale;
xAddSide.FMirror := xSide.FMirror;
xAddSide.FTextureHash := xSide.FTextureHash;
xAddSide.FTexture_ext := xSide.FTexture_ext;
xAddSide.FZOrder := xSide.FZOrder;
SetLength(xAddSide.FPoints, aAddSide.Nodes.Count);
SetLength(xAddSide.FGLPoints, aAddSide.Nodes.Count);
ZOrder := xAddSide.FZOrder;
for i := 0 to Length(xAddSide.FGLPoints) - 1 do
begin
xAddSide.FGLPoints[i].x := aAddSide.Nodes[i].X;
xAddSide.FGLPoints[i].y := aAddSide.Nodes[i].Y - ZOrder;
xAddSide.FGLPoints[i].z := aAddSide.Nodes[i].Z;
end;
for i := 0 to Length(xAddSide.FPoints) - 1 do
begin
xAddSide.FPoints[i].x := xAddSide.FGLPoints[i].x / Factor;
xAddSide.FPoints[i].z := xAddSide.FGLPoints[i].y / Factor;
xAddSide.FPoints[i].y := xAddSide.FGLPoints[i].z / Factor;
end;
if xSide.FParent is T3DSide then
T3DSide(xSide.FParent).FSubSides.Add(xAddSide);
// Create Node
xAddNode := ModelTree.Items.AddChild(xParentNode, xAddSide.FName);
xAddNode.Data := xAddSide;
xAddNode.ImageIndex := 50;
xAddNode.SelectedIndex := xAddNode.ImageIndex;
aAddSide.TagObject := xAddNode;
// Apply Texture
//tmpdir := GetWorkDir; // ExtractDirByCategoryType(dctPictures);
//tmpfname := tmpdir + '\tmp.bmp';
//aSide.Material.Texture.Image.SaveToFile(tmpfname);
//if tmpfname <> '' then
begin
aAddSide.Material.Texture.Disabled := False;
aAddSide.Material.Texture.MappingMode := tmmObjectLinear;
aAddSide.Material.Texture.DestroyHandles;
//aAddSide.Material.Texture.Image.LoadFromFile(tmpfname);
aAddSide.Material.Texture.Image.Assign(aSide.Material.Texture.Image);
RotateTextureToAngleP(xAddSide, aAddSide, xAddSide.FTextureRotate, xAddSide.FMirror);
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.CreateAddForDivSide', E.Message);
end;
end;
procedure Tfrm3D.CreateAddForParentSide(aFirstSide, aSecondSide: TGLPolygon);
var
i, j: Integer;
xParentNode, xFirstNode, xSecondNode: TTreeNode;
xParentSide, xFirstSide, xSecondSide: T3DSide;
tmpdir, tmpfname, ExtStr, BmpFName: string;
HashStr: string;
ZOrder: Double;
begin
try
// Create Model Object
xParentNode := TTreeNode(aFirstSide.TagObject);
xParentSide := T3DSide(xParentNode.Data);
// CREATE FIRST
xFirstSide := T3DSide.Create(xParentSide.FFaceType, xParentSide.FWallType, xParentSide.FSideType, xParentSide);
xFirstSide.FName := cSubSide + IntToStr(xParentNode.Count + 1);
xFirstSide.FDescription.Text := xParentSide.FDescription.Text;
xFirstSide.FGLObject := aFirstSide;
xFirstSide.FFace := nil;
xFirstSide.FColor := xParentSide.FColor;
xFirstSide.FTextureRotate := xParentSide.FTextureRotate;
xFirstSide.FTextureScale := xParentSide.FTextureScale;
xFirstSide.FMirror := xParentSide.FMirror;
xFirstSide.FTextureHash := xParentSide.FTextureHash;
xFirstSide.FTexture_ext := xParentSide.FTexture_ext;
xFirstSide.FZOrder := xParentSide.FZOrder;
SetLength(xFirstSide.FPoints, aFirstSide.Nodes.Count);
SetLength(xFirstSide.FGLPoints, aFirstSide.Nodes.Count);
ZOrder := xFirstSide.FZOrder;
for i := 0 to Length(xFirstSide.FGLPoints) - 1 do
begin
xFirstSide.FGLPoints[i].x := aFirstSide.Nodes[i].X;
xFirstSide.FGLPoints[i].y := aFirstSide.Nodes[i].Y - ZOrder;
xFirstSide.FGLPoints[i].z := aFirstSide.Nodes[i].Z;
end;
for i := 0 to Length(xFirstSide.FPoints) - 1 do
begin
xFirstSide.FPoints[i].x := xFirstSide.FGLPoints[i].x / Factor;
xFirstSide.FPoints[i].z := xFirstSide.FGLPoints[i].y / Factor;
xFirstSide.FPoints[i].y := xFirstSide.FGLPoints[i].z / Factor;
end;
xParentSide.FSubSides.Add(xFirstSide);
xFirstNode := ModelTree.Items.AddChild(xParentNode, xFirstSide.FName);
xFirstNode.Data := xFirstSide;
xFirstNode.ImageIndex := 50;
xFirstNode.SelectedIndex := xFirstNode.ImageIndex;
aFirstSide.TagObject := xFirstNode;
// CREATE SECOND
xSecondSide := T3DSide.Create(xParentSide.FFaceType, xParentSide.FWallType, xParentSide.FSideType, xParentSide);
xSecondSide.FName := cSubSide + IntToStr(xParentNode.Count + 1);
xSecondSide.FDescription.Text := xParentSide.FDescription.Text;
xSecondSide.FGLObject := aSecondSide;
xSecondSide.FFace := nil;
xSecondSide.FColor := xParentSide.FColor;
xSecondSide.FTextureRotate := xParentSide.FTextureRotate;
xSecondSide.FTextureScale := xParentSide.FTextureScale;
xSecondSide.FMirror := xParentSide.FMirror;
xSecondSide.FTextureHash := xParentSide.FTextureHash;
xSecondSide.FTexture_ext := xParentSide.FTexture_ext;
xSecondSide.FZOrder := xParentSide.FZOrder;
SetLength(xSecondSide.FPoints, aSecondSide.Nodes.Count);
SetLength(xSecondSide.FGLPoints, aSecondSide.Nodes.Count);
ZOrder := xSecondSide.FZOrder;
for i := 0 to Length(xSecondSide.FGLPoints) - 1 do
begin
xSecondSide.FGLPoints[i].x := aSecondSide.Nodes[i].X;
xSecondSide.FGLPoints[i].y := aSecondSide.Nodes[i].Y - ZOrder;
xSecondSide.FGLPoints[i].z := aSecondSide.Nodes[i].Z;
end;
for i := 0 to Length(xSecondSide.FPoints) - 1 do
begin
xSecondSide.FPoints[i].x := xSecondSide.FGLPoints[i].x / Factor;
xSecondSide.FPoints[i].z := xSecondSide.FGLPoints[i].y / Factor;
xSecondSide.FPoints[i].y := xSecondSide.FGLPoints[i].z / Factor;
end;
xParentSide.FSubSides.Add(xSecondSide);
xSecondNode := ModelTree.Items.AddChild(xParentNode, xSecondSide.FName);
xSecondNode.Data := xSecondSide;
xSecondNode.ImageIndex := 50;
xSecondNode.SelectedIndex := xSecondNode.ImageIndex;
aSecondSide.TagObject := xSecondNode;
xParentSide.FGLObject := nil;
// Apply Texture
//tmpdir := GetWorkDir; // ExtractDirByCategoryType(dctPictures);
//tmpfname := tmpdir + '\tmp.bmp';
//aFirstSide.Material.Texture.Image.SaveToFile(tmpfname);
//if tmpfname <> '' then
begin
aSecondSide.Material.Texture.Disabled := False;
aSecondSide.Material.Texture.MappingMode := tmmObjectLinear;
aSecondSide.Material.Texture.DestroyHandles;
//aSecondSide.Material.Texture.Image.LoadFromFile(tmpfname);
aSecondSide.Material.Texture.Image.Assign(aFirstSide.Material.Texture.Image);
RotateTextureToAngleP(xSecondSide, aSecondSide, xSecondSide.FTextureRotate, xSecondSide.FMirror);
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.CreateAddForParentSide', E.Message);
end;
end;
procedure Tfrm3D.SetSidesData;
var
xNode: TTreeNode;
xSide1, xSide2: T3DSide;
ZOrder: Double;
begin
try
FResizeData.Noder11.X := rpos1.x;
FResizeData.Noder11.Y := rpos1.y;
FResizeData.Noder11.Z := rpos1.z;
FResizeData.Noder12.X := rpos2.x;
FResizeData.Noder12.Y := rpos2.y;
FResizeData.Noder12.Z := rpos2.z;
FResizeData.Noder21.X := rpos1.x;
FResizeData.Noder21.Y := rpos1.y;
FResizeData.Noder21.Z := rpos1.z;
FResizeData.Noder22.X := rpos2.x;
FResizeData.Noder22.Y := rpos2.y;
FResizeData.Noder22.Z := rpos2.z;
xNode := TTreeNode(FResizeData.Side1.TagObject);
xSide1 := T3DSide(xNode.Data);
xNode := TTreeNode(FResizeData.Side2.TagObject);
xSide2 := T3DSide(xNode.Data);
ZOrder := xSide1.FZOrder;
xSide1.FGLPoints[FResizeData.Indexr11].x := FResizeData.Noder11.X;
xSide1.FGLPoints[FResizeData.Indexr11].y := FResizeData.Noder11.Y - ZOrder;
xSide1.FGLPoints[FResizeData.Indexr11].z := FResizeData.Noder11.Z;
xSide1.FGLPoints[FResizeData.Indexr12].x := FResizeData.Noder12.X;
xSide1.FGLPoints[FResizeData.Indexr12].y := FResizeData.Noder12.Y - ZOrder;
xSide1.FGLPoints[FResizeData.Indexr12].z := FResizeData.Noder12.Z;
xSide1.FPoints[FResizeData.Indexr11].x := xSide1.FGLPoints[FResizeData.Indexr11].x / Factor;
xSide1.FPoints[FResizeData.Indexr11].z := xSide1.FGLPoints[FResizeData.Indexr11].y / Factor;
xSide1.FPoints[FResizeData.Indexr11].y := xSide1.FGLPoints[FResizeData.Indexr11].z / Factor;
xSide1.FPoints[FResizeData.Indexr12].x := xSide1.FGLPoints[FResizeData.Indexr12].x / Factor;
xSide1.FPoints[FResizeData.Indexr12].z := xSide1.FGLPoints[FResizeData.Indexr12].y / Factor;
xSide1.FPoints[FResizeData.Indexr12].y := xSide1.FGLPoints[FResizeData.Indexr12].z / Factor;
ZOrder := xSide2.FZOrder;
xSide2.FGLPoints[FResizeData.Indexr21].x := FResizeData.Noder21.X;
xSide2.FGLPoints[FResizeData.Indexr21].y := FResizeData.Noder21.Y - ZOrder;
xSide2.FGLPoints[FResizeData.Indexr21].z := FResizeData.Noder21.Z;
xSide2.FGLPoints[FResizeData.Indexr22].x := FResizeData.Noder22.X;
xSide2.FGLPoints[FResizeData.Indexr22].y := FResizeData.Noder22.Y - ZOrder;
xSide2.FGLPoints[FResizeData.Indexr22].z := FResizeData.Noder22.Z;
xSide2.FPoints[FResizeData.Indexr21].x := xSide2.FGLPoints[FResizeData.Indexr21].x / Factor;
xSide2.FPoints[FResizeData.Indexr21].z := xSide2.FGLPoints[FResizeData.Indexr21].y / Factor;
xSide2.FPoints[FResizeData.Indexr21].y := xSide2.FGLPoints[FResizeData.Indexr21].z / Factor;
xSide2.FPoints[FResizeData.Indexr22].x := xSide2.FGLPoints[FResizeData.Indexr22].x / Factor;
xSide2.FPoints[FResizeData.Indexr22].z := xSide2.FGLPoints[FResizeData.Indexr22].y / Factor;
xSide2.FPoints[FResizeData.Indexr22].y := xSide2.FGLPoints[FResizeData.Indexr22].z / Factor;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.SetSidesData', E.Message);
end;
end;
procedure Tfrm3D.RefreshSidesPoints;
var
i, j: integer;
xGLSide1, xGLSide2: TGLPolygon;
xNode: TTreeNode;
xSide1, xSide2: T3DSide;
ZOrder: Double;
begin
try
xGLSide1 := FResizeData.Side1;
xGLSide2 := FResizeData.Side2;
xNode := TTreeNode(xGLSide1.TagObject);
xSide1 := T3DSide(xNode.Data);
xNode := TTreeNode(xGLSide2.TagObject);
xSide2 := T3DSide(xNode.Data);
i := 0;
while i < xGLSide1.Nodes.Count do
begin
if i > 0 then
begin
if EQD(xGLSide1.Nodes[i].x, xGLSide1.Nodes[i-1].x) and EQD(xGLSide1.Nodes[i].y, xGLSide1.Nodes[i-1].y) and EQD(xGLSide1.Nodes[i].z, xGLSide1.Nodes[i-1].z) then
xGLSide1.Nodes.Delete(i)
else
i := i + 1;
end
else
i := i + 1;
end;
SetLength(xSide1.FGLPoints, xGLSide1.Nodes.Count);
SetLength(xSide1.FPoints, xGLSide1.Nodes.Count);
ZOrder := xSide1.FZOrder;
for i := 0 to xGLSide1.Nodes.Count - 1 do
begin
xSide1.FGLPoints[i].x := xGLSide1.Nodes[i].x;
xSide1.FGLPoints[i].y := xGLSide1.Nodes[i].y - ZOrder;
xSide1.FGLPoints[i].z := xGLSide1.Nodes[i].z;
xSide1.FPoints[i].x := xSide1.FGLPoints[i].x / Factor;
xSide1.FPoints[i].z := xSide1.FGLPoints[i].y / Factor;
xSide1.FPoints[i].y := xSide1.FGLPoints[i].z / Factor;
end;
i := 0;
while i < xGLSide2.Nodes.Count do
begin
if i > 0 then
begin
if EQD(xGLSide2.Nodes[i].x, xGLSide2.Nodes[i-1].x) and EQD(xGLSide2.Nodes[i].y, xGLSide2.Nodes[i-1].y) and EQD(xGLSide2.Nodes[i].z, xGLSide2.Nodes[i-1].z) then
xGLSide2.Nodes.Delete(i)
else
i := i + 1;
end
else
i := i + 1;
end;
SetLength(xSide2.FGLPoints, xGLSide2.Nodes.Count);
SetLength(xSide2.FPoints, xGLSide2.Nodes.Count);
ZOrder := xSide2.FZOrder;
for i := 0 to xGLSide2.Nodes.Count - 1 do
begin
xSide2.FGLPoints[i].x := xGLSide2.Nodes[i].x;
xSide2.FGLPoints[i].y := xGLSide2.Nodes[i].y - ZOrder;
xSide2.FGLPoints[i].z := xGLSide2.Nodes[i].z;
xSide2.FPoints[i].x := xSide2.FGLPoints[i].x / Factor;
xSide2.FPoints[i].z := xSide2.FGLPoints[i].y / Factor;
xSide2.FPoints[i].y := xSide2.FGLPoints[i].z / Factor;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.RefreshSidesPoints', E.Message);
end;
end;
procedure Tfrm3D.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
var
i, Res: Integer;
mess: string;
xIDList: integer;
xFileStream: string;
begin
try
GLCadencer.Enabled := False;
mess := cForm3D_Mes6_1;
//Res := MessageQuastYNC(cForm3D_Mes6_1); //21.09.2011 MessageBox(self.Handle, PAnsiChar(mess), cForm3D_Mes6_2, MB_YESNOCANCEL);
if GReadOnlyMode then
Res := IDNO
else
Res := MessageBox(self.Handle, PAnsiChar(mess), cForm3D_Mes6_2, MB_YESNOCANCEL);
if Res = IDYES then
begin
if FToolMode = tmCut then
begin
// Ïðèìåíèòü ðàçðåçêó?
case MessageQuastYNC(cForm3D_Mes6_3) of
IDYES:
ApplyCutting;
IDCANCEL:
CanClose := false;
end;
end;
if CanClose then
begin
if FToolMode <> tmSelect then
begin
RefreshSidesPoints;
UndoCutSides;
end;
ValidateActiveFormControl(Self); // Åñëè ôîêóñ îñòàëñÿ â êîíòðîëå
for i := 0 to FIdsStream.Count - 1 do
begin
xIDList := FIdsStream.Items[i];
xFileStream := FFilesStream.Strings[i];
SaveModelToStream(xFileStream, xIDList);
end;
ApplyScsModel;
GSaved3DModelExist := True;
end;
end
else if Res = IDNO then
begin
{
if FToolMode <> tmSelect then
begin
RefreshSidesPoints;
UndoCutSides;
end;
}
end
else if Res = IDCANCEL then
begin
CanClose := False;
GLCadencer.Enabled := True;
end;
if CanClose then
begin
FreeAndNil(F3DModel);
FIdsStream.Clear;
FFilesStream.Clear;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.FormCloseQuery', E.Message);
end;
end;
procedure Tfrm3D.sbSaveModelClick(Sender: TObject);
var
i: integer;
xIDList: integer;
xFileStream: string;
begin
try
for i := 0 to FIdsStream.Count - 1 do
begin
xIDList := FIdsStream.Items[i];
xFileStream := FFilesStream.Strings[i];
SaveModelToStream(xFileStream, xIDList);
end;
GSaved3DModelExist := True;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.sbSaveModelClick', E.Message);
end;
end;
procedure Tfrm3D.SaveModelToStream(const AFile: String; AListID: Integer);
var
fFileName: string;
//08.09.2011 Buffer: array[0..1023] of Char;
TempPath: string;
xStream: TFileStream;
xSize: Integer;
mStream: TMemoryStream;
i, j, k, ii, jj, kk, s: integer;
xRoom: T3DRoom;
xWall: T3DWall;
xWallElement: T3DWallElement;
xBalconElement: T3DBalconElement;
xSlope: T3DSlope;
xSide, xSubSide: T3DSide;
x3DSObject: T3DSObject;
xConn: T3DConnector;
xLine: T3DLine;
begin
try
{* Çäåñü íà ñàìîì äåëå íóæíî ïîëó÷èòü èìÿ ôàéëà ñ ÏÌ, âîò êàê çäåñü
fFileName := GetCadFileNameForSaveToPM(FCAD.FCADListID);
PCad.SaveToFile(0, fFileName);
ýòî íà îáðàáîò÷èêå TF_CAD.FormCloseQuery è ïîòîì íà LoadModelToStream òîò ôàéë ïîëó÷èòü
*}
fFileName := AFile;
if fFileName = '' then
begin
TempPath := GetAnsiTempPath; //08.09.2011 SetString(TempPath, Buffer, GetTempPath(Sizeof(Buffer) - 1, Buffer));
fFileName := TempPath + '3dmodel.pwd';
end;
xStream := SafeOpenFileStream(fFileName, fmCreate or fmShareExclusive, 'Tfrm3D.SaveModelToStream', cSCSComponent_Msg22_12);
ModelObjectsList := TList.Create;
ModelObjectsList.Add(F3DModel);
// ðàñïàðñèòü êîìíàòû
for i := 0 to F3DModel.FRooms.Count - 1 do
begin
xRoom := T3DRoom(F3DModel.FRooms[i]);
if (xRoom.FListID <> AListID) or (not xRoom.FVisible) then
continue;
ModelObjectsList.Add(xRoom);
// äîáàâèòü ïîòîëîê â êîìíàòû
xSide := xRoom.FCeiling;
ModelObjectsList.Add(xSide);
for j := 0 to xSide.FSubSides.Count - 1 do
begin
xSubSide := T3DSide(xSide.FSubSides[j]);
ModelObjectsList.Add(xSubSide);
end;
// äîáàâèòü ïîë â êîìíàòó,åñëè îí åñòü
if xRoom.FFloor <> nil then
begin
xSide := xRoom.FFloor;
ModelObjectsList.Add(xSide);
for j := 0 to xSide.FSubSides.Count - 1 do
begin
xSubSide := T3DSide(xSide.FSubSides[j]);
ModelObjectsList.Add(xSubSide);
end;
end;
// äîáàâèòü 3äñ îáüåêòû
for j := 0 to xRoom.F3DSObjects.Count - 1 do
begin
x3DSObject := T3DSObject(xRoom.F3DSObjects[j]);
ModelObjectsList.Add(x3DSObject);
end;
// ðàñïàðñèòü ñòåíû êàæäîé êîìíàòû
for j := 0 to xRoom.FWalls.Count - 1 do
begin
xWall := T3DWall(xRoom.FWalls[j]);
ModelObjectsList.Add(xWall);
// ðàñïàðñèòü ýëåìåíòû êàæäîé ñòåíû
for k := 0 to xWall.FWallElements.Count - 1 do
begin
xWallElement := T3DWallElement(xWall.FWallElements[k]);
ModelObjectsList.Add(xWallElement);
// îêíî
if xWallElement.FElementType = dotWindow then
begin
// äîáàâèòü îòêîñû
for ii := 0 to xWallElement.FSlopes.Count - 1 do
begin
xSlope := T3DSlope(xWallElement.FSlopes[ii]);
ModelObjectsList.Add(xSlope);
// äîáàâòü ãðàíè îòêîñà
for jj := 0 to xSlope.FSides.Count - 1 do
begin
xSide := T3DSide(xSlope.FSides[jj]);
ModelObjectsList.Add(xSide);
// Ïîäãðàíè
for s := 0 to xSide.FSubSides.Count - 1 do
begin
xSubSide := T3DSide(xSide.FSubSides[s]);
ModelObjectsList.Add(xSubSide);
end;
end;
end;
end;
// äâåðü
if xWallElement.FElementType = dotDoor then
begin
// äîáàâèòü îòêîñû
for ii := 0 to xWallElement.FSlopes.Count - 1 do
begin
xSlope := T3DSlope(xWallElement.FSlopes[ii]);
ModelObjectsList.Add(xSlope);
// äîáàâòü ãðàíè îòêîñà
for jj := 0 to xSlope.FSides.Count - 1 do
begin
xSide := T3DSide(xSlope.FSides[jj]);
ModelObjectsList.Add(xSide);
// Ïîäãðàíè
for s := 0 to xSide.FSubSides.Count - 1 do
begin
xSubSide := T3DSide(xSide.FSubSides[s]);
ModelObjectsList.Add(xSubSide);
end;
end;
end;
end;
// áàëêîí
if xWallElement.FElementType = dotBalcony then
begin
// äîáàâèòü îòêîñû
for ii := 0 to xWallElement.FSlopes.Count - 1 do
begin
xSlope := T3DSlope(xWallElement.FSlopes[ii]);
ModelObjectsList.Add(xSlope);
// äîáàâòü ãðàíè îòêîñà
for jj := 0 to xSlope.FSides.Count - 1 do
begin
xSide := T3DSide(xSlope.FSides[jj]);
ModelObjectsList.Add(xSide);
// Ïîäãðàíè
for s := 0 to xSide.FSubSides.Count - 1 do
begin
xSubSide := T3DSide(xSide.FSubSides[s]);
ModelObjectsList.Add(xSubSide);
end;
end;
end;
// äîáàâèòü ýëåìåíòû áàëêîíà
for ii := 0 to xWallElement.FBalconElements.Count - 1 do
begin
xBalconElement := T3DBalconElement(xWallElement.FBalconElements[ii]);
ModelObjectsList.Add(xBalconElement);
// äîáàâòü ãðàíè ýëåìåíòà áàëêîíà
for jj := 0 to xBalconElement.FSides.Count - 1 do
begin
xSide := T3DSide(xBalconElement.FSides[jj]);
ModelObjectsList.Add(xSide);
// Ïîäãðàíè
for s := 0 to xSide.FSubSides.Count - 1 do
begin
xSubSide := T3DSide(xSide.FSubSides[s]);
ModelObjectsList.Add(xSubSide);
end;
end;
end;
end;
// äîáàâèòü ãðàíè äàííîãî ýëåìåíòà ñòåíû
for ii := 0 to xWallElement.FSides.Count - 1 do
begin
xSide := T3DSide(xWallElement.FSides[ii]);
ModelObjectsList.Add(xSide);
// Ïîäãðàíè
for s := 0 to xSide.FSubSides.Count - 1 do
begin
xSubSide := T3DSide(xSide.FSubSides[s]);
ModelObjectsList.Add(xSubSide);
end;
end;
end;
// äîáàâèòü ãðàíè ñòåíû
for k := 0 to xWall.FSides.Count - 1 do
begin
xSide := T3DSide(xWall.FSides[k]);
ModelObjectsList.Add(xSide);
// Ïîäãðàíè
for s := 0 to xSide.FSubSides.Count - 1 do
begin
xSubSide := T3DSide(xSide.FSubSides[s]);
ModelObjectsList.Add(xSubSide);
end;
end;
end;
end;
for i := 0 to F3DModel.FScsObjects.Count - 1 do
begin
if TObject(F3DModel.FScsObjects[i]) is T3DConnector then
begin
xConn := T3DConnector(F3DModel.FScsObjects[i]);
if (xConn.FListID <> AListID) then
continue;
ModelObjectsList.Add(xConn);
end;
if TObject(F3DModel.FScsObjects[i]) is T3DLine then
begin
xLine := T3DLine(F3DModel.FScsObjects[i]);
if (xLine.FListID <> AListID) then
continue;
ModelObjectsList.Add(xLine);
end;
end;
xSize := 0;
mStream := TMemoryStream.Create;
GetModelData(mStream);
xSize := mStream.Size;
mStream.Seek(0, soFromBeginning);
if xStream <> nil then
begin
xStream.Write(xSize, 4);
StreamToStream(mStream, xStream, xSize);
end;
FreeAndNil(mStream);
// All used files by model
xSize := 0;
mStream := TMemoryStream.Create;
CollectFileDataFromModel(mStream);
xSize := mStream.Size;
mStream.Seek(0, soFromBeginning);
if xStream <> nil then
begin
xStream.Write(xSize, 4);
StreamToStream(mStream, xStream, xSize);
end;
FreeAndNil(mStream);
FreeAndNil(xStream);
FreeAndNil(ModelObjectsList);
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.SaveModelToStream', E.Message);
end;
end;
procedure Tfrm3D.GetModelData(Stream: TStream);
var
i, xCount: integer;
xSize: Integer;
objStream: TMemoryStream;
xObject: TObject;
begin
try
xCount := ModelObjectsList.Count;
Stream.Write(xCount, 4);
for i := 0 to xCount - 1 do
begin
xObject := TObject(ModelObjectsList[i]);
objStream := TMemoryStream.Create;
if xObject is T3DModel then
T3DModel(xObject).WriteToStream(objStream);
if xObject is T3DRoom then
T3DRoom(xObject).WriteToStream(objStream);
if xObject is T3DWall then
T3DWall(xObject).WriteToStream(objStream);
if xObject is T3DWallElement then
T3DWallElement(xObject).WriteToStream(objStream);
if xObject is T3DBalconElement then
T3DBalconElement(xObject).WriteToStream(objStream);
if xObject is T3DSlope then
T3DSlope(xObject).WriteToStream(objStream);
if xObject is T3DSide then
T3DSide(xObject).WriteToStream(objStream);
if xObject is T3DSObject then
T3DSObject(xObject).WriteToStream(objStream);
if xObject is T3DConnector then
T3DConnector(xObject).WriteToStream(objStream);
if xObject is T3DLine then
T3DLine(xObject).WriteToStream(objStream);
xSize := objStream.Size;
objStream.Seek(0,soFromBeginning);
Stream.Write(xSize, 4);
StreamToStream(objStream, Stream, xSize);
FreeAndNil(objStream);
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.GetModelData', E.Message);
end;
end;
procedure Tfrm3D.LoadModelFromStream(const AFile: String; AListID: Integer);
var
fFileName: string;
//08.09.2011 Buffer: array[0..1023] of Char;
TempPath: string;
xStream: TFileStream;
xSize: Integer;
mStream: TMemoryStream;
i, j, k, ii, jj, kk: integer;
xModel: T3DModel;
xRoom: T3DRoom;
xWall: T3DWall;
xWallElement: T3DWallElement;
xBalconElement: T3DBalconElement;
xSlope: T3DSlope;
xCeiling, xFloor, xSide: T3DSide;
xObject: TObject;
begin
try
{* Çäåñü íà ñàìîì äåëå íóæíî ïîëó÷èòü ñòðèì ìîäåëè, êàê íà ïîäîáèè ýòî äåëàåòñÿ ñ
ïîëó÷åíèåì ñòðèìà ÊÀÄ îáúåêòîâ â ïðîöåäóðå OpenListsInProject
ListStream := OpenListInPM(FCAD.FCADListID, FCAD.FCADListName, fFileName);
if ListStream <> nil then
begin
SetString(TempPath, Buffer, GetTempPath(Sizeof(Buffer) - 1, Buffer));
ListStream.SaveToFile(TempPath + 'tempCAD.pwd');
FCAD.PCad.LoadFromFile(TempPath + 'tempCAD.pwd');
end
*}
F3DStreamModel := nil;
ModelObjectsList := TList.Create;
fFileName := AFile;
if fFileName = '' then
begin
TempPath := GetAnsiTempPath; //08.09.2011 SetString(TempPath, Buffer, GetTempPath(Sizeof(Buffer) - 1, Buffer));
fFileName := TempPath + '3dmodel.pwd';
end;
if not FileExists(fFileName) then
begin
FreeAndNil(ModelObjectsList);
exit;
end;
xStream := SafeOpenFileStream(fFileName, fmOpenRead or fmShareExclusive, 'Tfrm3D.LoadModelFromStream', cSCSComponent_Msg22_12);
if xStream <> nil then
begin
if xStream.Size = 0 then
begin
try
FreeAndNil(xStream);
except
end;
FreeAndNil(ModelObjectsList);
exit;
end;
xStream.Read(xSize, 4);
mStream := TMemoryStream.Create;
StreamToStream(xStream, mStream, xSize);
mStream.Seek(0, soFromBeginning);
SetModelData(mStream);
FreeAndNil(mStream);
if xStream.Position < xStream.Size then
begin
xStream.Read(xSize, 4);
mStream := TMemoryStream.Create;
StreamToStream(xStream, mStream, xSize);
mStream.Seek(0,soFromBeginning);
ExtractAllFiles(mStream);
mStream.Free;
end;
FreeAndNil(xStream);
end;
for i := 0 to ModelObjectsList.Count - 1 do
begin
xObject := TObject(ModelObjectsList[i]);
if xObject is T3DModel then
T3DModel(xObject).SetRelations;
if xObject is T3DRoom then
T3DRoom(xObject).SetRelations;
if xObject is T3DWall then
T3DWall(xObject).SetRelations;
if xObject is T3DWallElement then
T3DWallElement(xObject).SetRelations;
if xObject is T3DBalconElement then
T3DBalconElement(xObject).SetRelations;
if xObject is T3DSlope then
T3DSlope(xObject).SetRelations;
if xObject is T3DSide then
T3DSide(xObject).SetRelations;
if xObject is T3DSObject then
T3DSObject(xObject).SetRelations;
if xObject is T3DConnector then
T3DConnector(xObject).SetRelations;
if xObject is T3DLine then
T3DLine(xObject).SetRelations;
end;
FreeAndNil(ModelObjectsList);
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.LoadModelFromStream', E.Message);
end;
end;
procedure Tfrm3D.SyncModelFromStream(const AFile: String=''; AListID: Integer = 0; AFaces: TList=nil);
begin
LoadModelFromStream(AFile, AListID);
if Self.F3DStreamModel = nil then
begin
Self.UpdateModelTree;
Self.UpdateScsModelTree;
end
else
begin
Self.UpdateModelTreeFromStream(AFaces);
Self.UpdateScsModelTreeFromStream(AFaces);
end;
Self.UpdateFaces(AFaces, 1);
end;
procedure Tfrm3D.SetModelData(Stream: TStream);
var
i,xCount: integer;
xObject: TObject;
xSize: Integer;
objStream: TMemoryStream;
TypeName: string;
xModel: T3DModel;
xRoom: T3DRoom;
xWall: T3DWall;
xWallElement: T3DWallElement;
xBalconElement: T3DBalconElement;
xSlope: T3DSlope;
xSide: T3DSide;
x3DSObject: T3DSObject;
xConn: T3DConnector;
xLine: T3DLine;
begin
try
Stream.Read(xCount, 4);
xModel := nil; //14.12.2010
for i := 0 to xCount - 1 do
begin
Stream.Read(xSize, 4);
objStream := TMemoryStream.Create;
StreamToStream(Stream, objStream, xSize);
objStream.Seek(0,soFromBeginning);
TypeName := ReadStringFromStream(objStream);
if TypeName = 'T3DModel' then
begin
xModel := T3DModel.Create;
xModel.ReadFromStream(objStream);
ModelObjectsList.Add(xModel);
end;
if TypeName = 'T3DRoom' then
begin
xRoom := T3DRoom.Create(nil, nil, nil);
xRoom.ReadFromStream(objStream);
ModelObjectsList.Add(xRoom);
end;
if TypeName = 'T3DWall' then
begin
xWall := T3DWall.Create(nil, nil, nil);
xWall.ReadFromStream(objStream);
ModelObjectsList.Add(xWall);
end;
if TypeName = 'T3DWallElement' then
begin
xWallElement := T3DWallElement.Create(nil, nil, dotNone, nil);
xWallElement.ReadFromStream(objStream);
ModelObjectsList.Add(xWallElement);
end;
if TypeName = 'T3DBalconElement' then
begin
xBalconElement := T3DBalconElement.Create(nil, dotNone, nil);
xBalconElement.ReadFromStream(objStream);
ModelObjectsList.Add(xBalconElement);
end;
if TypeName = 'T3DSlope' then
begin
xSlope := T3DSlope.Create(nil, nil, nil);
xSlope.ReadFromStream(objStream);
ModelObjectsList.Add(xSlope);
end;
if TypeName = 'T3DSide' then
begin
xSide := T3DSide.Create(ftNetPath, fwtNone, wstNone, nil);
xSide.ReadFromStream(objStream);
ModelObjectsList.Add(xSide);
end;
if TypeName = 'T3DSObject' then
begin
x3DSObject := T3DSObject.Create(nil);
x3DSObject.ReadFromStream(objStream);
ModelObjectsList.Add(x3DSObject);
end;
if TypeName = 'T3DConnector' then
begin
xConn := T3DConnector.Create(nil, nil, nil);
xConn.ReadFromStream(objStream);
ModelObjectsList.Add(xConn);
end;
if TypeName = 'T3DLine' then
begin
xLine := T3DLine.Create(nil, nil, nil);
xLine.ReadFromStream(objStream);
ModelObjectsList.Add(xLine);
end;
FreeAndNil(objStream);
end;
frm3D.F3DStreamModel := xModel;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.SetModelData', E.Message);
end;
end;
procedure Tfrm3D.CopyModelHash;
var
i, j: integer;
xStr: string;
CanAdd: Boolean;
begin
try
// ïåðåáðîñèòü HASH
for i := 0 to F3DStreamModel.FHashs.Count - 1 do
begin
xStr := F3DStreamModel.FHashs[i];
if F3DModel.FHashs.IndexOf(xStr) = -1 then
F3DModel.FHashs.Add(xStr);
//CanAdd := True;
//for j := 0 to F3DModel.FHashs.Count - 1 do
//begin
// if F3DModel.FHashs[j] = xStr then
// CanAdd := False;
//end;
//if CanAdd then
// F3DModel.FHashs.Add(xStr);
end;
for i := 0 to F3DStreamModel.F3DSHashs.Count - 1 do
begin
xStr := F3DStreamModel.F3DSHashs[i];
if F3DModel.F3DSHashs.IndexOf(xStr) = -1 then
F3DModel.F3DSHashs.Add(xStr);
end;
for i := 0 to F3DStreamModel.FFiles.Count - 1 do
begin
xStr := F3DStreamModel.FFiles[i];
if F3DModel.FFiles.IndexOf(xStr) = -1 then
begin
F3DModel.FFiles.Add(xStr);
j := F3DModel.FFiles.IndexOf(xStr);
if j >= 0 then
begin
while F3DModel.FFilesHashs.Count - 1 < j do
F3DModel.FFilesHashs.Add('');
if F3DStreamModel.FFilesHashs.Count - 1 >= i then
F3DModel.FFilesHashs[j] := F3DStreamModel.FFilesHashs[i]
else
F3DModel.FFilesHashs[j] := 'empty.bmp';
end;
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.CopyModelHash', E.Message);
end;
end;
procedure Tfrm3D.OnRightClick;
var
xObj: TGLBaseSceneObject;
Item: TMenuItem;
i, j, Index: integer;
Str: string;
xCutData: TCutData;
X, Y: Integer;
xSide: T3DSide;
xLine: T3DLine;
xConn: T3DConnector;
begin
try
X := mx;
Y := my;
if (FToolMode = tmSelect) then
begin
xObj := GlsceneViewer.Buffer.GetPickedobject(X, Y);
// SIDES
if (xObj <> nil) and (xObj is TGLPolygon) then
begin
xSide := T3DSide(TTreeNode(xObj.TagObject).Data);
if (((xSide.FFaceType = ftNetPath) and ((xSide.FWallType = fwtInner) or (xSide.FWallType = fwtOuter))) or
(xSide.FFaceType = ftNetCeiling) or (xSide.FFaceType = ftNetFloor)) and (Not xSide.FAsArc) then
begin
if (FSelection.Count = 1) and (TGLBaseSceneObject(FSelection[0]) = xObj) then
begin
// Create Nodes Texts
CreateNodesObjects(TGLPolygon(xObj));
// Create PopumMenu
Index := DummyCube.IndexOfChild(xObj);
FCutDataList.Clear;
pmCut.Items.Clear;
for i := 0 to TGLPolygon(xObj).Nodes.Count - 1 do
begin
Str := '';
for j := i + 2 to TGLPolygon(xObj).Nodes.Count - 1 do
begin
Str := 'Ðàçðåçàòü: ' + IntToStr(i+1) + ',' + IntToStr(i+2) + '-';
if j + 1 < TGLPolygon(xObj).Nodes.Count then
begin
Str := Str + IntToStr(j+1) + ',' + IntToStr(j+2);
Item := TMenuItem.Create(pmCut);
Item.Caption := Str;
pmCut.Items.Add(Item);
Item.Tag := Index;
Item.OnClick := SelectNodesEvent;
xCutData := TCutData.create;
xCutData.Index11 := i;
xCutData.Index12 := i + 1;
xCutData.Index21 := j;
xCutData.Index22 := j + 1;
FCutDataList.Add(xCutData);
end
else
begin
if i <> 0 then
begin
Str := Str + IntToStr(j+1) + ',' + IntToStr(1);
Item := TMenuItem.Create(pmCut);
Item.Caption := Str;
pmCut.Items.Add(Item);
Item.Tag := Index;
Item.OnClick := SelectNodesEvent;
xCutData := TCutData.create;
xCutData.Index11 := i;
xCutData.Index12 := i + 1;
xCutData.Index21 := j;
xCutData.Index22 := 0;
FCutDataList.Add(xCutData);
end;
end;
end;
end;
pmCut.Popup(X, Y);
end;
end;
end
else
// SCS POPUP
if (xObj <> nil) and (xObj is TGLLines) then
begin
xLine := T3DLine(TTreeNode(xObj.TagObject).Data);
if FSelection.Count = 1 then
if isLineObject(TGLBaseSceneObject(FSelection[0]), xObj) then
begin
if xLine.FLineType = lt_Line then
begin
pmScsPopup.Items[0].Visible := True;
pmScsPopup.Popup(X, Y + 35);
end;
end;
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.OnRightClick', E.Message);
end;
end;
procedure Tfrm3D.Set3DSObjectPos(aGLObject: TGLFreeForm);
var
i: integer;
xObject: T3DSObject;
begin
try
xObject := T3DSObject(TTreeNode(aGLObject.TagObject).Data);
xObject.FPosition.x := aGLObject.Position.x;
xObject.FPosition.y := aGLObject.Position.y - xObject.FZOrder;
xObject.FPosition.z := aGLObject.Position.z;
edPosX.Text := FloatToStr(xObject.FPosition.x);
edPosY.Text := FloatToStr(xObject.FPosition.y);
edPosZ.Text := FloatToStr(xObject.FPosition.z);
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.Set3DSObjectPos', E.Message);
end;
end;
procedure Tfrm3D.SetConnectorsOffset(aGLObjects: TList);
var
i: integer;
glObject: TGLBaseSceneObject;
glObject1: TGLFreeForm;
xConn: T3DConnector;
off_x, off_y, off_z: Double;
begin
try
for i := 0 to aGLObjects.Count - 1 do
begin
glObject := TGLBaseSceneObject(aGLObjects[i]);
if TObject(TTreeNode(glObject.tagObject).Data) is T3DConnector then
begin
xConn := T3DConnector(TTreeNode(glObject.tagObject).Data);
glObject1 := TGLFreeForm(xConn.FGLObject1);
off_x := glObject1.Position.X - xConn.FGLPoint.x;
if abs(off_x) < 0.0001 then
off_x := 0;
off_y := glObject1.Position.Y - xConn.FGLPoint.y;
if abs(off_y) < 0.0001 then
off_y := 0;
off_z := glObject1.Position.Z - xConn.FGLPoint.z;
if abs(off_z) < 0.0001 then
off_z := 0;
xConn.FOffset.x := off_x / Factor;
xConn.FOffset.y := off_z / Factor;
xConn.FOffset.z := off_y / Factor;
edScsOffsetX.Text := FloatToStr(off_x);
edScsOffsetY.Text := FloatToStr(off_y);
edScsOffsetZ.Text := FloatToStr(off_z);
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.SetConnectorsOffset', E.Message);
end;
end;
procedure Tfrm3D.nDeleteAllSubSidesClick(Sender: TObject);
var
i, j: Integer;
xSide, xSubSide: T3DSide;
xSideNode, xSubSideNode: TTreeNode;
xGLObject, xGLSubObject: TGLBaseSceneObject;
begin
try
if ModelTree.SelectionCount = 1 then
begin
xSideNode := ModelTree.Selections[0];
xSide := T3DSide(xSideNode.Data);
xGLObject := TGLBaseSceneObject(xSide.FGLObject);
for i := 0 to xSideNode.Count - 1 do
begin
xSubSideNode := xSideNode.Item[i];
xSubSide := T3DSide(xSubSideNode.Data);
xGLSubObject := TGLBaseSceneObject(xSubSide.FGLObject);
if i = 0 then
begin
xSide.FGLObject := xGLSubObject;
xGLSubObject.TagObject := xSideNode;
TGLPolygon(xGLSubObject).Nodes.Clear;
for j := 0 to Length(xSide.FGLPoints) - 1 do
begin
TGLPolygon(xGLSubObject).AddNode(xSide.FGLPoints[j].x, xSide.FGLPoints[j].y, xSide.FGLPoints[j].z);
end;
end
else
begin
DummyCube.Remove(xGLSubObject, True);
end;
end;
xSideNode.DeleteChildren;
xSide.FSubSides.Clear;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.nDeleteAllSubSidesClick', E.Message);
end;
end;
function Tfrm3D.GetModelObjectByComponID(aComponID: Integer; aModelType: Byte): TObject;
var
i, j, k, ii, jj, kk, s: integer;
xRoom: T3DRoom;
xWall: T3DWall;
xWallElement: T3DWallElement;
xBalconElement: T3DBalconElement;
xSlope: T3DSlope;
xSide, xSubSide: T3DSide;
x3DSObject: T3DSObject;
xConn: T3DConnector;
xLine: T3DLine;
begin
try
Result := nil;
// ðàñïàðñèòü êîìíàòû
if aModelType = 1 then
begin
for i := 0 to F3DStreamModel.FRooms.Count - 1 do
begin
xRoom := T3DRoom(F3DStreamModel.FRooms[i]);
if xRoom.FSCSComponID = aComponID then
begin
Result := xRoom;
exit;
end;
// ðàñïàðñèòü ñòåíû êàæäîé êîìíàòû
for j := 0 to xRoom.FWalls.Count - 1 do
begin
xWall := T3DWall(xRoom.FWalls[j]);
if xWall.FSCSComponID = aComponID then
begin
Result := xWall;
exit;
end;
// ðàñïàðñèòü ýëåìåíòû êàæäîé ñòåíû
for k := 0 to xWall.FWallElements.Count - 1 do
begin
xWallElement := T3DWallElement(xWall.FWallElements[k]);
if xWallElement.FSCSComponID = aComponID then
begin
Result := xWallElement;
exit;
end;
// îêíî
if xWallElement.FElementType = dotWindow then
begin
// äîáàâèòü îòêîñû
for ii := 0 to xWallElement.FSlopes.Count - 1 do
begin
xSlope := T3DSlope(xWallElement.FSlopes[ii]);
if xSlope.FSCSComponID = aComponID then
begin
Result := xSlope;
exit;
end;
end;
end;
// äâåðü
if xWallElement.FElementType = dotDoor then
begin
// äîáàâèòü îòêîñû
for ii := 0 to xWallElement.FSlopes.Count - 1 do
begin
xSlope := T3DSlope(xWallElement.FSlopes[ii]);
if xSlope.FSCSComponID = aComponID then
begin
Result := xSlope;
exit;
end;
end;
end;
// áàëêîí
if xWallElement.FElementType = dotBalcony then
begin
// äîáàâèòü îòêîñû
for ii := 0 to xWallElement.FSlopes.Count - 1 do
begin
xSlope := T3DSlope(xWallElement.FSlopes[ii]);
if xSlope.FSCSComponID = aComponID then
begin
Result := xSlope;
exit;
end;
end;
// äîáàâèòü ýëåìåíòû áàëêîíà
for ii := 0 to xWallElement.FBalconElements.Count - 1 do
begin
xBalconElement := T3DBalconElement(xWallElement.FBalconElements[ii]);
if xBalconElement.FSCSComponID = aComponID then
begin
Result := xBalconElement;
exit;
end;
end;
end;
end;
end;
end;
end;
if aModelType = 2 then
begin
for i := 0 to F3DStreamModel.FScsObjects.Count - 1 do
begin
if TObject(F3DStreamModel.FScsObjects[i]) is T3DConnector then
begin
xConn := T3DConnector(F3DStreamModel.FScsObjects[i]);
if xConn.FSCSComponID = aComponID then
begin
Result := xConn;
exit;
end;
end;
if TObject(F3DStreamModel.FScsObjects[i]) is T3DLine then
begin
xLine := T3DLine(F3DStreamModel.FScsObjects[i]);
if xLine.FSCSComponID = aComponID then
begin
Result := xLine;
exit;
end;
end;
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.GetModelObjectByComponID', E.Message);
end;
end;
function Tfrm3D.GetSimilarSide(aSide: T3DSide; aObject: TObject): T3DSide;
var
i, j: integer;
SidesList: TList;
xSide: T3DSide;
begin
try
Result := nil;
if aObject = nil then
exit;
if aObject is T3DRoom then
begin
SidesList := TList.create;
SidesList.Add(T3DRoom(aObject).FCeiling);
if T3DRoom(aObject).FFloor <> nil then
SidesList.Add(T3DRoom(aObject).FFloor);
end;
if aObject is T3DWall then
begin
SidesList := T3DWall(aObject).FSides;
end;
if aObject is T3DWallElement then
begin
SidesList := T3DWallElement(aObject).FSides;
end;
if aObject is T3DBalconElement then
begin
SidesList := T3DBalconElement(aObject).FSides;
end;
if aObject is T3DSlope then
begin
SidesList := T3DSlope(aObject).FSides;
end;
// Ïåðåáîð
for i := 0 to SidesList.Count - 1 do
begin
xSide := T3DSide(SidesList[i]);
if CmpSides(aSide, xSide) then
begin
Result := xSide;
exit;
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.GetSimilarSide', E.Message);
end;
end;
function Tfrm3D.CmpSides(aSide1, aSide2: T3DSide): Boolean;
var
i, j: integer;
begin
try
Result := True;
if aSide1.FWallType <> aSide2.FWallType then
begin
Result := False;
exit;
end;
if Length(aSide1.FPoints) <> Length(aSide2.FPoints) then
begin
Result := False;
exit;
end;
for i := 0 to Length(aSide1.FPoints) - 1 do
begin
if not EQD(aSide1.FPoints[i].x, aSide2.FPoints[i].x) then
begin
Result := False;
exit;
end;
if not EQD(aSide1.FPoints[i].y, aSide2.FPoints[i].y) then
begin
Result := False;
exit;
end;
if not EQD(aSide1.FPoints[i].z, aSide2.FPoints[i].z) then
begin
Result := False;
exit;
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.CmpSides', E.Message);
end;
end;
procedure Tfrm3D.Edit2Exit(Sender: TObject);
begin
FirstPersonCamera.FocalLength := strtoint(Edit2.Text);
GLCamera.FocalLength := strtoint(Edit2.Text);
//GLCamera.DepthOfView := 100;
GLCamera.DepthOfView := Trunc(100 * gtx/400);
if GLCamera.DepthOfView > 500 then
GLCamera.DepthOfView := 500;
if GLCamera.DepthOfView < 100 then
GLCamera.DepthOfView := 100;
end;
procedure Tfrm3D.btnEmptyClick(Sender: TObject);
begin
if btnEmpty.Down then
begin
mDesc.Lines.Text := '';
end
else
mDesc.Lines.Text := 'empty';
if btnEmpty.GroupIndex <> 0 then
begin
mDesc.Lines.Text := '';
end
else
mDesc.Lines.Text := 'empty';
ChangeDesc;
end;
procedure Tfrm3D.NDel3DObjectClick(Sender: TObject);
var
i, j: Integer;
x3DObject: T3DSObject;
xSideNode: TTreeNode;
xGLObject: TGLBaseSceneObject;
xRoom: T3DRoom;
begin
try
if ModelTree.SelectionCount = 1 then
begin
xSideNode := ModelTree.Selections[0];
x3DObject := T3DSObject(xSideNode.Data);
xGLObject := TGLBaseSceneObject(x3DObject.FGLObject);
FSelection.Remove(xGLObject); //add
DummyCube.Remove(xGLObject, True);
xSideNode.Free;
xRoom := x3DObject.FParent;
xRoom.F3DSObjects.Delete(xRoom.F3DSObjects.IndexOf(x3DObject));
FreeAndNil(x3DObject);
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.nDelete3DObjectClick', E.Message);
end;
end;
function Tfrm3D.GetObjectFileByHash(aHash: string): string;
var
i: integer;
tmpdir, tmpfname, str: string;
begin
try
Result := '';
if aHash <> '' then
begin
tmpdir := GetWorkDir; // ExtractDirByCategoryType(dctPictures);
for i := 0 to F3DModel.F3DSHashs.Count - 1 do
begin
str := F3DModel.F3DSHashs.Strings[i];
if str = aHash then
begin
tmpfname := tmpdir + '\' + str + '.3ds';
if FileExists(tmpfname) then
begin
Result := tmpfname;
break;
end;
end;
end;
if Result = '' then
begin
for i := 0 to F3DModel.FHashs.Count - 1 do
begin
str := F3DModel.FHashs.Strings[i];
if str = aHash then
begin
tmpfname := tmpdir + '\' + str + '.3ds';
if FileExists(tmpfname) then
begin
Result := tmpfname;
break;
end;
end;
end;
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.GetObjectFileByHash', E.Message);
end;
end;
procedure Tfrm3D.LoadModelAddParamsFromStream(const AFile: String);
var
fFileName: string;
//08.09.2011 Buffer: array[0..1023] of Char;
TempPath: string;
xStream: TFileStream;
xSize: Integer;
mStream: TMemoryStream;
begin
try
fFileName := AFile;
if fFileName = '' then
begin
TempPath := GetAnsiTempPath; //08.09.2011 SetString(TempPath, Buffer, GetTempPath(Sizeof(Buffer) - 1, Buffer));
fFileName := TempPath + '3dmodel.pwd';
end;
if not FileExists(fFileName) then
exit;
xStream := SafeOpenFileStream(fFileName, fmOpenRead or fmShareExclusive, 'Tfrm3D.LoadModelAddParamsFromStream', cSCSComponent_Msg22_12);
if xStream <> nil then
begin
if xStream.Size = 0 then
begin
try
FreeAndNil(xStream);
except
end;
exit;
end;
xStream.Read(xSize, 4);
mStream := TMemoryStream.Create;
StreamToStream(xStream, mStream, xSize);
mStream.Seek(0, soFromBeginning);
SetFileData(mStream);
FreeAndNil(mStream);
FreeAndNil(xStream);
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.LoadModelAddParamsFromStream', E.Message);
end;
end;
procedure Tfrm3D.SaveModelAddParamsToStream(const AFile: String);
var
fFileName: string;
//08.09.2011 Buffer: array[0..1023] of Char;
TempPath: string;
xStream: TFileStream;
xSize: Integer;
mStream: TMemoryStream;
begin
try
fFileName := AFile;
if fFileName = '' then
begin
TempPath := GetAnsiTempPath; //08.09.2011 SetString(TempPath, Buffer, GetTempPath(Sizeof(Buffer) - 1, Buffer));
fFileName := TempPath + '3dmodel.pwd';
end;
xStream := SafeOpenFileStream(fFileName, fmCreate or fmShareExclusive, 'Tfrm3D.SaveModelAddParamsToStream', cSCSComponent_Msg22_12);
if xStream <> nil then
begin
xSize := 0;
mStream := TMemoryStream.Create;
GetFileData(mStream);
xSize := mStream.Size;
mStream.Seek(0, soFromBeginning);
xStream.Write(xSize, 4);
StreamToStream(mStream, xStream, xSize);
FreeAndNil(mStream);
FreeAndNil(xStream);
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.SaveModelAddParamsToStream', E.Message);
end;
end;
procedure Tfrm3D.CollectFileDataFromModel(Stream: TStream);
var
i, xCount: integer;
xSize: Integer;
xStream: TFileStream;
xFiles: TStringList;
SearchRec: TSearchRec;
tmpdir, FName: string;
begin
try
tmpdir := GetWorkDir; // ExtractDirByCategoryType(dctPictures);
if F3DModel <> nil then
begin
xFiles := TStringList.Create;
for i := 0 to F3DModel.FFilesHashs.Count - 1 do
begin
FName := ExtractFileName(F3DModel.FFilesHashs[i]);
if xFiles.IndexOf(FName) < 0 then
xFiles.Add(FName);
end;
// Save sides textures
xCount := F3DModel.FHashs.Count;
Stream.Write(xCount, 4);
for i := 0 to xCount - 1 do
begin
WriteString(Stream, F3DModel.FHashs[i]);
FName := tmpdir + '\' + F3DModel.FHashs[i] + '.bmp';
if FileExists(FName) then
begin
xStream := TFileStream.Create(FName, fmOpenRead);
xSize := xStream.Size;
xStream.Seek(0,soFromBeginning);
Stream.Write(xSize, 4);
StreamToStream(xStream, Stream, xSize);
FreeAndNil(xStream);
end
else
begin
xSize := 0;
Stream.Write(xSize, 4);
end;
end;
// Save 3ds Objects
xCount := F3DModel.F3DSHashs.Count;
Stream.Write(xCount, 4);
for i := 0 to xCount - 1 do
begin
WriteString(Stream, F3DModel.F3DSHashs[i]);
FName := tmpdir + '\' + F3DModel.F3DSHashs[i] + '.3ds';
if FileExists(FName) then
begin
xStream := TFileStream.Create(FName, fmOpenRead);
xSize := xStream.Size;
xStream.Seek(0,soFromBeginning);
Stream.Write(xSize, 4);
StreamToStream(xStream, Stream, xSize);
FreeAndNil(xStream);
end
else
begin
xSize := 0;
Stream.Write(xSize, 4);
end;
end;
// Save 3ds Objects Textures
xCount := xFiles.Count;
Stream.Write(xCount, 4);
for i := 0 to xCount - 1 do
begin
WriteString(Stream, xFiles.Strings[i]);
FName := tmpdir + '\' + xFiles.Strings[i];
if FileExists(FName) then
begin
xStream := TFileStream.Create(FName, fmOpenRead);
xSize := xStream.Size;
xStream.Seek(0,soFromBeginning);
Stream.Write(xSize, 4);
StreamToStream(xStream, Stream, xSize);
FreeAndNil(xStream);
end
else
begin
xSize := 0;
Stream.Write(xSize, 4);
end;
end;
FreeAndNil(xFiles);
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.GetFileData', E.Message);
end;
end;
procedure Tfrm3D.GetFileData(Stream: TStream);
var
i, xCount: integer;
xSize: Integer;
xStream: TFileStream;
xFiles: TStringList;
SearchRec: TSearchRec;
tmpdir, FName: string;
begin
try
tmpdir := GetWorkDir; // ExtractDirByCategoryType(dctPictures);
xFiles := TStringList.Create;
// Save sides textures
if (FindFirst(tmpdir + '\*.bmp', faAnyFile, SearchRec) = 0) or (FindFirst(tmpdir + '\*.jpg', faAnyFile, SearchRec) = 0) then
begin
repeat
if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
begin
if not (SearchRec.Attr and faDirectory = faDirectory) then
xFiles.Add(SearchRec.Name);
end;
until FindNext(SearchRec) <> 0;
FindClose(SearchRec);
end;
xCount := xFiles.Count;
Stream.Write(xCount, 4);
for i := 0 to xCount - 1 do
begin
WriteString(Stream, xFiles.Strings[i]);
FName := tmpdir + '\' + xFiles.Strings[i];
xStream := TFileStream.Create(FName, fmOpenRead);
xSize := xStream.Size;
xStream.Seek(0,soFromBeginning);
Stream.Write(xSize, 4);
StreamToStream(xStream, Stream, xSize);
FreeAndNil(xStream);
end;
xFiles.Clear;
// Save 3ds Objects
if FindFirst(tmpdir + '\*.3ds', faAnyFile, SearchRec) = 0 then
begin
repeat
if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
begin
if not (SearchRec.Attr and faDirectory = faDirectory) then
xFiles.Add(SearchRec.Name);
end;
until FindNext(SearchRec) <> 0;
FindClose(SearchRec);
end;
xCount := xFiles.Count;
Stream.Write(xCount, 4);
for i := 0 to xCount - 1 do
begin
WriteString(Stream, xFiles.Strings[i]);
FName := tmpdir + '\' + xFiles.Strings[i];
xStream := TFileStream.Create(FName, fmOpenRead);
xSize := xStream.Size;
xStream.Seek(0,soFromBeginning);
Stream.Write(xSize, 4);
StreamToStream(xStream, Stream, xSize);
FreeAndNil(xStream);
end;
FreeAndNil(xFiles);
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.GetFileData', E.Message);
end;
end;
procedure Tfrm3D.ExtractAllFiles(Stream: TStream);
var
i, xCount: integer;
xSize: Integer;
xStream: TMemoryStream; //TFileStream;
xFiles: TStringList;
SearchRec: TSearchRec;
tmpdir, FName, xFileName: string;
begin
try
tmpdir := GetWorkDir; // ExtractDirByCategoryType(dctPictures);
// Load Sides Textures
Stream.Read(xCount, 4);
for i := 0 to xCount - 1 do
begin
xFileName := ReadStringFromStream(Stream);
FName := tmpdir + '\' + xFileName + '.bmp';
Stream.Read(xSize, 4);
xStream := TMemoryStream.Create;
StreamToStream(Stream, xStream, xSize);
xStream.Seek(0,soFromBeginning);
if not FileExists(FName) then
xStream.SaveToFile(FName);
FreeAndNil(xStream);
end;
// Load 3ds Objects
Stream.Read(xCount, 4);
for i := 0 to xCount - 1 do
begin
xFileName := ReadStringFromStream(Stream);
FName := tmpdir + '\' + xFileName + '.3ds';
Stream.Read(xSize, 4);
xStream := TMemoryStream.Create;
StreamToStream(Stream, xStream, xSize);
xStream.Seek(0,soFromBeginning);
if not FileExists(FName) then
xStream.SaveToFile(FName);
FreeAndNil(xStream);
end;
// Load 3ds Objects Textures
Stream.Read(xCount, 4);
for i := 0 to xCount - 1 do
begin
xFileName := ReadStringFromStream(Stream);
FName := tmpdir + '\' + xFileName;
Stream.Read(xSize, 4);
xStream := TMemoryStream.Create;
StreamToStream(Stream, xStream, xSize);
xStream.Seek(0,soFromBeginning);
if not FileExists(FName) then
xStream.SaveToFile(FName);
FreeAndNil(xStream);
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.SetFileData', E.Message);
end;
end;
procedure Tfrm3D.SetFileData(Stream: TStream);
var
i, xCount: integer;
xSize: Integer;
xStream: TMemoryStream; //TFileStream;
xFiles: TStringList;
SearchRec: TSearchRec;
tmpdir, FName, xFileName: string;
begin
try
tmpdir := GetWorkDir; // ExtractDirByCategoryType(dctPictures);
// Load Sides Textures
Stream.Read(xCount, 4);
for i := 0 to xCount - 1 do
begin
xFileName := ReadStringFromStream(Stream);
FName := tmpdir + '\test_texture\' + xFileName;
Stream.Read(xSize, 4);
xStream := TMemoryStream.Create;
StreamToStream(Stream, xStream, xSize);
xStream.Seek(0,soFromBeginning);
if not FileExists(FName) then
xStream.SaveToFile(FName);
FreeAndNil(xStream);
end;
// Load 3ds Objects
Stream.Read(xCount, 4);
for i := 0 to xCount - 1 do
begin
xFileName := ReadStringFromStream(Stream);
FName := tmpdir + '\test_3ds\' + xFileName;
Stream.Read(xSize, 4);
xStream := TMemoryStream.Create;
StreamToStream(Stream, xStream, xSize);
xStream.Seek(0,soFromBeginning);
if not FileExists(FName) then
xStream.SaveToFile(FName);
FreeAndNil(xStream);
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.SetFileData', E.Message);
end;
end;
procedure Tfrm3D.LoadSelectionData;
var
i, j: integer;
Cad: TF_Cad;
xName: string;
begin
try
cbLists.Properties.Items.Clear;
cbScsLists.Properties.Items.Clear;
if G3DModelForProject then // for project
begin
for i := 0 to FSCS_Main.MDIChildCount - 1 do
begin
Cad := TF_CAD(FSCS_Main.MDIChildren[i]);
xName := Cad.FCADListName + ' ' + IntToStr(Cad.FCADListIndex);
cbLists.Properties.Items.Add(xName);
cbScsLists.Properties.Items.Add(xName);
if FSCS_Main.ActiveMDIChild = Cad then
begin
cbLists.ItemIndex := i;
cbScsLists.ItemIndex := i;
end;
end;
end
else // for list only
begin
Cad := TF_CAD(FSCS_Main.ActiveMDIChild);
xName := Cad.FCADListName + ' ' + IntToStr(Cad.FCADListIndex);
cbLists.Properties.Items.Add(xName);
cbScsLists.Properties.Items.Add(xName);
cbLists.ItemIndex := 0;
cbScsLists.ItemIndex := 0;
end;
cbObjectsTypes.Properties.Items.Clear;
cbObjectsTypes.Properties.Items.Add(''); // 0
{//15.08.2012
cbObjectsTypes.Properties.Items.Add('Ñòåíû'); // 1
cbObjectsTypes.Properties.Items.Add('Äâåðè'); // 2
cbObjectsTypes.Properties.Items.Add('Îêíà'); // 3
cbObjectsTypes.Properties.Items.Add('Áàëêîíû'); // 4
cbObjectsTypes.Properties.Items.Add('Îòêîñû'); // 5
cbObjectsTypes.Properties.Items.Add('Àðêè'); // 6
cbObjectsTypes.Properties.Items.Add('Íèøè'); // 7
cbObjectsTypes.Properties.Items.Add('Ïîëû'); // 8
cbObjectsTypes.Properties.Items.Add('Ïîòîëêè'); // 9
cbObjectsTypes.Properties.Items.Add('Âíóòðåííèå ãðàíè'); // 10
cbObjectsTypes.Properties.Items.Add('Âíåøíèå ãðàíè'); // 11
cbObjectsTypes.Properties.Items.Add('3ds îáúåêòû'); // 12}
cbObjectsTypes.Properties.Items.Add(cForm3D_Mes7_1);
cbObjectsTypes.Properties.Items.Add(cForm3D_Mes7_2);
cbObjectsTypes.Properties.Items.Add(cForm3D_Mes7_3);
cbObjectsTypes.Properties.Items.Add(cForm3D_Mes7_4);
cbObjectsTypes.Properties.Items.Add(cForm3D_Mes7_5);
cbObjectsTypes.Properties.Items.Add(cForm3D_Mes7_6);
cbObjectsTypes.Properties.Items.Add(cForm3D_Mes7_7);
cbObjectsTypes.Properties.Items.Add(cForm3D_Mes7_8);
cbObjectsTypes.Properties.Items.Add(cForm3D_Mes7_9);
cbObjectsTypes.Properties.Items.Add(cForm3D_Mes7_10);
cbObjectsTypes.Properties.Items.Add(cForm3D_Mes7_11);
cbObjectsTypes.Properties.Items.Add(cForm3D_Mes7_12);
cbObjectsTypes.ItemIndex := 0;
cbScsObjectsTypes.Properties.Items.Clear;
cbScsObjectsTypes.Properties.Items.Add(''); // 0
{//15.08.2012
cbScsObjectsTypes.Properties.Items.Add('Îáúåêòû'); // 1
cbScsObjectsTypes.Properties.Items.Add('Òðàññû'); // 2
cbScsObjectsTypes.Properties.Items.Add('Ñïóñêè-ïîäúåìû'); // 3
cbScsObjectsTypes.Properties.Items.Add('Ì-ý ñïóñêè-ïîäúåìû'); // 4}
cbScsObjectsTypes.Properties.Items.Add(cForm3D_Mes8_1);
cbScsObjectsTypes.Properties.Items.Add(cForm3D_Mes8_2);
cbScsObjectsTypes.Properties.Items.Add(cForm3D_Mes8_3);
cbScsObjectsTypes.Properties.Items.Add(cForm3D_Mes8_4);
cbScsObjectsTypes.ItemIndex := 0;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.LoadSelectionData', E.Message);
end;
end;
procedure Tfrm3D.cbListsPropertiesCloseUp(Sender: TObject);
begin
try
cbObjectsTypes.ItemIndex := 0;
ModelTree.ClearSelection;
DeselectGLObjects;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.cbListsPropertiesCloseUp', E.Message);
end;
end;
procedure Tfrm3D.cbObjectsTypesPropertiesCloseUp(Sender: TObject);
begin
try
ModelTree.ClearSelection;
if cbObjectsTypes.ItemIndex = 0 then
begin
DeselectGLObjects;
end
else
begin
FindSelectNodesByType(cbObjectsTypes.ItemIndex);
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.cbObjectsTypesPropertiesCloseUp', E.Message);
end;
end;
procedure Tfrm3D.FindSelectNodesByType(aType: Integer);
var
i: integer;
xModelNode, xNode: TTreeNode;
xNodes, xSides, SelNodes: TList;
xSide: T3DSide;
xObject: T3DSObject;
begin
try
xNodes := TList.Create;
xModelNode := ModelTree.Items.GetFirstNode;
xNode := xModelNode.getFirstChild;
while xNode <> nil do
begin
if xNode.Text = cbLists.Text then
break;
xNode := xNode.GetNextSibling;
end;
xNodes.Add(xNode);
xSides := GetAllSidesNodesByNodes(xNodes);
FreeAndNil(xNodes);
SelNodes := TList.Create;
for i := 0 to xSides.Count - 1 do
begin
xNode := TTreeNode(xSides[i]);
case aType of
1:
begin
if TObject(xNode.Data) is T3DSide then
begin
xSide := T3DSide(xNode.Data);
if xSide.FFaceType = ftNetPath then
begin
ModelTree.Select(xNode, [ssCtrl]);
SelNodes.Add(xNode);
end;
end;
end;
2:
begin
if TObject(xNode.Data) is T3DSide then
begin
xSide := T3DSide(xNode.Data);
if xSide.FFaceType = ftNetDoor then
begin
ModelTree.Select(xNode, [ssCtrl]);
SelNodes.Add(xNode);
end;
end;
end;
3:
begin
if TObject(xNode.Data) is T3DSide then
begin
xSide := T3DSide(xNode.Data);
if xSide.FFaceType = ftNetWindow then
begin
ModelTree.Select(xNode, [ssCtrl]);
SelNodes.Add(xNode);
end;
end;
end;
4:
begin
if TObject(xNode.Data) is T3DSide then
begin
xSide := T3DSide(xNode.Data);
if (xSide.FFaceType = ftNetBalconDoor) or (xSide.FFaceType = ftNetBalconWindow) then
begin
ModelTree.Select(xNode, [ssCtrl]);
SelNodes.Add(xNode);
end;
end;
end;
5:
begin
if TObject(xNode.Data) is T3DSide then
begin
xSide := T3DSide(xNode.Data);
if xSide.FWallType in [fwtDoorSlope, fwtWindowSlope, fwtBalconSlope] then
begin
ModelTree.Select(xNode, [ssCtrl]);
SelNodes.Add(xNode);
end;
end;
end;
6:
begin
if TObject(xNode.Data) is T3DSide then
begin
xSide := T3DSide(xNode.Data);
if xSide.FWallType = fwtArc then
begin
ModelTree.Select(xNode, [ssCtrl]);
SelNodes.Add(xNode);
end;
end;
end;
7:
begin
if TObject(xNode.Data) is T3DSide then
begin
xSide := T3DSide(xNode.Data);
if xSide.FWallType = fwtNiche then
begin
ModelTree.Select(xNode, [ssCtrl]);
SelNodes.Add(xNode);
end;
end;
end;
8:
begin
if TObject(xNode.Data) is T3DSide then
begin
xSide := T3DSide(xNode.Data);
if xSide.FFaceType = ftNetFloor then
begin
ModelTree.Select(xNode, [ssCtrl]);
SelNodes.Add(xNode);
end;
end;
end;
9:
begin
if TObject(xNode.Data) is T3DSide then
begin
xSide := T3DSide(xNode.Data);
if xSide.FFaceType = ftNetCeiling then
begin
ModelTree.Select(xNode, [ssCtrl]);
SelNodes.Add(xNode);
end;
end;
end;
10:
begin
if TObject(xNode.Data) is T3DSide then
begin
xSide := T3DSide(xNode.Data);
if xSide.FWallType = fwtInner then
begin
ModelTree.Select(xNode, [ssCtrl]);
SelNodes.Add(xNode);
end;
end;
end;
11:
begin
if TObject(xNode.Data) is T3DSide then
begin
xSide := T3DSide(xNode.Data);
if xSide.FWallType = fwtOuter then
begin
ModelTree.Select(xNode, [ssCtrl]);
SelNodes.Add(xNode);
end;
end;
end;
12:
begin
if TObject(xNode.Data) is T3DSObject then
begin
xObject := T3DSObject(xNode.Data);
ModelTree.Select(xNode, [ssCtrl]);
SelNodes.Add(xNode);
end;
end;
end;
end;
OnSelectNodes(SelNodes);
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.FindSelectNodesByType', E.Message);
end;
end;
procedure Tfrm3D.FindSelectScsNodesByType(aType: Integer);
var
i: integer;
xModelNode, xNode: TTreeNode;
xNodes, xScsObjects, SelNodes: TList;
xConn: T3DConnector;
xLine: T3DLine;
begin
try
ScsModelTree.Items.BeginUpdate;
try
xNodes := TList.Create;
xModelNode := ScsModelTree.Items.GetFirstNode;
xNode := xModelNode.getFirstChild;
while xNode <> nil do
begin
if xNode.Text = cbScsLists.Text then
break;
xNode := xNode.GetNextSibling;
end;
xNodes.Add(xNode);
xScsObjects := GetAllSidesNodesByNodes(xNodes);
FreeAndNil(xNodes);
SelNodes := TList.Create;
for i := 0 to xScsObjects.Count - 1 do
begin
xNode := TTreeNode(xScsObjects[i]);
case aType of
1:
begin
if TObject(xNode.Data) is T3DConnector then
begin
xConn := T3DConnector(xNode.Data);
ScsModelTree.Select(xNode, [ssCtrl]);
SelNodes.Add(xNode);
end;
end;
2:
begin
if TObject(xNode.Data) is T3DLine then
begin
xLine := T3DLine(xNode.Data);
if xLine.FLineType = lt_Line then
begin
ScsModelTree.Select(xNode, [ssCtrl]);
SelNodes.Add(xNode);
end;
end;
end;
3:
begin
if TObject(xNode.Data) is T3DLine then
begin
xLine := T3DLine(xNode.Data);
if xLine.FLineType = lt_Raise then
begin
ScsModelTree.Select(xNode, [ssCtrl]);
SelNodes.Add(xNode);
end;
end;
end;
4:
begin
if TObject(xNode.Data) is T3DLine then
begin
xLine := T3DLine(xNode.Data);
if xLine.FLineType = lt_FloorRaise then
begin
ScsModelTree.Select(xNode, [ssCtrl]);
SelNodes.Add(xNode);
end;
end;
end;
end;
end;
OnSelectNodes(SelNodes);
finally
ScsModelTree.Items.EndUpdate;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.FindSelectScsNodesByType', E.Message);
end;
end;
procedure Tfrm3D.ChangeTextureScale;
var
i: integer;
xObject: T3DSide;
xGLObject: TGLBaseSceneObject;
Bmp: TBitmap;
begin
try
if edTextureScale.Text = '' then
exit;
for i := 0 to FPropObjects.Count - 1 do
begin
if TOBject(TTreeNode(FPropObjects[i]).Data) is T3DSide then
begin
xObject := T3DSide(TTreeNode(FPropObjects[i]).Data);
xGLObject := TGLBaseSceneObject(xObject.FGLObject);
xObject.FTextureScale := StrToInt(edTextureScale.Text);
if (xGLObject is TGLMesh) then
begin
RotateTextureToAngleM(xObject, TGLMesh(xGLObject), xObject.FTextureRotate, xObject.FMirror);
end;
if (xGLObject is TGLPolygon) then
begin
RotateTextureToAngleP(xObject, TGLPolygon(xGLObject), xObject.FTextureRotate, xObject.FMirror);
end;
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.ChangeTextureScale', E.Message);
end;
end;
procedure Tfrm3D.edTextureScaleExit(Sender: TObject);
begin
ChangeTextureScale;
end;
procedure Tfrm3D.edTextureScaleKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
ChangeTextureScale;
end;
function Tfrm3D.is3DSObject(aObj: TGLBaseSceneObject): Boolean;
var
xNode: TTreeNode;
xObject: TObject;
Obj: TGLBaseSceneObject;
begin
try
Result := False;
xNode := TTreeNode(aObj.tagObject);
Obj := GlsceneViewer.Buffer.GetPickedobject(mx, my);
if TObject(xNode.Data) is T3DSObject then
begin
Result := True;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.is3DSObject', E.Message);
end;
end;
function Tfrm3D.GetDistAngle(AP1, AP2: TDoublePoint): Double;
var
Len_X, Len_Y: Double;
AngleRad: Double;
AddAngle: Double;
begin
Result := 0;
try
Len_X := Abs(AP1.x - AP2.x);
Len_Y := Abs(AP1.y - AP2.y);
// ïðîâåðêè è âû÷èëåíèå óãëà â ãðàäóñàõ
AddAngle := 0;
AngleRad := 0;
// äëÿ íåîðòîãîíàëüíûõ ëèíèé
if (AP1.x < AP2.x) and (AP1.y < AP2.y) then // 1
begin
AngleRad := ArcTan2(Len_X, Len_Y); // óãîë â ðàäèàíàõ
AddAngle := 0;
end;
if (AP1.x < AP2.x) and (AP1.y > AP2.y) then //4
begin
AngleRad := ArcTan2(Len_Y, Len_X); // óãîë â ðàäèàíàõ
AddAngle := 90;
end;
if (AP1.x > AP2.x) and (AP1.y > AP2.y) then //3
begin
AngleRad := ArcTan2(Len_X, Len_Y); // óãîë â ðàäèàíàõ
AddAngle := 180;
end;
if (AP1.x > Ap2.x) and (AP1.y < AP2.y) then //2
begin
AngleRad := ArcTan2(Len_Y, Len_X); // óãîë â ðàäèàíàõ
AddAngle := 270;
end;
Result := Round(AngleRad * 180 / pi) + AddAngle;
// äëÿ îðòîãîíàëüíûõ ëèíèé
if (AP1.y = AP2.y) and (AP1.x < AP2.x) then
Result := 90;
if (AP1.y = AP2.y) and (AP1.x > AP2.x) then
Result := 270;
if (AP1.x = AP2.x) and (AP1.y < AP2.y) then
Result := 0;
if (AP1.x = AP2.x) and (AP1.y > AP2.y) then
Result := 180;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.GetDistAngle', E.Message);
end;
end;
procedure Tfrm3D.UndoCutSides;
var
i, j, cnt: Integer;
xGLSide1, xGLSide2: TGLPolygon;
xNodeSide1, xNodeSide2, xNodeParentSide: TTreeNode;
xSide1, xSide2, xParentSide: T3DSide;
xSideNode, xSubSideNode: TTreeNode;
xGLObject, xGLSubObject: TGLBaseSceneObject;
ZOrder: Double;
begin
try
xGLSide1 := FResizeData.Side1;
xGLSide2 := FResizeData.Side2;
xNodeSide1 := TTreeNode(xGLSide1.TagObject);
xNodeSide2 := TTreeNode(xGLSide2.TagObject);
xSide1 := T3DSide(xNodeSide1.Data);
xSide2 := T3DSide(xNodeSide2.Data);
xParentSide := T3DSide(xSide1.FParent);
xNodeParentSide := xNodeSide1.Parent;
// delete Side2
DummyCube.Remove(xGLSide2, True);
xNodeSide2.Delete;
xParentSide.FSubSides.Remove(xSide2);
// backup params to Side1
cnt := Length(FResizeData.BasisNodes);
xGLSide1.Nodes.Clear;
SetLength(xSide1.FGLPoints, cnt);
SetLength(xSide1.FPoints, cnt);
ZOrder := xSide1.FZOrder;
for i := 0 to cnt - 1 do
begin
xGLSide1.AddNode(FResizeData.BasisNodes[i].x, FResizeData.BasisNodes[i].y, FResizeData.BasisNodes[i].z);
xSide1.FGLPoints[i].x := FResizeData.BasisNodes[i].x;
xSide1.FGLPoints[i].y := FResizeData.BasisNodes[i].y - ZOrder;
xSide1.FGLPoints[i].z := FResizeData.BasisNodes[i].z;
xSide1.FPoints[i].x := xSide1.FGLPoints[i].x / Factor;
xSide1.FPoints[i].z := xSide1.FGLPoints[i].y / Factor;
xSide1.FPoints[i].y := xSide1.FGLPoints[i].z / Factor;
end;
// if Side1 is single SubSide
if (xParentSide.FSubSides.Count = 1) and (xNodeParentSide.Count = 1) then
begin
xNodeSide1.Delete;
xParentSide.FSubSides.Remove(xSide1);
xParentSide.FGLObject := xGLSide1;
xGLSide1.TagObject := xNodeParentSide;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.UndoCutSides', E.Message);
end;
end;
procedure Tfrm3D.cbObjectHashsPropertiesCloseUp(Sender: TObject);
var
i, Index: Integer;
xObject: T3DSObject;
xGLObject: TGLFreeForm;
tmpdir, tmpfname, ExtStr, BmpFName: string;
HashStr: string;
begin
try
Index := cbObjectHashs.ItemIndex;
if Index >= 0 then
begin
HashStr := cbObjectHashs.Properties.Items[Index];
tmpdir := GetWorkDir; // ExtractDirByCategoryType(dctPictures);
tmpfname := GetImageFileByHash(HashStr);
ExtStr := ExtractFileExt(tmpfname);
if tmpfname <> '' then
begin
imgObjectTexture.Picture.LoadFromFile(tmpfname);
for i := 0 to FPropObjects.Count - 1 do
begin
if TObject(TTreeNode(FPropObjects[i]).Data) is T3DSObject then
begin
xObject := T3DSObject(TTreeNode(FPropObjects[i]).Data);
xGLObject := TGLFreeForm(xObject.FGLObject);
xObject.FTextureHash := HashStr;
xObject.FTexture_ext := ExtStr;
try
xGLObject.Material.Texture.Image.LoadFromFile(tmpfname);
except
ShowMessage('File not found ' + tmpfname);
end;
//xGLObject.Material.Texture.MappingMode := tmmCubeMapCamera;
end;
end;
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.cbObjectHashsPropertiesCloseUp', E.Message);
end;
end;
procedure Tfrm3D.bObjectTextureClearClick(Sender: TObject);
var
FName: string;
i: integer;
xObject: T3DSObject;
xGLObject: TGLFreeForm;
begin
try
imgObjectTexture.Clear;
for i := 0 to FPropObjects.Count - 1 do
begin
if TOBject(TTreeNode(FPropObjects[i]).Data) is T3DSObject then
begin
xObject := T3DSObject(TTreeNode(FPropObjects[i]).Data);
xGLObject := TGLFreeForm(xObject.FGLObject);
xObject.FTextureHash := '';
xObject.FTexture_ext := '';
//xGLObject.Material.Texture.Disabled := True;
//xGLObject.Material.Texture.Disabled := False;
//xGLObject.Material.MaterialOptions := [];
xGLObject.Material.Texture.DestroyHandles;
FName := GetObjectFileByHash(xObject.FObjectHash);
if FName <> '' then
begin
xGLObject.MaterialLibrary := MatLib;
xGLObject.DeleteChildren;
xGLObject.LoadFromFile(FName);
end;
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.bObjectTextureClearClick', E.Message);
end;
end;
procedure Tfrm3D.bObjectTextureChangeClick(Sender: TObject);
var
i: integer;
FName: string;
xObject: T3DSObject;
xGLObject: TGLFreeForm;
tmpdir, tmpfname, ExtStr, BmpFName: string;
Bmp: TBitmap;
Jpeg: TJPEGImage;
HashStr: string;
begin
try
FName := LoadTexture;
if (FName <> '') and FileExists(FName) then
begin
imgObjectTexture.Picture.LoadFromFile(FName);
ExtStr := ExtractFileExt(FName);
tmpdir := GetWorkDir; // ExtractDirByCategoryType(dctPictures);
// ïîëó÷àåì HASH ïî çàãðóæàåìîìó ôàéëó
HashStr := GetImageHash(FName);
// ïî HASH èùåì åñòü ëè îí â íàøåé áàçå
tmpfname := GetImageFileByHash(HashStr);
// åñëè íàéäåí, òî ãðóçèì åãî
if tmpfname <> '' then
begin
end
else
// íå íàéäåí - ñîçäàåì äëÿ ôàéëà HASH, êîïèðóåì â òåìï, ãðóçèì
begin
F3DModel.FHashs.Add(HashStr);
tmpfname := tmpdir + '\' + HashStr + '.bmp';
if (ExtStr = '.jpg') or (ExtStr = '.jpeg') then
begin
Bmp := TBitmap.Create;
Jpeg := TJPEGImage.Create;
jpeg.CompressionQuality := 100; {Default Value}
Jpeg.LoadFromFile(FName);
Bmp.Assign(Jpeg);
Bmp.SaveTofile(tmpfname);
FreeAndNil(Bmp);
FreeAndNil(Jpeg);
end
else
CopyFile(PChar(FName), PChar(tmpfname), True);
end;
for i := 0 to FPropObjects.Count - 1 do
begin
if TObject(TTreeNode(FPropObjects[i]).Data) is T3DSObject then
begin
xObject := T3DSObject(TTreeNode(FPropObjects[i]).Data);
xGLObject := TGLFreeForm(xObject.FGLObject);
xObject.FTextureHash := HashStr;
xObject.FTexture_ext := ExtStr;
xGLObject.MaterialLibrary := nil;
//xGLObject.Material.Texture.Disabled := False;
//xGLObject.Material.MaterialOptions := [];
xGLObject.Material.Texture.DestroyHandles;
try
xGLObject.Material.Texture.Image.LoadFromFile(tmpfname);
except
ShowMessage('File not found ' + tmpfname);
end;
//xGLObject.Material.Texture.MappingMode := tmmCubeMapCamera;
end;
end;
// Resfresh HASHs
cbObjectHashs.Properties.Items.Clear;
for i := 0 to F3DModel.FHashs.Count - 1 do
begin
cbObjectHashs.Properties.Items.Add(F3DModel.FHashs.Strings[i]);
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.bObjectTextureChangeClick', E.Message);
end;
end;
procedure Tfrm3D.MatLibTextureNeeded(Sender: TObject; var textureFileName: String);
var
tmpdir, fname, textfname, tmpfname, HashStr: string;
i, j, xIndex: Integer;
src_3ds_dir: string;
dir_texture: string;
xStr: string;
templist: TStringList;
begin
try
textfname := textureFileName;
tmpdir := GetWorkDir;
dir_texture := tmpdir;
if length(dir_texture) > 1 then
begin
if dir_texture[length(dir_texture)] <> '\' then
dir_texture := dir_texture + '\';
end;
if MatLib.TexturePaths <> dir_texture then
MatLib.TexturePaths := dir_texture;
// Íà ñîçäàíèè 3ÄÑ
if FisCreate3DS then
begin
src_3ds_dir := ExtractFilePath(Open3DObject.FileName);
if length(src_3ds_dir) > 1 then
begin
if src_3ds_dir[length(src_3ds_dir)] <> '\' then
src_3ds_dir := src_3ds_dir + '\';
end;
//templist := TStringList.Create;
//templist.LoadFromFile('c:\imgs.txt');
//if templist.IndexOf(Open3DObject.FileName + '\' + textureFileName) = -1 then
//begin
// templist.Add(Open3DObject.FileName + '\' + textureFileName);
// templist.SaveToFile('c:\imgs.txt');
//end;
//templist.Free;
fname := src_3ds_dir + textureFileName;
if FileExists(fname) then
begin
textureFileName := textfname;
// tmpdir := GetWorkDir; // ExtractDirByCategoryType(dctPictures);
// ïîëó÷àåì HASH ïî çàãðóæàåìîìó ôàéëó
FName := src_3ds_dir + textfname;
HashStr := GetImageHash(FName) + ExtractFileExt(FName);
// ïî HASH èùåì åñòü ëè îí â íàøåé áàçå
tmpfname := GetTextureFileByHash(HashStr);
if tmpfname = '' then
begin
tmpfname := tmpdir + '\' + HashStr;
CopyFile(PChar(FName), PChar(tmpfname), True);
if FCurrObject is T3DSObject then
xStr := 'c:\' + T3DSObject(FCurrObject).FObjectHash + '\' + textfname
else
if FCurrObject is T3DConnector then
xStr := 'c:\' + T3DConnector(FCurrObject).FObjectHash + '\' + textfname;
if F3DModel.FFiles.IndexOf(xStr) = -1 then
begin
F3DModel.FFiles.Add(xStr);
j := F3DModel.FFiles.IndexOf(xStr);
while F3DModel.FFilesHashs.Count - 1 < j do
F3DModel.FFilesHashs.Add('');
F3DModel.FFilesHashs[j] := HashStr;
end
else
begin
j := F3DModel.FFiles.IndexOf(xStr);
while F3DModel.FFilesHashs.Count - 1 < j do
F3DModel.FFilesHashs.Add('');
F3DModel.FFilesHashs[j] := HashStr;
end
end
else
begin
if FCurrObject is T3DSObject then
xStr := 'c:\' + T3DSObject(FCurrObject).FObjectHash + '\' + textfname
else
if FCurrObject is T3DConnector then
xStr := 'c:\' + T3DConnector(FCurrObject).FObjectHash + '\' + textfname;
j := F3DModel.FFiles.IndexOf(xStr);
if j < 0 then
begin
F3DModel.FFiles.Add(xStr);
j := F3DModel.FFiles.IndexOf(xStr);
while F3DModel.FFilesHashs.Count - 1 < j do
F3DModel.FFilesHashs.Add('');
F3DModel.FFilesHashs[j] := HashStr;
end
else
begin
if F3DModel.FFilesHashs[j] <> HashStr then
begin
// Âîîáùå òî òàêîãî íå äîëæíî áû ïðîèñõîäèòü - íî íà âñÿê ñëó÷àé:
HashStr := HashStr;
F3DModel.FFiles.Add(xStr);
j := F3DModel.FFiles.IndexOf(xStr);
while F3DModel.FFilesHashs.Count - 1 < j do
F3DModel.FFilesHashs.Add('');
F3DModel.FFilesHashs[j] := HashStr;
end;
end;
end;
if not FileExists(tmpdir + '\' + HashStr) then
begin
tmpfname := tmpdir + '\' + HashStr;
CopyFile(PChar(FName), PChar(tmpfname), True);
end;
textureFileName := HashStr;
end
else
begin
if Not FileExists(dir_texture + 'empty.bmp') then
CopyFile(PChar(ExeDir + '\3DTextures\empty.bmp'), PChar(dir_texture + 'empty.bmp'), True);
if FileExists(dir_texture + 'empty.bmp') then
textureFileName := 'empty.bmp'
else
textureFileName := '';
end;
end
else
// Íà ïîäíÿòèè 3ÄÑ
begin
if FCurrObject is T3DSObject then
begin
xStr := 'c:\' + T3DSObject(FCurrObject).FObjectHash + '\' + textfname;
end
else if FCurrObject is T3DConnector then
begin
xStr := 'c:\' + T3DConnector(FCurrObject).FObjectHash + '\' + textfname;
end;
xIndex := F3DModel.FFiles.IndexOf(xStr);
if xIndex <> - 1 then
begin
tmpfname := F3DModel.FFilesHashs[xIndex];
fname := tmpdir + '\' + tmpfname;
if FileExists(fname) then
begin
textureFileName := tmpfname;
end
else
begin
if Not FileExists(dir_texture + 'empty.bmp') then
CopyFile(PChar(ExeDir + '\3DTextures\empty.bmp'), PChar(dir_texture + 'empty.bmp'), True);
if FileExists(dir_texture + 'empty.bmp') then
textureFileName := 'empty.bmp'
else
textureFileName := '';
end;
end
else
begin
if Not FileExists(dir_texture + 'empty.bmp') then
CopyFile(PChar(ExeDir + '\3DTextures\empty.bmp'), PChar(dir_texture + 'empty.bmp'), True);
if FileExists(dir_texture + 'empty.bmp') then
textureFileName := 'empty.bmp'
else
textureFileName := '';
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.MatLibTextureNeeded', E.Message);
end;
end;
{TODO} // Ãëÿíóòü ãäå èñïîëüçóåòñÿ è Ñðàâíèòü ñ UP3
// OK
(*
procedure Tfrm3D.SetFreeFormRotate(aObject: TGLFreeForm; aX, aY, aZ: Double);
var
vect31: TVector3f;
oldroll: single;
begin
try
oldroll := aObject.RollAngle;
aObject.ResetRotations;
GLSceneViewer.Camera.TransformationChanged;
vect31[0] := 1;
vect31[1] := 0;
vect31[2] := 0;
aObject.RotateAbsolute(vect31, aX);
vect31[0] := 0;
vect31[1] := 1;
vect31[2] := 0;
aObject.RotateAbsolute(vect31, aY);
vect31[0] := 0;
vect31[1] := 0;
vect31[2] := 1;
aObject.RotateAbsolute(vect31, aZ);
//aObject.RollAngle := oldroll;
//edX.Text := FloatToStr(glObject.Direction.x);
//edY.Text := FloatToStr(glObject.Direction.y);
//edZ.Text := FloatToStr(glObject.Direction.z);
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.SetFreeFormRotate', E.Message);
end;
end;
*)
(*
procedure Tfrm3D.ResetFreeFormRotate(aObject: TGLFreeForm);
begin
try
aObject.ResetRotations;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.ResetFreeFormRotate', E.Message);
end;
end;
*)
procedure Tfrm3D.pcTreeTabClick(Sender: TObject);
begin
if pcTree.ActivePage = TabArchModel then
begin
pcProps.ActivePage := TabArchProps;
end;
if pcTree.ActivePage = TabScsModel then
begin
pcProps.ActivePage := TabScsProps;
end;
end;
procedure Tfrm3D.cbScsListsPropertiesCloseUp(Sender: TObject);
begin
try
cbScsObjectsTypes.ItemIndex := 0;
ScsModelTree.ClearSelection;
DeselectGLObjects;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.cbScsListsPropertiesCloseUp', E.Message);
end;
end;
procedure Tfrm3D.cbScsObjectsTypesPropertiesCloseUp(Sender: TObject);
begin
try
ScsModelTree.ClearSelection;
if cbScsObjectsTypes.ItemIndex = 0 then
begin
DeselectGLObjects;
end
else
begin
FindSelectScsNodesByType(cbScsObjectsTypes.ItemIndex);
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.cbScsObjectsTypesPropertiesCloseUp', E.Message);
end;
end;
procedure Tfrm3D.ScsModelTreeMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
i: Integer;
xNode: TTreeNode;
begin
{
if (Button = mbRight) then
begin
if ScsModelTree.SelectionCount = 1 then
begin
xNode := ScsModelTree.Selections[0];
if (TObject(xNode.Data) is T3DConnector) then
begin
pmScsModelTree.Items[0].Visible := False;
pmScsModelTree.Popup(X, Y);
end;
if (TObject(xNode.Data) is T3DLine) then
begin
pmScsModelTree.Items[0].Visible := False;
pmScsModelTree.Popup(X, Y);
end;
end;
end;
}
end;
procedure Tfrm3D.ScsModelTreeClick(Sender: TObject);
var
i: Integer;
xNode: TTreeNode;
xNodes: TList;
ClearSelected: boolean;
LineExists: Boolean;
ControlList: TList;
begin
try
LineExists := false; //20.12.2011
if ScsModelTree.Selected <> nil then
begin
ClearSelected := False;
for i := 0 to ScsModelTree.SelectionCount - 1 do
begin
xNode := ScsModelTree.Selections[i];
if TObject(xNode.Data).ClassName <> TObject(ScsModelTree.Selected.Data).ClassName then
ClearSelected := True;
if TObject(xNode.Data).ClassName = T3DLine.ClassName then
LineExists := true;
end;
if ClearSelected then
begin
xNode := ScsModelTree.Selected;
ScsModelTree.ClearSelection;
xNode.Selected := True;
end;
xNodes := TList.create;
for i := 0 to ScsModelTree.SelectionCount - 1 do
begin
xNode := ScsModelTree.Selections[i];
xNodes.Add(xNode);
end;
OnSelectNodes(xNodes);
end;
ControlList := TList.Create;
ControlList.Add(lbScsLength);
ControlList.Add(edScsLength);
ControlList.Add(lbScsLineX2);
ControlList.Add(lbScsLineY2);
ControlList.Add(lbScsLineZ2);
ControlList.Add(lbScsLine2);
ControlList.Add(edScsLineX2);
ControlList.Add(edScsLineY2);
ControlList.Add(edScsLineZ2);
for i := 0 to ControlList.Count - 1 do
TControl(ControlList[i]).Visible := LineExists;
ControlList.Free;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.ScsModelTreeClick', E.Message);
end;
end;
function Tfrm3D.LoadPropertiesForSingleConn(aObject: TTreeNode): TPropRecord;
var
i: integer;
xObject: T3DConnector;
xGLObject, xGLObject1: TGLBaseSceneObject;
tmpdir, tmpfname: string;
begin
try
xObject := T3DConnector(aObject.Data);
xGLObject := TGLBaseSceneObject(xObject.FGLObject);
xGLObject1 := TGLBaseSceneObject(xObject.FGLObject1);
edScsName.Text := xObject.FName;
edScsIndex.Text := IntToStr(xObject.FIndex);
mScsDesc.Clear;
for i := 0 to xObject.FDescription.Count - 1 do
mScsDesc.Lines.Add(xObject.FDescription[i]);
mScsCaption.Clear;
for i := 0 to xObject.FCaptions.Count - 1 do
mScsCaption.Lines.Add(xObject.FCaptions[i]);
mScsNote.Clear;
for i := 0 to xObject.FNotes.Count - 1 do
mScsNote.Lines.Add(xObject.FNotes[i]);
edScsOffsetX.Text := FloatToStr(xObject.FOffset.x * Factor);
edScsOffsetY.Text := FloatToStr(xObject.FOffset.z * Factor);
edScsOffsetZ.Text := FloatToStr(xObject.FOffset.y * Factor);
edScsAngleX.Text := FloatToStr(xObject.FRotate.x);
edScsAngleY.Text := FloatToStr(xObject.FRotate.y);
edScsAngleZ.Text := FloatToStr(xObject.FRotate.z);
edScsScaleX.Text := FloatToStr(xObject.FScale.x);
edScsScaleY.Text := FloatToStr(xObject.FScale.y);
edScsScaleZ.Text := FloatToStr(xObject.FScale.z);
edScsConnX.Text := FormatFloat(ffMask, xObject.FPoint.x);
edScsConnY.Text := FormatFloat(ffMask, xObject.FPoint.y);
edScsConnZ.Text := FormatFloat(ffMask, xObject.FPoint.z);
{
imgScsObjectTexture.Clear;
tmpfname := GetImageFileByHash(xObject.FTextureHash);
if tmpfname <> '' then
imgScsObjectTexture.Picture.LoadFromFile(tmpfname);
cbScsObjectHashs.Properties.Items.Clear;
for i := 0 to F3DModel.FHashs.Count - 1 do
begin
cbScsObjectHashs.Properties.Items.Add(F3DModel.FHashs.Strings[i]);
end;
}
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.LoadPropertiesForSingleConn', E.Message);
end;
end;
function Tfrm3D.LoadPropertiesForMultiConn(aObjects: TList): TPropRecord;
var
i: integer;
xObject: T3DConnector;
xGLObject, xGLObject1: TGLBaseSceneObject;
Points: T3DPointArray;
Cnt: Integer;
xPosX, xPosY, xPosZ, xAngleX, xAngleY, xAngleZ, xScaleX, xScaleY, xScaleZ, xCoordX, xCoordY, xCoordZ: Double;
begin
try
mScsDesc.Clear;
mScsCaption.Clear;
mScsNote.Clear;
for i := 0 to aObjects.Count - 1 do
begin
xObject := T3DConnector(TTreeNode(aObjects[i]).Data);
xGLObject := TGLBaseSceneObject(xObject.FGLObject);
xGLObject1 := TGLBaseSceneObject(xObject.FGLObject1);
if i = 0 then
begin
xPosX := xObject.FOffset.x * Factor;
edScsOffsetX.Text := FloatToStr(xPosX);
xPosY := xObject.FOffset.z * Factor;
edScsOffsetY.Text := FloatToStr(xPosY);
xPosZ := xObject.FOffset.y * Factor;
edScsOffsetZ.Text := FloatToStr(xPosZ);
xAngleX := xObject.FRotate.x;
edScsAngleX.Text := FloatToStr(xAngleX);
xAngleY := xObject.FRotate.y;
edScsAngleY.Text := FloatToStr(xAngleY);
xAngleZ := xObject.FRotate.z;
edScsAngleZ.Text := FloatToStr(xAngleZ);
xScaleX := xObject.FScale.x;
edScsScaleX.Text := FloatToStr(xScaleX);
xScaleY := xObject.FScale.y;
edScsScaleY.Text := FloatToStr(xScaleY);
xScaleZ := xObject.FScale.z;
edScsScaleZ.Text := FloatToStr(xScaleZ);
xCoordX := xObject.FPoint.x;
edScsConnX.Text := FormatFloat(ffMask, xCoordX);
xCoordY := xObject.FPoint.y;
edScsConnY.Text := FormatFloat(ffMask, xCoordY);
xCoordZ := xObject.FPoint.z;
edScsConnZ.Text := FormatFloat(ffMask, xCoordZ);
end
else
begin
if edScsOffsetX.Text <> '' then
if xPosX <> xObject.FOffset.x * Factor then
edScsOffsetX.Text := '';
if edScsOffsetY.Text <> '' then
if xPosY <> xObject.FOffset.z * Factor then
edScsOffsetY.Text := '';
if edScsOffsetZ.Text <> '' then
if xPosZ <> xObject.FOffset.y * Factor then
edScsOffsetZ.Text := '';
if edScsAngleX.Text <> '' then
if xAngleX <> xObject.FRotate.x then
edScsAngleX.Text := '';
if edScsAngleY.Text <> '' then
if xAngleY <> xObject.FRotate.y then
edScsAngleY.Text := '';
if edScsAngleZ.Text <> '' then
if xAngleZ <> xObject.FRotate.z then
edScsAngleZ.Text := '';
if edScsScaleX.Text <> '' then
if xScaleX <> xObject.FScale.x then
edScsScaleX.Text := '';
if edScsScaleY.Text <> '' then
if xScaleY <> xObject.FScale.y then
edScsScaleY.Text := '';
if edScsScaleZ.Text <> '' then
if xScaleZ <> xObject.FScale.z then
edScsScaleZ.Text := '';
if edScsConnX.Text <> '' then
if xCoordX <> xObject.FPoint.x then
edScsConnX.Text := '';
if edScsConnY.Text <> '' then
if xCoordY <> xObject.FPoint.y then
edScsConnY.Text := '';
if edScsConnZ.Text <> '' then
if xCoordZ <> xObject.FPoint.z then
edScsConnZ.Text := '';
end;
end;
{
imgScsObjectTexture.Clear;
cbScsObjectHashs.Properties.Items.Clear;
for i := 0 to F3DModel.FHashs.Count - 1 do
begin
cbSCSObjectHashs.Properties.Items.Add(F3DModel.FHashs.Strings[i]);
end;
}
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.LoadPropertiesForMultiConn', E.Message);
end;
end;
function Tfrm3D.LoadPropertiesForSingleLine(aObject: TTreeNode): TPropRecord;
var
i: integer;
xObject: T3DLine;
xGLObject: TGLBaseSceneObject;
tmpdir, tmpfname: string;
begin
try
xObject := T3DLine(aObject.Data);
xGLObject := TGLBaseSceneObject(xObject.FGLObject);
edScsName.Text := xObject.FName;
edScsIndex.Text := IntToStr(xObject.FIndex);
mScsDesc.Clear;
for i := 0 to xObject.FDescription.Count - 1 do
mScsDesc.Lines.Add(xObject.FDescription[i]);
mScsCaption.Clear;
for i := 0 to xObject.FCaptions.Count - 1 do
mScsCaption.Lines.Add(xObject.FCaptions[i]);
mScsNote.Clear;
for i := 0 to xObject.FNotes.Count - 1 do
mScsNote.Lines.Add(xObject.FNotes[i]);
edScsLength.Text := FormatFloat(ffMask, xObject.FLength);
edScsLineX1.Text := FormatFloat(ffMask, xObject.FPoint1.x);
edScsLineY1.Text := FormatFloat(ffMask, xObject.FPoint1.y);
edScsLineZ1.Text := FormatFloat(ffMask, xObject.FPoint1.z);
edScsLineX2.Text := FormatFloat(ffMask, xObject.FPoint2.x);
edScsLineY2.Text := FormatFloat(ffMask, xObject.FPoint2.y);
edScsLineZ2.Text := FormatFloat(ffMask, xObject.FPoint2.z);
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.LoadPropertiesForSingleLine', E.Message);
end;
end;
function Tfrm3D.LoadPropertiesForMultiLine(aObjects: TList): TPropRecord;
var
i: integer;
xObject: T3DLine;
xGLObject: TGLBaseSceneObject;
Points: T3DPointArray;
Cnt: Integer;
xCoordX1, xCoordY1, xCoordZ1, xCoordX2, xCoordY2, xCoordZ2, xLen: Double;
begin
try
mScsDesc.Clear;
mScsCaption.Clear;
mScsNote.Clear;
for i := 0 to aObjects.Count - 1 do
begin
xObject := T3DLine(TTreeNode(aObjects[i]).Data);
xGLObject := TGLBaseSceneObject(xObject.FGLObject);
if i = 0 then
begin
xLen := xObject.FLength;
edScsLength.Text := FormatFloat(ffMask, xLen);
xCoordX1 := xObject.FPoint1.x;
edScsLineX1.Text := FormatFloat(ffMask, xCoordX1);
xCoordY1 := xObject.FPoint1.y;
edScsLineY1.Text := FormatFloat(ffMask, xCoordY1);
xCoordZ1 := xObject.FPoint1.z;
edScsLineZ1.Text := FormatFloat(ffMask, xCoordZ1);
xCoordX2 := xObject.FPoint2.x;
edScsLineX2.Text := FormatFloat(ffMask, xCoordX2);
xCoordY2 := xObject.FPoint2.y;
edScsLineY2.Text := FormatFloat(ffMask, xCoordY2);
xCoordZ2 := xObject.FPoint2.z;
edScsLineZ2.Text := FormatFloat(ffMask, xCoordZ2);
end
else
begin
if edScsLength.Text <> '' then
if xLen <> xObject.FLength then
edScsLength.Text := '';
if edScsLineX1.Text <> '' then
if xCoordX1 <> xObject.FPoint1.x then
edScsLineX1.Text := '';
if edScsLineY1.Text <> '' then
if xCoordY1 <> xObject.FPoint1.y then
edScsLineY1.Text := '';
if edScsLineZ1.Text <> '' then
if xCoordZ1 <> xObject.FPoint1.z then
edScsLineZ1.Text := '';
if edScsLineX2.Text <> '' then
if xCoordX2 <> xObject.FPoint2.x then
edScsLineX2.Text := '';
if edScsLineY2.Text <> '' then
if xCoordY2 <> xObject.FPoint2.y then
edScsLineY2.Text := '';
if edScsLineZ2.Text <> '' then
if xCoordZ2 <> xObject.FPoint2.z then
edScsLineZ2.Text := '';
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.LoadPropertiesForMultiLine', E.Message);
end;
end;
procedure Tfrm3D.bScsLoadModelClick(Sender: TObject);
var
i, j: integer;
FName: string;
xNode, xSubNode: TTreeNode;
xConn: T3DConnector;
glObject: TGLFreeForm;
PrevObjectMin, PrevObjectMax, ObjectMin, ObjectMax, PrevObjSize, ObjSize, SetPos, Scale: T3DPoint;
SetScale: Double;
tmpdir, tmpfname: string;
HashStr: string;
begin
try
Open3DObject.InitialDir := ExeDir + '\3DModels';
NoMoveEvent := True;
if Open3DObject.Execute then
begin
//todo - íà ïîäíÿòèè ïîäìåíÿåòñÿ íà òåêóùèé savedir!
// ýòî ìîæíî íå äåëàòü!
//tmpdir := AddCreateDirToPath(ExtractFileDir(Application.ExeName), dnSave);
//CopyFile(PChar(Open3DObject.FileName), PChar(tmpdir + '\' + ExtractFileName(Open3DObject.FileName)), True);
//if FileExists(tmpdir + '\' + ExtractFileName(Open3DObject.FileName)) then
// FName := tmpdir + '\' + ExtractFileName(Open3DObject.FileName)
//else
FName := Open3DObject.FileName;
tmpdir := GetWorkDir; // ExtractDirByCategoryType(dctPictures);
// MARK
// ïîëó÷àåì HASH ïî çàãðóæàåìîìó ôàéëó
HashStr := GetObjectHash(FName);
// ïî HASH èùåì åñòü ëè îí â íàøåé áàçå
tmpfname := GetObjectFileByHash(HashStr);
// åñëè íàéäåí, òî ãðóçèì åãî
if tmpfname <> '' then
begin
end
else
// íå íàéäåí - ñîçäàåì äëÿ ôàéëà HASH, êîïèðóåì â òåìï, ãðóçèì
begin
F3DModel.F3DSHashs.Add(HashStr);
tmpfname := tmpdir + '\' + HashStr + '.3ds';
CopyFile(PChar(FName), PChar(tmpfname), True);
end;
// MARK
BeginProgress('Èäåò çàãðóçêà 3ds îáúåêòà ...'); // ***
for j := 0 to FPropObjects.Count - 1 do
begin
xConn := T3DConnector(TTreeNode(FPropObjects[j]).Data);
glObject := TGLFreeForm(xConn.FGLObject1);
glObject.Material.Texture.Disabled := False;
glObject.MaterialLibrary := MatLib;
// FTextures.Clear;
FisCreate3DS := True;
FCurrObject := xConn;
Get3DSObjectBounds(PrevObjectMin, PrevObjectMax, glObject);
PrevObjSize.x := abs(PrevObjectMax.x - PrevObjectMin.x);
PrevObjSize.y := abs(PrevObjectMax.y - PrevObjectMin.y);
PrevObjSize.z := abs(PrevObjectMax.z - PrevObjectMin.z);
xConn.FObjectHash := HashStr;
//glObject.LoadFromFile(FName);
glObject.LoadFromFile(tmpfname);
{TODO - ïåðåïðîâåðèòü - âîçìîæíî è íóæíî ýòî äåëàòü! }
//for i := 0 to MatLib.Materials.Count - 1 do
// MatLib.Materials[i].Material.Texture.MappingMode := tmmCubeMapCamera;
Get3DSObjectBounds(ObjectMin, ObjectMax, glObject);
ObjSize.x := abs(ObjectMax.x - ObjectMin.x);
ObjSize.y := abs(ObjectMax.y - ObjectMin.y);
ObjSize.z := abs(ObjectMax.z - ObjectMin.z);
SetPos.x := xConn.FGLPoint.x + xConn.FOffset.x / Factor;
SetPos.y := xConn.FGLPoint.y + xConn.FOffset.z / Factor + FDeltaZFloor;
SetPos.z := xConn.FGLPoint.z + xConn.FOffset.y / Factor;
Scale.X := PrevObjSize.x / ObjSize.x * glObject.Scale.x;
Scale.Y := PrevObjSize.y / ObjSize.y * glObject.Scale.y;
Scale.Z := PrevObjSize.z / ObjSize.z * glObject.Scale.z;
glObject.Position.x := SetPos.x;
glObject.Position.y := SetPos.y;
glObject.Position.z := SetPos.z;
SetScale := MinFloat(Scale.X, Scale.Y, Scale.Z);
glObject.Scale.X := SetScale;
glObject.Scale.Y := SetScale;
glObject.Scale.Z := SetScale;
RotateConnModel(glObject, xConn.FRotate.x, xConn.FRotate.y, xConn.FRotate.z);
if glObject.Material.Texture.Disabled then
begin
glObject.Material.FrontProperties.Ambient.Color := xConn.FColor;
glObject.Material.FrontProperties.Diffuse.Color := xConn.FColor;
glObject.Material.FrontProperties.Emission.Color := xConn.FColor;
glObject.Material.BackProperties.Ambient.Color := xConn.FColor;
glObject.Material.BackProperties.Diffuse.Color := xConn.FColor;
glObject.Material.BackProperties.Emission.Color := xConn.FColor;
end;
//glObject.Material.Texture.MappingMode := tmmCubeMapCamera;
//// glObject.BuildOctree; oi?iica
//glObject.Material.MaterialOptions := [moNoLighting];
glObject.Material.MaterialOptions := [];
glObject.Material.Texture.Disabled := False;
//xConn.FZOrder := 1;
// çäåñü íåëüçÿ òàê äåëàòü! FName ïî èäåè äîëæíî óæå èñïîëüçîâàòüñÿ äëÿ äðóãèõ öåëåé!
//xConn.FName := FName;
xConn.FScale.x := glObject.Scale.X;
xConn.FScale.y := glObject.Scale.Y;
xConn.FScale.z := glObject.Scale.Z;
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.bScsLoadModelClick', E.Message);
end;
EndProgress;
end;
function Tfrm3D.isConnectorObject(aObj: TGLBaseSceneObject; aCmpObj: TGLBaseSceneObject = nil): Boolean;
var
xNode: TTreeNode;
xObject: TObject;
Obj, Obj1: TGLBaseSceneObject;
begin
try
Result := False;
xNode := TTreeNode(aObj.tagObject);
Obj := GlsceneViewer.Buffer.GetPickedobject(mx, my);
if TObject(xNode.Data) is T3DConnector then
begin
if T3DConnector(xNode.Data).FConnType = ct_Full then
begin
Obj1 := TGLBaseSceneObject(T3DConnector(xNode.Data).FGLObject1);
if aCmpObj = nil then
Result := True
else if Obj1 = aCmpObj then
Result := True;
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.isConnectorObject', E.Message);
end;
end;
procedure Tfrm3D.DoScale3dsObject(aWheelDelta: Integer);
var
i, j: integer;
glObject, glObject1: TGLFreeForm;
pScale: Double;
begin
try
pScale := 0.1; // 10%
pScale := aWheelDelta / 120 * pScale;
glObject := TGLFreeForm(FSelection[0]);
if aWheelDelta < 0 then
begin
if glObject.Scale.X >= 0.01 then
begin
glObject.Scale.X := glObject.Scale.X + glObject.Scale.X * pScale;
glObject.Scale.Y := glObject.Scale.Y + glObject.Scale.Y * pScale;
glObject.Scale.Z := glObject.Scale.Z + glObject.Scale.Z * pScale;
end;
end
else
begin
glObject.Scale.X := glObject.Scale.X + glObject.Scale.X * pScale;
glObject.Scale.Y := glObject.Scale.Y + glObject.Scale.Y * pScale;
glObject.Scale.Z := glObject.Scale.Z + glObject.Scale.Z * pScale;
end;
edScaleX.Text := FloatToStr(glObject.Scale.X);
edScaleY.Text := FloatToStr(glObject.Scale.Y);
edScaleZ.Text := FloatToStr(glObject.Scale.Z);
T3DSObject(TTreeNode(glObject.TagObject).Data).FScale := DoublePoint(glObject.Scale.X, glObject.Scale.Y, glObject.Scale.Z);
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.DoScale3dsObject', E.Message);
end;
end;
procedure Tfrm3D.DoScaleConnectorObjects(aWheelDelta: Integer);
var
i, j: integer;
glObject: TGLBaseSceneObject;
glObject1: TGLFreeForm;
pScale: Double;
xConn: T3DConnector;
begin
try
pScale := 0.1; // 10%
pScale := aWheelDelta / 120 * pScale;
for i := 0 to FSelection.Count - 1 do
begin
glObject := TGLFreeForm(FSelection[i]);
if TObject(TTreeNode(glObject.tagObject).Data) is T3DConnector then
begin
xConn := T3DConnector(TTreeNode(glObject.tagObject).Data);
if xConn.FConnType <> ct_Empty then
begin
glObject1 := TGLFreeForm(xConn.FGLObject1);
if aWheelDelta < 0 then
begin
if glObject1.Scale.X >= 0.01 then
begin
glObject1.Scale.X := glObject1.Scale.X + glObject1.Scale.X * pScale;
glObject1.Scale.Y := glObject1.Scale.Y + glObject1.Scale.Y * pScale;
glObject1.Scale.Z := glObject1.Scale.Z + glObject1.Scale.Z * pScale;
end;
end
else
begin
glObject1.Scale.X := glObject1.Scale.X + glObject1.Scale.X * pScale;
glObject1.Scale.Y := glObject1.Scale.Y + glObject1.Scale.Y * pScale;
glObject1.Scale.Z := glObject1.Scale.Z + glObject1.Scale.Z * pScale;
end;
xConn.FScale := DoublePoint(glObject1.Scale.X, glObject1.Scale.Y, glObject1.Scale.Z);
//if FSelection.Count = 1 then
begin
edScsScaleX.Text := FloatToStr(glObject1.Scale.X);
edScsScaleY.Text := FloatToStr(glObject1.Scale.Y);
edScsScaleZ.Text := FloatToStr(glObject1.Scale.Z);
end;
end;
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.DoScaleConnectorObjects', E.Message);
end;
end;
procedure Tfrm3D.DoRotate3dsObject(Shift: TShiftState; X, Y: Integer);
var
glObject: TGLFreeForm;
xObject: T3DSObject;
Camera: TGLCamera;
AngX, AngY, AngZ: Double;
mult: integer;
VC: TVector4f;
dx, dy : Integer;
VX, VY: TVector;
begin
try
glObject := FRotatedObject;
Camera := GLSceneViewer.Camera;
dx := mx - x;
dy := my - y;
VY := VectorMake(VectorPerpendicular(YVector, VectorNormalize(Camera.Position.AsAffineVector)));
VX := VectorCrossProduct(VY, VectorNormalize(Camera.Position.AsVector));
NormalizeVector(VY);
NormalizeVector(VX);
VC := VectorCombine(VX, VY, -dx * 0.132 * Camera.DistanceToTarget / Camera.FocalLength, dy * 0.132 * Camera.DistanceToTarget / Camera.FocalLength);
if abs(x - last_x) >= 10 then
begin
if Not (ssCtrl in Shift) then
begin
mult := 1;
if VC[0] < 0 then
mult := -1;
if (ssShift in Shift) then
edAngleY.Text := FloatToStr(StrToFloat_My(edAngleY.Text) - 1 * mult)
else
edAngleY.Text := FloatToStr(StrToFloat_My(edAngleY.Text) - 15 * mult);
last_x := x;
last_y := y;
end
else
begin
mult := 1;
if VC[2] < 0 then
mult := -1;
if (ssShift in Shift) then
edAngleX.Text := FloatToStr(StrToFloat_My(edAngleX.Text) - 1 * mult)
else
edAngleX.Text := FloatToStr(StrToFloat_My(edAngleX.Text) - 15 * mult);
end;
last_x := x;
last_y := y;
Rotate3DSObj(glObject, StrToFloat_My(edAngleX.Text), StrToFloat_My(edAngleY.Text), StrToFloat_My(edAngleZ.Text));
end;
if abs(y - last_y) >= 10 then
begin
if Not (ssCtrl in Shift) then
begin
mult := 1;
if VC[0] > 0 then
mult := -1;
if (ssShift in Shift) then
edAngleZ.Text := FloatToStr(StrToFloat_My(edAngleZ.Text) - 1 * mult)
else
edAngleZ.Text := FloatToStr(StrToFloat_My(edAngleZ.Text) - 15 * mult);
end
else
begin
mult := 1;
if VC[2] < 0 then
mult := -1;
if (ssShift in Shift) then
edAngleX.Text := FloatToStr(StrToFloat_My(edAngleX.Text) - 1 * mult)
else
edAngleX.Text := FloatToStr(StrToFloat_My(edAngleX.Text) - 15 * mult);
end;
last_x := x;
last_y := y;
Rotate3DSObj(glObject, StrToFloat_My(edAngleX.Text), StrToFloat_My(edAngleY.Text), StrToFloat_My(edAngleZ.Text));
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.DoRotate3dsObject', E.Message);
end;
end;
procedure Tfrm3D.DoRotateConnectorObjects(Shift: TShiftState; X, Y: Integer);
var
i, j: integer;
glObject: TGLBaseSceneObject;
glObject1: TGLFreeForm;
Camera: TGLCamera;
xConn: T3DConnector;
AngX, AngY, AngZ: Double;
mult: integer;
VC: TVector4f;
dx, dy : Integer;
VX, VY: TVector;
begin
try
Camera := GLSceneViewer.Camera;
dx := mx - x;
dy := my - y;
VY := VectorMake(VectorPerpendicular(YVector, VectorNormalize(Camera.Position.AsAffineVector)));
VX := VectorCrossProduct(VY, VectorNormalize(Camera.Position.AsVector));
NormalizeVector(VY);
NormalizeVector(VX);
VC := VectorCombine(VX, VY, -dx * 0.132 * Camera.DistanceToTarget / Camera.FocalLength, dy * 0.132 * Camera.DistanceToTarget / Camera.FocalLength);
for i := 0 to FSelection.Count - 1 do
begin
glObject := TGLFreeForm(FSelection[i]);
if TObject(TTreeNode(glObject.tagObject).Data) is T3DConnector then
begin
xConn := T3DConnector(TTreeNode(glObject.tagObject).Data);
if xConn.FConnType <> ct_Empty then
begin
glObject1 := TGLFreeForm(xConn.FGLObject1);
if abs(x - last_x) >= 10 then
begin
if Not (ssCtrl in Shift) then
begin
mult := 1;
if VC[0] < 0 then
mult := -1;
if (ssShift in Shift) then
edScsAngleY.Text := FloatToStr(StrToFloat_My(edScsAngleY.Text) - 1 * mult)
else
edScsAngleY.Text := FloatToStr(StrToFloat_My(edScsAngleY.Text) - 15 * mult);
last_x := x;
last_y := y;
end
else
begin
mult := 1;
if VC[2] < 0 then
mult := -1;
if (ssShift in Shift) then
edScsAngleX.Text := FloatToStr(StrToFloat_My(edScsAngleX.Text) - 1 * mult)
else
edScsAngleX.Text := FloatToStr(StrToFloat_My(edScsAngleX.Text) - 15 * mult);
end;
last_x := x;
last_y := y;
RotateConnModel(glObject1, StrToFloat_My(edScsAngleX.Text), StrToFloat_My(edScsAngleY.Text), StrToFloat_My(edScsAngleZ.Text));
end;
if abs(y - last_y) >= 10 then
begin
if Not (ssCtrl in Shift) then
begin
mult := 1;
if VC[0] > 0 then
mult := -1;
if (ssShift in Shift) then
edScsAngleZ.Text := FloatToStr(StrToFloat_My(edScsAngleZ.Text) - 1 * mult)
else
edScsAngleZ.Text := FloatToStr(StrToFloat_My(edScsAngleZ.Text) - 15 * mult);
end
else
begin
mult := 1;
if VC[2] < 0 then
mult := -1;
if (ssShift in Shift) then
edScsAngleX.Text := FloatToStr(StrToFloat_My(edScsAngleX.Text) - 1 * mult)
else
edScsAngleX.Text := FloatToStr(StrToFloat_My(edScsAngleX.Text) - 15 * mult);
end;
last_x := x;
last_y := y;
RotateConnModel(glObject1, StrToFloat_My(edScsAngleX.Text), StrToFloat_My(edScsAngleY.Text), StrToFloat_My(edScsAngleZ.Text));
end;
end;
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.DoRotateConnectorObjects', E.Message);
end;
end;
function Tfrm3D.isLineObject(aObj: TGLBaseSceneObject; aCmpObj: TGLBaseSceneObject = nil): Boolean;
var
xNode: TTreeNode;
xObject: TObject;
Obj: TGLBaseSceneObject;
begin
try
Result := False;
xNode := TTreeNode(aObj.tagObject);
Obj := GlsceneViewer.Buffer.GetPickedobject(mx, my);
if (TObject(xNode.Data) is T3DLine){or(TObject(xNode.Data) is T3DWall)or(TObject(xNode.Data) is T3DCorner)} then
begin
if aCmpObj = nil then
Result := True
else if aObj = aCmpObj then
Result := True;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.isLineObject', E.Message);
end;
end;
procedure Tfrm3D.Move3DConnectorEvent(aObj: TGLBaseSceneObject);
var
xConn: T3DConnector;
dp: T3DPoint;
xGLCaption: TGLSpaceText;
xGLObject: TGLPipe;
begin
try
// Full Connector
if aObj is TGLFreeForm then
begin
xConn := T3DConnector(TTreeNode(aObj.tagObject).Data);
end;
// Empty Connector
if aObj is TGLCube then
begin
xConn := T3DConnector(aObj.tagObject);
end;
if xConn.FConnType = ct_Full then
begin
dp.x := aObj.Position.X - MovedStartPos.x;
dp.y := aObj.Position.Y - MovedStartPos.y;
dp.z := aObj.Position.Z - MovedStartPos.z;
end
else
begin
dp.x := aObj.Position.X - MovedStartPos.x;
dp.y := aObj.Position.Y - MovedStartPos.y;
dp.z := aObj.Position.Z - MovedStartPos.z;
end;
Move3DConnector(xConn, dp, true);
FMovedObjectsList.Clear;
if xConn.FConnType = ct_Full then
begin
edScsConnX.Text := FormatFloat(ffMask, xConn.FPoint.x);
edScsConnY.Text := FormatFloat(ffMask, xConn.FPoint.y);
edScsConnZ.Text := FormatFloat(ffMask, xConn.FPoint.z);
end
else
begin
if FSelection.Count = 1 then
LoadPropertiesForSingleLine(ScsModelTree.Selected);
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.Move3DConnector', E.Message);
end;
end;
procedure Tfrm3D.Move3DLineEvent(aObj: TGLBaseSceneObject);
var
xLine: T3DLine;
xGLLine: TGLLines;
cp, dp1, dp2: T3DPoint;
xGLCaption: TGLSpaceText;
JoinConn1, JoinConn2: T3DConnector;
begin
try
xGLLine := TGLLines(aObj);
if TObject(TTreeNode(aObj.tagObject).Data) is T3DLine then
begin
xLine := T3DLine(TTreeNode(aObj.tagObject).Data);
dp1.x := xGLLine.Nodes[0].X - MovedStartPos1.x;
dp1.y := xGLLine.Nodes[0].Y - MovedStartPos1.y;
dp1.z := xGLLine.Nodes[0].Z - MovedStartPos1.z;
dp2.x := xGLLine.Nodes[1].X - MovedStartPos2.x;
dp2.y := xGLLine.Nodes[1].Y - MovedStartPos2.y;
dp2.z := xGLLine.Nodes[1].Z - MovedStartPos2.z;
if xLine.FJoinConnector1.FJoinedConnectorsList.Count = 0 then
JoinConn1 := xLine.FJoinConnector1
else
JoinConn1 := T3DConnector(xLine.FJoinConnector1.FJoinedConnectorsList[0]);
if xLine.FJoinConnector2.FJoinedConnectorsList.Count = 0 then
JoinConn2 := xLine.FJoinConnector2
else
JoinConn2 := T3DConnector(xLine.FJoinConnector2.FJoinedConnectorsList[0]);
if xLine.FJoinConnector1 <> nil then
Move3DConnector(JoinConn1, dp1);
if xLine.FJoinConnector2 <> nil then
Move3DConnector(JoinConn2, dp2);
FMovedObjectsList.Clear;
edScsLineX1.Text := FormatFloat(ffMask, xLine.FPoint1.x);
edScsLineY1.Text := FormatFloat(ffMask, xLine.FPoint1.y);
edScsLineZ1.Text := FormatFloat(ffMask, xLine.FPoint1.z);
edScsLineX2.Text := FormatFloat(ffMask, xLine.FPoint2.x);
edScsLineY2.Text := FormatFloat(ffMask, xLine.FPoint2.y);
edScsLineZ2.Text := FormatFloat(ffMask, xLine.FPoint2.z);
end;
{$IF Defined(ES_GRAPH_SC)}
if (TObject(TTreeNode(aObj.tagObject).Data) is T3DWall)or(TObject(TTreeNode(aObj.tagObject).Data) is T3DCorner) then
begin
//Ïåðåìåùåíèå â ïðîñòðàíñòâå ïðèëÿãàþùèõ ñòîðîí è òî÷åê, åñëè ýòî êðûøà :))))
if IfFiguraIsRoof(T3droom(ttreenode(aObj.tagObject).parent.data).FSCSCompon) then
ChangeAllFiguresConnectedToModifyLine(xGLLine);
end;
{$IFEND}
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.Move3DLine', E.Message);
end;
end;
procedure Tfrm3D.ApplyCutting;
begin
if FToolMode <> tmSelect then
begin
FToolMode := tmSelect;
glSpliter.Visible := False;
glCubeSpliter.Visible := False;
glCubeSpliter1.Visible := False;
glCubeSpliter2.Visible := False;
glSide11.Visible := False;
glSide12.Visible := False;
glSide21.Visible := False;
glSide22.Visible := False;
GLSceneViewer.Cursor := crDefault;
DeleteNodesObjects;
RefreshSidesPoints;
end;
end;
procedure Tfrm3D.ApplyScsModel;
var
i, j, k: integer;
dp: T3DPoint;
xConn: T3DConnector;
xLine, xAddLine: T3DLine;
xScsConn, xGetScsConn: TConnectorObject;
xScsLine, xScsAddLine: TOrthoLine;
xCadForm: TF_CAD;
begin
try
BeginProgress('Èäåò ïðèìåíåíèå ÑÊÑ ìîäåëè ...');
// APPLY DIV TRACES
for i := 0 to F3DModel.FScsObjects.Count - 1 do
begin
// Connector Object
if TObject(F3DModel.FScsObjects[i]) is T3DConnector then
begin
xConn := T3DConnector(F3DModel.FScsObjects[i]);
xScsConn := xConn.FSCSObject;
// SCS Object NOT Exist
if xScsConn = nil then
begin
// Empty and Not Connected Connector
if (xConn.FConnType = ct_Empty) and (xConn.FJoinedConnectorsList.Count = 0) then
begin
if xConn.FListID <> FCAD.FCADListID then
begin
xCadForm := GetListByID(xConn.FListID);
FCAD := xCadForm;
end;
// Get Trace which was Div
xLine := T3DLine(xConn.FJoinedLinesList[0]);
if xLine.FSCSObject <> nil then
begin
// Div on Scs
xScsConn := DivideLineSimple(xLine.FSCSObject);
// Joined
xConn.FSCSObject := xScsConn;
xScsConn.F3DObject := xConn;
// Get Trace which Add By Div
for j := 0 to xScsConn.JoinedOrtholinesList.Count - 1 do
begin
xScsAddLine := TOrthoLine(xScsConn.JoinedOrtholinesList[j]);
// This line
if xScsAddLine.F3DObject = nil then
begin
xAddLine := T3DLine(xConn.FJoinedLinesList[1]);
xAddLine.FSCSObject := xScsAddLine;
xScsAddLine.F3DObject := xAddLine;
end;
end;
end;
end;
end;
end;
end;
// APPLY MOVES
GMoveWithRaise := False;
for i := 0 to F3DModel.FScsObjects.Count - 1 do
begin
// Connector Object
if TObject(F3DModel.FScsObjects[i]) is T3DConnector then
begin
xConn := T3DConnector(F3DModel.FScsObjects[i]);
xScsConn := xConn.FSCSObject;
// SCS Object Exist
if xScsConn <> nil then
begin
// Not Connected Connector
if (xConn.FConnType = ct_Full) or (xConn.FJoinedConnectorsList.Count = 0) then
begin
if xConn.FListID <> FCAD.FCADListID then
begin
xCadForm := GetListByID(xConn.FListID);
FCAD := xCadForm;
end;
dp.x := Round4(xConn.FPoint.x - xScsConn.ActualPoints[1].x);
dp.y := Round4(xConn.FPoint.y - xScsConn.ActualPoints[1].y);
xScsConn.MoveConnector(dp.x, dp.y, false, false);
if not G3DModelForProject then
begin
GMoveWithRaise := True;
xScsConn.MoveBetweenRaiseConnector(dp.x, dp.y); // !!!
GMoveWithRaise := False;
end;
{TODO ZCoord}
xScsConn.ActualZOrder[1] := Round4(xConn.FPoint.z);
//xScsConn.ActualZOrder[1] := UOMToMetre(Round4(xConn.FPoint.z)); // NEW
xScsConn.MoveConnector(0, 0, false, false, false); // ÄËß ÏÅÐÅÑ×ÅÒÀ ÄËÈÍÛ È ÇÀÏÈÑÈ Â ÐÌ
SetConFigureCoordZInPM(xScsConn.ID, xScsConn.ActualZOrder[1]);
// ZOrder Connected Conns
if xScsConn.ConnectorType <> ct_Clear then
begin
for j := 0 to xScsConn.JoinedConnectorsList.Count - 1 do
begin
xGetScsConn := TConnectorObject(xScsConn.JoinedConnectorsList[j]);
if not G3DModelForProject then
begin
GMoveWithRaise := True;
xGetScsConn.MoveBetweenRaiseConnector(dp.x, dp.y); // !!!
GMoveWithRaise := False;
end;
{TODO ZCoord}
xGetScsConn.ActualZOrder[1] := xScsConn.ActualZOrder[1];
// xGetScsConn.ActualZOrder[1] := UOMToMetre(xScsConn.ActualZOrder[1]); // NEW
xGetScsConn.MoveConnector(0, 0, false, false, false); // ÄËß ÏÅÐÅÑ×ÅÒÀ ÄËÈÍÛ È ÇÀÏÈÑÈ Â ÐÌ
SetConFigureCoordZInPM(xGetScsConn.ID, xGetScsConn.ActualZOrder[1]);
end;
end;
end;
end;
end;
// Line Object
if TObject(F3DModel.FScsObjects[i]) is T3DLine then
begin
xLine := T3DLine(F3DModel.FScsObjects[i]);
{TODO ZCoord}
//xLine.FSCSObject.ActualZOrder[0] := UOMToMetre(xLine.FSCSObject.ActualZOrder[0]); // new
//xLine.FSCSObject.ActualZOrder[1] := UOMToMetre(xLine.FSCSObject.ActualZOrder[1]); // new
//xLine.FSCSObject.ActualZOrder[2] := UOMToMetre(xLine.FSCSObject.ActualZOrder[2]); // new
xScsLine := xLine.FSCSObject;
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.ApplyScsModel', E.Message);
end;
//UpdateAllTracesLengthAndRefreshTextBoxOnAllLists;
GMoveWithRaise := True;
EndProgress;
end;
procedure Tfrm3D.ValidateActiveControl;
begin
//
end;
procedure Tfrm3D.sbApplyScsModelClick(Sender: TObject);
begin
ApplyScsModel;
end;
procedure Tfrm3D.nDivLineClick(Sender: TObject);
var
cp, cp1, p1, p2: T3DPoint;
xGLLine, xGLAddLine: TGLLines;
xGLConn: TGLPipe;
xLine, xAddLine: T3DLine;
xConn, JoinConn1, JoinConn2: T3DConnector;
xParentNode, xLineNode, xAddLineNode, xConnNode: TTreeNode;
xGLCaption, xGLAddCaption: TGLSpaceText;
begin
try
xGLLine := TGLLines(FSelection[0]);
cp := GetPointToDivTrace(mx, my, xGLLine);
p1.x := xGLLine.Nodes[0].X;
p1.y := xGLLine.Nodes[0].Y;
p1.z := xGLLine.Nodes[0].Z;
p2.x := xGLLine.Nodes[1].X;
p2.y := xGLLine.Nodes[1].Y;
p2.z := xGLLine.Nodes[1].Z;
xLineNode := TTreeNode(xGLLine.tagObject);
xParentNode := xLineNode.Parent;
xLine := T3DLine(xLineNode.Data);
JoinConn1 := xLine.FJoinConnector1;
JoinConn2 := xLine.FJoinConnector2;
xGLLine.Nodes[1].X := cp.x;
xGLLine.Nodes[1].Y := cp.y;
xGLLine.Nodes[1].Z := cp.z;
xLine.FGLPoint2.x := xGLLine.Nodes[1].X;
xLine.FGLPoint2.y := xGLLine.Nodes[1].Y - xLine.FZOrder;
xLine.FGLPoint2.z := xGLLine.Nodes[1].Z;
xLine.FPoint2.x := xLine.FGLPoint2.x / Factor;
xLine.FPoint2.z := xLine.FGLPoint2.y / Factor;
xLine.FPoint2.y := xLine.FGLPoint2.z / Factor;
if xLine.FGLCaption <> nil then
begin
cp1.x := (xGLLine.Nodes[0].X + xGLLine.Nodes[1].X) / 2;
cp1.y := (xGLLine.Nodes[0].Y + xGLLine.Nodes[1].Y) / 2;
cp1.z := (xGLLine.Nodes[0].Z + xGLLine.Nodes[1].Z) / 2;
if abs(xGLLine.Nodes[0].Y - xGLLine.Nodes[1].Y) < 0.0001 then
cp1.y := cp1.y + 2 * factor
else
cp1.y := cp1.y - 2 * factor;
xGLCaption := TGLSpaceText(xLine.FGLCaption);
xGLCaption.Position.x := cp1.x;
xGLCaption.Position.y := cp1.y;
xGLCaption.Position.z := cp1.z;
end;
DeselectGLObjects;
// Add Line ****************************************************************
xGLAddLine := TGLLines(DummyCube.AddNewChild(TGLLines));
xGLAddLine.AddNode(cp.x, cp.y, cp.z);
xGLAddLine.AddNode(p2.x, p2.y, p2.z);
xGLAddLine.LineColor := xGLLine.LineColor;
xGLAddLine.LineWidth := xGLLine.LineWidth;
xGLAddLine.NodesAspect := xGLLine.NodesAspect;
xGLAddLine.NodeColor := xGLLine.NodeColor;
xAddLine := T3DLine.Create(nil, nil, xLine.FParent);
xAddLine.FLineType := xLine.FLineType;
xAddLine.FName := xLine.FName;
xAddLine.FZOrder := xLine.FZOrder;
xAddLine.FGLPoint1.x := xGLAddLine.Nodes[0].X;
xAddLine.FGLPoint1.y := xGLAddLine.Nodes[0].Y - xAddLine.FZOrder;
xAddLine.FGLPoint1.z := xGLAddLine.Nodes[0].Z;
xAddLine.FGLPoint2.x := xGLAddLine.Nodes[1].X;
xAddLine.FGLPoint2.y := xGLAddLine.Nodes[1].Y - xAddLine.FZOrder;
xAddLine.FGLPoint2.z := xGLAddLine.Nodes[1].Z;
xAddLine.FPoint1.x := xAddLine.FGLPoint1.x / Factor;
xAddLine.FPoint1.z := xAddLine.FGLPoint1.y / Factor;
xAddLine.FPoint1.y := xAddLine.FGLPoint1.z / Factor;
xAddLine.FPoint2.x := xAddLine.FGLPoint2.x / Factor;
xAddLine.FPoint2.z := xAddLine.FGLPoint2.y / Factor;
xAddLine.FPoint2.y := xAddLine.FGLPoint2.z / Factor;
xAddLine.FGLObject := xGLAddLine;
F3DModel.FScsObjects.Add(xAddLine);
xGLAddCaption := TGLSpaceText(DummyCube.AddNewChild(TGLSpaceText));
xGLAddCaption.Text := xAddLine.FName;
xGLAddCaption.Scale.X := 0.4;
xGLAddCaption.Scale.y := 0.4;
xGLAddCaption.Scale.z := 0.4;
xGLAddCaption.Extrusion := 0.05;
xGLAddCaption.Font.Color := clRed;
xGLAddCaption.Material.FrontProperties.Diffuse.Color := clrRed;
xGLAddCaption.Material.BackProperties.Diffuse.Color := clrRed;
xAddLine.FGLCaption := xGLAddCaption;
cp1.x := (xGLAddLine.Nodes[0].X + xGLAddLine.Nodes[1].X) / 2;
cp1.y := (xGLAddLine.Nodes[0].Y + xGLAddLine.Nodes[1].Y) / 2;
cp1.z := (xGLAddLine.Nodes[0].Z + xGLAddLine.Nodes[1].Z) / 2;
if abs(xGLAddLine.Nodes[0].Y - xGLAddLine.Nodes[1].Y) < 0.0001 then
cp1.y := cp1.y + 2 * factor
else
cp1.y := cp1.y - 2 * factor;
xGLAddCaption.Position.x := cp1.x;
xGLAddCaption.Position.y := cp1.y;
xGLAddCaption.Position.z := cp1.z;
xAddLineNode := ScsModelTree.Items.AddChild(xParentNode, xLine.FName);
xAddLineNode.Data := xAddLine;
xAddLineNode.ImageIndex := 2;
xAddLineNode.SelectedIndex := xAddLineNode.ImageIndex;
//xAddLine.FFace.FTreeNode := xAddLineNode;
xGLAddLine.TagObject := xAddLineNode;
// Add Line ****************************************************************
// Add Div Conn ************************************************************
xGLConn := TGLPipe(DummyCube.AddNewChild(TGLPipe));
xGLConn.AddNode(cp.x, cp.y, cp.z);
xConn := T3DConnector.Create(nil, nil, xLine.FParent);
xConn.FConnType := ct_Empty;
xConn.FName := cCadClasses_Mes12;
xConn.FZOrder := xLine.FZOrder;
xConn.FGLPoint.x := xGLConn.Nodes[0].X;
xConn.FGLPoint.y := xGLConn.Nodes[0].Y - xConn.FZOrder;
xConn.FGLPoint.z := xGLConn.Nodes[0].Z;
xConn.FPoint.x := xConn.FGLPoint.x / Factor;
{TODO ZCoord}
//xConn.FPoint.z := xConn.FGLPoint.y / Factor / FScaleDelta;
xConn.FPoint.z := xConn.FGLPoint.y / Factor / FScaleDeltaSCS; // NEWNEW
xConn.FPoint.y := xConn.FGLPoint.z / Factor;
xConn.FGLObject := xGLConn;
F3DModel.FScsObjects.Add(xConn);
//xConnNode := ScsModelTree.Items.AddChild(xParentNode, xConn.FName);
//xConnNode.Data := xConn;
//xConnNode.ImageIndex := 3;
//xConn.FFace.FTreeNode := xConnNode;
//xGLConn.TagObject := xConnNode;
// Add Div Conn ************************************************************
xLine.FJoinConnector1 := JoinConn1;
xLine.FJoinConnector2 := xConn;
xAddLine.FJoinConnector1 := xConn;
xAddLine.FJoinConnector2 := JoinConn2;
xConn.FJoinedLinesList.Add(xLine);
xConn.FJoinedLinesList.Add(xAddLine);
JoinConn2.FJoinedLinesList.Remove(xLine);
JoinConn2.FJoinedLinesList.Add(xAddLine);
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.nDivLineClick', E.Message);
end;
end;
function Tfrm3D.GetPointToDivTrace(X, Y: Integer; aLine: TGLLines): T3DPoint;
var
glCursor: TGLCustomSceneObject;
VX, VY: TVector;
Camera: TGLCamera;
begin
try
{
glCursor := TGLCustomSceneObject.Create(GLScene);
Camera := GLSceneViewer.Camera;
VY := VectorMake(VectorPerpendicular(YVector, VectorNormalize(VectorSubtract(Camera.Position.AsAffineVector, MainCenter.Position.AsAffineVector))));
VX := VectorCrossProduct(VY, VectorNormalize( VectorSubtract(Camera.Position.AsVector, MainCenter.Position.AsVector)));
NormalizeVector(VY);
NormalizeVector(VX);
glCursor.Position.Translate(VectorCombine(VX, VY, 0, 0));
}
Result.x := (aLine.Nodes[0].X + aLine.Nodes[1].X) / 2;
Result.y := (aLine.Nodes[0].Y + aLine.Nodes[1].Y) / 2;
Result.z := (aLine.Nodes[0].Z + aLine.Nodes[1].Z) / 2;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.GetPointToDivTrace', E.Message);
end;
end;
procedure Tfrm3D.Move3DConnector(aObj: T3DConnector; dp: T3DPoint; AIsFirstObject: Boolean=false);
var
i, j: integer;
xConn, xConn1, xConn2, xGetConn, xRaiseConn, xObjFromRaise: T3DConnector;
xLine: T3DLine;
pos: T3DPoint;
xGLCaption: TGLSpaceText;
xGLObject: TGLPipe;
xGLObject1: TGLFreeForm;
begin
try
if (dp.x = 0) and (dp.y = 0) and (dp.z = 0) then
exit;
xConn := aObj;
if IsConnectorMoved(xConn) then
exit; // object already moved!
xGLObject := TGLPipe(xConn.FGLObject);
if xConn.FConnType = ct_Full then
begin
xGLObject1 := TGLFreeForm(xConn.FGLObject1);
if FMovedFullConnector = nil then
begin
xGLObject1.Position.X := xGLObject1.Position.X + dp.x;
xGLObject1.Position.Y := xGLObject1.Position.Y + dp.y;
xGLObject1.Position.Z := xGLObject1.Position.Z + dp.z;
end
else //04.01.2012
begin
if Not AIsFirstObject and (xGLObject1 <> nil) then
begin
xGLObject1.Position.X := xGLObject1.Position.X + dp.x;
xGLObject1.Position.Y := xGLObject1.Position.Y + dp.y;
xGLObject1.Position.Z := xGLObject1.Position.Z + dp.z;
end;
end;
end;
xGLObject.Nodes[0].X := xGLObject.Nodes[0].X + dp.x;
xGLObject.Nodes[0].Y := xGLObject.Nodes[0].Y + dp.y;
xGLObject.Nodes[0].Z := xGLObject.Nodes[0].Z + dp.z;
if xConn.FConnType = ct_Empty then
begin
if xConn.FGLObject1 = glConn1 then
begin
glConn1.Position.X := xGLObject.Nodes[0].X;
glConn1.Position.Y := xGLObject.Nodes[0].Y;
glConn1.Position.Z := xGLObject.Nodes[0].Z;
end;
if xConn.FGLObject1 = glConn2 then
begin
glConn2.Position.X := xGLObject.Nodes[0].X;
glConn2.Position.Y := xGLObject.Nodes[0].Y;
glConn2.Position.Z := xGLObject.Nodes[0].Z;
end;
end;
xConn.FGLPoint.x := xGLObject.Nodes[0].X;
xConn.FGLPoint.y := xGLObject.Nodes[0].Y - xConn.FZOrder;
xConn.FGLPoint.z := xGLObject.Nodes[0].Z;
xConn.FPoint.x := xConn.FGLPoint.x / Factor;
{TODO ZCoord}
//xConn.FPoint.z := xConn.FGLPoint.y / Factor / FScaleDelta;
xConn.FPoint.z := xConn.FGLPoint.y / Factor / FScaleDeltaSCS; // NEWNEW
xConn.FPoint.y := xConn.FGLPoint.z / Factor;
if xConn.FGLCaption <> nil then
begin
xGLCaption := TGLSpaceText(xConn.FGLCaption);
xGLCaption.Position.x := xGLCaption.Position.x + dp.x;
xGLCaption.Position.y := xGLCaption.Position.y + dp.y;
xGLCaption.Position.z := xGLCaption.Position.z + dp.z;
end;
FMovedObjectsList.Add(xConn);
// Move Joined Lines *******************************************************
// if empty connector
for i := 0 to xConn.FJoinedLinesList.Count - 1 do
begin
xLine := T3DLine(xConn.FJoinedLinesList[i]);
pos.x := xGLObject.Nodes[0].X;
pos.y := xGLObject.Nodes[0].Y;
pos.z := xGLObject.Nodes[0].Z;
Move3DLine(xConn, xLine, pos);
end;
// if full connector
for i := 0 to xConn.FJoinedConnectorsList.Count - 1 do
begin
xGetConn := T3DConnector(xConn.FJoinedConnectorsList[i]);
for j := 0 to xGetConn.FJoinedLinesList.Count - 1 do
begin
xLine := T3DLine(xGetConn.FJoinedLinesList[j]);
pos.x := xGLObject.Nodes[0].X;
pos.y := xGLObject.Nodes[0].Y;
pos.z := xGLObject.Nodes[0].Z;
Move3DLine(xGetConn, xLine, pos);
end;
end;
// Find and Move Raise or Object base raise
Move3DRaiseConnector(xConn, dp);
// Find and Move Between Floor Raise
if G3DModelForProject then
Move3DBetweenRaiseConnector(xConn, dp);
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.Move3DConnector', E.Message);
end;
end;
function Tfrm3D.Get3DConnectorByConnector(aConn: TConnectorObject): T3DConnector;
var
i: integer;
xConn: T3DConnector;
begin
try
Result := nil;
for i := 0 to F3DModel.FScsObjects.Count - 1 do
begin
if TObject(F3DModel.FScsObjects[i]) is T3DConnector then
begin
xConn := T3DConnector(F3DModel.FScsObjects[i]);
if xConn.FSCSObject = aConn then
begin
Result := xConn;
exit;
end;
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.Get3DConnectorByConnector', E.Message);
end;
end;
function Tfrm3D.Get3DLineByOrtholine(aLine: TOrthoLine): T3DLine;
var
i: integer;
xLine: T3DLine;
begin
try
Result := nil;
for i := 0 to F3DModel.FScsObjects.Count - 1 do
begin
if TObject(F3DModel.FScsObjects[i]) is T3DLine then
begin
xLine := T3DLine(F3DModel.FScsObjects[i]);
if xLine.FSCSObject = aLine then
begin
Result := xLine;
exit;
end;
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.Get3DLineByOrtholine', E.Message);
end;
end;
procedure Tfrm3D.Move3DLine(aObj: T3DConnector; aLine: T3DLine; aPos: T3DPoint);
var
xConn: T3DConnector;
xLine: T3DLine;
xGLLine: TGLLines;
cp: T3DPoint;
xGLCaption: TGLSpaceText;
xLen, Length_X, Length_Y, Length_Z: Double;
begin
try
xConn := aObj;
xLine := aLine;
xGLLine := TGLLines(xLine.FGLObject);
if xConn = xLine.FJoinConnector1 then
begin
xGLLine.Nodes[0].X := aPos.x;
xGLLine.Nodes[0].Y := aPos.y;
xGLLine.Nodes[0].Z := aPos.z;
end;
if xConn = xLine.FJoinConnector2 then
begin
xGLLine.Nodes[1].X := aPos.x;
xGLLine.Nodes[1].Y := aPos.y;
xGLLine.Nodes[1].Z := aPos.z;
end;
xLine.FGLPoint1.x := xGLLine.Nodes[0].X;
xLine.FGLPoint1.y := xGLLine.Nodes[0].Y - xLine.FZOrder;
xLine.FGLPoint1.z := xGLLine.Nodes[0].Z;
xLine.FGLPoint2.x := xGLLine.Nodes[1].X;
xLine.FGLPoint2.y := xGLLine.Nodes[1].Y - xLine.FZOrder;
xLine.FGLPoint2.z := xGLLine.Nodes[1].Z;
xLine.FPoint1.x := xLine.FGLPoint1.x / Factor;
{TODO ZCoord}
//xLine.FPoint1.z := xLine.FGLPoint1.y / Factor / FScaleDelta;
xLine.FPoint1.z := xLine.FGLPoint1.y / Factor / FScaleDeltaSCS; // NEWNEW
xLine.FPoint1.y := xLine.FGLPoint1.z / Factor;
xLine.FPoint2.x := xLine.FGLPoint2.x / Factor;
{TODO ZCoord}
//xLine.FPoint2.z := xLine.FGLPoint2.y / Factor / FScaleDelta;
xLine.FPoint2.z := xLine.FGLPoint2.y / Factor / FScaleDeltaSCS; // NEWNEW
xLine.FPoint2.y := xLine.FGLPoint2.z / Factor;
if xLine.FGLCaption <> nil then
begin
cp.x := (xGLLine.Nodes[0].X + xGLLine.Nodes[1].X) / 2;
cp.y := (xGLLine.Nodes[0].Y + xGLLine.Nodes[1].Y) / 2;
cp.z := (xGLLine.Nodes[0].Z + xGLLine.Nodes[1].Z) / 2;
if abs(xGLLine.Nodes[0].Y - xGLLine.Nodes[1].Y) < 0.0001 then
cp.y := cp.y + 2 * factor
else
cp.y := cp.y - 2 * factor;
xGLCaption := TGLSpaceText(xLine.FGLCaption);
xGLCaption.Position.x := cp.x;
xGLCaption.Position.y := cp.y;
xGLCaption.Position.z := cp.z;
end;
Length_X := (xLine.FPoint1.x - xLine.FPoint2.x) / 1000 * FCAD.PCad.MapScale;
Length_Y := (xLine.FPoint1.y - xLine.FPoint2.y) / 1000 * FCAD.PCad.MapScale;
Length_Z := (xLine.FPoint1.z - xLine.FPoint2.z);
xLen := SQRT(SQR(Length_X) + SQR(Length_Y) + SQR(Length_Z));
xLine.FLength := xLen;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.Move3DLine', E.Message);
end;
end;
function Tfrm3D.IsConnectorMoved(aConn: T3DConnector): Boolean;
var
i: integer;
begin
try
Result := False;
for i := 0 to FMovedObjectsList.Count - 1 do
begin
if T3DConnector(FMovedObjectsList[i]) = aConn then
begin
Result := True;
exit;
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.IsConnectorMoved', E.Message);
end;
end;
procedure Tfrm3D.Trace3DConnector(aObj: TGLBaseSceneObject; dx, dy: Integer);
var
i: integer;
VX, VY: TVector;
Camera: TGLCamera;
VX4, VY4, V4: TVector4f;
glFull: TGLFreeForm;
glEmpty: TGLCube;
dist, dp: T3DPoint;
xStr: string;
xConn: T3DConnector;
xGLLine: TGLLines;
koefcam: Double;
begin
try
Camera := GLSceneViewer.Camera;
GLSceneViewer.Cursor := crHandPoint;
VY := VectorMake(VectorPerpendicular(YVector, VectorNormalize(VectorSubtract(Camera.Position.AsAffineVector, MainCenter.Position.AsAffineVector))));
VX := VectorCrossProduct(VY, VectorNormalize( VectorSubtract(Camera.Position.AsVector, MainCenter.Position.AsVector)));
NormalizeVector(VY);
NormalizeVector(VX);
koefcam := GetKoefMoveCam; //04.01.2012 - 0.132
V4 := VectorCombine(VX, VY, -dx * koefcam * Camera.DistanceToTarget / Camera.FocalLength,
dy * koefcam * Camera.DistanceToTarget / Camera.FocalLength);
glCursorObject.Position.Translate(V4);
dist.x := abs(glCursorObject.Position.X - MovedStartPos.x);
dist.y := abs(glCursorObject.Position.Y - MovedStartPos.y);
dist.z := abs(glCursorObject.Position.Z - MovedStartPos.z);
if aOBj is TGLFreeForm then
begin
glFull := TGLFreeForm(aObj);
if (dist.x >= dist.y) and (dist.x >= dist.z) then
begin
glFull.Position.X := GetPosWithGridStep(glCursorObject.Position.X);
glFull.Position.Y := MovedStartPos.y;
glFull.Position.Z := MovedStartPos.z;
end
else if (dist.y >= dist.x) and (dist.y >= dist.z) then
begin
glFull.Position.X := MovedStartPos.x;
glFull.Position.Y := GetPosWithGridStep(glCursorObject.Position.Y);
glFull.Position.Z := MovedStartPos.z;
end
else if (dist.z >= dist.x) and (dist.z >= dist.y) then
begin
glFull.Position.X := MovedStartPos.x;
glFull.Position.Y := MovedStartPos.y;
glFull.Position.Z := GetPosWithGridStep(glCursorObject.Position.Z);
end;
// *** Move Joined ***
dp.x := glFull.Position.X - MovedStartPos.x;
dp.y := glFull.Position.Y - MovedStartPos.y;
dp.z := glFull.Position.Z - MovedStartPos.z;
for i := 0 to FShadowObjects.Count - 1 do
begin
xGLLine := TGLLines(FShadowObjects[i]);
// Move point 1
if xGLLine.Tag = 1 then
begin
xGLLine.Nodes[0].X := TGLLines(xGLLine.TagObject).Nodes[0].X + dp.x;
xGLLine.Nodes[0].Y := TGLLines(xGLLine.TagObject).Nodes[0].Y + dp.y;
xGLLine.Nodes[0].Z := TGLLines(xGLLine.TagObject).Nodes[0].Z + dp.z;
end;
// Move point 2
if xGLLine.Tag = 2 then
begin
xGLLine.Nodes[1].X := TGLLines(xGLLine.TagObject).Nodes[1].X + dp.x;
xGLLine.Nodes[1].Y := TGLLines(xGLLine.TagObject).Nodes[1].Y + dp.y;
xGLLine.Nodes[1].Z := TGLLines(xGLLine.TagObject).Nodes[1].Z + dp.z;
end;
// Move point 1 and 2 (Raise)
if xGLLine.Tag = 12 then
begin
xGLLine.Nodes[0].X := TGLLines(xGLLine.TagObject).Nodes[0].X + dp.x;
xGLLine.Nodes[0].Y := TGLLines(xGLLine.TagObject).Nodes[0].Y + dp.y;
xGLLine.Nodes[0].Z := TGLLines(xGLLine.TagObject).Nodes[0].Z + dp.z;
xGLLine.Nodes[1].X := TGLLines(xGLLine.TagObject).Nodes[1].X + dp.x;
xGLLine.Nodes[1].Y := TGLLines(xGLLine.TagObject).Nodes[1].Y + 0;
xGLLine.Nodes[1].Z := TGLLines(xGLLine.TagObject).Nodes[1].Z + dp.z;
end;
// Move point 2 and 1 (Raise)
if xGLLine.Tag = 21 then
begin
xGLLine.Nodes[0].X := TGLLines(xGLLine.TagObject).Nodes[0].X + dp.x;
xGLLine.Nodes[0].Y := TGLLines(xGLLine.TagObject).Nodes[0].Y + 0;
xGLLine.Nodes[0].Z := TGLLines(xGLLine.TagObject).Nodes[0].Z + dp.z;
xGLLine.Nodes[1].X := TGLLines(xGLLine.TagObject).Nodes[1].X + dp.x;
xGLLine.Nodes[1].Y := TGLLines(xGLLine.TagObject).Nodes[1].Y + dp.y;
xGLLine.Nodes[1].Z := TGLLines(xGLLine.TagObject).Nodes[1].Z + dp.z;
end;
end;
// *** Move Joined ***
sbView.Caption := GetFullConnectorInfo(glFull);
end;
if aOBj is TGLCube then
begin
glEmpty := TGLCube(aObj);
if (dist.x >= dist.y) and (dist.x >= dist.z) then
begin
glEmpty.Position.X := GetPosWithGridStep(glCursorObject.Position.X);
glEmpty.Position.Y := MovedStartPos.y;
glEmpty.Position.Z := MovedStartPos.z;
end
else if (dist.y >= dist.x) and (dist.y >= dist.z) then
begin
glEmpty.Position.X := MovedStartPos.x;
glEmpty.Position.Y := GetPosWithGridStep(glCursorObject.Position.Y);
glEmpty.Position.Z := MovedStartPos.z;
end
else if (dist.z >= dist.x) and (dist.z >= dist.y) then
begin
glEmpty.Position.X := MovedStartPos.x;
glEmpty.Position.Y := MovedStartPos.y;
glEmpty.Position.Z := GetPosWithGridStep(glCursorObject.Position.Z);
end;
// *** Move Joined ***
dp.x := glEmpty.Position.X - MovedStartPos.x;
dp.y := glEmpty.Position.Y - MovedStartPos.y;
dp.z := glEmpty.Position.Z - MovedStartPos.z;
for i := 0 to FShadowObjects.Count - 1 do
begin
xGLLine := TGLLines(FShadowObjects[i]);
// Move point 1
if xGLLine.Tag = 1 then
begin
xGLLine.Nodes[0].X := TGLLines(xGLLine.TagObject).Nodes[0].X + dp.x;
xGLLine.Nodes[0].Y := TGLLines(xGLLine.TagObject).Nodes[0].Y + dp.y;
xGLLine.Nodes[0].Z := TGLLines(xGLLine.TagObject).Nodes[0].Z + dp.z;
end;
// Move point 2
if xGLLine.Tag = 2 then
begin
xGLLine.Nodes[1].X := TGLLines(xGLLine.TagObject).Nodes[1].X + dp.x;
xGLLine.Nodes[1].Y := TGLLines(xGLLine.TagObject).Nodes[1].Y + dp.y;
xGLLine.Nodes[1].Z := TGLLines(xGLLine.TagObject).Nodes[1].Z + dp.z;
end;
// Move point 1 and 2 (Raise)
if xGLLine.Tag = 12 then
begin
xGLLine.Nodes[0].X := TGLLines(xGLLine.TagObject).Nodes[0].X + dp.x;
xGLLine.Nodes[0].Y := TGLLines(xGLLine.TagObject).Nodes[0].Y + dp.y;
xGLLine.Nodes[0].Z := TGLLines(xGLLine.TagObject).Nodes[0].Z + dp.z;
xGLLine.Nodes[1].X := TGLLines(xGLLine.TagObject).Nodes[1].X + dp.x;
xGLLine.Nodes[1].Y := TGLLines(xGLLine.TagObject).Nodes[1].Y + 0;
xGLLine.Nodes[1].Z := TGLLines(xGLLine.TagObject).Nodes[1].Z + dp.z;
end;
// Move point 2 and 1 (Raise)
if xGLLine.Tag = 21 then
begin
xGLLine.Nodes[0].X := TGLLines(xGLLine.TagObject).Nodes[0].X + dp.x;
xGLLine.Nodes[0].Y := TGLLines(xGLLine.TagObject).Nodes[0].Y + 0;
xGLLine.Nodes[0].Z := TGLLines(xGLLine.TagObject).Nodes[0].Z + dp.z;
xGLLine.Nodes[1].X := TGLLines(xGLLine.TagObject).Nodes[1].X + dp.x;
xGLLine.Nodes[1].Y := TGLLines(xGLLine.TagObject).Nodes[1].Y + dp.y;
xGLLine.Nodes[1].Z := TGLLines(xGLLine.TagObject).Nodes[1].Z + dp.z;
end;
end;
// *** Move Joined ***
sbView.Caption := GetEmptyConnectorInfo(glEmpty);
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.Trace3DConnector', E.Message);
end;
end;
procedure Tfrm3D.Trace3DLine(aObj: TGLBaseSceneObject; dx, dy: Integer);
var
VX, VY: TVector;
Camera: TGLCamera;
VX3, VY3, V3: TVector3f;
glLine: TGLLines;
dist1, dist2: T3DPoint;
LineOrder: TLineOrder;
koefcam: Double;
begin
try
Camera := GLSceneViewer.Camera;
GLSceneViewer.Cursor := crHandPoint;
VY := VectorMake(VectorPerpendicular(YVector, VectorNormalize(VectorSubtract(Camera.Position.AsAffineVector, MainCenter.Position.AsAffineVector))));
VX := VectorCrossProduct(VY, VectorNormalize( VectorSubtract(Camera.Position.AsVector, MainCenter.Position.AsVector)));
NormalizeVector(VY);
NormalizeVector(VX);
VX3[0] := VX[0];
VX3[1] := VX[1];
VX3[2] := VX[2];
VY3[0] := VY[0];
VY3[1] := VY[1];
VY3[2] := VY[2];
koefcam := GetKoefMoveCam; //04.01.2012 - 0.132
V3 := VectorCombine(VX3, VY3, -dx * koefcam * Camera.DistanceToTarget / Camera.FocalLength,
dy * koefcam * Camera.DistanceToTarget / Camera.FocalLength);
glCursorLine.Nodes.Translate(V3);
dist1.x := abs(glCursorLine.Nodes[0].X - MovedStartPos1.x);
dist1.y := abs(glCursorLine.Nodes[0].Y - MovedStartPos1.y);
dist1.z := abs(glCursorLine.Nodes[0].Z - MovedStartPos1.z);
dist2.x := abs(glCursorLine.Nodes[1].X - MovedStartPos2.x);
dist2.y := abs(glCursorLine.Nodes[1].Y - MovedStartPos2.y);
dist2.z := abs(glCursorLine.Nodes[1].Z - MovedStartPos2.z);
glLine := TGLLines(aObj);
LineOrder := GetLineOrder(glLine);
if LineOrder = loNone then
begin
glLine.Nodes[0].X := GetPosWithGridStep(glCursorLine.Nodes[0].X);
glLine.Nodes[0].Y := GetPosWithGridStep(glCursorLine.Nodes[0].Y);
glLine.Nodes[0].Z := GetPosWithGridStep(glCursorLine.Nodes[0].Z);
glLine.Nodes[1].X := GetPosWithGridStep(glCursorLine.Nodes[1].X);
glLine.Nodes[1].Y := GetPosWithGridStep(glCursorLine.Nodes[1].Y);
glLine.Nodes[1].Z := GetPosWithGridStep(glCursorLine.Nodes[1].Z);
end
else if LineOrder = loHorz then
begin
glLine.Nodes[0].X := MovedStartPos1.x;
glLine.Nodes[1].X := MovedStartPos2.x;
if (dist1.y >= dist1.z) then
begin
glLine.Nodes[0].Y := GetPosWithGridStep(glCursorLine.Nodes[0].Y);
glLine.Nodes[1].Y := GetPosWithGridStep(glCursorLine.Nodes[1].Y);
glLine.Nodes[0].Z := MovedStartPos1.z;
glLine.Nodes[1].Z := MovedStartPos2.z;
end
else
begin
glLine.Nodes[0].Y := MovedStartPos1.y;
glLine.Nodes[1].Y := MovedStartPos2.y;
glLine.Nodes[0].Z := GetPosWithGridStep(glCursorLine.Nodes[0].Z);
glLine.Nodes[1].Z := GetPosWithGridStep(glCursorLine.Nodes[1].Z);
end;
end
else if LineOrder = loVert then
begin
glLine.Nodes[0].Z := MovedStartPos1.z;
glLine.Nodes[1].Z := MovedStartPos2.z;
if (dist1.x >= dist1.y) then
begin
glLine.Nodes[0].X := GetPosWithGridStep(glCursorLine.Nodes[0].X);
glLine.Nodes[1].X := GetPosWithGridStep(glCursorLine.Nodes[1].X);
glLine.Nodes[0].Y := MovedStartPos1.y;
glLine.Nodes[1].Y := MovedStartPos2.y;
end
else
begin
glLine.Nodes[0].X := MovedStartPos1.x;
glLine.Nodes[1].X := MovedStartPos2.x;
glLine.Nodes[0].Y := GetPosWithGridStep(glCursorLine.Nodes[0].Y);
glLine.Nodes[1].Y := GetPosWithGridStep(glCursorLine.Nodes[1].Y);
end;
end
else if LineOrder = loRaise then
begin
glLine.Nodes[0].Y := MovedStartPos1.y;
glLine.Nodes[1].Y := MovedStartPos2.y;
if (dist1.x >= dist1.z) then
begin
glLine.Nodes[0].X := GetPosWithGridStep(glCursorLine.Nodes[0].X);
glLine.Nodes[1].X := GetPosWithGridStep(glCursorLine.Nodes[1].X);
glLine.Nodes[0].Z := MovedStartPos1.z;
glLine.Nodes[1].Z := MovedStartPos2.z;
end
else
begin
glLine.Nodes[0].X := MovedStartPos1.x;
glLine.Nodes[1].X := MovedStartPos2.x;
glLine.Nodes[0].Z := GetPosWithGridStep(glCursorLine.Nodes[0].Z);
glLine.Nodes[1].Z := GetPosWithGridStep(glCursorLine.Nodes[1].Z);
end;
end;
sbView.Caption := GetLineInfo(glLine);
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.Trace3DLine', E.Message);
end;
end;
function Tfrm3D.GetLineOrder(aLine: TGLLines): TLineOrder;
var
delta: T3DPoint;
begin
try
Result := loNone;
delta.x := abs(aLine.Nodes[0].X - aLine.Nodes[1].X);
delta.y := abs(aLine.Nodes[0].Y - aLine.Nodes[1].Y);
delta.z := abs(aLine.Nodes[0].Z - aLine.Nodes[1].Z);
// Horizontal (X)
if (delta.y < 0.0001) and (delta.z < 0.0001) then
begin
Result := loHorz;
end
else
// Vertical (Z)
if (delta.x < 0.0001) and (delta.y < 0.0001) then
begin
Result := loVert;
end
else
// Raise (Y)
if (delta.x < 0.0001) and (delta.z < 0.0001) then
begin
Result := loRaise;
end;
except
on E: Exception do AddExceptionToLogEx('', E.Message);
end;
end;
procedure Tfrm3D.Move3DRaiseConnector(aObj: T3DConnector; dp: T3DPoint);
var
i, j: integer;
xConn, xRaiseConn, xObjFromRaise: T3DConnector;
xLine: T3DLine;
xScsRaiseConn, xScsObjFromRaise: TConnectorObject;
begin
try
xConn := aObj;
if (xConn.FConnType <> ct_Empty) or (xConn.FJoinedConnectorsList.Count = 0) then
begin
if xConn.FSCSObject <> nil then
begin
xScsRaiseConn := GetRaiseConn(xConn.FSCSObject);
if xScsRaiseConn <> nil then
begin
xRaiseConn := T3DConnector(xScsRaiseConn.F3DObject);
if xRaiseConn <> nil then
begin
dp.y := 0; // no move by ZOrder
Move3DConnector(xRaiseConn, dp);
end;
end;
// ïîëó÷èòü ÒÎ ïîä ñ-ï
xScsObjFromRaise := xConn.FSCSObject.FObjectFromRaise;
if xScsObjFromRaise <> nil then
begin
xObjFromRaise := T3DConnector(xScsObjFromRaise.F3DObject);;
if xObjFromRaise <> nil then
begin
dp.y := 0; // no move by ZOrder
Move3DConnector(xObjFromRaise, dp);
end;
end;
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.Move3DRaiseConnector', E.Message);
end;
end;
procedure Tfrm3D.Move3DBetweenRaiseConnector(aObj: T3DConnector; dp: T3DPoint);
var
i, j: integer;
xConn, xRaiseConn, xObjFromRaise: T3DConnector;
xLine: T3DLine;
xScsRaiseConn, xScsObjFromRaise, xScsConnToPassage: TConnectorObject;
ListToPassage, CurGCadForm: TF_CAD;
CurConnToPassageIndex: Integer;
begin
try
xConn := aObj;
if (xConn.FConnType <> ct_Empty) or (xConn.FJoinedConnectorsList.Count = 0) then
begin
if xConn.FSCSObject <> nil then
begin
xScsRaiseConn := GetRaiseConn(xConn.FSCSObject);
if xScsRaiseConn <> nil then
begin
// Between Raise Exist
if xScsRaiseConn.FID_ConnToPassage <> -1 then
begin
ListToPassage := GetListOfPassage(xScsRaiseConn.FID_ListToPassage);
xScsConnToPassage := TConnectorObject(GetFigureByID(ListToPassage, xScsRaiseConn.FID_ConnToPassage));
if xScsConnToPassage <> nil then
begin
xScsObjFromRaise := xScsConnToPassage.FObjectFromRaise;
if xScsObjFromRaise <> nil then
begin
// 3d model with this object exist
if xScsObjFromRaise.F3DObject <> nil then
begin
xObjFromRaise := T3DConnector(xScsObjFromRaise.F3DObject);
dp.y := 0; // no move by ZOrder
Move3DConnector(xObjFromRaise, dp);
end;
end;
end;
end;
end;
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.Move3DBetweenRaiseConnector', E.Message);
end;
end;
function Tfrm3D.CanDrag(aObj: TGLBaseSceneObject; X, Y: Integer): Boolean;
var
i, j: integer;
MoveOff: Integer;
xConn, xGetConn: T3DConnector;
xLine: T3DLine;
xGLLine: TGLLines;
p1, p2: T3DPoint;
begin
try
Result := True;
if (StartDragX <> -999) and (StartDragY <> -999) then
begin
MoveOff := 5;
if (abs(X - StartDragX) >= MoveOff) or (abs(Y - StartDragY) >= MoveOff) then
begin
StartDragX := -999;
StartDragY := -999;
if aObj is TGLFreeForm then
begin
xConn := T3DConnector(TTreeNode(aObj.tagObject).Data);
for i := 0 to xConn.FJoinedConnectorsList.Count - 1 do
begin
xGetConn := T3DConnector(xConn.FJoinedConnectorsList[i]);
for j := 0 to xGetConn.FJoinedLinesList.Count - 1 do
begin
xLine := T3DLine(xGetConn.FJoinedLinesList[j]);
xGLLine := TGLLines(DummyCube.AddNewChild(TGLLines));
p1.x := TGLLines(xLine.FGLObject).Nodes[0].X;
p1.y := TGLLines(xLine.FGLObject).Nodes[0].Y;
p1.z := TGLLines(xLine.FGLObject).Nodes[0].Z;
p2.x := TGLLines(xLine.FGLObject).Nodes[1].X;
p2.y := TGLLines(xLine.FGLObject).Nodes[1].Y;
p2.z := TGLLines(xLine.FGLObject).Nodes[1].Z;
xGLLine.AddNode(p1.x, p1.y, p1.z);
xGLLine.AddNode(p2.x, p2.y, p2.z);
xGLLine.LineColor.AsWinColor := clSilver;
xGLLine.LineWidth := 2;
xGLLine.NodesAspect := lnaInvisible;
if xLine.FLineType = lt_Line then
begin
if xLine.FJoinConnector1 = xGetConn then
xGLLine.Tag := 1;
if xLine.FJoinConnector2 = xGetConn then
xGLLine.Tag := 2;
end
else
begin
if xLine.FJoinConnector1 = xGetConn then
xGLLine.Tag := 12;
if xLine.FJoinConnector2 = xGetConn then
xGLLine.Tag := 21;
end;
xGLLine.TagObject := xLine.FGLObject;
FShadowObjects.Add(xGLLine);
end;
end;
end;
if aObj is TGLCube then
begin
xConn := T3DConnector(aObj.tagObject);
for i := 0 to xConn.FJoinedLinesList.Count - 1 do
begin
xLine := T3DLine(xConn.FJoinedLinesList[i]);
xGLLine := TGLLines(DummyCube.AddNewChild(TGLLines));
p1.x := TGLLines(xLine.FGLObject).Nodes[0].X;
p1.y := TGLLines(xLine.FGLObject).Nodes[0].Y;
p1.z := TGLLines(xLine.FGLObject).Nodes[0].Z;
p2.x := TGLLines(xLine.FGLObject).Nodes[1].X;
p2.y := TGLLines(xLine.FGLObject).Nodes[1].Y;
p2.z := TGLLines(xLine.FGLObject).Nodes[1].Z;
xGLLine.AddNode(p1.x, p1.y, p1.z);
xGLLine.AddNode(p2.x, p2.y, p2.z);
xGLLine.LineColor.AsWinColor := clSilver;
xGLLine.LineWidth := 2;
xGLLine.NodesAspect := lnaInvisible;
if xLine.FLineType = lt_Line then
begin
if xLine.FJoinConnector1 = xConn then
xGLLine.Tag := 1;
if xLine.FJoinConnector2 = xConn then
xGLLine.Tag := 2;
end
else
begin
if xLine.FJoinConnector1 = xConn then
xGLLine.Tag := 12;
if xLine.FJoinConnector2 = xConn then
xGLLine.Tag := 21;
end;
xGLLine.TagObject := xLine.FGLObject;
FShadowObjects.Add(xGLLine);
end;
end;
end
else
begin
Result := False;
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.CanDrag', E.Message);
end;
end;
function Tfrm3D.GetFullConnectorInfo(aObj: TGLFreeForm): string;
var
xConn: T3DConnector;
X, Y, Z: double;
begin
try
xConn := T3DConnector(TTreeNode(aObj.tagObject).Data);
X := aObj.Position.X / factor;
{TODO ZCoord}
//Z := aObj.Position.Y / factor / FScaleDelta - xConn.FZOrder;
Z := aObj.Position.Y / factor / FScaleDeltaSCS - xConn.FZOrder; // NEWNEW
Y := aObj.Position.Z / factor;
Result := 'X=' + FormatFloat(ffMask, X) + ' ' +
'Y=' + FormatFloat(ffMask, Y) + ' ' +
'Z=' + FormatFloat(ffMask, Z);
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.GetFullConnectorInfo', E.Message);
end;
end;
function Tfrm3D.GetEmptyConnectorInfo(aObj: TGLCube): string;
var
xConn: T3DConnector;
X, Y, Z: double;
begin
try
xConn := T3DConnector(aObj.tagObject);
X := aObj.Position.X / factor;
{TODO ZCoord}
//Z := aObj.Position.Y / factor / FScaleDelta - xConn.FZOrder;
Z := aObj.Position.Y / factor / FScaleDeltaSCS - xConn.FZOrder; // NEWNEW
Y := aObj.Position.Z / factor;
Result := 'X=' + FormatFloat(ffMask, X) + ' ' +
'Y=' + FormatFloat(ffMask, Y) + ' ' +
'Z=' + FormatFloat(ffMask, Z);
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.GetEmptyConnectorInfo', E.Message);
end;
end;
function Tfrm3D.GetLineInfo(aObj: TGLLines): string;
var
xLine: T3DLine;
X1, Y1, Z1, X2, Y2, Z2: double;
begin
try
xLine := T3DLine(TTreeNode(aObj.tagObject).Data);
X1 := aObj.Nodes[0].X / factor;
{TODO ZCoord}
//Z1 := aObj.Nodes[0].Y / factor / FScaleDelta - xLine.FZOrder;
Z1 := aObj.Nodes[0].Y / factor / FScaleDeltaSCS - xLine.FZOrder; // NEWNEW
Y1 := aObj.Nodes[0].Z / factor;
X2 := aObj.Nodes[1].X / factor;
{TODO ZCoord}
//Z2 := aObj.Nodes[1].Y / factor / FScaleDelta - xLine.FZOrder;
Z2 := aObj.Nodes[1].Y / factor / FScaleDeltaSCS - xLine.FZOrder; // NEWNEW
Y2 := aObj.Nodes[1].Z / factor;
Result := 'X1=' + FormatFloat(ffMask, X1) + ' ' +
'Y1=' + FormatFloat(ffMask, Y1) + ' ' +
'Z1=' + FormatFloat(ffMask, Z1) + ' ' +
'X2=' + FormatFloat(ffMask, X2) + ' ' +
'Y2=' + FormatFloat(ffMask, Y2) + ' ' +
'Z2=' + FormatFloat(ffMask, Z2);
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.GetLineInfo', E.Message);
end;
end;
function Tfrm3D.GetPosWithGridStep(aPos: Double): Double;
var
iPrev, iNext: Integer;
grPrev, grNext: Double;
begin
try
Result := aPos;
iPrev := trunc(aPos / FGridstep);
if iPrev >= 0 then
iNext := iPrev + 1
else
iNext := iPrev - 1;
grPrev := FGridStep * iPrev;
grNext := FGridStep * iNext;
if abs(aPos - grNext) < abs(aPos - grPrev) then
Result := grNext
else
Result := grPrev;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.GetPosWithGridStep', E.Message);
end;
end;
procedure Tfrm3D.cbShowTraceCaptionsClick(Sender: TObject);
begin
try
ToggleTraceCaptions(cbShowTraceCaptions.Checked); //29.03.2011
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.cbShowTraceCaptionsClick', E.Message);
end;
GLSceneViewer.SetFocus;
end;
procedure Tfrm3D.ToggleTraceCaptions(AShow: Boolean);
var
i: integer;
GLBaseSceneObject: TGLBaseSceneObject;
begin
try
for i := 0 to DummyCube.Count - 1 do
begin
GLBaseSceneObject := DummyCube.Children[i];
if GLBaseSceneObject.ClassName = 'TGLSpaceText' then
if (GLBaseSceneObject.Tag <> 0) and (TObject(GLBaseSceneObject.Tag) is TOrthoLine) then
GLBaseSceneObject.Visible := AShow;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.ToggleTraceCaptions', E.Message);
end;
end;
procedure Tfrm3D.TimerOnSelectNodesTimer(Sender: TObject);
begin
try
TimerOnSelectNodes.Enabled := False;
DeselectGLObjectsT;
// Select objects
if TimerOnSelectNodes.Tag = 1 then
begin
SelectGLObjects(FxObjects);
OnLoadProperties(FNodes);
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.TimerOnSelectNodesTimer', E.Message);
end;
TimerOnSelectNodes.OnTimer := nil;
end;
procedure Tfrm3D.Rotate3DSObj(aObject: TGLFreeForm; aX, aY, aZ: Double);
var
xObject: T3DSObject;
begin
try
aObject.ResetAndPitchTurnRoll(aZ, aY, aX);
xObject := T3DSObject(TTreeNode(aObject.TagObject).Data);
xObject.FRotate.x := aX;
xObject.FRotate.y := aY;
xObject.FRotate.z := aZ;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.Rotate3DSObj', E.Message);
end;
end;
procedure Tfrm3D.RotateConnModel(aObject: TGLFreeForm; aX, aY, aZ: Double);
var
xConn: T3DConnector;
begin
try
aObject.ResetAndPitchTurnRoll(aZ, aY, aX);
xConn := T3DConnector(TTreeNode(aObject.TagObject).Data);
xConn.FRotate.x := aX;
xConn.FRotate.y := aY;
xConn.FRotate.z := aZ;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.RotateConnModel', E.Message);
end;
end;
procedure Tfrm3D.CreateModel;
begin
if F3DModel = nil then
F3DModel := T3DModel.Create;
end;
procedure Tfrm3D.CreateTopNode;
var
xModelNode: TTreeNode;
begin
ModelTree.Items.Clear;
xModelNode := ModelTree.Items.AddFirst(nil, F3DModel.FName);
xModelNode.Data := F3DModel;
xModelNode.HasChildren := True;
end;
procedure Tfrm3D.CreateTopSCSNode;
var
xModelNode: TTreeNode;
begin
ScsModelTree.Items.Clear;
xModelNode := ScsModelTree.Items.AddFirst(nil, F3DModel.FName);
xModelNode.Data := F3DModel;
xModelNode.HasChildren := True;
end;
function Tfrm3D.GetKoefMoveCam: Double;
begin
Result := 1;
if GLSceneViewer.Camera.CameraStyle = csPerspective then
Result := kmPerspective
else
Result := kmOrthogonel;
end;
function Tfrm3D.GetPointsForNormal(arr: T3DPointArray): T3DPointArray;
var
i, j: Integer;
ChkPt, LineP1, LineP2: P3DPoint;
ProjPoint: T3DPoint;
ValidPt: Boolean;
begin
SetLength(Result, 0);
for i := 0 to Length(arr) - 1 do
begin
ChkPt := @arr[i];
ValidPt := true;
if Length(Result) >= 2 then
begin
// Ïðîâåðÿåì åñòü ëè òàêàÿ óæå
for j := 0 to Length(Result) - 1 do
if EQDP(ChkPt^, Result[j]) then
begin
ValidPt := false;
Break; //// BREAK ////
end;
if ValidPt then
begin
// Åñëè ïîñëåäíÿÿ äîáàâëåííàÿ â ðåçóëüòàòû íà îäíîé ëèíèè ñ äîáàâëÿåìîé
LineP1 := @Result[Length(Result)-1];
LineP2 := @Result[Length(Result)-2];
if IsPointInLine(LineP2^, ChkPt^, LineP1^, 1, 0) then
begin
////Result[Length(Result)-1] := ChkPt^;
LineP1^ := ChkPt^;
ValidPt := false;
end;
//else
//// Åñëè òî÷êà íå íàëèíè, ïðîâåðÿåì íå ðÿäîì ëè îíà, ÷åðåç ïðîåöèðîâàíèå åå íà ëèíèþ
//begin
// ProjPoint := LineP1^;
// PointToLineByAngle(LineP2^, ChkPt^, ProjPoint);
// if GetLineLength(LineP1^, ProjPoint) < 4 then
// begin
// //LineP1^ := ChkPt^;
// //ValidPt := false;
// end;
//end;
end;
end;
if ValidPt then
begin
SetLength(Result, Length(Result) + 1);
Result[Length(Result) - 1] := arr[i];
end;
end;
end;
function Tfrm3D.GLNodesTo3DCoords(aNodes: TGLNodes; aYAsZ: Boolean=false): T3DPointArray;
var
i: Integer;
begin
SetLength(Result, aNodes.Count);
for i := 0 to aNodes.Count - 1 do
begin
Result[i].x := aNodes[i].x;
if aYAsZ then
begin
Result[i].y := aNodes[i].z;
Result[i].z := aNodes[i].y;
end
else
begin
Result[i].y := aNodes[i].y;
Result[i].z := aNodes[i].z;
end;
end;
end;
procedure Tfrm3D.FormKeyPress(Sender: TObject; var Key: Char);
begin
if Ord(key) = 27 then
Close;
end;
procedure Tfrm3D.SpeedButton4Click(Sender: TObject);
begin
Close;
end;
end.