├── LICENSE
├── QoiImage.pas
├── QoiShellExtensions
├── dll_binary
│ └── QoiShellExtensions.dll
├── readme.md
└── source
│ ├── QoiPreview.pas
│ ├── QoiReader.pas
│ ├── QoiShellExtensions.dpr
│ ├── QoiShellExtensions.dproj
│ ├── QoiShellExtensions.res
│ └── dialog.res
├── README.md
└── TestApp
├── QoiTest.dpr
├── QoiTest.dproj
├── QoiTest.res
├── QoiTest_Icon.ico
├── Unit1.dfm
├── Unit1.pas
├── qoi_logo.png
└── timer.png
/LICENSE:
--------------------------------------------------------------------------------
1 | MIT License
2 |
3 | Copyright (c) 2021 Angus Johnson
4 |
5 | Permission is hereby granted, free of charge, to any person obtaining a copy
6 | of this software and associated documentation files (the "Software"), to deal
7 | in the Software without restriction, including without limitation the rights
8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
9 | copies of the Software, and to permit persons to whom the Software is
10 | furnished to do so, subject to the following conditions:
11 |
12 | The above copyright notice and this permission notice shall be included in all
13 | copies or substantial portions of the Software.
14 |
15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
21 | SOFTWARE.
22 |
--------------------------------------------------------------------------------
/QoiImage.pas:
--------------------------------------------------------------------------------
1 | unit QoiImage;
2 |
3 | interface
4 |
5 | (*******************************************************************************
6 | * Author : Angus Johnson *
7 | * Version : 2.15 *
8 | * Date : 15 September 2022 *
9 | * Website : http://www.angusj.com *
10 | * License : The MIT License (MIT) *
11 | * Copyright (c) 2021-2022 Angus Johnson *
12 | * https://opensource.org/licenses/MIT *
13 | *******************************************************************************)
14 |
15 | (*******************************************************************************
16 | * QOI - The "Quite OK Image" format for fast, lossless image compression *
17 | * Dominic Szablewski - https://phoboslab.org *
18 | * LICENSE : The MIT License(MIT) *
19 | * Copyright(c) 2021 Dominic Szablewski *
20 | *******************************************************************************)
21 |
22 | uses
23 | SysUtils, Windows, Graphics, Math, Classes;
24 |
25 | type
26 | TQOI_DESC = packed record
27 | magic: Cardinal;
28 | width: Cardinal;
29 | height: Cardinal;
30 | channels: Byte;
31 | colorspace: Byte;
32 | end;
33 |
34 | {$IF COMPILERVERSION < 21}
35 | TBytes = array of Byte;
36 | {$IFEND}
37 |
38 | TARGB = packed record
39 | case Boolean of
40 | false : (B: Byte; G: Byte; R: Byte; A: Byte);
41 | true : (Color: Cardinal);
42 | end;
43 | PARGB = ^TARGB;
44 | TArrayOfARGB = array of TARGB;
45 |
46 | TQoiImageRec = record
47 | Width : integer;
48 | Height : integer;
49 | HasTransparency : Boolean;
50 | Pixels : TArrayOfARGB; //top-down 4 bytes per pixel
51 | end;
52 |
53 | TQoiImage = class(TGraphic)
54 | private
55 | FQoi : TQoiImageRec;
56 | procedure SetImageRec(const imgRec: TQoiImageRec);
57 | protected
58 | procedure Draw(ACanvas: TCanvas; const Rec: TRect); override;
59 | function GetEmpty: Boolean; override;
60 | function GetHeight: Integer; override;
61 | function GetTransparent: Boolean; override;
62 | function GetWidth: Integer; override;
63 | procedure SetHeight(Value: Integer); override;
64 | procedure SetWidth(Value: Integer); override;
65 | public
66 | procedure Assign(Source: TPersistent); override;
67 | procedure AssignTo(Dest: TPersistent); override;
68 | class function CanLoadFromStream(Stream: TStream): Boolean;
69 | {$IF COMPILERVERSION >= 33} override; {$IFEND} //Delphi 10.3 Rio
70 | procedure LoadFromStream(Stream: TStream); override;
71 | procedure SaveToFile(const Filename: string); override;
72 | procedure SaveToStream(Stream: TStream); override;
73 | procedure LoadFromClipboardFormat(AFormat: Word; AData: THandle;
74 | APalette: HPALETTE); override;
75 | procedure SaveToClipboardFormat(var AFormat: Word; var AData: THandle;
76 | var APalette: HPALETTE); override;
77 | procedure SetSize(AWidth, AHeight: Integer);
78 | {$IF COMPILERVERSION >= 23} override; {$IFEND} //?? check version
79 | property ImageRec: TQoiImageRec read FQoi write SetImageRec;
80 | end;
81 |
82 | function qoi_decode(const data: TBytes; out desc: TQOI_DESC): TArrayOfARGB;
83 | function LoadFromQoiBytes(const bytes: TBytes): TQoiImageRec;
84 | function LoadFromQoiStream(Stream: TStream): TQoiImageRec;
85 |
86 | function qoi_encode(const data: Pointer; const desc: TQOI_DESC): TBytes;
87 | function SaveToQoiBytes(const img: TQoiImageRec): TBytes;
88 | procedure SaveToQoiStream(const img: TQoiImageRec; Stream: TStream);
89 |
90 | function GetImgRecFromBitmap(bmp: TBitmap): TQoiImageRec;
91 | function CreateBitmapFromImgRec(const img: TQoiImageRec): TBitmap;
92 |
93 | const QOI_MAGIC = $66696F71;
94 |
95 | implementation
96 |
97 | ResourceString
98 | sQoiImageFile = 'QOI image file';
99 |
100 | const
101 | QOI_OP_INDEX = $0;
102 | QOI_OP_DIFF = $40;
103 | QOI_OP_LUMA = $80;
104 | QOI_OP_RUN = $C0;
105 | QOI_OP_RGB = $FE;
106 | QOI_OP_RGBA = $FF;
107 | QOI_MASK_2 = $C0;
108 | qoi_padding: array [0 .. 7] of Byte = (0, 0, 0, 0, 0, 0, 0, 1);
109 |
110 | //------------------------------------------------------------------------------
111 | // qoi_decode() and qoi_encode() and supporting functions
112 | //------------------------------------------------------------------------------
113 |
114 | function QOI_COLOR_HASH(c: TARGB): Byte;
115 | {$IF COMPILERVERSION >= 17} inline; {$IFEND}
116 | begin
117 | Result := (c.R * 3 + c.G * 5 + c.B * 7 + c.A * 11) and $3F;
118 | end;
119 |
120 | function SwapBytes(Value: Cardinal): Cardinal;
121 | var
122 | v: array[0..3] of byte absolute Value;
123 | r: array[0..3] of byte absolute Result;
124 | begin
125 | r[3] := v[0];
126 | r[2] := v[1];
127 | r[1] := v[2];
128 | r[0] := v[3];
129 | end;
130 |
131 | function ReadByte(var p: PByte): Byte;
132 | {$IF COMPILERVERSION >= 17} inline; {$IFEND}
133 | begin
134 | Result := p^;
135 | inc(p);
136 | end;
137 |
138 | procedure qoi_write_32(var p: PByte; val: Cardinal);
139 | {$IF COMPILERVERSION >= 17} inline; {$IFEND}
140 | begin
141 | PCardinal(p)^ := val;
142 | inc(p, SizeOf(Cardinal));
143 | end;
144 |
145 | procedure qoi_write_8(var p: PByte; val: Byte);
146 | {$IF COMPILERVERSION >= 17} inline; {$IFEND}
147 | begin
148 | p^ := val;
149 | inc(p);
150 | end;
151 |
152 | //qoi_decode: this function differs slightly from the standard at
153 | //https://github.com/phoboslab/qoi/blob/master/qoi.h.
154 | //The result here will instead always be an array of 4 byte pixels.
155 | //Nevertheless the desc.channel field will reliably indicate image
156 | //transparency such that 3 => alpha always 255; and 4 => alpha 0..255.
157 |
158 | {$R-}
159 | function qoi_decode(const data: TBytes; out desc: TQOI_DESC): TArrayOfARGB;
160 | var
161 | run, vg, i: Integer;
162 | index: array [0 .. 63] of TARGB;
163 | px: TARGB;
164 | b1, b2: Byte;
165 | dst: PARGB;
166 | src: PByte;
167 | hasAlpha: Boolean;
168 | begin
169 | FillChar(Result, SizeOf(Result), 0);
170 | if (Length(data) < SizeOf(desc) + SizeOf(qoi_padding)) then Exit;
171 |
172 | src := @data[0];
173 | Move(src^, desc, SizeOf(desc));
174 | inc(src, SizeOf(desc));
175 | with desc do
176 | begin
177 | if (magic <> QOI_MAGIC) then Exit; //not valid QOI format
178 | width := SwapBytes(width);
179 | height := SwapBytes(height);
180 | SetLength(Result, width * height);
181 | if (width = 0) or (height = 0) or
182 | (channels < 3) or (channels > 4) or (colorspace > 1) then
183 | Exit;
184 | end;
185 |
186 | px.Color := $FF000000;
187 | run := 0;
188 | FillChar(index, SizeOf(index), 0);
189 | hasAlpha := false;
190 | desc.channels := 3;
191 | dst := @Result[0];
192 | for i := 0 to desc.width * desc.height -1 do
193 | begin
194 | if (run > 0) then
195 | begin
196 | Dec(run);
197 | end
198 | else
199 | begin
200 | b1 := ReadByte(src);
201 | if (b1 = QOI_OP_RGB) then
202 | begin
203 | px.R := ReadByte(src);
204 | px.G := ReadByte(src);
205 | px.B := ReadByte(src);
206 | end
207 | else if (b1 = QOI_OP_RGBA) then
208 | begin
209 | px.R := ReadByte(src);
210 | px.G := ReadByte(src);
211 | px.B := ReadByte(src);
212 | px.A := ReadByte(src);
213 | hasAlpha := hasAlpha or (px.A < 255);
214 | end
215 | else if ((b1 and QOI_MASK_2) = QOI_OP_INDEX) then
216 | begin
217 | px := index[b1];
218 | end
219 | else if (b1 and QOI_MASK_2) = QOI_OP_DIFF then
220 | begin
221 | px.R := px.R + ((b1 shr 4) and 3) - 2;
222 | px.G := px.G + ((b1 shr 2) and 3) - 2;
223 | px.B := px.B + (b1 and 3) - 2;
224 | end
225 | else if (b1 and QOI_MASK_2) = QOI_OP_LUMA then
226 | begin
227 | b2 := ReadByte(src);
228 | vg := (b1 and $3F) - 32;
229 | px.R := px.R + vg - 8 + ((b2 shr 4) and $F);
230 | px.G := px.G + vg;
231 | px.B := px.B + vg - 8 + (b2 and $F);
232 | end
233 | else if (b1 and QOI_MASK_2) = QOI_OP_RUN then
234 | run := (b1 and $3F);
235 | index[QOI_COLOR_HASH(px)] := px;
236 | end;
237 | dst.Color := px.Color;
238 | inc(dst);
239 | end;
240 | if hasAlpha then desc.channels := 4;
241 | end;
242 | {$R+}
243 |
244 | function qoi_encode(const data: Pointer; const desc: TQOI_DESC): TBytes;
245 | var
246 | x,y,k,y2, max_size, run: Integer;
247 | vr, vg, vb, vg_r, vg_b: Integer;
248 | len, index_pos: Integer;
249 | dst: PByte;
250 | src: PARGB;
251 | index: array [0 .. 63] of TARGB;
252 | px_prev: TARGB;
253 | begin
254 | Result := nil;
255 | len := desc.width * desc.height;
256 |
257 | max_size := len * 4 + SizeOf(desc) + SizeOf(qoi_padding);
258 | SetLength(Result, max_size);
259 |
260 | dst := @Result[0];
261 | qoi_write_32(dst, desc.magic);
262 | qoi_write_32(dst, SwapBytes(desc.Width));
263 | qoi_write_32(dst, SwapBytes(desc.Height));
264 | qoi_write_8(dst, desc.channels);
265 | qoi_write_8(dst, desc.colorspace);
266 |
267 | run := 0;
268 | px_prev.Color := $FF000000;
269 | FillChar(index, SizeOf(index), 0);
270 |
271 | src := data;
272 | for y := 0 to len -1 do
273 | begin
274 | if src.Color = px_prev.Color then
275 | begin
276 | inc(run);
277 | if (run = 62) then
278 | begin
279 | qoi_write_8(dst, QOI_OP_RUN or (run - 1));
280 | run := 0;
281 | end;
282 | end
283 | else
284 | begin
285 | if (run > 0) then
286 | begin
287 | qoi_write_8(dst, QOI_OP_RUN or (run - 1));
288 | run := 0;
289 | end;
290 |
291 | index_pos := QOI_COLOR_HASH(src^);
292 | if (index[index_pos].Color = src.Color) then
293 | begin
294 | qoi_write_8(dst, QOI_OP_INDEX or index_pos);
295 | end
296 | else
297 | begin
298 | index[index_pos] := src^;
299 | if (src.A = px_prev.A) then
300 | begin
301 | vr := src.R - px_prev.R;
302 | vg := src.G - px_prev.G;
303 | vb := src.B - px_prev.B;
304 | vg_r := vr - vg;
305 | vg_b := vb - vg;
306 | if ((vr > -3) and (vr < 2) and (vg > -3) and (vg < 2) and (vb > -3)
307 | and (vb < 2)) then
308 | begin
309 | qoi_write_8(dst, QOI_OP_DIFF or (vr + 2) shl 4 or (vg + 2) shl 2 or
310 | (vb + 2));
311 | end
312 | else if ((vg_r > -9) and (vg_r < 8) and (vg > -33) and (vg < 32) and
313 | (vg_b > -9) and (vg_b < 8)) then
314 | begin
315 | qoi_write_8(dst, QOI_OP_LUMA or (vg + 32));
316 | qoi_write_8(dst, (vg_r + 8) shl 4 or (vg_b + 8));
317 | end
318 | else
319 | begin
320 | qoi_write_8(dst, QOI_OP_RGB);
321 | qoi_write_8(dst, src.R);
322 | qoi_write_8(dst, src.G);
323 | qoi_write_8(dst, src.B);
324 | end
325 | end
326 | else
327 | begin
328 | qoi_write_8(dst, QOI_OP_RGBA);
329 | qoi_write_8(dst, src.R);
330 | qoi_write_8(dst, src.G);
331 | qoi_write_8(dst, src.B);
332 | qoi_write_8(dst, src.A);
333 | end;
334 | end;
335 | end;
336 | px_prev := src^;
337 | inc(src);
338 | end;
339 |
340 | if (run > 0) then
341 | qoi_write_8(dst, QOI_OP_RUN or (run - 1));
342 |
343 | for x := 0 to 7 do
344 | qoi_write_8(dst, qoi_padding[x]);
345 | max_size := Cardinal(dst) - Cardinal(@Result[0]);
346 | SetLength(Result, max_size);
347 | end;
348 |
349 | //------------------------------------------------------------------------------
350 | // QOI Load and Save wrapper functions
351 | //------------------------------------------------------------------------------
352 |
353 | function LoadFromQoiBytes(const bytes: TBytes): TQoiImageRec;
354 | var
355 | desc: TQOI_DESC;
356 | begin
357 | Result.Pixels := qoi_decode(bytes, desc);
358 | Result.Width := desc.width;
359 | Result.Height := desc.height;
360 | Result.HasTransparency := desc.channels = 4;
361 | end;
362 |
363 | function LoadFromQoiStream(Stream: TStream): TQoiImageRec;
364 | var
365 | len: integer;
366 | bytes: TBytes;
367 | begin
368 | if not Assigned(Stream) then Exit;
369 | len := Stream.Size - Stream.Position;
370 | SetLength(bytes, len);
371 | Stream.Read(bytes[0], len);
372 | Result := LoadFromQoiBytes(bytes);
373 | end;
374 |
375 | function SaveToQoiBytes(const img: TQoiImageRec): TBytes;
376 | var
377 | desc: TQOI_DESC;
378 | begin
379 | Result := nil;
380 | desc.magic := QOI_MAGIC;
381 | desc.width := img.Width;
382 | desc.height := img.Height;
383 | if img.HasTransparency then
384 | desc.channels := 4 else
385 | desc.channels := 3;
386 | desc.colorspace := 0;
387 | Result := qoi_encode(img.Pixels, desc);
388 | end;
389 |
390 | procedure SaveToQoiStream(const img: TQoiImageRec; Stream: TStream);
391 | var
392 | bytes: TBytes;
393 | begin
394 | bytes := SaveToQoiBytes(img);
395 | Stream.Write(bytes[0], Length(bytes));
396 | end;
397 |
398 | //------------------------------------------------------------------------------
399 | //Exported GetImgRecFromBitmap & CreateBitmapFromImgRec amd support functions
400 | //------------------------------------------------------------------------------
401 |
402 | procedure SetAlpha255(var img: TQoiImageRec);
403 | var
404 | i, len: integer;
405 | p: PARGB;
406 | begin
407 | img.HasTransparency := false;
408 | len := Length(img.Pixels);
409 | if len = 0 then Exit;
410 | p := @img.Pixels[0];
411 | for i := 0 to len -1 do
412 | begin
413 | p.A := 255;
414 | inc(p);
415 | end;
416 | end;
417 |
418 | function GetHasTransparency(const img: TQoiImageRec): Boolean;
419 | var
420 | i, len: integer;
421 | p: PARGB;
422 | has0, has255: Boolean;
423 | begin
424 | Result := true;
425 | len := Length(img.Pixels);
426 | if len = 0 then Exit;
427 | p := @img.Pixels[0];
428 | has0 := false;
429 | has255 := false;
430 | for i := 0 to len -1 do
431 | begin
432 | if p.A = 0 then has0 := true
433 | else if p.A = 255 then has255 := true
434 | else exit;
435 | inc(p);
436 | end;
437 | Result := has0 = has255;
438 | end;
439 |
440 | function GetImgRecFromBitmap(bmp: TBitmap): TQoiImageRec;
441 | var
442 | len: integer;
443 | tmp: TBitmap;
444 | begin
445 | FillChar(Result, SizeOf(Result), 0);
446 | len := bmp.Width * bmp.Height;
447 | SetLength(Result.Pixels, len);
448 | if len = 0 then Exit;
449 | Result.Width := bmp.Width;
450 | Result.Height := bmp.Height;
451 |
452 | if bmp.PixelFormat = pf32bit then
453 | begin
454 | GetBitmapBits(bmp.Handle, len *4, @Result.Pixels[0]);
455 | Result.HasTransparency := GetHasTransparency(Result);
456 | end else
457 | begin
458 | tmp := TBitmap.Create;
459 | try
460 | tmp.Assign(bmp);
461 | tmp.PixelFormat := pf32bit;
462 | GetBitmapBits(tmp.Handle, len *4, @Result.Pixels[0]);
463 | Result.HasTransparency := false;
464 | finally
465 | tmp.Free;
466 | end;
467 | end;
468 | if not Result.HasTransparency then SetAlpha255(Result);
469 | end;
470 |
471 | function CreateBitmapFromImgRec(const img: TQoiImageRec): TBitmap;
472 | var
473 | i: integer;
474 | p: PARGB;
475 | begin
476 | Result := TBitmap.Create;
477 | Result.Width := img.Width;
478 | Result.Height := img.Height;
479 | Result.PixelFormat := pf32bit;
480 |
481 | //for some reason SetBitmapBits fails with vey old Delphi compilers
482 | p := @img.Pixels[0];
483 | for i := 0 to img.Height -1 do
484 | begin
485 | Move(p^, Result.ScanLine[i]^, img.Width * 4);
486 | inc(p, img.Width);
487 | end;
488 | //SetBitmapBits(Result.Handle, img.Width * img.Height * 4, @img.Pixels[0]);
489 | end;
490 |
491 | //------------------------------------------------------------------------------
492 | // TQoiImage methods
493 | //------------------------------------------------------------------------------
494 |
495 | procedure TQoiImage.AssignTo(Dest: TPersistent);
496 | var
497 | bmp: TBitmap;
498 | begin
499 | if Dest is TQoiImage then
500 | TQoiImage(Dest).Assign(self)
501 | else if Dest is TBitmap then
502 | begin
503 | bmp := CreateBitmapFromImgRec(FQoi);
504 | try
505 | {$IF COMPILERVERSION >= 20}
506 | bmp.AlphaFormat := afDefined;
507 | {$IFEND}
508 | TBitmap(Dest).Assign(bmp);
509 | finally
510 | bmp.Free;
511 | end;
512 | end
513 | else inherited;
514 | end;
515 |
516 | procedure TQoiImage.Assign(Source: TPersistent);
517 | begin
518 | if (Source is TQoiImage) then
519 | begin
520 | FQoi := TQoiImage(Source).FQoi;
521 | Changed(self);
522 | end
523 | else if Source is TBitmap then
524 | begin
525 | FQoi := GetImgRecFromBitmap(TBitmap(Source));
526 | Changed(self);
527 | end
528 | else inherited;
529 | end;
530 |
531 | type THackedBitmap = class(TBitmap);
532 |
533 | procedure TQoiImage.Draw(ACanvas: TCanvas; const Rec: TRect);
534 | var
535 | bmp: TBitmap;
536 | BlendFunction: TBlendFunction;
537 | w, h: integer;
538 | begin
539 | bmp := CreateBitmapFromImgRec(FQoi);
540 | try
541 | if Transparent then
542 | begin
543 | {$IF COMPILERVERSION >= 20}
544 | bmp.AlphaFormat := afDefined;
545 | {$IFEND}
546 | BlendFunction.BlendOp := AC_SRC_OVER;
547 | BlendFunction.AlphaFormat := AC_SRC_ALPHA;
548 | BlendFunction.SourceConstantAlpha := 255;
549 | BlendFunction.BlendFlags := 0;
550 | w := Math.Min(Width, Rec.Right - Rec.Left);
551 | h := Math.Min(Height, Rec.Bottom - Rec.Top);
552 | AlphaBlend(
553 | ACanvas.Handle, Rec.Left, Rec.Top, w, h,
554 | bmp.Canvas.Handle, 0, 0, w,h, BlendFunction);
555 | end else
556 | THackedBitmap(bmp).Draw(ACanvas, Rec);
557 | finally
558 | bmp.Free;
559 | end;
560 | end;
561 |
562 | function TQoiImage.GetEmpty: Boolean;
563 | begin
564 | Result := FQoi.Width * FQoi.Height = 0;
565 | end;
566 |
567 | function TQoiImage.GetTransparent: Boolean;
568 | begin
569 | Result := FQoi.HasTransparency;
570 | end;
571 |
572 | function TQoiImage.GetHeight: Integer;
573 | begin
574 | Result := FQoi.Height;
575 | end;
576 |
577 | function TQoiImage.GetWidth: Integer;
578 | begin
579 | Result := FQoi.Width;
580 | end;
581 |
582 | procedure TQoiImage.SetHeight(Value: Integer);
583 | begin
584 | SetSize(Width, Value);
585 | end;
586 |
587 | procedure TQoiImage.SetWidth(Value: Integer);
588 | begin
589 | SetSize(Value, Height);
590 | end;
591 |
592 | procedure TQoiImage.SetSize(AWidth, AHeight: Integer);
593 | begin
594 | FQoi.Width := AWidth;
595 | FQoi.Height := AHeight;
596 | FQoi.HasTransparency := false;
597 | SetLength(FQoi.Pixels, AWidth * AHeight);
598 | Changed(Self);
599 | end;
600 |
601 | procedure TQoiImage.SetImageRec(const imgRec: TQoiImageRec);
602 | begin
603 | FQoi := imgRec;
604 | Changed(Self);
605 | end;
606 |
607 | class function TQoiImage.CanLoadFromStream(Stream: TStream): Boolean;
608 | var
609 | p: Int64;
610 | q: Cardinal;
611 | begin
612 | p := Stream.Position;
613 | try
614 | Result := (Stream.Read(q, 4) = 4) and (q = QOI_MAGIC);
615 | finally
616 | Stream.Position := p;
617 | end;
618 | end;
619 |
620 | procedure TQoiImage.LoadFromStream(Stream: TStream);
621 | begin
622 | if not Assigned(Stream) then Exit;
623 | FQoi := LoadFromQoiStream(Stream);
624 | Changed(Self);
625 | end;
626 |
627 | procedure TQoiImage.SaveToFile(const Filename: string);
628 | begin
629 | inherited;
630 | end;
631 |
632 | procedure TQoiImage.SaveToStream(Stream: TStream);
633 | begin
634 | SaveToQoiStream(FQoi, Stream);
635 | end;
636 |
637 | procedure TQoiImage.LoadFromClipboardFormat(AFormat: Word; AData: THandle;
638 | APalette: HPALETTE);
639 | var
640 | bmp: TBitmap;
641 | begin
642 | bmp := TBitmap.Create;
643 | try
644 | THackedBitmap(bmp).LoadFromClipboardFormat(AFormat, AData, APalette);
645 | FQoi := GetImgRecFromBitmap(bmp);
646 | finally
647 | bmp.Free;
648 | end;
649 | end;
650 |
651 | procedure TQoiImage.SaveToClipboardFormat(var AFormat: Word;
652 | var AData: THandle; var APalette: HPALETTE);
653 | var
654 | bmp: TBitmap;
655 | begin
656 | bmp := CreateBitmapFromImgRec(FQoi);
657 | try
658 | THackedBitmap(bmp).SaveToClipboardFormat(AFormat, AData, APalette);
659 | finally
660 | bmp.Free;
661 | end;
662 | end;
663 |
664 | initialization
665 | TPicture.RegisterFileFormat('QOI', sQoiImageFile, TQoiImage); // Do not localize
666 |
667 | end.
668 |
--------------------------------------------------------------------------------
/QoiShellExtensions/dll_binary/QoiShellExtensions.dll:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/AngusJohnson/TQoiImage/fd0ff0a7f15efc442df2d2229f85313f2592dbb4/QoiShellExtensions/dll_binary/QoiShellExtensions.dll
--------------------------------------------------------------------------------
/QoiShellExtensions/readme.md:
--------------------------------------------------------------------------------
1 | # QoiShellExtensions.dll
2 |
3 | Windows (64bit) Explorer Shell Extensions for QOI files
4 | Preview Handler and Thumbnail Provider
5 |
6 | ----------
7 | Install:
8 | ----------
9 |
10 | 1. Right click Windows' Start Button
11 | 2. Select Windows PowerShell (Admin)
12 | In Windows PowerShell ...
13 | **cd** path_to_QoiShellExtensions
14 | **regsvr32** QoiShellExtensions.dll
15 | exit
16 |
17 | ----------
18 | Uninstall:
19 | ----------
20 |
21 | 1. Right click Windows' Start Button
22 | 2. Select Windows PowerShell (Admin)
23 | In Windows PowerShell ...
24 | **cd** path_to_QoiShellExtensions
25 | **regsvr32 /u** QoiShellExtensions.dll
26 | exit
27 |
28 | ----------
29 |
30 | 
31 |
32 | 
33 |
34 |
35 |
--------------------------------------------------------------------------------
/QoiShellExtensions/source/QoiPreview.pas:
--------------------------------------------------------------------------------
1 | unit QoiPreview;
2 |
3 | (*******************************************************************************
4 | * Author : Angus Johnson *
5 | * Version : 1.2 *
6 | * Date : 30 January 2022 *
7 | * Website : http://www.angusj.com *
8 | * Copyright : Angus Johnson 2022 *
9 | * *
10 | * Purpose : IPreviewHandler and IThumbnailProvider for QOI image files *
11 | * *
12 | * License : Use, modification & distribution is subject to *
13 | * Boost Software License Ver 1 *
14 | * http://www.boost.org/LICENSE_1_0.txt *
15 | *******************************************************************************)
16 |
17 | interface
18 |
19 | uses
20 | Windows, Messages, ActiveX, Classes, ComObj, ComServ, ShlObj,
21 | PropSys, Types, Registry, SysUtils, Math, QoiReader;
22 |
23 | {$WARN SYMBOL_PLATFORM OFF}
24 |
25 | {$R dialog.res}
26 |
27 | const
28 | extension = '.qoi';
29 | extFile = 'qoiFile';
30 | extDescription = 'QOI Shell Extensions';
31 |
32 | SID_EXT_ShellExtensions = '{0C2DCD0D-2A02-4D2B-9EAC-F8737DEAA7DF}';
33 | IID_EXT_ShellExtensions: TGUID = SID_EXT_ShellExtensions;
34 |
35 | SID_IThumbnailProvider = '{E357FCCD-A995-4576-B01F-234630154E96}';
36 | IID_IThumbnailProvider: TGUID = SID_IThumbnailProvider;
37 |
38 | darkBkColor = $202020;
39 | ID_IMAGE = 101; //dialog static control ID
40 |
41 | type
42 | TWTS_ALPHATYPE = (WTSAT_UNKNOWN, WTSAT_RGB, WTSAT_ARGB);
43 | PHBITMAP = ^HBITMAP;
44 |
45 | IThumbnailProvider = interface(IUnknown)
46 | [SID_IThumbnailProvider]
47 | function GetThumbnail(cx: Cardinal; out hbmp: HBITMAP;
48 | out at: TWTS_ALPHATYPE): HRESULT; stdcall;
49 | end;
50 |
51 | TQoiShelExt = class(TComObject,
52 | IPreviewHandler, IThumbnailProvider, IInitializeWithStream)
53 | strict private
54 | function IInitializeWithStream.Initialize = IInitializeWithStream_Init;
55 | //IPreviewHandler
56 | function DoPreview: HRESULT; stdcall;
57 | function QueryFocus(var phwnd: HWND): HRESULT; stdcall;
58 | function SetFocus: HRESULT; stdcall;
59 | function SetRect(var prc: TRect): HRESULT; stdcall;
60 | function SetWindow(hwnd: HWND; var prc: TRect): HRESULT; stdcall;
61 | function TranslateAccelerator(var pmsg: tagMSG): HRESULT; stdcall;
62 | function Unload: HRESULT; stdcall;
63 | //IThumbnailProvider
64 | function GetThumbnail(cx: Cardinal; out hbmp: HBITMAP; out at: TWTS_ALPHATYPE): HRESULT; stdcall;
65 | //IInitializeWithStream
66 | function IInitializeWithStream_Init(const pstream: IStream;
67 | grfMode: DWORD): HRESULT; stdcall;
68 | private
69 | FBounds : TRect;
70 | fParent : HWND;
71 | fDialog : HWND;
72 | fSrcImg : TImage32Rec;
73 | fStream : IStream;
74 | fDarkBrush: HBrush;
75 | fDarkModeChecked: Boolean;
76 | fDarkModeEnabled: Boolean;
77 | procedure CleanupObjects;
78 | procedure CheckDarkMode;
79 | procedure RedrawDialog;
80 | public
81 | destructor Destroy; override;
82 | end;
83 |
84 | implementation
85 |
86 | function GetStreamSize(stream: IStream): Cardinal;
87 | var
88 | statStg: TStatStg;
89 | begin
90 | if stream.Stat(statStg, STATFLAG_NONAME) = S_OK then
91 | Result := statStg.cbSize else
92 | Result := 0;
93 | end;
94 |
95 | function SetStreamPos(stream: IStream; pos: Int64): Int64;
96 | var
97 | res: LargeUInt;
98 | begin
99 | stream.Seek(pos, STREAM_SEEK_SET, res);
100 | Result := res;
101 | end;
102 |
103 | procedure FixAlpha(var img: TImage32Rec);
104 | var
105 | i: integer;
106 | begin
107 | //if the alpha channel is all 0's then reset to 255
108 | for i := 0 to High(img.pixels) do
109 | if img.pixels[i].A > 0 then Exit;
110 | for i := 0 to High(img.pixels) do
111 | img.pixels[i].A := 255;
112 | end;
113 | //------------------------------------------------------------------------------
114 |
115 | function Make32BitBitmapFromPxls(const img: TImage32Rec): HBitmap;
116 | var
117 | len : integer;
118 | dst : PARGB;
119 | bi : TBitmapV4Header;
120 | begin
121 | Result := 0;
122 | len := Length(img.pixels);
123 | if len <> img.width * img.height then Exit;
124 | FillChar(bi, sizeof(bi), #0);
125 | bi.bV4Size := sizeof(TBitmapV4Header);
126 | bi.bV4Width := img.width;
127 | bi.bV4Height := -img.height;
128 | bi.bV4Planes := 1;
129 | bi.bV4BitCount := 32;
130 | bi.bV4SizeImage := len *4;
131 | bi.bV4V4Compression := BI_RGB;
132 | bi.bV4RedMask := $FF shl 16;
133 | bi.bV4GreenMask := $FF shl 8;
134 | bi.bV4BlueMask := $FF;
135 | bi.bV4AlphaMask := Cardinal($FF) shl 24;
136 |
137 | Result := CreateDIBSection(0,
138 | PBitmapInfo(@bi)^, DIB_RGB_COLORS, Pointer(dst), 0, 0);
139 | Move(img.pixels[0], dst^, len * 4);
140 | end;
141 | //------------------------------------------------------------------------------
142 |
143 | function ClampByte(val: double): byte; inline;
144 | begin
145 | if val <= 0 then result := 0
146 | else if val >= 255 then result := 255
147 | else result := Round(val);
148 | end;
149 | //------------------------------------------------------------------------------
150 |
151 | type
152 | TWeightedColor = record
153 | private
154 | fAddCount : Integer;
155 | fAlphaTot : Int64;
156 | fColorTotR: Int64;
157 | fColorTotG: Int64;
158 | fColorTotB: Int64;
159 | function GetColor: TARGB;
160 | public
161 | procedure Reset; inline;
162 | procedure Add(c: TARGB; w: Integer = 1); overload;
163 | procedure Add(const other: TWeightedColor); overload; inline;
164 | procedure AddWeight(w: Integer); inline;
165 | property AddCount: Integer read fAddCount;
166 | property Color: TARGB read GetColor;
167 | property Weight: integer read fAddCount;
168 | end;
169 | TArrayOfWeightedColor = array of TWeightedColor;
170 |
171 | //------------------------------------------------------------------------------
172 | //------------------------------------------------------------------------------
173 |
174 | function BilinearResample(const img: TImage32Rec; x256, y256: Integer): TARGB;
175 | var
176 | xi,yi, weight: Integer;
177 | iw, ih: integer;
178 | color: TWeightedColor;
179 | xf, yf: cardinal;
180 | begin
181 | iw := img.Width;
182 | ih := img.Height;
183 |
184 | if (x256 <= -$100) or (x256 >= iw *$100) or
185 | (y256 <= -$100) or (y256 >= ih *$100) then
186 | begin
187 | result.Color := 0;
188 | Exit;
189 | end;
190 |
191 | if x256 < 0 then xi := -1
192 | else xi := x256 shr 8;
193 |
194 | if y256 < 0 then yi := -1
195 | else yi := y256 shr 8;
196 |
197 | xf := x256 and $FF;
198 | yf := y256 and $FF;
199 |
200 | color.Reset;
201 |
202 | weight := (($100 - xf) * ($100 - yf)) shr 8; //top-left
203 | if (xi < 0) or (yi < 0) then
204 | color.AddWeight(weight) else
205 | color.Add(img.Pixels[xi + yi * iw], weight);
206 |
207 | weight := (xf * ($100 - yf)) shr 8; //top-right
208 | if ((xi+1) >= iw) or (yi < 0) then
209 | color.AddWeight(weight) else
210 | color.Add(img.Pixels[(xi+1) + yi * iw], weight);
211 |
212 | weight := (($100 - xf) * yf) shr 8; //bottom-left
213 | if (xi < 0) or ((yi+1) >= ih) then
214 | color.AddWeight(weight) else
215 | color.Add(img.Pixels[xi + (yi+1) * iw], weight);
216 |
217 | weight := (xf * yf) shr 8; //bottom-right
218 | if (xi + 1 >= iw) or (yi + 1 >= ih) then
219 | color.AddWeight(weight) else
220 | color.Add(img.Pixels[(xi+1) + (yi+1) * iw], weight);
221 |
222 | Result := color.Color;
223 | end;
224 | //------------------------------------------------------------------------------
225 |
226 | function ImageResize(const img: TImage32Rec;
227 | newWidth, newHeight: integer): TImage32Rec;
228 | var
229 | i,j: integer;
230 | invX,invY: double;
231 | pc: PARGB;
232 | begin
233 | Result.width := newWidth;
234 | Result.height := newHeight;
235 | SetLength(Result.pixels, newWidth * newHeight);
236 | invX := 256 *img.width/newWidth;
237 | invY := 256 *img.height/newHeight;
238 |
239 | pc := @Result.pixels[0];
240 | for i := 0 to + newHeight -1 do
241 | for j := 0 to newWidth -1 do
242 | begin
243 | pc^ := BilinearResample(img,
244 | Round(j * invX), Round(i * invY));
245 | inc(pc);
246 | end;
247 | end;
248 |
249 | //------------------------------------------------------------------------------
250 | // TQoiPreviewHandler
251 | //------------------------------------------------------------------------------
252 |
253 | destructor TQoiShelExt.Destroy;
254 | begin
255 | CleanupObjects;
256 | fStream := nil;
257 | inherited Destroy;
258 | end;
259 | //------------------------------------------------------------------------------
260 |
261 | procedure TQoiShelExt.CheckDarkMode;
262 | var
263 | reg: TRegistry;
264 | begin
265 | fDarkModeChecked := true;
266 | reg := TRegistry.Create(KEY_READ); //specific access rights important here
267 | try
268 | reg.RootKey := HKEY_CURRENT_USER;
269 | fDarkModeEnabled := reg.OpenKey(
270 | 'SOFTWARE\Microsoft\Windows\CurrentVersion\Themes\Personalize', false) and
271 | reg.ValueExists('SystemUsesLightTheme') and
272 | (reg.ReadInteger('SystemUsesLightTheme') = 0);
273 | finally
274 | reg.Free;
275 | end;
276 | end;
277 | //------------------------------------------------------------------------------
278 |
279 | procedure TQoiShelExt.CleanupObjects;
280 | var
281 | imgCtrl: HWnd;
282 | begin
283 | fSrcImg.pixels := nil;
284 | if fDialog <> 0 then
285 | begin
286 | imgCtrl := GetDlgItem(fDialog, ID_IMAGE);
287 | //https://devblogs.microsoft.com/oldnewthing/20140219-00/?p=1713
288 | DeleteObject(SendMessage(imgCtrl, STM_SETIMAGE, IMAGE_BITMAP, 0));
289 | DestroyWindow(fDialog);
290 | fDialog := 0;
291 | if fDarkBrush <> 0 then DeleteObject(fDarkBrush);
292 | fDarkBrush := 0;
293 | end;
294 | end;
295 | //------------------------------------------------------------------------------
296 |
297 | procedure TQoiShelExt.RedrawDialog;
298 | var
299 | l,t,w,h : integer;
300 | scale : double;
301 | imgCtrl : HWnd;
302 | img : TImage32Rec;
303 | bm,oldBm: HBitmap;
304 | begin
305 | if fDialog = 0 then Exit;
306 | w := RectWidth(FBounds);
307 | h := RectHeight(FBounds);
308 |
309 | scale := Min(w/fSrcImg.width, h/fSrcImg.height);
310 | w := Round(fSrcImg.width * scale);
311 | h := Round(fSrcImg.height * scale);
312 | l := (RectWidth(FBounds)- w) div 2;
313 | t := (RectHeight(FBounds)- h) div 2;
314 |
315 | FixAlpha(fSrcImg); //do this before resizing
316 | img := ImageResize(fSrcImg, w, h); //much better that using STRETCHDIBITS
317 | bm := Make32BitBitmapFromPxls(img);
318 | imgCtrl := GetDlgItem(fDialog, ID_IMAGE);
319 |
320 | SetWindowPos(fDialog, 0, l,t,w,h, SWP_NOZORDER or SWP_NOACTIVATE);
321 | SetWindowPos(imgCtrl, 0, 0,0,w,h, SWP_NOZORDER or SWP_NOACTIVATE);
322 | oldBm := SendMessage(imgCtrl, STM_SETIMAGE, IMAGE_BITMAP, bm);
323 | if oldBm <> 0 then DeleteObject(oldBm);
324 | DeleteObject(bm);
325 | end;
326 | //------------------------------------------------------------------------------
327 |
328 | function DlgProc(dlg: HWnd; msg, wPar: WPARAM; lPar: LPARAM): Bool; stdcall;
329 | var
330 | svgShellExt: TQoiShelExt;
331 | begin
332 | case msg of
333 | WM_CTLCOLORDLG, WM_CTLCOLORSTATIC:
334 | begin
335 | svgShellExt := Pointer(GetWindowLongPtr(dlg, GWLP_USERDATA));
336 | if Assigned(svgShellExt) and (svgShellExt.fDarkBrush <> 0) then
337 | Result := Bool(svgShellExt.fDarkBrush) else
338 | Result := Bool(GetSysColorBrush(COLOR_WINDOW));
339 | end;
340 | else
341 | Result := False;
342 | end;
343 | end;
344 | //------------------------------------------------------------------------------
345 |
346 | function TQoiShelExt.DoPreview: HRESULT;
347 | var
348 | qoiBytes : TArrayOfByte;
349 | size,dum : Cardinal;
350 | begin
351 | result := S_OK;
352 | if (fParent = 0) or FBounds.IsEmpty then Exit;
353 | CleanupObjects;
354 |
355 | if not fDarkModeChecked then
356 | CheckDarkMode;
357 | //get file contents and put into qoiBytes
358 | size := GetStreamSize(fStream);
359 | if size = 0 then Exit;
360 | SetLength(qoiBytes, size);
361 | SetStreamPos(fStream, 0);
362 | fStream.Read(@qoiBytes[0], size, @dum);
363 |
364 | //extract image from qoiBytes and fill fSrcImg
365 | fSrcImg := ReadQoi(qoiBytes);
366 | if fSrcImg.pixels = nil then Exit;
367 |
368 | //create the display dialog containing an image control
369 | fDialog := CreateDialog(hInstance, MAKEINTRESOURCE(1), fParent, @DlgProc);
370 | SetWindowLongPtr(fDialog, GWLP_USERDATA, NativeInt(self));
371 | if fDarkModeEnabled then
372 | fDarkBrush := CreateSolidBrush(darkBkColor);
373 | //draw and show the display dialog
374 | RedrawDialog;
375 | ShowWindow(fDialog, SW_SHOW);
376 | end;
377 | //------------------------------------------------------------------------------
378 |
379 | function TQoiShelExt.QueryFocus(var phwnd: HWND): HRESULT;
380 | begin
381 | phwnd := GetFocus;
382 | result := S_OK;
383 | end;
384 | //------------------------------------------------------------------------------
385 |
386 | function TQoiShelExt.SetFocus: HRESULT;
387 | begin
388 | result := S_OK;
389 | end;
390 | //------------------------------------------------------------------------------
391 |
392 | function TQoiShelExt.SetRect(var prc: TRect): HRESULT;
393 | begin
394 | FBounds := prc;
395 | RedrawDialog;
396 | result := S_OK;
397 | end;
398 | //------------------------------------------------------------------------------
399 |
400 | function TQoiShelExt.SetWindow(hwnd: HWND; var prc: TRect): HRESULT;
401 | begin
402 | if (hwnd <> 0) then fParent := hwnd;
403 | if (@prc <> nil) then FBounds := prc;
404 | CleanupObjects;
405 | result := S_OK;
406 | end;
407 | //------------------------------------------------------------------------------
408 |
409 | function TQoiShelExt.TranslateAccelerator(var pmsg: tagMSG): HRESULT;
410 | begin
411 | result := S_FALSE
412 | end;
413 | //------------------------------------------------------------------------------
414 |
415 | function TQoiShelExt.Unload: HRESULT;
416 | begin
417 | CleanupObjects;
418 | fStream := nil;
419 | fParent := 0;
420 | result := S_OK;
421 | end;
422 | //------------------------------------------------------------------------------
423 |
424 | function TQoiShelExt.IInitializeWithStream_Init(const pstream: IStream;
425 | grfMode: DWORD): HRESULT;
426 | begin
427 | fStream := nil;
428 | fStream := pstream;
429 | result := S_OK;
430 | end;
431 | //------------------------------------------------------------------------------
432 |
433 | function TQoiShelExt.GetThumbnail(cx: Cardinal;
434 | out hbmp: HBITMAP; out at: TWTS_ALPHATYPE): HRESULT;
435 | var
436 | size, dum : Cardinal;
437 | w,h : integer;
438 | scale : double;
439 | img : TImage32Rec;
440 | qoiBytes : TArrayOfByte;
441 | begin
442 | result := S_FALSE;
443 | if fStream = nil then Exit;
444 |
445 | //get file contents and put into qoiBytes
446 | size := GetStreamSize(fStream);
447 | SetStreamPos(fStream, 0);
448 | SetLength(qoiBytes, size);
449 | result := fStream.Read(@qoiBytes[0], size, @dum);
450 | if not Succeeded(Result) then Exit;
451 |
452 | //extract image from qoiBytes and fill img
453 | img := ReadQoi(qoiBytes);
454 | if img.pixels = nil then Exit;
455 | at := WTSAT_ARGB;
456 |
457 | scale := Min(cx/img.width, cx/img.height);
458 | w := Round(img.width * scale);
459 | h := Round(img.height * scale);
460 |
461 | FixAlpha(img); //do this before resizing
462 | img := ImageResize(img, w, h); //much better that using STRETCHDIBITS
463 | hbmp := Make32BitBitmapFromPxls(img);
464 | end;
465 |
466 | //------------------------------------------------------------------------------
467 | // TWeightedColor
468 | //------------------------------------------------------------------------------
469 |
470 | procedure TWeightedColor.Reset;
471 | begin
472 | fAddCount := 0;
473 | fAlphaTot := 0;
474 | fColorTotR := 0;
475 | fColorTotG := 0;
476 | fColorTotB := 0;
477 | end;
478 | //------------------------------------------------------------------------------
479 |
480 | procedure TWeightedColor.AddWeight(w: Integer);
481 | begin
482 | inc(fAddCount, w);
483 | end;
484 | //------------------------------------------------------------------------------
485 |
486 | procedure TWeightedColor.Add(c: TARGB; w: Integer);
487 | var
488 | a: Integer;
489 | argb: TARGB absolute c;
490 | begin
491 | inc(fAddCount, w);
492 | a := w * argb.A;
493 | if a = 0 then Exit;
494 | inc(fAlphaTot, a);
495 | inc(fColorTotB, (a * argb.B));
496 | inc(fColorTotG, (a * argb.G));
497 | inc(fColorTotR, (a * argb.R));
498 | end;
499 | //------------------------------------------------------------------------------
500 |
501 | procedure TWeightedColor.Add(const other: TWeightedColor);
502 | begin
503 | inc(fAddCount, other.fAddCount);
504 | inc(fAlphaTot, other.fAlphaTot);
505 | inc(fColorTotR, other.fColorTotR);
506 | inc(fColorTotG, other.fColorTotG);
507 | inc(fColorTotB, other.fColorTotB);
508 | end;
509 | //------------------------------------------------------------------------------
510 |
511 | function TWeightedColor.GetColor: TARGB;
512 | var
513 | invAlpha: double;
514 | res: TARGB absolute Result;
515 | begin
516 | if (fAlphaTot <= 0) or (fAddCount <= 0) then
517 | begin
518 | result.Color := 0;
519 | Exit;
520 | end;
521 | res.A := Min(255, (fAlphaTot + (fAddCount shr 1)) div fAddCount);
522 | //nb: alpha weighting is applied to colors when added,
523 | //so we now need to div by fAlphaTot here ...
524 | invAlpha := 1/fAlphaTot;
525 | res.R := ClampByte(fColorTotR * invAlpha);
526 | res.G := ClampByte(fColorTotG * invAlpha);
527 | res.B := ClampByte(fColorTotB * invAlpha);
528 | end;
529 | //------------------------------------------------------------------------------
530 | //------------------------------------------------------------------------------
531 |
532 | var
533 | res: HResult;
534 |
535 | initialization
536 | res := OleInitialize(nil);
537 | TComObjectFactory.Create(ComServer,
538 | TQoiShelExt, IID_EXT_ShellExtensions,
539 | extFile, extDescription, ciMultiInstance, tmApartment);
540 |
541 | finalization
542 | if res = S_OK then OleUninitialize();
543 |
544 | end.
545 |
--------------------------------------------------------------------------------
/QoiShellExtensions/source/QoiReader.pas:
--------------------------------------------------------------------------------
1 | unit QoiReader;
2 |
3 | (*******************************************************************************
4 | * Author : Angus Johnson *
5 | * Version : 0.99 *
6 | * Date : 17 January 2022 *
7 | * Website : http://www.angusj.com *
8 | * Copyright : Angus Johnson 2022 *
9 | * *
10 | * Purpose : QOI image file decompiler *
11 | * *
12 | * License : Use, modification & distribution is subject to *
13 | * Boost Software License Ver 1 *
14 | * http://www.boost.org/LICENSE_1_0.txt *
15 | *******************************************************************************)
16 |
17 | interface
18 |
19 | type
20 | PARGB = ^TARGB;
21 | TARGB = packed record
22 | case Boolean of
23 | false: (B,G,R,A: Byte);
24 | true: (Color: Cardinal);
25 | end;
26 | TArrayOfARGB = array of TARGB;
27 |
28 | TImage32Rec = record
29 | width : integer;
30 | height : integer;
31 | pixels : TArrayOfARGB;
32 | end;
33 |
34 | TArrayOfByte = array of Byte;
35 |
36 | function ReadQoi(bytes: TArrayOfByte): TImage32Rec;
37 |
38 | implementation
39 |
40 | const
41 | QOI_OP_INDEX = $0;
42 | QOI_OP_DIFF = $40;
43 | QOI_OP_LUMA = $80;
44 | QOI_OP_RUN = $C0;
45 | QOI_OP_RGB = $FE;
46 | QOI_OP_RGBA = $FF;
47 | QOI_MASK_2 = $C0;
48 | QOI_MAGIC = $66696F71;
49 | QOI_HEADER_SIZE = 14;
50 | qoi_padding: array[0..7] of byte = (0,0,0,0,0,0,0,1);
51 | qoi_padding_size = 8;
52 |
53 | type
54 | TQOI_DESC = packed record
55 | magic : Cardinal;
56 | width : Cardinal;
57 | height : Cardinal;
58 | channels : byte;
59 | colorspace : byte;
60 | end;
61 | //------------------------------------------------------------------------------
62 | //------------------------------------------------------------------------------
63 |
64 | function QOI_COLOR_HASH(c: TARGB): Byte; {$IFDEF INLINE} inline; {$ENDIF}
65 | begin
66 | Result := (c.R*3 + c.G*5 + c.B*7 + c.A*11) mod 64;
67 | end;
68 | //------------------------------------------------------------------------------
69 |
70 | function SwapBytes(Value: Cardinal): Cardinal;
71 | var
72 | v: array[0..3] of byte absolute Value;
73 | r: array[0..3] of byte absolute Result;
74 | begin
75 | r[3] := v[0];
76 | r[2] := v[1];
77 | r[1] := v[2];
78 | r[0] := v[3];
79 | end;
80 | //------------------------------------------------------------------------------
81 |
82 | function ReadByte(var p: PByte): Byte; {$IFDEF INLINE} inline; {$ENDIF}
83 | begin
84 | Result := p^;
85 | inc(p);
86 | end;
87 | //------------------------------------------------------------------------------
88 |
89 | function ReadQoi(bytes: TArrayOfByte): TImage32Rec;
90 | var
91 | i, size, run, vg: integer;
92 | desc: TQOI_DESC;
93 | index: array[0..63] of TARGB;
94 | px: TARGB;
95 | b1, b2: byte;
96 | dst: PARGB;
97 | src: PByte;
98 | begin
99 | Result.width := 0;
100 | Result.height := 0;
101 | Result.pixels := nil;
102 |
103 | size := Length(bytes);
104 | if size < QOI_HEADER_SIZE + qoi_padding_size then Exit;
105 | src := @bytes[0];
106 |
107 | Move(src^, desc, SizeOf(TQOI_DESC));
108 | inc(src, SizeOf(TQOI_DESC));
109 | with desc do
110 | begin
111 | width := SwapBytes(width);
112 | height := SwapBytes(height);
113 | if (magic <> QOI_MAGIC) or (width = 0) or (height = 0) or
114 | (channels < 3) or (channels > 4) or (colorspace > 1) then
115 | Exit;
116 | Result.width := width;
117 | Result.height := height;
118 | SetLength(Result.pixels, width * height);
119 | end;
120 | if Result.pixels = nil then Exit;
121 |
122 | dst := @Result.pixels[0];
123 | px.Color := $FF000000;
124 | run := 0;
125 | FillChar(index, SizeOf(index), 0);
126 |
127 | for i := 0 to Result.width * Result.height - 1 do
128 | begin
129 | if (run > 0) then
130 | begin
131 | Dec(run);
132 | end else
133 | begin
134 | b1 := ReadByte(src);
135 | if (b1 = QOI_OP_RGB) then
136 | begin
137 | px.R := ReadByte(src);
138 | px.G := ReadByte(src);
139 | px.B := ReadByte(src);
140 | end
141 | else if (b1 = QOI_OP_RGBA) then
142 | begin
143 | px.R := ReadByte(src);
144 | px.G := ReadByte(src);
145 | px.B := ReadByte(src);
146 | px.A := ReadByte(src);
147 | end
148 | else if ((b1 and QOI_MASK_2) = QOI_OP_INDEX) then
149 | begin
150 | px := index[b1];
151 | end
152 | else if (b1 and QOI_MASK_2) = QOI_OP_DIFF then
153 | begin
154 | px.R := px.R + ((b1 shr 4) and 3) - 2;
155 | px.G := px.G + ((b1 shr 2) and 3) - 2;
156 | px.B := px.B + (b1 and 3) - 2;
157 | end
158 | else if (b1 and QOI_MASK_2) = QOI_OP_LUMA then
159 | begin
160 | b2 := ReadByte(src);
161 | vg := (b1 and $3f) - 32;
162 | px.R := px.R + vg - 8 + ((b2 shr 4) and $f);
163 | px.G := px.G + vg;
164 | px.B := px.B + vg - 8 + (b2 and $f);
165 | end
166 | else if (b1 and QOI_MASK_2) = QOI_OP_RUN then
167 | run := (b1 and $3f);
168 | index[QOI_COLOR_HASH(px)] := px;
169 | end;
170 | dst^ := px;
171 | inc(dst);
172 | end;
173 | end;
174 |
175 | end.
176 |
--------------------------------------------------------------------------------
/QoiShellExtensions/source/QoiShellExtensions.dpr:
--------------------------------------------------------------------------------
1 | library QoiShellExtensions;
2 |
3 | (*******************************************************************************
4 | * Author : Angus Johnson *
5 | * Version : 1.0 *
6 | * Date : 19 January 2022 *
7 | * Website : http://www.angusj.com *
8 | * Copyright : Angus Johnson 2022 *
9 | * *
10 | * Purpose : 64bit Windows Explorer Preview Handler for QOI image files *
11 | * *
12 | * License : Use, modification & distribution is subject to *
13 | * Boost Software License Ver 1 *
14 | * http://www.boost.org/LICENSE_1_0.txt *
15 | *******************************************************************************)
16 |
17 | uses
18 | Windows,
19 | Winapi.ShlObj,
20 | Winapi.ActiveX,
21 | System.Classes,
22 | System.SysUtils,
23 | System.Win.ComServ,
24 | System.Win.Registry,
25 | QoiPreview in 'QoiPreview.pas',
26 | QoiReader in 'QoiReader.pas';
27 |
28 | {$R *.res}
29 |
30 | const
31 | sSurrogateId = '{6D2B5079-2F0B-48DD-AB7F-97CEC514D30B}'; //64bit
32 |
33 | function GetModuleName: string;
34 | var
35 | i: integer;
36 | begin
37 | SetLength(Result, MAX_PATH);
38 | i := GetModuleFileName(hInstance, @Result[1], MAX_PATH);
39 | SetLength(Result, i);
40 | end;
41 | //------------------------------------------------------------------------------
42 | //------------------------------------------------------------------------------
43 |
44 | function DllRegisterServer: HResult; stdcall;
45 | var
46 | reg: TRegistry;
47 | begin
48 | Result := E_UNEXPECTED; //will fail if not ADMIN
49 |
50 | reg := TRegistry.Create(KEY_ALL_ACCESS);
51 | try
52 | reg.RootKey := HKEY_CLASSES_ROOT;
53 | if not reg.OpenKey(extension, true) then Exit;
54 | reg.WriteString('', extFile);
55 | reg.CloseKey;
56 |
57 | if reg.OpenKey(extFile+'\Clsid', true) then
58 | begin
59 | reg.WriteString('', SID_EXT_ShellExtensions);
60 | reg.CloseKey;
61 | end;
62 |
63 | //REGISTER PREVIEW HANDLER
64 | if reg.OpenKey(extFile+'\ShellEx\'+SID_IPreviewHandler, true) then
65 | begin
66 | reg.WriteString('', SID_EXT_ShellExtensions);
67 | reg.CloseKey;
68 | end;
69 | //REGISTER THUMBNAIL PROVIDER
70 | if reg.OpenKey(extFile+'\ShellEx\'+SID_IThumbnailProvider, true) then
71 | begin
72 | reg.WriteString('', SID_EXT_ShellExtensions);
73 | reg.CloseKey;
74 | end;
75 |
76 | if not reg.OpenKey('CLSID\'+ SID_EXT_ShellExtensions, true) then Exit;
77 | reg.WriteString('', extDescription);
78 | reg.WriteString('AppID', sSurrogateId);
79 | reg.CloseKey;
80 |
81 | reg.OpenKey('CLSID\'+ SID_EXT_ShellExtensions+'\InProcServer32', true);
82 | reg.WriteString('', GetModuleName);
83 | reg.WriteString('ThreadingModel', 'Apartment');
84 | reg.CloseKey;
85 |
86 | reg.OpenKey('CLSID\' + SID_EXT_ShellExtensions + '\ProgId', true);
87 | reg.WriteString('', extFile);
88 | reg.CloseKey;
89 |
90 | reg.RootKey := HKEY_LOCAL_MACHINE;
91 | if reg.OpenKey('SOFTWARE\Microsoft\Windows\'+
92 | 'CurrentVersion\PreviewHandlers', true) then
93 | begin
94 | reg.WriteString(SID_EXT_ShellExtensions, extDescription);
95 | reg.CloseKey;
96 | end;
97 |
98 | finally
99 | reg.Free;
100 | end;
101 |
102 | //Invalidate the shell's cache so any .qoi files viewed
103 | //before registering won't show blank images.
104 | SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_IDLIST, nil, nil);
105 |
106 | Result := S_OK;
107 | end;
108 |
109 | function DllUnregisterServer: HResult; stdcall;
110 | var
111 | reg: TRegistry;
112 | begin
113 | reg := TRegistry.Create(KEY_ALL_ACCESS);
114 | try
115 | reg.RootKey := HKEY_LOCAL_MACHINE;
116 | if reg.OpenKey('SOFTWARE\Microsoft\Windows\'+
117 | 'CurrentVersion\PreviewHandlers', true) and
118 | reg.ValueExists(SID_EXT_ShellExtensions) then
119 | reg.DeleteValue(SID_EXT_ShellExtensions);
120 |
121 | reg.RootKey := HKEY_CLASSES_ROOT;
122 | reg.DeleteKey('CLSID\'+SID_EXT_ShellExtensions);
123 | reg.DeleteKey(extFile+'\ShellEx\'+SID_IPreviewHandler);
124 | reg.DeleteKey(extFile+'\ShellEx\'+SID_IThumbnailProvider);
125 | reg.DeleteKey(extFile+'\Clsid');
126 | finally
127 | reg.Free;
128 | end;
129 | Result := S_OK;
130 | end;
131 |
132 | exports
133 | DllRegisterServer,
134 | DllUnregisterServer,
135 | DllGetClassObject,
136 | DllCanUnloadNow;
137 |
138 | begin
139 | end.
140 |
--------------------------------------------------------------------------------
/QoiShellExtensions/source/QoiShellExtensions.dproj:
--------------------------------------------------------------------------------
1 |
2 |
3 | {A6240E7D-9C2D-41AD-B8C6-B35A0529166E}
4 | 19.2
5 | None
6 | True
7 | Release
8 | Win64
9 | 2
10 | Library
11 | QoiShellExtensions.dpr
12 |
13 |
14 | true
15 |
16 |
17 | true
18 | Base
19 | true
20 |
21 |
22 | true
23 | Base
24 | true
25 |
26 |
27 | true
28 | Base
29 | true
30 |
31 |
32 | true
33 | Base
34 | true
35 |
36 |
37 | true
38 | Base
39 | true
40 |
41 |
42 | true
43 | Cfg_1
44 | true
45 | true
46 |
47 |
48 | true
49 | Cfg_1
50 | true
51 | true
52 |
53 |
54 | true
55 | Base
56 | true
57 |
58 |
59 | .\$(Platform)\$(Config)
60 | .\$(Platform)\$(Config)
61 | false
62 | false
63 | false
64 | false
65 | false
66 | true
67 | System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace)
68 | QoiShellExtensions
69 |
70 |
71 | package=com.embarcadero.$(MSBuildProjectName);label=$(MSBuildProjectName);versionCode=1;versionName=1.0.0;persistent=False;restoreAnyVersion=False;installLocation=auto;largeHeap=False;theme=TitleBar;hardwareAccelerated=true;apiKey=
72 | Debug
73 | android-support-v4.dex.jar;cloud-messaging.dex.jar;com-google-android-gms.play-services-ads-base.17.2.0.dex.jar;com-google-android-gms.play-services-ads-identifier.16.0.0.dex.jar;com-google-android-gms.play-services-ads-lite.17.2.0.dex.jar;com-google-android-gms.play-services-ads.17.2.0.dex.jar;com-google-android-gms.play-services-analytics-impl.16.0.8.dex.jar;com-google-android-gms.play-services-analytics.16.0.8.dex.jar;com-google-android-gms.play-services-base.16.0.1.dex.jar;com-google-android-gms.play-services-basement.16.2.0.dex.jar;com-google-android-gms.play-services-gass.17.2.0.dex.jar;com-google-android-gms.play-services-identity.16.0.0.dex.jar;com-google-android-gms.play-services-maps.16.1.0.dex.jar;com-google-android-gms.play-services-measurement-base.16.4.0.dex.jar;com-google-android-gms.play-services-measurement-sdk-api.16.4.0.dex.jar;com-google-android-gms.play-services-stats.16.0.1.dex.jar;com-google-android-gms.play-services-tagmanager-v4-impl.16.0.8.dex.jar;com-google-android-gms.play-services-tasks.16.0.1.dex.jar;com-google-android-gms.play-services-wallet.16.0.1.dex.jar;com-google-firebase.firebase-analytics.16.4.0.dex.jar;com-google-firebase.firebase-common.16.1.0.dex.jar;com-google-firebase.firebase-iid-interop.16.0.1.dex.jar;com-google-firebase.firebase-iid.17.1.1.dex.jar;com-google-firebase.firebase-measurement-connector.17.0.1.dex.jar;com-google-firebase.firebase-messaging.17.5.0.dex.jar;fmx.dex.jar;google-play-billing.dex.jar;google-play-licensing.dex.jar
74 |
75 |
76 | package=com.embarcadero.$(MSBuildProjectName);label=$(MSBuildProjectName);versionCode=1;versionName=1.0.0;persistent=False;restoreAnyVersion=False;installLocation=auto;largeHeap=False;theme=TitleBar;hardwareAccelerated=true;apiKey=
77 | Debug
78 | android-support-v4.dex.jar;cloud-messaging.dex.jar;com-google-android-gms.play-services-ads-base.17.2.0.dex.jar;com-google-android-gms.play-services-ads-identifier.16.0.0.dex.jar;com-google-android-gms.play-services-ads-lite.17.2.0.dex.jar;com-google-android-gms.play-services-ads.17.2.0.dex.jar;com-google-android-gms.play-services-analytics-impl.16.0.8.dex.jar;com-google-android-gms.play-services-analytics.16.0.8.dex.jar;com-google-android-gms.play-services-base.16.0.1.dex.jar;com-google-android-gms.play-services-basement.16.2.0.dex.jar;com-google-android-gms.play-services-gass.17.2.0.dex.jar;com-google-android-gms.play-services-identity.16.0.0.dex.jar;com-google-android-gms.play-services-maps.16.1.0.dex.jar;com-google-android-gms.play-services-measurement-base.16.4.0.dex.jar;com-google-android-gms.play-services-measurement-sdk-api.16.4.0.dex.jar;com-google-android-gms.play-services-stats.16.0.1.dex.jar;com-google-android-gms.play-services-tagmanager-v4-impl.16.0.8.dex.jar;com-google-android-gms.play-services-tasks.16.0.1.dex.jar;com-google-android-gms.play-services-wallet.16.0.1.dex.jar;com-google-firebase.firebase-analytics.16.4.0.dex.jar;com-google-firebase.firebase-common.16.1.0.dex.jar;com-google-firebase.firebase-iid-interop.16.0.1.dex.jar;com-google-firebase.firebase-iid.17.1.1.dex.jar;com-google-firebase.firebase-measurement-connector.17.0.1.dex.jar;com-google-firebase.firebase-messaging.17.5.0.dex.jar;fmx.dex.jar;google-play-billing.dex.jar;google-play-licensing.dex.jar
79 |
80 |
81 | DBXSqliteDriver;RESTComponents;IndyIPCommon;bindcompdbx;DBXInterBaseDriver;vcl;IndyIPServer;vclactnband;vclFireDAC;IndySystem;bindcompvclsmp;tethering;svnui;bindcompvclwinx;dsnapcon;FireDACADSDriver;FireDACMSAccDriver;fmxFireDAC;Img32_Library;vclimg;FireDAC;vcltouch;vcldb;bindcompfmx;svn;FireDACSqliteDriver;FireDACPgDriver;inetdb;VirtualTreesDR;soaprtl;DbxCommonDriver;fmx;FireDACIBDriver;fmxdae;xmlrtl;soapmidas;vcledge;fmxobj;vclwinx;rtl;DbxClientDriver;CustomIPTransport;vcldsnap;dbexpress;IndyCore;vclx;bindcomp;appanalytics;dsnap;SVGIconImageListFMX;FireDACCommon;IndyIPClient;bindcompvcl;RESTBackendComponents;SVGIconImageList;VCLRESTComponents;soapserver;dbxcds;VclSmp;adortl;Img32_VCL_Dsgn;vclie;bindengine;DBXMySQLDriver;CloudService;SVGIconPackage;FireDACMySQLDriver;dbrtl;IndyProtocols;inetdbxpress;dsnapxml;FireDACCommonODBC;FireDACCommonDriver;awj;inet;fmxase;$(DCC_UsePackage)
82 | Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)
83 | Debug
84 | true
85 | CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=
86 | 1033
87 | .\dcu
88 | .\
89 | (None)
90 |
91 |
92 | DBXSqliteDriver;RESTComponents;IndyIPCommon;bindcompdbx;DBXInterBaseDriver;vcl;IndyIPServer;vclactnband;vclFireDAC;IndySystem;bindcompvclsmp;tethering;bindcompvclwinx;dsnapcon;FireDACADSDriver;FireDACMSAccDriver;fmxFireDAC;vclimg;FireDAC;vcltouch;vcldb;bindcompfmx;FireDACSqliteDriver;FireDACPgDriver;inetdb;VirtualTreesDR;soaprtl;DbxCommonDriver;fmx;FireDACIBDriver;fmxdae;xmlrtl;soapmidas;vcledge;fmxobj;vclwinx;rtl;DbxClientDriver;CustomIPTransport;vcldsnap;dbexpress;IndyCore;vclx;bindcomp;appanalytics;dsnap;SVGIconImageListFMX;FireDACCommon;IndyIPClient;bindcompvcl;RESTBackendComponents;SVGIconImageList;VCLRESTComponents;soapserver;dbxcds;VclSmp;adortl;vclie;bindengine;DBXMySQLDriver;CloudService;SVGIconPackage;FireDACMySQLDriver;dbrtl;IndyProtocols;inetdbxpress;dsnapxml;FireDACCommonODBC;FireDACCommonDriver;inet;fmxase;$(DCC_UsePackage)
93 | Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace)
94 | Debug
95 | true
96 | CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=
97 | 1033
98 | .\
99 | .\dcu
100 | (None)
101 |
102 |
103 | DEBUG;$(DCC_Define)
104 | true
105 | false
106 | true
107 | true
108 | true
109 |
110 |
111 | false
112 | .\
113 | .\dcu
114 | true
115 | 1033
116 | (None)
117 |
118 |
119 | true
120 | 1033
121 |
122 |
123 | false
124 | RELEASE;$(DCC_Define)
125 | 0
126 | 0
127 |
128 |
129 |
130 | MainSource
131 |
132 |
133 |
134 |
135 | Cfg_2
136 | Base
137 |
138 |
139 | Base
140 |
141 |
142 | Cfg_1
143 | Base
144 |
145 |
146 |
147 | Delphi.Personality.12
148 | Application
149 |
150 |
151 |
152 | QoiShellExtensions.dpr
153 |
154 |
155 | Microsoft Office 2000 Sample Automation Server Wrapper Components
156 | Microsoft Office XP Sample Automation Server Wrapper Components
157 |
158 |
159 |
160 |
161 |
162 | QoiShellExtensions.dll
163 | true
164 |
165 |
166 |
167 |
168 | true
169 |
170 |
171 |
172 |
173 | true
174 |
175 |
176 |
177 |
178 | true
179 |
180 |
181 |
182 |
183 | QoiShellExtensions.dll
184 | true
185 |
186 |
187 |
188 |
189 | QoiShellExtensions.dll
190 | true
191 |
192 |
193 |
194 |
195 | 1
196 |
197 |
198 | Contents\MacOS
199 | 1
200 |
201 |
202 | 0
203 |
204 |
205 |
206 |
207 | classes
208 | 1
209 |
210 |
211 | classes
212 | 1
213 |
214 |
215 |
216 |
217 | res\xml
218 | 1
219 |
220 |
221 | res\xml
222 | 1
223 |
224 |
225 |
226 |
227 | library\lib\armeabi-v7a
228 | 1
229 |
230 |
231 |
232 |
233 | library\lib\armeabi
234 | 1
235 |
236 |
237 | library\lib\armeabi
238 | 1
239 |
240 |
241 |
242 |
243 | library\lib\armeabi-v7a
244 | 1
245 |
246 |
247 |
248 |
249 | library\lib\mips
250 | 1
251 |
252 |
253 | library\lib\mips
254 | 1
255 |
256 |
257 |
258 |
259 | library\lib\armeabi-v7a
260 | 1
261 |
262 |
263 | library\lib\arm64-v8a
264 | 1
265 |
266 |
267 |
268 |
269 | library\lib\armeabi-v7a
270 | 1
271 |
272 |
273 |
274 |
275 | res\drawable
276 | 1
277 |
278 |
279 | res\drawable
280 | 1
281 |
282 |
283 |
284 |
285 | res\values
286 | 1
287 |
288 |
289 | res\values
290 | 1
291 |
292 |
293 |
294 |
295 | res\values-v21
296 | 1
297 |
298 |
299 | res\values-v21
300 | 1
301 |
302 |
303 |
304 |
305 | res\values
306 | 1
307 |
308 |
309 | res\values
310 | 1
311 |
312 |
313 |
314 |
315 | res\drawable
316 | 1
317 |
318 |
319 | res\drawable
320 | 1
321 |
322 |
323 |
324 |
325 | res\drawable-xxhdpi
326 | 1
327 |
328 |
329 | res\drawable-xxhdpi
330 | 1
331 |
332 |
333 |
334 |
335 | res\drawable-xxxhdpi
336 | 1
337 |
338 |
339 | res\drawable-xxxhdpi
340 | 1
341 |
342 |
343 |
344 |
345 | res\drawable-ldpi
346 | 1
347 |
348 |
349 | res\drawable-ldpi
350 | 1
351 |
352 |
353 |
354 |
355 | res\drawable-mdpi
356 | 1
357 |
358 |
359 | res\drawable-mdpi
360 | 1
361 |
362 |
363 |
364 |
365 | res\drawable-hdpi
366 | 1
367 |
368 |
369 | res\drawable-hdpi
370 | 1
371 |
372 |
373 |
374 |
375 | res\drawable-xhdpi
376 | 1
377 |
378 |
379 | res\drawable-xhdpi
380 | 1
381 |
382 |
383 |
384 |
385 | res\drawable-mdpi
386 | 1
387 |
388 |
389 | res\drawable-mdpi
390 | 1
391 |
392 |
393 |
394 |
395 | res\drawable-hdpi
396 | 1
397 |
398 |
399 | res\drawable-hdpi
400 | 1
401 |
402 |
403 |
404 |
405 | res\drawable-xhdpi
406 | 1
407 |
408 |
409 | res\drawable-xhdpi
410 | 1
411 |
412 |
413 |
414 |
415 | res\drawable-xxhdpi
416 | 1
417 |
418 |
419 | res\drawable-xxhdpi
420 | 1
421 |
422 |
423 |
424 |
425 | res\drawable-xxxhdpi
426 | 1
427 |
428 |
429 | res\drawable-xxxhdpi
430 | 1
431 |
432 |
433 |
434 |
435 | res\drawable-small
436 | 1
437 |
438 |
439 | res\drawable-small
440 | 1
441 |
442 |
443 |
444 |
445 | res\drawable-normal
446 | 1
447 |
448 |
449 | res\drawable-normal
450 | 1
451 |
452 |
453 |
454 |
455 | res\drawable-large
456 | 1
457 |
458 |
459 | res\drawable-large
460 | 1
461 |
462 |
463 |
464 |
465 | res\drawable-xlarge
466 | 1
467 |
468 |
469 | res\drawable-xlarge
470 | 1
471 |
472 |
473 |
474 |
475 | res\values
476 | 1
477 |
478 |
479 | res\values
480 | 1
481 |
482 |
483 |
484 |
485 | 1
486 |
487 |
488 | Contents\MacOS
489 | 1
490 |
491 |
492 | 0
493 |
494 |
495 |
496 |
497 | Contents\MacOS
498 | 1
499 | .framework
500 |
501 |
502 | Contents\MacOS
503 | 1
504 | .framework
505 |
506 |
507 | 0
508 |
509 |
510 |
511 |
512 | 1
513 | .dylib
514 |
515 |
516 | 1
517 | .dylib
518 |
519 |
520 | 1
521 | .dylib
522 |
523 |
524 | Contents\MacOS
525 | 1
526 | .dylib
527 |
528 |
529 | Contents\MacOS
530 | 1
531 | .dylib
532 |
533 |
534 | 0
535 | .dll;.bpl
536 |
537 |
538 |
539 |
540 | 1
541 | .dylib
542 |
543 |
544 | 1
545 | .dylib
546 |
547 |
548 | 1
549 | .dylib
550 |
551 |
552 | Contents\MacOS
553 | 1
554 | .dylib
555 |
556 |
557 | Contents\MacOS
558 | 1
559 | .dylib
560 |
561 |
562 | 0
563 | .bpl
564 |
565 |
566 |
567 |
568 | 0
569 |
570 |
571 | 0
572 |
573 |
574 | 0
575 |
576 |
577 | 0
578 |
579 |
580 | 0
581 |
582 |
583 | Contents\Resources\StartUp\
584 | 0
585 |
586 |
587 | Contents\Resources\StartUp\
588 | 0
589 |
590 |
591 | 0
592 |
593 |
594 |
595 |
596 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
597 | 1
598 |
599 |
600 |
601 |
602 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
603 | 1
604 |
605 |
606 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
607 | 1
608 |
609 |
610 |
611 |
612 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
613 | 1
614 |
615 |
616 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
617 | 1
618 |
619 |
620 |
621 |
622 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset
623 | 1
624 |
625 |
626 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset
627 | 1
628 |
629 |
630 |
631 |
632 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset
633 | 1
634 |
635 |
636 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset
637 | 1
638 |
639 |
640 |
641 |
642 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
643 | 1
644 |
645 |
646 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
647 | 1
648 |
649 |
650 |
651 |
652 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
653 | 1
654 |
655 |
656 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
657 | 1
658 |
659 |
660 |
661 |
662 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
663 | 1
664 |
665 |
666 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
667 | 1
668 |
669 |
670 |
671 |
672 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
673 | 1
674 |
675 |
676 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
677 | 1
678 |
679 |
680 |
681 |
682 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
683 | 1
684 |
685 |
686 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
687 | 1
688 |
689 |
690 |
691 |
692 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset
693 | 1
694 |
695 |
696 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset
697 | 1
698 |
699 |
700 |
701 |
702 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset
703 | 1
704 |
705 |
706 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset
707 | 1
708 |
709 |
710 |
711 |
712 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset
713 | 1
714 |
715 |
716 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset
717 | 1
718 |
719 |
720 |
721 |
722 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset
723 | 1
724 |
725 |
726 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset
727 | 1
728 |
729 |
730 |
731 |
732 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
733 | 1
734 |
735 |
736 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
737 | 1
738 |
739 |
740 |
741 |
742 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
743 | 1
744 |
745 |
746 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
747 | 1
748 |
749 |
750 |
751 |
752 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
753 | 1
754 |
755 |
756 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
757 | 1
758 |
759 |
760 |
761 |
762 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
763 | 1
764 |
765 |
766 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
767 | 1
768 |
769 |
770 |
771 |
772 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
773 | 1
774 |
775 |
776 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
777 | 1
778 |
779 |
780 |
781 |
782 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
783 | 1
784 |
785 |
786 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
787 | 1
788 |
789 |
790 |
791 |
792 | 1
793 |
794 |
795 | 1
796 |
797 |
798 |
799 |
800 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF
801 | 1
802 |
803 |
804 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF
805 | 1
806 |
807 |
808 |
809 |
810 | ..\
811 | 1
812 |
813 |
814 | ..\
815 | 1
816 |
817 |
818 |
819 |
820 | 1
821 |
822 |
823 | 1
824 |
825 |
826 | 1
827 |
828 |
829 |
830 |
831 | ..\$(PROJECTNAME).launchscreen
832 | 64
833 |
834 |
835 | ..\$(PROJECTNAME).launchscreen
836 | 64
837 |
838 |
839 |
840 |
841 | 1
842 |
843 |
844 | 1
845 |
846 |
847 | 1
848 |
849 |
850 |
851 |
852 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF
853 | 1
854 |
855 |
856 |
857 |
858 | ..\
859 | 1
860 |
861 |
862 | ..\
863 | 1
864 |
865 |
866 |
867 |
868 | Contents
869 | 1
870 |
871 |
872 | Contents
873 | 1
874 |
875 |
876 |
877 |
878 | Contents\Resources
879 | 1
880 |
881 |
882 | Contents\Resources
883 | 1
884 |
885 |
886 |
887 |
888 | library\lib\armeabi-v7a
889 | 1
890 |
891 |
892 | library\lib\arm64-v8a
893 | 1
894 |
895 |
896 | 1
897 |
898 |
899 | 1
900 |
901 |
902 | 1
903 |
904 |
905 | 1
906 |
907 |
908 | Contents\MacOS
909 | 1
910 |
911 |
912 | Contents\MacOS
913 | 1
914 |
915 |
916 | 0
917 |
918 |
919 |
920 |
921 | library\lib\armeabi-v7a
922 | 1
923 |
924 |
925 |
926 |
927 | 1
928 |
929 |
930 | 1
931 |
932 |
933 |
934 |
935 | Assets
936 | 1
937 |
938 |
939 | Assets
940 | 1
941 |
942 |
943 |
944 |
945 | Assets
946 | 1
947 |
948 |
949 | Assets
950 | 1
951 |
952 |
953 |
954 |
955 |
956 |
957 |
958 |
959 |
960 |
961 |
962 |
963 |
964 |
965 | False
966 | False
967 | False
968 | True
969 |
970 |
971 | 12
972 |
973 |
974 |
975 |
976 |
977 |
--------------------------------------------------------------------------------
/QoiShellExtensions/source/QoiShellExtensions.res:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/AngusJohnson/TQoiImage/fd0ff0a7f15efc442df2d2229f85313f2592dbb4/QoiShellExtensions/source/QoiShellExtensions.res
--------------------------------------------------------------------------------
/QoiShellExtensions/source/dialog.res:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/AngusJohnson/TQoiImage/fd0ff0a7f15efc442df2d2229f85313f2592dbb4/QoiShellExtensions/source/dialog.res
--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
1 | # TQoiImage
2 | Delphi support for QOI images.
3 |
4 | QOI - The “Quite OK Image Format” for fast, lossless image compression
5 | https://github.com/phoboslab/qoi
6 |
7 |
8 | Example:
9 |
10 | uses Forms, Graphics, QoiImage;
11 |
12 | type
13 | TForm1 = class(TForm)
14 | ...
15 | image: TImage;
16 | ...
17 |
18 | procedure TForm1.FormCreate(Sender: TObject);
19 | begin
20 | Image1.Picture.LoadFromFile('.\dice.qoi');
21 | end;
22 |
23 |
24 | # QoiShellExtensions.dll
25 | Windows Explorer (64bit) Preview Handler and Thumbnail Provider shell extensions.
26 |
27 | 
28 |
29 | 
30 |
31 |
32 |
--------------------------------------------------------------------------------
/TestApp/QoiTest.dpr:
--------------------------------------------------------------------------------
1 | program QoiTest;
2 | {$IF CompilerVersion >= 21.0}
3 | {$WEAKLINKRTTI ON}
4 | {$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])}
5 | {$IFEND}
6 | uses
7 | Forms,
8 | QoiImage in '..\QoiImage.pas',
9 | Unit1 in 'Unit1.pas' {Form1};
10 |
11 | {$R *.res}
12 | begin
13 | Application.Initialize;
14 | {$IF COMPILERVERSION >= 18.5}
15 | Application.MainFormOnTaskbar := True;
16 | {$IFEND}
17 | Application.CreateForm(TForm1, Form1);
18 | Application.Run;
19 | end.
20 |
--------------------------------------------------------------------------------
/TestApp/QoiTest.dproj:
--------------------------------------------------------------------------------
1 |
2 |
3 | {B3AA6806-3A8F-4BBF-A036-52BD95FE5C72}
4 | QoiTest.dpr
5 | True
6 | Debug
7 | 1
8 | Application
9 | VCL
10 | 19.2
11 | Win32
12 |
13 |
14 | true
15 |
16 |
17 | true
18 | Base
19 | true
20 |
21 |
22 | true
23 | Base
24 | true
25 |
26 |
27 | true
28 | Base
29 | true
30 |
31 |
32 | true
33 | Cfg_1
34 | true
35 | true
36 |
37 |
38 | true
39 | Cfg_1
40 | true
41 | true
42 |
43 |
44 | true
45 | Base
46 | true
47 |
48 |
49 | true
50 | Cfg_2
51 | true
52 | true
53 |
54 |
55 | true
56 | Cfg_2
57 | true
58 | true
59 |
60 |
61 | false
62 | false
63 | false
64 | false
65 | false
66 | 00400000
67 | QoiTest
68 | Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;$(DCC_Namespace)
69 | 3081
70 | CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName=
71 | $(BDS)\bin\delphi_PROJECTICON.ico
72 | $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png
73 | $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png
74 |
75 |
76 | System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)
77 | Debug
78 | true
79 | CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName)
80 | 1033
81 | $(BDS)\bin\default_app.manifest
82 | QoiTest_Icon.ico
83 | true
84 | $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png
85 | $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png
86 |
87 |
88 | System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace)
89 | Debug
90 | true
91 | CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=
92 | 1033
93 | $(BDS)\bin\default_app.manifest
94 |
95 |
96 | RELEASE;$(DCC_Define)
97 | 0
98 | false
99 | 0
100 |
101 |
102 | true
103 | PerMonitorV2
104 |
105 |
106 | true
107 | PerMonitorV2
108 |
109 |
110 | DEBUG;$(DCC_Define)
111 | false
112 | true
113 |
114 |
115 | true
116 | PerMonitorV2
117 |
118 |
119 | true
120 | PerMonitorV2
121 |
122 |
123 |
124 | MainSource
125 |
126 |
127 |
128 |
129 |
130 |
131 | Cfg_2
132 | Base
133 |
134 |
135 | Base
136 |
137 |
138 | Cfg_1
139 | Base
140 |
141 |
142 |
143 | Delphi.Personality.12
144 |
145 |
146 |
147 |
148 | QoiTest.dpr
149 |
150 |
151 |
152 | True
153 | False
154 |
155 |
156 | 12
157 |
158 |
159 |
160 |
161 |
--------------------------------------------------------------------------------
/TestApp/QoiTest.res:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/AngusJohnson/TQoiImage/fd0ff0a7f15efc442df2d2229f85313f2592dbb4/TestApp/QoiTest.res
--------------------------------------------------------------------------------
/TestApp/QoiTest_Icon.ico:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/AngusJohnson/TQoiImage/fd0ff0a7f15efc442df2d2229f85313f2592dbb4/TestApp/QoiTest_Icon.ico
--------------------------------------------------------------------------------
/TestApp/Unit1.dfm:
--------------------------------------------------------------------------------
1 | object Form1: TForm1
2 | Left = 448
3 | Top = 248
4 | Caption = 'Test PNG/QOI'
5 | ClientHeight = 458
6 | ClientWidth = 488
7 | Color = clBtnFace
8 | Font.Charset = DEFAULT_CHARSET
9 | Font.Color = clWindowText
10 | Font.Height = -12
11 | Font.Name = 'Arial'
12 | Font.Style = []
13 | Menu = MainMenu1
14 | OldCreateOrder = True
15 | Position = poScreenCenter
16 | OnCreate = FormCreate
17 | OnDestroy = FormDestroy
18 | PixelsPerInch = 96
19 | TextHeight = 15
20 | object image: TImage
21 | Left = 0
22 | Top = 66
23 | Width = 488
24 | Height = 373
25 | Align = alClient
26 | Stretch = True
27 | ExplicitHeight = 374
28 | end
29 | object Panel1: TPanel
30 | Left = 0
31 | Top = 0
32 | Width = 488
33 | Height = 66
34 | Align = alTop
35 | TabOrder = 0
36 | object btnPNG: TButton
37 | Left = 14
38 | Top = 14
39 | Width = 107
40 | Height = 35
41 | Caption = 'Time &PNG'
42 | Enabled = False
43 | TabOrder = 0
44 | OnClick = btnPNGClick
45 | end
46 | object btnConvertFolder: TButton
47 | Left = 324
48 | Top = 14
49 | Width = 144
50 | Height = 35
51 | Caption = '&Convert PNGs ...'
52 | TabOrder = 2
53 | OnClick = btnConvertFolderClick
54 | end
55 | object btnQoi: TButton
56 | Left = 137
57 | Top = 14
58 | Width = 107
59 | Height = 35
60 | Caption = 'Time &QOI'
61 | Enabled = False
62 | TabOrder = 1
63 | OnClick = btnQoiClick
64 | end
65 | end
66 | object StatusBar1: TStatusBar
67 | Left = 0
68 | Top = 439
69 | Width = 488
70 | Height = 19
71 | Panels = <>
72 | SimplePanel = True
73 | end
74 | object MainMenu1: TMainMenu
75 | Left = 232
76 | Top = 120
77 | object File1: TMenuItem
78 | Caption = '&File'
79 | object Open1: TMenuItem
80 | Caption = '&Open ...'
81 | ShortCut = 16463
82 | OnClick = Open1Click
83 | end
84 | object N1: TMenuItem
85 | Caption = '-'
86 | end
87 | object mnuExit: TMenuItem
88 | Caption = 'E&xit'
89 | ShortCut = 27
90 | OnClick = mnuExitClick
91 | end
92 | end
93 | end
94 | object OpenDialog1: TOpenDialog
95 | Filter = 'Image Files (*.BMP,*.PNG,*.JPG,*.QOI)|*.BMP;*.PNG; *.JPG;*.QOI;'
96 | Left = 176
97 | Top = 120
98 | end
99 | object FileOpenDialog: TFileOpenDialog
100 | FavoriteLinks = <>
101 | FileTypes = <>
102 | Options = [fdoPickFolders, fdoForceFileSystem, fdoPathMustExist]
103 | Left = 296
104 | Top = 128
105 | end
106 | end
107 |
--------------------------------------------------------------------------------
/TestApp/Unit1.pas:
--------------------------------------------------------------------------------
1 | unit Unit1;
2 |
3 | interface
4 |
5 | uses
6 | Windows, SysUtils, ShlObj, ShellApi, Classes, Graphics,
7 | ComCtrls, Menus, Controls, Forms, StdCtrls, ExtCtrls, Dialogs,
8 | Diagnostics, QoiImage, PngImage, Jpeg;
9 |
10 | type
11 | TForm1 = class(TForm)
12 | Panel1: TPanel;
13 | btnPNG: TButton;
14 | StatusBar1: TStatusBar;
15 | btnConvertFolder: TButton;
16 | MainMenu1: TMainMenu;
17 | File1: TMenuItem;
18 | mnuExit: TMenuItem;
19 | Open1: TMenuItem;
20 | N1: TMenuItem;
21 | OpenDialog1: TOpenDialog;
22 | image: TImage;
23 | btnQoi: TButton;
24 | FileOpenDialog: TFileOpenDialog;
25 | procedure btnPNGClick(Sender: TObject);
26 | procedure FormCreate(Sender: TObject);
27 | procedure btnConvertFolderClick(Sender: TObject);
28 | procedure mnuExitClick(Sender: TObject);
29 | procedure FormDestroy(Sender: TObject);
30 | procedure Open1Click(Sender: TObject);
31 | procedure btnQoiClick(Sender: TObject);
32 | public
33 | foldername: string;
34 | procedure LoadImage(const filename: string);
35 | procedure TimeTest(testPng: Boolean);
36 | end;
37 |
38 | var
39 | Form1: TForm1;
40 |
41 | const
42 | pngFile = './tmp.png';
43 | qoiFile = './tmp.qoi';
44 |
45 | implementation
46 |
47 | {$R *.dfm}
48 |
49 | type
50 | THackedJpeg = class(TJPEGImage);
51 |
52 | TRGB = packed record
53 | B: Byte; G: Byte; R: Byte;
54 | end;
55 | PRGB = ^TRGB;
56 |
57 | function GetFileSize(const filename: string): Int64;
58 | var
59 | info: TWin32FileAttributeData;
60 | begin
61 | if GetFileAttributesEx(PChar(filename),
62 | GetFileExInfoStandard, @info) then
63 | result := Int64(info.nFileSizeLow) or
64 | Int64(info.nFileSizeHigh shl 32) else
65 | result := -1;
66 | end;
67 |
68 | function GetQoiImgRecFromPngImage(png: TPngImage): TQoiImageRec;
69 | var
70 | X,Y : Cardinal;
71 | dst : PARGB;
72 | src : PRGB;
73 | srcAlpha: PByte;
74 | bmp : TBitmap;
75 | begin
76 | Result.Width := png.Width;
77 | Result.Height := png.Height;
78 | SetLength(Result.Pixels, png.Width * png.Height);
79 | if png.TransparencyMode = ptmPartial then //alpha blended transparency
80 | begin
81 | Result.HasTransparency := true;
82 | dst := @Result.Pixels[0];
83 | for Y := 0 to png.Height -1 do
84 | begin
85 | src := png.Scanline[Y];
86 | srcAlpha := PByte(png.AlphaScanline[Y]);
87 | for X := 0 to png.width -1 do
88 | begin
89 | dst.B := src.B; dst.G := src.G; dst.R := src.R;
90 | dst.A := srcAlpha^;
91 | inc(dst); Inc(srcAlpha); inc(src);
92 | end;
93 | end;
94 | end else
95 | begin
96 | bmp := TBitmap.Create;
97 | try
98 | png.AssignTo(bmp);
99 | Result := GetImgRecFromBitmap(bmp);
100 | finally
101 | bmp.Free;
102 | end;
103 | end;
104 | end;
105 |
106 | function CreatePngImageFromImgRec(const img: TQoiImageRec): TPNGImage;
107 | var
108 | X,Y: Cardinal;
109 | src: PARGB;
110 | dst: PRGB;
111 | dstAlpha: PByte;
112 | begin
113 | Result := TPNGImage.CreateBlank(COLOR_RGBALPHA, 8, img.Width , img.Height);
114 | Result.CreateAlpha;
115 | if img.Width * img.Height = 0 then Exit;
116 |
117 | src := @img.Pixels[0];
118 | for Y := 0 to img.Height -1 do
119 | begin
120 | dst := Result.Scanline[Y];
121 | dstAlpha := PByte(Result.AlphaScanline[Y]);
122 | for X := 0 to img.width -1 do
123 | begin
124 | dst.B := src.B; dst.G := src.G; dst.R := src.R;
125 | dstAlpha^ := src.A;
126 | Inc(dstAlpha); inc(dst); inc(src);
127 | end;
128 | end;
129 | end;
130 |
131 | function GetQoiImgRecFromJpegImage(jpeg: TJPEGImage): TQoiImageRec;
132 | begin
133 | Result := GetImgRecFromBitmap(THackedJpeg(jpeg).Bitmap);
134 | Result.HasTransparency := false;
135 | end;
136 |
137 | //------------------------------------------------------------------------------
138 | // TForm1 methods
139 | //------------------------------------------------------------------------------
140 |
141 | procedure TForm1.FormCreate(Sender: TObject);
142 | begin
143 | StatusBar1.Font.Style := [fsBold];
144 | end;
145 |
146 | procedure TForm1.FormDestroy(Sender: TObject);
147 | begin
148 | if FileExists(qoiFile) then DeleteFile(qoiFile);
149 | if FileExists(pngFile) then DeleteFile(pngFile);
150 | end;
151 |
152 | procedure TForm1.LoadImage(const filename: string);
153 | var
154 | ext: string;
155 | png : TPngImage;
156 | jpg : TJpegImage;
157 | qoi : TQoiImage;
158 | begin
159 | StatusBar1.SimpleText := ' Wait ...';
160 | btnPNG.Enabled := false;
161 | btnQoi.Enabled := false;
162 | image.Picture := nil;
163 | ext := Lowercase(ExtractFileExt(filename));
164 | Application.ProcessMessages;
165 |
166 | if ext = '.png' then
167 | begin
168 | png := TPngImage.Create;
169 | png.LoadFromFile(filename);
170 | image.Picture.Bitmap.Assign(png);
171 | CopyFile(PChar(filename), PChar(pngFile), false);
172 | qoi := TQoiImage.Create;
173 | qoi.ImageRec := GetQoiImgRecFromPngImage(png);
174 | qoi.SaveToFile(qoiFile);
175 | qoi.Free;
176 | png.Free;
177 | end
178 | else if ext = '.jpg' then
179 | begin
180 | jpg := TJpegImage.Create;
181 | jpg.LoadFromFile(filename);
182 | image.Picture.Bitmap.Assign(jpg);
183 | qoi := TQoiImage.Create;
184 | qoi.ImageRec := GetQoiImgRecFromJpegImage(jpg);
185 | qoi.SaveToFile(qoiFile);
186 | png := CreatePngImageFromImgRec(qoi.ImageRec);
187 | png.SaveToFile(pngFile);
188 | qoi.Free;
189 | png.Free;
190 | jpg.Free;
191 | end
192 | else if ext = '.qoi' then
193 | begin
194 | qoi := TQoiImage.Create;
195 | qoi.LoadFromFile(filename);
196 | image.Picture.Bitmap.Assign(qoi);
197 | CopyFile(PChar(filename), PChar(qoiFile), false);
198 | png := CreatePngImageFromImgRec(qoi.ImageRec);
199 | png.SaveToFile(pngFile);
200 | qoi.Free;
201 | png.Free;
202 | end else
203 | Exit;
204 |
205 | StatusBar1.SimpleText := '';
206 | btnPNG.Enabled := true;
207 | btnQoi.Enabled := true;
208 | if Active then
209 | btnPNG.SetFocus;
210 | end;
211 |
212 | procedure TForm1.TimeTest(testPng: Boolean);
213 | var
214 | fileSize, T1, T2: Int64;
215 | ext, filename: string;
216 | png: TPngImage;
217 | qoi: TQoiImage;
218 | begin
219 | if testPng then filename := pngFile
220 | else filename := qoiFile;
221 |
222 | fileSize := GetFileSize(filename);
223 | if fileSize <= 0 then
224 | begin
225 | StatusBar1.SimpleText := ' Invalid image.';
226 | Exit;
227 | end;
228 |
229 | btnPng.Enabled := False;
230 | btnQoi.Enabled := False;
231 | image.Picture := nil;
232 | StatusBar1.SimpleText := ' Wait ...';
233 | Application.ProcessMessages;
234 | try
235 | if testPng then
236 | begin
237 | Ext := 'PNG';
238 | png := TPngImage.Create;
239 | { decode }
240 | with TStopWatch.StartNew do
241 | begin
242 | png.LoadFromFile(filename);
243 | T1 := ElapsedMilliseconds;
244 | end;
245 | { encode }
246 | with TStopWatch.StartNew do
247 | begin
248 | png.SaveToFile(filename);
249 | T2 := ElapsedMilliseconds;
250 | end;
251 | //and display the image
252 | image.Picture.Bitmap.Assign(png);
253 | png.Free;
254 | end else
255 | begin
256 | Ext := 'QOI';
257 | qoi := TQoiImage.Create;
258 | { decode }
259 | with TStopWatch.StartNew do
260 | begin
261 | qoi.LoadFromFile(filename);
262 | T1 := ElapsedMilliseconds;
263 | end;
264 | { encode }
265 | with TStopWatch.StartNew do
266 | begin
267 | qoi.SaveToFile(filename);
268 | T2 := ElapsedMilliseconds;
269 | end;
270 | //and display the image
271 | image.Picture.Bitmap.Assign(qoi);
272 | qoi.Free;
273 | end;
274 |
275 | finally
276 | btnPng.Enabled := true;
277 | btnQoi.Enabled := true;
278 | end;
279 |
280 | StatusBar1.SimpleText :=
281 | Format(' %s - File Size: %1.0n; Encode: %1d ms; Decode: %1d ms.',
282 | [Ext, FileSize/1.0, T2, T1]);
283 | end;
284 |
285 | procedure TForm1.btnPNGClick(Sender: TObject);
286 | begin
287 | TimeTest(true);
288 | end;
289 |
290 | procedure TForm1.btnQoiClick(Sender: TObject);
291 | begin
292 | TimeTest(false);
293 | end;
294 |
295 | procedure TForm1.btnConvertFolderClick(Sender: TObject);
296 | var
297 | i,j,cnt: integer;
298 | n, n2: string;
299 | sr: TSearchRec;
300 | png: TPngImage;
301 | qoi: TQoiImage;
302 | begin
303 | if not FileOpenDialog.Execute then Exit;
304 | foldername := FileOpenDialog.FileName + '\';
305 | StatusBar1.SimpleText := '';
306 |
307 | cnt := 0;
308 | i := FindFirst(foldername +'*.png', faAnyFile, sr);
309 | while i = 0 do
310 | begin
311 | if sr.Name[1] <> '.' then inc(cnt);
312 | i := FindNext(sr);
313 | end;
314 | FindClose(sr);
315 | if cnt = 0 then Exit;
316 |
317 | StatusBar1.SimpleText := ' Wait ...';
318 | Application.ProcessMessages;
319 | ForceDirectories(foldername + 'QOI\');
320 |
321 | png := TPngImage.Create;
322 | qoi := TQoiImage.Create;
323 | try
324 | j := 0;
325 | i := FindFirst(foldername +'*.png', faAnyFile, sr);
326 | while i = 0 do
327 | begin
328 | if j mod 5 = 0 then
329 | begin
330 | StatusBar1.SimpleText := format(' %d/%d files processed',[j, cnt]);
331 | Application.ProcessMessages;
332 | end;
333 | inc(j);
334 | if sr.Name[1] <> '.' then
335 | begin
336 | n := foldername + sr.Name;
337 | png.LoadFromFile(n);
338 | qoi.ImageRec := GetQoiImgRecFromPngImage(png);
339 | n2 := foldername + 'QOI\' + ChangeFileExt(sr.Name, '.qoi');
340 | qoi.SaveToFile(n2);
341 | end;
342 | i := FindNext(sr);
343 | end;
344 | FindClose(sr);
345 |
346 | finally
347 | qoi.Free;
348 | png.Free;
349 | StatusBar1.SimpleText := ' All done';
350 | end;
351 | end;
352 |
353 | procedure TForm1.mnuExitClick(Sender: TObject);
354 | begin
355 | Close;
356 | end;
357 |
358 | procedure TForm1.Open1Click(Sender: TObject);
359 | begin
360 | if OpenDialog1.Execute then
361 | LoadImage(OpenDialog1.FileName);
362 | StatusBar1.SimpleText := '';
363 | end;
364 |
365 | end.
366 |
--------------------------------------------------------------------------------
/TestApp/qoi_logo.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/AngusJohnson/TQoiImage/fd0ff0a7f15efc442df2d2229f85313f2592dbb4/TestApp/qoi_logo.png
--------------------------------------------------------------------------------
/TestApp/timer.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/AngusJohnson/TQoiImage/fd0ff0a7f15efc442df2d2229f85313f2592dbb4/TestApp/timer.png
--------------------------------------------------------------------------------