admin/expertcad
1
0
Fork 0
mirror of http://gitlab.expertsoft.com.ua/git/expertcad synced 2026-01-12 07:35:39 +02:00
Code Issues Packages Projects Releases Wiki Activity
expertcad/POWERCAD30/UNITS/BAK/Form3d.pas
ShevaIV 00e2ad8635 initial commit
2025-05-12 10:07:51 +03:00

12497 lines
416 KiB
ObjectPascal
Raw Blame History

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, RzPanel, RzStatus;
type
TPropViewType = (pvtNone, pvtSingleSide, pvtMultiSides, pvtSingle3ds, pvtMulti3ds,
pvtSingleConn, pvtMultiConn, pvtSingleLine, pvtMultiLine);
TToolMode = (tmSelect, tmCut);
TLineOrder = (loNone, loHorz, loVert, loRaise);
TCutData = class(TMyObject)
Index11: Integer;
Index12: Integer;
Index21: Integer;
Index22: Integer;
end;
TResizeData = class(TMyObject)
BasisNodes: T3DPointArray;
Side1: TGLPolygon;
Side2: TGLPolygon;
Nodep11: TGLNode;
Nodep12: TGLNode;
Nodep21: TGLNode;
Nodep22: TGLNode;
Noder11: TGLNode;
Noder12: TGLNode;
Noder21: TGLNode;
Noder22: TGLNode;
Indexp11: Integer;
Indexp12: Integer;
Indexp21: Integer;
Indexp22: Integer;
Indexr11: Integer;
Indexr12: Integer;
Indexr21: Integer;
Indexr22: Integer;
end;
TPropRecord = class(TMyObject)
fName: string;
fDesc: TStringList;
fCoords: TList;
fRotate: string;
constructor Create;
end;
Tfrm3D = class(TForm)
GLScene: TGLScene;
panMain: TPanel;
GLCamera: TGLCamera;
GLLightSource1: TGLLightSource;
GLLightSource2: TGLLightSource;
GLLightSource3: TGLLightSource;
GLLightSource4: TGLLightSource;
GLLightSource5: TGLLightSource;
panUpper: TPanel;
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
DummyCube: TGLDummyCube;
TransCube: TGLDummyCube;
GLPlane1: TGLPlane;
GLDummyCube1: TGLDummyCube;
GLHUDText1: TGLHUDText;
SpeedButton3: TSpeedButton;
SaveDialog: TSaveDialog;
lbViewType: TLabel;
lng_Forms: TsiLangLinked;
cbViewCeiling: TCheckBox;
Splitter1: TSplitter;
ImageList_Dir: TImageList;
panScene: TPanel;
GLSceneViewer: TGLSceneViewer;
panObjects: TPanel;
Splitter2: TSplitter;
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;
Label53: 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;
Label62: TLabel;
edScsLineX2: TcxMaskEdit;
Label63: TLabel;
edScsLineY2: TcxMaskEdit;
Label64: TLabel;
edScsLineZ2: TcxMaskEdit;
Label65: TLabel;
Label66: TLabel;
sbViewPanel: TRzStatusBar;
sbView: TRzStatusPane;
cbShowTraceCaptions: TCheckBox;
TimerOnSelectNodes: TTimer;
Light: TGLLightSource;
GLLightFirstPerson: TGLLightSource;
procedure GLSceneViewerMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure GLSceneViewerMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
procedure SpeedButton1Click(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure GLHeightField1GetHeight(const x, y: Single; var z: Single;
var color: TVector4f; var texPoint: TTexPoint);
procedure FormMouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
procedure SpeedButton3Click(Sender: TObject);
procedure cbViewCeilingClick(Sender: TObject);
procedure GLSceneViewerDblClick(Sender: TObject);
procedure ModelTreeClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure cbCoordNbrCloseUp(Sender: TObject);
procedure bSideTextureClearClick(Sender: TObject);
procedure cbMirrorClick(Sender: TObject);
procedure mDescEnter(Sender: TObject);
procedure sbFirstFaceClick(Sender: TObject);
procedure bSideTextureChangeClick(Sender: TObject);
procedure GLCadencerProgress(Sender: TObject; const deltaTime,
newTime: Double);
procedure GLSceneViewerClick(Sender: TObject);
procedure cbHashsPropertiesCloseUp(Sender: TObject);
procedure nAdd3DObjectClick(Sender: TObject);
procedure ModelTreeMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure edNameExit(Sender: TObject);
procedure mDescExit(Sender: TObject);
procedure edPosXExit(Sender: TObject);
procedure edPosYExit(Sender: TObject);
procedure edPosZExit(Sender: TObject);
procedure edAngleXExit(Sender: TObject);
procedure edAngleYExit(Sender: TObject);
procedure edAngleZExit(Sender: TObject);
procedure edScaleXExit(Sender: TObject);
procedure edScaleYExit(Sender: TObject);
procedure edScaleZExit(Sender: TObject);
procedure edCoordXKeyPress(Sender: TObject; var Key: Char);
procedure edCoordXExit(Sender: TObject);
procedure edCoordYExit(Sender: TObject);
procedure edCoordZExit(Sender: TObject);
procedure edTextureRotateExit(Sender: TObject);
procedure edCoordYKeyPress(Sender: TObject; var Key: Char);
procedure edCoordZKeyPress(Sender: TObject; var Key: Char);
procedure edTextureRotateKeyPress(Sender: TObject; var Key: Char);
procedure edNameKeyPress(Sender: TObject; var Key: Char);
procedure mDescKeyPress(Sender: TObject; var Key: Char);
procedure edPosXKeyPress(Sender: TObject; var Key: Char);
procedure edPosYKeyPress(Sender: TObject; var Key: Char);
procedure edPosZKeyPress(Sender: TObject; var Key: Char);
procedure edAngleXKeyPress(Sender: TObject; var Key: Char);
procedure edAngleYKeyPress(Sender: TObject; var Key: Char);
procedure edAngleZKeyPress(Sender: TObject; var Key: Char);
procedure edScaleXKeyPress(Sender: TObject; var Key: Char);
procedure edScaleYKeyPress(Sender: TObject; var Key: Char);
procedure edScaleZKeyPress(Sender: TObject; var Key: Char);
procedure GLSceneViewerMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure sbSaveModelClick(Sender: TObject);
procedure nDeleteAllSubSidesClick(Sender: TObject);
procedure Edit2Exit(Sender: TObject);
procedure btnEmptyClick(Sender: TObject);
procedure NDel3DObjectClick(Sender: TObject);
procedure 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);
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: 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);
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: Single): Single;
procedure ApplyCutting;
procedure ApplyScsModel;
procedure ValidateActiveControl;
procedure CreateModel;
procedure CreateTopNode;
procedure CreateTopSCSNode;
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;
//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;
{$R *.dfm}
//
// Classic mouse movement bits
//
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 FSelection.Count = 1 then
if isLineObject(TGLBaseSceneObject(FSelection[0]), Obj) then
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;
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: single;
//vx,vz: single;
spd: 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]);
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;
end
// ********************* Offset ******************************************
else
begin
if GLSceneViewer.Camera = GLCamera then
begin
GLSceneViewer.Camera.MoveAroundTarget(my - y, mx - x);
end;
//Alex(17.12.2010) <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>
{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) <20><><EFBFBD><EFBFBD> FirstPerson <20><> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
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;
// <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> (Resizing)
if (FToolMode = tmCut) then
begin
// <20><><EFBFBD>c<EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
if not FResizer then
begin
if Shift = [] then
begin
xObj := GLSceneViewer.Buffer.GetPickedobject(X, Y);
if (xObj = glCubeSpliter) or (xObj = glCubeSpliter1) or (xObj = glCubeSpliter2) then
GLSceneViewer.Cursor := crSizeAll
else
GLSceneViewer.Cursor := crDefault;
end;
end
else
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
begin
VY := VectorMake(VectorPerpendicular(YVector, VectorNormalize(VectorSubtract(Camera.Position.AsAffineVector, MainCenter.Position.AsAffineVector))));
VX := VectorCrossProduct(VY, VectorNormalize( VectorSubtract(Camera.Position.AsVector, MainCenter.Position.AsVector)));
NormalizeVector(VY);
NormalizeVector(VX);
glCursorObject.Position.Translate(VectorCombine(VX, VY, -dx * 0.132 * Camera.DistanceToTarget / Camera.FocalLength, dy * 0.132 * Camera.DistanceToTarget / Camera.FocalLength));
DoResize;
end;
end;
mx := x;
my := y;
end;
procedure Tfrm3D.UpdateFaces(Faces: TList; Yh: Double = 0);
var
i, pCnt, j, k, FigureID: Integer;
Face:TFaceRecord;
glPoly:TGLPolyGon;
glLine: TGLLines;
glCube: TGLCube;
glSphere: TGLSphere;
glCenter: TGLDummyCube;
glPipe: TGLPipe;
p, p1, p2, p3, p4, p5, p6, p7, p8, normal: T3dPoint;
tx,ty,tz,bx,by,bz,cx,cy,cz: Double;
glObject: TGLBaseSceneObject;
glObjClass: TGLSceneObjectClass;
glObject1: TGLBaseSceneObject;
glObjClass1: TGLSceneObjectClass;
SCSCatalog: TSCSCatalog;
xoffset, aScaleModel: single;
aColorModel: TVector4f;
glWallSide, glFloor, glCeiling, glDoorSide, glWindowSide, glBalconDoorSide, glBalconWindowSide: TGLPolygon;
gl3DSObject, glModelObject: TGLFreeForm;
aColor: TVector4f;
tmpdir, ImgName, ImgName1: string;
WallCoords: array [0..5] of TVector3f;
FloorCoords: array of TVector3f;
BegCoordIndex: integer;
xNode: TTreeNode;
xSide: T3DSide;
xObject: T3DSObject;
xConn: T3DConnector;
xLine: T3DLine;
PrevxNode: TTreeNode;
PrevxSide: T3DSide;
Angle1, Angle2, ResAng: Double;
dp1, dp2: TDoublePoint;
pN, pP: TVector3f;
//Alex(22.12.2010)
xRoom: T3DRoom;
RoomMin, RoomMax, RoomSize, SetPos, Scale: T3DPoint;
begin
try
TimerOnSelectNodes.OnTimer := nil;
FaceList := Faces;
{$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;
for i := 0 to DummyCube.Count - 1 do
begin
if not (DummyCube.Children[i] is TGLCamera) then
DummyCube.Children[i].DeleteChildren;
end;
TransCube.DeleteChildren;
// Beg - 2011-05-10
//LoadModelFromStream(FFileStream);
//if F3DStreamModel = nil then
// UpdateModelTree
//else
// UpdateModelTreeFromStream(Faces);
// End - 2011-05-10
//// *********** FACES.COUNT *************************************************
for i := 0 to Faces.Count - 1 do
begin
Face := TFaceRecord(faces[i]);
xNode := Face.FTreeNode;
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);
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;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
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
xNode.ImageIndex := xNode.ImageIndex + 1000;
end
else
begin
if GLObject <> nil then
GLObject.Visible := True;
if xNode <> nil then
if xNode.ImageIndex > 999 then
xNode.ImageIndex := xNode.ImageIndex - 1000;
end;
end;
case Face.RecType of
ftPolygon: glPoly := TGLPolyGon(glObject);
ftLine : glLine := TGLLines(glObject);
ftPipe,ftBar : glPipe := TGLPipe(glObject);
ftSphere: glSphere := TGLSphere(glObject);
ftCenterCube: glCenter := TGLDummyCube(glObject);
ftNetPath: glWallSide := TGLPolygon(glObject);
ftNetFloor: glFloor := TGLPolygon(glObject);
ftNetCeiling: glCeiling := TGLPolygon(glObject);
ftNetDoor: glDoorSide := TGLPolyGon(glObject);
ftNetWindow: glWindowSide := TGLPolyGon(glObject);
ftNetBalconDoor: glBalconDoorSide := TGLPolyGon(glObject);
ftNetBalconWindow: glBalconWindowSide := TGLPolyGon(glObject);
ftNet3DSObject: gl3DSObject := TGLFreeForm(glObject);
end;
// ADD ZORDER TO Z
for k := 0 to pCnt - 1 do
begin
p := Face.Points[k];
if Face.RecType <> ftNet3DSObject then
Face.Points[k] := DoublePoint(p.x, p.y, p.z + FZOrder * UOMToMetre(1000 / FCAD.PCad.MapScale))
else
Face.Points[k] := DoublePoint(p.x, p.y + FZOrder * UOMToMetre(1000 / FCAD.PCad.MapScale) * Factor, p.z);
end;
if Face.RecType in [ftPolyGon,ftLine,ftPipe,ftBar,ftSphere] then
begin
for k := 0 to pCnt - 1 do
begin
p := Face.Points[k];
p := DoublePoint(p.x,p.z,p.y);
if Face.RecType = ftPolyGon then
begin
glPoly.AddNode(p.x * factor, p.y * factor, p.z * factor);
end
else
if Face.RecType = ftLine then
begin
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);
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} '<27>/<2F>' {$IFEND} + inttostr(TOrthoLine(Face.FFigure).FIndex);
TGLSpaceText(glObject1).Scale.X := 0.2;
TGLSpaceText(glObject1).Scale.y := 0.2;
TGLSpaceText(glObject1).Scale.z := 0.2;
end
else
begin
TGLSpaceText(glObject1).Text := TOrthoLine(Face.FFigure).Name + inttostr(TOrthoLine(Face.FFigure).FIndex);
TGLSpaceText(glObject1).Scale.X := 0.4;
TGLSpaceText(glObject1).Scale.y := 0.4;
TGLSpaceText(glObject1).Scale.z := 0.4;
end;
TGLSpaceText(glObject1).Position.x := p.x*factor;
TGLSpaceText(glObject1).Position.z := p.z*factor;
if Face.Points[0].z = Face.Points[1].z then
TGLSpaceText(glObject1).Position.y := (p.y + 2) * factor
else
TGLSpaceText(glObject1).Position.y := (p.y - 2) * factor;
TGLSpaceText(glObject1).Extrusion := 0.05;
TGLSpaceText(glObject1).Font.Color := clRed;
TGLSpaceText(glObject1).Material.FrontProperties.Diffuse.Color := clrRed;
TGLSpaceText(glObject1).Material.BackProperties.Diffuse.Color := clrRed;
//
with TGLSceneObject(glObject).Material do
begin
BackProperties.Ambient.AsWinColor:= Face.Color;
BackProperties.Diffuse.AsWinColor := Face.Color;
BackProperties.Emission.AsWinColor := Face.Color;
FrontProperties.Ambient.AsWinColor := Face.Color;
FrontProperties.Diffuse.AsWinColor := Face.Color;
FrontProperties.Emission.AsWinColor := Face.Color;
end;
xLine.FGLCaption := glObject1;
end;
if Face.RecType = ftPipe then
begin
if TConnectorObject(Face.FFigure).ConnectorType <> ct_Clear then
begin
if TConnectorObject(Face.FFigure).Name <> ctnConnector then
begin
aScaleModel := 0.05;
aColorModel := clrGreen;
xoffset := 3;
FigureID := TConnectorObject(Face.FFigure).ID;
SCSCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(FigureID);
if SCSCatalog <> nil then
begin
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> TSCSComponent
if SCSCatalog.SCSComponents.Count > 0 then
begin
if SCSCatalog.SCSComponents[0].ComponentType.SysName = ctsnCupboard then
begin
aScaleModel := 0.1;
aColorModel := clrBrown;
xoffset := 4;
end;
if SCSCatalog.SCSComponents[0].ComponentType.SysName = ctsnCableChannelElement then
begin
aScaleModel := 0.02;
aColorModel := clrBlue;
end;
end;
end;
if TConnectorObject(Face.FFigure).Name <> cCadClasses_Mes24 then
begin
glObjClass1 := TGLSpaceText;
p := Face.Points[0];
p := DoublePoint(p.x,p.z,p.y);
glObject1 := DummyCube.AddNewChild(glObjClass1);
TGLSpaceText(glObject1).Text := TConnectorObject(Face.FFigure).Name + inttostr(TConnectorObject(Face.FFigure).FIndex);
TGLSpaceText(glObject1).Position.x := (p.x + xoffset)*factor;
TGLSpaceText(glObject1).Position.z := p.z*factor;
TGLSpaceText(glObject1).Position.y := p.y*factor;
TGLSpaceText(glObject1).Extrusion := 0.05;
TGLSpaceText(glObject1).Font.Color := clRed;
TGLSpaceText(glObject1).Scale.X := 0.4;
TGLSpaceText(glObject1).Scale.y := 0.4;
TGLSpaceText(glObject1).Scale.z := 0.4;
TGLSpaceText(glObject1).Material.FrontProperties.Diffuse.Color := clrRed;
TGLSpaceText(glObject1).Material.BackProperties.Diffuse.Color := clrRed;
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 - <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> - <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>!}
//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('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; // - <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
xConn.FColor := aColorModel;
xConn.FGLObject1 := glModelObject;
{TODO} // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>!!!
ImgName1 := GetImageFileByHash(xConn.FTextureHash);
if ImgName1 <> '' then
begin
glModelObject.MaterialLibrary := nil;
glModelObject.Material.Texture.Image.LoadFromFile(ImgName1);
//glModelObject.Material.Texture.MappingMode := tmmCubeMapCamera;
end
{!!!}
end
else
begin
FigureID := TConnectorObject(Face.FFigure).ID;
SCSCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(FigureID);
if SCSCatalog <> nil then
begin
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> TSCSComponent
if SCSCatalog.SCSComponents.Count > 0 then
begin
if SCSCatalog.SCSComponents[0].ComponentType.SysName = ctsnCableChannelElement then
begin
aScaleModel := 0.02;
aColorModel := clrBlue;
glObjClass1 := TGLFreeForm;
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 - <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> - <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>!}
//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('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; // - <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
xConn.FColor := aColorModel;
xConn.FGLObject1 := glModelObject;
{TODO} // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>!!!
ImgName1 := GetImageFileByHash(xConn.FTextureHash);
if ImgName1 <> '' then
begin
glModelObject.MaterialLibrary := nil;
glModelObject.Material.Texture.Image.LoadFromFile(ImgName1);
//glModelObject.Material.Texture.MappingMode := tmmCubeMapCamera;
end
{!!!}
end;
end;
end;
end;
end
else
begin
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
Texture.Image.LoadFromFile(ImgName);
end
else
begin
if Face.FFaceWallType = fwtInner then
Texture.Image.LoadFromFile(ExeDir + '\3DTextures\inner_wall.bmp')
else if Face.FFaceWallType = fwtOuter then
Texture.Image.LoadFromFile(ExeDir + '\3DTextures\outer_wall.bmp')
else if Face.FFaceWallType = fwtDoorSlope then
Texture.Image.LoadFromFile(ExeDir + '\3DTextures\door_slope.bmp')
else if Face.FFaceWallType = fwtWindowSlope then
Texture.Image.LoadFromFile(ExeDir + '\3DTextures\window_slope.bmp')
else if Face.FFaceWallType = fwtArc then
Texture.Image.LoadFromFile(ExeDir + '\3DTextures\arc.bmp')
else if Face.FFaceWallType = fwtBalconSlope then
Texture.Image.LoadFromFile(ExeDir + '\3DTextures\balcon_slope.bmp')
else if Face.FFaceWallType = fwtNiche then
Texture.Image.LoadFromFile(ExeDir + '\3DTextures\niche.bmp');
end;
end;
RotateTextureToAngleP(xSide, GLWallSide, xSide.FTextureRotate, xSide.FMirror);
end;
// ********************** NETPATHs *****************************************
// ********************** NETDOORs *****************************************
if Face.RecType = ftNetDoor then
begin
for k := 0 to pCnt - 1 do
begin
p := Face.Points[k];
p := DoublePoint(p.x, p.z, p.y);
p1 := Face.Points[1];
p1 := DoublePoint(p1.x, p1.z, p1.y);
p.x := p.x * factor;
if (p.y < 0.011) then
begin
if (p.y <> p1.y) then
p.y := p.y * factor
else
p.y := p.y * factor + FDeltaZSlope
end
else
p.y := p.y * factor;
p.z := p.z * factor;
glDoorSide.AddNode(p.x, p.y, p.z);
xSide.FGLPoints[k] := p;
end;
with TGLSceneObject(glObject).Material do
begin
aColor := clrTan;
BackProperties.Ambient.Color := aColor;
BackProperties.Diffuse.Color := aColor;
BackProperties.Emission.Color := aColor;
FrontProperties.Ambient.Color := aColor;
FrontProperties.Diffuse.Color := aColor;
FrontProperties.Emission.Color := aColor;
MaterialOptions := [moNoLighting];
end;
end;
// ********************** NETDOORs *****************************************
// ********************** NETWINDOWs ***************************************
if Face.RecType = ftNetWindow then
begin
for k := 0 to pCnt - 1 do
begin
p := Face.Points[k];
p := DoublePoint(p.x, p.z, p.y);
p1 := Face.Points[1];
p1 := DoublePoint(p1.x, p1.z, p1.y);
p.x := p.x * factor;
//if (p.y < 0.011) then
//begin
// if (p.y <> p1.y) then
// p.y := p.y * factor
// else
// p.y := p.y * factor + FDeltaZSlope
//end
//else
p.y := p.y * factor;
p.z := p.z * factor;
glWindowSide.AddNode(p.x, p.y, p.z);
xSide.FGLPoints[k] := p;
end;
with TGLSceneObject(glObject).Material do
begin
aColor := clrSilver;
BackProperties.Ambient.Color := aColor;
BackProperties.Diffuse.Color := aColor;
BackProperties.Emission.Color := aColor;
FrontProperties.Ambient.Color := aColor;
FrontProperties.Diffuse.Color := aColor;
FrontProperties.Emission.Color := aColor;
MaterialOptions := [moNoLighting];
end;
end;
// ********************** NETWINDOWs ***************************************
// ********************** NETBALCONs ***************************************
if Face.RecType = ftNetBalconDoor then
begin
for k := 0 to pCnt - 1 do
begin
p := Face.Points[k];
p := DoublePoint(p.x, p.z, p.y);
p1 := Face.Points[1];
p1 := DoublePoint(p1.x, p1.z, p1.y);
p.x := p.x * factor;
if (p.y < 0.011) then
begin
if (p.y <> p1.y) then
p.y := p.y * factor
else
p.y := p.y * factor + FDeltaZSlope
end
else
p.y := p.y * factor;
p.z := p.z * factor;
glBalconDoorSide.AddNode(p.x, p.y, p.z);
xSide.FGLPoints[k] := p;
end;
with TGLSceneObject(glObject).Material do
begin
aColor := clrGray80;
BackProperties.Ambient.Color := aColor;
BackProperties.Diffuse.Color := aColor;
BackProperties.Emission.Color := aColor;
FrontProperties.Ambient.Color := aColor;
FrontProperties.Diffuse.Color := aColor;
FrontProperties.Emission.Color := aColor;
MaterialOptions := [moNoLighting];
end;
end;
if Face.RecType = ftNetBalconWindow then
begin
for k := 0 to pCnt - 1 do
begin
p := Face.Points[k];
p := DoublePoint(p.x, p.z, p.y);
p1 := Face.Points[1];
p1 := DoublePoint(p1.x, p1.z, p1.y);
p.x := p.x * factor;
//if (p.y < 0.011) then
//begin
// if (p.y <> p1.y) then
// p.y := p.y * factor
// else
// p.y := p.y * factor + FDeltaZSlope
//end
//else
p.y := p.y * factor;
p.z := p.z * factor;
glBalconWindowSide.AddNode(p.x, p.y, p.z);
xSide.FGLPoints[k] := p;
end;
with TGLSceneObject(glObject).Material do
begin
aColor := clrSilver;
BackProperties.Ambient.Color := aColor;
BackProperties.Diffuse.Color := aColor;
BackProperties.Emission.Color := aColor;
FrontProperties.Ambient.Color := aColor;
FrontProperties.Diffuse.Color := aColor;
FrontProperties.Emission.Color := aColor;
MaterialOptions := [moNoLighting];
end;
end;
// ********************** NETBALCONs ***************************************
// ********************** NETFLOOR *****************************************
{TODO}
// 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;
}
SetLength(FloorCoords, pCnt);
for k := 0 to pCnt - 1 do
begin
p := Face.Points[k];
p := DoublePoint(p.x, p.z, p.y);
FloorCoords[k][0] := p.x * factor;
FloorCoords[k][1] := p.y * factor + FDeltaZFloor; //FDeltaZ;
FloorCoords[k][2] := p.z * factor;
end;
if pCnt >= 3 then
begin
for k := 0 to pCnt - 3 do
begin
dp1 := DoublePoint(FloorCoords[0][0], FloorCoords[0][2], FloorCoords[0][1]);
dp2 := DoublePoint(FloorCoords[k + 1][0], FloorCoords[k + 1][2], FloorCoords[k + 1][1]);
Angle1 := GetLineAngle(dp1, dp2);
dp1 := DoublePoint(FloorCoords[k + 1][0], FloorCoords[k + 1][2], FloorCoords[k + 1][1]);
dp2 := DoublePoint(FloorCoords[k + 2][0], FloorCoords[k + 2][2], FloorCoords[k + 2][1]);
Angle2 := GetLineAngle(dp1, dp2);
ResAng := abs(Angle1 - Angle2);
//if ResAng < 180 then
begin
pN := CalcPlaneNormal (FloorCoords[0], FloorCoords[k + 1], FloorCoords[k + 2]);
if (not isNaN(pN[0])) and (Not IsNaN(pN[1])) and (Not IsNaN(pN[2])) then
break;
end;
end;
if k > (pCnt - 1) then
k := 0;
pN := CalcPlaneNormal (FloorCoords[0], FloorCoords[k + 1], FloorCoords[k + 2]);
end
else
pN[1] := 0;
if pN[1] >= 0 then
glFloor.Parts := [ppTop]
else
glFloor.Parts := [ppBottom];
for k := 0 to pCnt - 1 do
begin
p := Face.Points[k];
//p := DoublePoint(p.x * factor, p.z * factor + FDeltaZ, p.y * factor); {TODO} // 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
Texture.Image.LoadFromFile(ImgName);
end
else
begin
Texture.Image.LoadFromFile(ExeDir + '\3DTextures\floor.bmp');
end;
end;
RotateTextureToAngleP(xSide, GLFloor, xSide.FTextureRotate, xSide.FMirror);
end;
// ********************** NETFLOOR *****************************************
// ********************** NETCEILING ***************************************
{TODO}
// 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;
}
SetLength(FloorCoords, pCnt);
for k := 0 to pCnt - 1 do
begin
p := Face.Points[k];
p := DoublePoint(p.x, p.z, p.y);
FloorCoords[k][0] := p.x * factor;
FloorCoords[k][1] := p.y * factor + FDeltaZ;
FloorCoords[k][2] := p.z * factor;
end;
if pCnt >= 3 then
begin
for k := 0 to pCnt - 3 do
begin
dp1 := DoublePoint(FloorCoords[0][0], FloorCoords[0][2], FloorCoords[0][1]);
dp2 := DoublePoint(FloorCoords[k + 1][0], FloorCoords[k + 1][2], FloorCoords[k + 1][1]);
Angle1 := GetLineAngle(dp1, dp2);
dp1 := DoublePoint(FloorCoords[k + 1][0], FloorCoords[k + 1][2], FloorCoords[k + 1][1]);
dp2 := DoublePoint(FloorCoords[k + 2][0], FloorCoords[k + 2][2], FloorCoords[k + 2][1]);
Angle2 := GetLineAngle(dp1, dp2);
ResAng := abs(Angle1 - Angle2);
//if ResAng < 180 then
begin
pN := CalcPlaneNormal (FloorCoords[0], FloorCoords[k + 1], FloorCoords[k + 2]);
if (not isNaN(pN[0])) and (Not IsNaN(pN[1])) and (Not IsNaN(pN[2])) then
break;
end;
end;
if k > (pCnt - 1) then
k := 0;
pN := CalcPlaneNormal (FloorCoords[0], FloorCoords[k + 1], FloorCoords[k + 2]);
end
else
pN[1] := 0;
if pN[1] >= 0 then
glCeiling.Parts := [ppBottom]
else
glCeiling.Parts := [ppTop];
for k := 0 to pCnt - 1 do
begin
p := Face.Points[k];
p := DoublePoint(p.x * factor, p.z * factor + FDeltaZ, p.y * factor);
glCeiling.AddNode(p.x, p.y, p.z);
xSide.FGLPoints[k] := p;
end;
xSide.FZOrder := xSide.FZOrder + FDeltaZ;
{
for k := 0 to pCnt - 1 do
begin
p := Face.Points[k];
p := DoublePoint(p.x * factor, p.z * factor, p.y * factor + FDeltaZ);
glCeiling.AddNode(p.x, p.y, p.z);
xSide.FGLPoints[k] := p;
end;
}
with TGLSceneObject(glObject).Material do
begin
aColor := clrSilver;
BackProperties.Ambient.Color := aColor;
BackProperties.Diffuse.Color := aColor;
BackProperties.Emission.Color := aColor;
FrontProperties.Ambient.Color := aColor;
FrontProperties.Diffuse.Color := aColor;
FrontProperties.Emission.Color := aColor;
Texture.texturemode := tmDecal;
Texture.Disabled := False;
ImgName := GetImageFileByHash(xSide.FTextureHash);
if ImgName <> '' then
begin
Texture.Image.LoadFromFile(ImgName);
end
else
begin
Texture.Image.LoadFromFile(ExeDir + '\3DTextures\ceiling.bmp');
end;
end;
RotateTextureToAngleP(xSide, GLCeiling, xSide.FTextureRotate, xSide.FMirror);
end;
// ********************** NETCEILING ***************************************
// ********************** NET3DSObject *************************************
if Face.RecType = ftNet3DSObject then
begin
gl3DSObject.Material.Texture.Disabled := False;
try
// <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> savedir!
{
if FileExists(ExeDir + '\' + dnSave + '\' + ExtractFileName(xObject.FPath)) then
xObject.FPath := ExeDir + '\' + dnSave + '\' + ExtractFileName(xObject.FPath)
else
begin
// <20><><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>.
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 - <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> - <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>!}
//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; // - <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
// LOAD texture from Hash
{TODO} // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>!!!
{TODO} // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>!!!
ImgName1 := GetImageFileByHash(xObject.FTextureHash);
if ImgName1 <> '' then
begin
gl3DSObject.MaterialLibrary := nil;
gl3DSObject.Material.Texture.Image.LoadFromFile(ImgName1);
//gl3DSObject.Material.Texture.MappingMode := tmmCubeMapCamera;
end
end;
except
end;
end;
// ********************** NET3DSObject *************************************
with TGLSceneObject(glObject).Material do
begin
if (Face.Trans) or (face.OpTrans) then
begin
BlendingMode := bmTransparency;
BackProperties.Diffuse.Alpha := 0.4;
FrontProperties.Diffuse.Alpha := 0.4;
end;
end;
if Face.RecType = ftPipe then
begin
{$IF Defined(ES_GRAPH_SC)}
glPipe.Radius := 0;
{$ELSE}
glPipe.Radius := Face.Size;
{$IFEND}
glPipe.Parts := [ppOutSide,ppInSide,ppStartDisk,ppStopDisk];
end
else
if Face.RecType = ftBar then
begin
glPipe.Radius := 0.06;
end
else
if Face.RecType = ftSphere then
begin
glSphere.Radius := Face.Size * factor;
end
else
if Face.RecType = ftCenterCube then
begin
end
else
begin
end;
end;
//// *********** FACES.COUNT *************************************************
//FCAD.FActiveNet;
// Factor := 0.15;
cx := ((tx+bx) / 2) * Factor;
cy := ((ty+by) / 2) * Factor;
cz := ((tz+bz) / 2) * Factor;
Cpoint := DoublePoint(cx,cy,cz);
Opoint := DoublePoint(cx,(by * factor) - 5,tz * factor);
MainCenter.Position.X := cx;
//MainCenter.Position.Y := cy;
MainCenter.Position.Z := cz;
GLCamera.Position.x := cx;
GLCamera.Position.y := cy;
GLCamera.Position.z := tz * factor + 40;
{$IF Not Defined(ES_GRAPH_SC)}
GLPlane1.Material.Texture.Image.LoadFromFile(GetPathToSCSTmpDir + '\3d.jpg');
{$ELSE}
GLPlane1.Position.y := GLPlane1.Position.y - FDeltaZPlane; //
{$IFEND}
GLPlane1.Scale.Y := 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;
//--
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD>
glCamera.CameraStyle := csPerspective;
GLCamera.FocalLength := 160;
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
// UpdateModelTree;
cbViewCeiling.Checked := True;
{$IF Not Defined(ES_GRAPH_SC)}
cbViewCeiling.Visible := False;
sbSaveModel.Visible := False;
panObjects.Visible := False;
Splitter1.Visible := False;
{$IFEND}
SetAllPanels(False);
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) <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> FocalLength <20><><EFBFBD> <20><><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>
if GLSceneViewer.Camera = FirstPersonCamera then
begin
if WheelDelta > 0 then
FirstPersonCamera.FocalLength := FirstPersonCamera.FocalLength + 5
else
FirstPersonCamera.FocalLength := FirstPersonCamera.FocalLength - 5;
end;
if GLSceneViewer.Camera <> FirstPersonCamera then
begin
s := GLSceneViewer.Camera.FocalLength;
if shiftdown then
begin
if GLSceneViewer.Camera.CameraStyle = csPerspective then
GLSceneViewer.Camera.FocalLength := s + WheelDelta / 80
else
GLSceneViewer.Camera.FocalLength := s + WheelDelta / 2420;
end
else
begin
if GLSceneViewer.Camera.CameraStyle = csPerspective then
GLSceneViewer.Camera.FocalLength := s + WheelDelta / 20
else
GLSceneViewer.Camera.FocalLength := s + WheelDelta / 540;
end;
end;
end
end;
procedure Tfrm3D.SpeedButton3Click(Sender: TObject);
var
Save3D: TSaveDialog;
Jpeg: TJPEGImage;
Bmp: TBitmap;
BmpFileName: string;
bmpx, bmpy: Integer;
begin
try
{$IF Defined(ES_GRAPH_SC)}
if GLSceneViewer.Camera = FirstPersonCamera then
begin
ShowMessage('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> "<22><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>"!');
Exit;
end;
{$ELSE}
if GLSceneViewer.Camera.CameraStyle = csPerspective then
begin
ShowMessage(cForm3D_Mes2);
Exit;
end;
{$IFEND}
Save3D := TSaveDialog.Create(nil);
with Save3D do
begin
InitialDir := GetEXEDir;
Title := cForm3D_Mes1;
Filter := '(*.jpg)|*.jpg';
DefaultExt := '*.jpg';
FileName := '';
Options := [ofReadOnly,ofHideReadOnly,ofPathMustExist,ofFileMustExist,ofNoDereferenceLinks];
end;
if Save3D.Execute then
begin
if frm3D_Save.ShowModal = mrOk then
begin
Bmp := TBitmap.Create;
Jpeg := TJPEGImage.Create;
BmpFileName := ChangeFileExt(Save3D.FileName, '.bmp');
if frm3D_Save.rbLow.Checked then
begin
GLSceneViewer.Buffer.RenderToFile(BmpFileName, 300);
end;
if frm3D_Save.rbNormal.Checked then
begin
bmpx := GLSceneViewer.Buffer.Width * 2;
bmpy := GLSceneViewer.Buffer.Height * 2;
GLSceneViewer.Buffer.RenderToFile(BmpFileName, bmpx, bmpy);
end;
if frm3D_Save.rbHigh.Checked then
begin
bmpx := GLSceneViewer.Buffer.Width * 3;
bmpy := GLSceneViewer.Buffer.Height * 3;
GLSceneViewer.Buffer.RenderToFile(BmpFileName, bmpx, bmpy);
end;
Bmp.LoadFromFile(BmpFileName);
ConvertBMPToJpeg(Bmp, BmpFileName);
FreeAndNil(Bmp);
DeleteFile(BmpFileName);
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.SpeedButton3Click', E.Message);
end;
end;
procedure Tfrm3D.cbViewCeilingClick(Sender: TObject);
var
i: integer;
xNode: TTreeNode;
begin
try
for i := 0 to DummyCube.Count - 1 do
begin
if (DummyCube.Children[i].TagObject <> nil) then
begin
xNode := TTreeNode(DummyCube.Children[i].TagObject);
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>/<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD>
if cbViewCeiling.Checked then
begin
if T3dSide(xNode.Data).FFaceType = ftNetCeiling then
begin
if xNode <> nil then
begin
if xNode.ImageIndex < 1000 then
DummyCube.Children[i].Visible := True;
end
else
DummyCube.Children[i].Visible := True;
end;
if T3dSide(xNode.Data).FFaceType = ftNetFloor then
begin
if xNode <> nil then
begin
if xNode.ImageIndex < 1000 then
DummyCube.Children[i].Visible := True;
end
else
DummyCube.Children[i].Visible := True;
end;
end
else
begin
if T3dSide(xNode.Data).FFaceType = ftNetCeiling then
DummyCube.Children[i].Visible := False;
if T3dSide(xNode.Data).FFaceType = ftNetFloor then
DummyCube.Children[i].Visible := False;
end;
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.cbViewCeilingClick', E.Message);
end;
end;
procedure Tfrm3D.AddWall(aWall: TGLMesh; vs: array of TVector3f);
var
vd: array [1..6] of TVertexData;
pN, pP: TVector3f;
mat: TAffineMatrix;
begin
try
pN := CalcPlaneNormal (vs[0], vs[1], vs[2]);
SetVector (mat[2], pN);
SetVector (mat[0], VectorNormalize (VectorSubtract (vs[1], vs[0])));
SetVector (mat[1], VectorCrossProduct (mat[2], mat[0]));
InvertMatrix (mat);
with vd[1] do begin
coord := vs[0];
normal := pN;
pP := VectorTransform (vs[0], mat);
textCoord := TexPointMake (pP[0], pP[1]);
end;
with vd[2] do begin
coord := vs[1];
normal := pN;
pP := VectorTransform (vs[1], mat);
textCoord := TexPointMake (pP[0], pP[1]);
end;
with vd[3] do begin
coord := vs[2];
normal := pN;
pP := VectorTransform (vs[2], mat);
textCoord := TexPointMake (pP[0], pP[1]);
end;
with vd[4] do begin
coord := vs[3];
normal := pN;
pP := VectorTransform (vs[3], mat);
textCoord := TexPointMake (pP[0], pP[1]);
end;
with vd[5] do begin
coord := vs[4];
normal := pN;
pP := VectorTransform (vs[4], mat);
textCoord := TexPointMake (pP[0], pP[1]);
end;
with vd[6] do begin
coord := vs[5];
normal := pN;
pP := VectorTransform (vs[5], mat);
textCoord := TexPointMake (pP[0], pP[1]);
end;
aWall.Vertices.AddVertex (vd[1]);
aWall.Vertices.AddVertex (vd[2]);
aWall.Vertices.AddVertex (vd[3]);
aWall.Vertices.AddVertex (vd[4]);
aWall.Vertices.AddVertex (vd[5]);
aWall.Vertices.AddVertex (vd[6]);
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.AddFloor', E.Message);
end;
end;
procedure Tfrm3D.AddFloor(aFloor: TGLMesh; vs: array of TVector3f; aSide: T3DSide);
var
vd: TVertexData;
pN, pP: TVector3f;
pN2: TVector3f;
vs0, vs1, vs2: TVector3f;
mat: TAffineMatrix;
i, k, Cnt: Integer;
Angle1, Angle2, ResAng: Double;
dp1, dp2: TDoublePoint;
begin
try
Cnt := Length(vs);
//pN := CalcPlaneNormal (vs[0], vs[1], vs[2]);
pN2[0] := 0;
pN2[1] := 1;
pN2[2] := 0;
if Cnt >= 3 then
begin
for k := 0 to Cnt - 3 do
begin
dp1 := DoublePoint(vs[0][0], vs[0][2], vs[0][1]);
dp2 := DoublePoint(vs[k + 1][0], vs[k + 1][2], vs[k + 1][1]);
Angle1 := GetLineAngle(dp1, dp2);
dp1 := DoublePoint(vs[k + 1][0], vs[k + 1][2], vs[k + 1][1]);
dp2 := DoublePoint(vs[k + 2][0], vs[k + 2][2], vs[k + 2][1]);
Angle2 := GetLineAngle(dp1, dp2);
ResAng := abs(Angle1 - Angle2);
if ResAng < 180 then
begin
pN := CalcPlaneNormal (vs[0], vs[k + 1], vs[k + 2]);
if (not isNaN(pN[0])) and (Not IsNaN(pN[1])) and (Not IsNaN(pN[2])) then
break;
end;
end;
if k > (Cnt - 1) then
k := 0;
SetVector(vs0, vs[0]);
SetVector(vs1, vs[k + 1]);
SetVector(vs2, vs[k + 2]);
end
else
begin
vs0[0] := 0; vs0[1] := 0; vs0[2] := 0;
vs1[0] := 100; vs1[1] := 0; vs1[2] := 0;
vs2[0] := 100; vs2[1] := 0; vs2[2] := 100;
end;
pN := CalcPlaneNormal (vs0, vs1, vs2);
SetVector (mat[2], pN);
SetVector (mat[0], VectorNormalize (VectorSubtract (vs1, vs0)));
SetVector (mat[1], VectorCrossProduct (mat[2], mat[0]));
InvertMatrix (mat);
for i := 0 to Cnt - 1 do
begin
vd.coord := vs[i];
vd.normal := pN;
pP := VectorTransform (vs[i], mat);
vd.textCoord := TexPointMake (pP[0], pP[1]);
aFloor.Vertices.AddVertex (vd);
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.AddFloor', E.Message);
end;
end;
procedure Tfrm3D.UpdateModelTree;
var
i, j, k, ii, jj, kk: integer;
xModelNode, xListNode, xRoomNode, xCeilingNode, xFloorNode, xWallNode, xWallElementNode, xBalconElementNode, xSlopeNode, xSideNode, xNode: TTreeNode;
xRoom: T3DRoom;
xWall: T3DWall;
xWallElement: T3DWallElement;
xBalconElement: T3DBalconElement;
xSlope: T3DSlope;
xSide: T3DSide;
Str: string;
begin
try
xModelNode := ModelTree.Items.GetFirstNode;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>
Str := FCAD.FCADListName + ' ' + IntToStr(FCAD.FCADListIndex);
xListNode:= ModelTree.Items.AddChild(xModelNode, Str);
xListNode.Data := FCAD;
xListNode.ImageIndex := 1;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
for i := 0 to F3DModel.FRooms.Count - 1 do
begin
xRoom := T3DRoom(F3DModel.FRooms[i]);
if (xRoom.FListID <> FCAD.FCADListID) or (not xRoom.FVisible) then
continue;
xRoomNode:= ModelTree.Items.AddChild(xListNode, xRoom.FName);
xRoomNode.Data := xRoom;
xRoomNode.ImageIndex := 47;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
xSide := xRoom.FCeiling;
xNode := ModelTree.Items.AddChild(xRoomNode, xSide.FName);
xNode.Data := xSide;
xNode.ImageIndex := 56;
xSide.FFace.FTreeNode := xNode;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
xSide := xRoom.FFloor;
xNode := ModelTree.Items.AddChild(xRoomNode, xSide.FName);
xNode.Data := xSide;
xNode.ImageIndex := 56;
xSide.FFace.FTreeNode := xNode;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
for j := 0 to xRoom.FWalls.Count - 1 do
begin
xWall := T3DWall(xRoom.FWalls[j]);
xWallNode:= ModelTree.Items.AddChild(xRoomNode, xWall.FName);
xWallNode.Data := xWall;
xWallNode.ImageIndex := 49;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>
for k := 0 to xWall.FWallElements.Count - 1 do
begin
xWallElement := T3DWallElement(xWall.FWallElements[k]);
// <20><><EFBFBD><EFBFBD>
if xWallElement.FElementType = dotWindow then
begin
xWallElementNode := ModelTree.Items.AddChild(xWallNode, xWallElement.FName);
xWallElementNode.Data := xWallElement;
xWallElementNode.ImageIndex := 52;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
for ii := 0 to xWallElement.FSlopes.Count - 1 do
begin
xSlope := T3DSlope(xWallElement.FSlopes[ii]);
xSlopeNode := ModelTree.Items.AddChild(xWallElementNode, xSlope.FName);
xSlopeNode.Data := xSlope;
xSlopeNode.ImageIndex := 57;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
for jj := 0 to xSlope.FSides.Count - 1 do
begin
xSide := T3DSide(xSlope.FSides[jj]);
xNode := ModelTree.Items.AddChild(xSlopeNode, xSide.FName);
xNode.Data := xSide;
xNode.ImageIndex := 50;
xSide.FFace.FTreeNode := xNode;
end;
end;
end;
// <20><><EFBFBD><EFBFBD><EFBFBD>
if xWallElement.FElementType = dotDoor then
begin
xWallElementNode:= ModelTree.Items.AddChild(xWallNode, xWallElement.FName);
xWallElementNode.Data := xWallElement;
xWallElementNode.ImageIndex := 51;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
for ii := 0 to xWallElement.FSlopes.Count - 1 do
begin
xSlope := T3DSlope(xWallElement.FSlopes[ii]);
xSlopeNode := ModelTree.Items.AddChild(xWallElementNode, xSlope.FName);
xSlopeNode.Data := xSlope;
xSlopeNode.ImageIndex := 57;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
for jj := 0 to xSlope.FSides.Count - 1 do
begin
xSide := T3DSide(xSlope.FSides[jj]);
xNode := ModelTree.Items.AddChild(xSlopeNode, xSide.FName);
xNode.Data := xSide;
xNode.ImageIndex := 50;
xSide.FFace.FTreeNode := xNode;
end;
end;
end;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
if xWallElement.FElementType = dotBalcony then
begin
xWallElementNode:= ModelTree.Items.AddChild(xWallNode, xWallElement.FName);
xWallElementNode.Data := xWallElement;
xWallElementNode.ImageIndex := 55;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
for ii := 0 to xWallElement.FSlopes.Count - 1 do
begin
xSlope := T3DSlope(xWallElement.FSlopes[ii]);
xSlopeNode := ModelTree.Items.AddChild(xWallElementNode, xSlope.FName);
xSlopeNode.Data := xSlope;
xSlopeNode.ImageIndex := 57;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
for jj := 0 to xSlope.FSides.Count - 1 do
begin
xSide := T3DSide(xSlope.FSides[jj]);
xNode := ModelTree.Items.AddChild(xSlopeNode, xSide.FName);
xNode.Data := xSide;
xNode.ImageIndex := 50;
xSide.FFace.FTreeNode := xNode;
end;
end;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
for ii := 0 to xWallElement.FBalconElements.Count - 1 do
begin
xBalconElement := T3DBalconElement(xWallElement.FBalconElements[ii]);
if xBalconElement.FElementType = dotDoor then
begin
xBalconElementNode := ModelTree.Items.AddChild(xWallElementNode, xBalconElement.FName);
xBalconElementNode.ImageIndex := 51;
end;
if xBalconElement.FElementType = dotWindow then
begin
xBalconElementNode := ModelTree.Items.AddChild(xWallElementNode, xBalconElement.FName);
xBalconElementNode.ImageIndex := 52;
end;
xBalconElementNode.Data := xBalconElement;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
for jj := 0 to xBalconElement.FSides.Count - 1 do
begin
xSide := T3DSide(xBalconElement.FSides[jj]);
xNode := ModelTree.Items.AddChild(xBalconElementNode, xSide.FName);
xNode.Data := xSide;
xNode.ImageIndex := 50;
xSide.FFace.FTreeNode := xNode;
end;
end;
end;
// <20><><EFBFBD><EFBFBD>
if xWallElement.FElementType = dotNiche then
begin
xWallElementNode:= ModelTree.Items.AddChild(xWallNode, xWallElement.FName);
xWallElementNode.Data := xWallElement;
xWallElementNode.ImageIndex := 53;
end;
// <20><><EFBFBD><EFBFBD>
if xWallElement.FElementType = dotArc then
begin
xWallElementNode:= ModelTree.Items.AddChild(xWallNode, xWallElement.FName);
xWallElementNode.Data := xWallElement;
xWallElementNode.ImageIndex := 54;
end;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>
for ii := 0 to xWallElement.FSides.Count - 1 do
begin
xSide := T3DSide(xWallElement.FSides[ii]);
xNode := ModelTree.Items.AddChild(xWallElementNode, xSide.FName);
xNode.Data := xSide;
xNode.ImageIndex := 50;
xSide.FFace.FTreeNode := xNode;
end;
end;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>
for k := 0 to xWall.FSides.Count - 1 do
begin
xSide := T3DSide(xWall.FSides[k]);
xNode := ModelTree.Items.AddChild(xWallNode, xSide.FName);
xNode.Data := xSide;
xNode.ImageIndex := 50;
xSide.FFace.FTreeNode := xNode;
end;
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.UpdateModelTree', E.Message);
end;
end;
procedure Tfrm3D.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;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>
Str := FCAD.FCADListName + ' ' + IntToStr(FCAD.FCADListIndex);
xListNode:= ScsModelTree.Items.AddChild(xModelNode, Str);
xListNode.Data := FCAD;
xListNode.ImageIndex := 1;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
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;
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;
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: integer;
xModelNode, xListNode, xRoomNode, xCeilingNode, xFloorNode, xWallNode, xWallElementNode, xBalconElementNode, xSlopeNode, xSideNode, x3DSNode, xNode, xSubNode: TTreeNode;
xRoom, xStrRoom: T3DRoom;
xWall, xStrWall: T3DWall;
xWallElement, xStrWallElement: T3DWallElement;
xBalconElement, xStrBalconElement: T3DBalconElement;
xSlope, xStrSlope: T3DSlope;
xSide, xStrSide, xAddSide, xSubSide, xStrSubSide: T3DSide;
xObject, xStrObject: T3DSObject;
FName: string;
Str: string;
begin
try
xModelNode := ModelTree.Items.GetFirstNode;
CopyModelHash;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>
Str := FCAD.FCADListName + ' ' + IntToStr(FCAD.FCADListIndex);
xListNode:= ModelTree.Items.AddChild(xModelNode, Str);
xListNode.Data := FCAD;
xListNode.ImageIndex := 1;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
for i := 0 to F3DModel.FRooms.Count - 1 do
begin
xRoom := T3DRoom(F3DModel.FRooms[i]);
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;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
xSide := xRoom.FCeiling;
xStrSide := GetSimilarSide(xSide, xStrRoom);
xNode := ModelTree.Items.AddChild(xRoomNode, xSide.FName);
xNode.Data := xSide;
xNode.ImageIndex := 56;
xSide.FFace.FTreeNode := xNode;
if xStrSide <> nil then
begin
CopySideProperties(xSide, xStrSide);
if xStrSide.FSubSides.Count > 0 then
begin
Faces.Remove(xSide.FFace);
for iadd := 0 to xStrSide.FSubSides.Count - 1 do
begin
xStrSubSide := T3DSide(xStrSide.FSubSides[iadd]);
xSubSide := CopySubSideProperties(xStrSubSide);
xSubNode := ModelTree.Items.AddChild(xNode, xSubSide.FName);
xSubNode.Data := xSubSide;
xSubNode.ImageIndex := 56;
xSubSide.FFace.FTreeNode := xSubNode;
Faces.Add(xSubSide.FFace);
xSubSide.FParent := xSide;
xSide.FSubSides.Add(xSubSide);
end;
end;
end;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
xSide := xRoom.FFloor;
xStrSide := GetSimilarSide(xSide, xStrRoom);
xNode := ModelTree.Items.AddChild(xRoomNode, xSide.FName);
xNode.Data := xSide;
xNode.ImageIndex := 56;
xSide.FFace.FTreeNode := xNode;
if xStrSide <> nil then
begin
CopySideProperties(xSide, xStrSide);
if xStrSide.FSubSides.Count > 0 then
begin
Faces.Remove(xSide.FFace);
for iadd := 0 to xStrSide.FSubSides.Count - 1 do
begin
xStrSubSide := T3DSide(xStrSide.FSubSides[iadd]);
xSubSide := CopySubSideProperties(xStrSubSide);
xSubNode := ModelTree.Items.AddChild(xNode, xSubSide.FName);
xSubNode.Data := xSubSide;
xSubNode.ImageIndex := 56;
xSubSide.FFace.FTreeNode := xSubNode;
Faces.Add(xSubSide.FFace);
xSubSide.FParent := xSide;
xSide.FSubSides.Add(xSubSide);
end;
end;
end;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> 3<><33> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
// !!! <20><><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
if xStrSide <> nil then
begin
for j := 0 to xStrRoom.F3DSObjects.Count - 1 do
begin
FName := GetObjectFileByHash(T3DSObject(xStrRoom.F3DSObjects[j]).FObjectHash);
if FileExists(FName) then
begin
xStrObject := T3DSObject(xStrRoom.F3DSObjects[j]);
xObject := CopyObjectProperties(nil, xStrObject);
xNode := ModelTree.Items.AddChild(xRoomNode, xObject.FName);
xNode.Data := xObject;
xNode.ImageIndex := 42;
xObject.FFace.FTreeNode := xNode;
Faces.Add(xObject.FFace);
xObject.FParent := xRoom;
xRoom.F3DSObjects.Add(xObject);
end;
end;
end;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
for j := 0 to xRoom.FWalls.Count - 1 do
begin
xWall := T3DWall(xRoom.FWalls[j]);
xStrWall := T3DWall(getModelObjectByComponID(xWall.FSCSComponID));
xWallNode:= ModelTree.Items.AddChild(xRoomNode, xWall.FName);
xWallNode.Data := xWall;
xWallNode.ImageIndex := 49;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>
for k := 0 to xWall.FWallElements.Count - 1 do
begin
xWallElement := T3DWallElement(xWall.FWallElements[k]);
xStrWallElement := T3DWallElement(getModelObjectByComponID(xWallElement.FSCSComponID));
// <20><><EFBFBD><EFBFBD>
if xWallElement.FElementType = dotWindow then
begin
xWallElementNode := ModelTree.Items.AddChild(xWallNode, xWallElement.FName);
xWallElementNode.Data := xWallElement;
xWallElementNode.ImageIndex := 52;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
for ii := 0 to xWallElement.FSlopes.Count - 1 do
begin
xSlope := T3DSlope(xWallElement.FSlopes[ii]);
xStrSlope := T3DSlope(getModelObjectByComponID(xSlope.FSCSComponID));
xSlopeNode := ModelTree.Items.AddChild(xWallElementNode, xSlope.FName);
xSlopeNode.Data := xSlope;
xSlopeNode.ImageIndex := 57;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
for jj := 0 to xSlope.FSides.Count - 1 do
begin
xSide := T3DSide(xSlope.FSides[jj]);
xStrSide := GetSimilarSide(xSide, xStrSlope);
xNode := ModelTree.Items.AddChild(xSlopeNode, xSide.FName);
xNode.Data := xSide;
xNode.ImageIndex := 50;
xSide.FFace.FTreeNode := xNode;
if xStrSide <> nil then
begin
CopySideProperties(xSide, xStrSide);
if xStrSide.FSubSides.Count > 0 then
begin
Faces.Remove(xSide.FFace);
for iadd := 0 to xStrSide.FSubSides.Count - 1 do
begin
xStrSubSide := T3DSide(xStrSide.FSubSides[iadd]);
xSubSide := CopySubSideProperties(xStrSubSide);
xSubNode := ModelTree.Items.AddChild(xNode, xSubSide.FName);
xSubNode.Data := xSubSide;
xSubNode.ImageIndex := 56;
xSubSide.FFace.FTreeNode := xSubNode;
Faces.Add(xSubSide.FFace);
xSubSide.FParent := xSide;
xSide.FSubSides.Add(xSubSide);
end;
end;
end;
end;
end;
end;
// <20><><EFBFBD><EFBFBD><EFBFBD>
if xWallElement.FElementType = dotDoor then
begin
xWallElementNode:= ModelTree.Items.AddChild(xWallNode, xWallElement.FName);
xWallElementNode.Data := xWallElement;
xWallElementNode.ImageIndex := 51;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
for ii := 0 to xWallElement.FSlopes.Count - 1 do
begin
xSlope := T3DSlope(xWallElement.FSlopes[ii]);
xStrSlope := T3DSlope(getModelObjectByComponID(xSlope.FSCSComponID));
xSlopeNode := ModelTree.Items.AddChild(xWallElementNode, xSlope.FName);
xSlopeNode.Data := xSlope;
xSlopeNode.ImageIndex := 57;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
for jj := 0 to xSlope.FSides.Count - 1 do
begin
xSide := T3DSide(xSlope.FSides[jj]);
xStrSide := GetSimilarSide(xSide, xStrSlope);
xNode := ModelTree.Items.AddChild(xSlopeNode, xSide.FName);
xNode.Data := xSide;
xNode.ImageIndex := 50;
xSide.FFace.FTreeNode := xNode;
if xStrSide <> nil then
begin
CopySideProperties(xSide, xStrSide);
if xStrSide.FSubSides.Count > 0 then
begin
Faces.Remove(xSide.FFace);
for iadd := 0 to xStrSide.FSubSides.Count - 1 do
begin
xStrSubSide := T3DSide(xStrSide.FSubSides[iadd]);
xSubSide := CopySubSideProperties(xStrSubSide);
xSubNode := ModelTree.Items.AddChild(xNode, xSubSide.FName);
xSubNode.Data := xSubSide;
xSubNode.ImageIndex := 56;
xSubSide.FFace.FTreeNode := xSubNode;
Faces.Add(xSubSide.FFace);
xSubSide.FParent := xSide;
xSide.FSubSides.Add(xSubSide);
end;
end;
end;
end;
end;
end;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
if xWallElement.FElementType = dotBalcony then
begin
xWallElementNode:= ModelTree.Items.AddChild(xWallNode, xWallElement.FName);
xWallElementNode.Data := xWallElement;
xWallElementNode.ImageIndex := 55;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
for ii := 0 to xWallElement.FSlopes.Count - 1 do
begin
xSlope := T3DSlope(xWallElement.FSlopes[ii]);
xStrSlope := T3DSlope(getModelObjectByComponID(xSlope.FSCSComponID));
xSlopeNode := ModelTree.Items.AddChild(xWallElementNode, xSlope.FName);
xSlopeNode.Data := xSlope;
xSlopeNode.ImageIndex := 57;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
for jj := 0 to xSlope.FSides.Count - 1 do
begin
xSide := T3DSide(xSlope.FSides[jj]);
xStrSide := GetSimilarSide(xSide, xStrSlope);
xNode := ModelTree.Items.AddChild(xSlopeNode, xSide.FName);
xNode.Data := xSide;
xNode.ImageIndex := 50;
xSide.FFace.FTreeNode := xNode;
if xStrSide <> nil then
begin
CopySideProperties(xSide, xStrSide);
if xStrSide.FSubSides.Count > 0 then
begin
Faces.Remove(xSide.FFace);
for iadd := 0 to xStrSide.FSubSides.Count - 1 do
begin
xStrSubSide := T3DSide(xStrSide.FSubSides[iadd]);
xSubSide := CopySubSideProperties(xStrSubSide);
xSubNode := ModelTree.Items.AddChild(xNode, xSubSide.FName);
xSubNode.Data := xSubSide;
xSubNode.ImageIndex := 56;
xSubSide.FFace.FTreeNode := xSubNode;
Faces.Add(xSubSide.FFace);
xSubSide.FParent := xSide;
xSide.FSubSides.Add(xSubSide);
end;
end;
end;
end;
end;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
for ii := 0 to xWallElement.FBalconElements.Count - 1 do
begin
xBalconElement := T3DBalconElement(xWallElement.FBalconElements[ii]);
xStrBalconElement := T3DBalconElement(getModelObjectByComponID(xBalconElement.FSCSComponID));
if xBalconElement.FElementType = dotDoor then
begin
xBalconElementNode := ModelTree.Items.AddChild(xWallElementNode, xBalconElement.FName);
xBalconElementNode.ImageIndex := 51;
end;
if xBalconElement.FElementType = dotWindow then
begin
xBalconElementNode := ModelTree.Items.AddChild(xWallElementNode, xBalconElement.FName);
xBalconElementNode.ImageIndex := 52;
end;
xBalconElementNode.Data := xBalconElement;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
for jj := 0 to xBalconElement.FSides.Count - 1 do
begin
xSide := T3DSide(xBalconElement.FSides[jj]);
xStrSide := GetSimilarSide(xSide, xStrBalconElement);
xNode := ModelTree.Items.AddChild(xBalconElementNode, xSide.FName);
xNode.Data := xSide;
xNode.ImageIndex := 50;
xSide.FFace.FTreeNode := xNode;
if xStrSide <> nil then
begin
CopySideProperties(xSide, xStrSide);
if xStrSide.FSubSides.Count > 0 then
begin
Faces.Remove(xSide.FFace);
for iadd := 0 to xStrSide.FSubSides.Count - 1 do
begin
xStrSubSide := T3DSide(xStrSide.FSubSides[iadd]);
xSubSide := CopySubSideProperties(xStrSubSide);
xSubNode := ModelTree.Items.AddChild(xNode, xSubSide.FName);
xSubNode.Data := xSubSide;
xSubNode.ImageIndex := 56;
xSubSide.FFace.FTreeNode := xSubNode;
Faces.Add(xSubSide.FFace);
xSubSide.FParent := xSide;
xSide.FSubSides.Add(xSubSide);
end;
end;
end;
end;
end;
end;
// <20><><EFBFBD><EFBFBD>
if xWallElement.FElementType = dotNiche then
begin
xWallElementNode:= ModelTree.Items.AddChild(xWallNode, xWallElement.FName);
xWallElementNode.Data := xWallElement;
xWallElementNode.ImageIndex := 53;
end;
// <20><><EFBFBD><EFBFBD>
if xWallElement.FElementType = dotArc then
begin
xWallElementNode:= ModelTree.Items.AddChild(xWallNode, xWallElement.FName);
xWallElementNode.Data := xWallElement;
xWallElementNode.ImageIndex := 54;
end;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>
for ii := 0 to xWallElement.FSides.Count - 1 do
begin
xSide := T3DSide(xWallElement.FSides[ii]);
xStrSide := GetSimilarSide(xSide, xStrWallElement);
xNode := ModelTree.Items.AddChild(xWallElementNode, xSide.FName);
xNode.Data := xSide;
xNode.ImageIndex := 50;
xSide.FFace.FTreeNode := xNode;
if xStrSide <> nil then
begin
CopySideProperties(xSide, xStrSide);
if xStrSide.FSubSides.Count > 0 then
begin
Faces.Remove(xSide.FFace);
for iadd := 0 to xStrSide.FSubSides.Count - 1 do
begin
xStrSubSide := T3DSide(xStrSide.FSubSides[iadd]);
xSubSide := CopySubSideProperties(xStrSubSide);
xSubNode := ModelTree.Items.AddChild(xNode, xSubSide.FName);
xSubNode.Data := xSubSide;
xSubNode.ImageIndex := 56;
xSubSide.FFace.FTreeNode := xSubNode;
Faces.Add(xSubSide.FFace);
xSubSide.FParent := xSide;
xSide.FSubSides.Add(xSubSide);
end;
end;
end;
end;
end;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>
for k := 0 to xWall.FSides.Count - 1 do
begin
xSide := T3DSide(xWall.FSides[k]);
xStrSide := GetSimilarSide(xSide, xStrWall);
xNode := ModelTree.Items.AddChild(xWallNode, xSide.FName);
xNode.Data := xSide;
xNode.ImageIndex := 50;
xSide.FFace.FTreeNode := xNode;
if xStrSide <> nil then
begin
CopySideProperties(xSide, xStrSide);
if xStrSide.FSubSides.Count > 0 then
begin
Faces.Remove(xSide.FFace);
for iadd := 0 to xStrSide.FSubSides.Count - 1 do
begin
xStrSubSide := T3DSide(xStrSide.FSubSides[iadd]);
xSubSide := CopySubSideProperties(xStrSubSide);
xSubNode := ModelTree.Items.AddChild(xNode, xSubSide.FName);
xSubNode.Data := xSubSide;
xSubNode.ImageIndex := 56;
xSubSide.FFace.FTreeNode := xSubNode;
Faces.Add(xSubSide.FFace);
xSubSide.FParent := xSide;
xSide.FSubSides.Add(xSubSide);
end;
end;
end;
end;
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.UpdateModelTreeFromStream', E.Message);
end;
end;
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;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>
Str := FCAD.FCADListName + ' ' + IntToStr(FCAD.FCADListIndex);
xListNode:= ScsModelTree.Items.AddChild(xModelNode, Str);
xListNode.Data := FCAD;
xListNode.ImageIndex := 1;
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;
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;
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;
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) 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);
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;
begin
try
if ModelTree.Selected <> nil then
begin
ClearSelected := False;
for i := 0 to ModelTree.SelectionCount - 1 do
begin
xNode := ModelTree.Selections[i];
if TObject(xNode.Data) is T3DSObject then
ClearSelected := True;
if TObject(xNode.Data).ClassName <> TObject(ModelTree.Selected.Data).ClassName then
ClearSelected := True;
end;
if ClearSelected then
begin
xNode := ModelTree.Selected;
ModelTree.ClearSelection;
xNode.Selected := True;
end;
xNodes := TList.create;
for i := 0 to ModelTree.SelectionCount - 1 do
begin
xNode := ModelTree.Selections[i];
xNodes.Add(xNode);
end;
OnSelectNodes(xNodes);
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.ModelTreeClick', E.Message);
end;
end;
procedure Tfrm3D.OnSelectNodes(aNodes: TList);
var
i: Integer;
xNode: TTreeNode;
xObjects: TList;
begin
try
// <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD>
xObjects := FindGLObjectsByNodes(aNodes);
FNodes.Clear;
for i := 0 to aNodes.Count - 1 do
FNodes.Add(aNodes.Items[i]);
if not Assigned(TimerOnSelectNodes.OnTimer) then
begin
FxObjects.Clear;
for i := 0 to xObjects.Count - 1 do
FxObjects.Add(xObjects.Items[i]);
TimerOnSelectNodes.OnTimer := TimerOnSelectNodesTimer;
TimerOnSelectNodes.Tag := 1;
TimerOnSelectNodes.Enabled := True;
end;
{
DeselectGLObjects;
// Select objects
SelectGLObjects(xObjects);
}
// Show Properties
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.OnSelectNodes', E.Message);
end;
end;
procedure Tfrm3D.FormCreate(Sender: TObject);
begin
FSelection := TList.Create;
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;
end;
function Tfrm3D.FindGLObjectsByNodes(aNodes: TList): TList;
var
i: integer;
xObj: TGLBaseSceneObject;
xNode: TTreeNode;
xNodes: TList;
begin
try
Result := TList.Create;
xNodes := GetAllSidesNodesByNodes(aNodes);
for i := 0 to xNodes.Count - 1 do
begin
xNode := TTreeNode(xNodes[i]);
if (TObject(xNode.Data) is T3DSide) then
xObj := TGLBaseSceneObject(T3DSide(xNode.Data).FGLObject);
if (TObject(xNode.Data) is T3DSObject) then
xObj := TGLBaseSceneObject(T3DSObject(xNode.Data).FGLObject);
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);
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: integer;
xObj: TGLBaseSceneObject;
xConn, JoinConn1, JoinConn2: T3DConnector;
xLine: T3DLine;
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;
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;
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} // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD> <20><> <20><> <20><><EFBFBD> <20><> UP3 <20><> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
// 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;
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
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;
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]);
// <20><><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>, <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><>
if (TObject(xNode.Data) is T3DSide) then
begin
if TTreeNode(aObject.TagObject) = xNode then
begin
Result := True;
exit;
end;
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.CheckGLObjectInSelectionNodes', E.Message);
end;
end;
function Tfrm3D.GetAllSidesNodesByNodes(aNodes: TList): TList;
var
i, j: integer;
xNode: TTreeNode;
xNodes: TList;
begin
try
Result := TList.Create;
for i := 0 to aNodes.Count - 1 do
begin
xNode := TTreeNode(aNodes[i]);
if (TObject(xNode.Data) is T3DSide) and (T3DSide(xNode.Data).FSubSides.Count = 0) 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
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);
StepGetAllChildNodes(CurrNode);
CurrNode := CurrNode.GetNextSibling;
end;
end;
begin
Result := TList.Create;
StepGetAllChildNodes(ANode);
end;
procedure Tfrm3D.FormDestroy(Sender: TObject);
begin
if FSelection <> nil then
FreeAndNil(FSelection);
if FPropObjects <> nil then
FreeAndNil(FPropObjects);
if FxObjects <> nil then
FreeAndNil(FxObjects);
if FNodes <> nil then
FreeAndNil(FNodes);
end;
function Tfrm3D.GetPropViewType(aNodes: TList): TPropViewType;
var
i: integer;
xNode: TTreeNode;
begin
try
Result := pvtNone;
if aNodes.Count > 0 then
begin
if aNodes.Count = 1 then
begin
if (TObject(TTreeNode(aNodes[0]).Data) is T3DSide) then
Result := pvtSingleSide;
if (TObject(TTreeNode(aNodes[0]).Data) is T3DSObject) then
Result := pvtSingle3ds;
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
xObject := T3DSide(TTreeNode(aObjects[i]).Data);
xGLObject := TGLBaseSceneObject(xObject.FGLObject);
if i = 0 then
begin
xRotate := xObject.FTextureRotate;
xScale := xObject.FTextureScale;
xMirror := xObject.FMirror;
edTextureRotate.Text := IntToStr(xObject.FTextureRotate);
edTextureScale.Text := IntToStr(xObject.FTextureScale);
cbMirror.Checked := xObject.FMirror;
xCnt := Length(xObject.FGLPoints);
end
else
begin
if edTextureRotate.Text <> '' then
if xRotate <> xObject.FTextureRotate then
edTextureRotate.Text := '';
if edTextureScale.Text <> '' then
if xScale <> xObject.FTextureScale then
edTextureScale.Text := '';
if cbMirror.AllowGrayed = False then
if xMirror <> xObject.FMirror then
cbMirror.AllowGrayed := True;
if xCnt <> - 1 then
if xCnt <> Length(xObject.FGLPoints) then
xCnt := -1;
end;
end;
if xCnt > 0 then
begin
//panCoords.Enabled := True;
for i := 0 to xCnt - 1 do
begin
CoordsInfo := '';{' (' + FloatToStr(xObject.FGLPoints[i].x) + '; ' +
FloatToStr(xObject.FGLPoints[i].y) + '; ' +
FloatToStr(xObject.FGLPoints[i].z) + ')';}
cbCoordNbr.Properties.Items.Add(InttoStr(i + 1) + CoordsInfo);
end;
cbCoordNbr.Text := cbCoordNbr.Properties.Items[0];
edCoordX.Text := '';
edCoordY.Text := '';
edCoordZ.Text := '';
end
else
begin
//panCoords.Enabled := False;
end;
imgSideTexture.Clear;
cbSideHashs.Properties.Items.Clear;
for i := 0 to F3DModel.FHashs.Count - 1 do
begin
cbSideHashs.Properties.Items.Add(F3DModel.FHashs.Strings[i]);
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.LoadPropertiesForMultiObjects', E.Message);
end;
end;
function Tfrm3D.LoadPropertiesForSingleObject(aObject: TTreeNode): TPropRecord;
var
i: integer;
xObject: T3DSide;
xGLObject: TGLBaseSceneObject;
Points: T3DPointArray;
Cnt: Integer;
CoordsInfo: string;
tmpdir, tmpfname: string;
begin
try
xObject := T3DSide(aObject.Data);
xGLObject := TGLBaseSceneObject(xObject.FGLObject);
edName.Text := xObject.FName;
mDesc.Clear;
for i := 0 to xObject.FDescription.Count - 1 do
mDesc.Lines.Add(xObject.FDescription[i]);
if Pos('empty', AnsiLowerCase(mDesc.Lines.Text)) = 1 then
begin
if xGLObject <> nil then
begin
xGLObject.Visible := False;
if xObject.FAsArc and (AnsiLowerCase(xObject.ClassName) <> 't3dsobject') then
RotateTextureToAngleP(xObject, TGLPolygon(xGLObject), xObject.FTextureRotate, xObject.FMirror);
end;
btnEmpty.GroupIndex := 1;
btnEmpty.Down := True;
if aObject.ImageIndex < 999 then
aObject.ImageIndex := aObject.ImageIndex + 1000;
end
else
begin
btnEmpty.GroupIndex := 0;
btnEmpty.Down := False;
if xGLObject <> nil then
begin
xGLObject.Visible := True;
if xObject.FAsArc and (AnsiLowerCase(xObject.ClassName) <> 't3dsobject') then
RotateTextureToAngleP(xObject, TGLPolygon(xGLObject), xObject.FTextureRotate, xObject.FMirror);
end;
if aObject.ImageIndex > 999 then
aObject.ImageIndex := aObject.ImageIndex - 1000;
end;
edTextureRotate.Text := IntToStr(xObject.FTextureRotate);
edTextureScale.Text := IntToStr(xObject.FTextureScale);
cbMirror.Checked := xObject.FMirror;
cbCoordNbr.Properties.Items.Clear;
Cnt := Length(xObject.FGLPoints);
for i := 0 to Cnt - 1 do
begin
CoordsInfo := '';{' (' + FloatToStr(xObject.FGLPoints[i].x) + '; ' +
FloatToStr(xObject.FGLPoints[i].y) + '; ' +
FloatToStr(xObject.FGLPoints[i].z) + ')';}
cbCoordNbr.Properties.Items.Add(InttoStr(i + 1) + CoordsInfo);
end;
cbCoordNbr.Text := cbCoordNbr.Properties.Items[0];
edCoordX.Text := FloatToStr(xObject.FGLPoints[0].x);
edCoordY.Text := FloatToStr(xObject.FGLPoints[0].y);
edCoordZ.Text := FloatToStr(xObject.FGLPoints[0].z);
imgSideTexture.Clear;
tmpfname := GetImageFileByHash(xObject.FTextureHash);
if tmpfname <> '' then
imgSideTexture.Picture.LoadFromFile(tmpfname);
cbSideHashs.Properties.Items.Clear;
for i := 0 to F3DModel.FHashs.Count - 1 do
begin
cbSideHashs.Properties.Items.Add(F3DModel.FHashs.Strings[i]);
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.LoadPropertiesForSingleObject', E.Message);
end;
end;
function Tfrm3D.LoadPropertiesForSingle3ds(aObject: TTreeNode): TPropRecord;
var
i: integer;
xObject: T3DSObject;
xGLObject: TGLBaseSceneObject;
tmpdir, tmpfname: string;
begin
try
xObject := T3DSObject(aObject.Data);
xGLObject := TGLBaseSceneObject(xObject.FGLObject);
edName.Text := xObject.FName;
mDesc.Clear;
for i := 0 to xObject.FDescription.Count - 1 do
mDesc.Lines.Add(xObject.FDescription[i]);
edPosX.Text := FloatToStr(xObject.FPosition.x);
edPosY.Text := FloatToStr(xObject.FPosition.y);
edPosZ.Text := FloatToStr(xObject.FPosition.z);
edAngleX.Text := FloatToStr(xObject.FRotate.x);
edAngleY.Text := FloatToStr(xObject.FRotate.y);
edAngleZ.Text := FloatToStr(xObject.FRotate.z);
edScaleX.Text := FloatToStr(xObject.FScale.x);
edScaleY.Text := FloatToStr(xObject.FScale.y);
edScaleZ.Text := FloatToStr(xObject.FScale.z);
imgObjectTexture.Clear;
tmpfname := GetImageFileByHash(xObject.FTextureHash);
if tmpfname <> '' then
imgObjectTexture.Picture.LoadFromFile(tmpfname);
cbObjectHashs.Properties.Items.Clear;
for i := 0 to F3DModel.FHashs.Count - 1 do
begin
cbObjectHashs.Properties.Items.Add(F3DModel.FHashs.Strings[i]);
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.LoadPropertiesForSingle3ds', E.Message);
end;
end;
function Tfrm3D.LoadPropertiesForMulti3ds(aObjects: TList): TPropRecord;
var
i: integer;
xObject: T3DSObject;
xGLObject: TGLBaseSceneObject;
Points: T3DPointArray;
Cnt: Integer;
xPosX, xPosY, xPosZ, xAngleX, xAngleY, xAngleZ, xScaleX, xScaleY, xScaleZ: Double;
begin
try
mDesc.Clear;
for i := 0 to aObjects.Count - 1 do
begin
xObject := T3DSObject(TTreeNode(aObjects[i]).Data);
xGLObject := TGLBaseSceneObject(xObject.FGLObject);
if i = 0 then
begin
xPosX := xObject.FPosition.x;
edPosX.Text := FloatToStr(xPosX);
xPosY := xObject.FPosition.y;
edPosY.Text := FloatToStr(xPosY);
xPosZ := xObject.FPosition.z;
edPosZ.Text := FloatToStr(xPosZ);
xAngleX := xObject.FRotate.x;
edAngleX.Text := FloatToStr(xAngleX);
xAngleY := xObject.FRotate.y;
edAngleY.Text := FloatToStr(xAngleY);
xAngleZ := xObject.FRotate.z;
edAngleZ.Text := FloatToStr(xAngleZ);
xScaleX := xObject.FScale.x;
edScaleX.Text := FloatToStr(xScaleX);
xScaleY := xObject.FScale.y;
edScaleY.Text := FloatToStr(xScaleY);
xScaleZ := xObject.FScale.z;
edScaleZ.Text := FloatToStr(xScaleZ);
end
else
begin
if edPosX.Text <> '' then
if xPosX <> xObject.FPosition.x then
edPosX.Text := '';
if edPosY.Text <> '' then
if xPosY <> xObject.FPosition.y then
edPosY.Text := '';
if edPosZ.Text <> '' then
if xPosZ <> xObject.FPosition.z then
edPosZ.Text := '';
if edAngleX.Text <> '' then
if xAngleX <> xObject.FRotate.x then
edAngleX.Text := '';
if edAngleY.Text <> '' then
if xAngleY <> xObject.FRotate.y then
edAngleY.Text := '';
if edAngleZ.Text <> '' then
if xAngleZ <> xObject.FRotate.z then
edAngleZ.Text := '';
if edScaleX.Text <> '' then
if xScaleX <> xObject.FScale.x then
edScaleX.Text := '';
if edScaleY.Text <> '' then
if xScaleY <> xObject.FScale.y then
edScaleY.Text := '';
if edScaleZ.Text <> '' then
if xScaleZ <> xObject.FScale.z then
edScaleZ.Text := '';
end;
end;
imgObjectTexture.Clear;
cbObjectHashs.Properties.Items.Clear;
for i := 0 to F3DModel.FHashs.Count - 1 do
begin
cbObjectHashs.Properties.Items.Add(F3DModel.FHashs.Strings[i]);
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.LoadPropertiesForMulti3ds', E.Message);
end;
end;
procedure Tfrm3D.cbCoordNbrCloseUp(Sender: TObject);
var
Index: Integer;
xObject: T3DSide;
begin
try
Index := cbCoordNbr.ItemIndex;
if FPropObjects.Count > 0 then
begin
if FPropObjects.Count = 1 then
begin
xObject := T3DSide(TTreeNode(FPropObjects[0]).Data);
edCoordX.Text := FloatToStr(xObject.FGLPoints[Index].x);
edCoordY.Text := FloatToStr(xObject.FGLPoints[Index].y);
edCoordZ.Text := FloatToStr(xObject.FGLPoints[Index].z);
end
else
begin
edCoordX.Text := '';
edCoordY.Text := '';
edCoordZ.Text := '';
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.cbCoordNbrCloseUp', E.Message);
end;
end;
{ TPropRecord }
constructor TPropRecord.Create;
begin
inherited Create;
fCoords := TList.Create;
fDesc := TStringList.Create;
end;
procedure Tfrm3D.bSideTextureChangeClick(Sender: TObject);
var
i: integer;
FName: string;
xObject: T3DSide;
xGLObject: TGLBaseSceneObject;
tmpdir, tmpfname, ExtStr, BmpFName: string;
Bmp: TBitmap;
Jpeg: TJPEGImage;
HashStr: string;
begin
try
FName := LoadTexture;
if (FName <> '') and FileExists(FName) then
begin
imgSideTexture.Picture.LoadFromFile(FName);
ExtStr := ExtractFileExt(FName);
tmpdir := GetWorkDir; //ExtractDirByCategoryType(dctPictures);
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> HASH <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>
HashStr := GetImageHash(FName);
// <20><> HASH <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><> <20><> <20> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>
tmpfname := GetImageFileByHash(HashStr);
// <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>, <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD>
if tmpfname <> '' then
begin
end
else
// <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> - <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> HASH, <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD>, <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
begin
F3DModel.FHashs.Add(HashStr);
tmpfname := tmpdir + '\' + HashStr + '.bmp';
if (ExtStr = '.jpg') or (ExtStr = '.jpeg') then
begin
Bmp := TBitmap.Create;
Jpeg := TJPEGImage.Create;
jpeg.CompressionQuality := 100; {Default Value}
Jpeg.LoadFromFile(FName);
Bmp.Assign(Jpeg);
Bmp.SaveTofile(tmpfname);
FreeAndNil(Bmp);
FreeAndNil(Jpeg);
end
else
CopyFile(PChar(FName), PChar(tmpfname), True);
end;
for i := 0 to FPropObjects.Count - 1 do
begin
xObject := T3DSide(TTreeNode(FPropObjects[i]).Data);
xGLObject := TGLBaseSceneObject(xObject.FGLObject);
xObject.FTextureHash := HashStr;
xObject.FTexture_ext := ExtStr;
if (xGLObject is TGLPolygon) then
begin
TGLPolygon(xGLObject).Material.Texture.Disabled := False;
TGLPolygon(xGLObject).Material.Texture.DestroyHandles;
TGLPolygon(xGLObject).Material.Texture.Image.LoadFromFile(tmpfname);
RotateTextureToAngleP(xObject, TGLPolygon(xGLObject), xObject.FTextureRotate, xObject.FMirror);
end;
end;
// Resfresh HASHs
cbSideHashs.Properties.Items.Clear;
for i := 0 to F3DModel.FHashs.Count - 1 do
begin
cbSideHashs.Properties.Items.Add(F3DModel.FHashs.Strings[i]);
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.bTextureChangeClick', E.Message);
end;
end;
function Tfrm3D.LoadTexture: string;
begin
try
Result := '';
OpenTexture.InitialDir := ExeDir + '\3DTextures';
NoMoveEvent := True;
if OpenTexture.Execute then
begin
Result := OpenTexture.FileName;
end;
except
on E: Exception do AddExceptionToLogEx('', E.Message);
end;
end;
procedure Tfrm3D.edNameExit(Sender: TObject);
begin
ChangeName;
end;
procedure Tfrm3D.bSideTextureClearClick(Sender: TObject);
var
FName: string;
i: integer;
xObject: T3DSide;
xGLObject: TGLBaseSceneObject;
tmpdir, tmpfname, ExtStr, BmpFName: string;
Bmp: TBitmap;
Jpeg: TJPEGImage;
begin
try
for i := 0 to FPropObjects.Count - 1 do
begin
xObject := T3DSide(TTreeNode(FPropObjects[i]).Data);
xGLObject := TGLBaseSceneObject(xObject.FGLObject);
xObject.FTextureHash := '';
xObject.FTexture_ext := '';
if (xGLObject is TGLPolygon) then
begin
imgSideTexture.Clear;
TGLPolygon(xGLObject).Material.Texture.Disabled := True;
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.bTextureClearClick', E.Message);
end;
end;
procedure Tfrm3D.cbMirrorClick(Sender: TObject);
var
i: integer;
xObject: T3DSide;
xGLObject: TGLBaseSceneObject;
begin
try
for i := 0 to FPropObjects.Count - 1 do
begin
xObject := T3DSide(TTreeNode(FPropObjects[i]).Data);
xGLObject := TGLBaseSceneObject(xObject.FGLObject);
xObject.FMirror := cbMirror.Checked;
if (xGLObject is TGLPolygon) then
RotateTextureToAngleP(xObject, TGLPolygon(xGLObject), xObject.FTextureRotate, xObject.FMirror);
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.cbMirrorClick', E.Message);
end;
end;
procedure Tfrm3D.mDescEnter(Sender: TObject);
begin
ChangeDesc;
end;
procedure Tfrm3D.mDescExit(Sender: TObject);
begin
ChangeDesc;
end;
procedure Tfrm3D.edNameKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
ChangeName;
end;
procedure Tfrm3D.mDescKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
ChangeDesc;
end;
procedure Tfrm3D.edCoordXKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
ChangeCoordX;
end;
procedure Tfrm3D.edCoordXExit(Sender: TObject);
begin
ChangeCoordX;
end;
procedure Tfrm3D.edCoordYExit(Sender: TObject);
begin
ChangeCoordY;
end;
procedure Tfrm3D.edCoordYKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
ChangeCoordY;
end;
procedure Tfrm3D.edCoordZKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
ChangeCoordZ;
end;
procedure Tfrm3D.edCoordZExit(Sender: TObject);
begin
ChangeCoordZ;
end;
procedure Tfrm3D.edTextureRotateExit(Sender: TObject);
begin
ChangeTextureRotate;
end;
procedure Tfrm3D.edTextureRotateKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
ChangeTextureRotate;
end;
procedure Tfrm3D.ChangeCoordX;
var
i: integer;
xObject: T3DSide;
xGLObject: TGLBaseSceneObject;
Index: Integer;
p: TVector3f;
begin
try
if edCoordX.Text = '' then
exit;
Index := cbCoordNbr.ItemIndex;
for i := 0 to FPropObjects.Count - 1 do
begin
xObject := T3DSide(TTreeNode(FPropObjects[i]).Data);
xGLObject := TGLBaseSceneObject(xObject.FGLObject);
xObject.FGLPoints[Index].x := StrToFloat_My(edCoordX.Text);
xObject.FPoints[Index].x := StrToFloat_My(edCoordX.Text) / Factor;
if (xGLObject is TGLPolygon) then
begin
TGLPolygon(xGLObject).Nodes[Index].X := StrToFloat_My(edCoordX.Text);
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.ChangeCoordX', E.Message);
end;
end;
procedure Tfrm3D.ChangeCoordY;
var
i: integer;
xObject: T3DSide;
xGLObject: TGLBaseSceneObject;
Index: Integer;
p: TVector3f;
begin
try
if edCoordY.Text = '' then
exit;
Index := cbCoordNbr.ItemIndex;
for i := 0 to FPropObjects.Count - 1 do
begin
xObject := T3DSide(TTreeNode(FPropObjects[i]).Data);
xGLObject := TGLBaseSceneObject(xObject.FGLObject);
xObject.FGLPoints[Index].y := StrToFloat_My(edCoordY.Text);
xObject.FPoints[Index].z := StrToFloat_My(edCoordY.Text) / Factor;
if (xGLObject is TGLPolygon) then
begin
TGLPolygon(xGLObject).Nodes[Index].Y := StrToFloat_My(edCoordY.Text);
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.ChangeCoordY', E.Message);
end;
end;
procedure Tfrm3D.ChangeCoordZ;
var
i: integer;
xObject: T3DSide;
xGLObject: TGLBaseSceneObject;
Index: Integer;
p: TVector3f;
begin
try
if edCoordZ.Text = '' then
exit;
Index := cbCoordNbr.ItemIndex;
for i := 0 to FPropObjects.Count - 1 do
begin
xObject := T3DSide(TTreeNode(FPropObjects[i]).Data);
xGLObject := TGLBaseSceneObject(xObject.FGLObject);
xObject.FGLPoints[Index].z := StrToFloat_My(edCoordZ.Text);
xObject.FPoints[Index].y := StrToFloat_My(edCoordZ.Text) / Factor;
if (xGLObject is TGLPolygon) then
begin
TGLPolygon(xGLObject).Nodes[Index].Z := StrToFloat_My(edCoordZ.Text);
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.ChangeCoordZ', E.Message);
end;
end;
procedure Tfrm3D.ChangeDesc;
var
i, j: integer;
xObject: 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
TTreeNode(FPropObjects[i]).ImageIndex := TTreeNode(FPropObjects[i]).ImageIndex + 1000;
end
else
begin
btnEmpty.GroupIndex := 0;
btnEmpty.Down := False;
if xGLObject <> nil then
begin
xGLObject.Visible := True;
if xSide.FAsArc then
RotateTextureToAngleP(xSide, TGLPolygon(xGLObject), xSide.FTextureRotate, xSide.FMirror);
end;
if TTreeNode(FPropObjects[i]).ImageIndex > 999 then
TTreeNode(FPropObjects[i]).ImageIndex := TTreeNode(FPropObjects[i]).ImageIndex - 1000;
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
xObject := T3DSide(TTreeNode(FPropObjects[i]).Data);
xGLObject := TGLBaseSceneObject(xObject.FGLObject);
if StrToInt(edTextureRotate.Text) >= 360 then
edTextureRotate.Text := IntToStr(StrToInt(edTextureRotate.Text) mod 360);
xObject.FTextureRotate := StrToInt(edTextureRotate.Text);
if (xGLObject is TGLMesh) then
begin
RotateTextureToAngleM(xObject, TGLMesh(xGLObject), xObject.FTextureRotate, xObject.FMirror);
end;
if (xGLObject is TGLPolygon) then
begin
RotateTextureToAngleP(xObject, TGLPolygon(xGLObject), xObject.FTextureRotate, xObject.FMirror);
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.ChangeTextureRotate', E.Message);
end;
end;
//Alex(20.12.2010)
procedure Tfrm3D.sbFirstFaceClick(Sender: TObject);
begin
FirstPersonCamera.FocalLength := 100; //160;
DeselectGLObjects;
GLSceneViewer.SetFocus;
GLSceneViewer.Camera := FirstPersonCamera;
GLLightFirstPerson.Shining := True;
Light.Shining := False;
lbViewType.Caption := cForm3D_Mes5;
end;
procedure Tfrm3D.GLCadencerProgress(Sender: TObject; const deltaTime, newTime: Double);
var
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;
//<2F><><EFBFBD><EFBFBD><EFBFBD>
if IsKeyDown(VK_PRIOR) then
begin
if shiftDown then
behav.StrafeVertical(MovementScale*deltaTime)
else
behav.turnVertical(70*deltatime);
end;
//<2F><><EFBFBD><EFBFBD>
if IsKeyDown(VK_NEXT) then
begin
if shiftDown then
behav.StrafeVertical(-MovementScale*deltaTime)
else
behav.turnVertical(-70*deltatime);
end;
//<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>
if IsKeyDown(VK_LEFT) then
begin
if shiftDown then
behav.StrafeHorizontal(-MovementScale*deltaTime * 2)
else
behav.TurnHorizontal(-100*deltatime);
end;
//<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
if IsKeyDown(VK_RIGHT) then
begin
if shiftDown then
behav.StrafeHorizontal(MovementScale*deltaTime * 2)
else
behav.TurnHorizontal(100*deltatime);
end;
//<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
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;
//<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>
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);
//<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20> w
if (IsKeyDown('<27>') or IsKeyDown('w')) then
GLSceneViewer.Camera.Move(5 * deltaTime);
//<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20> s
if (IsKeyDown('<27>') or IsKeyDown('s')) then
GLSceneViewer.Camera.Move(-5 * deltaTime);
//<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20> a
if (IsKeyDown('<27>') or IsKeyDown('a')) then
GLSceneViewer.Camera.slide(-5 * deltaTime);
//<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20> d
if (IsKeyDown('<27>') or IsKeyDown('d')) then
GLSceneViewer.Camera.slide(5 * deltaTime);
if IsKeyDown(VK_ESCAPE) 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; //- <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> / <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
HW_koef: double; //- <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> / <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
f_find_other_GLObject: Boolean;
f_face_index: integer;
f_first_Object: T3DSide;
f_Face: TFaceRecord;
f_GLObject: TGLBaseSceneObject;
tmpdir: string;
tmpfname: string;
begin
try
f_find_other_GLObject := True;
f_face_index := 0;
f_first_Object := aObject;
f_GLObject := aGLObject;
tmpfname := '';
if (f_GLObject is TGLPolygon) and (f_GLObject.TagObject <> nil) then
begin
if (T3DSide(TTreeNode(f_GLObject.TagObject).Data).FAsArc) then
begin
//tmpdir := GetWorkDir; //ExtractDirByCategoryType(dctPictures);
//tmpfname := tmpdir + '\tmp.bmp';
//aGLObject.Material.Texture.Image.SaveToFile(tmpfname);
end;
end;
while f_find_other_GLObject do
begin
{TODO} // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
//if aObject.FAsArc then
begin
VCoords[1][0] := 0; VCoords[1][1] := 0; VCoords[1][2] := 0;
VCoords[2][0] := 100; VCoords[2][1] := 0; VCoords[2][2] := 0;
VCoords[3][0] := 100; VCoords[3][1] := 100; VCoords[3][2] := 0;
VCoords[4][0] := 0; VCoords[4][1] := 100; VCoords[4][2] := 0;
end;
//else
begin
if aGLObject.Nodes.Count >= 4 then
begin
VCoords[1][0] := aGLObject.Nodes[0].x;
VCoords[1][1] := aGLObject.Nodes[0].y;
VCoords[1][2] := aGLObject.Nodes[0].z;
VCoords[2][0] := aGLObject.Nodes[1].x;
VCoords[2][1] := aGLObject.Nodes[1].y;
VCoords[2][2] := aGLObject.Nodes[1].z;
VCoords[3][0] := aGLObject.Nodes[2].x;
VCoords[3][1] := aGLObject.Nodes[2].y;
VCoords[3][2] := aGLObject.Nodes[2].z;
VCoords[4][0] := aGLObject.Nodes[3].x;
VCoords[4][1] := aGLObject.Nodes[3].y;
VCoords[4][2] := aGLObject.Nodes[3].z;
end
else
begin
VCoords[1][0] := 0; VCoords[1][1] := 0; VCoords[1][2] := 0;
VCoords[2][0] := 100; VCoords[2][1] := 0; VCoords[2][2] := 0;
VCoords[3][0] := 100; VCoords[3][1] := 0; VCoords[3][2] := 100;
VCoords[4][0] := 0; VCoords[4][1] := 0; VCoords[4][2] := 100;
end;
end;
rAngle := DegToRad(aAngle);
if (aAngle >=0) and (aAngle < 90) then
begin
if not aMirror then
begin
vs0 := VCoords[1];
vs1 := VCoords[2];
end
else
begin
vs0 := VCoords[2];
vs1 := VCoords[1];
end;
vs2 := VCoords[4];
vs1 := Rotate3DVector(vs0, vs1, vs2, aAngle - 0);
end;
if (aAngle >=90) and (aAngle < 180) then
begin
if not aMirror then
begin
vs0 := VCoords[2];
vs1 := VCoords[3];
end
else
begin
vs0 := VCoords[3];
vs1 := VCoords[2];
end;
vs2 := VCoords[1];
vs1 := Rotate3DVector(vs0, vs1, vs2, aAngle - 90);
end;
if (aAngle >=180) and (aAngle < 270) then
begin
if not aMirror then
begin
vs0 := VCoords[3];
vs1 := VCoords[4];
end
else
begin
vs0 := VCoords[4];
vs1 := VCoords[3];
end;
vs2 := VCoords[2];
vs1 := Rotate3DVector(vs0, vs1, vs2, aAngle - 180);
end;
if (aAngle >=270) and (aAngle < 360) then
begin
if not aMirror then
begin
vs0 := VCoords[4];
vs1 := VCoords[1];
end
else
begin
vs0 := VCoords[1];
vs1 := VCoords[4];
end;
vs2 := VCoords[3];
vs1 := Rotate3DVector(vs0, vs1, vs2, aAngle - 270);
end;
pN := CalcPlaneNormal (vs0, vs1, vs2);
SetVector (mat[2], pN);
SetVector (mat[0], VectorNormalize (VectorSubtract (vs1, vs0)));
SetVector (mat[1], VectorCrossProduct (mat[2], mat[0]));
with aGLObject.Material.Texture do
begin
{TODO} // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> + <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
// 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
xObject := T3DSide(TTreeNode(FPropObjects[i]).Data);
xGLObject := TGLBaseSceneObject(xObject.FGLObject);
xObject.FTextureHash := HashStr;
xObject.FTexture_ext := ExtStr;
if (xGLObject is TGLPolygon) then
begin
TGLPolygon(xGLObject).Material.Texture.Disabled := False;
TGLPolygon(xGLObject).Material.Texture.DestroyHandles;
TGLPolygon(xGLObject).Material.Texture.Image.LoadFromFile(tmpfname);
RotateTextureToAngleP(xObject, TGLPolygon(xGLObject), xObject.FTextureRotate, xObject.FMirror);
// TGLPolygon(xGLObject).Material.Texture.ApplyMappingMode;
// TGLPolygon(xGLObject).Material.Texture.TexHeight := 100;
// TGLPolygon(xGLObject).Material.Texture.TexWidth := 100;
end;
end;
end
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.cbHashsPropertiesCloseUp', E.Message);
end;
end;
procedure Tfrm3D.nAdd3DObjectClick(Sender: TObject);
var
i, j: integer;
FName: string;
xNode, xSubNode: TTreeNode;
xRoom: T3DRoom;
xObject: T3DSObject;
glObjClass: TGLSceneObjectClass;
glObject: TGLFreeForm;
ObjectMin, ObjectMax, RoomMin, RoomMax, ObjSize, RoomSize, SetPos, Scale: T3DPoint;
SetScale: Double;
tmpdir, tmpfname: string;
HashStr: string;
begin
try
if ModelTree.SelectionCount = 1 then
begin
xNode := ModelTree.Selections[0];
Open3DObject.InitialDir := ExeDir + '\3DModels';
NoMoveEvent := True;
if Open3DObject.Execute then
begin
// <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>!
//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
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> HASH <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>
HashStr := GetObjectHash(FName);
// <20><> HASH <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><> <20><> <20> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>
tmpfname := GetObjectFileByHash(HashStr);
// <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>, <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD>
if tmpfname <> '' then
begin
end
else
// <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> - <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> HASH, <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD>, <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
begin
F3DModel.F3DSHashs.Add(HashStr);
tmpfname := tmpdir + '\' + HashStr + '.3ds';
CopyFile(PChar(FName), PChar(tmpfname), True);
end;
// MARK
BeginProgress('<27><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> 3ds <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> ...'); // ***
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> GLScene
glObjClass := TGLFreeForm;
glObject := TGLFreeForm(DummyCube.AddNewChild(glObjClass));
glObject.Material.Texture.Disabled := False;
glObject.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; //<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
//glObject.StructureChanged;
{TODO - <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> - <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>! }
//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;
// <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> 3<> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>!
//glObject.Material.Texture.MappingMode := tmmCubeMapCamera;
//// glObject.BuildOctree; <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
//glObject.Material.MaterialOptions := [moNoLighting];
glObject.Material.MaterialOptions := [];
glObject.Material.Texture.Disabled := False;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
xObject.FZOrder := xObject.FParent.FZOrder;
//xObject.FName := ExtractFileName(FName);
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>!
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);
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
xSubNode := ModelTree.Items.AddChild(xNode, xObject.FName);
xSubNode.Data := xObject;
xSubNode.ImageIndex := 42;
glObject.TagObject := xSubNode;
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));
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>
if LenToCursor1 < LenToResizer1 then
begin
if HLen > LimitLen1 then
HLen := LimitLen1;
if Len11 = 0 then
DLen1 := 0
else
DLen1 := HLen / Len11;
if Len12 = 0 then
DLen2 := 0
else
DLen2 := HLen / Len12;
rpos1.x := RStartPos1.x - (RStartPos1.x - FResizeData.Nodep11.x) * DLen1;
rpos1.y := RStartPos1.y - (RStartPos1.y - FResizeData.Nodep11.y) * DLen1;
rpos1.z := RStartPos1.z - (RStartPos1.z - FResizeData.Nodep11.z) * DLen1;
rpos2.x := RStartPos2.x - (RStartPos2.x - FResizeData.Nodep12.x) * DLen2;
rpos2.y := RStartPos2.y - (RStartPos2.y - FResizeData.Nodep12.y) * DLen2;
rpos2.z := RStartPos2.z - (RStartPos2.z - FResizeData.Nodep12.z) * DLen2;
end
else if LenToCursor2 < LenToResizer2 then
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>
begin
if HLen > LimitLen2 then
HLen := LimitLen2;
if Len21 = 0 then
DLen1 := 0
else
DLen1 := HLen / Len21;
if Len22 = 0 then
DLen2 := 0
else
DLen2 := HLen / Len22;
rpos1.x := RStartPos1.x - (RStartPos1.x - FResizeData.Nodep21.x) * DLen1;
rpos1.y := RStartPos1.y - (RStartPos1.y - FResizeData.Nodep21.y) * DLen1;
rpos1.z := RStartPos1.z - (RStartPos1.z - FResizeData.Nodep21.z) * DLen1;
rpos2.x := RStartPos2.x - (RStartPos2.x - FResizeData.Nodep22.x) * DLen2;
rpos2.y := RStartPos2.y - (RStartPos2.y - FResizeData.Nodep22.y) * DLen2;
rpos2.z := RStartPos2.z - (RStartPos2.z - FResizeData.Nodep22.z) * DLen2;
end
else if (LimitLen1 = 0) or (LimitLen2 = 0) then
begin
rpos1.x := RStartPos1.x;
rpos1.y := RStartPos1.y;
rpos1.z := RStartPos1.z;
rpos2.x := RStartPos2.x;
rpos2.y := RStartPos2.y;
rpos2.z := RStartPos2.z;
end;
// Set Spliter Line and Cube
glSpliter.Nodes[0].X := rpos1.x;
glSpliter.Nodes[0].Y := rpos1.y;
glSpliter.Nodes[0].Z := rpos1.z;
glSpliter.Nodes[1].X := rpos2.x;
glSpliter.Nodes[1].Y := rpos2.y;
glSpliter.Nodes[1].Z := rpos2.z;
glCubeSpliter.Position.x := (rpos1.x + rpos2.x) / 2;
glCubeSpliter.Position.y := (rpos1.y + rpos2.y) / 2;
glCubeSpliter.Position.z := (rpos1.z + rpos2.z) / 2;
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
// <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>, <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
if Button = mbLeft then
begin
FResizer := False;
RStartPos1 := rpos1;
RStartPos2 := rpos2;
SetSidesData;
end;
// <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> - <20><><EFBFBD><EFBFBD><EFBFBD>
if Button = mbRight then
begin
FResizer := False;
rpos1 := RStartPos1;
rpos2 := RStartPos2;
glSpliter.Nodes[0].X := rpos1.x;
glSpliter.Nodes[0].Y := rpos1.y;
glSpliter.Nodes[0].Z := rpos1.z;
glSpliter.Nodes[1].X := rpos2.x;
glSpliter.Nodes[1].Y := rpos2.y;
glSpliter.Nodes[1].Z := rpos2.z;
glCubeSpliter.Position.x := (rpos1.x + rpos2.x) / 2;
glCubeSpliter.Position.y := (rpos1.y + rpos2.y) / 2;
glCubeSpliter.Position.z := (rpos1.z + rpos2.z) / 2;
glCubeSpliter1.Position.x := rpos1.x;
glCubeSpliter1.Position.y := rpos1.y;
glCubeSpliter1.Position.z := rpos1.z;
glCubeSpliter2.Position.x := rpos2.x;
glCubeSpliter2.Position.y := rpos2.y;
glCubeSpliter2.Position.z := rpos2.z;
GLSceneViewer.Cursor := crDefault;
SetSideSizes;
{
//Full Reset
FToolMode := tmSelect;
glSpliter.Visible := False;
glCubeSpliter.Visible := False;
glSide11.Visible := False;
glSide12.Visible := False;
glSide21.Visible := False;
glSide22.Visible := False;
DeleteNodesObjects;
GLSceneViewer.Cursor := crDefault;
}
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.GLSceneViewerMouseUp', E.Message);
end;
end;
procedure Tfrm3D.CreateAddForDivSide(aSide, aAddSide: TGLPolygon);
var
i, j: Integer;
xNode, xParentNode, xAddNode: TTreeNode;
xParentSide, xSide, xAddSide: T3DSide;
tmpdir, tmpfname, ExtStr, BmpFName: string;
HashStr: string;
ZOrder: Double;
begin
try
// Create Model Object
xNode := TTreeNode(aSide.TagObject);
xParentNode := xNode.Parent;
// Create
xSide := T3DSide(xNode.Data);
SetLength(xSide.FPoints, aSide.Nodes.Count);
SetLength(xSide.FGLPoints, aSide.Nodes.Count);
ZOrder := xSide.FZOrder;
for i := 0 to Length(xSide.FGLPoints) - 1 do
begin
xSide.FGLPoints[i].x := aSide.Nodes[i].X;
xSide.FGLPoints[i].y := aSide.Nodes[i].Y - ZOrder;
xSide.FGLPoints[i].z := aSide.Nodes[i].Z;
end;
for i := 0 to Length(xSide.FPoints) - 1 do
begin
xSide.FPoints[i].x := xSide.FGLPoints[i].x / Factor;
xSide.FPoints[i].z := xSide.FGLPoints[i].y / Factor;
xSide.FPoints[i].y := xSide.FGLPoints[i].z / Factor;
end;
xAddSide := T3DSide.Create(xSide.FFaceType, xSide.FWallType, xSide.FSideType, xSide.FParent);
xAddSide.FName := cSubSide + IntToStr(xParentNode.Count + 1);
xAddSide.FDescription.Text := xSide.FDescription.Text;
xAddSide.FGLObject := aAddSide;
xAddSide.FFace := nil;
xAddSide.FColor := xSide.FColor;
xAddSide.FTextureRotate := xSide.FTextureRotate;
xAddSide.FTextureScale := xSide.FTextureScale;
xAddSide.FMirror := xSide.FMirror;
xAddSide.FTextureHash := xSide.FTextureHash;
xAddSide.FTexture_ext := xSide.FTexture_ext;
xAddSide.FZOrder := xSide.FZOrder;
SetLength(xAddSide.FPoints, aAddSide.Nodes.Count);
SetLength(xAddSide.FGLPoints, aAddSide.Nodes.Count);
ZOrder := xAddSide.FZOrder;
for i := 0 to Length(xAddSide.FGLPoints) - 1 do
begin
xAddSide.FGLPoints[i].x := aAddSide.Nodes[i].X;
xAddSide.FGLPoints[i].y := aAddSide.Nodes[i].Y - ZOrder;
xAddSide.FGLPoints[i].z := aAddSide.Nodes[i].Z;
end;
for i := 0 to Length(xAddSide.FPoints) - 1 do
begin
xAddSide.FPoints[i].x := xAddSide.FGLPoints[i].x / Factor;
xAddSide.FPoints[i].z := xAddSide.FGLPoints[i].y / Factor;
xAddSide.FPoints[i].y := xAddSide.FGLPoints[i].z / Factor;
end;
if xSide.FParent is T3DSide then
T3DSide(xSide.FParent).FSubSides.Add(xAddSide);
// Create Node
xAddNode := ModelTree.Items.AddChild(xParentNode, xAddSide.FName);
xAddNode.Data := xAddSide;
xAddNode.ImageIndex := 50;
aAddSide.TagObject := xAddNode;
// Apply Texture
//tmpdir := 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;
aFirstSide.TagObject := xFirstNode;
// CREATE SECOND
xSecondSide := T3DSide.Create(xParentSide.FFaceType, xParentSide.FWallType, xParentSide.FSideType, xParentSide);
xSecondSide.FName := cSubSide + IntToStr(xParentNode.Count + 1);
xSecondSide.FDescription.Text := xParentSide.FDescription.Text;
xSecondSide.FGLObject := aSecondSide;
xSecondSide.FFace := nil;
xSecondSide.FColor := xParentSide.FColor;
xSecondSide.FTextureRotate := xParentSide.FTextureRotate;
xSecondSide.FTextureScale := xParentSide.FTextureScale;
xSecondSide.FMirror := xParentSide.FMirror;
xSecondSide.FTextureHash := xParentSide.FTextureHash;
xSecondSide.FTexture_ext := xParentSide.FTexture_ext;
xSecondSide.FZOrder := xParentSide.FZOrder;
SetLength(xSecondSide.FPoints, aSecondSide.Nodes.Count);
SetLength(xSecondSide.FGLPoints, aSecondSide.Nodes.Count);
ZOrder := xSecondSide.FZOrder;
for i := 0 to Length(xSecondSide.FGLPoints) - 1 do
begin
xSecondSide.FGLPoints[i].x := aSecondSide.Nodes[i].X;
xSecondSide.FGLPoints[i].y := aSecondSide.Nodes[i].Y - ZOrder;
xSecondSide.FGLPoints[i].z := aSecondSide.Nodes[i].Z;
end;
for i := 0 to Length(xSecondSide.FPoints) - 1 do
begin
xSecondSide.FPoints[i].x := xSecondSide.FGLPoints[i].x / Factor;
xSecondSide.FPoints[i].z := xSecondSide.FGLPoints[i].y / Factor;
xSecondSide.FPoints[i].y := xSecondSide.FGLPoints[i].z / Factor;
end;
xParentSide.FSubSides.Add(xSecondSide);
xSecondNode := ModelTree.Items.AddChild(xParentNode, xSecondSide.FName);
xSecondNode.Data := xSecondSide;
xSecondNode.ImageIndex := 50;
aSecondSide.TagObject := xSecondNode;
xParentSide.FGLObject := nil;
// Apply Texture
//tmpdir := 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);
Res := MessageBox(self.Handle, PAnsiChar(mess), cForm3D_Mes6_2, MB_YESNOCANCEL);
if Res = IDYES then
begin
if FToolMode = tmCut then
begin
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>?
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); // <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
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
{* <20><><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20> <20><>, <20><><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>
fFileName := GetCadFileNameForSaveToPM(FCAD.FCADListID);
PCad.SaveToFile(0, fFileName);
<20><><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> TF_CAD.FormCloseQuery <20> <20><><EFBFBD><EFBFBD><EFBFBD> <20><> LoadModelToStream <20><><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
*}
fFileName := AFile;
if fFileName = '' then
begin
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);
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
for i := 0 to F3DModel.FRooms.Count - 1 do
begin
xRoom := T3DRoom(F3DModel.FRooms[i]);
if (xRoom.FListID <> AListID) or (not xRoom.FVisible) then
continue;
ModelObjectsList.Add(xRoom);
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
xSide := xRoom.FCeiling;
ModelObjectsList.Add(xSide);
for j := 0 to xSide.FSubSides.Count - 1 do
begin
xSubSide := T3DSide(xSide.FSubSides[j]);
ModelObjectsList.Add(xSubSide);
end;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
xSide := xRoom.FFloor;
ModelObjectsList.Add(xSide);
for j := 0 to xSide.FSubSides.Count - 1 do
begin
xSubSide := T3DSide(xSide.FSubSides[j]);
ModelObjectsList.Add(xSubSide);
end;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> 3<><33> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
for j := 0 to xRoom.F3DSObjects.Count - 1 do
begin
x3DSObject := T3DSObject(xRoom.F3DSObjects[j]);
ModelObjectsList.Add(x3DSObject);
end;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
for j := 0 to xRoom.FWalls.Count - 1 do
begin
xWall := T3DWall(xRoom.FWalls[j]);
ModelObjectsList.Add(xWall);
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>
for k := 0 to xWall.FWallElements.Count - 1 do
begin
xWallElement := T3DWallElement(xWall.FWallElements[k]);
ModelObjectsList.Add(xWallElement);
// <20><><EFBFBD><EFBFBD>
if xWallElement.FElementType = dotWindow then
begin
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
for ii := 0 to xWallElement.FSlopes.Count - 1 do
begin
xSlope := T3DSlope(xWallElement.FSlopes[ii]);
ModelObjectsList.Add(xSlope);
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
for jj := 0 to xSlope.FSides.Count - 1 do
begin
xSide := T3DSide(xSlope.FSides[jj]);
ModelObjectsList.Add(xSide);
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
for s := 0 to xSide.FSubSides.Count - 1 do
begin
xSubSide := T3DSide(xSide.FSubSides[s]);
ModelObjectsList.Add(xSubSide);
end;
end;
end;
end;
// <20><><EFBFBD><EFBFBD><EFBFBD>
if xWallElement.FElementType = dotDoor then
begin
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
for ii := 0 to xWallElement.FSlopes.Count - 1 do
begin
xSlope := T3DSlope(xWallElement.FSlopes[ii]);
ModelObjectsList.Add(xSlope);
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
for jj := 0 to xSlope.FSides.Count - 1 do
begin
xSide := T3DSide(xSlope.FSides[jj]);
ModelObjectsList.Add(xSide);
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
for s := 0 to xSide.FSubSides.Count - 1 do
begin
xSubSide := T3DSide(xSide.FSubSides[s]);
ModelObjectsList.Add(xSubSide);
end;
end;
end;
end;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
if xWallElement.FElementType = dotBalcony then
begin
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
for ii := 0 to xWallElement.FSlopes.Count - 1 do
begin
xSlope := T3DSlope(xWallElement.FSlopes[ii]);
ModelObjectsList.Add(xSlope);
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
for jj := 0 to xSlope.FSides.Count - 1 do
begin
xSide := T3DSide(xSlope.FSides[jj]);
ModelObjectsList.Add(xSide);
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
for s := 0 to xSide.FSubSides.Count - 1 do
begin
xSubSide := T3DSide(xSide.FSubSides[s]);
ModelObjectsList.Add(xSubSide);
end;
end;
end;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
for ii := 0 to xWallElement.FBalconElements.Count - 1 do
begin
xBalconElement := T3DBalconElement(xWallElement.FBalconElements[ii]);
ModelObjectsList.Add(xBalconElement);
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
for jj := 0 to xBalconElement.FSides.Count - 1 do
begin
xSide := T3DSide(xBalconElement.FSides[jj]);
ModelObjectsList.Add(xSide);
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
for s := 0 to xSide.FSubSides.Count - 1 do
begin
xSubSide := T3DSide(xSide.FSubSides[s]);
ModelObjectsList.Add(xSubSide);
end;
end;
end;
end;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>
for ii := 0 to xWallElement.FSides.Count - 1 do
begin
xSide := T3DSide(xWallElement.FSides[ii]);
ModelObjectsList.Add(xSide);
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
for s := 0 to xSide.FSubSides.Count - 1 do
begin
xSubSide := T3DSide(xSide.FSubSides[s]);
ModelObjectsList.Add(xSubSide);
end;
end;
end;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>
for k := 0 to xWall.FSides.Count - 1 do
begin
xSide := T3DSide(xWall.FSides[k]);
ModelObjectsList.Add(xSide);
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
for s := 0 to xSide.FSubSides.Count - 1 do
begin
xSubSide := T3DSide(xSide.FSubSides[s]);
ModelObjectsList.Add(xSubSide);
end;
end;
end;
end;
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
{* <20><><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>, <20><><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20>
<20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> OpenListsInProject
ListStream := OpenListInPM(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
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> HASH
for i := 0 to F3DStreamModel.FHashs.Count - 1 do
begin
xStr := F3DStreamModel.FHashs[i];
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 := '<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>: ' + IntToStr(i+1) + ',' + IntToStr(i+2) + '-';
if j + 1 < TGLPolygon(xObj).Nodes.Count then
begin
Str := Str + IntToStr(j+1) + ',' + IntToStr(j+2);
Item := TMenuItem.Create(pmCut);
Item.Caption := Str;
pmCut.Items.Add(Item);
Item.Tag := Index;
Item.OnClick := SelectNodesEvent;
xCutData := TCutData.create;
xCutData.Index11 := i;
xCutData.Index12 := i + 1;
xCutData.Index21 := j;
xCutData.Index22 := j + 1;
FCutDataList.Add(xCutData);
end
else
begin
if i <> 0 then
begin
Str := Str + IntToStr(j+1) + ',' + IntToStr(1);
Item := TMenuItem.Create(pmCut);
Item.Caption := Str;
pmCut.Items.Add(Item);
Item.Tag := Index;
Item.OnClick := SelectNodesEvent;
xCutData := TCutData.create;
xCutData.Index11 := i;
xCutData.Index12 := i + 1;
xCutData.Index21 := j;
xCutData.Index22 := 0;
FCutDataList.Add(xCutData);
end;
end;
end;
end;
pmCut.Popup(X, Y);
end;
end;
end
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;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
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;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
for j := 0 to xRoom.FWalls.Count - 1 do
begin
xWall := T3DWall(xRoom.FWalls[j]);
if xWall.FSCSComponID = aComponID then
begin
Result := xWall;
exit;
end;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>
for k := 0 to xWall.FWallElements.Count - 1 do
begin
xWallElement := T3DWallElement(xWall.FWallElements[k]);
if xWallElement.FSCSComponID = aComponID then
begin
Result := xWallElement;
exit;
end;
// <20><><EFBFBD><EFBFBD>
if xWallElement.FElementType = dotWindow then
begin
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
for ii := 0 to xWallElement.FSlopes.Count - 1 do
begin
xSlope := T3DSlope(xWallElement.FSlopes[ii]);
if xSlope.FSCSComponID = aComponID then
begin
Result := xSlope;
exit;
end;
end;
end;
// <20><><EFBFBD><EFBFBD><EFBFBD>
if xWallElement.FElementType = dotDoor then
begin
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
for ii := 0 to xWallElement.FSlopes.Count - 1 do
begin
xSlope := T3DSlope(xWallElement.FSlopes[ii]);
if xSlope.FSCSComponID = aComponID then
begin
Result := xSlope;
exit;
end;
end;
end;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
if xWallElement.FElementType = dotBalcony then
begin
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
for ii := 0 to xWallElement.FSlopes.Count - 1 do
begin
xSlope := T3DSlope(xWallElement.FSlopes[ii]);
if xSlope.FSCSComponID = aComponID then
begin
Result := xSlope;
exit;
end;
end;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
for ii := 0 to xWallElement.FBalconElements.Count - 1 do
begin
xBalconElement := T3DBalconElement(xWallElement.FBalconElements[ii]);
if xBalconElement.FSCSComponID = aComponID then
begin
Result := xBalconElement;
exit;
end;
end;
end;
end;
end;
end;
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);
SidesList.Add(T3DRoom(aObject).FFloor);
end;
if aObject is T3DWall then
begin
SidesList := T3DWall(aObject).FSides;
end;
if aObject is T3DWallElement then
begin
SidesList := T3DWallElement(aObject).FSides;
end;
if aObject is T3DBalconElement then
begin
SidesList := T3DBalconElement(aObject).FSides;
end;
if aObject is T3DSlope then
begin
SidesList := T3DSlope(aObject).FSides;
end;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
for i := 0 to SidesList.Count - 1 do
begin
xSide := T3DSide(SidesList[i]);
if CmpSides(aSide, xSide) then
begin
Result := xSide;
exit;
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.GetSimilarSide', E.Message);
end;
end;
function Tfrm3D.CmpSides(aSide1, aSide2: T3DSide): Boolean;
var
i, j: integer;
begin
try
Result := True;
if aSide1.FWallType <> aSide2.FWallType then
begin
Result := False;
exit;
end;
if Length(aSide1.FPoints) <> Length(aSide2.FPoints) then
begin
Result := False;
exit;
end;
for i := 0 to Length(aSide1.FPoints) - 1 do
begin
if not EQD(aSide1.FPoints[i].x, aSide2.FPoints[i].x) then
begin
Result := False;
exit;
end;
if not EQD(aSide1.FPoints[i].y, aSide2.FPoints[i].y) then
begin
Result := False;
exit;
end;
if not EQD(aSide1.FPoints[i].z, aSide2.FPoints[i].z) then
begin
Result := False;
exit;
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.CmpSides', E.Message);
end;
end;
procedure Tfrm3D.Edit2Exit(Sender: TObject);
begin
FirstPersonCamera.FocalLength := strtoint(Edit2.Text);
GLCamera.FocalLength := strtoint(Edit2.Text);
GLCamera.DepthOfView := 100;
end;
procedure Tfrm3D.btnEmptyClick(Sender: TObject);
begin
if btnEmpty.Down then
begin
mDesc.Lines.Text := '';
end
else
mDesc.Lines.Text := 'empty';
if btnEmpty.GroupIndex <> 0 then
begin
mDesc.Lines.Text := '';
end
else
mDesc.Lines.Text := 'empty';
ChangeDesc;
end;
procedure Tfrm3D.NDel3DObjectClick(Sender: TObject);
var
i, j: Integer;
x3DObject: T3DSObject;
xSideNode: TTreeNode;
xGLObject: TGLBaseSceneObject;
xRoom: T3DRoom;
begin
try
if ModelTree.SelectionCount = 1 then
begin
xSideNode := ModelTree.Selections[0];
x3DObject := T3DSObject(xSideNode.Data);
xGLObject := TGLBaseSceneObject(x3DObject.FGLObject);
FSelection.Remove(xGLObject); //add
DummyCube.Remove(xGLObject, True);
xSideNode.Free;
xRoom := x3DObject.FParent;
xRoom.F3DSObjects.Delete(xRoom.F3DSObjects.IndexOf(x3DObject));
FreeAndNil(x3DObject);
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.nDelete3DObjectClick', E.Message);
end;
end;
function Tfrm3D.GetObjectFileByHash(aHash: string): string;
var
i: integer;
tmpdir, tmpfname, str: string;
begin
try
Result := '';
if aHash <> '' then
begin
tmpdir := 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
cbObjectsTypes.Properties.Items.Add('<27><><EFBFBD><EFBFBD><EFBFBD>'); // 1
cbObjectsTypes.Properties.Items.Add('<27><><EFBFBD><EFBFBD><EFBFBD>'); // 2
cbObjectsTypes.Properties.Items.Add('<27><><EFBFBD><EFBFBD>'); // 3
cbObjectsTypes.Properties.Items.Add('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>'); // 4
cbObjectsTypes.Properties.Items.Add('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>'); // 5
cbObjectsTypes.Properties.Items.Add('<27><><EFBFBD><EFBFBD>'); // 6
cbObjectsTypes.Properties.Items.Add('<27><><EFBFBD><EFBFBD>'); // 7
cbObjectsTypes.Properties.Items.Add('<27><><EFBFBD><EFBFBD>'); // 8
cbObjectsTypes.Properties.Items.Add('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>'); // 9
cbObjectsTypes.Properties.Items.Add('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>'); // 10
cbObjectsTypes.Properties.Items.Add('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>'); // 11
cbObjectsTypes.Properties.Items.Add('3ds <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>'); // 12
cbObjectsTypes.ItemIndex := 0;
cbScsObjectsTypes.Properties.Items.Clear;
cbScsObjectsTypes.Properties.Items.Add(''); // 0
cbScsObjectsTypes.Properties.Items.Add('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>'); // 1
cbScsObjectsTypes.Properties.Items.Add('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>'); // 2
cbScsObjectsTypes.Properties.Items.Add('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>-<2D><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>'); // 3
cbScsObjectsTypes.Properties.Items.Add('<27>-<2D> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>-<2D><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>'); // 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
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);
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
xObject := T3DSide(TTreeNode(FPropObjects[i]).Data);
xGLObject := TGLBaseSceneObject(xObject.FGLObject);
xObject.FTextureScale := StrToInt(edTextureScale.Text);
if (xGLObject is TGLMesh) then
begin
RotateTextureToAngleM(xObject, TGLMesh(xGLObject), xObject.FTextureRotate, xObject.FMirror);
end;
if (xGLObject is TGLPolygon) then
begin
RotateTextureToAngleP(xObject, TGLPolygon(xGLObject), xObject.FTextureRotate, xObject.FMirror);
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.ChangeTextureScale', E.Message);
end;
end;
procedure Tfrm3D.edTextureScaleExit(Sender: TObject);
begin
ChangeTextureScale;
end;
procedure Tfrm3D.edTextureScaleKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
ChangeTextureScale;
end;
function Tfrm3D.is3DSObject(aObj: TGLBaseSceneObject): Boolean;
var
xNode: TTreeNode;
xObject: TObject;
Obj: TGLBaseSceneObject;
begin
try
Result := False;
xNode := TTreeNode(aObj.tagObject);
Obj := GlsceneViewer.Buffer.GetPickedobject(mx, my);
if TObject(xNode.Data) is T3DSObject then
begin
Result := True;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.is3DSObject', E.Message);
end;
end;
function Tfrm3D.GetDistAngle(AP1, AP2: TDoublePoint): Double;
var
Len_X, Len_Y: Double;
AngleRad: Double;
AddAngle: Double;
begin
Result := 0;
try
Len_X := Abs(AP1.x - AP2.x);
Len_Y := Abs(AP1.y - AP2.y);
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
AddAngle := 0;
AngleRad := 0;
// <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>
if (AP1.x < AP2.x) and (AP1.y < AP2.y) then // 1
begin
AngleRad := ArcTan2(Len_X, Len_Y); // <20><><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
AddAngle := 0;
end;
if (AP1.x < AP2.x) and (AP1.y > AP2.y) then //4
begin
AngleRad := ArcTan2(Len_Y, Len_X); // <20><><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
AddAngle := 90;
end;
if (AP1.x > AP2.x) and (AP1.y > AP2.y) then //3
begin
AngleRad := ArcTan2(Len_X, Len_Y); // <20><><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
AddAngle := 180;
end;
if (AP1.x > Ap2.x) and (AP1.y < AP2.y) then //2
begin
AngleRad := ArcTan2(Len_Y, Len_X); // <20><><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
AddAngle := 270;
end;
Result := Round(AngleRad * 180 / pi) + AddAngle;
// <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>
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
xObject := T3DSObject(TTreeNode(FPropObjects[i]).Data);
xGLObject := TGLFreeForm(xObject.FGLObject);
xObject.FTextureHash := HashStr;
xObject.FTexture_ext := ExtStr;
xGLObject.Material.Texture.Image.LoadFromFile(tmpfname);
//xGLObject.Material.Texture.MappingMode := tmmCubeMapCamera;
end;
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.cbObjectHashsPropertiesCloseUp', E.Message);
end;
end;
procedure Tfrm3D.bObjectTextureClearClick(Sender: TObject);
var
FName: string;
i: integer;
xObject: T3DSObject;
xGLObject: TGLFreeForm;
begin
try
imgObjectTexture.Clear;
for i := 0 to FPropObjects.Count - 1 do
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;
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);
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> HASH <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>
HashStr := GetImageHash(FName);
// <20><> HASH <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><> <20><> <20> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>
tmpfname := GetImageFileByHash(HashStr);
// <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>, <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD>
if tmpfname <> '' then
begin
end
else
// <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> - <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> HASH, <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD>, <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
begin
F3DModel.FHashs.Add(HashStr);
tmpfname := tmpdir + '\' + HashStr + '.bmp';
if (ExtStr = '.jpg') or (ExtStr = '.jpeg') then
begin
Bmp := TBitmap.Create;
Jpeg := TJPEGImage.Create;
jpeg.CompressionQuality := 100; {Default Value}
Jpeg.LoadFromFile(FName);
Bmp.Assign(Jpeg);
Bmp.SaveTofile(tmpfname);
FreeAndNil(Bmp);
FreeAndNil(Jpeg);
end
else
CopyFile(PChar(FName), PChar(tmpfname), True);
end;
for i := 0 to FPropObjects.Count - 1 do
begin
xObject := T3DSObject(TTreeNode(FPropObjects[i]).Data);
xGLObject := TGLFreeForm(xObject.FGLObject);
xObject.FTextureHash := HashStr;
xObject.FTexture_ext := ExtStr;
xGLObject.MaterialLibrary := nil;
//xGLObject.Material.Texture.Disabled := False;
//xGLObject.Material.MaterialOptions := [];
xGLObject.Material.Texture.DestroyHandles;
xGLObject.Material.Texture.Image.LoadFromFile(tmpfname);
//xGLObject.Material.Texture.MappingMode := tmmCubeMapCamera;
end;
// Resfresh HASHs
cbObjectHashs.Properties.Items.Clear;
for i := 0 to F3DModel.FHashs.Count - 1 do
begin
cbObjectHashs.Properties.Items.Add(F3DModel.FHashs.Strings[i]);
end;
end;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.bObjectTextureChangeClick', E.Message);
end;
end;
procedure Tfrm3D.MatLibTextureNeeded(Sender: TObject; var textureFileName: String);
var
tmpdir, fname, textfname, tmpfname, HashStr: string;
i, 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;
// <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> 3<><33>
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);
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> HASH <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>
FName := src_3ds_dir + textfname;
HashStr := GetImageHash(FName) + ExtractFileExt(FName);
// <20><> HASH <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><> <20><> <20> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>
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
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> - <20><> <20><> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>:
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
// <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> 3<><33>
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} // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> 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;
begin
try
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;
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;
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 - <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> savedir!
// <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>!
//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
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> HASH <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>
HashStr := GetObjectHash(FName);
// <20><> HASH <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><> <20><> <20> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>
tmpfname := GetObjectFileByHash(HashStr);
// <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>, <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD>
if tmpfname <> '' then
begin
end
else
// <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> - <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> HASH, <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD>, <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
begin
F3DModel.F3DSHashs.Add(HashStr);
tmpfname := tmpdir + '\' + HashStr + '.3ds';
CopyFile(PChar(FName), PChar(tmpfname), True);
end;
// MARK
BeginProgress('<27><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> 3ds <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> ...'); // ***
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 - <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> - <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>! }
//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;
// <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>! FName <20><> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>!
//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 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);
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);
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);
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('<27><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> ...');
// 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 := xConn.FPoint.x - xScsConn.ActualPoints[1].x;
dp.y := 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;
xScsConn.ActualZOrder[1] := xConn.FPoint.z;
// 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;
xGetScsConn.ActualZOrder[1] := xScsConn.ActualZOrder[1];
end;
end;
end;
end;
end;
// Line Object
if TObject(F3DModel.FScsObjects[i]) is T3DLine then
begin
xLine := T3DLine(F3DModel.FScsObjects[i]);
xScsLine := xLine.FSCSObject;
end;
end;
GMoveWithRaise := True;
except
on E: Exception do AddExceptionToLogEx('Tfrm3D.ApplyScsModel', E.Message);
end;
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;
//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;
xConn.FPoint.z := xConn.FGLPoint.y / Factor / FScaleDelta;
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);
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;
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;
xConn.FPoint.z := xConn.FGLPoint.y / Factor / FScaleDelta;
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;
xLine.FPoint1.z := xLine.FGLPoint1.y / Factor / FScaleDelta;
xLine.FPoint1.y := xLine.FGLPoint1.z / Factor;
xLine.FPoint2.x := xLine.FGLPoint2.x / Factor;
xLine.FPoint2.z := xLine.FGLPoint2.y / Factor / FScaleDelta;
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;
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);
V4 := VectorCombine(VX, VY, -dx * 0.132 * Camera.DistanceToTarget / Camera.FocalLength,
dy * 0.132 * 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;
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];
V3 := VectorCombine(VX3, VY3, -dx * 0.132 * Camera.DistanceToTarget / Camera.FocalLength,
dy * 0.132 * 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;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD> <20>-<2D>
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;
Z := aObj.Position.Y / factor / FScaleDelta - xConn.FZOrder;
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;
Z := aObj.Position.Y / factor / FScaleDelta - xConn.FZOrder;
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;
Z1 := aObj.Nodes[0].Y / factor / FScaleDelta - xLine.FZOrder;
Y1 := aObj.Nodes[0].Z / factor;
X2 := aObj.Nodes[1].X / factor;
Z2 := aObj.Nodes[1].Y / factor / FScaleDelta - xLine.FZOrder;
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: Single): Single;
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;
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;
end.
Reference in New Issue View Git Blame Copy Permalink