[Instantobjects-cvscommit] Source/Core InstantPresentation.pas,1.4,1.5

[Andrea P. <and...@us...>]

Update of /cvsroot/instantobjects/Source/Core
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv29550

Modified Files:
	InstantPresentation.pas 
Log Message:
Added OnProgress event on TInstantSelector

Index: InstantPresentation.pas
===================================================================
RCS file: /cvsroot/instantobjects/Source/Core/InstantPresentation.pas,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** InstantPresentation.pas	8 Sep 2004 21:59:52 -0000	1.4
--- InstantPresentation.pas	10 Sep 2004 10:13:04 -0000	1.5
***************
*** 25,33 ****
   *
   * Contributor(s):
!  * Carlo Barazzetta, Adrea Petrelli: porting Kylix
   * Carlo Barazzetta:
   * - Exposer Undo virtual and access to UndoBuffer
   * - Exposer OnAddClassFieldDef event 
   * - Added Currency and Graphic support to exposer
   * ***** END LICENSE BLOCK ***** *)
  
--- 25,35 ----
   *
   * Contributor(s):
!  * Carlo Barazzetta, Andrea Petrelli: porting Kylix
   * Carlo Barazzetta:
   * - Exposer Undo virtual and access to UndoBuffer
   * - Exposer OnAddClassFieldDef event 
   * - Added Currency and Graphic support to exposer
+  * Andrea Petrelli:
+  * - Added OnProgress event on TInstantSelector
   * ***** END LICENSE BLOCK ***** *)
  
***************
*** 48,52 ****
  
  type
!   TInstantAddClassFieldDefEvent = procedure (const FieldName : string; var BreakProcess : boolean) of object; 
    TInstantChangeType = (ctAppearance, ctData);
    TInstantAccessMode = (amObject, amContent);
--- 50,54 ----
  
  type
!   TInstantAddClassFieldDefEvent = procedure (const FieldName : string; var BreakProcess : boolean) of object;
    TInstantChangeType = (ctAppearance, ctData);
    TInstantAccessMode = (amObject, amContent);
***************
*** 73,76 ****
--- 75,79 ----
      FOnCompare: TInstantCompareObjectsEvent;
      FOnLimit: TInstantLimitObjectsEvent;
+     FOnProgress: TInstantProgressEvent;
      procedure DestroyView;
      function GetAltered: Boolean;
***************
*** 91,94 ****
--- 94,98 ----
      procedure SetOnCompare(Value: TInstantCompareObjectsEvent);
      procedure SetOnLimit(Value: TInstantLimitObjectsEvent);
+     procedure SetOnProgress(const Value: TInstantProgressEvent);
      procedure SetSorted(Value: Boolean);
      property View: TList read GetView;
***************
*** 99,102 ****
--- 103,107 ----
      procedure Changed(ChangeType: TInstantChangeType); virtual;
      procedure DoLimit(AObject: TObject; var Accept: Boolean);
+     procedure DoProgress(Sender: TObject; Count: Integer; var Continue: Boolean);
      function GetConnector: TInstantConnector; virtual;
      function GetMode: TInstantAccessMode; virtual;
***************
*** 114,118 ****
      function InternalInsertObject(Index: Integer; AObject: TObject): Integer; virtual;
      procedure InternalRefreshObjects; virtual;
!     procedure InternalReleaseObject(AObject: TObject); virtual; 
      function InternalRemoveObject(AObject: TObject): Integer; virtual;
      property HasSubject: Boolean read GetHasSubject;
--- 119,123 ----
      function InternalInsertObject(Index: Integer; AObject: TObject): Integer; virtual;
      procedure InternalRefreshObjects; virtual;
!     procedure InternalReleaseObject(AObject: TObject); virtual;
      function InternalRemoveObject(AObject: TObject): Integer; virtual;
      property HasSubject: Boolean read GetHasSubject;
***************
*** 161,164 ****
--- 166,170 ----
      property OnCompare: TInstantCompareObjectsEvent read FOnCompare write SetOnCompare;
      property OnLimit: TInstantLimitObjectsEvent read FOnLimit write SetOnLimit;
+     property OnProgress: TInstantProgressEvent read FOnProgress write SetOnProgress;
    end;
  
