fpvectorial: Implements routines to delete entities and starts the las writer and cutting functionality

git-svn-id: trunk@35185 -

components/fpvectorial/examples/fpv3d_mainform.lfm

@@ -1,17 +1,17 @@
 object formFPV3D: TformFPV3D
   Left = 336
-  Height = 376
+  Height = 409
   Top = 171
-  Width = 495
+  Width = 514
   Caption = 'formFPV3D'
-  ClientHeight = 376
-  ClientWidth = 495
+  ClientHeight = 409
+  ClientWidth = 514
   OnCreate = FormCreate
   OnDestroy = FormDestroy
   LCLVersion = '0.9.31'
   object editFileName: TFileNameEdit
     Left = 12
-    Height = 25
+    Height = 21
     Top = 8
     Width = 280
     DialogOptions = []
@@ -38,9 +38,9 @@ object formFPV3D: TformFPV3D
     AnchorSideBottom.Control = Owner
     AnchorSideBottom.Side = asrBottom
     Left = 5
-    Height = 299
-    Top = 72
-    Width = 485
+    Height = 300
+    Top = 104
+    Width = 504
     Anchors = [akTop, akLeft, akRight, akBottom]
     BorderSpacing.Left = 5
     BorderSpacing.Right = 5
@@ -83,4 +83,13 @@ object formFPV3D: TformFPV3D
     OnClick = buttonRotZClick
     TabOrder = 6
   end
+  object buttonCutFile: TButton
+    Left = 12
+    Height = 25
+    Top = 72
+    Width = 159
+    Caption = 'Cut File to make it smaller'
+    OnClick = buttonCutFileClick
+    TabOrder = 7
+  end
 end

components/fpvectorial/examples/fpv3d_mainform.pas

@@ -14,6 +14,7 @@ type
 
   TformFPV3D = class(TForm)
     Button1: TButton;
+    buttonCutFile: TButton;
     buttonRotZ: TButton;
     buttonZoomIn: TButton;
 
@@ -21,6 +22,7 @@ type
     editFileName: TFileNameEdit;
     glControl: TOpenGLControl;
     procedure Button1Click(Sender: TObject);
+    procedure buttonCutFileClick(Sender: TObject);
     procedure buttonLoadClick(Sender: TObject);
     procedure buttonRotZClick(Sender: TObject);
     procedure buttonZoomInClick(Sender: TObject);
@@ -140,6 +142,16 @@ begin
   glControl.Invalidate;
 end;
 
+procedure TformFPV3D.buttonCutFileClick(Sender: TObject);
+var
+  lPage: TvVectorialPage;
+begin
+  VecDoc.ReadFromFile(editFileName.FileName);
+  lPage := VecDoc.GetPage(0);
+  while lPage.DeleteEntity(20000) do ;
+  VecDoc.WriteToFile(editFileName.FileName + 'smaller.las');
+end;
+
 procedure TformFPV3D.FormDestroy(Sender: TObject);
 begin
   VecDoc.Free;

components/fpvectorial/examples/fpv3dviewer.lpi

@@ -65,13 +65,6 @@
       <IncludeFiles Value="$(ProjOutDir)"/>
       <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
     </SearchPaths>
-    <Linking>
-      <Options>
-        <Win32>
-          <GraphicApplication Value="True"/>
-        </Win32>
-      </Options>
-    </Linking>
     <Other>
       <CompilerMessages>
         <MsgFileName Value=""/>

components/fpvectorial/fpvectorial.pas

@@ -353,12 +353,13 @@ type
 
   TvVectorialPage = class
   private
-    FEntities: TFPList;
+    FEntities: TFPList; // of TvEntity
     FTmpPath: TPath;
     FTmpText: TvText;
     //procedure RemoveCallback(data, arg: pointer);
     procedure ClearTmpPath();
     procedure AppendSegmentToTmpPath(ASegment: TPathSegment);
+    procedure CallbackDeleteEntity(data,arg:pointer);
   public
     // Document size for page-based documents
     Width, Height: Double; // in millimeters
@@ -375,6 +376,8 @@ type
     function  FindAndSelectEntity(Pos: TPoint): TvFindEntityResult;
     { Data removing methods }
     procedure Clear; virtual;
+    function  DeleteEntity(AIndex: Cardinal): Boolean;
+    function  RemoveEntity(AEntity: TvEntity; AFreeAfterRemove: Boolean = True): Boolean;
     { Data writing methods }
     function AddEntity(AEntity: TvEntity): Integer;
     procedure AddPathCopyMem(APath: TPath);
