LazReport, fix preview blocking bug, issue #13399

git-svn-id: trunk@19116 -

components/lazreport/source/lazreport.lpk

@@ -27,7 +27,7 @@ Lazarus Port: Olivier Guilbaud, Jesus Reyes A.
 See license.txt and license-lazreport.txt for details.
 "/>
     <Version Minor="9" Release="5"/>
-    <Files Count="48">
+    <Files Count="51">
       <Item1>
         <Filename Value="lr_class.pas"/>
         <UnitName Value="LR_Class"/>
@@ -221,6 +221,18 @@ See license.txt and license-lazreport.txt for details.
         <Filename Value="lr_propedit.pas"/>
         <UnitName Value="lr_propedit"/>
       </Item48>
+      <Item49>
+        <Filename Value="lr_progr.lfm"/>
+        <Type Value="LFM"/>
+      </Item49>
+      <Item50>
+        <Filename Value="lr_progr.lrs"/>
+        <Type Value="LRS"/>
+      </Item50>
+      <Item51>
+        <Filename Value="lr_progr.pas"/>
+        <UnitName Value="LR_progr"/>
+      </Item51>
     </Files>
     <i18n>
       <EnableI18N Value="True"/>
@@ -250,7 +262,6 @@ See license.txt and license-lazreport.txt for details.
     </UsageOptions>
     <PublishOptions>
       <Version Value="2"/>
-      <DestinationDirectory Value="$(TestDir)\publishedpackage\"/>
       <IgnoreBinaries Value="False"/>
     </PublishOptions>
   </Package>

components/lazreport/source/lazreport.pas

@@ -7,10 +7,10 @@ unit lazreport;
 interface
 
 uses
-  LR_Class, LR_Desgn, LR_Register, LR_Flds, LR_DBSet, LR_BarC, LR_BndEd, 
+  LR_Class, LR_Desgn, LR_Register, LR_Flds, LR_DBSet, LR_BarC, LR_BndEd,
   LR_PGrid, LR_View, lr_expres, lr_funct_editor_unit, lr_funct_editor_unit1, 
   LR_Prntr, LR_Edit, LR_Pars, LR_fmted, LR_Const, LR_pgopt, LR_Dopt, LR_GEdit, 
-  LR_Utils, LR_GrpEd, lr_propedit, LazarusPackageIntf;
+  LR_Utils, LR_GrpEd, lr_propedit, LR_progr, LazarusPackageIntf;
 
 implementation
 

components/lazreport/source/lr_class.pas

@@ -21,7 +21,7 @@ uses
   
   LCLType,LCLIntf,TypInfo,LCLProc,
   SysUtilsAdds,
-  LR_View, LR_Pars, LR_Intrp, LR_DSet, LR_DBSet, LR_DBRel,LR_Const;
+  LR_View, LR_Pars, LR_Intrp, LR_DSet, LR_DBSet, LR_DBRel, LR_Const;
 
 const
 // object flags
@@ -7959,35 +7959,28 @@ var
 procedure TfrReport.BuildBeforeModal(Sender: TObject);
 begin
   {$IFDEF DebugLR}
-  DebugLn('20');
+  DebugLn('TfrReport.BuildBeforeModal INIT FinalPass=',dbgs(FinalPass),' DoublePass=',dbgs(DoublePass));
   {$ENDIF}
   DoBuildReport;
-  {$IFDEF DebugLR}
-  DebugLn('21');
-  {$ENDIF}
   if FinalPass then
   begin
     if Terminated then
-      frProgressForm.ModalResult := mrCancel
+      frProgressForm.ModalDone(mrCancel)
     else
-      frProgressForm.ModalResult := mrOk;
+      frProgressForm.ModalDone(mrOk);
   end
   else
   begin
-    {$IFDEF DebugLR}
-    DebugLn('22');
-    {$ENDIF}
-
     FirstPassTerminated := Terminated;
     SavedAllPages := EMFPages.Count;
     DoublePass := False;
     FirstTime := False;
     DoPrepareReport; // do final pass
     DoublePass := True;
-    {$IFDEF DebugLR}
-    DebugLn('23');
-    {$ENDIF}
   end;
+  {$IFDEF DebugLR}
+  DebugLn('TfrReport.BuildBeforeModal DONE');
+  {$ENDIF}
 end;
 
 function TfrReport.PrepareReport: Boolean;

components/lazreport/source/lr_progr.lfm

@@ -3,8 +3,7 @@ object frProgressForm: TfrProgressForm
   Height = 106
   Top = 137
   Width = 278
-  HorzScrollBar.Page = 277
+  ActiveControl = Button1
-  VertScrollBar.Page = 105
   BorderStyle = bsDialog
   Caption = 'frProgressForm'
   ClientHeight = 106
@@ -13,11 +12,12 @@ object frProgressForm: TfrProgressForm
   Font.Name = 'MS Sans Serif'
   OnCreate = FormCreate
   Position = poScreenCenter
+  LCLVersion = '0.9.27'
   object Label1: TLabel
     Left = 20
-    Height = 14
+    Height = 16
     Top = 32
-    Width = 7
+    Width = 9
     Alignment = taCenter
     Caption = '1'
     ParentColor = False