***************
*** 220,225 ****
      FOnInitFieldDef: TInstantFieldDefEvent;
      FOnLimit: TInstantLimitObjectsEvent;
      FOnTranslate: TInstantFieldTranslateEvent;
!     FOnAddClassFieldDef: TInstantAddClassFieldDefEvent; 
      procedure AccessorChanged(Sender: TObject; ChangeType: TInstantChangeType);
      procedure CheckClass(AObject: TObject);
--- 226,232 ----
      FOnInitFieldDef: TInstantFieldDefEvent;
      FOnLimit: TInstantLimitObjectsEvent;
+     FOnProgress: TInstantProgressEvent;
      FOnTranslate: TInstantFieldTranslateEvent;
!     FOnAddClassFieldDef: TInstantAddClassFieldDefEvent;
      procedure AccessorChanged(Sender: TObject; ChangeType: TInstantChangeType);
      procedure CheckClass(AObject: TObject);
***************
*** 243,246 ****
--- 250,254 ----
      function GetOnCompare: TInstantCompareObjectsEvent;
      function GetOnLimit: TInstantLimitObjectsEvent;
+     function GetOnProgress: TInstantProgressEvent;
      procedure GotoActiveRecord;
      procedure GotoRecord(ARecNo: Integer);
***************
*** 261,266 ****
      procedure SetOnCompare(Value: TInstantCompareObjectsEvent);
      procedure SetOnLimit(Value: TInstantLimitObjectsEvent);
      procedure SetSorted(Value: Boolean);
!     function GetUndoBuffer: PChar; 
    protected
      { IProviderSupport }
--- 269,275 ----
      procedure SetOnCompare(Value: TInstantCompareObjectsEvent);
      procedure SetOnLimit(Value: TInstantLimitObjectsEvent);
+     procedure SetOnProgress(const Value: TInstantProgressEvent);
      procedure SetSorted(Value: Boolean);
!     function GetUndoBuffer: PChar;
    protected
      { IProviderSupport }
***************
*** 361,368 ****
      procedure SetFiltered(Value: Boolean); override;
      procedure SetRecNo(Value: Integer); override;
!     procedure Undo; virtual; 
      procedure UpdateCalcFields;
      procedure WriteProperty(Field: TField; Instance: TObject; Value: Variant);
!     function BreakThorough( const FieldName : string ) : boolean; virtual; 
      property Accessor: TInstantAccessor read GetAccessor;
      property ContainerName: string read FContainerName write SetContainerName;
--- 370,377 ----
      procedure SetFiltered(Value: Boolean); override;
      procedure SetRecNo(Value: Integer); override;
!     procedure Undo; virtual;
      procedure UpdateCalcFields;
      procedure WriteProperty(Field: TField; Instance: TObject; Value: Variant);
!     function BreakThorough( const FieldName : string ) : boolean; virtual;
      property Accessor: TInstantAccessor read GetAccessor;
      property ContainerName: string read FContainerName write SetContainerName;
***************
*** 415,419 ****
      property Objects[Index: Integer]: TObject read GetObjects;
      property TotalCount: Integer read GetTotalCount;
!     property UndoBuffer: PChar read GetUndoBuffer; 
    published
      property FieldOptions: TInstantFieldOptions read FFieldOptions write SetFieldOptions default [foThorough];
--- 424,428 ----
      property Objects[Index: Integer]: TObject read GetObjects;
      property TotalCount: Integer read GetTotalCount;
!     property UndoBuffer: PChar read GetUndoBuffer;
    published
      property FieldOptions: TInstantFieldOptions read FFieldOptions write SetFieldOptions default [foThorough];
***************
*** 448,453 ****
      property OnInitFieldDef: TInstantFieldDefEvent read FOnInitFieldDef write FOnInitFieldDef;
      property OnLimit: TInstantLimitObjectsEvent read GetOnLimit write SetOnLimit;
      property OnTranslate: TInstantFieldTranslateEvent read FOnTranslate write FOnTranslate;
!     property OnAddClassFieldDef : TInstantAddClassFieldDefEvent read FOnAddClassFieldDef write FOnAddClassFieldDef; 
    end;
  
