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

1535 lines
51 KiB
ObjectPascal
Raw Blame History

unit Form3d;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Keyboard, Dialogs, GLScene, GLObjects, GLWin32Viewer, GLMisc, GLTexture,
StdCtrls, ExtCtrls, Buttons,PCTypesUtils,GLGeomObjects,VectorGeometry,
GLFile3DS, GLExtrusion, GLGraph, GLVectorFileObjects, GLPortal, GLSpaceText,GLMultiPolygon, VectorTypes,
GLHUDObjects, GLWaterPlane, GLBitmapFont, GLWindowsFont, LibJPeg, Form3d_Save,
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); <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> - DummyCube2 <20> TransCube <20> 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} '<27>/<2F>' {$IFEND} + inttostr(TOrthoLine(Face.FFigure).FIndex);
TGLSpaceText(glObject1).Scale.X := 0.2;
TGLSpaceText(glObject1).Scale.y := 0.2;
TGLSpaceText(glObject1).Scale.z := 0.2;
end
else
begin
TGLSpaceText(glObject1).Text := TOrthoLine(Face.FFigure).Name + inttostr(TOrthoLine(Face.FFigure).FIndex);
TGLSpaceText(glObject1).Scale.X := 0.4;
TGLSpaceText(glObject1).Scale.y := 0.4;
TGLSpaceText(glObject1).Scale.z := 0.4;
end;
TGLSpaceText(glObject1).Position.x := p.x*factor;
TGLSpaceText(glObject1).Position.z := p.z*factor;
if Face.Points[0].z = Face.Points[1].z then
TGLSpaceText(glObject1).Position.y := (p.y + 2) * factor
else
TGLSpaceText(glObject1).Position.y := (p.y - 2) * factor;
TGLSpaceText(glObject1).Extrusion := 0.05;
TGLSpaceText(glObject1).Font.Color := clRed;
TGLSpaceText(glObject1).Material.FrontProperties.Diffuse.Color := clrRed;
TGLSpaceText(glObject1).Material.BackProperties.Diffuse.Color := clrRed;
//
with TGLSceneObject(glObject).Material do
begin
BackProperties.Ambient.AsWinColor:= Face.Color;
BackProperties.Diffuse.AsWinColor := Face.Color;
BackProperties.Emission.AsWinColor := Face.Color;
FrontProperties.Ambient.AsWinColor := Face.Color;
FrontProperties.Diffuse.AsWinColor := Face.Color;
FrontProperties.Emission.AsWinColor := Face.Color;
end;
end;
if Face.RecType = ftPipe then
begin
if TConnectorObject(Face.FFigure).ConnectorType <> ct_Clear then
begin
{!!!}
if TConnectorObject(Face.FFigure).Name <> ctnConnector then
begin
aScaleModel := 0.05;
aColorModel := clrGreen;
xoffset := 3;
FigureID := TConnectorObject(Face.FFigure).ID;
SCSCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(FigureID);
if SCSCatalog <> nil then
begin
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> TSCSComponent
if SCSCatalog.SCSComponents.Count > 0 then
begin
if SCSCatalog.SCSComponents[0].ComponentType.SysName = ctsnCupboard then
begin
aScaleModel := 0.1;
aColorModel := clrBrown;
xoffset := 4;
end;
if SCSCatalog.SCSComponents[0].ComponentType.SysName = ctsnCableChannelElement then
begin
aScaleModel := 0.02;
aColorModel := clrBlue;
end;
end;
end;
{!!!}
if TConnectorObject(Face.FFigure).Name <> cCadClasses_Mes24 then
begin
glObjClass1 := TGLSpaceText;
p := Face.Points[0];
p := DoublePoint(p.x,p.z,p.y);
glObject1 := DummyCube2.AddNewChild(glObjClass1);
//glObject1 := GLDummyCube1.AddNewChild(glObjClass1); <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> - DummyCube2 <20> TransCube <20> 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
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> TSCSComponent
if SCSCatalog.SCSComponents.Count > 0 then
begin
if SCSCatalog.SCSComponents[0].ComponentType.SysName = ctsnCableChannelElement then
begin
aScaleModel := 0.02;
aColorModel := clrBlue;
glObjClass1 := TGLFreeForm;
glObject1 := 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;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD>
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
// <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 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.
Reference in New Issue View Git Blame Copy Permalink