DavidJr.

Hi, this is a nice feature. I am able to render a Firemonkey rending of a 3D model within a VCL Form. But it would be nice to be able to pass data back and forth between the FMX form and the VCL form.

Is there a way to add multiple TMesh objects into a common TDummy while preserving the original size of mesh. Currently the meshes all are appearing to be centered and the scale is changed.

Hi, with verified (using 3rd party software) 3MF files I am able to load the data, however the TModel3D even with TLight I am just getting a blank window with only the TButton. What am I missing? I have attache pretty much everything I have. David Unit1.pas Unit1.fmx GLCADViewer.dpr GLCADViewer.dproj

I finally got time to go back to this code and test. I was able to correct scaling, but the positioning is wrong. It seems that when adding multiple tmesh objects to one tdummy manual scaling is required, and positioning. Is there something I am missing about TDummy and/or TMesh that can make this a little easier? IF you run this and do not select the checkbox it will add a Lib3MF Mesh objects to one TMesh (FMX) object and then everything renders at the correct scale and position, its when I try to add each 3Mf Mesh Object to its own TMesh (FMX object) that I get this problem. I attached the full project with the DLL. unit Unit1; interface uses Windows, System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, System.Math.Vectors, System.Generics.Collections, System.Math, FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Objects, FMX.Controls.Presentation, FMX.StdCtrls, FMX.Viewport3D, FMX.Memo.Types, FMX.ScrollBox, FMX.Memo, FMX.Objects3D, FMX.Types3D, Unit_Lib3MF, FMX.Edit, FMX.Layouts, FMX.ListBox, FMX.Controls3D, FMX.MaterialSources; const DLLName = 'lib3mf.dll'; RCLASS = '3mf'; WheelSensitive = 0.01; type TPoint3DArray = TArray<TPoint3D>; TIndexArray = TArray<Integer>; TColorArray = array[1..6] of TAlphaColor; TForm1 = class(TForm) Viewport3D1: TViewport3D; btnLoadModel: TButton; OpenDialog1: TOpenDialog; Memo1: TMemo; ListBox1: TListBox; Camera: TCamera; Light: TLight; cbMultiColoredObjects: TCheckBox; procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure btnLoadModelClick(Sender: TObject); procedure Viewport3D1MouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean); procedure Viewport3D1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single); procedure Viewport3D1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Single); procedure Viewport3D1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single); procedure ListBox1Change(Sender: TObject); procedure cbMultiColoredObjectsChange(Sender: TObject); private ModelLoad: Boolean; GlobalCenter, GlobalMinPoint, GlobalMaxPoint: TPoint3D; FLastMousePos: TPointF; FCameraDistance: Single; FMouseDown: TPointF; FIsPanning: Boolean; FIsRotating: Boolean; FColors: TColorArray; FLargestCenterPoint: TPoint3D; FMeshes: TDictionary<Integer, TMesh>; FObjectToBuildItemMap: TDictionary<Integer, TLib3MFBuildItem>; Lib3MF: TLib3MFWrapper; Lib3MFReader: TLib3MFReader; Model3MF: TLib3MFModel; Model3D: TDummy;//TModel3D; ObjectIterator: TLib3MFObjectIterator; Obj: TLib3MFObject; BuildItemIterator: TLib3MFBuildItemIterator; BuildItem: TLib3MFBuildItem; SliceStackIterator: TLib3MFSliceStackIterator; SliceStack: TLib3MFSliceStack; ObjRange: TArray<Integer>; FilePath3MF: String; function OutputLib3MFVersion: Boolean; function OpenFile3MF(FN: AnsiString): Boolean; procedure ShowThumbnailInformation(Model: TLib3MFModel); procedure ShowMetaDataInformation(MetaDataGroup: TLib3MFMetaDataGroup); procedure ShowSliceStack(SliceStack: TLib3MFSliceStack; Indent: string); procedure ShowObjectProperties(cadObj: TLib3MFObject); procedure ShowMeshObjectInformation(MeshObj: TLib3MFMeshObject); procedure ShowTransform(Transform: TLib3MFTransform; Indent: string); procedure ShowComponentsObjectInformation(ComponentsObj: TLib3MFComponentsObject); procedure SelectAllListBoxItems; function ExtractInfoFrom3MF(FileName: string): Boolean; // GRAPH METHODS: procedure ClearModel3D; procedure RenderSelectedObjects; procedure RenderCompositeMeshWithGhost; // All Meshes added as indiviual objects: procedure RenderCompositeMesh; // All Vertices and Trianlges (from each object) added into one Mesh: procedure RenderCompositeToOneMesh; procedure CalculateGlobalBoundingBox; procedure CreateGhostMesh; procedure SetupCamera; public end; var Form1: TForm1; implementation {$R *.fmx} procedure TForm1.btnLoadModelClick(Sender: TObject); begin if OpenDialog1.Execute then begin FilePath3MF := OpenDialog1.FileName; ModelLoad := ExtractInfoFrom3MF(FilePath3MF); end; end; procedure TForm1.FormCreate(Sender: TObject); begin ModelLoad := False; FColors[1] := TAlphaColorRec.Red; FColors[2] := TAlphaColorRec.Green; FColors[3] := TAlphaColorRec.Blue; FColors[4] := TAlphaColorRec.Yellow; FColors[5] := TAlphaColorRec.Cyan; FColors[6] := TAlphaColorRec.Magenta; Lib3MF := TLib3MFWrapper.Create(DLLName); FObjectToBuildItemMap := TDictionary<Integer, TLib3MFBuildItem>.Create; FMeshes := TDictionary<Integer, TMesh>.Create; Model3D := TDummy.Create(Self); Model3D.Parent := Viewport3D1; Model3D.HitTest := False; ListBox1.MultiSelect := True; if Assigned(Lib3MF) AND (Lib3MF is TLib3MFWrapper) then begin btnLoadModel.Enabled := OutputLib3MFVersion; end; SetupCamera; end; procedure TForm1.FormDestroy(Sender: TObject); begin if Assigned(Lib3MF) then Lib3MF.Free; FObjectToBuildItemMap.Free; end; procedure TForm1.ListBox1Change(Sender: TObject); begin RenderSelectedObjects; end; procedure TForm1.Viewport3D1MouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean); var NewScale: Single; begin if Assigned(Model3D) then begin NewScale := Model3D.Scale.X + WheelDelta * WheelSensitive; // Use uniform scaling if NewScale > 0.01 then // Prevent scaling to zero or negative begin Model3D.Scale.X := NewScale; Model3D.Scale.Y := NewScale; Model3D.Scale.Z := NewScale; Form1.Caption := '3MF View (Scale: ' + NewScale.ToString + ')'; end; Viewport3D1.Repaint; Handled := True; end; end; procedure TForm1.Viewport3D1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single); begin FMouseDown := PointF(X, Y); if Button = TMouseButton.mbLeft then begin FIsPanning := True; end else if Button = TMouseButton.mbRight then begin FIsRotating := True; end; end; procedure TForm1.Viewport3D1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Single); var DeltaX, DeltaY: Single; begin if FIsRotating or FIsPanning then begin DeltaX := (X - FMouseDown.X) / Viewport3D1.Width; DeltaY := (Y - FMouseDown.Y) / Viewport3D1.Height; FMouseDown := PointF(X, Y); if FIsRotating then begin Model3D.RotationAngle.X := Model3D.RotationAngle.X + DeltaY * 360; Model3D.RotationAngle.Y := Model3D.RotationAngle.Y + DeltaX * 360; Viewport3D1.Repaint; end else if FIsPanning then begin Model3D.Position.X := Model3D.Position.X - DeltaX * 10; Model3D.Position.Y := Model3D.Position.Y + DeltaY * 10; Viewport3D1.Repaint; end; end; end; procedure TForm1.Viewport3D1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single); begin FIsPanning := False; FIsRotating := False; end; procedure TForm1.SetupCamera; begin FCameraDistance := 2000; // Initial camera distance Camera.Parent := Viewport3D1; // Position the camera Camera.Position.Point := Point3D(0, 0, FCameraDistance); Camera.RotationAngle.X := 0; Camera.RotationAngle.Y := 0; Camera.RotationAngle.Z := 0; Viewport3D1.Camera := Camera; // Set up a light Light := TLight.Create(Self); Light.Parent := Viewport3D1; Light.Position.Point := Point3D(0, 100, -100); Light.LightType := TLightType.Directional; Viewport3D1.AddObject(Light); end; function TForm1.OutputLib3MFVersion: Boolean; var Major, Minor, Micro: Cardinal; PreReleaseInfo, BuildInfo: AnsiString; begin Result := False; try Lib3MF.GetLibraryVersion(Major, Minor, Micro); Memo1.Lines.Add(Format('Lib3MF.Version = %d.%d.%d', [Major, Minor, Micro])); if Lib3MF.GetPrereleaseInformation(PreReleaseInfo) then Memo1.Lines.Add('-' + PreReleaseInfo); if Lib3MF.GetBuildInformation(BuildInfo) then Memo1.Lines.Add('+' + BuildInfo); Result := True; except Result := False; end; end; function TForm1.OpenFile3MF(FN: AnsiString): Boolean; var i: Integer; WarningCount: Cardinal; WarningCode: Cardinal; WarningMessage: Widestring; ReaderClass: AnsiString; begin Result := False; if Assigned(Lib3MF) and FileExists(FN) then begin try ReaderClass := RCLASS; Model3MF := Lib3MF.CreateModel; if Assigned(Model3MF) then begin Memo1.Lines.Add('Lib3MFModel created successfully.'); Memo1.Lines.Add('Querying reader for class: ' + ReaderClass); Lib3MFReader := Model3MF.QueryReader(ReaderClass); if Assigned(Lib3MFReader) then begin Memo1.Lines.Add('Lib3MFReader created successfully.'); Lib3MFReader.SetStrictModeActive(False); Lib3MFReader.ReadFromFile(FN); WarningCount := Lib3MFReader.GetWarningCount; if WarningCount > 0 then begin for i := 0 to WarningCount - 1 do begin WarningMessage := Lib3MFReader.GetWarning(i, WarningCode); Memo1.Lines.Add(Format('Encountered warning #%d : %s', [WarningCode, WarningMessage])); end; end else begin Memo1.Lines.Add('Encountered '+WarningCount.ToString+' warnings'); end; Result := True; end else Memo1.Lines.Add('Failed to create Lib3MFReader.'); end else Memo1.Lines.Add('Failed to create Lib3MFModel.'); except on E: ELib3MFException do begin Memo1.Lines.Add(Format('Error loading 3MF file: %s', [E.Message])); end; on E: Exception do begin Memo1.Lines.Add(Format('Unexpected error: %s', [E.Message])); end; end; end else Memo1.Lines.Add('Library not initialized or file not found.'); end; procedure TForm1.ShowThumbnailInformation(Model: TLib3MFModel); begin // TODO: Implement this when available in Lib3MF end; procedure TForm1.ShowMetaDataInformation(MetaDataGroup: TLib3MFMetaDataGroup); var i, MetaDataCount: Cardinal; MetaData: TLib3MFMetaData; MetaDataName, MetaDataValue: Widestring; begin MetaDataCount := MetaDataGroup.GetMetaDataCount; if MetaDataCount > 0 then begin for i := 0 to MetaDataCount - 1 do begin MetaData := MetaDataGroup.GetMetaData(i); MetaDataName := MetaData.GetName; MetaDataValue := MetaData.GetValue; Memo1.Lines.Add(Format('Metadatum: %d:', [i])); Memo1.Lines.Add(Format('Name = "%s"', [MetaDataName])); Memo1.Lines.Add(Format('Value = "%s"', [MetaDataValue])); end; end else begin Memo1.Lines.Add('No Metadata!'); end; end; procedure TForm1.ShowSliceStack(SliceStack: TLib3MFSliceStack; Indent: string); var i, SliceCount, SliceRefCount: Cardinal; begin Memo1.Lines.Add(Format('%sSliceStackID: %d', [Indent, SliceStack.GetResourceID])); SliceCount := SliceStack.GetSliceCount; if SliceCount > 0 then Memo1.Lines.Add(Format('%s Slice count: %d', [Indent, SliceCount])); SliceRefCount := SliceStack.GetSliceRefCount; if SliceRefCount > 0 then begin Memo1.Lines.Add(Format('%s Slice ref count: %d', [Indent, SliceRefCount])); for i := 0 to SliceRefCount - 1 do Memo1.Lines.Add(Format('%s Slice ref : %d', [Indent, SliceStack.GetSliceStackReference(i).GetResourceID])); end; end; procedure TForm1.ShowObjectProperties(cadObj: TLib3MFObject); begin Memo1.Lines.Add(Format(' Name: "%s"', [cadObj.GetName])); Memo1.Lines.Add(Format(' PartNumber: "%s"', [cadObj.GetPartNumber])); case cadObj.GetType of eObjectTypeModel: Memo1.Lines.Add(' Object type: model'); eObjectTypeSupport: Memo1.Lines.Add(' Object type: support'); eObjectTypeSolidSupport: Memo1.Lines.Add(' Object type: solidsupport'); eObjectTypeOther: Memo1.Lines.Add(' Object type: other'); else Memo1.Lines.Add(' Object type: invalid'); end; if cadObj.HasSlices(False) then ShowSliceStack(cadObj.GetSliceStack, ' '); if cadObj.GetMetaDataGroup.GetMetaDataCount > 0 then ShowMetaDataInformation(cadObj.GetMetaDataGroup); end; procedure TForm1.ShowMeshObjectInformation(MeshObj: TLib3MFMeshObject); var BeamLattice: TLib3MFBeamLattice; VertexCount, TriangleCount, BeamCount, i: Cardinal; RepresentationMesh, ClippingMesh: Cardinal; ClipMode: TLib3MFBeamLatticeClipMode; begin Memo1.Lines.Add(Format('mesh object #%d:', [MeshObj.GetResourceID])); ShowObjectProperties(MeshObj); VertexCount := MeshObj.GetVertexCount; TriangleCount := MeshObj.GetTriangleCount; BeamLattice := MeshObj.BeamLattice; Memo1.Lines.Add(Format(' Vertex count: %d', [VertexCount])); Memo1.Lines.Add(Format(' Triangle count: %d', [TriangleCount])); BeamCount := BeamLattice.GetBeamCount; if BeamCount > 0 then begin Memo1.Lines.Add(Format(' Beam count: %d', [BeamCount])); if BeamLattice.GetRepresentation(RepresentationMesh) then Memo1.Lines.Add(Format(' |_Representation Mesh ID: %d', [RepresentationMesh])); BeamLattice.GetClipping(ClipMode, ClippingMesh); if ClipMode <> eBeamLatticeClipModeNoClipMode then Memo1.Lines.Add(Format(' |_Clipping Mesh ID: %d (mode=%d)', [ClippingMesh, Ord(ClipMode)])); if BeamLattice.GetBeamSetCount > 0 then Memo1.Lines.Add(Format(' |_BeamSet count: %d', [BeamLattice.GetBeamSetCount])); end; end; procedure TForm1.ShowTransform(Transform: TLib3MFTransform; Indent: string); begin Memo1.Lines.Add(Format('%sTransformation: [ %f %f %f %f ]', [Indent, Transform.FFields[0, 0], Transform.FFields[1, 0], Transform.FFields[2, 0], Transform.FFields[3, 0]])); Memo1.Lines.Add(Format('%s [ %f %f %f %f ]', [Indent, Transform.FFields[0, 1], Transform.FFields[1, 1], Transform.FFields[2, 1], Transform.FFields[3, 1]])); Memo1.Lines.Add(Format('%s [ %f %f %f %f ]', [Indent, Transform.FFields[0, 2], Transform.FFields[1, 2], Transform.FFields[2, 2], Transform.FFields[3, 2]])); end; procedure TForm1.ShowComponentsObjectInformation(ComponentsObj: TLib3MFComponentsObject); var i: Cardinal; Component: TLib3MFComponent; begin Memo1.Lines.Add(Format('components object #%d:', [ComponentsObj.GetResourceID])); ShowObjectProperties(ComponentsObj); Memo1.Lines.Add(Format(' Component count: %d', [ComponentsObj.GetComponentCount])); for i := 0 to ComponentsObj.GetComponentCount - 1 do begin Component := ComponentsObj.GetComponent(i); Memo1.Lines.Add(Format(' Component %d: Object ID: %d', [i, Component.GetObjectResourceID])); if Component.HasTransform then ShowTransform(Component.GetTransform, ' ') else Memo1.Lines.Add(' Transformation: none'); end; end; procedure TForm1.SelectAllListBoxItems; var i: Integer; begin ListBox1.OnChange := nil; ListBox1.BeginUpdate; try for i := 0 to ListBox1.Items.Count - 1 do begin ListBox1.ListItems[i].IsSelected := True; end; finally ListBox1.EndUpdate; end; ListBox1.OnChange := ListBox1Change; end; function TForm1.ExtractInfoFrom3MF(FileName: string): Boolean; var ObjName: Widestring; MeshObj: TLib3MFMeshObject; MinPoint, MaxPoint, CenterPoint: TPoint3D; I, VertexCount: Integer; Vertices: array of TPoint3D; CurrentObjectSize, LargestObjectSize: Single; LargestMinPoint, LargestMaxPoint: TPoint3D; ObjID: Integer; begin Result := False; ClearModel3D; Memo1.Lines.Clear; LargestObjectSize := 0; LargestMinPoint := TPoint3D.Zero; LargestMaxPoint := TPoint3D.Zero; // Initialize global min and max points with extreme values GlobalMinPoint := TPoint3D.Create(MaxSingle, MaxSingle, MaxSingle); GlobalMaxPoint := TPoint3D.Create(-MaxSingle, -MaxSingle, -MaxSingle); Model3MF := Lib3MF.CreateModel; if (Not OpenFile3MF(FileName)) then begin Memo1.Lines.Add('Failed to load 3MF file.'); Exit; end; ListBox1.Clear; // Populate the FObjectToBuildItemMap and determine the largest object BuildItemIterator := Model3MF.GetBuildItems; while BuildItemIterator.MoveNext do begin BuildItem := BuildItemIterator.GetCurrent; ObjID := BuildItem.GetObjectResourceID; FObjectToBuildItemMap.AddOrSetValue(ObjID, BuildItem); end; // Iterate through the objects to find the largest object and update global boundaries ObjectIterator := Model3MF.GetObjects; while ObjectIterator.MoveNext do begin Obj := ObjectIterator.GetCurrentObject; ObjName := Obj.GetName; if ObjName = '' then ObjName := 'Object ' + Obj.GetResourceID.ToString; // Store object ID in ListBox item ListBox1.Items.Add(ObjName); ListBox1.ListItems[ListBox1.Items.Count - 1].Tag := Obj.GetResourceID; if Obj.IsMeshObject then begin MeshObj := TLib3MFMeshObject(Obj); VertexCount := MeshObj.GetVertexCount; SetLength(Vertices, VertexCount); // Extract vertices from the 3MF mesh object for I := 0 to VertexCount - 1 do begin Vertices[I].X := MeshObj.GetVertex(I).FCoordinates[0]; Vertices[I].Y := MeshObj.GetVertex(I).FCoordinates[1]; Vertices[I].Z := MeshObj.GetVertex(I).FCoordinates[2]; end; // Calculate bounding box and center point if Length(Vertices) > 0 then begin MinPoint := Vertices[0]; MaxPoint := Vertices[0]; for I := 1 to High(Vertices) do begin MinPoint.X := Min(MinPoint.X, Vertices[I].X); MinPoint.Y := Min(MinPoint.Y, Vertices[I].Y); MinPoint.Z := Min(MinPoint.Z, Vertices[I].Z); MaxPoint.X := Max(MaxPoint.X, Vertices[I].X); MaxPoint.Y := Max(MaxPoint.Y, Vertices[I].Y); MaxPoint.Z := Max(MaxPoint.Z, Vertices[I].Z); end; CenterPoint.X := (MinPoint.X + MaxPoint.X) / 2; CenterPoint.Y := (MinPoint.Y + MaxPoint.Y) / 2; CenterPoint.Z := (MinPoint.Z + MaxPoint.Z) / 2; // Determine the size of the current object CurrentObjectSize := Max(MaxPoint.X - MinPoint.X, Max(MaxPoint.Y - MinPoint.Y, MaxPoint.Z - MinPoint.Z)); // Update global boundaries GlobalMinPoint.X := Min(GlobalMinPoint.X, MinPoint.X); GlobalMinPoint.Y := Min(GlobalMinPoint.Y, MinPoint.Y); GlobalMinPoint.Z := Min(GlobalMinPoint.Z, MinPoint.Z); GlobalMaxPoint.X := Max(GlobalMaxPoint.X, MaxPoint.X); GlobalMaxPoint.Y := Max(GlobalMaxPoint.Y, MaxPoint.Y); GlobalMaxPoint.Z := Max(GlobalMaxPoint.Z, MaxPoint.Z); // Check if this object is the largest if CurrentObjectSize > LargestObjectSize then begin LargestObjectSize := CurrentObjectSize; FLargestCenterPoint := CenterPoint; LargestMinPoint := MinPoint; LargestMaxPoint := MaxPoint; end; end; end; end; // After processing all objects, render them SelectAllListBoxItems; if cbMultiColoredObjects.IsChecked then begin RenderSelectedObjects; end else begin RenderCompositeToOneMesh; end; Memo1.Lines.Add('done'); Result := (ListBox1.Items.Count > 0); end; // GRAPH METHODS: procedure TForm1.ClearModel3D; var i: Integer; begin // Iterate through all the children and free each one for i := Model3D.ChildrenCount - 1 downto 0 do begin Model3D.Children[i].Free; end; // Alternatively, you can clear all children at once //Model3D.Clear; end; procedure TForm1.RenderSelectedObjects; var i: Integer; ObjID: Integer; MeshObj: TLib3MFMeshObject; begin ClearModel3D; FMeshes.Clear; CalculateGlobalBoundingBox; RenderCompositeMeshWithGhost; Viewport3D1.Repaint; end; procedure TForm1.CalculateGlobalBoundingBox; var I, J: Integer; MeshObj: TLib3MFMeshObject; begin // Initialize global bounding box GlobalMinPoint := TPoint3D.Create(MaxSingle, MaxSingle, MaxSingle); GlobalMaxPoint := TPoint3D.Create(-MaxSingle, -MaxSingle, -MaxSingle); // Iterate through all objects (regardless of selection) to calculate the global bounding box for I := 0 to ListBox1.Count - 1 do begin MeshObj := TLib3MFMeshObject(FObjectToBuildItemMap[ListBox1.ListItems[I].Tag].GetObjectResource); for J := 0 to MeshObj.GetVertexCount - 1 do begin GlobalMinPoint.X := Min(GlobalMinPoint.X, MeshObj.GetVertex(J).FCoordinates[0]); GlobalMinPoint.Y := Min(GlobalMinPoint.Y, MeshObj.GetVertex(J).FCoordinates[1]); GlobalMinPoint.Z := Min(GlobalMinPoint.Z, MeshObj.GetVertex(J).FCoordinates[2]); GlobalMaxPoint.X := Max(GlobalMaxPoint.X, MeshObj.GetVertex(J).FCoordinates[0]); GlobalMaxPoint.Y := Max(GlobalMaxPoint.Y, MeshObj.GetVertex(J).FCoordinates[1]); GlobalMaxPoint.Z := Max(GlobalMaxPoint.Z, MeshObj.GetVertex(J).FCoordinates[2]); end; end; // Calculate the global center of the entire model GlobalCenter := (GlobalMinPoint + GlobalMaxPoint) * 0.5; end; procedure TForm1.cbMultiColoredObjectsChange(Sender: TObject); begin if ModelLoad then begin ClearModel3D; if cbMultiColoredObjects.IsChecked then begin RenderCompositeMesh; end else begin RenderCompositeToOneMesh; end; end; end; procedure TForm1.CreateGhostMesh; var GhostMesh: TMesh; Material: TColorMaterialSource; Vertices: array[0..7] of TPoint3D; Indices: array of Integer; I: Integer; begin GhostMesh := TMesh.Create(Self); // Clear any transformations on TDummy to avoid scaling/positioning issues Model3D.Position.Point := TPoint3D.Zero; Model3D.Scale.Point := TPoint3D.Create(1.0, 1.0, 1.0); Model3D.RotationAngle.Point := TPoint3D.Zero; GhostMesh.Parent := Model3D; // Define the 8 corners of the bounding box based on the global min/max points Vertices[0] := TPoint3D.Create(GlobalMinPoint.X, GlobalMinPoint.Y, GlobalMinPoint.Z); Vertices[1] := TPoint3D.Create(GlobalMaxPoint.X, GlobalMinPoint.Y, GlobalMinPoint.Z); Vertices[2] := TPoint3D.Create(GlobalMaxPoint.X, GlobalMaxPoint.Y, GlobalMinPoint.Z); Vertices[3] := TPoint3D.Create(GlobalMinPoint.X, GlobalMaxPoint.Y, GlobalMinPoint.Z); Vertices[4] := TPoint3D.Create(GlobalMinPoint.X, GlobalMinPoint.Y, GlobalMaxPoint.Z); Vertices[5] := TPoint3D.Create(GlobalMaxPoint.X, GlobalMinPoint.Y, GlobalMaxPoint.Z); Vertices[6] := TPoint3D.Create(GlobalMaxPoint.X, GlobalMaxPoint.Y, GlobalMaxPoint.Z); Vertices[7] := TPoint3D.Create(GlobalMinPoint.X, GlobalMaxPoint.Y, GlobalMaxPoint.Z); // Define the indices for the triangles to form the 12 edges of the bounding box SetLength(Indices, 36); Indices[0] := 0; Indices[1] := 1; Indices[2] := 2; Indices[3] := 2; Indices[4] := 3; Indices[5] := 0; Indices[6] := 4; Indices[7] := 5; Indices[8] := 6; Indices[9] := 6; Indices[10] := 7; Indices[11] := 4; Indices[12] := 0; Indices[13] := 1; Indices[14] := 5; Indices[15] := 5; Indices[16] := 4; Indices[17] := 0; Indices[18] := 2; Indices[19] := 3; Indices[20] := 7; Indices[21] := 7; Indices[22] := 6; Indices[23] := 2; Indices[24] := 0; Indices[25] := 3; Indices[26] := 7; Indices[27] := 7; Indices[28] := 4; Indices[29] := 0; Indices[30] := 1; Indices[31] := 2; Indices[32] := 6; Indices[33] := 6; Indices[34] := 5; Indices[35] := 1; // Set the vertex and index data to the ghost mesh GhostMesh.Data.VertexBuffer.Length := Length(Vertices); GhostMesh.Data.IndexBuffer.Length := Length(Indices); for I := 0 to High(Vertices) do GhostMesh.Data.VertexBuffer.Vertices[I] := Vertices[I]; for I := 0 to High(Indices) do GhostMesh.Data.IndexBuffer.Indices[I] := Indices[I]; GhostMesh.Visible := False; // Position and scale the ghost mesh GhostMesh.Position.Point := TPoint3D.Zero; GhostMesh.RotationAngle.Point := TPoint3D.Zero; GhostMesh.Scale.Point := TPoint3D.Create(1.0, 1.0, 1.0); Model3D.AddObject(GhostMesh); end; procedure TForm1.RenderCompositeMeshWithGhost; begin //CalculateGlobalBoundingBox; // Step 1: Calculate the bounding box //CreateGhostMesh; // Step 2: Create the ghost mesh if cbMultiColoredObjects.IsChecked then begin RenderCompositeMesh; end else begin RenderCompositeToOneMesh; end; end; procedure TForm1.RenderCompositeMesh; var Mesh: TMesh; Material: TColorMaterialSource; VertexCount, TriangleCount, I, J: Cardinal; Vertices: array of TPoint3D; Indices: array of Integer; MeshObj: TLib3MFMeshObject; ColorIndex: Integer; LocalPosition, ObjectMinPoint, ObjectMaxPoint, ObjectCenter, LargestCenter, Offset, GlobalPosition: TPoint3D; ObjectVolume, LargestVolume, ScaleFactor: Single; begin ColorIndex := 1; ClearModel3D; // Clear previous meshes LargestVolume := 0; LargestCenter := TPoint3D.Zero; // First Pass: Find the largest mesh object by volume and calculate the bounding box for each for I := 0 to ListBox1.Count - 1 do begin MeshObj := TLib3MFMeshObject(FObjectToBuildItemMap[ListBox1.ListItems[I].Tag].GetObjectResource); // Calculate the bounding box of the mesh object ObjectMinPoint := TPoint3D.Create(MaxSingle, MaxSingle, MaxSingle); ObjectMaxPoint := TPoint3D.Create(-MaxSingle, -MaxSingle, -MaxSingle); VertexCount := MeshObj.GetVertexCount; for J := 0 to VertexCount - 1 do begin LocalPosition.X := MeshObj.GetVertex(J).FCoordinates[0]; LocalPosition.Y := MeshObj.GetVertex(J).FCoordinates[1]; LocalPosition.Z := MeshObj.GetVertex(J).FCoordinates[2]; ObjectMinPoint.X := Min(ObjectMinPoint.X, LocalPosition.X); ObjectMinPoint.Y := Min(ObjectMinPoint.Y, LocalPosition.Y); ObjectMinPoint.Z := Min(ObjectMinPoint.Z, LocalPosition.Z); ObjectMaxPoint.X := Max(ObjectMaxPoint.X, LocalPosition.X); ObjectMaxPoint.Y := Max(ObjectMaxPoint.Y, LocalPosition.Y); ObjectMaxPoint.Z := Max(ObjectMaxPoint.Z, LocalPosition.Z); end; // Compute object volume as width * height * depth ObjectVolume := (ObjectMaxPoint.X - ObjectMinPoint.X) * (ObjectMaxPoint.Y - ObjectMinPoint.Y) * (ObjectMaxPoint.Z - ObjectMinPoint.Z); // Update the largest object volume and center if necessary if ObjectVolume > LargestVolume then begin LargestVolume := ObjectVolume; LargestCenter := (ObjectMinPoint + ObjectMaxPoint) * 0.5; // Find the center of the largest object end; end; // Second Pass: Create, scale, and position each mesh for I := 0 to ListBox1.Count - 1 do begin MeshObj := TLib3MFMeshObject(FObjectToBuildItemMap[ListBox1.ListItems[I].Tag].GetObjectResource); VertexCount := MeshObj.GetVertexCount; TriangleCount := MeshObj.GetTriangleCount; SetLength(Vertices, VertexCount); SetLength(Indices, TriangleCount * 3); // Create a new TMesh for this object Mesh := TMesh.Create(Self); Mesh.Parent := Model3D; // Parent the mesh to the TDummy // Extract vertices for the mesh object for J := 0 to VertexCount - 1 do begin LocalPosition.X := MeshObj.GetVertex(J).FCoordinates[0]; LocalPosition.Y := MeshObj.GetVertex(J).FCoordinates[1]; LocalPosition.Z := MeshObj.GetVertex(J).FCoordinates[2]; Vertices[J] := LocalPosition; end; // Set up indices for the mesh for J := 0 to TriangleCount - 1 do begin Indices[J * 3] := MeshObj.GetTriangle(J).FIndices[0]; Indices[J * 3 + 1] := MeshObj.GetTriangle(J).FIndices[1]; Indices[J * 3 + 2] := MeshObj.GetTriangle(J).FIndices[2]; end; // Assign vertices and indices to the mesh Mesh.Data.VertexBuffer.Length := VertexCount; Mesh.Data.IndexBuffer.Length := TriangleCount * 3; for J := 0 to High(Vertices) do Mesh.Data.VertexBuffer.Vertices[J] := Vertices[J]; for J := 0 to High(Indices) do Mesh.Data.IndexBuffer.Indices[J] := Indices[J]; // Calculate volume of the current mesh ObjectMinPoint := TPoint3D.Create(MaxSingle, MaxSingle, MaxSingle); ObjectMaxPoint := TPoint3D.Create(-MaxSingle, -MaxSingle, -MaxSingle); for J := 0 to VertexCount - 1 do begin ObjectMinPoint.X := Min(ObjectMinPoint.X, Vertices[J].X); ObjectMinPoint.Y := Min(ObjectMinPoint.Y, Vertices[J].Y); ObjectMinPoint.Z := Min(ObjectMinPoint.Z, Vertices[J].Z); ObjectMaxPoint.X := Max(ObjectMaxPoint.X, Vertices[J].X); ObjectMaxPoint.Y := Max(ObjectMaxPoint.Y, Vertices[J].Y); ObjectMaxPoint.Z := Max(ObjectMaxPoint.Z, Vertices[J].Z); end; ObjectVolume := (ObjectMaxPoint.X - ObjectMinPoint.X) * (ObjectMaxPoint.Y - ObjectMinPoint.Y) * (ObjectMaxPoint.Z - ObjectMinPoint.Z); // Calculate scale factor relative to the largest object using cubic root of volume ratio if LargestVolume > 0 then begin ScaleFactor := Power(ObjectVolume / LargestVolume, 1/3); Mesh.Scale.Point := TPoint3D.Create(ScaleFactor, ScaleFactor, ScaleFactor); end; // Calculate object center ObjectCenter := (ObjectMinPoint + ObjectMaxPoint) * 0.5; // Calculate the offset to position the object relative to the largest object's center Offset := (ObjectCenter - LargestCenter) * ScaleFactor; GlobalPosition := Mesh.LocalToAbsolute3D(Offset); Mesh.Position.Point := GlobalPosition; // Apply material and color Material := TColorMaterialSource.Create(Self); if ListBox1.ListItems[I].IsSelected then begin Material.Color := FColors[ColorIndex]; end else begin Material.Color := TAlphaColorRec.White; end; Mesh.MaterialSource := Material; // Cycle through colors for each mesh ColorIndex := (ColorIndex mod Length(FColors)) + 1; // Add the mesh to the TDummy Model3D.AddObject(Mesh); end; // Repaint the viewport to reflect the changes Viewport3D1.Repaint; end; { procedure TForm1.RenderCompositeMesh; var Mesh: TMesh; Material: TColorMaterialSource; VertexCount, TriangleCount, I, J: Cardinal; Vertices: array of TPoint3D; Indices: array of Integer; MeshObj: TLib3MFMeshObject; ColorIndex: Integer; ObjectMinPoint, ObjectMaxPoint, ObjectCenter, MeshPosition: TPoint3D; GlobalMinPoint, GlobalMaxPoint, GlobalCenter: TPoint3D; ScaleFactor: Single; LocalPosition: TPoint3D; begin ColorIndex := 1; ClearModel3D; // Clear previous meshes in TDummy // Initialize global bounding box for all objects GlobalMinPoint := TPoint3D.Create(MaxSingle, MaxSingle, MaxSingle); GlobalMaxPoint := TPoint3D.Create(-MaxSingle, -MaxSingle, -MaxSingle); // First, calculate global bounding box of all objects for I := 0 to ListBox1.Count - 1 do begin if ListBox1.ListItems[I].IsSelected then begin MeshObj := TLib3MFMeshObject(FObjectToBuildItemMap[ListBox1.ListItems[I].Tag].GetObjectResource); VertexCount := MeshObj.GetVertexCount; SetLength(Vertices, VertexCount); // Update the global bounding box based on each object for J := 0 to VertexCount - 1 do begin LocalPosition.X := MeshObj.GetVertex(J).FCoordinates[0]; LocalPosition.Y := MeshObj.GetVertex(J).FCoordinates[1]; LocalPosition.Z := MeshObj.GetVertex(J).FCoordinates[2]; // Update global bounding box GlobalMinPoint.X := Min(GlobalMinPoint.X, LocalPosition.X); GlobalMinPoint.Y := Min(GlobalMinPoint.Y, LocalPosition.Y); GlobalMinPoint.Z := Min(GlobalMinPoint.Z, LocalPosition.Z); GlobalMaxPoint.X := Max(GlobalMaxPoint.X, LocalPosition.X); GlobalMaxPoint.Y := Max(GlobalMaxPoint.Y, LocalPosition.Y); GlobalMaxPoint.Z := Max(GlobalMaxPoint.Z, LocalPosition.Z); end; end; end; // Calculate global center and size GlobalCenter := (GlobalMinPoint + GlobalMaxPoint) * 0.5; ScaleFactor := 1.0 / Max(GlobalMaxPoint.X - GlobalMinPoint.X, Max(GlobalMaxPoint.Y - GlobalMinPoint.Y, GlobalMaxPoint.Z - GlobalMinPoint.Z)); // Re-center the camera based on global bounding box Camera.Position.Point := Point3D(GlobalCenter.X, GlobalCenter.Y, GlobalMaxPoint.Z + 500); // Adjust the Z distance to keep it visible Camera.RotationAngle.Point := Point3D(0, 0, 0); // Ensure the camera is facing straight // Now render each object individually with correct translation and scaling for I := 0 to ListBox1.Count - 1 do begin if ListBox1.ListItems[I].IsSelected then begin MeshObj := TLib3MFMeshObject(FObjectToBuildItemMap[ListBox1.ListItems[I].Tag].GetObjectResource); VertexCount := MeshObj.GetVertexCount; TriangleCount := MeshObj.GetTriangleCount; SetLength(Vertices, VertexCount); SetLength(Indices, TriangleCount * 3); // Create a new TMesh for this object Mesh := TMesh.Create(Self); Mesh.Parent := Model3D; // Calculate local bounding box for this object ObjectMinPoint := TPoint3D.Create(MaxSingle, MaxSingle, MaxSingle); ObjectMaxPoint := TPoint3D.Create(-MaxSingle, -MaxSingle, -MaxSingle); for J := 0 to VertexCount - 1 do begin LocalPosition.X := MeshObj.GetVertex(J).FCoordinates[0]; LocalPosition.Y := MeshObj.GetVertex(J).FCoordinates[1]; LocalPosition.Z := MeshObj.GetVertex(J).FCoordinates[2]; Vertices[J] := (LocalPosition - GlobalCenter) * ScaleFactor; // Scale and translate vertices // Update local bounding box ObjectMinPoint.X := Min(ObjectMinPoint.X, LocalPosition.X); ObjectMinPoint.Y := Min(ObjectMinPoint.Y, LocalPosition.Y); ObjectMinPoint.Z := Min(ObjectMinPoint.Z, LocalPosition.Z); ObjectMaxPoint.X := Max(ObjectMaxPoint.X, LocalPosition.X); ObjectMaxPoint.Y := Max(ObjectMaxPoint.Y, LocalPosition.Y); ObjectMaxPoint.Z := Max(ObjectMaxPoint.Z, LocalPosition.Z); end; // Calculate center for this mesh object and adjust position ObjectCenter := (ObjectMinPoint + ObjectMaxPoint) * 0.5; Mesh.Position.Point := (ObjectCenter - GlobalCenter) * ScaleFactor; // Set up indices for the mesh for J := 0 to TriangleCount - 1 do begin Indices[J * 3] := MeshObj.GetTriangle(J).FIndices[0]; Indices[J * 3 + 1] := MeshObj.GetTriangle(J).FIndices[1]; Indices[J * 3 + 2] := MeshObj.GetTriangle(J).FIndices[2]; end; // Assign vertices and indices to the mesh Mesh.Data.VertexBuffer.Length := VertexCount; Mesh.Data.IndexBuffer.Length := TriangleCount * 3; for J := 0 to High(Vertices) do Mesh.Data.VertexBuffer.Vertices[J] := Vertices[J]; for J := 0 to High(Indices) do Mesh.Data.IndexBuffer.Indices[J] := Indices[J]; // Apply material and color Material := TColorMaterialSource.Create(Self); Material.Color := FColors[ColorIndex]; Mesh.MaterialSource := Material; // Cycle through colors for each mesh ColorIndex := (ColorIndex mod Length(FColors)) + 1; // Add the mesh to the TDummy Model3D.AddObject(Mesh); end; end; // Repaint the viewport to reflect the changes Viewport3D1.Repaint; end; } procedure TForm1.RenderCompositeToOneMesh; var CombinedMesh: TMesh; Material: TColorMaterialSource; VertexCount, TriangleCount, I, J, K, GlobalVertexIndex: Cardinal; Vertices: array of TPoint3D; Indices: array of Integer; MeshObj: TLib3MFMeshObject; CombinedVertices: array of TPoint3D; CombinedIndices: array of Integer; TotalVertexCount, TotalTriangleCount: Cardinal; begin TotalVertexCount := 0; TotalTriangleCount := 0; // First pass: calculate total vertex and triangle count for I := 0 to ListBox1.Count - 1 do begin if ListBox1.ListItems[I].IsSelected then begin MeshObj := TLib3MFMeshObject(FObjectToBuildItemMap[ListBox1.ListItems[I].Tag].GetObjectResource); TotalVertexCount := TotalVertexCount + MeshObj.GetVertexCount; TotalTriangleCount := TotalTriangleCount + MeshObj.GetTriangleCount; end; end; // Initialize arrays for combined vertices and indices SetLength(CombinedVertices, TotalVertexCount); SetLength(CombinedIndices, TotalTriangleCount * 3); GlobalVertexIndex := 0; // To track the global vertex index as we combine // Second pass: copy vertices and indices into the combined arrays for I := 0 to ListBox1.Count - 1 do begin if ListBox1.ListItems[I].IsSelected then begin MeshObj := TLib3MFMeshObject(FObjectToBuildItemMap[ListBox1.ListItems[I].Tag].GetObjectResource); VertexCount := MeshObj.GetVertexCount; TriangleCount := MeshObj.GetTriangleCount; // Get the vertices from the current object SetLength(Vertices, VertexCount); for J := 0 to VertexCount - 1 do begin Vertices[J].X := MeshObj.GetVertex(J).FCoordinates[0]; Vertices[J].Y := MeshObj.GetVertex(J).FCoordinates[1]; Vertices[J].Z := MeshObj.GetVertex(J).FCoordinates[2]; // Store the vertex into the combined array CombinedVertices[GlobalVertexIndex + J] := Vertices[J]; end; // Get the indices from the current object and update with global vertex index SetLength(Indices, TriangleCount * 3); for J := 0 to TriangleCount - 1 do begin Indices[J * 3] := MeshObj.GetTriangle(J).FIndices[0] + GlobalVertexIndex; Indices[J * 3 + 1] := MeshObj.GetTriangle(J).FIndices[1] + GlobalVertexIndex; Indices[J * 3 + 2] := MeshObj.GetTriangle(J).FIndices[2] + GlobalVertexIndex; end; // Copy the indices into the combined array for K := 0 to High(Indices) do CombinedIndices[(GlobalVertexIndex div VertexCount) * (TriangleCount * 3) + K] := Indices[K]; // Update the global vertex index for the next object GlobalVertexIndex := GlobalVertexIndex + VertexCount; end; end; // Create the combined mesh and add it to the viewport CombinedMesh := TMesh.Create(Self); CombinedMesh.Parent := Model3D; CombinedMesh.Data.VertexBuffer.Length := TotalVertexCount; CombinedMesh.Data.IndexBuffer.Length := TotalTriangleCount * 3; // Copy vertices and indices into the mesh for I := 0 to High(CombinedVertices) do CombinedMesh.Data.VertexBuffer.Vertices[I] := CombinedVertices[I]; for I := 0 to High(CombinedIndices) do CombinedMesh.Data.IndexBuffer.Indices[I] := CombinedIndices[I]; // Apply material and color to the combined mesh Material := TColorMaterialSource.Create(Self); Material.Color := TAlphaColors.Skyblue; // Set to a default color for now CombinedMesh.MaterialSource := Material; // Add the mesh to the scene Model3D.AddObject(CombinedMesh); end; end. Test_lib3mf_app.zip

