unit Form3d; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Keyboard, Dialogs, GLScene, GLObjects, GLWin32Viewer, GLMisc, GLTexture, StdCtrls, ExtCtrls, Buttons,PCTypesUtils,GLGeomObjects,VectorGeometry, GLFile3DS, GLExtrusion, GLGraph, GLVectorFileObjects, GLPortal, GLSpaceText,GLMultiPolygon, VectorTypes, GLHUDObjects, GLWaterPlane, GLBitmapFont, GLWindowsFont, LibJPeg, Form3d_Save, math, siComp, siLngLnk, GLMesh; type Tfrm3D = class(TForm) GLScene1: TGLScene; GLCamera1: TGLCamera; Panel2: TPanel; GLSceneViewer1: TGLSceneViewer; GLLightSource1: TGLLightSource; GLLightSource2: TGLLightSource; GLLightSource3: TGLLightSource; GLLightSource4: TGLLightSource; GLLightSource5: TGLLightSource; Panel3: TPanel; SpeedButton1: TSpeedButton; SpeedButton2: TSpeedButton; Label1: TLabel; cmbCenter: TComboBox; MainCenter: TGLDummyCube; DummyCube2: TGLDummyCube; TransCube: TGLDummyCube; GLPlane1: TGLPlane; GLDummyCube1: TGLDummyCube; GLHUDText1: TGLHUDText; Button1: TButton; Button2: TButton; SpeedButton3: TSpeedButton; SaveDialog: TSaveDialog; lbViewType: TLabel; lng_Forms: TsiLangLinked; cbViewCeiling: TCheckBox; procedure GLSceneViewer1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure GLSceneViewer1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure CheckBox4Click(Sender: TObject); procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure SpeedButton1Click(Sender: TObject); procedure SpeedButton2Click(Sender: TObject); procedure cmbCenterClick(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 Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure SpeedButton3Click(Sender: TObject); procedure cbViewCeilingClick(Sender: TObject); private { Private declarations } public { Public declarations } mx, my : Integer; FaceList: TList; CPoint: T3DPoint; OPoint: T3DPoint; Camera: T3DPoint; Procedure UpdateFaces(Faces:Tlist;Yh:Double=0); 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); end; var frm3D: Tfrm3D; implementation uses U_ESCadClasess, U_BaseConstants, U_Constants, U_BaseCommon, U_Common, U_SCSComponent, u_main, PCDrawBox, U_ProtectionCommon, U_Arch3D; {$R *.dfm} procedure Tfrm3D.CheckBox4Click(Sender: TObject); begin end; // // Classic mouse movement bits // procedure Tfrm3D.GLSceneViewer1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin mx:=x; my:=y; end; procedure Tfrm3D.GLSceneViewer1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); var dx, dy : Integer; v : TVector; mp: TPoint; ip : TVector; tileX, tileY : Integer; shiftDown : Boolean; mip, translateOffset : TVector; translating : Boolean; koefcam: single; begin shiftDown:=(IsKeyDown(VK_LSHIFT) or IsKeyDown(VK_RSHIFT)); dx := mx - x; dy := my - y; if ssLeft in Shift then begin //if ssCtrl in Shift then //begin // GLCamera1.RotateTarget(my-y, mx-x); // GLCamera1.RotateObject(DummyCube2, my-y, mx-x); // GLCamera1.RotateObject(TransCube, my-y, mx-x); // GLCamera1.RotateObject(MainCenter, my-y, mx-x); //end //else GLCamera1.MoveAroundTarget(my-y, mx-x); end else if Shift=[ssRight] then begin if glCamera1.CameraStyle = csPerspective then koefcam := 0.12 else koefcam := 0.03; if GLCamera1.Position.Y < 0 then v := GLCamera1.ScreenDeltaToVectorXZ(-dx, -dy, koefcam * GLCamera1.DistanceToTarget / GLCamera1.FocalLength) else v := GLCamera1.ScreenDeltaToVectorXZ(-dx, dy, koefcam * GLCamera1.DistanceToTarget / GLCamera1.FocalLength); GLDummyCube1.Position.Translate(v); DummyCube2.Position.Translate(v); TransCube.Position.Translate(v); GLCamera1.TransformationChanged; end; mx := x; my := y; end; procedure Tfrm3D.UpdateFaces(Faces: Tlist; Yh: Double = 0); var i,pCnt,k : Integer; Face:TFaceRecord; glPoly:TGLPolyGon; glLine: TGLLines; glCube: TGLCube; glSphere: TGLSphere; glCenter: TGLDummyCube; p, p1, p2, p3, p4, p5, p6, p7, p8: T3dPoint; tx,ty,tz,bx,by,bz,cx,cy,cz: Double; glObject: TGLBaseSceneObject; glObjClass: TGLSceneObjectClass; glObject1: TGLBaseSceneObject; glObjClass1: TGLSceneObjectClass; factor: Single; normal: T3dPoint; glPipe: TGLPipe; FigureID: Integer; SCSCatalog: TSCSCatalog; xoffset, aScaleModel: single; aColorModel: TVector4f; glWallSide: TGLMesh; //glFloor: TGLMesh; glFloor: TGLPolygon; //glCeiling: TGLMesh; glCeiling: TGLPolygon; glDoorSide: TGLPolygon; glWindowSide: TGLPolygon; glBalconDoorSide: TGLPolygon; glBalconWindowSide: TGLPolygon; glFrame: TGLPolygon; aColor: TVector4f; tmpdir: string; WallCoords: array [0..5] of TVector3f; FloorCoords: array of TVector3f; BegCoordIndex: integer; pN, pP: TVector3f; Angle1, Angle2, ResAng: Double; dp1, dp2: TDoublePoint; begin try FaceList := Faces; Factor := 0.15; DummyCube2.DeleteChildren; TransCube.DeleteChildren; cmbCenter.Items.Clear; cmbCenter.Items.AddObject('Bina Merkezi', MainCenter); //// *********** FACES.COUNT ************************************************* for i := 0 to Faces.Count - 1 do begin Face := TFaceRecord(faces[i]); 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 := TGLMesh; //ftNetFloor: glObjClass := TGLMesh; ftNetFloor: glObjClass := TGLPolygon; //ftNetCeiling: glObjClass := TGLMesh; ftNetCeiling: glObjClass := TGLPolygon; ftNetDoor: glObjClass := TGLPolygon; ftNetWindow: glObjClass := TGLPolygon; ftNetBalconDoor: glObjClass := TGLPolygon; ftNetBalconWindow: glObjClass := TGLPolygon; ftNetFrame: glObjClass := TGLPolygon; end; if face.OpTrans then begin glObject := TransCube.AddNewChild(glObjClass); end else begin glObject := DummyCube2.AddNewChild(glObjClass); 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 := TGLMesh(glObject); //ftNetFloor: glFloor := TGLMesh(glObject); ftNetFloor: glFloor := TGLPolygon(glObject); //ftNetCeiling: glCeiling := TGLMesh(glObject); ftNetCeiling: glCeiling := TGLPolygon(glObject); ftNetDoor: glDoorSide := TGLPolyGon(glObject); ftNetWindow: glWindowSide := TGLPolyGon(glObject); ftNetBalconDoor: glBalconDoorSide := TGLPolyGon(glObject); ftNetBalconWindow: glBalconWindowSide := TGLPolyGon(glObject); ftNetFrame: glFrame := TGLPolyGon(glObject); end; if Face.RecType = ftCenterCube then begin cmbCenter.Items.AddObject(Face.Info,glCenter); end; if Face.RecType in [ftPolyGon,ftLine,ftPipe,ftBar,ftSphere] then begin for k := 0 to pCnt - 1 do begin p := Face.Points[k]; p := DoublePoint(p.x,p.z,p.y); if Face.RecType = ftPolyGon then begin glPoly.AddNode( p.x*factor,p.y*factor,p.z*factor); end else if Face.RecType = ftLine then begin glLine.AddNode(p.x*factor,p.y*factor,p.z*factor); end else if Face.RecType = ftSphere then begin glSphere.Position.X := p.x*factor; glSphere.Position.Y := p.y*factor; glSphere.Position.Z := p.z*factor; end else if Face.RecType = ftCenterCube then begin glCenter.Position.X := p.x*factor; glCenter.Position.Y := p.y*factor; glCenter.Position.Z := p.z*factor; end else if (Face.RecType = ftPipe) or (Face.RecType = ftBar) then begin glPipe.AddNode(p.x*factor,p.y*factor,p.z*factor); end; end; if Face.RecType = ftLine then begin p := Face.Points[0]; p := DoublePoint(p.x,p.z,p.y); p1 := Face.Points[1]; p1 := DoublePoint(p1.x,p1.z,p1.y); glObjClass1 := TGLSpaceText; p.x := (p.x + p1.x) * 0.5; p.y := (p.y + p1.y) * 0.5; p.z := (p.z + p1.z) * 0.5; glObject1 := DummyCube2.AddNewChild(glObjClass1); // glObject1 := GLDummyCube1.AddNewChild(glObjClass1); Для случая - DummyCube2 и TransCube в CenterCube {!!!} if (TOrthoLine(Face.FFigure).Name = cudUpDownCaption) or (TOrthoLine(Face.FFigure).Name = cCadClasses_Mes25) then begin TGLSpaceText(glObject1).Text := {$IF Defined(SCS_PE)} 'Raise' {$ELSE} 'С/П' {$IFEND} + inttostr(TOrthoLine(Face.FFigure).FIndex); TGLSpaceText(glObject1).Scale.X := 0.2; TGLSpaceText(glObject1).Scale.y := 0.2; TGLSpaceText(glObject1).Scale.z := 0.2; end else begin TGLSpaceText(glObject1).Text := TOrthoLine(Face.FFigure).Name + inttostr(TOrthoLine(Face.FFigure).FIndex); TGLSpaceText(glObject1).Scale.X := 0.4; TGLSpaceText(glObject1).Scale.y := 0.4; TGLSpaceText(glObject1).Scale.z := 0.4; end; TGLSpaceText(glObject1).Position.x := p.x*factor; TGLSpaceText(glObject1).Position.z := p.z*factor; if Face.Points[0].z = Face.Points[1].z then TGLSpaceText(glObject1).Position.y := (p.y + 2) * factor else TGLSpaceText(glObject1).Position.y := (p.y - 2) * factor; TGLSpaceText(glObject1).Extrusion := 0.05; TGLSpaceText(glObject1).Font.Color := clRed; TGLSpaceText(glObject1).Material.FrontProperties.Diffuse.Color := clrRed; TGLSpaceText(glObject1).Material.BackProperties.Diffuse.Color := clrRed; // with TGLSceneObject(glObject).Material do begin BackProperties.Ambient.AsWinColor:= Face.Color; BackProperties.Diffuse.AsWinColor := Face.Color; BackProperties.Emission.AsWinColor := Face.Color; FrontProperties.Ambient.AsWinColor := Face.Color; FrontProperties.Diffuse.AsWinColor := Face.Color; FrontProperties.Emission.AsWinColor := Face.Color; end; end; if Face.RecType = ftPipe then begin if TConnectorObject(Face.FFigure).ConnectorType <> ct_Clear then begin {!!!} if TConnectorObject(Face.FFigure).Name <> ctnConnector then begin aScaleModel := 0.05; aColorModel := clrGreen; xoffset := 3; FigureID := TConnectorObject(Face.FFigure).ID; SCSCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(FigureID); if SCSCatalog <> nil then begin // Список всех компонентов верхнего уровня TSCSComponent if SCSCatalog.SCSComponents.Count > 0 then begin if SCSCatalog.SCSComponents[0].ComponentType.SysName = ctsnCupboard then begin aScaleModel := 0.1; aColorModel := clrBrown; xoffset := 4; end; if SCSCatalog.SCSComponents[0].ComponentType.SysName = ctsnCableChannelElement then begin aScaleModel := 0.02; aColorModel := clrBlue; end; end; end; {!!!} if TConnectorObject(Face.FFigure).Name <> cCadClasses_Mes24 then begin glObjClass1 := TGLSpaceText; p := Face.Points[0]; p := DoublePoint(p.x,p.z,p.y); glObject1 := DummyCube2.AddNewChild(glObjClass1); //glObject1 := GLDummyCube1.AddNewChild(glObjClass1); Для случая - DummyCube2 и TransCube в CenterCube TGLSpaceText(glObject1).Text := TConnectorObject(Face.FFigure).Name + inttostr(TConnectorObject(Face.FFigure).FIndex); TGLSpaceText(glObject1).Position.x := (p.x + xoffset)*factor; TGLSpaceText(glObject1).Position.z := p.z*factor; TGLSpaceText(glObject1).Position.y := p.y*factor; TGLSpaceText(glObject1).Extrusion := 0.05; TGLSpaceText(glObject1).Font.Color := clRed; TGLSpaceText(glObject1).Scale.X := 0.4; TGLSpaceText(glObject1).Scale.y := 0.4; TGLSpaceText(glObject1).Scale.z := 0.4; TGLSpaceText(glObject1).Material.FrontProperties.Diffuse.Color := clrRed; TGLSpaceText(glObject1).Material.BackProperties.Diffuse.Color := clrRed; end; glObjClass1 := TGLFreeForm; glObject1 := DummyCube2.AddNewChild(glObjClass1); try {$IF Defined(ES_GRAPH_SC)} TGLFreeForm(glObject1).LoadFromFile(ExeDir + '\3DModels\RM.3ds'); {$else} TGLFreeForm(glObject1).LoadFromFile('Map.3ds'); {$IFEND} except end; TGLFreeForm(glObject1).Position.x := p.x*factor; TGLFreeForm(glObject1).Position.z := p.z*factor; TGLFreeForm(glObject1).Position.y := p.y*factor; TGLFreeForm(glObject1).Scale.X := aScaleModel; TGLFreeForm(glObject1).Scale.Y := aScaleModel; TGLFreeForm(glObject1).Scale.Z := aScaleModel; TGLFreeForm(glObject1).Material.FrontProperties.Diffuse.Color := aColorModel; TGLFreeForm(glObject1).Material.BackProperties.Diffuse.Color := aColorModel; TGLFreeForm(glObject1).BuildOctree; end else begin FigureID := TConnectorObject(Face.FFigure).ID; SCSCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(FigureID); if SCSCatalog <> nil then begin // Список всех компонентов верхнего уровня TSCSComponent if SCSCatalog.SCSComponents.Count > 0 then begin if SCSCatalog.SCSComponents[0].ComponentType.SysName = ctsnCableChannelElement then begin aScaleModel := 0.02; aColorModel := clrBlue; glObjClass1 := TGLFreeForm; glObject1 := DummyCube2.AddNewChild(glObjClass1); try {$IF Defined(ES_GRAPH_SC)} TGLFreeForm(glObject1).LoadFromFile(ExeDir + '\3DModels\RM.3ds'); {$else} TGLFreeForm(glObject1).LoadFromFile('Map.3ds'); {$IFEND} except end; TGLFreeForm(glObject1).Position.x := p.x*factor; TGLFreeForm(glObject1).Position.z := p.z*factor; TGLFreeForm(glObject1).Position.y := p.y*factor; TGLFreeForm(glObject1).Scale.X := aScaleModel; TGLFreeForm(glObject1).Scale.Y := aScaleModel; TGLFreeForm(glObject1).Scale.Z := aScaleModel; TGLFreeForm(glObject1).Material.FrontProperties.Diffuse.Color := aColorModel; TGLFreeForm(glObject1).Material.BackProperties.Diffuse.Color := aColorModel; TGLFreeForm(glObject1).BuildOctree; end; end; end; end; end; // with TGLSceneObject(glObject).Material do begin BackProperties.Ambient.AsWinColor:= Face.Color; BackProperties.Diffuse.AsWinColor := Face.Color; BackProperties.Emission.AsWinColor := Face.Color; FrontProperties.Ambient.AsWinColor := Face.Color; FrontProperties.Diffuse.AsWinColor := Face.Color; FrontProperties.Emission.AsWinColor := Face.Color; if TConnectorObject(Face.FFigure).Name = 'Anchor' then begin BackProperties.Ambient.AsWinColor:= clNone; BackProperties.Diffuse.AsWinColor := clNone; BackProperties.Emission.AsWinColor := clNone; FrontProperties.Ambient.AsWinColor := clNone; FrontProperties.Diffuse.AsWinColor := clNone; FrontProperties.Emission.AsWinColor := clNone; end; end; end; end; if Face.RecType = ftLine then begin glLine.NodeSize := 0; glLine.ShowAxes := False; if TOrthoLine(Face.FFigure).FLineType = ts_ClearTrace then gLLine.LineWidth := 1 else gLLine.LineWidth := 4; glLine.AntiAliased := True; glLine.NodesAspect := lnaInvisible; glLine.LineColor.AsWinColor := Face.Color; //clred; end else if Face.RecType = ftPolyGon then begin //glPoly.Smooth := True; glPoly.Parts := [ppTop,ppBottom]; end; 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; // ********************** NETPATHs ***************************************** if Face.RecType = ftNetPath then begin glWallSide.Mode := mmQuadStrip; 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); WallCoords[k][0] := 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 WallCoords[k][1] := p.y * factor else WallCoords[k][1] := p.y * factor + FDeltaZSlope; end else WallCoords[k][1] := p.y * factor; end else WallCoords[k][1] := p.y * factor; WallCoords[k][2] := p.z * factor; end; glWallSide.Vertices.Clear; AddWall(glWallSide, WallCoords); 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; if Face.FFaceWallType = fwtInner then begin Texture.texturemode := tmDecal; Texture.Disabled := False; Texture.Image.LoadFromFile(tex_innerwall); end else if Face.FFaceWallType = fwtOuter then begin Texture.texturemode := tmDecal; Texture.Disabled := False; Texture.Image.LoadFromFile(tex_outerwall); end else if Face.FFaceWallType = fwtDoorSlope then begin Texture.texturemode := tmDecal; Texture.Disabled := False; Texture.Image.LoadFromFile(tex_doorslope); end else if Face.FFaceWallType = fwtWindowSlope then begin Texture.texturemode := tmDecal; Texture.Disabled := False; Texture.Image.LoadFromFile(tex_windowslope); end else if Face.FFaceWallType = fwtArc then begin Texture.texturemode := tmDecal; Texture.Disabled := False; Texture.Image.LoadFromFile(tex_arc); end else if Face.FFaceWallType = fwtBalconSlope then begin Texture.texturemode := tmDecal; Texture.Disabled := False; Texture.Image.LoadFromFile(tex_balconslope); end else if Face.FFaceWallType = fwtNiche then begin Texture.texturemode := tmDecal; Texture.Disabled := False; Texture.Image.LoadFromFile(tex_niche); end; end; 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); WallCoords[k][0] := p.x * factor; begin if (p.y < 0.011) then begin if (p.y <> p1.y) then glDoorSide.AddNode(p.x * factor, p.y * factor, p.z * factor) else glDoorSide.AddNode(p.x * factor, p.y * factor + FDeltaZSlope, p.z * factor); end else glDoorSide.AddNode(p.x * factor, p.y * factor, p.z * factor); end; //glDoorSide.AddNode(p.x * factor, p.y * factor, p.z * factor); end; with TGLSceneObject(glObject).Material do begin aColor := clrDarkWood; 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); glWindowSide.AddNode(p.x * factor, p.y * factor, p.z * factor); 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); WallCoords[k][0] := p.x * factor; begin if (p.y < 0.011) then begin if (p.y <> p1.y) then glBalconDoorSide.AddNode(p.x * factor, p.y * factor, p.z * factor) else glBalconDoorSide.AddNode(p.x * factor, p.y * factor + FDeltaZSlope, p.z * factor); end else glBalconDoorSide.AddNode(p.x * factor, p.y * factor, p.z * factor); end; //glBalconDoorSide.AddNode(p.x * factor, p.y * factor, p.z * factor); 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); glBalconWindowSide.AddNode(p.x * factor, p.y * factor, p.z * factor); 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 ***************************************** 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; // ********************** NETFLOOR ***************************************** (* if Face.RecType = ftNetFloor then begin glFloor.Mode := mmPolygon; SetLength(FloorCoords, pCnt div 2); //SetLength(FloorCoords, pCnt); for k := 0 to (pCnt div 2) - 1 do //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 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]); if pn[1] < 0 then begin BegCoordIndex := (pCnt div 2); for k := 0 to (pCnt div 2) - 1 do begin p := Face.Points[k + BegCoordIndex]; 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; end; end; glFloor.Vertices.Clear; //glFloor.VertexMode := vmVNT; AddFloor(glFloor, FloorCoords); 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; // ********************** NETFLOOR ***************************************** *) // ********************** NETCEILING *************************************** 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; (* // ********************** NETCEILING *************************************** if Face.RecType = ftNetCeiling then begin glCeiling.Mode := mmPolygon; BegCoordIndex := 0; SetLength(FloorCoords, pCnt div 2); //SetLength(FloorCoords, pCnt); for k := 0 to (pCnt div 2) - 1 do //for k := 0 to pCnt - 1 do begin p := Face.Points[k + BegCoordIndex]; 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; // if cbViewCeiling.Checked then // glCeiling.Visible := true // else // glCeiling.Visible := false; 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]); if pn[1] > 0 then begin BegCoordIndex := (pCnt div 2); for k := 0 to (pCnt div 2) - 1 do begin p := Face.Points[k + BegCoordIndex]; 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; end; end; glCeiling.Vertices.Clear; AddFloor(glCeiling, FloorCoords); 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; // ********************** NETCEILING *************************************** *) with TGLSceneObject(glObject).Material do begin if (Face.Trans) or (face.OpTrans) then begin BlendingMode := bmTransparency; BackProperties.Diffuse.Alpha := 0.4; FrontProperties.Diffuse.Alpha := 0.4; end; end; if Face.RecType = ftPipe then begin glPipe.Radius := Face.Size; glPipe.Parts := [ppOutSide,ppInSide,ppStartDisk,ppStopDisk]; end else if Face.RecType = ftBar then begin glPipe.Radius := 0.06; end else if Face.RecType = ftSphere then begin glSphere.Radius := Face.Size * factor; end else if Face.RecType = ftCenterCube then begin end; end; 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; GLCamera1.Position.x := cx; GLCamera1.Position.y := cy; GLCamera1.Position.z := tz * factor + 40; {$IF Not Defined(ES_GRAPH_SC)} GLPlane1.Material.Texture.Image.LoadFromFile(GetPathToSCSTmpDir + '\3d.jpg'); {$ELSE} GLPlane1.Position.y := GLPlane1.Position.y - FDeltaZPlane; {$IFEND} GLPlane1.Scale.Y := GCadForm.PCad.WorkHeight * factor; GLPlane1.Scale.X := GCadForm.PCad.WorkWidth * factor; // Камера в перспективный вид glCamera1.CameraStyle := csPerspective; GLCamera1.FocalLength := 160; lbViewType.Caption := cForm3D_Mes3; 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.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin if key = vk_up then begin end else begin end; end; procedure Tfrm3D.SpeedButton1Click(Sender: TObject); begin glCamera1.CameraStyle := csPerspective; GLCamera1.FocalLength := 160; lbViewType.Caption := cForm3D_Mes3; // GLCamera1.Position.x := 44; // GLCamera1.Position.x := 40; // GLCamera1.Position.x := 67; end; procedure Tfrm3D.SpeedButton2Click(Sender: TObject); begin glCamera1.CameraStyle := csOrthogonal; GLCamera1.FocalLength := 1.7; lbViewType.Caption := cForm3D_Mes4; // GLCamera1.Position.x := 43; // GLCamera1.Position.x := 45; // GLCamera1.Position.x := 63; 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 cbViewCeiling.Checked := True; // end; procedure Tfrm3D.GLHeightField1GetHeight(const x, y: Single; var z: Single; var color: TVector4f; var texPoint: TTexPoint); begin z := 0; end; procedure Tfrm3D.FormMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); var s: Single; shiftDown : Boolean; ctrlDown : Boolean; i: integer; begin shiftDown := (IsKeyDown(VK_LShift) or IsKeyDown(VK_RSHIFT)); ctrlDown := (IsKeyDown(VK_LCONTROL) or IsKeyDown(VK_RCONTROL)); if ctrlDown then begin for i := 0 to DummyCube2.Count - 1 do begin if shiftdown then begin if DummyCube2.Children[i].ClassName = 'TGLSpaceText' then begin if WheelDelta < 0 then begin if DummyCube2.Children[i].Scale.X >= 0.01 then begin DummyCube2.Children[i].Scale.X := DummyCube2.Children[i].Scale.X + WheelDelta / 24000; DummyCube2.Children[i].Scale.Y := DummyCube2.Children[i].Scale.Y + WheelDelta / 24000; DummyCube2.Children[i].Scale.Z := DummyCube2.Children[i].Scale.Z + WheelDelta / 24000; end; end else begin DummyCube2.Children[i].Scale.X := DummyCube2.Children[i].Scale.X + WheelDelta / 24000; DummyCube2.Children[i].Scale.Y := DummyCube2.Children[i].Scale.Y + WheelDelta / 24000; DummyCube2.Children[i].Scale.Z := DummyCube2.Children[i].Scale.Z + WheelDelta / 24000; end; end; end else begin if DummyCube2.Children[i].ClassName = 'TGLFreeForm' then begin if WheelDelta < 0 then begin if DummyCube2.Children[i].Scale.X >= 0.01 then begin DummyCube2.Children[i].Scale.X := DummyCube2.Children[i].Scale.X + WheelDelta / 24000; DummyCube2.Children[i].Scale.Y := DummyCube2.Children[i].Scale.Y + WheelDelta / 24000; DummyCube2.Children[i].Scale.Z := DummyCube2.Children[i].Scale.Z + WheelDelta / 24000; end; end else begin DummyCube2.Children[i].Scale.X := DummyCube2.Children[i].Scale.X + WheelDelta / 24000; DummyCube2.Children[i].Scale.Y := DummyCube2.Children[i].Scale.Y + WheelDelta / 24000; DummyCube2.Children[i].Scale.Z := DummyCube2.Children[i].Scale.Z + WheelDelta / 24000; end; end; end; end; end else begin s := GLCamera1.FocalLength; if shiftdown then begin if glCamera1.CameraStyle = csPerspective then GLCamera1.FocalLength := s + WheelDelta / 80 else GLCamera1.FocalLength := s + WheelDelta / 2420; end else begin if glCamera1.CameraStyle = csPerspective then GLCamera1.FocalLength := s + WheelDelta / 20 else GLCamera1.FocalLength := s + WheelDelta / 540; end; end; end; procedure Tfrm3D.Button1Click(Sender: TObject); begin GLPlane1.Scale.Y := GLPlane1.Scale.Y + 2; GLPlane1.Scale.X := GLPlane1.Scale.Y * 1.41; Button1.Caption := floattostr(GLPlane1.Scale.Y); end; procedure Tfrm3D.Button2Click(Sender: TObject); begin GLPlane1.Scale.Y := GLPlane1.Scale.Y - 2; GLPlane1.Scale.X := GLPlane1.Scale.Y * 1.41; Button1.Caption := floattostr(GLPlane1.Scale.Y); end; procedure Tfrm3D.SpeedButton3Click(Sender: TObject); var Save3D: TSaveDialog; Jpeg: TJPEGImage; Bmp: TBitmap; BmpFileName: string; bmpx, bmpy: Integer; begin try if glCamera1.CameraStyle = csPerspective then begin ShowMessage(cForm3D_Mes2); Exit; end; Save3D := TSaveDialog.Create(nil); with Save3D do begin InitialDir := GetEXEDir; Title := cForm3D_Mes1; Filter := '(*.jpg)|*.jpg'; DefaultExt := '*.jpg'; FileName := ''; Options := [ofReadOnly,ofHideReadOnly,ofPathMustExist,ofFileMustExist,ofNoDereferenceLinks]; end; if Save3D.Execute then begin if frm3D_Save.ShowModal = mrOk then begin Bmp := TBitmap.Create; Jpeg := TJPEGImage.Create; BmpFileName := ChangeFileExt(Save3D.FileName, '.bmp'); if frm3D_Save.rbLow.Checked then begin GLSceneViewer1.Buffer.RenderToFile(BmpFileName, 300); end; if frm3D_Save.rbNormal.Checked then begin bmpx := GLSceneViewer1.Buffer.Width * 2; bmpy := GLSceneViewer1.Buffer.Height * 2; GLSceneViewer1.Buffer.RenderToFile(BmpFileName, bmpx, bmpy); end; if frm3D_Save.rbHigh.Checked then begin bmpx := GLSceneViewer1.Buffer.Width * 3; bmpy := GLSceneViewer1.Buffer.Height * 3; GLSceneViewer1.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; begin try for i := 0 to DummyCube2.Count - 1 do begin // включить/выключить потолок и пол if DummyCube2.Children[i].Tag = 999 then begin DummyCube2.Children[i].Visible := cbViewCeiling.Checked; end; if DummyCube2.Children[i].Tag = 998 then begin DummyCube2.Children[i].Visible := cbViewCeiling.Checked; end; end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.cbViewCeilingClick', E.Message); end; end; procedure Tfrm3D.AddWall(aWall: TGLMesh; vs: array of TVector3f); var vd: array [1..6] of TVertexData; pN, pP: TVector3f; mat: TAffineMatrix; begin try pN := CalcPlaneNormal (vs[0], vs[1], vs[2]); SetVector (mat[2], pN); SetVector (mat[0], VectorNormalize (VectorSubtract (vs[1], vs[0]))); SetVector (mat[1], VectorCrossProduct (mat[2], mat[0])); InvertMatrix (mat); with vd[1] do begin coord := vs[0]; normal := pN; pP := VectorTransform (vs[0], mat); textCoord := TexPointMake (pP[0], pP[1]); end; with vd[2] do begin coord := vs[1]; normal := pN; pP := VectorTransform (vs[1], mat); textCoord := TexPointMake (pP[0], pP[1]); end; with vd[3] do begin coord := vs[2]; normal := pN; pP := VectorTransform (vs[2], mat); textCoord := TexPointMake (pP[0], pP[1]); end; with vd[4] do begin coord := vs[3]; normal := pN; pP := VectorTransform (vs[3], mat); textCoord := TexPointMake (pP[0], pP[1]); end; with vd[5] do begin coord := vs[4]; normal := pN; pP := VectorTransform (vs[4], mat); textCoord := TexPointMake (pP[0], pP[1]); end; with vd[6] do begin coord := vs[5]; normal := pN; pP := VectorTransform (vs[5], mat); textCoord := TexPointMake (pP[0], pP[1]); end; aWall.Vertices.AddVertex (vd[1]); aWall.Vertices.AddVertex (vd[2]); aWall.Vertices.AddVertex (vd[3]); aWall.Vertices.AddVertex (vd[4]); aWall.Vertices.AddVertex (vd[5]); aWall.Vertices.AddVertex (vd[6]); except on E: Exception do AddExceptionToLogEx('Tfrm3D.AddFloor', E.Message); end; end; procedure Tfrm3D.AddFloor(aFloor: TGLMesh; vs: array of TVector3f); 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 (vs[1], vs[0]))); 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 with vd do begin coord := vs[i]; normal := pN; pP := VectorTransform (vs[i], mat); textCoord := TexPointMake (pP[0], pP[1]); end; aFloor.Vertices.AddVertex (vd); end; except on E: Exception do AddExceptionToLogEx('Tfrm3D.AddFloor', E.Message); end; end; end.