paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-19 09:59:29 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ Added progressevent

Browse Source
This commit is contained in:
michael 2003-06-30 19:35:20 +00:00
parent b7ae35ec3b
commit 7b37f2dd4a
3 changed files with 37 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
fcl/image/fphandler.inc
View File

@ -170,6 +170,18 @@ begin
inherited create;
end;
procedure TFPCustomImageHandler.Progress(Stage: TProgressStage;
PercentDone: Byte; RedrawNow: Boolean; const R: TRect;
const Msg: AnsiString; var Continue: Boolean);
begin
If Assigned(FOnProgress) then
FOnProgress(Self,Stage,PercentDone,RedrawNow,R,Msg,Continue)
else If Assigned(FImage) then
// It is debatable whether we should pass ourselves or the image ?
FImage.Progress(Self,Stage,PercentDone,RedrawNow,R,Msg,Continue);
end;
{ TFPCustomImageReader }
constructor TFPCustomImageReader.Create;

8
fcl/image/fpimage.inc
View File

@ -217,6 +217,14 @@ begin
FPImgError (StrInvalidIndex,[ErrorText[StrImageY],y]);
end;
Procedure TFPCustomImage.Progress(Sender: TObject; Stage: TProgressStage;
PercentDone: Byte; RedrawNow: Boolean; const R: TRect;
const Msg: AnsiString; var Continue: Boolean);
begin
If Assigned(FOnProgress) then
FonProgress(Sender,Stage,PercentDone,RedrawNow,R,Msg,Continue);
end;
{ TFPMemoryImage }

17
fcl/image/fpimage.pp
View File

@ -34,6 +34,14 @@ type
TFPColorArray = array [0..maxint] of TFPColor;
PFPColorArray = ^TFPColorArray;
TFPImgProgressStage = (psStarting, psRunning, psEnding);
TFPImgProgressEvent = procedure (Sender: TObject; Stage: TFPImgProgressStage;
PercentDone: Byte; RedrawNow: Boolean; const R: TRect;
const Msg: AnsiString; var Continue : Boolean) of object;
// Delphi compatibility
TProgressStage = TFPImgProgressStage;
TProgressEvent = TFPImgProgressEvent;
TFPPalette = class
private
FData : PFPColorArray;
@ -57,6 +65,7 @@ type
TFPCustomImage = class
private
FOnProgress : TFPImgProgressEvent;
FExtra : TStringlist;
FPalette : TFPPalette;
FHeight, FWidth : integer;
@ -82,6 +91,9 @@ type
function GetInternalColor (x,y:integer) : TFPColor; virtual;
procedure SetInternalPixel (x,y:integer; Value:integer); virtual; abstract;
function GetInternalPixel (x,y:integer) : integer; virtual; abstract;
procedure Progress(Sender: TObject; Stage: TProgressStage;
PercentDone: Byte; RedrawNow: Boolean; const R: TRect;
const Msg: AnsiString; var Continue: Boolean); Virtual;
public
constructor create (AWidth,AHeight:integer); virtual;
destructor destroy; override;
@ -105,6 +117,7 @@ type
property ExtraKey [index:integer] : string read GetExtraKey write SetExtraKey;
procedure RemoveExtra (const key:string);
function ExtraCount : integer;
property OnProgress: TFPImgProgressEvent read FOnProgress write FOnProgress;
end;
TFPCustomImageClass = class of TFPCustomImage;
@ -125,13 +138,17 @@ type
TFPCustomImageHandler = class
private
FOnProgress : TFPImgProgressEvent;
FStream : TStream;
FImage : TFPCustomImage;
protected
procedure Progress(Stage: TProgressStage; PercentDone: Byte; RedrawNow: Boolean; const R: TRect;
const Msg: AnsiString; var Continue: Boolean); Virtual;
property TheStream : TStream read FStream;
property TheImage : TFPCustomImage read FImage;
public
constructor Create; virtual;
Property OnProgress : TFPImgProgressEvent Read FOnProgress Write FOnProgress;
end;
TFPCustomImageReader = class (TFPCustomImageHandler)