unit Form3dN; 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, GLCadencer; //GLGeomObjects GLGeomObjects GLGeomObjects GLOutlineShader VectorGeometry type Tfrm3D = class(TForm) GLScene1: TGLScene; GLCamera1: TGLCamera; Panel2: TPanel; ScrollBar1: TScrollBar; GLSceneViewer1: TGLSceneViewer; GLLightSource1: TGLLightSource; GLLightSource2: TGLLightSource; GLLightSource3: TGLLightSource; GLLightSource4: TGLLightSource; GLLightSource5: TGLLightSource; Panel3: TPanel; SpeedButton1: TSpeedButton; SpeedButton2: TSpeedButton; MainCenter: TGLDummyCube; DummyCube2: TGLDummyCube; TransCube: TGLDummyCube; GLPlane1: TGLPlane; GLCadencer1: TGLCadencer; GLDummyCube2: TGLDummyCube; 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 Button1Click(Sender: TObject); procedure ScrollBar1Change(Sender: TObject); procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); 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); 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); end; var frm3D: Tfrm3D; mip, translateOffset: TVector; translating: Boolean; implementation uses U_ESCadClasess, U_BaseConstants, U_Constants; {$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; begin shiftDown:=(IsKeyDown(VK_LSHIFT) or IsKeyDown(VK_RSHIFT)); dx := mx - x; dy := my - y; GetCursorPos(mp); mp:=GLSceneViewer1.ScreenToClient(mp); 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); end else GLCamera1.MoveAroundTarget(my-y, mx-x); end else if Shift=[ssRight] then begin if PtInRect(GLSceneViewer1.ClientRect, mp) then begin GLSceneViewer1.Buffer.ScreenVectorIntersectWithPlaneXZ(VectorMake(-mp.x, mp.y - GLSceneViewer1.Height, 0), 0, ip); if not translating then begin translateOffset := ip; translating := True; end; GLDummyCube1.Position.Translate(VectorAdd(VectorSubtract(mip, ip), translateOffset)); TransCube.Position.Translate(VectorAdd(VectorSubtract(mip, ip), translateOffset)); DummyCube2.Position.Translate(VectorAdd(VectorSubtract(mip, ip), translateOffset)); // v := GLCamera1.ScreenDeltaToVectorXZ(-dx, dy, 0.05 * GLCamera1.DistanceToTarget / GLCamera1.FocalLength); // GLDummyCube1.Position.Translate(v); // DummyCube2.Position.Translate(v); // TransCube.Position.Translate(v); GLSceneViewer1.Invalidate; // GLCamera1.TransformationChanged; end; end else translating := False; mx := x; my := y; end; *) var ip : TVector; mp : TPoint; shiftDown : Boolean; begin shiftDown:=(IsKeyDown(VK_LSHIFT) or IsKeyDown(VK_RSHIFT)); // DCSelection.Visible:=not shiftDown; // if DCSelection.Visible then // GLSceneViewer1.Cursor:=crDefault // else // GLSceneViewer1.Cursor:=crHandPoint; GetCursorPos(mp); mp:=GLSceneViewer1.ScreenToClient(mp); if PtInRect(GLSceneViewer1.ClientRect, mp) then begin GLSceneViewer1.Buffer.ScreenVectorIntersectWithPlaneXZ( VectorMake(mp.x, GLSceneViewer1.Height-mp.y, 0), 0, ip); // tileX:=Round(ip[0]-0.5); // tileY:=Round(ip[1]-0.5); // DCSelection.Position.SetPoint(tileX, tileY, 0); if shiftDown then begin if IsKeyDown(VK_LBUTTON) then begin if not translating then begin translateOffset:=ip; translating:=True; // Memo1.Lines.Add('translateOffset:=ip'); end; GLDummyCube2.Position.Translate(VectorAdd(VectorSubtract(mip, ip), translateOffset)); // Memo1.Lines.Add('DCTarget.Position.Translate'); end else translating:=False; if IsKeyDown(VK_RBUTTON) then begin GLCamera1.MoveAroundTarget((my-mp.y)*0.5, (mx-mp.x)*0.5); end; end else begin translating:=False; if IsKeyDown(VK_LBUTTON) then begin // GLTilePlane.Tiles[tileX, tileY]:=CBMaterial.ItemIndex+1; // GLTilePlane.StructureChanged; end; if IsKeyDown(VK_RBUTTON) then begin // GLTilePlane.Tiles[tileX, tileY]:=0; // GLTilePlane.StructureChanged; end; end; mx:=mp.x; my:=mp.y; end; GLSceneViewer1.Invalidate; 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: T3dPoint; p1: 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; begin FaceList := Faces; Factor := 0.15; DummyCube2.DeleteChildren; TransCube.DeleteChildren; // cmbCenter.Items.Clear; // cmbCenter.Items.AddObject('Bina Merkezi',MainCenter); // GlScene1.Objects.Remove(); 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; 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); 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 glPoly.AddNode( p.x*factor,p.y*factor,p.z*factor) 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 glPipe.AddNode(p.x*factor,p.y*factor,p.z*factor); 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); 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; end; if Face.RecType = ftPipe then begin if TConnectorObject(Face.FFigure).ConnectorType <> ct_Clear then begin if TConnectorObject(Face.FFigure).Name <> ctnConnector then begin glObjClass1 := TGLSpaceText; p := Face.Points[0]; p := DoublePoint(p.x,p.z,p.y); glObject1 := DummyCube2.AddNewChild(glObjClass1); TGLSpaceText(glObject1).Text := TConnectorObject(Face.FFigure).Name + inttostr(TConnectorObject(Face.FFigure).FIndex); TGLSpaceText(glObject1).Position.x := (p.x + 3)*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; glObjClass1 := TGLFreeForm; glObject1 := glPipe.AddNewChild(glObjClass1); try TGLFreeForm(glObject1).LoadFromFile('Map.3ds'); except end; TGLSpaceText(glObject1).Position.x := p.x*factor; TGLSpaceText(glObject1).Position.z := p.z*factor; TGLSpaceText(glObject1).Position.y := p.y*factor; TGLFreeForm(glObject1).Scale.X := 0.05; TGLFreeForm(glObject1).Scale.Y := 0.05; TGLFreeForm(glObject1).Scale.Z := 0.05; TGLFreeForm(glObject1).Material.FrontProperties.Diffuse.Color := clrGreen; TGLFreeForm(glObject1).Material.BackProperties.Diffuse.Color := clrGreen; TGLFreeForm(glObject1).BuildOctree; 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; with TGLSceneObject(glObject).Material do begin //Face.Color := SurfaceColor(Face.Points,DoublePoint(0,0,0)); 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.Trans) or (face.OpTrans) then begin BlendingMode := bmTransparency; BackProperties.Diffuse.Alpha := 0.4; FrontProperties.Diffuse.Alpha := 0.4; end; //Texture.texturemode := tmModulate; //Texture.Image.LoadFromFile('C:\Projects\ZetaCad2.0\media\ashwood.jpg'); //Texture.Disabled := False; //BackProperties.PolygonMode := pmLines; //BlendingMode := bmTransparency; //FrontProperties.Diffuse.Color :=VectorLerp(clrYellow, clrRed, 0); end; if Face.RecType = ftPipe then begin glPipe.Radius := Face.Size; glPipe.Parts := [ppOutSide,ppInSide,ppStartDisk,ppStopDisk]; //glPipe.Material.FrontProperties.Diffuse.Color :=VectorLerp(clrRed, clrRed, 0); //glPipe.Material.BackProperties.Diffuse.Color :=VectorLerp(clrRed, clrRed, 0); end else if Face.RecType = ftBar then begin glPipe.Radius := 0.06; //glPipe.Material.FrontProperties.Diffuse.Color :=VectorLerp(clrGray, clrGray, 0); //glPipe.Material.BackProperties.Diffuse.Color :=VectorLerp(clrGray, clrGray, 0); end else if Face.RecType = ftSphere then begin glSphere.Radius := Face.Size*factor; end else if Face.RecType = ftCenterCube then begin end else begin //TGLSceneObject(glObject).Material.MaterialLibrary := GLMaterialLibrary1; //TGLSceneObject(glObject).Material.LibMaterialName := 'LibMaterial1'; 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; // GLPlane1.Material.Texture.Image.LoadFromFile('123.bmp'); end; procedure Tfrm3D.Button1Click(Sender: TObject); begin if glCamera1.CameraStyle = csOrthogonal then glCamera1.CameraStyle := csPerspective else glCamera1.CameraStyle := csOrthogonal; end; procedure Tfrm3D.ScrollBar1Change(Sender: TObject); var s: Single; begin s := ScrollBar1.Position; if glCamera1.CameraStyle = csPerspective then s := s*5; GLCamera1.FocalLength := s; 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; end; procedure Tfrm3D.SpeedButton2Click(Sender: TObject); begin glCamera1.CameraStyle := csOrthogonal; end; procedure Tfrm3D.FormShow(Sender: TObject); begin // 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; begin s := GLCamera1.FocalLength; if glCamera1.CameraStyle = csPerspective then GLCamera1.FocalLength := s + WheelDelta / 60 else GLCamera1.FocalLength := s + WheelDelta / 240; // GLCamera1.AdjustDistanceToTarget(Power(1.1, WheelDelta/120)); end; end.