fpvectorial: Adds a progress event to allow informing back during the load of very large files

git-svn-id: trunk@35576 -

components/fpvectorial/examples/fpv3d_mainform.lfm

@@ -1,10 +1,10 @@
 object formFPV3D: TformFPV3D
   Left = 336
-  Height = 409
+  Height = 470
   Top = 171
   Width = 514
   Caption = 'formFPV3D'
-  ClientHeight = 409
+  ClientHeight = 470
   ClientWidth = 514
   OnCreate = FormCreate
   OnDestroy = FormDestroy
@@ -38,8 +38,8 @@ object formFPV3D: TformFPV3D
     AnchorSideBottom.Control = Owner
     AnchorSideBottom.Side = asrBottom
     Left = 5
-    Height = 300
-    Top = 104
+    Height = 337
+    Top = 128
     Width = 504
     Anchors = [akTop, akLeft, akRight, akBottom]
     BorderSpacing.Left = 5
@@ -101,4 +101,11 @@ object formFPV3D: TformFPV3D
     OnClick = btnConvert3DPointArrayToHeightMapClick
     TabOrder = 8
   end
+  object progressBar: TProgressBar
+    Left = 12
+    Height = 20
+    Top = 104
+    Width = 220
+    TabOrder = 9
+  end
 end

components/fpvectorial/examples/fpv3d_mainform.pas

@@ -6,7 +6,7 @@ interface
 
 uses
   Classes, SysUtils, FileUtil, OpenGLContext, Forms, Controls, Graphics,
-  Dialogs, EditBtn, StdCtrls, fpvectorial, gl, glu, FPimage,
+  Dialogs, EditBtn, StdCtrls, ComCtrls, fpvectorial, gl, glu, FPimage,
   Math, lasvectorialreader;
 
 type
@@ -23,6 +23,7 @@ type
     buttonZoomOut: TButton;  buttonLoad: TButton;
     editFileName: TFileNameEdit;
     glControl: TOpenGLControl;
+    progressBar: TProgressBar;
     procedure btnConvert3DPointArrayToHeightMapClick(Sender: TObject);
     procedure Button1Click(Sender: TObject);
     procedure buttonCutFileClick(Sender: TObject);
@@ -33,6 +34,7 @@ type
     procedure FormCreate(Sender: TObject);
     procedure FormDestroy(Sender: TObject);
     procedure glControlPaint(Sender: TObject);
+    procedure HandleVecDocProgress(APercentage: Byte);
   private
     { private declarations }
     procedure Render3DPointsArrayAlternative1();
@@ -71,6 +73,12 @@ begin
   RenderHeightMapV1();
 end;
 
+procedure TformFPV3D.HandleVecDocProgress(APercentage: Byte);
+begin
+  progressBar.Position := APercentage;
+  Application.ProcessMessages;
+end;
+
 procedure TformFPV3D.Render3DPointsArrayAlternative1;
 var
   VecPage: TvVectorialPage;
@@ -263,6 +271,7 @@ end;
 
 procedure TformFPV3D.buttonLoadClick(Sender: TObject);
 begin
+  VecDoc.OnProgress := @HandleVecDocProgress;
   VecDoc.ReadFromFile(editFileName.FileName);
   glControl.Invalidate;
 end;

components/fpvectorial/fpvectorial.pas

@@ -310,10 +310,13 @@ type
   public
   end;
 
+  TvProgressEvent = procedure (APercentage: Byte) of object;
+
   { TvVectorialDocument }
 
   TvVectorialDocument = class
   private
+    FOnProgress: TvProgressEvent;
     FPages: TFPList;
     FCurrentPageIndex: Integer;
     function CreateVectorialWriter(AFormat: TvVectorialFormat): TvCustomVectorialWriter;
@@ -350,6 +353,8 @@ type
     function AddPage(): TvVectorialPage;
     { Data removing methods }
     procedure Clear; virtual;
+    { Events }
+    property OnProgress: TvProgressEvent read FOnProgress write FOnprogress;
   end;
 
   { TvVectorialPage }
@@ -571,6 +576,8 @@ var
   i: Integer;
   lPos: TPoint;
   lValue: TFPColor;
+  PreviousValue: Word;
+  PreviousCount: Integer;
 begin
   // First setup the map and initialize it
   if RasterImage <> nil then RasterImage.Free;
@@ -590,9 +597,18 @@ begin
       if lPos.X < 0 then lPos.X := 0;
       if lPos.Y < 0 then lPos.Y := 0;
 
+      // Calculate the height of this point
+      PreviousValue := lValue.Red;
       lValue.Red := Round((lEntity.Z - APage.MinZ) * $FFFF / (APage.MaxZ - APage.MinZ));
+
+      // And apply it as a fraction of the total number of points which fall in this square
+      // we store the number of points in the Alpha channel
+      PreviousCount := lValue.Alpha div $100;
+      lValue.Red := Round((PreviousCount * PreviousValue + lValue.Red) / (PreviousCount + 1));
+
       lValue.Green := lValue.Red;
       lValue.Blue := lValue.Red;
+      lValue.Alpha := lValue.Alpha + $100;
       //lValue.alpha:=;
       RasterImage.Colors[lPos.X, lPos.Y] := lValue;
     end;

components/fpvectorial/lasvectorialreader.pas

@@ -129,6 +129,7 @@ type
     procedure DebugOutPublicHeaderBlock();
     {$endif}
     procedure ReadVariableLengthRecords(AStream: TStream);
+    procedure DoProgress(AProgress: Byte; AData: TvVectorialDocument);
   public
     // Public Header
     PublicHeaderBlock_1_0: TLASPublicHeaderBlock_1_0;
@@ -343,6 +344,11 @@ begin
   end;
 end;
 
+procedure TvLASVectorialReader.DoProgress(AProgress: Byte; AData: TvVectorialDocument);
+begin
+  if @AData.OnProgress <> nil then AData.OnProgress(AProgress);
+end;
+
 procedure TvLASVectorialReader.ReadFromStream(AStream: TStream;
   AData: TvVectorialDocument);
 var
@@ -353,6 +359,7 @@ var
   lPoint: TvPoint;
   lClassification: Integer = -1;
   lColor: TFPColor;
+  lPointsCounter: Integer = 0;
 begin
   // Clear and add the first page
   AData.Clear;
@@ -389,6 +396,11 @@ begin
   AStream.Position := InitialPos + PublicHeaderBlock_1_0.OffsetToPointData;
   while AStream.Position < AStream.Size do
   begin
+    // Send a progress event every 1k points
+    Inc(lPointsCounter);
+    if lPointsCounter mod 1000 = 0 then
+      DoProgress(Round(AStream.Position * 100 / AStream.Size), AData);
+
     // hack to cut las files: if lPage.GetEntitiesCount = 100000 then Exit;
     case PublicHeaderBlock_1_0.PointDataFormatID of
     0: