1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
|
{%MainUnit ../graphics.pp}
{******************************************************************************
TJPegImage
******************************************************************************
*****************************************************************************
This file is part of the Lazarus Component Library (LCL)
See the file COPYING.modifiedLGPL.txt, included in this distribution,
for details about the license.
*****************************************************************************
}
{ TJPEGImage }
constructor TJPEGImage.Create;
begin
inherited Create;
FPerformance := jpBestQuality;
FProgressiveEncoding := False;
FGrayScale := False;
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;
SOI: Word;
begin
Pos := Stream.Position;
try
Stream.Read(SOI, SizeOf(SOI));
Result := SOI = NtoLE($D8FF);
finally
Stream.Position := Pos;
end;
end;
procedure TJPEGImage.FinalizeReader(AReader: TFPCustomImageReader);
begin
FProgressiveEncoding := TFPReaderJPEG(AReader).ProgressiveEncoding;
FGrayScale := TFPReaderJPEG(AReader).GrayScale;
inherited;
end;
class function TJPEGImage.GetFileExtensions: string;
begin
Result := 'jpeg;jpg;jpe;jfif';
end;
class function TJPEGImage.GetReaderClass: TFPCustomImageReaderClass;
begin
Result := TFPReaderJPEG;
end;
class function TJPEGImage.GetSharedImageClass: TSharedRasterImageClass;
begin
Result := TSharedJPEGImage;
end;
class function TJPEGImage.GetWriterClass: TFPCustomImageWriterClass;
begin
Result := TFPWriterJPEG;
end;
procedure TJPEGImage.InitializeReader(AImage: TLazIntfImage; AReader: TFPCustomImageReader);
begin
inherited;
TFPReaderJPEG(AReader).MinHeight := MinHeight;
TFPReaderJPEG(AReader).MinWidth := MinWidth;
TFPReaderJPEG(AReader).Performance := Performance;
TFPReaderJPEG(AReader).Scale := Scale;
TFPReaderJPEG(AReader).Smoothing := Smoothing;
end;
procedure TJPEGImage.InitializeWriter(AImage: TLazIntfImage; AWriter: TFPCustomImageWriter);
begin
inherited;
if not(AWriter is TFPWriterJPEG) then Exit;
TFPWriterJPEG(AWriter).ProgressiveEncoding := ProgressiveEncoding;
TFPWriterJPEG(AWriter).CompressionQuality := CompressionQuality;
TFPWriterJPEG(AWriter).GrayScale := GrayScale;
end;
procedure TJPEGImage.SetCompressionQuality(AValue: TJPEGQualityRange);
begin
if FQuality = AValue then Exit;
FQuality := AValue;
FreeSaveStream;
end;
procedure TJPEGImage.SetGrayScale(AValue: Boolean);
begin
if FGrayScale = AValue then Exit;
FGrayScale := AValue;
FreeSaveStream;
end;
procedure TJPEGImage.SetProgressiveEncoding(AValue: boolean);
begin
if FProgressiveEncoding = AValue then Exit;
FProgressiveEncoding := AValue;
FreeSaveStream;
end;
|