@@ -34,4 +34,11 @@ object frProgressForm: TfrProgressForm
     OnClick = Button1Click
     TabOrder = 0
   end
+  object Timer1: TTimer
+    Enabled = False
+    Interval = 10
+    OnTimer = Timer1Timer
+    left = 224
+    top = 24
+  end
 end

components/lazreport/source/lr_progr.lrs

@@ -2,13 +2,15 @@
 
 LazarusResources.Add('TfrProgressForm','FORMDATA',[
   'TPF0'#15'TfrProgressForm'#14'frProgressForm'#4'Left'#3#235#0#6'Height'#2'j'#3
-  +'Top'#3#137#0#5'Width'#3#22#1#18'HorzScrollBar.Page'#3#21#1#18'VertScrollBar'
+  +'Top'#3#137#0#5'Width'#3#22#1#13'ActiveControl'#7#7'Button1'#11'BorderStyle'
-  +'.Page'#2'i'#11'BorderStyle'#7#8'bsDialog'#7'Caption'#6#14'frProgressForm'#12
+  +#7#8'bsDialog'#7'Caption'#6#14'frProgressForm'#12'ClientHeight'#2'j'#11'Clie'
-  +'ClientHeight'#2'j'#11'ClientWidth'#3#22#1#11'Font.Height'#2#245#9'Font.Name'
+  +'ntWidth'#3#22#1#11'Font.Height'#2#245#9'Font.Name'#6#13'MS Sans Serif'#8'On'
-  +#6#13'MS Sans Serif'#8'OnCreate'#7#10'FormCreate'#8'Position'#7#14'poScreenC'
+  +'Create'#7#10'FormCreate'#8'Position'#7#14'poScreenCenter'#10'LCLVersion'#6#6
-  +'enter'#0#6'TLabel'#6'Label1'#4'Left'#2#20#6'Height'#2#14#3'Top'#2' '#5'Widt'
+  +'0.9.27'#0#6'TLabel'#6'Label1'#4'Left'#2#20#6'Height'#2#16#3'Top'#2' '#5'Wid'
-  +'h'#2#7#9'Alignment'#7#8'taCenter'#7'Caption'#6#1'1'#11'ParentColor'#8#0#0#7
+  +'th'#2#9#9'Alignment'#7#8'taCenter'#7'Caption'#6#1'1'#11'ParentColor'#8#0#0#7
   +'TButton'#7'Button1'#4'Left'#2'd'#6'Height'#2#25#3'Top'#2'D'#5'Width'#2'K'#25
   +'BorderSpacing.InnerBorder'#2#4#6'Cancel'#9#7'Caption'#6#6'Cancel'#11'ModalR'
-  +'esult'#2#2#7'OnClick'#7#12'Button1Click'#8'TabOrder'#2#0#0#0#0
+  +'esult'#2#2#7'OnClick'#7#12'Button1Click'#8'TabOrder'#2#0#0#0#6'TTimer'#6'Ti'
+  +'mer1'#7'Enabled'#8#8'Interval'#2#10#7'OnTimer'#7#11'Timer1Timer'#4'left'#3
+  +#224#0#3'top'#2#24#0#0#0
 ]);

components/lazreport/source/lr_progr.pas

@@ -21,7 +21,7 @@ uses
   
   LCLProc,
 
-  LR_Class, LR_Const;
+  LR_Const, LR_Class, ExtCtrls;
 
 const
   CM_BeforeModal = WM_USER + 1;
@@ -33,20 +33,22 @@ type
   TfrProgressForm = class(TForm)
     Button1: TButton;
     Label1: TLabel;
+    Timer1: TTimer;
     procedure Button1Click(Sender: TObject);
     procedure FormCreate(Sender: TObject);
+    procedure Timer1Timer(Sender: TObject);
   private
     { Private declarations }
     fDoc: TfrReport;
     fOnBeforeModal: TNotifyEvent;
-
     procedure DoBeforeModal(Data: ptrint);
   public
     { Public declarations }
     FirstCaption: String;
-    property OnBeforeModal: TNotifyEvent read FOnBeforeModal write FOnBeforeModal;
-
     function Show_Modal(Doc: TfrReport): Word;
+    procedure ModalDone(AModalResult: TModalResult);
+
+    property OnBeforeModal: TNotifyEvent read FOnBeforeModal write FOnBeforeModal;
   end;
 
 var
@@ -63,15 +65,14 @@ begin
   Visible:=False;
   Enabled:=True;
   ModalResult:=mrNone;
-  {$IFDEF DebugLR}
-  DebugLn('A1');
-  {$ENDIF}
   InitializeWnd;
-  
   Result:=ShowModal;
-  {$IFDEF DebugLR}
+end;
-  DebugLn('A2');
+
-  {$ENDIF}
+procedure TfrProgressForm.ModalDone(AModalResult: TModalResult);
+begin
+  ModalResult := AModalResult;
+  Timer1.Enabled:=true;
 end;
 
 procedure TfrProgressForm.Button1Click(Sender: TObject);
@@ -91,6 +92,11 @@ begin
   Button1.Caption:=sCancel;
 end;
 
+procedure TfrProgressForm.Timer1Timer(Sender: TObject);
+begin
+  Timer1.Enabled:=false;
+end;
+
 initialization
   {$I lr_progr.lrs}