--- 457,463 ----
      property OnInitFieldDef: TInstantFieldDefEvent read FOnInitFieldDef write FOnInitFieldDef;
      property OnLimit: TInstantLimitObjectsEvent read GetOnLimit write SetOnLimit;
+     property OnProgress: TInstantProgressEvent read GetOnProgress write SetOnProgress;
      property OnTranslate: TInstantFieldTranslateEvent read FOnTranslate write FOnTranslate;
!     property OnAddClassFieldDef : TInstantAddClassFieldDefEvent read FOnAddClassFieldDef write FOnAddClassFieldDef;
    end;
  
***************
*** 628,632 ****
  procedure InstantRegisterAccessorClass(AClass: TInstantAccessorClass);
  procedure InstantUnregisterAccessorClass(AClass: TInstantAccessorClass);
! function ExposerGetUndoBuffer(Exposer : TInstantCustomExposer) : PChar; 
  
  implementation
--- 638,642 ----
  procedure InstantRegisterAccessorClass(AClass: TInstantAccessorClass);
  procedure InstantUnregisterAccessorClass(AClass: TInstantAccessorClass);
! function ExposerGetUndoBuffer(Exposer : TInstantCustomExposer) : PChar;
  
  implementation
***************
*** 981,984 ****
--- 991,1001 ----
  end;
  
+ procedure TInstantAccessor.DoProgress(Sender: TObject; Count: Integer;
+   var Continue: Boolean);
+ begin
+   if Assigned(FOnProgress) then
+     FOnProgress(Self, Count, Continue);
+ end;
+ 
  procedure TInstantAccessor.EnableChanges;
  begin
***************
*** 1021,1025 ****
  function TInstantAccessor.GetAltered: Boolean;
  begin
!   Result := Limited or Sorted;
  end;
  
--- 1038,1042 ----
  function TInstantAccessor.GetAltered: Boolean;
  begin
!   Result := Limited or Sorted or Assigned(FOnProgress);
  end;
  
***************
*** 1107,1117 ****
--- 1124,1140 ----
  var
    I: Integer;
+   Continue:Boolean;
  begin
    if not Assigned(FView) then
    begin
+     Continue:=True;
      FView := TList.Create;
      FView.Capacity := InternalObjectCount;
      for I := 0 to Pred(InternalObjectCount) do
+     begin
+       DoProgress(InternalObjects[I], I+1, Continue);
+       if not Continue then Break;
        AddToView(InternalObjects[I]);
+     end;
    end;
    Result := FView;
***************
*** 1379,1382 ****
--- 1402,1415 ----
  end;
  
+ procedure TInstantAccessor.SetOnProgress(
+   const Value: TInstantProgressEvent);
+ begin
+   if @Value <> @FOnProgress then
+   begin
+     FOnProgress := Value;
+     RefreshView;
+   end;
+ end;
+ 
  procedure TInstantAccessor.SetSorted(Value: Boolean);
  begin
***************
*** 2261,2264 ****
--- 2294,2305 ----
  end;
  
+ function TInstantCustomExposer.GetOnProgress: TInstantProgressEvent;
+ begin
+   if HasAccessor then
+     Result := Accessor.OnProgress
+   else
+     Result := FOnProgress;
+ end;
+ 
  function TInstantCustomExposer.GetRecInfo(Buffer: PChar): PRecInfo;
  begin
***************
*** 2426,2429 ****
--- 2467,2471 ----
        OnCompare := Self.FOnCompare;
        OnLimit := Self.FOnLimit;
+       OnProgress := Self.FOnProgress;
        ObjectClass := Self.FObjectClass;
        ObjectClassName := Self.FObjectClassName;
***************
*** 3429,3432 ****
--- 3471,3485 ----
  end;
  
+ procedure TInstantCustomExposer.SetOnProgress(
+   const Value: TInstantProgressEvent);
+ begin
+   if @Value <> @OnProgress then
+   begin
+     FOnProgress := Value;
+     if HasAccessor then
+       Accessor.OnProgress := FOnProgress;
+   end;
+ end;
+ 
  procedure TInstantCustomExposer.SetRecNo(Value: Integer);
  begin