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
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
|
{
fpGUI - Free Pascal GUI Library
Image I/O interface declarations
Copyright (C) 2000 - 2006 See the file AUTHORS.txt, included in this
distribution, for details of the copyright.
See the file COPYING.modifiedLGPL, included in this distribution,
for details about redistributing fpGUI.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
}
unit ImageIO;
{$IFDEF Debug}
{$ASSERTIONS On}
{$ENDIF}
interface
uses
SysUtils
,Classes
,GFXBase
;
resourcestring
SImgOutOfData = 'No more data available for image';
SImgUnsupportedPixelFormat = 'Unsupported pixel format in image';
type
EImgError = class(Exception);
EImgOutOfData = class(EImgError)
public
constructor Create;
end;
EImgUnsupportedPixelFormat = class(EImgError)
public
constructor Create;
end;
// Image reading
TImageReaderClass = class of TImageReader;
TImageReaderState = (irsStart, irsInHeader, irsHeaderRead,
irsInImage, irsFinished);
TSegmentEvent = procedure(Sender: TObject; StartY, Height: Integer) of object;
TImageReader = class
private
FState: TImageReaderState;
{ Needed for reading of image data. These values must be initialized by
the user via SetImageSegmentBuffer }
FSegmentData: Pointer;
FSegmentStride: LongWord;
FSegmentHeight: Integer;
FSegmentSize: LongWord; // Size in bytes
FOnHeader: TNotifyEvent;
FOnSegment: TSegmentEvent;
FOnImage: TNotifyEvent;
protected
// Image properties, only available after OnHeaderRead event
FWidth: Integer;
FHeight: Integer;
FPixelFormat: TGfxPixelFormat;
FPaletteSize: Integer;
FPalette: PGfxColor;
procedure HeaderFinished;
procedure SegmentFinished(AStartY, AHeight: Integer);
procedure ImageFinished;
procedure DoProcessHeaderData(AStream: TStream); virtual; abstract;
function DoGetImageSegmentStartY(ASegmentHeight: Integer): Integer; virtual; abstract;
procedure InitImageReading; virtual;
procedure DoProcessImageData(AStream: TStream); virtual; abstract;
public
constructor Create; virtual;
procedure ProcessHeaderData(AStream: TStream);
function GetImageSegmentStartY(ASegmentHeight: Integer): Integer;
procedure SetImageSegmentBuffer(AData: Pointer; AStride: LongWord; ASegmentHeight: Integer);
procedure ProcessImageData(AStream: TStream);
property State: TImageReaderState read FState;
property Width: Integer read FWidth;
property Height: Integer read FHeight;
property PixelFormat: TGfxPixelFormat read FPixelFormat;
property PaletteSize: Integer read FPaletteSize;
property Palette: PGfxColor read FPalette;
property SegmentData: Pointer read FSegmentData;
property SegmentStride: LongWord read FSegmentStride;
property SegmentHeight: Integer read FSegmentHeight;
property SegmentSize: LongWord read FSegmentSize;
property OnHeader: TNotifyEvent read FOnHeader write FOnHeader;
property OnSegment: TSegmentEvent read FOnSegment write FOnSegment;
property OnImage: TNotifyEvent read FOnImage write FOnImage;
end;
implementation
constructor EImgOutOfData.Create;
begin
inherited Create(SImgOutOfData);
end;
constructor EImgUnsupportedPixelFormat.Create;
begin
inherited Create(SImgUnsupportedPixelFormat);
end;
{ TImageReader }
constructor TImageReader.Create;
begin
inherited Create;
end;
procedure TImageReader.ProcessHeaderData(AStream: TStream);
begin
ASSERT(FState in [irsStart, irsInHeader]);
if State = irsStart then
FState := irsInHeader;
DoProcessHeaderData(AStream);
end;
function TImageReader.GetImageSegmentStartY(ASegmentHeight: Integer): Integer;
begin
ASSERT(State in [irsHeaderRead, irsInImage]);
Result := DoGetImageSegmentStartY(ASegmentHeight);
end;
procedure TImageReader.SetImageSegmentBuffer(AData: Pointer; AStride: LongWord;
ASegmentHeight: Integer);
begin
ASSERT(State in [irsHeaderRead, irsInImage]);
FSegmentData := AData;
FSegmentStride := AStride;
FSegmentHeight := ASegmentHeight;
FSegmentSize := SegmentStride * SegmentHeight;
end;
procedure TImageReader.ProcessImageData(AStream: TStream);
begin
if State = irsFinished then
exit;
ASSERT(State in [irsHeaderRead, irsInImage]);
if State = irsHeaderRead then
begin
FState := irsInImage;
InitImageReading;
end;
DoProcessImageData(AStream);
end;
procedure TImageReader.HeaderFinished;
begin
ASSERT(FState = irsInHeader);
FState := irsHeaderRead;
if Assigned(OnHeader) then
OnHeader(Self);
end;
procedure TImageReader.SegmentFinished(AStartY, AHeight: Integer);
begin
ASSERT(FState = irsInImage);
if Assigned(OnSegment) then
OnSegment(Self, AStartY, AHeight);
end;
procedure TImageReader.ImageFinished;
begin
ASSERT(FState = irsInImage);
FState := irsFinished;
if Assigned(OnImage) then
OnImage(Self);
end;
procedure TImageReader.InitImageReading;
begin
// Do nothing
end;
end.
|
