mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-05 16:08:01 +02:00
* Make compression struct accessible to descendants. Fixes issue #40327
This commit is contained in:
parent
fa735ba7b2
commit
ab3916b0f8
@ -65,6 +65,7 @@ type
|
|||||||
procedure InternalRead(Str: TStream; Img: TFPCustomImage); override;
|
procedure InternalRead(Str: TStream; Img: TFPCustomImage); override;
|
||||||
function InternalCheck(Str: TStream): boolean; override;
|
function InternalCheck(Str: TStream): boolean; override;
|
||||||
class function InternalSize(Str:TStream): TPoint; override;
|
class function InternalSize(Str:TStream): TPoint; override;
|
||||||
|
property CompressInfo : jpeg_decompress_struct Read Finfo Write FInfo;
|
||||||
public
|
public
|
||||||
constructor Create; override;
|
constructor Create; override;
|
||||||
destructor Destroy; override;
|
destructor Destroy; override;
|
||||||
|
@ -38,7 +38,9 @@ type
|
|||||||
FQuality: TFPJPEGCompressionQuality;
|
FQuality: TFPJPEGCompressionQuality;
|
||||||
FProgressMgr: TFPJPEGProgressManager;
|
FProgressMgr: TFPJPEGProgressManager;
|
||||||
protected
|
protected
|
||||||
|
procedure InitWriting; virtual;
|
||||||
procedure InternalWrite(Str: TStream; Img: TFPCustomImage); override;
|
procedure InternalWrite(Str: TStream; Img: TFPCustomImage); override;
|
||||||
|
property CompressInfo : jpeg_compress_struct Read FInfo Write FInfo;
|
||||||
public
|
public
|
||||||
constructor Create; override;
|
constructor Create; override;
|
||||||
destructor Destroy; override;
|
destructor Destroy; override;
|
||||||
@ -95,23 +97,24 @@ end;
|
|||||||
|
|
||||||
{ TFPWriterJPEG }
|
{ TFPWriterJPEG }
|
||||||
|
|
||||||
|
|
||||||
|
procedure TFPWriterJPEG.InitWriting;
|
||||||
|
begin
|
||||||
|
FError := jpeg_std_error;
|
||||||
|
FInfo := Default(jpeg_compress_struct);
|
||||||
|
jpeg_create_compress(@FInfo);
|
||||||
|
FInfo.err := jerror.jpeg_std_error(FError);
|
||||||
|
FInfo.progress := @FProgressMgr.pub;
|
||||||
|
FProgressMgr.pub.progress_monitor := @ProgressCallback;
|
||||||
|
FProgressMgr.instance := Self;
|
||||||
|
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TFPWriterJPEG.InternalWrite(Str: TStream; Img: TFPCustomImage);
|
procedure TFPWriterJPEG.InternalWrite(Str: TStream; Img: TFPCustomImage);
|
||||||
var
|
var
|
||||||
MemStream: TMemoryStream;
|
MemStream: TMemoryStream;
|
||||||
Continue: Boolean;
|
Continue: Boolean;
|
||||||
|
|
||||||
procedure InitWriting;
|
|
||||||
begin
|
|
||||||
FillChar(FInfo, sizeof(FInfo), 0);
|
|
||||||
FError := jpeg_std_error;
|
|
||||||
FInfo.err := jerror.jpeg_std_error(FError);
|
|
||||||
|
|
||||||
jpeg_create_compress(@FInfo);
|
|
||||||
FProgressMgr.pub.progress_monitor := @ProgressCallback;
|
|
||||||
FProgressMgr.instance := Self;
|
|
||||||
FInfo.progress := @FProgressMgr.pub;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure SetDestination;
|
procedure SetDestination;
|
||||||
begin
|
begin
|
||||||
if Str is TMemoryStream then
|
if Str is TMemoryStream then
|
||||||
|
Loading…
Reference in New Issue
Block a user