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

561 lines
18 KiB
ObjectPascal
Raw Permalink Blame History

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} '<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;
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.
Reference in New Issue View Git Blame Copy Permalink