@@ -603,6 +606,12 @@ begin
   FTmpPath.AppendSegment(ASegment);
 end;
 
+procedure TvVectorialPage.CallbackDeleteEntity(data, arg: pointer);
+begin
+  if (data <> nil) then
+    TvEntity(data).Free;
+end;
+
 constructor TvVectorialPage.Create(AOwner: TvVectorialDocument);
 begin
   inherited Create;
@@ -669,9 +678,35 @@ end;
 
 procedure TvVectorialPage.Clear;
 begin
+  FEntities.ForEachCall(CallbackDeleteEntity, nil);
   FEntities.Clear();
 end;
 
+{@@
+  Returns if the entity was really deleted or false if there is no entity with this index
+}
+function TvVectorialPage.DeleteEntity(AIndex: Cardinal): Boolean;
+var
+  lEntity: TvEntity;
+begin
+  Result := False;
+  if AIndex >= GetEntitiesCount() then Exit;;
+  lEntity := GetEntity(AIndex);
+  if lEntity = nil then Exit;
+  FEntities.Delete(AIndex);
+  lEntity.Free;
+  Result := True;
+end;
+
+function TvVectorialPage.RemoveEntity(AEntity: TvEntity; AFreeAfterRemove: Boolean = True): Boolean;
+begin
+  Result := False;
+  if AEntity = nil then Exit;
+  FEntities.Remove(AEntity);
+  if AFreeAfterRemove then AEntity.Free;
+  Result := True;
+end;
+
 {@@
   Adds an entity to the document and returns it's current index
 }

components/fpvectorial/lasvectorialreader.pas

@@ -26,7 +26,7 @@ unit lasvectorialreader;
 interface
 
 uses
-  Classes, SysUtils,
+  Classes, SysUtils, dateutils,
   fpcanvas, fpimage,
   //avisozlib,
   fpvectorial;
@@ -142,8 +142,127 @@ type
     procedure ReadFromStream(AStream: TStream; AData: TvVectorialDocument); override;
   end;
 
+  { TvLASVectorialWriter }
+
+  TvLASVectorialWriter = class(TvCustomVectorialWriter)
+  private
+    // Stream position information
+    InitialPos, PositionAfterPublicHeader: Int64;
+  public
+    // Public Header
+    PublicHeaderBlock_1_0: TLASPublicHeaderBlock_1_0;
+    PublicHeaderBlock_1_3_Extension: TLASPublicHeaderBlock_1_3_Extension;
+    // Variable Length Records
+    VariableLengthRecords: array of TLASVariableLengthRecord;
+    // Point Data
+    PointsFormat0: array of TLASPointDataRecordFormat0;
+    PointsFormat1: array of TLASPointDataRecordFormat1;
+    { General reading methods }
+    procedure WriteToStream(AStream: TStream; AData: TvVectorialDocument); override;
+  end;
+
 implementation
 
