paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-09 12:35:55 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL: Changeable jpeg compression quality, add TJpegImage.Compress (issue #30408, patch by Nur Cholif Murtadho)

Browse Source 
git-svn-id: trunk@59051 -
This commit is contained in:
wp 2018-09-17 21:19:59 +00:00
parent b01af43fc3
commit c0c477a971
2 changed files with 24 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
lcl/graphics.pp
View File

@ -1763,6 +1763,7 @@ type
FPerformance: TJPEGPerformance;
FProgressiveEncoding: boolean;
FQuality: TJPEGQualityRange;
procedure SetCompressionQuality(AValue: TJPEGQualityRange);
protected
procedure InitializeReader(AImage: TLazIntfImage; AReader: TFPCustomImageReader); override;
procedure InitializeWriter(AImage: TLazIntfImage; AWriter: TFPCustomImageWriter); override;
@ -1772,10 +1773,11 @@ type
class function GetSharedImageClass: TSharedRasterImageClass; override;
public
constructor Create; override;
procedure Compress;
class function IsStreamFormatSupported(Stream: TStream): Boolean; override;
class function GetFileExtensions: string; override;
public
property CompressionQuality: TJPEGQualityRange read FQuality write FQuality;
property CompressionQuality: TJPEGQualityRange read FQuality write SetCompressionQuality;
property GrayScale: Boolean read FGrayScale;
property ProgressiveEncoding: boolean read FProgressiveEncoding;
property Performance: TJPEGPerformance read FPerformance write FPerformance;

21
lcl/include/jpegimage.inc
View File

@ -23,6 +23,21 @@ begin
FQuality := 75;
end;
procedure TJPEGImage.Compress;
var
TempStream: TMemoryStream;
begin
TempStream := TMemoryStream.Create;
try
FreeSaveStream;
SaveToStream(TempStream);
TempStream.Position := 0;
LoadFromStream(TempStream);
finally
TempStream.Free;
end;
end;
class function TJPEGImage.IsStreamFormatSupported(Stream: TStream): Boolean;
var
Pos: Int64;
@ -78,3 +93,9 @@ begin
TFPWriterJPEG(AWriter).CompressionQuality := CompressionQuality;
end;
procedure TJPEGImage.SetCompressionQuality(AValue: TJPEGQualityRange);
begin
if FQuality = AValue then Exit;
FQuality := AValue;
FreeSaveStream;
end;