1 | unit BGRAIconCursor;
|
---|
2 |
|
---|
3 | {$mode objfpc}{$H+}
|
---|
4 |
|
---|
5 | interface
|
---|
6 |
|
---|
7 | uses
|
---|
8 | Classes, SysUtils, BGRAMultiFileType, BGRABitmapTypes;
|
---|
9 |
|
---|
10 | type
|
---|
11 | { TBGRAIconCursorEntry }
|
---|
12 |
|
---|
13 | TBGRAIconCursorEntry = class(TMultiFileEntry)
|
---|
14 | protected
|
---|
15 | FWidth,FHeight,FBitDepth: integer;
|
---|
16 | FExtension: string;
|
---|
17 | FContent: TStream;
|
---|
18 | FHotSpot: TPoint;
|
---|
19 | function GetName: utf8string; override;
|
---|
20 | procedure SetName({%H-}AValue: utf8string); override;
|
---|
21 | function GetExtension: utf8string; override;
|
---|
22 | function GetFileSize: int64; override;
|
---|
23 | public
|
---|
24 | constructor Create(AContainer: TMultiFileContainer; AExtension: string; AInfo: TQuickImageInfo; AContent: TStream);
|
---|
25 | class function TryCreate(AContainer: TMultiFileContainer; AContent: TStream): TBGRAIconCursorEntry;
|
---|
26 | destructor Destroy; override;
|
---|
27 | function CopyTo(ADestination: TStream): int64; override;
|
---|
28 | function GetBitmap: TBGRACustomBitmap;
|
---|
29 | property Width: integer read FWidth;
|
---|
30 | property Height: integer read FHeight;
|
---|
31 | property BitDepth: integer read FBitDepth;
|
---|
32 | property HotSpot: TPoint read FHotSpot write FHotSpot;
|
---|
33 | end;
|
---|
34 |
|
---|
35 | { TBGRAIconCursor }
|
---|
36 |
|
---|
37 | TBGRAIconCursor = class(TMultiFileContainer)
|
---|
38 | private
|
---|
39 | function GetBitDepthAt(AIndex: integer): integer;
|
---|
40 | function GetHeightAt(AIndex: integer): integer;
|
---|
41 | function GetHotSpotAtAt(AIndex: integer): TPoint;
|
---|
42 | function GetWidthAt(AIndex: integer): integer;
|
---|
43 | procedure SetFileType(AValue: TBGRAImageFormat);
|
---|
44 | procedure SetHotSpotAt(AIndex: integer; AValue: TPoint);
|
---|
45 | protected
|
---|
46 | FFileType : TBGRAImageFormat;
|
---|
47 | FLoading : boolean;
|
---|
48 | function CreateEntry(AName: utf8string; AExtension: utf8string;
|
---|
49 | AContent: TStream): TMultiFileEntry; override;
|
---|
50 | function ExpectedMagic: Word;
|
---|
51 | procedure Init; override;
|
---|
52 | public
|
---|
53 | constructor Create(AFileType: TBGRAImageFormat); overload;
|
---|
54 | function Add(ABitmap: TBGRACustomBitmap; ABitDepth: integer; AOverwrite: boolean = false): integer; overload;
|
---|
55 | function Add(AContent: TStream; AOverwrite: boolean = false; AOwnStream: boolean = true): integer; overload;
|
---|
56 | procedure LoadFromStream(AStream: TStream); override;
|
---|
57 | procedure SaveToStream(ADestination: TStream); override;
|
---|
58 | function GetBitmap(AIndex: integer): TBGRACustomBitmap;
|
---|
59 | function GetBestFitBitmap(AWidth,AHeight: integer): TBGRACustomBitmap;
|
---|
60 | function IndexOf(AWidth,AHeight,ABitDepth: integer): integer; overload;
|
---|
61 | property FileType: TBGRAImageFormat read FFileType write SetFileType;
|
---|
62 | property Width[AIndex: integer]: integer read GetWidthAt;
|
---|
63 | property Height[AIndex: integer]: integer read GetHeightAt;
|
---|
64 | property BitDepth[AIndex: integer]: integer read GetBitDepthAt;
|
---|
65 | property HotSpot[AIndex: integer]: TPoint read GetHotSpotAtAt write SetHotSpotAt;
|
---|
66 | end;
|
---|
67 |
|
---|
68 | function BGRADitherIconCursor(ABitmap: TBGRACustomBitmap; ABitDepth: integer; ADithering: TDitheringAlgorithm): TBGRACustomBitmap;
|
---|
69 |
|
---|
70 | implementation
|
---|
71 |
|
---|
72 | uses BGRAWinResource, BGRAUTF8, BGRAReadPng, BGRAReadBMP, FPWriteBMP, BGRAPalette, BGRAWritePNG,
|
---|
73 | BGRAColorQuantization;
|
---|
74 |
|
---|
75 | function BGRADitherIconCursor(ABitmap: TBGRACustomBitmap; ABitDepth: integer;
|
---|
76 | ADithering: TDitheringAlgorithm): TBGRACustomBitmap;
|
---|
77 | var
|
---|
78 | frameMask, temp: TBGRACustomBitmap;
|
---|
79 | quantizer: TBGRAColorQuantizer;
|
---|
80 | maskQuantizer: TBGRAColorQuantizer;
|
---|
81 |
|
---|
82 | x,y: integer;
|
---|
83 | psrc,pdest: PBGRAPixel;
|
---|
84 | begin
|
---|
85 | if ABitDepth <= 0 then
|
---|
86 | raise exception.Create('Invalid bit depth');
|
---|
87 |
|
---|
88 | if ABitDepth <= 24 then
|
---|
89 | begin
|
---|
90 | if ABitDepth = 1 then
|
---|
91 | begin
|
---|
92 | quantizer := TBGRAColorQuantizer.Create([BGRABlack,BGRAWhite,BGRAPixelTransparent],false,3);
|
---|
93 | result := quantizer.GetDitheredBitmap(ADithering, ABitmap);
|
---|
94 | quantizer.Free;
|
---|
95 | end
|
---|
96 | else
|
---|
97 | begin
|
---|
98 | frameMask := ABitmap.GetMaskFromAlpha;
|
---|
99 | maskQuantizer := TBGRAColorQuantizer.Create([BGRABlack,BGRAWhite],false,2);
|
---|
100 | temp := maskQuantizer.GetDitheredBitmap(ADithering, frameMask);
|
---|
101 | frameMask.Free;
|
---|
102 | frameMask := temp;
|
---|
103 | maskQuantizer.Free;
|
---|
104 |
|
---|
105 | result := ABitmap.Duplicate;
|
---|
106 | result.ReplaceTransparent(BGRABlack);
|
---|
107 | result.AlphaFill(255);
|
---|
108 |
|
---|
109 | if ABitDepth <= 8 then
|
---|
110 | begin
|
---|
111 | quantizer := TBGRAColorQuantizer.Create(result,acFullChannelInPalette, 1 shl ABitDepth);
|
---|
112 | temp := quantizer.GetDitheredBitmap(daFloydSteinberg, result);
|
---|
113 | result.free;
|
---|
114 | result := temp;
|
---|
115 | quantizer.Free;
|
---|
116 | end;
|
---|
117 |
|
---|
118 | result.ApplyMask(frameMask);
|
---|
119 | frameMask.Free;
|
---|
120 | end;
|
---|
121 | end else
|
---|
122 | result := ABitmap.Duplicate;
|
---|
123 |
|
---|
124 | if Assigned(ABitmap.XorMask) then
|
---|
125 | begin
|
---|
126 | result.NeedXorMask;
|
---|
127 | for y := 0 to ABitmap.XorMask.Height-1 do
|
---|
128 | begin
|
---|
129 | psrc := ABitmap.XorMask.ScanLine[y];
|
---|
130 | pdest := result.XorMask.ScanLine[y];
|
---|
131 | for x := 0 to ABitmap.XorMask.Width-1 do
|
---|
132 | begin
|
---|
133 | if ((psrc^.red shl 1)+(psrc^.green shl 2)+psrc^.blue >= 128*(1+2+4)) then
|
---|
134 | pdest^ := BGRA(255,255,255,0);
|
---|
135 | inc(psrc);
|
---|
136 | inc(pdest);
|
---|
137 | end;
|
---|
138 | end;
|
---|
139 | end;
|
---|
140 | end;
|
---|
141 |
|
---|
142 | { TBGRAIconCursorEntry }
|
---|
143 |
|
---|
144 | constructor TBGRAIconCursorEntry.Create(AContainer: TMultiFileContainer; AExtension: string; AInfo: TQuickImageInfo;
|
---|
145 | AContent: TStream);
|
---|
146 | begin
|
---|
147 | inherited Create(AContainer);
|
---|
148 | FExtension:= AExtension;
|
---|
149 | FWidth := AInfo.Width;
|
---|
150 | FHeight:= AInfo.Height;
|
---|
151 |
|
---|
152 | // 16 bit per channel is not relevant for icon depth
|
---|
153 | if AInfo.ColorDepth >= 24 then
|
---|
154 | begin
|
---|
155 | if AInfo.AlphaDepth >= 8 then
|
---|
156 | FBitDepth := 32
|
---|
157 | else
|
---|
158 | FBitDepth := 24;
|
---|
159 | end else
|
---|
160 | FBitDepth := AInfo.ColorDepth;
|
---|
161 |
|
---|
162 | FContent := AContent;
|
---|
163 | end;
|
---|
164 |
|
---|
165 | class function TBGRAIconCursorEntry.TryCreate(
|
---|
166 | AContainer: TMultiFileContainer; AContent: TStream): TBGRAIconCursorEntry;
|
---|
167 | var
|
---|
168 | format: TBGRAImageFormat;
|
---|
169 | imageInfo: TQuickImageInfo;
|
---|
170 | tempStream: TMemoryStream;
|
---|
171 | reader: TBGRAImageReader;
|
---|
172 | bmp: TBGRACustomBitmap;
|
---|
173 | maskLine: packed array of byte;
|
---|
174 | maskStride: integer;
|
---|
175 | psrc: PBGRAPixel;
|
---|
176 | maskBit: byte;
|
---|
177 | maskPos,x,y: integer;
|
---|
178 | headerSize, dataSize: integer;
|
---|
179 | begin
|
---|
180 | AContent.Position:= 0;
|
---|
181 | format := DetectFileFormat(AContent);
|
---|
182 | case format of
|
---|
183 | ifBmp:
|
---|
184 | begin
|
---|
185 | reader := TBGRAReaderBMP.Create;
|
---|
186 | bmp := BGRABitmapFactory.Create;
|
---|
187 | try
|
---|
188 | AContent.Position := 0;
|
---|
189 | imageInfo := reader.GetQuickInfo(AContent);
|
---|
190 | if (imageInfo.width <= 0) or (imageInfo.height <= 0) or
|
---|
191 | (imageInfo.width > 256) or (imageInfo.height > 256) then
|
---|
192 | raise exception.Create('Invalid image size');
|
---|
193 | AContent.Position := 0;
|
---|
194 | //load bitmap to build mask
|
---|
195 | bmp.LoadFromStream(AContent);
|
---|
196 | maskStride := ((bmp.Width+31) div 32)*4;
|
---|
197 |
|
---|
198 | tempStream := TMemoryStream.Create;
|
---|
199 | //BMP header is not stored in icon/cursor
|
---|
200 | AContent.Position:= sizeof(TBitMapFileHeader);
|
---|
201 | tempStream.CopyFrom(AContent, AContent.Size - sizeof(TBitMapFileHeader));
|
---|
202 | AContent.Free;
|
---|
203 |
|
---|
204 | //fix height
|
---|
205 | tempStream.Position := 0;
|
---|
206 | headerSize := LEtoN(tempStream.ReadDWord);
|
---|
207 | if headerSize = sizeof(TOS2BitmapHeader) then // OS/2 1.x
|
---|
208 | begin
|
---|
209 | tempStream.Position := 6;
|
---|
210 | tempStream.WriteWord(NtoLE(word(bmp.Height*2))); //include mask size
|
---|
211 | end else
|
---|
212 | begin
|
---|
213 | tempStream.Position := 8;
|
---|
214 | tempStream.WriteDWord(NtoLE(dword(bmp.Height*2))); //include mask size
|
---|
215 | if headerSize >= 20+4 then
|
---|
216 | begin
|
---|
217 | tempStream.Position:= 20;
|
---|
218 | dataSize := LEtoN(tempStream.ReadDWord);
|
---|
219 | if dataSize <> 0 then
|
---|
220 | begin //if data size is supplied, include mask size
|
---|
221 | dataSize += maskStride*bmp.Height;
|
---|
222 | tempStream.Position:= 20;
|
---|
223 | tempStream.WriteDWord(NtoLE(dataSize));
|
---|
224 | end;
|
---|
225 | end;
|
---|
226 | end;
|
---|
227 |
|
---|
228 | //build mask
|
---|
229 | tempStream.Position := tempStream.Size;
|
---|
230 | setlength(maskLine, maskStride);
|
---|
231 | for y := bmp.Height-1 downto 0 do
|
---|
232 | begin
|
---|
233 | maskBit := $80;
|
---|
234 | maskPos := 0;
|
---|
235 | psrc := bmp.ScanLine[y];
|
---|
236 | fillchar(maskLine[0], length(maskLine), 0);
|
---|
237 | for x := 0 to bmp.Width-1 do
|
---|
238 | begin
|
---|
239 | if psrc^.alpha = 0 then
|
---|
240 | maskLine[maskPos] := maskLine[maskPos] or maskBit;
|
---|
241 | maskBit := maskBit shr 1;
|
---|
242 | if maskBit = 0 then
|
---|
243 | begin
|
---|
244 | maskBit := $80;
|
---|
245 | maskPos += 1;
|
---|
246 | end;
|
---|
247 | inc(psrc);
|
---|
248 | end;
|
---|
249 | tempStream.WriteBuffer(maskLine[0], length(maskLine));
|
---|
250 | end;
|
---|
251 |
|
---|
252 | result := TBGRAIconCursorEntry.Create(AContainer, 'dib', imageInfo, tempStream);
|
---|
253 | finally
|
---|
254 | bmp.Free;
|
---|
255 | reader.Free;
|
---|
256 | end;
|
---|
257 | end;
|
---|
258 | ifPng:
|
---|
259 | begin
|
---|
260 | reader := TBGRAReaderPNG.Create;
|
---|
261 | imageInfo := reader.GetQuickInfo(AContent);
|
---|
262 | reader.Free;
|
---|
263 | result := TBGRAIconCursorEntry.Create(AContainer, 'png', imageInfo, AContent);
|
---|
264 |
|
---|
265 | end;
|
---|
266 | ifUnknown, ifLazPaint {a headerless bmp can be confused for a headerless lzp}:
|
---|
267 | begin
|
---|
268 | //assume headerless BMP
|
---|
269 | AContent.Position := 0;
|
---|
270 | reader := TBGRAReaderBMP.Create;
|
---|
271 | imageInfo := reader.GetQuickInfo(AContent);
|
---|
272 | imageInfo.Height:= imageInfo.Height div 2; //mask size is included
|
---|
273 | reader.Free;
|
---|
274 | if (imageInfo.width <= 0) or (imageInfo.height <= 0) or
|
---|
275 | (imageInfo.width > 256) or (imageInfo.height > 256) then
|
---|
276 | raise exception.Create('Invalid image size');
|
---|
277 | result := TBGRAIconCursorEntry.Create(AContainer, 'dib', imageInfo, AContent);
|
---|
278 | end;
|
---|
279 | else
|
---|
280 | raise exception.Create(SuggestImageExtension(format) + ' format is not handled');
|
---|
281 | end;
|
---|
282 | end;
|
---|
283 |
|
---|
284 | destructor TBGRAIconCursorEntry.Destroy;
|
---|
285 | begin
|
---|
286 | FContent.Free;
|
---|
287 | inherited Destroy;
|
---|
288 | end;
|
---|
289 |
|
---|
290 | function TBGRAIconCursorEntry.CopyTo(ADestination: TStream): int64;
|
---|
291 | begin
|
---|
292 | if FContent.Size = 0 then
|
---|
293 | begin
|
---|
294 | result := 0;
|
---|
295 | exit;
|
---|
296 | end;
|
---|
297 |
|
---|
298 | FContent.Position := 0;
|
---|
299 | result := ADestination.CopyFrom(FContent, FContent.Size);
|
---|
300 | end;
|
---|
301 |
|
---|
302 | function TBGRAIconCursorEntry.GetBitmap: TBGRACustomBitmap;
|
---|
303 | var reader: TBGRAImageReader;
|
---|
304 | begin
|
---|
305 | if Extension = 'dib' then
|
---|
306 | begin
|
---|
307 | reader := TBGRAReaderBMP.Create;
|
---|
308 | TBGRAReaderBMP(reader).Subformat := bsfHeaderlessWithMask;
|
---|
309 | end else
|
---|
310 | reader := TBGRAReaderPNG.create;
|
---|
311 |
|
---|
312 | result := BGRABitmapFactory.Create;
|
---|
313 | FContent.Position := 0;
|
---|
314 | try
|
---|
315 | result.LoadFromStream(FContent, reader);
|
---|
316 | except on ex: Exception do
|
---|
317 | begin
|
---|
318 | result.Free;
|
---|
319 | reader.Free;
|
---|
320 | raise ex;
|
---|
321 | end;
|
---|
322 | end;
|
---|
323 | reader.Free;
|
---|
324 |
|
---|
325 | result.HotSpot := HotSpot;
|
---|
326 | end;
|
---|
327 |
|
---|
328 | function TBGRAIconCursorEntry.GetName: utf8string;
|
---|
329 | begin
|
---|
330 | result := IntToStr(FWidth)+'x'+IntToStr(FHeight)+'x'+IntToStr(FBitDepth);
|
---|
331 | end;
|
---|
332 |
|
---|
333 | procedure TBGRAIconCursorEntry.SetName(AValue: utf8string);
|
---|
334 | begin
|
---|
335 | raise exception.Create('Name cannot be changed');
|
---|
336 | end;
|
---|
337 |
|
---|
338 | function TBGRAIconCursorEntry.GetExtension: utf8string;
|
---|
339 | begin
|
---|
340 | result := FExtension;
|
---|
341 | end;
|
---|
342 |
|
---|
343 | function TBGRAIconCursorEntry.GetFileSize: int64;
|
---|
344 | begin
|
---|
345 | result := FContent.Size;
|
---|
346 | end;
|
---|
347 |
|
---|
348 | { TBGRAIconCursor }
|
---|
349 |
|
---|
350 | function TBGRAIconCursor.GetBitDepthAt(AIndex: integer): integer;
|
---|
351 | begin
|
---|
352 | if (AIndex < 0) or (AIndex >= Count) then raise ERangeError.Create('Index out of bounds');
|
---|
353 | result := TBGRAIconCursorEntry(Entry[AIndex]).BitDepth;
|
---|
354 | end;
|
---|
355 |
|
---|
356 | function TBGRAIconCursor.GetHeightAt(AIndex: integer): integer;
|
---|
357 | begin
|
---|
358 | if (AIndex < 0) or (AIndex >= Count) then raise ERangeError.Create('Index out of bounds');
|
---|
359 | result := TBGRAIconCursorEntry(Entry[AIndex]).Height;
|
---|
360 | end;
|
---|
361 |
|
---|
362 | function TBGRAIconCursor.GetHotSpotAtAt(AIndex: integer): TPoint;
|
---|
363 | begin
|
---|
364 | if (AIndex < 0) or (AIndex >= Count) then raise ERangeError.Create('Index out of bounds');
|
---|
365 | result := TBGRAIconCursorEntry(Entry[AIndex]).HotSpot;
|
---|
366 | end;
|
---|
367 |
|
---|
368 | function TBGRAIconCursor.GetWidthAt(AIndex: integer): integer;
|
---|
369 | begin
|
---|
370 | if (AIndex < 0) or (AIndex >= Count) then raise ERangeError.Create('Index out of bounds');
|
---|
371 | result := TBGRAIconCursorEntry(Entry[AIndex]).Width;
|
---|
372 | end;
|
---|
373 |
|
---|
374 | procedure TBGRAIconCursor.SetFileType(AValue: TBGRAImageFormat);
|
---|
375 | begin
|
---|
376 | if FFileType=AValue then Exit;
|
---|
377 | if not (AValue in [ifIco,ifCur,ifUnknown]) then
|
---|
378 | raise exception.Create('Allowed formats: ICO, CUR or unknown');
|
---|
379 | FFileType:=AValue;
|
---|
380 | end;
|
---|
381 |
|
---|
382 | procedure TBGRAIconCursor.SetHotSpotAt(AIndex: integer; AValue: TPoint);
|
---|
383 | begin
|
---|
384 | if (AIndex < 0) or (AIndex >= Count) then raise ERangeError.Create('Index out of bounds');
|
---|
385 | TBGRAIconCursorEntry(Entry[AIndex]).HotSpot := AValue;
|
---|
386 | end;
|
---|
387 |
|
---|
388 | function TBGRAIconCursor.CreateEntry(AName: utf8string;
|
---|
389 | AExtension: utf8string; AContent: TStream): TMultiFileEntry;
|
---|
390 | begin
|
---|
391 | AExtension := UTF8LowerCase(AExtension);
|
---|
392 | if (AExtension <> 'png') and (AExtension <> 'dib') then
|
---|
393 | raise exception.Create('The only supported extensions are PNG and DIB');
|
---|
394 |
|
---|
395 | result := TBGRAIconCursorEntry.TryCreate(self, AContent);
|
---|
396 | if result.Extension <> AExtension then
|
---|
397 | begin
|
---|
398 | result.Free;
|
---|
399 | raise exception.Create(AExtension + ' file extension expected but ' + result.Extension + ' found');
|
---|
400 | end;
|
---|
401 |
|
---|
402 | if result.Name <> AName then
|
---|
403 | begin
|
---|
404 | result.Free;
|
---|
405 | raise exception.Create('"' + AName + '" dimension expected but "' + result.Name + '" found');
|
---|
406 | end;
|
---|
407 | end;
|
---|
408 |
|
---|
409 | function TBGRAIconCursor.ExpectedMagic: Word;
|
---|
410 | begin
|
---|
411 | case FFileType of
|
---|
412 | ifIco: result := ICON_OR_CURSOR_FILE_ICON_TYPE;
|
---|
413 | ifCur: result := ICON_OR_CURSOR_FILE_CURSOR_TYPE;
|
---|
414 | else
|
---|
415 | raise exception.Create('Invalid icon/cursor type');
|
---|
416 | end;
|
---|
417 | end;
|
---|
418 |
|
---|
419 | procedure TBGRAIconCursor.Init;
|
---|
420 | begin
|
---|
421 | inherited Init;
|
---|
422 | FFileType:= ifUnknown;
|
---|
423 | end;
|
---|
424 |
|
---|
425 | constructor TBGRAIconCursor.Create(AFileType: TBGRAImageFormat);
|
---|
426 | begin
|
---|
427 | if not (AFileType in [ifIco,ifCur,ifUnknown]) then
|
---|
428 | raise exception.Create('Allowed formats: ICO, CUR or unknown');
|
---|
429 |
|
---|
430 | Init;
|
---|
431 | FFileType := AFileType;
|
---|
432 | end;
|
---|
433 |
|
---|
434 | function TBGRAIconCursor.Add(ABitmap: TBGRACustomBitmap; ABitDepth: integer;
|
---|
435 | AOverwrite: boolean): integer;
|
---|
436 | var stream, temp: TStream;
|
---|
437 | writer: TFPWriterBMP;
|
---|
438 | bmpXOR: TBGRACustomBitmap;
|
---|
439 | y: Integer;
|
---|
440 | psrcMask, pdest: PBGRAPixel;
|
---|
441 | bitAndMask: array of byte;
|
---|
442 | bitAndMaskPos: integer;
|
---|
443 | bitAndMaskBit: byte;
|
---|
444 | bitAndMaskRowSize, x: integer;
|
---|
445 | palette: TBGRAPalette;
|
---|
446 | writerPng: TBGRAWriterPNG;
|
---|
447 |
|
---|
448 | begin
|
---|
449 | stream := TMemoryStream.Create;
|
---|
450 | try
|
---|
451 | //PNG format is advised from 256 on but does not handle XOR
|
---|
452 | if ((ABitmap.Width >= 256) or (ABitmap.Height >= 256)) and (ABitDepth >= 8) and
|
---|
453 | ((ABitmap.XorMask = nil) or ABitmap.XorMask.IsZero) then
|
---|
454 | begin
|
---|
455 | writerPng := TBGRAWriterPNG.Create;
|
---|
456 | try
|
---|
457 | writerPng.WordSized := false;
|
---|
458 | if ABitDepth = 8 then
|
---|
459 | begin
|
---|
460 | writerPng.Indexed := true;
|
---|
461 | writerpng.UseAlpha := ABitmap.HasTransparentPixels;
|
---|
462 | end else
|
---|
463 | begin
|
---|
464 | writerPng.Indexed := false;
|
---|
465 | writerpng.UseAlpha := (ABitDepth = 32);
|
---|
466 | end;
|
---|
467 | ABitmap.SaveToStream(stream, writerPng);
|
---|
468 | finally
|
---|
469 | writerPng.Free;
|
---|
470 | end;
|
---|
471 | result := Add(stream, AOverwrite, true);
|
---|
472 | stream := nil;
|
---|
473 | end else
|
---|
474 | if ((ABitmap.XorMask = nil) or ABitmap.XorMask.IsZero) and
|
---|
475 | (not ABitmap.HasTransparentPixels or (ABitDepth = 32)) then
|
---|
476 | begin
|
---|
477 | writer := TFPWriterBMP.Create;
|
---|
478 | writer.BitsPerPixel := ABitDepth;
|
---|
479 | try
|
---|
480 | if not ABitmap.UsePalette and (ABitDepth < 24) then
|
---|
481 | begin
|
---|
482 | palette := TBGRAPalette.Create(ABitmap);
|
---|
483 | try
|
---|
484 | palette.AssignTo(ABitmap);
|
---|
485 | finally
|
---|
486 | palette.Free;
|
---|
487 | end;
|
---|
488 | ABitmap.SaveToStream(stream, writer);
|
---|
489 | ABitmap.UsePalette:= false;
|
---|
490 | end
|
---|
491 | else
|
---|
492 | ABitmap.SaveToStream(stream, writer);
|
---|
493 | finally
|
---|
494 | writer.Free;
|
---|
495 | end;
|
---|
496 | result := Add(stream, AOverwrite, true);
|
---|
497 | stream := nil;
|
---|
498 | end else
|
---|
499 | begin
|
---|
500 | bmpXOR := BGRABitmapFactory.Create(ABitmap);
|
---|
501 | try
|
---|
502 | bitAndMaskRowSize := ((bmpXOR.Width+31) div 32)*4;
|
---|
503 | setlength(bitAndMask, bitAndMaskRowSize*bmpXOR.Height);
|
---|
504 | for y := bmpXOR.Height-1 downto 0 do
|
---|
505 | begin
|
---|
506 | if assigned(ABitmap.XorMask) then
|
---|
507 | psrcMask := ABitmap.XorMask.ScanLine[y]
|
---|
508 | else
|
---|
509 | psrcMask := nil;
|
---|
510 | pdest := bmpXOR.ScanLine[y];
|
---|
511 | bitAndMaskPos := (bmpXOR.Height-1-y)*bitAndMaskRowSize;
|
---|
512 | bitAndMaskBit:= $80;
|
---|
513 | for x := bmpXOR.Width-1 downto 0 do
|
---|
514 | begin
|
---|
515 | //xor mask is either 100% or 0%
|
---|
516 | if assigned(psrcMask) and ((psrcMask^.red <> 0) or (psrcMask^.green <> 0) or (psrcMask^.blue <> 0)) then
|
---|
517 | begin
|
---|
518 | pdest^ := psrcMask^;
|
---|
519 | pdest^.alpha := 255;
|
---|
520 | bitAndMask[bitAndMaskPos] := bitAndMask[bitAndMaskPos] or bitAndMaskBit;
|
---|
521 | end else
|
---|
522 | if pdest^.alpha = 0 then
|
---|
523 | begin
|
---|
524 | bitAndMask[bitAndMaskPos] := bitAndMask[bitAndMaskPos] or bitAndMaskBit;
|
---|
525 | if ABitDepth <= 24 then //if we cannot save alpha, replace with black.
|
---|
526 | begin //mask will task care of making it transparent
|
---|
527 | pdest^ := BGRABlack;
|
---|
528 | end;
|
---|
529 | end;
|
---|
530 |
|
---|
531 | bitAndMaskBit := bitAndMaskBit shr 1;
|
---|
532 | if bitAndMaskBit = 0 then
|
---|
533 | begin
|
---|
534 | bitAndMaskBit := $80;
|
---|
535 | bitAndMaskPos += 1;
|
---|
536 | end;
|
---|
537 | if assigned(psrcMask) then inc(psrcMask);
|
---|
538 | inc(pdest);
|
---|
539 | end;
|
---|
540 | end;
|
---|
541 | bmpXOR.InvalidateBitmap;
|
---|
542 |
|
---|
543 | if ABitDepth < 24 then
|
---|
544 | begin
|
---|
545 | palette := TBGRAPalette.Create(bmpXor);
|
---|
546 | palette.AssignTo(bmpXor);
|
---|
547 | palette.Free;
|
---|
548 | end;
|
---|
549 |
|
---|
550 | temp := TMemoryStream.Create;
|
---|
551 | try
|
---|
552 | writer := TFPWriterBMP.Create;
|
---|
553 | writer.BitsPerPixel := ABitDepth;
|
---|
554 | try
|
---|
555 | bmpXOR.SaveToStream(temp, writer);
|
---|
556 | //write double height to include mask
|
---|
557 | temp.Position := 22;
|
---|
558 | temp.WriteDWord(NtoLE(DWord(bmpXOR.Height*2)));
|
---|
559 | //go after the file header
|
---|
560 | temp.Position := 14;
|
---|
561 | //copy bitmap without header
|
---|
562 | stream.CopyFrom(temp, temp.Size-temp.Position);
|
---|
563 | finally
|
---|
564 | writer.Free;
|
---|
565 | end;
|
---|
566 | finally
|
---|
567 | temp.Free;
|
---|
568 | end;
|
---|
569 | //write mask
|
---|
570 | stream.WriteBuffer(bitAndMask[0],length(bitAndMask));
|
---|
571 | result := Add(stream, AOverwrite, true);
|
---|
572 | stream := nil;
|
---|
573 | finally
|
---|
574 | bmpXOR.Free;
|
---|
575 | end;
|
---|
576 | end;
|
---|
577 |
|
---|
578 | finally
|
---|
579 | stream.Free;
|
---|
580 | end;
|
---|
581 | end;
|
---|
582 |
|
---|
583 | function TBGRAIconCursor.Add(AContent: TStream; AOverwrite: boolean;
|
---|
584 | AOwnStream: boolean): integer;
|
---|
585 | var
|
---|
586 | index,i: Integer;
|
---|
587 | newEntry: TBGRAIconCursorEntry;
|
---|
588 | contentCopy: TMemoryStream;
|
---|
589 | begin
|
---|
590 | if not AOwnStream then
|
---|
591 | begin
|
---|
592 | AContent.Position:= 0;
|
---|
593 | contentCopy := TMemoryStream.Create;
|
---|
594 | contentCopy.CopyFrom(AContent, AContent.Size);
|
---|
595 | newEntry := TBGRAIconCursorEntry.TryCreate(self, contentCopy);
|
---|
596 | end else
|
---|
597 | newEntry := TBGRAIconCursorEntry.TryCreate(self, AContent);
|
---|
598 |
|
---|
599 | index := IndexOf(newEntry.Name, newEntry.Extension);
|
---|
600 | if index <> -1 then
|
---|
601 | begin
|
---|
602 | if AOverwrite then
|
---|
603 | Delete(index)
|
---|
604 | else
|
---|
605 | begin
|
---|
606 | newEntry.Free;
|
---|
607 | raise Exception.Create('Duplicate entry');
|
---|
608 | end;
|
---|
609 | end else if not FLoading then
|
---|
610 | begin
|
---|
611 | for i := 0 to Count-1 do
|
---|
612 | if ((Width[i] < newEntry.Width) and (Height[i] < newEntry.Height)) or
|
---|
613 | ((Width[i] = newEntry.Width) and (Height[i] = newEntry.Height) and (BitDepth[i] < newEntry.BitDepth)) then
|
---|
614 | begin
|
---|
615 | index := i;
|
---|
616 | break;
|
---|
617 | end;
|
---|
618 | end;
|
---|
619 | result := AddEntry(newEntry, index);
|
---|
620 | end;
|
---|
621 |
|
---|
622 | procedure TBGRAIconCursor.LoadFromStream(AStream: TStream);
|
---|
623 | var header: TGroupIconHeader;
|
---|
624 | dir: packed array of TIconFileDirEntry;
|
---|
625 | startPos: int64;
|
---|
626 | entryContent: TMemoryStream;
|
---|
627 | entryIndex, i: integer;
|
---|
628 | begin
|
---|
629 | FLoading:= true;
|
---|
630 | try
|
---|
631 | startPos := AStream.Position;
|
---|
632 | AStream.ReadBuffer({%H-}header, sizeof(header));
|
---|
633 | header.SwapIfNecessary;
|
---|
634 | if header.Reserved <> 0 then
|
---|
635 | raise exception.Create('Invalid file format');
|
---|
636 | if FileType = ifUnknown then
|
---|
637 | begin
|
---|
638 | case header.ResourceType of
|
---|
639 | ICON_OR_CURSOR_FILE_ICON_TYPE: FFileType := ifIco;
|
---|
640 | ICON_OR_CURSOR_FILE_CURSOR_TYPE: FFileType := ifCur;
|
---|
641 | end;
|
---|
642 | end;
|
---|
643 | if header.ResourceType <> ExpectedMagic then
|
---|
644 | raise exception.Create('Invalid resource type');
|
---|
645 | Clear;
|
---|
646 | setlength(dir, header.ImageCount);
|
---|
647 | AStream.ReadBuffer(dir[0], sizeof(TIconFileDirEntry)*length(dir));
|
---|
648 | for i := 0 to high(dir) do
|
---|
649 | begin
|
---|
650 | AStream.Position:= LEtoN(dir[i].ImageOffset) + startPos;
|
---|
651 | entryContent := TMemoryStream.Create;
|
---|
652 | entryContent.CopyFrom(AStream, LEtoN(dir[i].ImageSize));
|
---|
653 | entryIndex := Add(entryContent, false, true);
|
---|
654 | if ((dir[i].Width = 0) and (Width[entryIndex] < 256)) or
|
---|
655 | ((dir[i].Width > 0) and (Width[entryIndex] <> dir[i].Width)) or
|
---|
656 | ((dir[i].Height = 0) and (Height[entryIndex] < 256)) or
|
---|
657 | ((dir[i].Height > 0) and (Height[entryIndex] <> dir[i].Height)) then
|
---|
658 | raise Exception.Create('Inconsistent image size');
|
---|
659 | if FFileType = ifCur then
|
---|
660 | TBGRAIconCursorEntry(Entry[entryIndex]).HotSpot := Point(LEtoN(dir[i].HotSpotX),LEtoN(dir[i].HotSpotY));
|
---|
661 | end;
|
---|
662 | finally
|
---|
663 | FLoading:= false;
|
---|
664 | end;
|
---|
665 | end;
|
---|
666 |
|
---|
667 | procedure TBGRAIconCursor.SaveToStream(ADestination: TStream);
|
---|
668 | var header: TGroupIconHeader;
|
---|
669 | i: integer;
|
---|
670 | accSize: DWord;
|
---|
671 | dir: packed array of TIconFileDirEntry;
|
---|
672 | contentSize: DWord;
|
---|
673 | begin
|
---|
674 | if Count = 0 then
|
---|
675 | raise exception.Create('File cannot be empty');
|
---|
676 | if FileType = ifUnknown then
|
---|
677 | raise exception.Create('You need to specify the file type');
|
---|
678 | header.ImageCount:= Count;
|
---|
679 | header.Reserved := 0;
|
---|
680 | header.ResourceType:= ExpectedMagic;
|
---|
681 | header.SwapIfNecessary;
|
---|
682 | accSize := sizeof(header) + sizeof(TIconFileDirEntry)*Count;
|
---|
683 | setlength(dir, Count);
|
---|
684 | for i := 0 to Count-1 do
|
---|
685 | begin
|
---|
686 | if Width[i] >= 256
|
---|
687 | then dir[i].Width := 0
|
---|
688 | else dir[i].Width := Width[i];
|
---|
689 |
|
---|
690 | if Height[i] >= 256
|
---|
691 | then dir[i].Height := 0
|
---|
692 | else dir[i].Height := Height[i];
|
---|
693 |
|
---|
694 | if BitDepth[i] < 8 then
|
---|
695 | dir[i].Colors := 1 shl BitDepth[i]
|
---|
696 | else
|
---|
697 | dir[i].Colors := 0;
|
---|
698 | dir[i].Reserved := 0;
|
---|
699 | case FFileType of
|
---|
700 | ifCur: begin dir[i].HotSpotX:= NtoLE(Word(HotSpot[i].X)); dir[i].HotSpotY := NtoLE(Word(HotSpot[i].Y)); end;
|
---|
701 | ifIco: begin dir[i].BitsPerPixel:= NtoLE(Word(BitDepth[i])); dir[i].Planes := NtoLE(Word(1)); end;
|
---|
702 | else dir[i].Variable:= 0;
|
---|
703 | end;
|
---|
704 | dir[i].ImageOffset := LEtoN(accSize);
|
---|
705 | contentSize:= Entry[i].FileSize;
|
---|
706 | dir[i].ImageSize := NtoLE(contentSize);
|
---|
707 | inc(accSize,contentSize);
|
---|
708 | end;
|
---|
709 |
|
---|
710 | ADestination.WriteBuffer(header, sizeof(header));
|
---|
711 | ADestination.WriteBuffer(dir[0], sizeof(TIconFileDirEntry)*length(dir));
|
---|
712 | for i := 0 to Count-1 do
|
---|
713 | if Entry[i].CopyTo(ADestination) <> Entry[i].FileSize then
|
---|
714 | raise exception.Create('Unable to write data in stream');
|
---|
715 | end;
|
---|
716 |
|
---|
717 | function TBGRAIconCursor.GetBitmap(AIndex: integer): TBGRACustomBitmap;
|
---|
718 | begin
|
---|
719 | if (AIndex < 0) or (AIndex >= Count) then raise ERangeError.Create('Index out of bounds');
|
---|
720 | result := TBGRAIconCursorEntry(Entry[AIndex]).GetBitmap;
|
---|
721 | end;
|
---|
722 |
|
---|
723 | function TBGRAIconCursor.GetBestFitBitmap(AWidth, AHeight: integer): TBGRACustomBitmap;
|
---|
724 | var bestIndex: integer;
|
---|
725 | bestSizeDiff: integer;
|
---|
726 | bestBPP: integer;
|
---|
727 | sizeDiff, i: integer;
|
---|
728 | begin
|
---|
729 | bestBPP := 0;
|
---|
730 | bestSizeDiff := high(integer);
|
---|
731 | bestIndex := -1;
|
---|
732 | for i := 0 to Count-1 do
|
---|
733 | begin
|
---|
734 | sizeDiff := abs(AWidth-Width[i])+abs(AHeight-Height[i]);
|
---|
735 | if (sizeDiff < bestSizeDiff) or
|
---|
736 | ((sizeDiff = bestSizeDiff) and (BitDepth[i] > bestBPP)) then
|
---|
737 | begin
|
---|
738 | bestIndex := i;
|
---|
739 | bestSizeDiff:= sizeDiff;
|
---|
740 | bestBPP:= BitDepth[i];
|
---|
741 | end;
|
---|
742 | end;
|
---|
743 | if bestIndex = -1 then
|
---|
744 | raise Exception.Create('No bitmap found')
|
---|
745 | else
|
---|
746 | result := GetBitmap(bestIndex);
|
---|
747 | end;
|
---|
748 |
|
---|
749 | function TBGRAIconCursor.IndexOf(AWidth, AHeight, ABitDepth: integer): integer;
|
---|
750 | var
|
---|
751 | i: Integer;
|
---|
752 | begin
|
---|
753 | for i := 0 to Count-1 do
|
---|
754 | if (Width[i] = AWidth) and (Height[i] = AHeight) and (BitDepth[i] = ABitDepth) then
|
---|
755 | begin
|
---|
756 | result := i;
|
---|
757 | exit;
|
---|
758 | end;
|
---|
759 | result := -1;
|
---|
760 | end;
|
---|
761 |
|
---|
762 | end.
|
---|
763 |
|
---|