by the way, I am having a problem trying to add each mesh and having the meshes not sit on top of each other. I attached the test project, try loading a 3MF file with multiple objects you will see what I mean. This is just a test app. I was hoping to share this so other can use it, but its worthless if I cannot specify a different color per object (mesh) in one TModel3D instance. Unit_Lib3MF.pas Test_lib3mf_app.zip if I add all vertices and triangles into one mesh and add then the positions and scale of each object (all merged into one mesh are perfect, but then I cannot apply different colors.

I actually fixed a lot of that unit already... thanks!

revised unit. Unit_Lib3MF.zip

Well I got the Lib3mf unit (a delphi specific one I created to work. Delphi binding · Issue #385 · 3MFConsortium/lib3mf (github.com) They may include it in their repo. I discovered they had typos in their version too. Delphi seems to be overly neglected by most SDK developers.

actually I am testing a unit I converted from FPC now. (see attached) Unit_Lib3MF.zip

Hi, Sorry for the delay. I decided to try and use the Lib3MF SDK for the consortium but the existing Pascal unit did not work even after adding in type QWork: Uint64 (see attached (Unit_Lib3MF.pas). So I started on my own one (renamed with _custom) (also attached).. but I have a feeling that I should be really using the original Unit_Lib3MF.pas file but not sure what I am doing wrong. this is where I got the unit: GitHub - 3MFConsortium/lib3mf: lib3mf is an implementation of the 3D Manufacturing Format file standard This actually renders the 3D model but I am not able to get the metadata just as Object name from the file using their lib. Unit_Lib3MF.pas GLCADViewer.dpr GLCADViewer.dproj ProjectGroup1.groupproj Unit_Lib3MF_custom.pas Unit1.fmx Unit1.pas Unit1.Windows.fmx

I have a VCL app and I am able to draw cross sections at any specific Z height using SDL Components (RChart) just fine, but I need to view solid objects. Some of the methods here are resused from that app.

Hi, I am supporting a large "legacy" application and it uses a lot of global variables especially Array of records that are used by different methods. Recently I moved all the methods into a TThread class and implemented properties with "getters" and "setters" to make certain information available to the Main Form thread. However, there is still the problem of global variables that I need to address in a clean way. These global variables are NOT accessed outside the Thread class right now using the global variables as class members but they are still technically global. . How can I get access to these global variables without them being global. The application just works as it, but I would like to start refactoring the application. Is there basic hierarchy using classes and sub classes I should consider? Thanks.

Hi, I am trying to call a Python (with Open3D) app UI from a Delphi form (11.3), using a Tthread .. it seems to call the method just fine but I do not see the window. When not using it in a thread the window comes up just fine... however I want to be able to terminate the process at will (from within the Delphi Form). What do I need to do in order to make the python app be visible? (Note: I am also using SDL Components for the input fields that handle numbers.) unit Unit1; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, System.Threading, System.Math, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, PythonEngine, PythonVersions, ShellAPI, SDL_NumIO, SDL_stringl, Vcl.ExtCtrls, LJUDDelphi, Vcl.WinXCtrls, TlHelp32; const PYHARV_HOME = 'C:\Users\printeruser\Desktop\3DScan_Work\photoneo-python-examples\GigEV\harvesters'; VENV_PATH = PYHARV_HOME + '\.venv'; VENV_PYTHON_EXE = VENV_PATH + '\Scripts\python.exe'; PHOTONEO_GENICAM_PATH = PYHARV_HOME + '\advanced\photoneo_genicam'; LJ_TIMER_INTERVAL = 100; SCAN_MODE_MANUAL = 0; SCAN_MODE_TIMER = 1; SCAN_MODE_RELAY = 2; // THREAD EVENT_ID_NUMS: CloseScanResultEventID = 0; RunScanGetResultEventID = 1; type TPythonScriptThread = class(TThread) private FPythonEngine: TPythonEngine; FPythonInputOutput: TPythonInputOutput; FPyVersion: TPythonVersion; FScript: TStringList; FDevSerialNumber: String; FHorizontalRotation: Double; FVerticalRotation: Double; FScanZoomFactor: Double; FScriptRunning: Boolean; FPythonOpen3DPID: DWORD; FCloseScanResultEvent: THandle; FRunScanGetResultEvent: THandle; procedure SetEnvironmentVariables; procedure ConfigurePythonEnvironment; procedure Set_DevSerialNumber(Value: String); procedure Set_HorizontalRotation(Value: Double); procedure Set_VerticalRotation(Value: Double); procedure Set_ScanZoomFactor(Value: Double); // Thread Event triggered methods: function _ExecuteStopPythonScript: Boolean; function _ExecuteRunPythonScript: Boolean; // Private Thread member methods that are called by UI invoking a thread-safe event method: function mFindPythonOpen3DSubprocess: DWORD; protected procedure Execute; override; public constructor Create; destructor Destroy; override; // Read Only Property: property ScriptRunning: Boolean read FScriptRunning; // The publicly accessible methods: function StopPythonScript: Boolean; function RunPythonScript(DevID: String; HRot: Double = 0; VRot: Double = 0; Zoom: Double = 1): Boolean; end; TForm1 = class(TForm) Panel1: TPanel; nioVerticalRotation: TNumIO2; PythonEngine1: TPythonEngine; RadioGroup1: TRadioGroup; editDevSerialNumber: TEdit; nioHorizontalRotation: TNumIO2; nioZoomFactor: TNumIO2; btnScanNow: TButton; lblDeviceSerialNum_Label: TLabel; Timer1: TTimer; nioTimerInterval: TNumIO2; lblLabJackStatus: TLabel; uiRelay_0_Voltage: TLabel; uiRelay_1_Voltage: TLabel; procedure btnScanNowClick(Sender: TObject); procedure FormActivate(Sender: TObject); procedure FormCreate(Sender: TObject); procedure RadioGroup1Click(Sender: TObject); procedure nioTimerIntervalChange(Sender: TObject); procedure Timer1Timer(Sender: TObject); procedure nioZoomFactorChange(Sender: TObject); procedure Panel1DblClick(Sender: TObject); private { Private declarations } PythonScriptThread: TPythonScriptThread; // LabJack Vars for the class: FLabJackConnected: Boolean; FRelayMonitorLatch: Boolean; FLJRelay_0_ON, FLJRelay_1_ON: Boolean; FLJErrorcode: LJ_ERROR; // LabJack Error Code FLJHandle: LJ_HANDLE; // Handle for LabJack device FLJVoltage_0, FLJVoltage_1 : double; // Timer & TDateTime Trigger: LastTriggerTime: TDateTime; // The rest of th eclass vars: FTimerTriggeredScan: Boolean; FRelayTriggeredScan: Boolean; FTimeTrigScanInterval: Integer; procedure RequestElevationIfNeeded; function IsUserAnAdmin: Boolean; // Trigger procedures: procedure TriggerByUserToScan; procedure TriggerByTimerToScan; procedure TriggerByRelayToScan; // LabJack: procedure Initialize_U3HV; procedure ErrorHandler(LJErrorcode: LJ_ERROR; LJIteration: longint); procedure SetDACVoltage(Channel: Integer; TheSetVoltage: Double); procedure GetAnalogVoltage(Channel: Integer; var TheVoltage: Double); public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} // The Rest of the Code: function TForm1.IsUserAnAdmin: Boolean; var hToken: THandle; Elevation: TOKEN_ELEVATION; cbSize: DWORD; begin Result := False; if OpenProcessToken(GetCurrentProcess, TOKEN_QUERY, hToken) then try cbSize := SizeOf(TOKEN_ELEVATION); if GetTokenInformation(hToken, TokenElevation, @Elevation, cbSize, cbSize) then Result := Elevation.TokenIsElevated <> 0; finally CloseHandle(hToken); end; end; procedure TForm1.RequestElevationIfNeeded; var sei: TShellExecuteInfo; exeName: string; begin if not IsUserAnAdmin then begin ZeroMemory(@sei, SizeOf(sei)); sei.cbSize := SizeOf(sei); sei.Wnd := Handle; // Parent window sei.fMask := SEE_MASK_FLAG_DDEWAIT or SEE_MASK_FLAG_NO_UI; sei.lpVerb := 'runas'; // Request elevation exeName := ParamStr(0); sei.lpFile := PChar(exeName); sei.lpParameters := PChar(''); // No parameters sei.nShow := SW_SHOWNORMAL; if not ShellExecuteEx(@sei) then begin ShowMessage('Failed to create elevated process. Error code: ' + IntToStr(GetLastError)); Application.Terminate; // Terminate the unelevated instance end else Application.Terminate; // Terminate the unelevated instance end; end; // LabJack: procedure TForm1.Initialize_U3HV; var numChannels, quickSample, longSettling: longint; LabJack_Check : integer; begin // This performs the standard initialization of the U3-HV system // Some initial values LabJack_Check := 0; FLJHandle := 0; numChannels := 16; //Number of AIN channels, 0-16. quickSample := 0; //Set to TRUE for quick AIN sampling. longSettling := 1; //Set to TRUE for extra AIN settling time. // Now let's open the labjack FLJErrorcode := OpenLabJack(LJ_dtU3, LJ_ctUSB, '1', 1, FLJHandle); ErrorHandler(FLJErrorcode, 0); if FLJErrorcode > 0 then INC(LabJack_Check); // Now let's reset the configuration FLJErrorcode := ePut(FLJHandle, LJ_ioPIN_CONFIGURATION_RESET, 0, 0, 0); ErrorHandler(FLJErrorcode, 0); if FLJErrorcode > 0 then INC(LabJack_Check); //Configure quickSample. FLJErrorcode := ePut(FLJHandle, LJ_ioPUT_CONFIG, LJ_chAIN_RESOLUTION, quickSample, 0); ErrorHandler(FLJErrorcode, 0); if FLJErrorcode > 0 then INC(LabJack_Check); //Configure longSettling. FLJErrorcode := ePut(FLJHandle, LJ_ioPUT_CONFIG, LJ_chAIN_SETTLING_TIME, longSettling, 0); ErrorHandler(FLJErrorcode, 0); if FLJErrorcode > 0 then INC(LabJack_Check); //Configure the lines as analog. FLJErrorcode := ePut(FLJHandle, LJ_ioPUT_ANALOG_ENABLE_PORT, 0, (IntPower(2, numChannels) - 1), numChannels); ErrorHandler(FLJErrorcode, 0); if FLJErrorcode > 0 then INC(LabJack_Check); if LabJack_Check = 0 then begin lblLabJackStatus.Font.Color := clLime; lblLabJackStatus.Caption := 'LabJack Connected'; end else begin lblLabJackStatus.Font.Color := clRed; lblLabJackStatus.Caption := 'LabJack Disonnected!'; end; // Let's set the DAC0 and DAC1 to 0.0 Volts at boot-up SetDACVoltage(0, 0.0); SetDACVoltage(1, 0.0); end; procedure TForm1.ErrorHandler(LJErrorcode: LJ_ERROR; LJIteration: longint); var err: array[0..254] of AnsiChar; begin if LJErrorcode <> LJE_NOERROR then begin ErrorToString(LJErrorcode, @err); //StatusUpdate('Error number = ' + IntToStr(lngErrorcode)+ ' Error string = ' + string(err) + ' Iteration = ' + IntToStr(LJIteration)); FLabJackConnected := False; // there was an error! end else begin // LabJack Operation is OK FLabJackConnected := True; end; end; procedure TForm1.SetDACVoltage(Channel: Integer; TheSetVoltage: Double); begin if FLabJackConnected then begin // This uses the global lngHandle to refer to the U3-HV if ABS(TheSetVoltage) < 10 then ePUT(FLJHandle, LJ_ioPUT_DAC, Channel, TheSetVoltage, 0) else begin // Add an error statement if the DAC is set overrange...! lblLabJackStatus.Font.Color := clRed; lblLabJackStatus.Caption := 'LabJack Connected & Overrange!'; end; end else begin lblLabJackStatus.Font.Color := clRed; lblLabJackStatus.Caption := 'LabJack Disonnected!'; FLabJackConnected := False; ShowMessage('Problem connecting to LabJack! Check Power and USB connection.'); end; end; procedure TForm1.GetAnalogVoltage(Channel: Integer; var TheVoltage: Double); begin // This uses the global lngHandle to read a voltage from the Analog Channels // // The "LJ_ioGET_AIN" is the integer that determines the operation. Refer to // LJUDDelphi.pas for details if FLabJackConnected then begin eGET(FLJHandle, LJ_ioGET_AIN, Channel, TheVoltage, 0); end else begin lblLabJackStatus.Font.Color := clRed; lblLabJackStatus.Caption := 'LabJack Disonnected!'; FLabJackConnected := False; ShowMessage('Problem connecting to LabJack! Check Power and USB connection.'); end; // Update the Text readings if Channel = 0 then uiRelay_0_Voltage.Caption := 'Relay 0 Voltage = '+ Strff(FLJVoltage_0, 4, 3)+' V'; if Channel = 1 then uiRelay_1_Voltage.Caption := 'Relay 1 Voltage = '+ Strff(FLJVoltage_1, 4, 3)+' V'; end; // Python script thread implementation constructor TPythonScriptThread.Create; begin inherited Create(False); FPythonEngine := TPythonEngine.Create(Form1); FPythonInputOutput := TPythonInputOutput.Create(Form1); if PythonVersionFromPath(PYHARV_HOME + '\.venv\', FPyVersion) then begin // Create the Events: FCloseScanResultEvent := CreateEvent(nil, True, False, nil); FRunScanGetResultEvent := CreateEvent(nil, True, False, nil); FPythonEngine.VenvPythonExe := VENV_PYTHON_EXE; FPythonEngine.SetPythonHome(PYHARV_HOME + '\.venv\'); FPyVersion.AssignTo(FPythonEngine); FPythonEngine.LoadDll; // ShowMessage('Python DLL loaded successfully. ' + PythonEngine1.DllName); ConfigurePythonEnvironment; end end; destructor TPythonScriptThread.Destroy; begin FScript.Free; inherited; end; // The publicly accessible methods: function TPythonScriptThread.StopPythonScript: Boolean; begin //CloseScanResultEventID SetEvent(FCloseScanResultEvent); end; function TPythonScriptThread.RunPythonScript(DevID: String; HRot: Double = 0; VRot: Double = 0; Zoom: Double = 1): Boolean; begin Result := False; // Set the Params: FDevSerialNumber := DevID; FHorizontalRotation := HRot; FVerticalRotation := VRot; FScanZoomFactor:= (100 / Zoom); //RunScanGetResultEventID if(FDevSerialNumber <> '') AND (Not FHorizontalRotation.IsNan) AND (Not FVerticalRotation.IsNan) AND (Not FScanZoomFactor.IsNan) then begin SetEvent(FRunScanGetResultEvent); Result := True; end; end; procedure TPythonScriptThread.Execute; var EventHandles: array[0..1] of THandle; EventIndex: DWORD; begin EventHandles[CloseScanResultEventID] := FCloseScanResultEvent; EventHandles[RunScanGetResultEventID] := FRunScanGetResultEvent; while(Not Terminated) do begin EventIndex := WaitForMultipleObjects(2, @EventHandles, False, 60); case EventIndex of WAIT_OBJECT_0 + CloseScanResultEventID: // FJogStopEvent signaled begin // Handle FCloseScanResultEvent signaled case _ExecuteStopPythonScript; ResetEvent(FCloseScanResultEvent); end; WAIT_OBJECT_0 + RunScanGetResultEventID: // FJogStopEvent signaled begin // Handle FRunScanGetResultEvent signaled case _ExecuteRunPythonScript; ResetEvent(FRunScanGetResultEvent); end; end; end; CloseHandle(FCloseScanResultEvent); CloseHandle(FRunScanGetResultEvent); end; // Python uses Open3D Library modules: function TPythonScriptThread.mFindPythonOpen3DSubprocess: DWORD; var Snapshot: THandle; ProcessEntry: TProcessEntry32; begin Result := 0; Snapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0); if Snapshot <> INVALID_HANDLE_VALUE then try ProcessEntry.dwSize := SizeOf(ProcessEntry); if Process32First(Snapshot, ProcessEntry) then begin repeat if Pos('Open3D', ProcessEntry.szExeFile) > 0 then begin Result := ProcessEntry.th32ProcessID; Break; end; until Not Process32Next(Snapshot, ProcessEntry); end; finally CloseHandle(Snapshot); end; end; function TPythonScriptThread._ExecuteStopPythonScript: Boolean; begin end; // The Actual Python execution: function TPythonScriptThread._ExecuteRunPythonScript: Boolean; var Script: TStringList; ScriptFilePath, HorizontalRotation, VerticalRotation, ZoomFactor: string; begin // Prevent Double Clicking... since the python script needs to complete first before re-running: FScriptRunning := True; Script := TStringList.Create; try // Retrieve the values from the form inputs ScriptFilePath := PYHARV_HOME + '\advanced\GridLoigic_pointcloud_with_normals_and_texture.py'; if FileExists(ScriptFilePath) then begin Script.LoadFromFile(ScriptFilePath); HorizontalRotation := FHorizontalRotation.ToString; VerticalRotation := FVerticalRotation.ToString; ZoomFactor := FScanZoomFactor.ToString; // Insert the sys.path and debug statements Script.Insert(2, 'sys.path.append(r"' + PYHARV_HOME + '\advanced")'); Script.Insert(3, 'print("Starting script execution")'); Script.Insert(4, 'try:'); Script.Insert(5, ' import photoneo_genicam'); Script.Insert(6, ' print("photoneo_genicam imported successfully")'); Script.Insert(7, 'except ImportError as e:'); Script.Insert(8, ' print("Failed to import photoneo_genicam:", str(e))'); Script.Insert(9, ' raise'); // Add the parameters as comments for reference Script.Insert(10, '# Parameters passed from Delphi'); Script.Insert(11, 'device_id = "' + FDevSerialNumber + '"'); Script.Insert(12, 'horizontal_angle = ' + HorizontalRotation); Script.Insert(13, 'vertical_angle = ' + VerticalRotation); Script.Insert(14, 'zoom_factor = ' + ZoomFactor); // Replace main function call with parameters //Script.Add('main(device_id, horizontal_angle, vertical_angle, zoom_factor)'); try FPythonEngine.ExecStrings(Script); //ShowMessage('Script executed successfully.'); except on E: EPySystemExit do begin // Handle the SystemExit exception ShowMessage('Script terminated by SystemExit.'); end; on E: EPythonError do begin ShowMessage('Python Error: ' + E.Message); end; on E: Exception do begin ShowMessage('Error: ' + E.Message); end; end; end else begin ShowMessage('Script file does not exist: ' + ScriptFilePath); end; finally Script.Free; end; end; procedure TPythonScriptThread.SetEnvironmentVariables; begin SetEnvironmentVariable('VIRTUAL_ENV', PChar(VENV_PATH)); SetEnvironmentVariable('PYTHONHOME', nil); // Unset PYTHONHOME SetEnvironmentVariable('PATH', PChar(VENV_PATH + '\Scripts;' + GetEnvironmentVariable('PATH'))); end; procedure TPythonScriptThread.ConfigurePythonEnvironment; begin MaskFPUExceptions(True); // Ensure the virtual environment paths are correctly set SetEnvironmentVariables; // Configure Python environment FPythonEngine.ExecString(Format( 'import sys; import os; ' + 'sys.path.append(r"%s"); ' + 'sys.path.append(r"%s\Lib\site-packages"); ' + 'sys.path.append(r"%s"); ' + // Add path to photoneo_genicam 'os.environ["VIRTUAL_ENV"] = r"%s"; ' + 'os.environ["PATH"] = r"%s\Scripts;" + os.environ["PATH"]; ' + 'print("sys.path:", sys.path); ' + 'print("VIRTUAL_ENV:", os.environ["VIRTUAL_ENV"]); ' + 'print("PATH:", os.environ["PATH"])', [VENV_PATH, VENV_PATH, PHOTONEO_GENICAM_PATH, VENV_PATH, VENV_PATH] )); end; procedure TPythonScriptThread.Set_DevSerialNumber(Value: String); begin FDevSerialNumber := Value; end; procedure TPythonScriptThread.Set_HorizontalRotation(Value: Double); begin FHorizontalRotation := Value; end; procedure TPythonScriptThread.Set_VerticalRotation(Value: Double); begin FVerticalRotation := Value; end; procedure TPythonScriptThread.Set_ScanZoomFactor(Value: Double); begin FScanZoomFactor := Value; end; // Form stuff: procedure TForm1.nioTimerIntervalChange(Sender: TObject); begin try if(Not nioTimerInterval.Value.IsNan) then FTimeTrigScanInterval := nioTimerInterval.IntegerValue; except FTimeTrigScanInterval := 10; nioTimerInterval.Value := FTimeTrigScanInterval; end; end; procedure TForm1.nioZoomFactorChange(Sender: TObject); begin try if(nioZoomFactor.Value.IsNan) AND (Assigned(PythonScriptThread)) then nioTimerInterval.Value := 200; except end; end; procedure TForm1.Panel1DblClick(Sender: TObject); begin // Reset fields: if(GetKeyState(VK_SHIFT) < 0) then begin nioHorizontalRotation.Value := 360; nioVerticalRotation.Value := 180; nioZoomFactor.Value := 200; end; end; procedure TForm1.FormCreate(Sender: TObject); begin RequestElevationIfNeeded; FTimerTriggeredScan := False; FRelayTriggeredScan := False; Timer1.Interval := LJ_TIMER_INTERVAL; end; procedure TForm1.FormActivate(Sender: TObject); begin if(Not DirectoryExists(PYHARV_HOME)) then begin ShowMessage(PYHARV_HOME + ' doesn''t exist!'); end else begin // Load the Python DLL using the virtual environment's Python executable PythonScriptThread := TPythonScriptThread.Create; Sleep(10); Application.ProcessMessages; Sleep(10); Application.ProcessMessages; if(Assigned(PythonScriptThread)) then begin try FTimeTrigScanInterval := nioTimerInterval.IntegerValue; except on E: Exception do ShowMessage('Failed to load Python DLL: ' + E.Message); end; FTimeTrigScanInterval := nioTimerInterval.IntegerValue; LastTriggerTime := Now; // try to connect to Lab Jack: Initialize_U3HV; // Now Check if its connected: if(Not FLabJackconnected) then begin lblLabJackStatus.Font.Color := clRed; lblLabJackStatus.Caption := 'LabJack Disonnected!'; end; end; end; end; procedure TForm1.RadioGroup1Click(Sender: TObject); begin case RadioGroup1.ItemIndex of SCAN_MODE_MANUAL: begin FTimerTriggeredScan := False; FRelayTriggeredScan := False; btnScanNow.Enabled := (Not FTimerTriggeredScan) AND (Not FRelayTriggeredScan); nioTimerInterval.Enabled := FTimerTriggeredScan; end; SCAN_MODE_TIMER: begin FTimerTriggeredScan := True; FRelayTriggeredScan := False; btnScanNow.Enabled := (Not FTimerTriggeredScan) AND (Not FRelayTriggeredScan); nioTimerInterval.Enabled := FTimerTriggeredScan; end; SCAN_MODE_RELAY: begin FTimerTriggeredScan := False; FRelayTriggeredScan := True; btnScanNow.Enabled := (Not FTimerTriggeredScan) AND (Not FRelayTriggeredScan); nioTimerInterval.Enabled := FTimerTriggeredScan; end; else begin RadioGroup1.ItemIndex := 0; btnScanNow.Enabled := True; nioTimerInterval.Enabled := False; end; end; end; procedure TForm1.btnScanNowClick(Sender: TObject); begin btnScanNow.Enabled := False; if PythonScriptThread.ScriptRunning then begin ShowMessage('Scan is still busy.'); Exit; end; Application.ProcessMessages; if(Tbutton(Sender).Name = 'btnScanNow') then begin TriggerByUserToScan; end; btnScanNow.Enabled := (Not PythonScriptThread.ScriptRunning); end; procedure TForm1.Timer1Timer(Sender: TObject); begin if(FTimerTriggeredScan OR FRelayTriggeredScan) then begin Timer1.Enabled := False; //Check for Triggers: if(Not FTimerTriggeredScan) then TriggerByRelayToScan; if(Not FRelayTriggeredScan) then TriggerByTimerToScan; Timer1.Enabled := True; end; end; procedure TForm1.TriggerByUserToScan; begin if((Not FTimerTriggeredScan) AND (Not FRelayTriggeredScan)) then begin if(Not PythonScriptThread.RunPythonScript( editDevSerialNumber.Text, nioHorizontalRotation.Value, nioVerticalRotation.Value, nioZoomFactor.Value )) then begin //Error: ShowMessage('Could not call process!'); end; end; end; procedure TForm1.TriggerByTimerToScan; var myCurrentTime: TDateTime; myTriggerTimeElapsed: Double; begin myCurrentTime := Now; // Calculate time elapsed since the last execution of UpdateMassChart myTriggerTimeElapsed := (myCurrentTime - LastTriggerTime) * 86400; // Convert to seconds if(myTriggerTimeElapsed >= FTimeTrigScanInterval) then begin PythonScriptThread.StopPythonScript; LastTriggerTime := myCurrentTime; PythonScriptThread.RunPythonScript( editDevSerialNumber.Text, nioHorizontalRotation.Value, nioVerticalRotation.Value, nioZoomFactor.Value ); end; end; procedure TForm1.TriggerByRelayToScan; var ActiveFileName : String; myActiveFileCheckSum: String; begin // Enable the Print Monitor Button if(FLabJackConnected AND FRelayTriggeredScan AND (Not FTimerTriggeredScan)) then begin // After the first read.....The Monitorlatch is FALSE....it should only be true // again if BOTH voltages are less than 2.0V!!!! // Just get the voltage readings from the Labjack GetAnalogVoltage(0, FLJVoltage_0); GetAnalogVoltage(1, FLJVoltage_1); if ((FLJVoltage_0 < 2.0) and (FLJVoltage_1 < 2.0)) then FRelayMonitorLatch := True; // Update the Relay Lights Status if(FLJVoltage_0 > 2.0) then begin // Use 2V as the trigger voltage level for now //uiRelay_0_Light.Fill.Color := TAlphaColorRec.Lime; FLJRelay_0_ON := True; end else begin //uiRelay_0_Light.Fill.Color := TAlphaColorRec.Crimson; FLJRelay_0_ON := False; end; if(FLJVoltage_1 > 2.0) then begin // Use 2V as the trigger voltage level for now //uiRelay_1_Light.Fill.Color := TAlphaColorRec.Lime; FLJRelay_1_ON := True; end else begin //uiRelay_1_Light.Fill.Color := TAlphaColorRec.Crimson; FLJRelay_1_ON := False; end; // Now let's figure out if we need to take a photo // // The camera will be "inactive" most of the time // Make it active first.... // // then wait for Relay_1 to turn ON // // Take the photo and turn Relay 1 OFF and Turn Relay 0 OFF // if FLJRelay_0_ON then begin // This means the camera is "active" and updating images // // Now let's see if Relay 1 is ON if FLJRelay_1_ON then begin // Here you should execute scan! // if FRelayMonitorLatch then begin PythonScriptThread.StopPythonScript; // Now let's write the file! PythonScriptThread.RunPythonScript( editDevSerialNumber.Text, nioHorizontalRotation.Value, nioVerticalRotation.Value, nioZoomFactor.Value ); end; // Now set the MonitorLatch to False! FRelayMonitorLatch := False; end; end; end; end; end. Here is the python script: #!/usr/bin/env python import sys from pathlib import Path import open3d as o3d import numpy as np from genicam.genapi import NodeMap from harvesters.core import Component2DImage, Harvester from photoneo_genicam.components import enable_components, enabled_components from photoneo_genicam.default_gentl_producer import producer_path from photoneo_genicam.features import enable_software_trigger from photoneo_genicam.pointcloud import create_3d_vector, map_texture from photoneo_genicam.user_set import load_default_user_set from photoneo_genicam.visualizer import render_static def rotate_point_cloud(point_cloud, horizontal_angle_degrees, vertical_angle_degrees): # Convert angles from degrees to radians horizontal_angle_radians = np.deg2rad(horizontal_angle_degrees) vertical_angle_radians = np.deg2rad(vertical_angle_degrees) # Define the rotation matrix for horizontal rotation (around Y-axis) horizontal_rotation_matrix = np.array([ [np.cos(horizontal_angle_radians), 0, np.sin(horizontal_angle_radians)], [0, 1, 0], [-np.sin(horizontal_angle_radians), 0, np.cos(horizontal_angle_radians)] ]) # Define the rotation matrix for vertical rotation (around X-axis) vertical_rotation_matrix = np.array([ [1, 0, 0], [0, np.cos(vertical_angle_radians), -np.sin(vertical_angle_radians)], [0, np.sin(vertical_angle_radians), np.cos(vertical_angle_radians)] ]) # Apply the rotations to the point cloud point_cloud.rotate(horizontal_rotation_matrix, center=(0, 0, 0)) point_cloud.rotate(vertical_rotation_matrix, center=(0, 0, 0)) def render_with_zoom(point_cloud, zoom_factor): vis = o3d.visualization.Visualizer() vis.create_window() vis.add_geometry(point_cloud) # Get the view control and set the zoom level view_control = vis.get_view_control() view_control.set_zoom(zoom_factor) vis.run() vis.destroy_window() def main(device_sn: str, horizontal_angle: float, vertical_angle: float, zoom_factor: float): with Harvester() as h: h.add_file(str(producer_path), check_existence=True, check_validity=True) h.update() with h.create({"serial_number": device_sn}) as ia: features: NodeMap = ia.remote_device.node_map load_default_user_set(features) enable_software_trigger(features) features.Scan3dOutputMode.value = "CalibratedABC_Grid" enable_components(features, ["Intensity", "Range", "Normal"]) ia.start() features.TriggerSoftware.execute() with ia.fetch(timeout=10) as buffer: components = dict(zip(enabled_components(features), buffer.payload.components)) intensity_component: Component2DImage = components["Intensity"] point_cloud_raw: Component2DImage = components["Range"] normal_component: Component2DImage = components["Normal"] point_cloud = o3d.geometry.PointCloud() point_cloud.points = create_3d_vector(point_cloud_raw.data) point_cloud.normals = create_3d_vector(normal_component.data) point_cloud.colors = map_texture(intensity_component) # Rotate the point cloud as specified by the command-line arguments rotate_point_cloud(point_cloud, horizontal_angle, vertical_angle) # Render the point cloud with the specified zoom factor render_with_zoom(point_cloud, zoom_factor) if __name__ == "__main__": # Set default values #device_id = "FJE-061" #horizontal_angle = 360 #vertical_angle = 180 #zoom_factor = 0.1 # Override default values with command-line arguments if provided if len(sys.argv) > 1: device_id = sys.argv[1] if len(sys.argv) > 2: horizontal_angle = float(sys.argv[2]) if len(sys.argv) > 3: vertical_angle = float(sys.argv[3]) if len(sys.argv) > 4: zoom_factor = float(sys.argv[4]) # Run main function with values if len(sys.argv) > 4: main(device_id, horizontal_angle, vertical_angle, zoom_factor)

Thanks. I will. For the time being I am using CreateProcess and calling the script as a commandline and its working fine. I will revisit this later.

I did not, I thought that was actually done using the ThreadPythonExec as well as in this: FTask := TTask.Create( procedure var Py: IPyEngineAndGIL; begin Py := SafePyEngine; Py.PythonEngine.ExecStrings(Script); end); FTask.Start; So no matter what I am required to call Py_Begin_Allow_Threads and Py_End_Allow_Threads?

I have attached the version of the project that uses the example (to the best of my understanding) ThreadPythonExec: This snippet: // ThreadPythonExec( // procedure // begin // PythonEngine1.ExecStrings(Script); // end, // procedure // begin // FScriptRunning := False; // end, // False); PythonEngine1.ExecStrings(Script); I commented out the ThreadPythonExec and uncommented (the last) line.. and it works fine, but the python app blocks the main UI and I am trying to avoid this. GLDelphiScanner_BKUP.zip

Using the "ThreadPythonExec" method, I tried this: unit Unit1; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, System.Threading, System.Math, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, PythonEngine, PythonVersions, ShellAPI, SDL_NumIO, SDL_stringl, Vcl.ExtCtrls, LJUDDelphi, Vcl.WinXCtrls, TlHelp32; const PYHARV_HOME = 'C:\Users\printeruser\Desktop\3DScan_Work\photoneo-python-examples\GigEV\harvesters'; VENV_PATH = PYHARV_HOME + '\.venv'; VENV_PYTHON_EXE = VENV_PATH + '\Scripts\python.exe'; PHOTONEO_GENICAM_PATH = PYHARV_HOME + '\advanced\photoneo_genicam'; LJ_TIMER_INTERVAL = 100; SCAN_MODE_MANUAL = 0; SCAN_MODE_TIMER = 1; SCAN_MODE_RELAY = 2; type TForm1 = class(TForm) Panel1: TPanel; nioVerticalRotation: TNumIO2; PythonInputOutput1: TPythonInputOutput; PythonEngine1: TPythonEngine; RadioGroup1: TRadioGroup; editDevSerialNumber: TEdit; nioHorizontalRotation: TNumIO2; nioZoomFactor: TNumIO2; btnScanNow: TButton; lblDeviceSerialNum_Label: TLabel; Timer1: TTimer; nioTimerInterval: TNumIO2; lblLabJackStatus: TLabel; uiRelay_0_Voltage: TLabel; uiRelay_1_Voltage: TLabel; procedure btnScanNowClick(Sender: TObject); procedure FormActivate(Sender: TObject); procedure FormCreate(Sender: TObject); procedure RadioGroup1Click(Sender: TObject); procedure nioTimerIntervalChange(Sender: TObject); procedure Timer1Timer(Sender: TObject); procedure nioZoomFactorChange(Sender: TObject); procedure Panel1DblClick(Sender: TObject); private { Private declarations } // LabJack Vars for the class: FLabJackConnected: Boolean; FRelayMonitorLatch: Boolean; FLJRelay_0_ON, FLJRelay_1_ON: Boolean; FLJErrorcode: LJ_ERROR; // LabJack Error Code FLJHandle: LJ_HANDLE; // Handle for LabJack device FLJVoltage_0, FLJVoltage_1 : double; // Timer & TDateTime Trigger: LastTriggerTime: TDateTime; // The rest of th eclass vars: FTimerTriggeredScan: Boolean; FRelayTriggeredScan: Boolean; FTimeTrigScanInterval: Integer; FScanZoomFactor: Double; FScriptRunning: Boolean; FPythonOpen3DPID: DWORD; PyVersion: TPythonVersion; procedure SetEnvironmentVariables; procedure ConfigurePythonEnvironment; function FindPythonOpen3DSubprocess: DWORD; function StopPythonScript: Boolean; function RunPythonScript: Boolean; procedure RequestElevationIfNeeded; function IsUserAnAdmin: Boolean; // Trigger procedures: procedure TriggerByUserToScan; procedure TriggerByTimerToScan; procedure TriggerByRelayToScan; // LabJack: procedure Initialize_U3HV; procedure ErrorHandler(LJErrorcode: LJ_ERROR; LJIteration: longint); procedure SetDACVoltage(Channel: Integer; TheSetVoltage: Double); procedure GetAnalogVoltage(Channel: Integer; var TheVoltage: Double); public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} // LabJack: procedure TForm1.Initialize_U3HV; var numChannels, quickSample, longSettling: longint; LabJack_Check : integer; begin // This performs the standard initialization of the U3-HV system // Some initial values LabJack_Check := 0; FLJHandle := 0; numChannels := 16; //Number of AIN channels, 0-16. quickSample := 0; //Set to TRUE for quick AIN sampling. longSettling := 1; //Set to TRUE for extra AIN settling time. // Now let's open the labjack FLJErrorcode := OpenLabJack(LJ_dtU3, LJ_ctUSB, '1', 1, FLJHandle); ErrorHandler(FLJErrorcode, 0); if FLJErrorcode > 0 then INC(LabJack_Check); // Now let's reset the configuration FLJErrorcode := ePut(FLJHandle, LJ_ioPIN_CONFIGURATION_RESET, 0, 0, 0); ErrorHandler(FLJErrorcode, 0); if FLJErrorcode > 0 then INC(LabJack_Check); //Configure quickSample. FLJErrorcode := ePut(FLJHandle, LJ_ioPUT_CONFIG, LJ_chAIN_RESOLUTION, quickSample, 0); ErrorHandler(FLJErrorcode, 0); if FLJErrorcode > 0 then INC(LabJack_Check); //Configure longSettling. FLJErrorcode := ePut(FLJHandle, LJ_ioPUT_CONFIG, LJ_chAIN_SETTLING_TIME, longSettling, 0); ErrorHandler(FLJErrorcode, 0); if FLJErrorcode > 0 then INC(LabJack_Check); //Configure the lines as analog. FLJErrorcode := ePut(FLJHandle, LJ_ioPUT_ANALOG_ENABLE_PORT, 0, (IntPower(2, numChannels) - 1), numChannels); ErrorHandler(FLJErrorcode, 0); if FLJErrorcode > 0 then INC(LabJack_Check); if LabJack_Check = 0 then begin lblLabJackStatus.Font.Color := clLime; lblLabJackStatus.Caption := 'LabJack Connected'; end else begin lblLabJackStatus.Font.Color := clRed; lblLabJackStatus.Caption := 'LabJack Disonnected!'; end; // Let's set the DAC0 and DAC1 to 0.0 Volts at boot-up SetDACVoltage(0, 0.0); SetDACVoltage(1, 0.0); end; procedure TForm1.ErrorHandler(LJErrorcode: LJ_ERROR; LJIteration: longint); var err: array[0..254] of AnsiChar; begin if LJErrorcode <> LJE_NOERROR then begin ErrorToString(LJErrorcode, @err); //StatusUpdate('Error number = ' + IntToStr(lngErrorcode)+ ' Error string = ' + string(err) + ' Iteration = ' + IntToStr(LJIteration)); FLabJackConnected := False; // there was an error! end else begin // LabJack Operation is OK FLabJackConnected := True; end; end; procedure TForm1.SetDACVoltage(Channel: Integer; TheSetVoltage: Double); begin if FLabJackConnected then begin // This uses the global lngHandle to refer to the U3-HV if ABS(TheSetVoltage) < 10 then ePUT(FLJHandle, LJ_ioPUT_DAC, Channel, TheSetVoltage, 0) else begin // Add an error statement if the DAC is set overrange...! lblLabJackStatus.Font.Color := clRed; lblLabJackStatus.Caption := 'LabJack Connected & Overrange!'; end; end else begin lblLabJackStatus.Font.Color := clRed; lblLabJackStatus.Caption := 'LabJack Disonnected!'; FLabJackConnected := False; ShowMessage('Problem connecting to LabJack! Check Power and USB connection.'); end; end; procedure TForm1.GetAnalogVoltage(Channel: Integer; var TheVoltage: Double); begin // This uses the global lngHandle to read a voltage from the Analog Channels // // The "LJ_ioGET_AIN" is the integer that determines the operation. Refer to // LJUDDelphi.pas for details if FLabJackConnected then begin eGET(FLJHandle, LJ_ioGET_AIN, Channel, TheVoltage, 0); end else begin lblLabJackStatus.Font.Color := clRed; lblLabJackStatus.Caption := 'LabJack Disonnected!'; FLabJackConnected := False; ShowMessage('Problem connecting to LabJack! Check Power and USB connection.'); end; // Update the Text readings if Channel = 0 then uiRelay_0_Voltage.Caption := 'Relay 0 Voltage = '+ Strff(FLJVoltage_0, 4, 3)+' V'; if Channel = 1 then uiRelay_1_Voltage.Caption := 'Relay 1 Voltage = '+ Strff(FLJVoltage_1, 4, 3)+' V'; end; // The Rest of the Code: function TForm1.IsUserAnAdmin: Boolean; var hToken: THandle; Elevation: TOKEN_ELEVATION; cbSize: DWORD; begin Result := False; if OpenProcessToken(GetCurrentProcess, TOKEN_QUERY, hToken) then try cbSize := SizeOf(TOKEN_ELEVATION); if GetTokenInformation(hToken, TokenElevation, @Elevation, cbSize, cbSize) then Result := Elevation.TokenIsElevated <> 0; finally CloseHandle(hToken); end; end; procedure TForm1.RequestElevationIfNeeded; var sei: TShellExecuteInfo; exeName: string; begin if not IsUserAnAdmin then begin ZeroMemory(@sei, SizeOf(sei)); sei.cbSize := SizeOf(sei); sei.Wnd := Handle; // Parent window sei.fMask := SEE_MASK_FLAG_DDEWAIT or SEE_MASK_FLAG_NO_UI; sei.lpVerb := 'runas'; // Request elevation exeName := ParamStr(0); sei.lpFile := PChar(exeName); sei.lpParameters := PChar(''); // No parameters sei.nShow := SW_SHOWNORMAL; if not ShellExecuteEx(@sei) then begin ShowMessage('Failed to create elevated process. Error code: ' + IntToStr(GetLastError)); Application.Terminate; // Terminate the unelevated instance end else Application.Terminate; // Terminate the unelevated instance end; end; procedure TForm1.SetEnvironmentVariables; begin SetEnvironmentVariable('VIRTUAL_ENV', PChar(VENV_PATH)); SetEnvironmentVariable('PYTHONHOME', nil); // Unset PYTHONHOME SetEnvironmentVariable('PATH', PChar(VENV_PATH + '\Scripts;' + GetEnvironmentVariable('PATH'))); end; procedure TForm1.ConfigurePythonEnvironment; begin MaskFPUExceptions(True); // Ensure the virtual environment paths are correctly set SetEnvironmentVariables; // Configure Python environment PythonEngine1.ExecString(Format( 'import sys; import os; ' + 'sys.path.append(r"%s"); ' + 'sys.path.append(r"%s\Lib\site-packages"); ' + 'sys.path.append(r"%s"); ' + // Add path to photoneo_genicam 'os.environ["VIRTUAL_ENV"] = r"%s"; ' + 'os.environ["PATH"] = r"%s\Scripts;" + os.environ["PATH"]; ' + 'print("sys.path:", sys.path); ' + 'print("VIRTUAL_ENV:", os.environ["VIRTUAL_ENV"]); ' + 'print("PATH:", os.environ["PATH"])', [VENV_PATH, VENV_PATH, PHOTONEO_GENICAM_PATH, VENV_PATH, VENV_PATH] )); end; procedure TForm1.nioTimerIntervalChange(Sender: TObject); begin try if(Not nioTimerInterval.Value.IsNan) then FTimeTrigScanInterval := nioTimerInterval.IntegerValue; except FTimeTrigScanInterval := 10; nioTimerInterval.Value := FTimeTrigScanInterval; end; end; procedure TForm1.nioZoomFactorChange(Sender: TObject); begin try if(Not nioZoomFactor.Value.IsNan) then FScanZoomFactor := (100 / nioZoomFactor.IntegerValue); except FScanZoomFactor := 0.3; nioTimerInterval.Value := (100/FScanZoomFactor); end; end; procedure TForm1.Panel1DblClick(Sender: TObject); begin // Reset fields: if(GetKeyState(VK_SHIFT) < 0) then begin nioHorizontalRotation.Value := 360; nioVerticalRotation.Value := 180; nioZoomFactor.Value := 200; FScanZoomFactor := (100 / nioZoomFactor.IntegerValue); end; end; procedure TForm1.FormCreate(Sender: TObject); begin RequestElevationIfNeeded; FTimerTriggeredScan := False; FRelayTriggeredScan := False; FScriptRunning := False; Timer1.Interval := LJ_TIMER_INTERVAL; // Load the Python DLL using the virtual environment's Python executable try FTimeTrigScanInterval := nioTimerInterval.IntegerValue; FScanZoomFactor := (100 / nioZoomFactor.IntegerValue); if PythonVersionFromPath(PYHARV_HOME + '\.venv\', PyVersion) then begin PythonEngine1.VenvPythonExe := VENV_PYTHON_EXE; PythonEngine1.SetPythonHome(PYHARV_HOME + '\.venv\'); PyVersion.AssignTo(PythonEngine1); PythonEngine1.LoadDll; // ShowMessage('Python DLL loaded successfully. ' + PythonEngine1.DllName); ConfigurePythonEnvironment; end else begin ShowMessage('No vEnv found!'); end; except on E: Exception do ShowMessage('Failed to load Python DLL: ' + E.Message); end; end; procedure TForm1.FormActivate(Sender: TObject); begin if(Not DirectoryExists(PYHARV_HOME)) then begin ShowMessage(PYHARV_HOME + ' doesn''t exist!'); end; FTimeTrigScanInterval := nioTimerInterval.IntegerValue; LastTriggerTime := Now; // try to connect to Lab Jack: Initialize_U3HV; // Now Check if its connected: if(Not FLabJackconnected) then begin lblLabJackStatus.Font.Color := clRed; lblLabJackStatus.Caption := 'LabJack Disonnected!'; end; end; procedure TForm1.RadioGroup1Click(Sender: TObject); begin case RadioGroup1.ItemIndex of SCAN_MODE_MANUAL: begin FTimerTriggeredScan := False; FRelayTriggeredScan := False; btnScanNow.Enabled := (Not FTimerTriggeredScan) AND (Not FRelayTriggeredScan); nioTimerInterval.Enabled := FTimerTriggeredScan; end; SCAN_MODE_TIMER: begin FTimerTriggeredScan := True; FRelayTriggeredScan := False; btnScanNow.Enabled := (Not FTimerTriggeredScan) AND (Not FRelayTriggeredScan); nioTimerInterval.Enabled := FTimerTriggeredScan; end; SCAN_MODE_RELAY: begin FTimerTriggeredScan := False; FRelayTriggeredScan := True; btnScanNow.Enabled := (Not FTimerTriggeredScan) AND (Not FRelayTriggeredScan); nioTimerInterval.Enabled := FTimerTriggeredScan; end; else begin RadioGroup1.ItemIndex := 0; btnScanNow.Enabled := True; nioTimerInterval.Enabled := False; end; end; end; procedure TForm1.btnScanNowClick(Sender: TObject); begin btnScanNow.Enabled := False; if FScriptRunning then begin ShowMessage('Scan is still busy.'); Exit; end; Application.ProcessMessages; if(Tbutton(Sender).Name = 'btnScanNow') then begin TTask.Run( procedure var t: Integer; begin for t := 0 to 9000 do begin Sleep(10); end; TThread.Synchronize(nil, procedure begin //Py_Exit PythonEngine1.ExecString('exit(0)'); Application.ProcessMessages; end); end); TriggerByUserToScan; end; btnScanNow.Enabled := (Not FScriptRunning); end; procedure TForm1.Timer1Timer(Sender: TObject); begin if(FTimerTriggeredScan OR FRelayTriggeredScan) then begin Timer1.Enabled := False; //Check for Triggers: if(Not FTimerTriggeredScan) then TriggerByRelayToScan; if(Not FRelayTriggeredScan) then TriggerByTimerToScan; Timer1.Enabled := True; end; end; procedure TForm1.TriggerByUserToScan; begin if((Not FTimerTriggeredScan) AND (Not FRelayTriggeredScan)) then begin RunPythonScript; end; end; procedure TForm1.TriggerByTimerToScan; var myCurrentTime: TDateTime; myTriggerTimeElapsed: Double; begin myCurrentTime := Now; // Calculate time elapsed since the last execution of UpdateMassChart myTriggerTimeElapsed := (myCurrentTime - LastTriggerTime) * 86400; // Convert to seconds if(myTriggerTimeElapsed >= FTimeTrigScanInterval) then begin StopPythonScript; LastTriggerTime := myCurrentTime; RunPythonScript; end; end; procedure TForm1.TriggerByRelayToScan; var ActiveFileName : String; myActiveFileCheckSum: String; begin // Enable the Print Monitor Button if(FLabJackConnected AND FRelayTriggeredScan AND (Not FTimerTriggeredScan)) then begin // After the first read.....The Monitorlatch is FALSE....it should only be true // again if BOTH voltages are less than 2.0V!!!! // Just get the voltage readings from the Labjack GetAnalogVoltage(0, FLJVoltage_0); GetAnalogVoltage(1, FLJVoltage_1); if ((FLJVoltage_0 < 2.0) and (FLJVoltage_1 < 2.0)) then FRelayMonitorLatch := True; // Update the Relay Lights Status if(FLJVoltage_0 > 2.0) then begin // Use 2V as the trigger voltage level for now //uiRelay_0_Light.Fill.Color := TAlphaColorRec.Lime; FLJRelay_0_ON := True; end else begin //uiRelay_0_Light.Fill.Color := TAlphaColorRec.Crimson; FLJRelay_0_ON := False; end; if(FLJVoltage_1 > 2.0) then begin // Use 2V as the trigger voltage level for now //uiRelay_1_Light.Fill.Color := TAlphaColorRec.Lime; FLJRelay_1_ON := True; end else begin //uiRelay_1_Light.Fill.Color := TAlphaColorRec.Crimson; FLJRelay_1_ON := False; end; // Now let's figure out if we need to take a photo // // The camera will be "inactive" most of the time // Make it active first.... // // then wait for Relay_1 to turn ON // // Take the photo and turn Relay 1 OFF and Turn Relay 0 OFF // if FLJRelay_0_ON then begin // This means the camera is "active" and updating images // // Now let's see if Relay 1 is ON if FLJRelay_1_ON then begin // Here you should execute scan! // if FRelayMonitorLatch then begin StopPythonScript; // Now let's write the file! RunPythonScript; end; // Now set the MonitorLatch to False! FRelayMonitorLatch := False; end; end; end; end; // Python uses Open3D Library modules: function TForm1.FindPythonOpen3DSubprocess: DWORD; var Snapshot: THandle; ProcessEntry: TProcessEntry32; begin Result := 0; Snapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0); if Snapshot <> INVALID_HANDLE_VALUE then try ProcessEntry.dwSize := SizeOf(ProcessEntry); if Process32First(Snapshot, ProcessEntry) then begin repeat if Pos('Open3D', ProcessEntry.szExeFile) > 0 then begin Result := ProcessEntry.th32ProcessID; Break; end; until Not Process32Next(Snapshot, ProcessEntry); end; finally CloseHandle(Snapshot); end; end; // Terminate Python execution: function TForm1.StopPythonScript: Boolean; procedure TerminateProcessByPID(PID: DWORD); var ProcessHandle: THandle; begin ProcessHandle := OpenProcess(PROCESS_TERMINATE, False, PID); if ProcessHandle <> 0 then try TerminateProcess(ProcessHandle, 0); finally CloseHandle(ProcessHandle); end; end; begin Result := False; // Terminate the Open3D subprocess if it exists FPythonOpen3DPID := FindPythonOpen3DSubprocess; if FPythonOpen3DPID <> 0 then TerminateProcessByPID(FPythonOpen3DPID); end; // The Actual Python execution: function TForm1.RunPythonScript: Boolean; var Script: TStringList; ScriptFilePath, DeviceID, HorizontalRotation, VerticalRotation, ZoomFactor: string; begin // Prevent Double Clicking... since the python script needs to complete first before re-running: FScriptRunning := True; Script := TStringList.Create; try // Retrieve the values from the form inputs DeviceID := editDevSerialNumber.Text; HorizontalRotation := nioHorizontalRotation.Value.ToString; VerticalRotation := nioVerticalRotation.Value.ToString; ZoomFactor := FScanZoomFactor.ToString; ScriptFilePath := PYHARV_HOME + '\advanced\GridLoigic_pointcloud_with_normals_and_texture.py'; if FileExists(ScriptFilePath) then begin Script.LoadFromFile(ScriptFilePath); // Insert the sys.path and debug statements Script.Insert(2, 'sys.path.append(r"' + PYHARV_HOME + '\advanced")'); Script.Insert(3, 'print("Starting script execution")'); Script.Insert(4, 'try:'); Script.Insert(5, ' import photoneo_genicam'); Script.Insert(6, ' print("photoneo_genicam imported successfully")'); Script.Insert(7, 'except ImportError as e:'); Script.Insert(8, ' print("Failed to import photoneo_genicam:", str(e))'); Script.Insert(9, ' raise'); // Add the parameters as comments for reference Script.Insert(10, '# Parameters passed from Delphi'); Script.Insert(11, 'device_id = "' + DeviceID + '"'); Script.Insert(12, 'horizontal_angle = ' + HorizontalRotation); Script.Insert(13, 'vertical_angle = ' + VerticalRotation); Script.Insert(14, 'zoom_factor = ' + ZoomFactor); // Replace main function call with parameters //Script.Add('main(device_id, horizontal_angle, vertical_angle, zoom_factor)'); try ThreadPythonExec( procedure begin GetPythonEngine.ExecStrings(Script); end, procedure begin FScriptRunning := False; end, False); //PythonEngine1.ExecStrings(Script); //ShowMessage('Script executed successfully.'); except on E: EPySystemExit do begin // Handle the SystemExit exception ShowMessage('Script terminated by SystemExit.'); end; on E: EPythonError do begin ShowMessage('Python Error: ' + E.Message); end; on E: Exception do begin ShowMessage('Error: ' + E.Message); end; end; end else begin ShowMessage('Script file does not exist: ' + ScriptFilePath); end; finally Script.Free; //PythonEngine1. //if(Not (FTimerTriggeredScan or FRelayTriggeredScan)) then //FScriptRunning := False; end; end; end.

Yes. I purchased a license. great stuff! Thanks!

I am glad I found this thread the other day. I was able ot get a large 3MF file to load much faster using OXml instead using the DOM method. so I concure for OXml suggestion.

Hi, Have you tried this (saxforpascal) with Delphi 11.3? Or is there anything newer that may work. I am opening 3MF files and the XML files that are big take too long so I was wanting to convert to using SAX implementation of XML parsing. Thanks, David

Hi, I am following this example for setting up a VideoCaptureDevice app: https://docwiki.embarcadero.com/RADStudio/Sydney/en/Video_Capturing I could not get the VideoCaptureDevice to start. I tried 4 known good cameras and get the same thing, I modified the code a bit to give me an indicator that I am indeed setting up the app right, still nothing. The app compiles just fine, just won't start capture. My version of Delphi is 10.2.3 and the following is my current code: unit FMXCamera_Main; interface uses System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Objects, FMX.ListBox, FMX.Controls.Presentation, FMX.StdCtrls, FMX.Layouts, FMX.Media, FMX.Edit; type TForm1 = class(TForm) Layout1: TLayout; btnStart: TButton; ComboBox1: TComboBox; Image1: TImage; procedure FormCreate(Sender: TObject); procedure ComboBox1Change(Sender: TObject); procedure btnStartClick(Sender: TObject); procedure FormDestroy(Sender: TObject); private { Private declarations } public { Public declarations } VideoCamera: TVideoCaptureDevice; procedure SampleBufferSync; procedure SampleBufferReady(Sender: TObject; const ATime: TMediaTime); end; var Form1: TForm1; implementation // Delphi version of the implementation {$R *.fmx} procedure TForm1.btnStartClick(Sender: TObject); begin if(VideoCamera <> nil) then begin if(VideoCamera.State = TCaptureDeviceState.Stopped) then begin VideoCamera.OnSampleBufferReady := SampleBufferReady; VideoCamera.CaptureSettingPriority := TVideoCaptureSettingPriority.FrameRate; VideoCamera.StartCapture; if(VideoCamera.State = TCaptureDeviceState.Capturing) then begin btnStart.Text := 'Stop'; end else begin VideoCamera.StopCapture; btnStart.Text := 'Start'; end; end else begin VideoCamera.StopCapture; btnStart.Text := 'Start'; end; end else begin Caption := 'Video capture devices not available.'; end; end; procedure TForm1.ComboBox1Change(Sender: TObject); begin VideoCamera := TVideoCaptureDevice(TCaptureDeviceManager.Current.GetDevicesByName(ComboBox1.Selected.Text)); if (VideoCamera <> nil) then begin btnstart.Text := 'Start '+VideoCamera.Name; btnStart.Enabled := true; end; end; procedure TForm1.FormCreate(Sender: TObject); var DeviceList: TCaptureDeviceList; i: integer; begin DeviceList := TCaptureDeviceManager.Current.GetDevicesByMediaType(TMediaType.Video); for i := 0 to DeviceList.Count - 1 do begin ComboBox1.Items.Add(DeviceList[i].Name); end; end; procedure TForm1.FormDestroy(Sender: TObject); begin if(VideoCamera <> nil) then begin VideoCamera.StopCapture; end; end; procedure TForm1.SampleBufferReady(Sender: TObject; const ATime: TMediaTime); begin TThread.Synchronize(TThread.CurrentThread, SampleBufferSync); //Resize the image so that the video is buffered in its original size Image1.Width := Image1.Bitmap.Width; Image1.Height := Image1.Bitmap.Height; end; procedure TForm1.SampleBufferSync; begin VideoCamera.SampleBufferToBitmap(Image1.Bitmap, true); end; end.

I have abandoned the FMX option. Thanks.

I have done everything. The camera permissions is open. In VCL I am using other libraries that work just fine. Its the FMX app that doesn't work.

The example did not work, The Camera is in a state of "Stopped" after calling "StartCapture"

I have absolutely done all of that. I am not even getting any errors in the IDE.