+{ TvLASVectorialWriter }
+
+procedure TvLASVectorialWriter.WriteToStream(AStream: TStream;
+  AData: TvVectorialDocument);
+var
+  lPage: TvVectorialPage;
+  lRecord0: TLASPointDataRecordFormat0;
+  lRecord1: TLASPointDataRecordFormat1;
+  lPoint: TvPoint;
+  lColor: TFPColor;
+  lCreationDate: TDateTime;
+  lEntity: TvEntity;
+  i: Integer;
+begin
+  // Get the first page
+  lPage := AData.GetPage(0);
+  lCreationDate := Now;
+
+  // Write our LAS 1.0 header
+  FillChar(PublicHeaderBlock_1_0, SizeOf(PublicHeaderBlock_1_0), #0);
+  PublicHeaderBlock_1_0.FileSignatureLASF := 'LASF';
+  PublicHeaderBlock_1_0.FileSourceID := 0;
+  PublicHeaderBlock_1_0.GlobalEncoding := 0;
+  PublicHeaderBlock_1_0.ProjectIDGUIDdata1 := 0;
+  PublicHeaderBlock_1_0.ProjectIDGUIDdata2 := 0;
+  PublicHeaderBlock_1_0.ProjectIDGUIDdata3 := 0;
+  // PublicHeaderBlock_1_0.ProjectIDGUIDdata4 all zero
+  PublicHeaderBlock_1_0.VersionMajor := 1;
+  PublicHeaderBlock_1_0.VersionMinor := 0;
+  PublicHeaderBlock_1_0.SystemIdentifier := '';
+  PublicHeaderBlock_1_0.GeneratingSoftware := 'FPSpreadsheet';
+  PublicHeaderBlock_1_0.FileCreationDayofYear := DayOfTheYear(lCreationDate);
+  PublicHeaderBlock_1_0.FileCreationYear := YearOf(lCreationDate);
+  PublicHeaderBlock_1_0.HeaderSize := SizeOf(PublicHeaderBlock_1_0);
+  PublicHeaderBlock_1_0.OffsetToPointData := SizeOf(PublicHeaderBlock_1_0);
+  PublicHeaderBlock_1_0.NumberofVariableLengthRecords := 0;
+  PublicHeaderBlock_1_0.PointDataFormatID := 1;
+  PublicHeaderBlock_1_0.PointDataRecordLength := $1C;
+  PublicHeaderBlock_1_0.Numberofpointrecords := lPage.GetEntitiesCount;
+  PublicHeaderBlock_1_0.Numberofpointsbyreturn[0] := 0;
+  PublicHeaderBlock_1_0.Numberofpointsbyreturn[1] := 0;
+  PublicHeaderBlock_1_0.Numberofpointsbyreturn[2] := 0;
+  PublicHeaderBlock_1_0.Numberofpointsbyreturn[3] := 0;
+  PublicHeaderBlock_1_0.Numberofpointsbyreturn[4] := 0;
+  PublicHeaderBlock_1_0.Xscalefactor := 1;
+  PublicHeaderBlock_1_0.Yscalefactor := 1;
+  PublicHeaderBlock_1_0.Zscalefactor := 1;
+
+  PublicHeaderBlock_1_0.Xoffset := 0;
+  PublicHeaderBlock_1_0.Yoffset := 0;
+  PublicHeaderBlock_1_0.Zoffset := 0;
+  PublicHeaderBlock_1_0.MaxX := lPage.MaxX;
+  PublicHeaderBlock_1_0.MinX := lPage.MinX;
+  PublicHeaderBlock_1_0.MaxY := lPage.MaxY;
+  PublicHeaderBlock_1_0.MinY := lPage.MinY;
+  PublicHeaderBlock_1_0.MaxZ := lPage.MaxZ;
+  PublicHeaderBlock_1_0.MinZ := lPage.MinZ;
+  AStream.Write(PublicHeaderBlock_1_0, SizeOf(TLASPublicHeaderBlock_1_0));
+
+  // Write the variable length records
+  // none currently
+
+  // Write the point data
+  for i := 0 to lPage.GetEntitiesCount()-1 do
+  begin
+    lEntity := lPage.GetEntity(i);
+    if not (lEntity is TvPoint) then Continue;
+    lPoint := lEntity as TvPoint;
+
+    FillChar(lRecord1, SizeOf(TLASPointDataRecordFormat1), #0);
+    lRecord1.X := Round(lEntity.X);
+    lRecord1.Y := Round(lEntity.Y);
+    lRecord1.Z := Round(lEntity.Z);
+
+    // Convert the colors into LIDAR Point Classes
+    lColor := lPoint.Pen.Color;
+    // 2 Ground
+    if lColor = colMaroon then
+      lRecord1.Classification := 2
+    // 3 Low Vegetation
+    else if lColor = colGreen then
+      lRecord1.Classification := 3
+    // 4 Medium Vegetation
+    //4: lColor := colGreen;
+    // 5 High Vegetation
+    else if lColor = colDkGreen then
+      lRecord1.Classification := 5
+    // 6 Building
+    else if lColor = colGray then
+      lRecord1.Classification := 6
+    // 7 Low Point (noise)
+    // 8 Model Key-point (mass point)
+    // 9 Water
+    else if lColor = colBlue then
+      lRecord1.Classification := 9;
+
+    AStream.Write(lRecord1, SizeOf(TLASPointDataRecordFormat1));
+  end;
+end;
+
 {$ifdef FPVECTORIALDEBUG_LAS}
 procedure TvLASVectorialReader.DebugOutPublicHeaderBlock;
 begin
@@ -338,6 +457,7 @@ end;
 initialization
 
   RegisterVectorialReader(TvLASVectorialReader, vfLAS);
+  RegisterVectorialWriter(TvLASVectorialWriter, vfLAS);
 
 end.