├── LICENSE ├── README.md ├── bin ├── Heif │ ├── libde265.dll │ ├── libheif.dll │ └── sk4d.dll └── WebP │ ├── libwebp.dll │ └── x86 │ └── libwebp.dll ├── samples ├── sample.heic └── sample.webp └── source ├── Cod.Imaging.Heif.pas ├── Cod.Imaging.Internal.Heif.pas ├── Cod.Imaging.Internal.WebPHelpers.pas ├── Cod.Imaging.Internal.libwebp.pas ├── Cod.Imaging.Utils.pas └── Cod.Imaging.WebP.pas /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2024 Codrut 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 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Delphi-Extended-Images-Format 2 | Support in Delphi for WebP and Heif image codecs with a wrapper for the DLLs. 3 | 4 | These units add two new `TGraphic` class types called `THeifImage` and `TWebPImage` respectively. They work as any other TGraphic with support for editing images, assigning to other image types and you can edit the pixels individually by any of the avalabile channels with the `TRGBAPixel` helper provided in `Cod.Imaging.Utils`. 5 | 6 | ## Examples 7 | ``` 8 | var Image: THeifImage; 9 | Image := THeifImage.Create; 10 | try 11 | Image.LoadFromFile('sample.heic'); 12 | 13 | Image1.Stretch := true; 14 | Image1.Picture.Graphic := Image; 15 | finally 16 | Image.Free; 17 | end; 18 | ``` 19 | ``` 20 | var Image: TWebPImage; 21 | Image := TWebPImage.Create; 22 | try 23 | Image.LoadFromFile('sample.webp'); 24 | 25 | Image1.Stretch := true; 26 | Image1.Picture.Graphic := Image; 27 | finally 28 | Image.Free; 29 | end; 30 | ``` 31 | Cross conversion example 32 | ``` 33 | var WebImage: TWebPImage; 34 | var HeifImage: THeifImage; 35 | WebImage := TWebPImage.Create; 36 | HeifImage := THeifImage.Create; 37 | try 38 | // Load WebP 39 | WebImage.LoadFromFile('sample.webp'); 40 | 41 | // Assign to Heif 42 | HeifImage.Assign(WebImage); 43 | 44 | // Display 45 | Image1.Stretch := true; 46 | Image1.Picture.Graphic := HeifImage; 47 | 48 | // Save heif 49 | HeifImage.SaveToFile('out.heif'); 50 | finally 51 | WebImage.Free; 52 | HeifImage.Free; 53 | end; 54 | ``` 55 | 56 | ## Image 57 | ![image](https://github.com/Codrax/Delphi-Extended-Images-Format/assets/68193064/1550559a-4639-4833-ac55-68d6e9b49cb7) 58 | -------------------------------------------------------------------------------- /bin/Heif/libde265.dll: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Codrax/Delphi-Extended-Images-Format/f6bc6933d49a6fc45d5d119c74124d33d448ba71/bin/Heif/libde265.dll -------------------------------------------------------------------------------- /bin/Heif/libheif.dll: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Codrax/Delphi-Extended-Images-Format/f6bc6933d49a6fc45d5d119c74124d33d448ba71/bin/Heif/libheif.dll -------------------------------------------------------------------------------- /bin/Heif/sk4d.dll: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Codrax/Delphi-Extended-Images-Format/f6bc6933d49a6fc45d5d119c74124d33d448ba71/bin/Heif/sk4d.dll -------------------------------------------------------------------------------- /bin/WebP/libwebp.dll: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Codrax/Delphi-Extended-Images-Format/f6bc6933d49a6fc45d5d119c74124d33d448ba71/bin/WebP/libwebp.dll -------------------------------------------------------------------------------- /bin/WebP/x86/libwebp.dll: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Codrax/Delphi-Extended-Images-Format/f6bc6933d49a6fc45d5d119c74124d33d448ba71/bin/WebP/x86/libwebp.dll -------------------------------------------------------------------------------- /samples/sample.heic: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Codrax/Delphi-Extended-Images-Format/f6bc6933d49a6fc45d5d119c74124d33d448ba71/samples/sample.heic -------------------------------------------------------------------------------- /samples/sample.webp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Codrax/Delphi-Extended-Images-Format/f6bc6933d49a6fc45d5d119c74124d33d448ba71/samples/sample.webp -------------------------------------------------------------------------------- /source/Cod.Imaging.Heif.pas: -------------------------------------------------------------------------------- 1 | {***********************************************************} 2 | { Codruts Imaging Heif image } 3 | { } 4 | { version 1.0 } 5 | { } 6 | { } 7 | { } 8 | { This library is licensed under a MIT license } 9 | { Copyright 2024 Codrut Software } 10 | { All rights reserved. } 11 | { } 12 | {***********************************************************} 13 | 14 | {$DEFINE UseDelphi} //Disable fat vcl units(perfect for small apps) 15 | {$DEFINE RegisterGraphic} //Registers TPNGObject to use with TPicture 16 | 17 | unit Cod.Imaging.Heif; 18 | 19 | interface 20 | uses 21 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Math, 22 | Types, UITypes, Vcl.Graphics, Vcl.Imaging.pngimage, 23 | Cod.Imaging.Utils, 24 | Cod.Imaging.Internal.Heif; 25 | 26 | type 27 | THeifImage = class(TGraphic) 28 | private 29 | const PIXEL_SIZE=3; 30 | const HEIF_CHANNEL=THeifChannel.channel_interleaved; 31 | var 32 | FImage: PHeifImage; 33 | FData: PByte; 34 | FDataStride: integer; 35 | FQuality: byte; // the save quality 36 | FLosslessQuality: boolean; 37 | 38 | {Free mem} 39 | procedure FreeData; 40 | procedure FreeImageMemory(AImage: PHeifImage); 41 | 42 | {Utils} 43 | function GetPixelStart(X, Y: Integer): cardinal; 44 | function ScanCreateBitmap: TBitMap; 45 | function ScanCreatePNG: TPNGImage; 46 | function ArraySize: cardinal; 47 | // Allocate new image 48 | procedure ReallocateNew(Width, Height: integer); // this does NOT free previous existing memory 49 | 50 | {Properties} 51 | procedure SetQuality(const Value: byte); 52 | function GetPixels(const X, Y: Integer): TColor; 53 | procedure SetPixels(const X, Y: Integer; const Value: TColor); 54 | function GetWebPPixel(const X, Y: Integer): TRGBAPixel; 55 | procedure SetWebPPixel(const X, Y: Integer; const Value: TRGBAPixel); 56 | function GetScanline(const Index: Integer): Pointer; 57 | 58 | {Internal} 59 | class function DoWrite(ctx: PHeifContext; const data: Pointer; size: cardinal; userdata: Pointer): THeifError; static; 60 | 61 | protected 62 | {Empty} 63 | function GetEmpty: Boolean; override; 64 | 65 | {Internal assign} 66 | procedure AssignHeif(Source: THeifImage); 67 | 68 | {Draw to canvas} 69 | procedure Draw(ACanvas: TCanvas; const Rect: TRect); override; 70 | 71 | {Sizing} 72 | function GetWidth: Integer; override; 73 | function GetHeight: Integer; override; 74 | procedure SetHeight(Value: Integer); override; 75 | procedure SetWidth(Value: Integer); override; 76 | 77 | public 78 | {Returns a scanline from png} 79 | property Scanline[const Index: Integer]: Pointer read GetScanline; 80 | 81 | {Assigns from another object} 82 | procedure Assign(Source: TPersistent); override; 83 | {Assigns to another object} 84 | procedure AssignTo(Dest: TPersistent); override; 85 | 86 | property Handle: PHeifImage read FImage; 87 | 88 | {Save / Load} 89 | procedure LoadFromStream(Stream: TStream); override; 90 | procedure SaveToStream(Stream: TStream); override; 91 | 92 | procedure LoadFromFile(const Filename: string); override; 93 | procedure SaveToFile(const Filename: string); override; 94 | 95 | {Clipboard} 96 | procedure LoadFromClipboardFormat(AFormat: Word; AData: THandle; 97 | APalette: HPALETTE); override; 98 | procedure SaveToClipboardFormat(var AFormat: Word; var AData: THandle; 99 | var APalette: HPALETTE); override; 100 | 101 | {Save quality level} 102 | property Quality: byte read FQuality write SetQuality; 103 | property LosslessQuality: boolean read FLosslessQuality write FLosslessQuality; 104 | 105 | {Access to the png pixels} 106 | property Pixels[const X, Y: Integer]: TColor read GetPixels write SetPixels; 107 | property WebPPixels[const X, Y: Integer]: TRGBAPixel read GetWebPPixel write SetWebPPixel; // no trasparency support 108 | 109 | constructor Create; override; 110 | constructor CreateBlank(Width, Height: integer); 111 | destructor Destroy; override; 112 | end; 113 | 114 | implementation 115 | 116 | procedure MoveFlipPixels(Source, Dest: PByte; Size: Integer); 117 | var 118 | Divider: integer; 119 | begin 120 | Divider := Size div 3; 121 | for var I := 0 to Divider-1 do begin 122 | Dest[I*3] := Source[I*3+2]; 123 | Dest[I*3+1] := Source[I*3+1]; 124 | Dest[I*3+2] := Source[I*3]; 125 | end; 126 | end; 127 | 128 | { THeifImage } 129 | 130 | function THeifImage.ArraySize: cardinal; 131 | begin 132 | Result := Height * FDataStride; 133 | end; 134 | 135 | procedure THeifImage.Assign(Source: TPersistent); 136 | const 137 | RGB_SIZE = 3; 138 | RGBA_SIZE = 4; 139 | var 140 | Y: integer; 141 | SrcPtr: PByte; 142 | DestPtr: PByte; 143 | BytesPerScanLine: Integer; 144 | begin 145 | // Load 146 | if Source is THeifImage then 147 | AssignHeif(Source as THeifImage) 148 | else begin 149 | const Bit = TBitMap.Create; 150 | try 151 | // Create 152 | Bit.Assign(Source); 153 | 154 | // Free previous 155 | FreeData; 156 | 157 | // Allocate new image 158 | ReallocateNew(Bit.Width, Bit.Height); 159 | 160 | // Read 161 | DestPtr := FData; 162 | BytesPerScanLine := Bit.Width * RGB_SIZE; 163 | 164 | // Pixel format 165 | case Bit.PixelFormat of 166 | pf24bit: begin 167 | // Copy picture lines 168 | for Y := 0 to Bit.Height - 1 do begin 169 | SrcPtr := Bit.ScanLine[Y]; 170 | 171 | // Copy 172 | MoveFlipPixels(SrcPtr, DestPtr, BytesPerScanLine); 173 | 174 | // Inc pos 175 | Inc(DestPtr, BytesPerScanLine); 176 | end; 177 | end; 178 | pf32bit: begin 179 | Bit.SaveToFile('C:\Users\Codrut\Downloads\what.heif'); 180 | 181 | // Copy picture lines 182 | for Y := 0 to Bit.Height - 1 do begin 183 | SrcPtr := Bit.ScanLine[Y]; 184 | 185 | // Copy 186 | for var X := 0 to Bit.Width do begin 187 | DestPtr[X*RGB_SIZE] := SrcPtr[2]; 188 | DestPtr[X*RGB_SIZE+1] := SrcPtr[1]; 189 | DestPtr[X*RGB_SIZE+2] := SrcPtr[0]; 190 | 191 | Inc(SrcPtr, RGBA_SIZE); 192 | end; 193 | 194 | // Inc pos 195 | Inc(DestPtr, FDataStride); 196 | end; 197 | end; 198 | 199 | else raise Exception.Create('Pixel format not supported.'); 200 | end; 201 | finally 202 | Bit.Free; 203 | end; 204 | end; 205 | end; 206 | 207 | procedure THeifImage.AssignTo(Dest: TPersistent); 208 | begin 209 | if Dest is THeifImage then 210 | (Dest as THeifImage).AssignHeif( Self ) 211 | else 212 | if Dest is TPngImage then 213 | begin 214 | const PNG = ScanCreatePNG; 215 | Dest.Assign( PNG ); 216 | end 217 | else 218 | begin 219 | const Bit = ScanCreateBitmap; 220 | try 221 | Dest.Assign( Bit ); 222 | finally 223 | Bit.Free; 224 | end; 225 | end; 226 | end; 227 | 228 | procedure THeifImage.AssignHeif(Source: THeifImage); 229 | begin 230 | // Free memory 231 | FreeData; 232 | 233 | if not Source.Empty then begin 234 | // Read settings 235 | ReallocateNew(Source.Width, Source.Height); 236 | 237 | // Copy memory 238 | Move(Source.FData^, FData^, ArraySize); 239 | end; 240 | end; 241 | 242 | constructor THeifImage.Create; 243 | begin 244 | inherited; 245 | FImage := nil; 246 | FData := nil; 247 | FQuality := DEFAULT_QUALITY; 248 | end; 249 | 250 | constructor THeifImage.CreateBlank(Width, Height: integer); 251 | begin 252 | FreeData; 253 | 254 | ReallocateNew(Width, Height); 255 | end; 256 | 257 | destructor THeifImage.Destroy; 258 | begin 259 | FreeData; 260 | 261 | inherited; 262 | end; 263 | 264 | class function THeifImage.DoWrite(ctx: PHeifContext; const data: Pointer; size: cardinal; 265 | userdata: Pointer): THeifError; 266 | var 267 | Stream: TStream; 268 | begin 269 | Stream := TStream(userdata); 270 | 271 | // Write 272 | try 273 | Stream.Write(Data^, Size); 274 | except 275 | // Success 276 | Result := THeifError.Create(THeifErrorNum.heif_error_Decoder_plugin_error, 277 | THeifSuberrorCode.heif_suberror_Unspecified); 278 | Exit; 279 | end; 280 | 281 | // Success 282 | Result := THeifError.Create(THeifErrorNum.heif_error_Ok); 283 | end; 284 | 285 | procedure THeifImage.Draw(ACanvas: TCanvas; const Rect: TRect); 286 | var 287 | Cache: TPNGImage; 288 | begin 289 | if Empty then 290 | Exit; 291 | Cache := ScanCreatePNG; 292 | try 293 | // Draw buffer 294 | ACanvas.StretchDraw(Rect, Cache); 295 | finally 296 | Cache.Free; 297 | end; 298 | end; 299 | 300 | procedure THeifImage.FreeData; 301 | begin 302 | if not GetEmpty then 303 | FreeImageMemory(FImage); 304 | 305 | FData := nil; 306 | FImage := nil; 307 | end; 308 | 309 | procedure THeifImage.FreeImageMemory(AImage: PHeifImage); 310 | begin 311 | heif_image_release(AImage); 312 | end; 313 | 314 | function THeifImage.GetEmpty: Boolean; 315 | begin 316 | Result := (FImage = nil) and (FData = nil); 317 | end; 318 | 319 | function THeifImage.GetHeight: Integer; 320 | begin 321 | if GetEmpty then 322 | Exit(0); 323 | Result := heif_image_get_height(FImage, HEIF_CHANNEL); 324 | end; 325 | 326 | function THeifImage.GetPixels(const X, Y: Integer): TColor; 327 | begin 328 | Result := GetWebPPixel(X, Y).ToColor; 329 | end; 330 | 331 | function THeifImage.GetPixelStart(X, Y: Integer): cardinal; 332 | begin 333 | Result := Y*FDataStride + X*PIXEL_SIZE; 334 | end; 335 | 336 | function THeifImage.GetScanline(const Index: Integer): Pointer; 337 | begin 338 | Result := @FData[GetWidth*Index*PIXEL_SIZE]; 339 | end; 340 | 341 | function THeifImage.GetWebPPixel(const X, Y: Integer): TRGBAPixel; 342 | var 343 | Start: integer; 344 | begin 345 | Start := GetPixelStart(X, Y); 346 | Result := TRGBAPixel.Create(FData[Start], FData[Start+1], FData[Start+2]); 347 | end; 348 | 349 | function THeifImage.GetWidth: Integer; 350 | begin 351 | if GetEmpty then 352 | Exit(0); 353 | Result := heif_image_get_width(FImage, HEIF_CHANNEL); 354 | end; 355 | 356 | procedure THeifImage.LoadFromClipboardFormat(AFormat: Word; AData: THandle; 357 | APalette: HPALETTE); 358 | begin 359 | inherited; 360 | raise Exception.Create('Not supported.'); 361 | end; 362 | 363 | procedure THeifImage.LoadFromFile(const Filename: string); 364 | var 365 | ctx: PHeifContext; 366 | imageHandle: PHeifImageHandle; 367 | begin 368 | // Allocate context 369 | ctx := heif_context_alloc(); 370 | try 371 | // Make new memory instance 372 | heif_context_read_from_file(ctx, @AnsiString(Filename)[1], nil).ErrRaise; 373 | 374 | heif_context_get_primary_image_handle(ctx, imageHandle).ErrRaise; 375 | try 376 | heif_decode_image(imageHandle, FImage, THeifColorspace.colorspace_RGB, THeifChroma.chroma_interleaved_RGB, nil).ErrRaise; 377 | 378 | FData := heif_image_get_plane(FImage, THeifChannel.channel_interleaved, FDataStride); 379 | finally 380 | heif_image_handle_release(imageHandle); 381 | end; 382 | 383 | finally 384 | heif_context_free( ctx ); 385 | end; 386 | end; 387 | 388 | procedure THeifImage.LoadFromStream(Stream: TStream); 389 | var 390 | ctx: PHeifContext; 391 | imageHandle: PHeifImageHandle; 392 | Buffer: TBytes; 393 | begin 394 | // Get bytes 395 | Stream.Position := 0; 396 | SetLength(Buffer, Stream.Size); 397 | Stream.ReadBuffer(Buffer, Stream.size); 398 | 399 | // Decode 400 | try 401 | // Allocate context 402 | ctx := heif_context_alloc(); 403 | try 404 | // Make new memory instance 405 | heif_context_read_from_memory(ctx, @Buffer[0], Stream.Size, nil); 406 | 407 | heif_context_get_primary_image_handle(ctx, imageHandle).ErrRaise; 408 | try 409 | heif_decode_image(imageHandle, FImage, THeifColorspace.colorspace_RGB, THeifChroma.chroma_interleaved_RGB, nil).ErrRaise; 410 | 411 | FData := heif_image_get_plane(FImage, THeifChannel.channel_interleaved, FDataStride); 412 | finally 413 | heif_image_handle_release(imageHandle); 414 | end; 415 | 416 | finally 417 | heif_context_free( ctx ); 418 | end; 419 | finally 420 | SetLength(Buffer, 0); 421 | end; 422 | end; 423 | 424 | procedure THeifImage.ReallocateNew(Width, Height: integer); 425 | begin 426 | // Create image 427 | heif_image_create(Width, Height, THeifColorspace.colorspace_RGB, THeifChroma.chroma_interleaved_RGB, FImage).ErrRaise; 428 | 429 | // Create new plane 430 | heif_image_add_plane(FImage, THeifChannel.channel_interleaved, Width, Height, 24).ErrRaise; 431 | 432 | // Get Interleaved plane 433 | FData := heif_image_get_plane(FImage, THeifChannel.channel_interleaved, FDataStride); 434 | end; 435 | 436 | procedure THeifImage.SaveToClipboardFormat(var AFormat: Word; 437 | var AData: THandle; var APalette: HPALETTE); 438 | begin 439 | inherited; 440 | raise Exception.Create('Not supported.'); 441 | end; 442 | 443 | procedure THeifImage.SaveToFile(const Filename: string); 444 | var 445 | ctx: PHeifContext; 446 | encoder: PHeifEncoder; 447 | begin 448 | // Save 449 | ctx := heif_context_alloc(); 450 | try 451 | heif_context_get_encoder_for_format(ctx, THeifCompressionFormat.compression_HEVC, encoder).ErrRaise; 452 | try 453 | heif_encoder_set_lossy_quality(encoder, 85).ErrRaise; 454 | 455 | heif_context_encode_image(ctx, FImage, encoder, nil, nil).ErrRaise; 456 | finally 457 | heif_encoder_release(encoder); 458 | end; 459 | 460 | heif_context_write_to_file(ctx, @AnsiString(Filename)[1]); 461 | finally 462 | heif_context_free(ctx); 463 | end; 464 | end; 465 | 466 | procedure THeifImage.SaveToStream(Stream: TStream); 467 | var 468 | ctx: PHeifContext; 469 | encoder: PHeifEncoder; 470 | writer: THeifWriter; 471 | begin 472 | // Allocate context 473 | ctx := heif_context_alloc(); 474 | try 475 | // Create encoder 476 | heif_context_get_encoder_for_format(ctx, THeifCompressionFormat.compression_HEVC, encoder).ErrRaise; 477 | try 478 | if LosslessQuality then 479 | heif_encoder_set_lossless(encoder, true) 480 | else 481 | heif_encoder_set_lossy_quality(encoder, Quality).ErrRaise; 482 | 483 | // Encode 484 | heif_context_encode_image(ctx, FImage, encoder, nil, nil).ErrRaise; 485 | finally 486 | heif_encoder_release(encoder); 487 | end; 488 | 489 | // Start writing process 490 | writer.writer_api_version := 1; 491 | writer.write := DoWrite; 492 | heif_context_write(ctx, writer, Stream).ErrRaise; 493 | finally 494 | heif_context_free( ctx ); 495 | end; 496 | end; 497 | 498 | function THeifImage.ScanCreateBitmap: TBitMap; 499 | var 500 | Y: Integer; 501 | SrcPtr: PByte; 502 | DestPtr: PByte; 503 | BytesPerScanLine: Integer; 504 | begin 505 | Result := TBitmap.Create; 506 | 507 | Result.PixelFormat := pf24bit; 508 | Result.Width := Width; 509 | Result.Height := Height; 510 | Result.Transparent := false; 511 | 512 | SrcPtr := FData; 513 | BytesPerScanLine := Width * PIXEL_SIZE; 514 | 515 | const ImageHeight = Height; 516 | for Y := 0 to ImageHeight - 1 do 517 | begin 518 | // Get line start 519 | DestPtr := Result.ScanLine[Y]; 520 | 521 | // Read 522 | MoveFlipPixels(@SrcPtr^, @DestPtr^, BytesPerScanLine); 523 | 524 | // Next row 525 | Inc(SrcPtr, FDataStride); // move by FDataStride, as some other data is contained!! 526 | end; 527 | end; 528 | 529 | function THeifImage.ScanCreatePNG: TPNGImage; 530 | var 531 | Y: Integer; 532 | SrcPtr, 533 | DestPtr: PByte; 534 | BytesPerSourceLine: integer; 535 | begin 536 | if (Width = 0) or (Height = 0) then 537 | Exit( TPNGImage.Create ); 538 | 539 | Result := TPNGImage.CreateBlank(COLOR_RGB, 8, Width, Height); 540 | Result.Transparent := false; 541 | 542 | // Calcualte byte size 543 | SrcPtr := FData; 544 | BytesPerSourceLine := Width * PIXEL_SIZE; 545 | 546 | const ImageHeight = Height; 547 | for Y := 0 to ImageHeight - 1 do 548 | begin 549 | DestPtr := Result.ScanLine[Y]; 550 | 551 | // Read 552 | MoveFlipPixels(@SrcPtr^, @DestPtr^, BytesPerSourceLine); 553 | 554 | /// Since the PNG image is COLOR_RGB, not COLOR_BRGALPHA, the Alpha 555 | /// channel does not exist, and so It does not need to be set to 255. 556 | /// Also, they are in reverse order, so this function is needed 557 | 558 | // Move 559 | Inc(SrcPtr, FDataStride); // move by FDataStride, as some other data is contained!! 560 | end; 561 | end; 562 | 563 | procedure THeifImage.SetHeight(Value: Integer); 564 | var 565 | PreviousImage: PHeifImage; 566 | PreviousData: PByte; 567 | PreviousSize: cardinal; 568 | DataCopy: cardinal; 569 | begin 570 | // Prev 571 | PreviousImage := FImage; 572 | PreviousData := FData; 573 | PreviousSize := ArraySize; 574 | 575 | // Allocate new 576 | ReallocateNew(Width, Value); 577 | 578 | // Transfer data 579 | DataCopy := Min(PreviousSize, ArraySize); 580 | Move(PreviousData^, FData^, DataCopy); 581 | 582 | // Free previous 583 | FreeImageMemory(PreviousImage); 584 | end; 585 | 586 | procedure THeifImage.SetPixels(const X, Y: Integer; const Value: TColor); 587 | begin 588 | SetWebPPixel(X, Y, TRGBAPixel.Create(Value)); 589 | end; 590 | 591 | procedure THeifImage.SetQuality(const Value: byte); 592 | begin 593 | FQuality := EnsureRange(Value, 0, 100); 594 | end; 595 | 596 | procedure THeifImage.SetWebPPixel(const X, Y: Integer; const Value: TRGBAPixel); 597 | var 598 | Start: integer; 599 | begin 600 | Start := GetPixelStart(X, Y); 601 | 602 | FData[Start] := Value.GetR; 603 | FData[Start+1] := Value.GetG; 604 | FData[Start+2] := Value.GetB; 605 | end; 606 | 607 | procedure THeifImage.SetWidth(Value: Integer); 608 | var 609 | PreviousImage: PHeifImage; 610 | PreviousData: PByte; 611 | PreviousRowByteSize: integer; 612 | DataCopy: cardinal; 613 | ImageHeight, 614 | RowByteSize: integer; 615 | begin 616 | // Prev 617 | PreviousImage := FImage; 618 | PreviousData := FData; 619 | PreviousRowByteSize := Width*PIXEL_SIZE; 620 | 621 | // Allocate new 622 | ReallocateNew(Value, Height); 623 | 624 | // Transfer data 625 | RowByteSize := Width*PIXEL_SIZE; 626 | DataCopy := Min(PreviousRowByteSize, RowByteSize); 627 | ImageHeight := Height; // Assign the value here 628 | 629 | for var Y := 0 to ImageHeight - 1 do 630 | Move(PreviousData[Y*PreviousRowByteSize], FData[Y*RowByteSize], DataCopy); 631 | 632 | // Free previous 633 | FreeImageMemory(PreviousImage); 634 | end; 635 | 636 | initialization 637 | // Don't register DLL 638 | if not HeifDLLLoaded then 639 | Exit; 640 | 641 | {Registers THeifImage to use with TPicture} 642 | {$IFDEF UseDelphi}{$IFDEF RegisterGraphic} 643 | TPicture.RegisterFileFormat('heic', 'High Efficiency Image Codec', THeifImage); 644 | TPicture.RegisterFileFormat('heif', 'High Efficiency Image Format', THeifImage); 645 | {$ENDIF}{$ENDIF} 646 | finalization 647 | // Don't unregister DLL 648 | if not HeifDLLLoaded then 649 | Exit; 650 | 651 | {$IFDEF UseDelphi}{$IFDEF RegisterGraphic} 652 | TPicture.UnregisterGraphicClass(THeifImage); 653 | {$ENDIF}{$ENDIF} 654 | end. 655 | -------------------------------------------------------------------------------- /source/Cod.Imaging.Internal.Heif.pas: -------------------------------------------------------------------------------- 1 | // Lib HEIF 2 | 3 | unit Cod.Imaging.Internal.Heif; 4 | 5 | interface 6 | 7 | uses 8 | Windows, 9 | SysUtils; 10 | 11 | type 12 | // Types 13 | THeifItemID = UInt32; 14 | PHeifItemID = ^THeifItemID; 15 | THeifPropertyID = UInt32; 16 | THeifString = PAnsiChar; 17 | THeifChannel = type integer; 18 | THeifChroma = type integer; 19 | THeifColorspace = type integer; 20 | THeifReadingOptions = type Pointer; // should be set to null for now 21 | THeifEncodingOptions = type Pointer; // also null 22 | THeifCompressionFormat = type integer; 23 | THeifSuberrorCode = type integer; 24 | 25 | // Helper 26 | THeifChannelHelper = record helper for THeifChannel 27 | const 28 | channel_Y = 0; 29 | channel_Cb = 1; 30 | channel_Cr = 2; 31 | channel_R = 3; 32 | channel_G = 4; 33 | channel_B = 5; 34 | channel_Alpha = 6; 35 | channel_interleaved = 10; 36 | end; 37 | THeifChromaHelper = record helper for THeifChroma 38 | const 39 | // SDR 40 | chroma_444=3; 41 | chroma_interleaved_RGB =10; 42 | chroma_interleaved_RGBA=11; 43 | // HDR 44 | chroma_interleaved_RRGGBB_BE=12; 45 | chroma_interleaved_RRGGBBAA_BE=13; 46 | chroma_interleaved_RRGGBB_LE=14; 47 | chroma_interleaved_RRGGBBAA_LE=15; 48 | end; 49 | THeifColorspaceHelper = record helper for THeifColorspace 50 | const 51 | colorspace_undefined=99; 52 | colorspace_YCbCr=0; 53 | colorspace_RGB=1; 54 | colorspace_monochrome=2; 55 | end; 56 | THeifCompressionFormatHelper = record helper for THeifCompressionFormat 57 | const 58 | // No format selected 59 | compression_undefined = 0; 60 | 61 | // HEVC used for HEIC images, equivalent to H.256 62 | compression_HEVC = 1; 63 | // AVC compression (unused) 64 | compression_AVC = 2; 65 | // Joint Photographs Experts Group encoding 66 | compression_JPEG = 3; 67 | // Used for AVIF Images 68 | compression_AV1 = 4; 69 | // VVC compression (unused) 70 | compression_VVC = 5; 71 | // EVC encoding (unused) 72 | compression_EVC = 6; 73 | // JPEG 2000 encoding 74 | compression_JPEG2000 = 7; 75 | // Uncompressed image encoding 76 | compression_uncompressed = 8; 77 | // Mask image encoding (ISO/IEC 23008-12:2022 Section 6.10.2) 78 | compression_mask = 0; 79 | end; 80 | THeifSuberrorCodeHelper = record helper for THeifSuberrorCode 81 | const 82 | // no further information available 83 | heif_suberror_Unspecified = 0; 84 | 85 | // --- Invalid_input --- 86 | // End of data reached unexpectedly. 87 | heif_suberror_End_of_data = 100; 88 | 89 | // Size of box (defined in header) is wrong 90 | heif_suberror_Invalid_box_size = 101; 91 | 92 | // Mandatory 'ftyp' box is missing 93 | heif_suberror_No_ftyp_box = 102; 94 | heif_suberror_No_idat_box = 103; 95 | heif_suberror_No_meta_box = 104; 96 | heif_suberror_No_hdlr_box = 105; 97 | heif_suberror_No_hvcC_box = 106; 98 | heif_suberror_No_pitm_box = 107; 99 | heif_suberror_No_ipco_box = 108; 100 | heif_suberror_No_ipma_box = 109; 101 | heif_suberror_No_iloc_box = 110; 102 | heif_suberror_No_iinf_box = 111; 103 | heif_suberror_No_iprp_box = 112; 104 | heif_suberror_No_iref_box = 113; 105 | heif_suberror_No_pict_handler = 114; 106 | 107 | // An item property referenced in the 'ipma' box is not existing in the 'ipco' container. 108 | heif_suberror_Ipma_box_references_nonexisting_property = 115; 109 | 110 | // No properties have been assigned to an item. 111 | heif_suberror_No_properties_assigned_to_item = 116; 112 | 113 | // Image has no (compressed) data 114 | heif_suberror_No_item_data = 117; 115 | 116 | // Invalid specification of image grid (tiled image) 117 | heif_suberror_Invalid_grid_data = 118; 118 | 119 | // Tile-images in a grid image are missing 120 | heif_suberror_Missing_grid_images = 119; 121 | heif_suberror_Invalid_clean_aperture = 120; 122 | 123 | // Invalid specification of overlay image 124 | heif_suberror_Invalid_overlay_data = 121; 125 | 126 | // Overlay image completely outside of visible canvas area 127 | heif_suberror_Overlay_image_outside_of_canvas = 122; 128 | heif_suberror_Auxiliary_image_type_unspecified = 123; 129 | heif_suberror_No_or_invalid_primary_item = 124; 130 | heif_suberror_No_infe_box = 125; 131 | heif_suberror_Unknown_color_profile_type = 126; 132 | heif_suberror_Wrong_tile_image_chroma_format = 127; 133 | heif_suberror_Invalid_fractional_number = 128; 134 | heif_suberror_Invalid_image_size = 129; 135 | heif_suberror_Invalid_pixi_box = 130; 136 | heif_suberror_No_av1C_box = 131; 137 | heif_suberror_Wrong_tile_image_pixel_depth = 132; 138 | heif_suberror_Unknown_NCLX_color_primaries = 133; 139 | heif_suberror_Unknown_NCLX_transfer_characteristics = 134; 140 | heif_suberror_Unknown_NCLX_matrix_coefficients = 135; 141 | 142 | // Invalid specification of region item 143 | heif_suberror_Invalid_region_data = 136; 144 | 145 | // Image has no ispe property 146 | heif_suberror_No_ispe_property = 137; 147 | heif_suberror_Camera_intrinsic_matrix_undefined = 138; 148 | heif_suberror_Camera_extrinsic_matrix_undefined = 139; 149 | 150 | // Invalid JPEG 2000 codestream - usually a missing marker 151 | heif_suberror_Invalid_J2K_codestream = 140; 152 | heif_suberror_No_vvcC_box = 141; 153 | 154 | // icbr is only needed in some situations; this error is for those cases 155 | heif_suberror_No_icbr_box = 142; 156 | heif_suberror_No_avcC_box = 143; 157 | 158 | // Decompressing generic compression or header compression data failed (e.g. bitstream corruption) 159 | heif_suberror_Decompression_invalid_data = 150; 160 | 161 | // --- Memory_allocation_error --- 162 | 163 | // A security limit preventing unreasonable memory allocations was exceeded by the input file. 164 | // Please check whether the file is valid. If it is; contact us so that we could increase the 165 | // security limits further. 166 | heif_suberror_Security_limit_exceeded = 1000; 167 | 168 | // There was an error from the underlying compression / decompression library. 169 | // One possibility is lack of resources (e.g. memory). 170 | heif_suberror_Compression_initialisation_error = 1001; 171 | 172 | // --- Usage_error --- 173 | // An item ID was used that is not present in the file. 174 | heif_suberror_Nonexisting_item_referenced = 2000; // also used for Invalid_input 175 | 176 | // An API argument was given a NULL pointer; which is not allowed for that function. 177 | heif_suberror_Null_pointer_argument = 2001; 178 | 179 | // Image channel referenced that does not exist in the image 180 | heif_suberror_Nonexisting_image_channel_referenced = 2002; 181 | 182 | // The version of the passed plugin is not supported. 183 | heif_suberror_Unsupported_plugin_version = 2003; 184 | 185 | // The version of the passed writer is not supported. 186 | heif_suberror_Unsupported_writer_version = 2004; 187 | 188 | // The given (encoder) parameter name does not exist. 189 | heif_suberror_Unsupported_parameter = 2005; 190 | 191 | // The value for the given parameter is not in the valid range. 192 | heif_suberror_Invalid_parameter_value = 2006; 193 | 194 | // Error in property specification 195 | heif_suberror_Invalid_property = 2007; 196 | 197 | // Image reference cycle found in iref 198 | heif_suberror_Item_reference_cycle = 2008; 199 | 200 | // --- Unsupported_feature --- 201 | // Image was coded with an unsupported compression method. 202 | heif_suberror_Unsupported_codec = 3000; 203 | 204 | // Image is specified in an unknown way; e.g. as tiled grid image (which is supported) 205 | heif_suberror_Unsupported_image_type = 3001; 206 | heif_suberror_Unsupported_data_version = 3002; 207 | 208 | // The conversion of the source image to the requested chroma / colorspace is not supported. 209 | heif_suberror_Unsupported_color_conversion = 3003; 210 | heif_suberror_Unsupported_item_construction_method = 3004; 211 | heif_suberror_Unsupported_header_compression_method = 3005; 212 | 213 | // Generically compressed data used an unsupported compression method 214 | heif_suberror_Unsupported_generic_compression_method = 3006; 215 | heif_suberror_Unsupported_essential_property = 3007; 216 | 217 | // --- Encoder_plugin_error --- 218 | heif_suberror_Unsupported_bit_depth = 4000; 219 | 220 | // --- Encoding_error --- 221 | heif_suberror_Cannot_write_output_data = 5000; 222 | heif_suberror_Encoder_initialization = 5001; 223 | heif_suberror_Encoder_encoding = 5002; 224 | heif_suberror_Encoder_cleanup = 5003; 225 | heif_suberror_Too_many_regions = 5004; 226 | 227 | // --- Plugin loading error --- 228 | heif_suberror_Plugin_loading_error = 6000; // a specific plugin file cannot be loaded 229 | heif_suberror_Plugin_is_not_loaded = 6001; // trying to remove a plugin that is not loaded 230 | heif_suberror_Cannot_read_plugin_directory = 6002; // error while scanning the directory for plugins 231 | heif_suberror_No_matching_decoder_installed = 6003; // no decoder found for that compression format 232 | end; 233 | 234 | // Error 235 | THeifErrorNum = ( 236 | // Everything ok, no error occurred 237 | heif_error_Ok, 238 | // Input file does not exist. 239 | heif_error_Input_does_not_exist, 240 | // Error in input file. Corrupted or invalid content. 241 | heif_error_Invalid_input, 242 | // Input file type is not supported. 243 | heif_error_Unsupported_filetype, 244 | // Image requires an unsupported decoder feature. 245 | heif_error_Unsupported_feature, 246 | // Library API has been used in an invalid way. 247 | heif_error_Usage_error, 248 | // Could not allocate enough memory. 249 | heif_error_Memory_allocation_error, 250 | // The decoder plugin generated an error 251 | heif_error_Decoder_plugin_error, 252 | // The encoder plugin generated an error 253 | heif_error_Encoder_plugin_error, 254 | // Error during encoding or when writing to the output 255 | heif_error_Encoding_error, 256 | // Application has asked for a color profile type that does not exist 257 | heif_error_Color_profile_does_not_exist, 258 | // Error loading a dynamic plugin 259 | heif_error_Plugin_loading_error 260 | ); 261 | 262 | heif_filetype_result = ( 263 | heif_filetype_no, 264 | heif_filetype_yes_supported, // it is heif and can be read by libheif 265 | heif_filetype_yes_unsupported, // it is heif, but cannot be read by libheif 266 | heif_filetype_maybe 267 | ); // not sure whether it is an heif, try detection with more input data 268 | 269 | THeifError = record 270 | code: THeifErrorNum; 271 | subcode: THeifSuberrorCode; 272 | 273 | emessage: THeifString; 274 | 275 | procedure ErrRaise; 276 | 277 | class function Create(ACode: THeifErrorNum; ASubcode: THeifSuberrorCode=THeifSuberrorCode.heif_suberror_Unspecified; AMessage: THeifString=nil): THeifError; static; 278 | end; 279 | 280 | // Base classes 281 | THeifContextClass = TObject; 282 | THeifImageClass = TObject; 283 | THeifPixelImageClass = TObject; 284 | 285 | // Heif context 286 | THeifContext = record 287 | context: THeifContextClass; 288 | end; 289 | PHeifContext = ^THeifContext; 290 | 291 | // Heif image 292 | THeifImage = record 293 | image: THeifPixelImageClass; 294 | end; 295 | PHeifImage = ^THeifImage; 296 | 297 | // Heif image handle 298 | THeifImageHandle = record 299 | image: THeifImage; 300 | context: THeifContext; 301 | end; 302 | PHeifImageHandle = ^THeifImageHandle; 303 | PPHeifImageHandle = ^PHeifImageHandle; 304 | 305 | // Encoder 306 | PHeifEncoder = Pointer; 307 | 308 | // Procs 309 | THeifWriteFunc = function(ctx: PHeifContext; const data: Pointer; size: cardinal; userdata: Pointer): THeifError; 310 | PHeifWriteFunc = ^THeifWriteFunc; 311 | 312 | // Writer 313 | THeifWriter = record 314 | writer_api_version: integer; 315 | write: THeifWriteFunc; 316 | end; 317 | PHeifWriter = ^THeifWriter; 318 | 319 | const 320 | (* DLL Name *) 321 | HeifDLL = 'libheif.dll'; 322 | 323 | // Lib-HEIF Procedures 324 | //procedure heif_check_filetype; stdcall; external HeifDLL; 325 | 326 | var 327 | (* Context *) 328 | heif_context_alloc: function: PHeifContext; stdcall; 329 | heif_context_read_from_file: function (context: PHeifContext; filename: THeifString; const readoptions: THeifReadingOptions): THeifError; stdcall; 330 | heif_context_write_to_file: function (context: PHeifContext; filename: THeifString): THeifError; stdcall; 331 | heif_context_read_from_memory: function (context: PHeifContext; mem: PByte; size: cardinal; const readoptions: THeifReadingOptions): THeifError; stdcall; 332 | heif_context_read_from_memory_without_copy: function (context: PHeifContext; mem: PByte; size: cardinal; const readoptions: THeifReadingOptions): THeifError; stdcall; 333 | heif_context_write: function (context: PHeifContext; var writer: THeifWriter; userdata: Pointer): THeifError; stdcall; 334 | heif_context_get_number_of_top_level_images: function (context: PHeifContext): cardinal; 335 | heif_context_get_primary_image_handle: function (context: PHeifContext; var Handle: PHeifImageHandle): THeifError; stdcall; 336 | heif_context_get_primary_image_ID: function (context: PHeifContext; var id: THeifItemID): THeifError; stdcall; 337 | heif_context_set_primary_image: function (context: PHeifContext; Handle: PHeifImageHandle): THeifError; stdcall; 338 | heif_context_get_encoder_for_format: function (context: PHeifContext; format: THeifCompressionFormat; var Encoder: PHeifEncoder): THeifError; 339 | heif_context_encode_image: function (context: PHeifContext; image: PHeifImage; Encoder: PHeifEncoder; options: THeifEncodingOptions; out_image_handle: PPHeifImageHandle): THeifError; stdcall; 340 | heif_context_add_exif_metadata: function (context: PHeifContext; imageHandle: PHeifImageHandle; data: Pointer; size: integer): THeifError; stdcall; 341 | heif_context_free: function (context: PHeifContext): BOOL; stdcall; 342 | 343 | (* Encoder *) 344 | heif_encoder_get_name: function (encoder: PHeifEncoder): THeifString; stdcall; 345 | heif_encoder_set_lossless: function (encoder: PHeifEncoder; enable: bool): THeifError; stdcall; 346 | // Quality ranges from 0-100 347 | heif_encoder_set_lossy_quality: function (encoder: PHeifEncoder; quality: integer): THeifError; stdcall; 348 | heif_encoder_release: function (encoder: PHeifEncoder): THeifString; stdcall; 349 | 350 | (* Heif image handle *) 351 | heif_image_handle_get_height: function (handle: PHeifImageHandle): integer; stdcall; 352 | heif_image_handle_get_width: function (handle: PHeifImageHandle): integer; stdcall; 353 | heif_image_handle_has_alpha_channel: function (handle: PHeifImageHandle): bool; stdcall; 354 | heif_image_handle_get_thumbnail: function (MainImageHandle: PHeifImageHandle; id: THeifItemID; Handle: PHeifImageHandle): BOOL; stdcall; 355 | heif_image_handle_get_chroma_bits_per_pixel: function (handle: PHeifImageHandle): integer; stdcall; 356 | heif_image_handle_release: function (handle: PHeifImageHandle): BOOL; stdcall; 357 | 358 | (* Heif image *) 359 | heif_image_create: function (width: integer; height: integer; colorspace: THeifColorspace; chroma: THeifChroma; var image: PHeifImage): THeifError; stdcall; 360 | heif_decode_image: function (in_handle: PHeifImageHandle; var out_img: PHeifImage; colorspace: THeifColorspace; chroma: THeifChroma; other: pointer): THeifError; stdcall; 361 | heif_image_get_width: function (image: PHeifImage; channel: THeifChannel): integer; stdcall; 362 | heif_image_get_height: function (image: PHeifImage; channel: THeifChannel): integer; stdcall; 363 | heif_image_get_plane: function (image: PHeifImage; channel: THeifChannel; var stride: Integer): PByte; stdcall; 364 | heif_image_get_plane_readonly: function (image: PHeifImage; channel: THeifChannel; stride: PInteger): PByte; stdcall; 365 | heif_image_get_colorspace: function (image: PHeifImage): cardinal; stdcall; 366 | heif_image_get_bits_per_pixel: function (image: PHeifImage; channel: THeifChannel ): integer; stdcall; 367 | heif_image_get_chroma_format: function (image: PHeifImage): THeifChroma; stdcall; 368 | heif_image_add_plane: function (image: PHeifImage; channel: THeifChannel; width: integer; height: integer; bitDepth: integer): THeifError; stdcall; 369 | heif_image_release: procedure (image: PHeifImage); stdcall; 370 | 371 | (* Utils *) 372 | heif_get_version: function: THeifString; stdcall; 373 | heif_get_version_number: function: integer; stdcall; 374 | heif_get_version_number_major: function: integer; stdcall; 375 | heif_get_version_number_minor: function: integer; stdcall; 376 | heif_get_version_number_maintenance: function: integer; stdcall; 377 | 378 | function HeifDLLLoaded: boolean; 379 | 380 | implementation 381 | 382 | var 383 | FHeifDLL: THandle = 0; 384 | 385 | function HeifDLLLoaded: boolean; 386 | begin 387 | Result := FHeifDLL <> 0; 388 | end; 389 | 390 | function GetProc(Name: string): FARPROC; 391 | begin 392 | Result := GetProcAddress(FHeifDLL, PChar(Name)); 393 | end; 394 | 395 | procedure LoadHeifDLL; 396 | begin 397 | FHeifDLL := LoadLibrary(PChar(HeifDLL)); 398 | 399 | if FHeifDLL = 0 then 400 | Exit; 401 | 402 | // Load function memory 403 | heif_context_alloc := GetProc('heif_context_alloc'); 404 | heif_context_read_from_file := GetProc('heif_context_read_from_file'); 405 | heif_context_write_to_file := GetProc('heif_context_write_to_file'); 406 | heif_context_read_from_memory := GetProc('heif_context_read_from_memory'); 407 | heif_context_read_from_memory_without_copy := GetProc('heif_context_read_from_memory_without_copy'); 408 | heif_context_write := GetProc('heif_context_write'); 409 | heif_context_get_number_of_top_level_images := GetProc('heif_context_get_number_of_top_level_images'); 410 | heif_context_get_primary_image_handle := GetProc('heif_context_get_primary_image_handle'); 411 | heif_context_get_primary_image_ID := GetProc('heif_context_get_primary_image_ID'); 412 | heif_context_set_primary_image := GetProc('heif_context_set_primary_image'); 413 | heif_context_get_encoder_for_format := GetProc('heif_context_get_encoder_for_format'); 414 | heif_context_encode_image := GetProc('heif_context_encode_image'); 415 | heif_context_add_exif_metadata := GetProc('heif_context_add_exif_metadata'); 416 | heif_context_free := GetProc('heif_context_free'); 417 | 418 | heif_encoder_get_name := GetProc('heif_encoder_get_name'); 419 | heif_encoder_set_lossless := GetProc('heif_encoder_set_lossless'); 420 | heif_encoder_set_lossy_quality := GetProc('heif_encoder_set_lossy_quality'); 421 | heif_encoder_release := GetProc('heif_encoder_release'); 422 | 423 | heif_image_handle_get_height := GetProc('heif_image_handle_get_height'); 424 | heif_image_handle_get_width := GetProc('heif_image_handle_get_width'); 425 | heif_image_handle_has_alpha_channel := GetProc('heif_image_handle_has_alpha_channel'); 426 | heif_image_handle_get_thumbnail := GetProc('heif_image_handle_get_thumbnail'); 427 | heif_image_handle_get_chroma_bits_per_pixel := GetProc('heif_image_handle_get_chroma_bits_per_pixel'); 428 | heif_image_handle_release := GetProc('heif_image_handle_release'); 429 | 430 | heif_image_create := GetProc('heif_image_create'); 431 | heif_decode_image := GetProc('heif_decode_image'); 432 | heif_image_get_width := GetProc('heif_image_get_width'); 433 | heif_image_get_height := GetProc('heif_image_get_height'); 434 | heif_image_get_plane := GetProc('heif_image_get_plane'); 435 | heif_image_get_plane_readonly := GetProc('heif_image_get_plane_readonly'); 436 | heif_image_get_colorspace := GetProc('heif_image_get_colorspace'); 437 | heif_image_get_bits_per_pixel := GetProc('heif_image_get_bits_per_pixel'); 438 | heif_image_get_chroma_format := GetProc('heif_image_get_chroma_format'); 439 | heif_image_add_plane := GetProc('heif_image_add_plane'); 440 | heif_image_release := GetProc('heif_image_release'); 441 | 442 | heif_get_version := GetProc('heif_get_version'); 443 | heif_get_version_number := GetProc('heif_get_version_number'); 444 | heif_get_version_number_major := GetProc('heif_get_version_number_major'); 445 | heif_get_version_number_minor := GetProc('heif_get_version_number_minor'); 446 | heif_get_version_number_maintenance := GetProc('heif_get_version_number_maintenance'); 447 | end; 448 | 449 | procedure UnloadHeifDLL; 450 | begin 451 | FreeLibrary(FHeifDLL); 452 | end; 453 | 454 | { THeifError } 455 | 456 | class function THeifError.Create(ACode: THeifErrorNum; ASubcode: THeifSuberrorCode; 457 | AMessage: THeifString): THeifError; 458 | begin 459 | with Result do begin 460 | code := ACode; 461 | subcode := ASubCode; 462 | emessage := AMessage; 463 | end; 464 | end; 465 | 466 | procedure THeifError.ErrRaise; 467 | begin 468 | if code <> heif_error_Ok then 469 | raise Exception.Create(Format('Error "%S"'#13'Code: %D @(%D)', [emessage, integer(code), subcode])); 470 | end; 471 | 472 | initialization 473 | LoadHeifDLL; 474 | finalization 475 | UnloadHeifDLL; 476 | end. 477 | -------------------------------------------------------------------------------- /source/Cod.Imaging.Internal.WebPHelpers.pas: -------------------------------------------------------------------------------- 1 | unit Cod.Imaging.Internal.WebPHelpers; 2 | 3 | interface 4 | 5 | uses 6 | System.SysUtils, 7 | GDIPAPI, 8 | GDIPOBJ, 9 | System.Classes, 10 | Cod.Imaging.Internal.libwebp; 11 | 12 | // Encode GUID's from https://stackoverflow.com/questions/16368575/how-to-save-an-image-to-bmp-png-jpg-with-gdi 13 | const 14 | gGIf: TGUID = '{557CF402-1A04-11D3-9A73-0000F81EF32E}'; 15 | gPNG: TGUID = '{557CF406-1A04-11D3-9A73-0000F81EF32E}'; 16 | gPJG: TGUID = '{557CF401-1A04-11D3-9A73-0000F81EF32E}'; 17 | gBMP: TGUID = '{557CF400-1A04-11D3-9A73-0000F81EF32E}'; 18 | gTIF: TGUID = '{557CF405-1A04-11D3-9A73-0000F81EF32E}'; 19 | 20 | /// 21 | /// Compress image using Webp. See https://developers.google.com/speed/webp/docs/api#simple_encoding_api for more documentation. 22 | /// 23 | /// 24 | /// Stream to write the image content to. 25 | /// 26 | /// 27 | /// The image to compress 28 | /// 29 | /// 30 | /// The image quality {0-100}. Default is 80. 31 | /// 32 | procedure WebpEncode(var stream: TMemoryStream; img: TGPBitmap; quality_factor: Single = 80); overload; 33 | 34 | /// 35 | /// Compress image using Webp. See https://developers.google.com/speed/webp/docs/api#simple_encoding_api for more documentation. 36 | /// 37 | /// 38 | /// Buffer to write the image content to. 39 | /// 40 | /// 41 | /// The image to compress 42 | /// 43 | /// 44 | /// The image quality {0-100}. Default is 80. 45 | /// 46 | procedure WebpEncode(var buffer: TBytes; img: TGPBitmap; quality_factor: Single = 80); overload; 47 | 48 | /// 49 | /// Compress image losslessly using Webp. See https://developers.google.com/speed/webp/docs/api#simple_encoding_api for more documentation. 50 | /// 51 | /// 52 | /// Stream to write the image content to. 53 | /// 54 | /// 55 | /// The image to compress 56 | /// 57 | procedure WebpLosslessEncode(var stream: TMemoryStream; img: TGPBitmap); overload; 58 | 59 | /// 60 | /// Compress image losslessly using Webp. See https://developers.google.com/speed/webp/docs/api#simple_encoding_api for more documentation. 61 | /// 62 | /// 63 | /// Buffer to write the image content to. 64 | /// 65 | /// 66 | /// The image to compress 67 | /// 68 | procedure WebpLosslessEncode(var buffer: TBytes; img: TGPBitmap); overload; 69 | 70 | /// 71 | /// Decode image to GDI+ Bitmap 72 | /// 73 | /// 74 | /// File stream to decode 75 | /// 76 | /// 77 | /// The pointer to the raw decoded data in BGRA format (32bit). YOU MUST FREE IT WITH WebPFree(data)! 78 | /// 79 | /// 80 | /// The bitmap data for the image. YOU MUST FREE IT WITH bitmap.Free! 81 | /// 82 | procedure WebpDecode(fs: TStream; var data: PByte; var bitmap : TGPBitmap); 83 | 84 | /// 85 | /// Return version as string 86 | /// 87 | function GetWebpVersionString (versionhex : integer) : string; 88 | 89 | implementation 90 | 91 | procedure WebpEncode(var stream: TMemoryStream; img: TGPBitmap; quality_factor: Single = 80); overload; 92 | var 93 | rect : TGPRect; 94 | bmpData: BitmapData; 95 | ptrEncoded : PByte; 96 | size: Cardinal; 97 | begin 98 | // Get image size 99 | rect.X := 0; 100 | rect.Y := 0; 101 | rect.Width := img.GetWidth; 102 | rect.height := img.GetHeight; 103 | // Get image data 104 | img.LockBits(rect, 3, img.GetPixelFormat, bmpData); 105 | // Check if image has alpha layer. 106 | if IsAlphaPixelFormat(img.GetPixelFormat) then size := WebPEncodeBGRA(bmpData.Scan0, img.GetWidth, img.GetHeight, bmpData.Stride, quality_factor, ptrEncoded) 107 | else size := WebPEncodeBGR(bmpData.Scan0, img.GetWidth, img.GetHeight, bmpData.Stride, quality_factor, ptrEncoded); 108 | // Write buffer to stream 109 | stream.Write(ptrEncoded^, size); 110 | // Free buffer 111 | WebPFree(ptrEncoded); 112 | end; 113 | 114 | procedure WebpEncode(var buffer: TBytes; img: TGPBitmap; quality_factor: Single = 80); overload; 115 | var 116 | stream : TMemoryStream; 117 | begin 118 | // Helper to convert stream to buffer 119 | stream := TMemoryStream.Create; 120 | WebpEncode(stream, img, quality_factor); 121 | stream.Position := 0; 122 | SetLength(buffer, stream.Size); 123 | stream.ReadData(buffer, stream.Size); 124 | stream.Free; 125 | end; 126 | 127 | procedure WebpLosslessEncode(var stream: TMemoryStream; img: TGPBitmap); overload; 128 | var 129 | rect : TGPRect; 130 | bmpData: BitmapData; 131 | ptrEncoded : PByte; 132 | size: Cardinal; 133 | begin 134 | // Get image size 135 | rect.X := 0; 136 | rect.Y := 0; 137 | rect.Width := img.GetWidth; 138 | rect.height := img.GetHeight; 139 | // Get image data 140 | img.LockBits(rect, 3, img.GetPixelFormat, bmpData); 141 | // Check if image has alpha layer. 142 | if IsAlphaPixelFormat(img.GetPixelFormat) then size := WebPEncodeLosslessBGRA(bmpData.Scan0, img.GetWidth, img.GetHeight, bmpData.Stride, ptrEncoded) 143 | else size := WebPEncodeLosslessBGR(bmpData.Scan0, img.GetWidth, img.GetHeight, bmpData.Stride, ptrEncoded); 144 | // Write buffer to stream 145 | stream.Write(ptrEncoded^, size); 146 | // Free buffer 147 | WebPFree(ptrEncoded); 148 | end; 149 | 150 | procedure WebpLosslessEncode(var buffer: TBytes; img: TGPBitmap); overload; 151 | var 152 | stream : TMemoryStream; 153 | begin 154 | // Helper to convert stream to buffer 155 | stream := TMemoryStream.Create; 156 | WebpLosslessEncode(stream, img); 157 | stream.Position := 0; 158 | SetLength(buffer, stream.Size); 159 | stream.ReadData(buffer, stream.Size); 160 | stream.Free; 161 | end; 162 | 163 | procedure WebpDecode(fs: TStream; var data: PByte; var bitmap : TGPBitmap); 164 | var 165 | buffer: TBytes; 166 | width, height: integer; 167 | begin 168 | fs.Position := 0; 169 | setlength(buffer, fs.Size); 170 | fs.ReadBuffer(buffer, fs.size); 171 | data := WebPDecodeBGRA(@buffer[0], fs.Size, @width, @height); 172 | // Free buffer 173 | setlength(buffer, 0); 174 | // Load to image 175 | bitmap := TGPBitmap.Create(width, height, 4 * width, 2498570, data); 176 | end; 177 | 178 | function GetWebpVersionString (versionhex : integer) : string; 179 | var 180 | maj, min, patch : integer; 181 | begin 182 | // Determine version 183 | // Format for version is hex, where first 2 hex is maj, second min, third patch 184 | // E.g: v2.5.7 is 0x020507 185 | maj := versionhex div $10000; 186 | min := (versionhex - (maj * $10000)) div $100; 187 | patch := (versionhex - (maj * $10000) - (min * $100)); 188 | result := maj.ToString + '.' + min.ToString + '.' + patch.ToString; 189 | end; 190 | 191 | end. 192 | -------------------------------------------------------------------------------- /source/Cod.Imaging.Internal.libwebp.pas: -------------------------------------------------------------------------------- 1 | unit Cod.Imaging.Internal.libwebp; 2 | 3 | // Copyright 2010 Google Inc. 4 | // 5 | // This code is licensed under the same terms as WebM: 6 | // Software License Agreement: http://www.webmproject.org/license/software/ 7 | // Additional IP Rights Grant: http://www.webmproject.org/license/additional/ 8 | // 9 | 10 | // Original Delphi API by Henri Gourvest 11 | 12 | // Updated by Daniel Wykerd 13 | 14 | // ----------------------------------------------------------------------------- 15 | 16 | {$ALIGN ON} 17 | {$MINENUMSIZE 4} 18 | 19 | interface 20 | const 21 | LIB_WEBP = 'libwebp.dll'; 22 | 23 | 24 | //----------------------------------------------------------------------------- 25 | 26 | type 27 | // Output colorspaces 28 | WEBP_CSP_MODE = ( 29 | MODE_RGB = 0, 30 | MODE_RGBA = 1, 31 | MODE_BGR = 2, 32 | MODE_BGRA = 3, 33 | MODE_YUV = 4); 34 | 35 | // Enumeration of the status codes 36 | TVP8StatusCode = ( 37 | VP8_STATUS_OK = 0, 38 | VP8_STATUS_OUT_OF_MEMORY, 39 | VP8_STATUS_INVALID_PARAM, 40 | VP8_STATUS_BITSTREAM_ERROR, 41 | VP8_STATUS_UNSUPPORTED_FEATURE, 42 | VP8_STATUS_SUSPENDED, 43 | VP8_STATUS_USER_ABORT, 44 | VP8_STATUS_NOT_ENOUGH_DATA 45 | ); 46 | 47 | TDecState = ( 48 | STATE_HEADER = 0, 49 | STATE_PARTS0 = 1, 50 | STATE_DATA = 2, 51 | STATE_DONE = 3, 52 | STATE_ERROR = 4); 53 | 54 | // Decoding output parameters. 55 | PWebPDecParams = ^TWebPDecParams; 56 | TWebPDecParams = record 57 | output: PByte; // rgb(a) or luma 58 | u, v: PByte; // chroma u/v 59 | top_y, top_u, top_v: PByte; // cache for the fancy upscaler 60 | stride: Integer; // rgb(a) stride or luma stride 61 | u_stride: Integer; // chroma-u stride 62 | v_stride: Integer; // chroma-v stride 63 | mode: WEBP_CSP_MODE; // rgb(a) or yuv 64 | last_y: Integer; // coordinate of the line that was last output 65 | output_size: Integer; // size of 'output' buffer 66 | output_u_size: Integer; // size of 'u' buffer 67 | output_v_size: Integer; // size of 'v' buffer 68 | external_buffer: Integer; // If true, the output buffers are externally owned 69 | end; 70 | 71 | PWebPBitstreamFeatures = ^TWebPBitstreamFeatures; 72 | TWebPBitstreamFeatures = record 73 | width: Integer; 74 | height: Integer; 75 | has_alpha: Integer; // 1 = Image has transparency 76 | 77 | bitstream_version: Integer; 78 | no_incremental_decoding: Integer; // 1 = Image is animated 79 | 80 | rotate: Integer; 81 | uv_sampling: integer; 82 | Pad: array[0..2] of Cardinal; 83 | end; 84 | 85 | PWebPIDecoder = ^TWebPIDecoder; 86 | TWebPIDecoder = record 87 | state_: TDecState; // current decoding state 88 | w_, h_: integer; // width and height 89 | params_: TWebPDecParams; // Params to store output info 90 | dec_: Pointer; 91 | end; 92 | 93 | // Input / Output 94 | PVP8Io = ^VP8Io; 95 | VP8Io = record 96 | // set by VP8GetHeaders() 97 | width, height: Integer; // picture dimensions, in pixels 98 | 99 | // set before calling put() 100 | mb_y: Integer; // position of the current rows (in pixels) 101 | mb_h: Integer; // number of rows in the sample 102 | y, u, v: PByte; // rows to copy (in yuv420 format) 103 | y_stride: Integer; // row stride for luma 104 | uv_stride: Integer; // row stride for chroma 105 | 106 | opaque: Pointer; // user data 107 | 108 | // called when fresh samples are available. Currently, samples are in 109 | // YUV420 format, and can be up to width x 24 in size (depending on the 110 | // in-loop filtering level, e.g.). Should return false in case of error 111 | // or abort request. 112 | put: function(const io: PVP8Io): Integer; cdecl; 113 | 114 | // called just before starting to decode the blocks. 115 | // Should returns 0 in case of error. 116 | setup: function(io: PVP8Io): Integer; cdecl; 117 | 118 | // called just after block decoding is finished (or when an error occurred). 119 | teardown: procedure(const io: PVP8Io); cdecl; 120 | 121 | // this is a recommendation for the user-side yuv->rgb converter. This flag 122 | // is set when calling setup() hook and can be overwritten by it. It then 123 | // can be taken into consideration during the put() method. 124 | fancy_upscaling: Integer; 125 | 126 | // Input buffer. 127 | data_size: Cardinal; 128 | data: PByte; 129 | 130 | // If true, in-loop filtering will not be performed even if present in the 131 | // bitstream. Switching off filtering may speed up decoding at the expense 132 | // of more visible blocking. Note that output will also be non-compliant 133 | // with the VP8 specifications. 134 | bypass_filtering: Integer; 135 | end; 136 | 137 | // Main decoding object. This is an opaque structure. 138 | PVP8Decoder = ^VP8Decoder; 139 | VP8Decoder = record end; 140 | 141 | //----------------------------------------------------------------------------- 142 | // Coding parameters 143 | 144 | PWebPConfig = ^TWebPConfig; 145 | TWebPConfig = record 146 | quality: Single; // between 0 (smallest file) and 100 (biggest) 147 | target_size: Integer; // if non-zero, set the desired target size in bytes. 148 | // Takes precedence over the 'compression' parameter. 149 | target_PSNR: Single; // if non-zero, specifies the minimal distortion to 150 | // try to achieve. Takes precedence over target_size. 151 | method: Integer; // quality/speed trade-off (0=fast, 6=slower-better) 152 | segments: Integer; // maximum number of segments to use, in [1..4] 153 | sns_strength: Integer; // Spatial Noise Shaping. 0=off, 100=maximum. 154 | filter_strength: Integer; // range: [0 = off .. 100 = strongest] 155 | filter_sharpness: Integer; // range: [0 = off .. 7 = least sharp] 156 | filter_type: Integer; // filtering type: 0 = simple, 1 = strong 157 | // (only used if filter_strength > 0 or autofilter > 0) 158 | autofilter: Integer; // Auto adjust filter's strength [0 = off, 1 = on] 159 | pass: Integer; // number of entropy-analysis passes (in [1..10]). 160 | 161 | show_compressed: Integer; // if true, export the compressed picture back. 162 | // In-loop filtering is not applied. 163 | preprocessing: Integer; // preprocessing filter (0=none, 1=segment-smooth) 164 | partitions: Integer; // log2(number of token partitions) in [0..3] 165 | // Default is set to 0 for easier progressive decoding. 166 | end; 167 | 168 | // Enumerate some predefined settings for WebPConfig, depending on the type 169 | // of source picture. These presets are used when calling WebPConfigPreset(). 170 | TWebPPreset = ( 171 | WEBP_PRESET_DEFAULT = 0, // default preset. 172 | WEBP_PRESET_PICTURE, // digital picture, like portrait, inner shot 173 | WEBP_PRESET_PHOTO, // outdoor photograph, with natural lighting 174 | WEBP_PRESET_DRAWING, // hand or line drawing, with high-contrast details 175 | WEBP_PRESET_ICON, // small-sized colorful images 176 | WEBP_PRESET_TEXT // text-like 177 | ); 178 | 179 | PWebPPicture = ^TWebPPicture; 180 | //TWebPPicture = record end; // main structure for I/O 181 | 182 | // non-essential structure for storing auxilliary statistics 183 | PWebPAuxStats = ^TWebPAuxStats; 184 | TWebPAuxStats = record 185 | PSNR: array[0..3] of Single; // peak-signal-to-noise ratio for Y/U/V/All 186 | coded_size: Integer; // final size 187 | block_count: array[0..2] of Integer; // number of intra4/intra16/skipped macroblocks 188 | header_bytes: array[0..1] of Integer; // approximative number of bytes spent for header 189 | // and mode-partition #0 190 | residual_bytes: array[0..2, 0..3] of Integer; // approximative number of bytes spent for 191 | // DC/AC/uv coefficients for each (0..3) segments. 192 | segment_size: array[0..3] of Integer; // number of macroblocks in each segments 193 | segment_quant: array[0..3] of Integer; // quantizer values for each segments 194 | segment_level: array[0..3] of Integer; // filtering strength for each segments [0..63] 195 | end; 196 | 197 | // Signature for output function. Should return 1 if writing was successful. 198 | // data/data_size is the segment of data to write, and 'picture' is for 199 | // reference (and so one can make use of picture->custom_ptr). 200 | TWebPWriterFunction = function(const data: PByte; data_size: Cardinal; 201 | const picture: PWebPPicture): Integer; cdecl; 202 | 203 | TWebPPicture = record 204 | // input 205 | colorspace: Integer; // colorspace: should be 0 for now (=Y'CbCr). 206 | width, height: Integer; // dimensions. 207 | y, u, v: PByte; // pointers to luma/chroma planes. 208 | y_stride, uv_stride: Integer; // luma/chroma strides. 209 | a: PByte; // pointer to the alpha plane (unused for now). 210 | 211 | // output 212 | writer: TWebPWriterFunction ; // can be NULL 213 | custom_ptr: Pointer; // can be used by the writer. 214 | 215 | // map for extra information 216 | extra_info_type: Integer; // 1: intra type, 2: segment, 3: quant 217 | // 4: intra-16 prediction mode, 218 | // 5: chroma prediction mode, 219 | // 6: bit cost, 7: distortion 220 | extra_info: PByte; // if not NULL, points to an array of size 221 | // ((width + 15) / 16) * ((height + 15) / 16) that 222 | // will be filled with a macroblock map, depending 223 | // on extra_info_type. 224 | 225 | // where to store statistics, if not NULL: 226 | stats: PWebPAuxStats; 227 | end; 228 | 229 | // DLL 230 | function WebPDLLLoaded: boolean; 231 | 232 | (****************************************************************************** 233 | decode.h 234 | Main decoding functions for WEBP images. 235 | ******************************************************************************) 236 | 237 | procedure WebPFree(p : pointer); cdecl; external LIB_WEBP; 238 | 239 | // Return the decoder's version number, packed in hexadecimal using 8bits for 240 | // each of major/minor/revision. E.g: v2.5.7 is 0x020507. 241 | function WebPGetDecoderVersion: Integer; cdecl; external LIB_WEBP; 242 | 243 | // Retrieve basic header information: width, height. 244 | // This function will also validate the header and return 0 in 245 | // case of formatting error. 246 | // Pointers *width/*height can be passed NULL if deemed irrelevant. 247 | function WebPGetInfo(const data: PByte; data_size: Cardinal; 248 | width, height: PInteger): Integer; cdecl; external LIB_WEBP; 249 | 250 | // Decodes WEBP images pointed to by *data and returns RGB samples, along 251 | // with the dimensions in *width and *height. 252 | // The returned pointer should be deleted calling WebPFree(data). 253 | // Returns NULL in case of error. 254 | function WebPDecodeRGB(const data: PByte; data_size: Cardinal; 255 | width, height: PInteger): PByte; cdecl; external LIB_WEBP; 256 | 257 | // Same as WebPDecodeRGB, but returning RGBA data. 258 | function WebPDecodeRGBA(const data: PByte; data_size: Cardinal; 259 | width, height: PInteger): PByte; cdecl; external LIB_WEBP; 260 | 261 | // This variant decode to BGR instead of RGB. 262 | function WebPDecodeBGR(const data: PByte; data_size: Cardinal; 263 | width, height: PInteger): PByte; cdecl; external LIB_WEBP; 264 | // This variant decodes to BGRA instead of RGBA. 265 | function WebPDecodeBGRA(const data: PByte; data_size: Cardinal; 266 | width, height: PInteger): PByte; cdecl; external LIB_WEBP; 267 | 268 | function WebPDecodeARGB(const data: PByte; data_size: Cardinal; 269 | width, height: PInteger): PByte; cdecl; external LIB_WEBP; 270 | 271 | // Decode WEBP images stored in *data in Y'UV format(*). The pointer returned is 272 | // the Y samples buffer. Upon return, *u and *v will point to the U and V 273 | // chroma data. These U and V buffers need NOT be free()'d, unlike the returned 274 | // Y luma one. The dimension of the U and V planes are both (*width + 1) / 2 275 | // and (*height + 1)/ 2. 276 | // Upon return, the Y buffer has a stride returned as '*stride', while U and V 277 | // have a common stride returned as '*uv_stride'. 278 | // Return NULL in case of error. 279 | // (*) Also named Y'CbCr. See: http://en.wikipedia.org/wiki/YCbCr 280 | function WebPDecodeYUV(const data: PByte; data_size: Cardinal; width, height: PInteger; 281 | var u, v: PByte; stride, uv_stride: PInteger): PByte; cdecl; external LIB_WEBP; 282 | 283 | // These three functions are variants of the above ones, that decode the image 284 | // directly into a pre-allocated buffer 'output_buffer'. The maximum storage 285 | // available in this buffer is indicated by 'output_buffer_size'. If this 286 | // storage is not sufficient (or an error occurred), NULL is returned. 287 | // Otherwise, output_buffer is returned, for convenience. 288 | // The parameter 'output_stride' specifies the distance (in bytes) 289 | // between scanlines. Hence, output_buffer_size is expected to be at least 290 | // output_stride x picture-height. 291 | function WebPDecodeRGBInto(const data: PByte; data_size: Cardinal; 292 | output_buffer: PByte; output_buffer_size, output_stride: Integer): PByte; cdecl; external LIB_WEBP; 293 | 294 | function WebPDecodeRGBAInto(const data: PByte; data_size: Cardinal; 295 | output_buffer: PByte; output_buffer_size, output_stride: Integer): PByte; cdecl; external LIB_WEBP; 296 | 297 | // BGR variants 298 | function WebPDecodeBGRInto(const data: PByte; data_size: Cardinal; 299 | output_buffer: PByte; output_buffer_size, output_stride: Integer): PByte; cdecl; external LIB_WEBP; 300 | 301 | function WebPDecodeBGRAInto(const data: PByte; data_size: Cardinal; 302 | output_buffer: PByte; output_buffer_size, output_stride: Integer): PByte; cdecl; external LIB_WEBP; 303 | 304 | // WebPDecodeYUVInto() is a variant of WebPDecodeYUV() that operates directly 305 | // into pre-allocated luma/chroma plane buffers. This function requires the 306 | // strides to be passed: one for the luma plane and one for each of the 307 | // chroma ones. The size of each plane buffer is passed as 'luma_size', 308 | // 'u_size' and 'v_size' respectively. 309 | // Pointer to the luma plane ('*luma') is returned or NULL if an error occurred 310 | // during decoding (or because some buffers were found to be too small). 311 | function WebPDecodeYUVInto(const data: PByte; data_size: Cardinal; 312 | luma: PByte; luma_size, luma_stride: Integer; 313 | u: PByte; u_size, u_stride: Integer; 314 | v: PByte; v_size, v_stride: Integer): PByte; cdecl; external LIB_WEBP; 315 | 316 | //----------------------------------------------------------------------------- 317 | // Incremental decoding 318 | // 319 | // This API allows streamlined decoding of partial data. 320 | // Picture can be incrementally decoded as data become available thanks to the 321 | // WebPIDecoder object. This object can be left in a SUSPENDED state if the 322 | // picture is only partially decoded, pending additional input. 323 | // Code example: 324 | // 325 | // WebPIDecoder* const idec = WebPINew(mode); 326 | // while (has_more_data) { 327 | // // ... (get additional data) 328 | // status = WebPIAppend(idec, new_data, new_data_size); 329 | // if (status != VP8_STATUS_SUSPENDED || 330 | // break; 331 | // } 332 | // 333 | // // The above call decodes the current available buffer. 334 | // // Part of the image can now be refreshed by calling to 335 | // // WebPIDecGetRGB()/WebPIDecGetYUV() etc. 336 | // } 337 | // WebPIDelete(idec); 338 | 339 | // Creates a WebPIDecoder object. Returns NULL in case of failure. 340 | function WebPINew(mode: WEBP_CSP_MODE): PWebPIDecoder; cdecl; external LIB_WEBP; 341 | 342 | // This function allocates and initializes an incremental-decoder object, which 343 | // will output the r/g/b(/a) samples specified by 'mode' into a preallocated 344 | // buffer 'output_buffer'. The size of this buffer is at least 345 | // 'output_buffer_size' and the stride (distance in bytes between two scanlines) 346 | // is specified by 'output_stride'. Returns NULL if the allocation failed. 347 | function WebPINewRGB(mode: WEBP_CSP_MODE; output_buffer: PByte; 348 | output_buffer_size, output_stride: Integer): PWebPIDecoder; cdecl; external LIB_WEBP; 349 | 350 | // This function allocates and initializes an incremental-decoder object, which 351 | // will output the raw luma/chroma samples into a preallocated planes. The luma 352 | // plane is specified by its pointer 'luma', its size 'luma_size' and its stride 353 | // 'luma_stride'. Similarly, the chroma-u plane is specified by the 'u', 354 | // 'u_size' and 'u_stride' parameters, and the chroma-v plane by 'v', 'v_size' 355 | // and 'v_size'. 356 | // Returns NULL if the allocation failed. 357 | function WebPINewYUV(luma: PByte; luma_size, luma_stride: Integer; 358 | u: PByte; u_size, u_stride: Integer; 359 | v: PByte; v_size, v_stride: Integer): PWebPIDecoder; cdecl; external LIB_WEBP; 360 | 361 | // Deletes the WebpBuffer object and associated memory. Must always be called 362 | // if WebPINew, WebPINewRGB or WebPINewYUV succeeded. 363 | procedure WebPIDelete(const idec: PWebPIDecoder); cdecl; external LIB_WEBP; 364 | 365 | // Copies and decodes the next available data. Returns VP8_STATUS_OK when 366 | // the image is successfully decoded. Returns VP8_STATUS_SUSPENDED when more 367 | // data is expected. Returns error in other cases. 368 | function WebPIAppend(const idec: PWebPIDecoder; const data: PByte; 369 | data_size: Cardinal): TVP8StatusCode; cdecl; external LIB_WEBP; 370 | 371 | // A variant of the above function to be used when data buffer contains 372 | // partial data from the beginning. In this case data buffer is not copied 373 | // to the internal memory. 374 | // Note that the value of the 'data' pointer can change between calls to 375 | // WebPIUpdate, for instance when the data buffer is resized to fit larger data. 376 | function WebPIUpdate(const idec: PWebPIDecoder; const data: PByte; 377 | data_size: Cardinal): TVP8StatusCode; cdecl; external LIB_WEBP; 378 | 379 | // Returns the RGB image decoded so far. Returns NULL if output params are not 380 | // initialized yet. *last_y is the index of last decoded row in raster scan 381 | // order. Some pointers (*last_y, *width etc.) can be NULL if corresponding 382 | // information is not needed. 383 | function WebPIDecGetRGB(const idec: PWebPIDecoder; last_y, width, 384 | height, stride: PInteger): PByte; cdecl; external LIB_WEBP; 385 | 386 | // Same as above function to get YUV image. Returns pointer to the luma plane 387 | // or NULL in case of error. 388 | function WebPIDecGetYUV(const idec: PWebPIDecoder; last_y: PInteger; 389 | var u, v: PByte; width, height, stride, uv_stride: PInteger): PByte; cdecl; external LIB_WEBP; 390 | 391 | 392 | (******************************************************************************* 393 | decode_vp8.h 394 | Low-level API for VP8 decoder 395 | ******************************************************************************) 396 | 397 | //----------------------------------------------------------------------------- 398 | // Lower-level API 399 | // 400 | // Thes functions provide fine-grained control of the decoding process. 401 | // The call flow should resemble: 402 | // 403 | // VP8Io io; 404 | // VP8InitIo(&io); 405 | // io.data = data; 406 | // io.data_size = size; 407 | // /* customize io's functions (setup()/put()/teardown()) if needed. */ 408 | // 409 | // VP8Decoder* dec = VP8New(); 410 | // bool ok = VP8Decode(dec); 411 | // if (!ok) printf("Error: %s\n", VP8StatusMessage(dec)); 412 | // VP8Delete(dec); 413 | // return ok; 414 | 415 | 416 | // Create a new decoder object. 417 | function VP8New: PWebPIDecoder; cdecl; external LIB_WEBP; 418 | 419 | function WebPGetFeatures(const data: PByte; data_size: Cardinal; features: PWebPBitstreamFeatures): TVP8StatusCode; 420 | function WebPGetFeaturesInternal(const data: PByte; data_size: Cardinal; features: PWebPBitstreamFeatures; version: Integer): TVP8StatusCode; cdecl; external LIB_WEBP; 421 | 422 | // Must be called to make sure 'io' is initialized properly. 423 | // Returns false in case of version mismatch. Upon such failure, no other 424 | // decoding function should be called (VP8Decode, VP8GetHeaders, ...) 425 | function VP8InitIo(const io: PVP8Io): Integer; 426 | 427 | // Start decoding a new picture. Returns true if ok. 428 | function VP8GetHeaders(const dec: PVP8Decoder; const io: PVP8Io): Integer; cdecl; external LIB_WEBP; 429 | 430 | // Decode a picture. Will call VP8GetHeaders() if it wasn't done already. 431 | // Returns false in case of error. 432 | function VP8Decode(const dec: PVP8Decoder; const io: PVP8Io): Integer; cdecl; external LIB_WEBP; 433 | 434 | // Return current status of the decoder: 435 | function VP8Status(const dec: PVP8Decoder): TVP8StatusCode; cdecl; external LIB_WEBP; 436 | 437 | // return readable string corresponding to the last status. 438 | function VP8StatusMessage(const dec: PVP8Decoder): PAnsiChar; cdecl; external LIB_WEBP; 439 | 440 | // Resets the decoder in its initial state, reclaiming memory. 441 | // Not a mandatory call between calls to VP8Decode(). 442 | procedure VP8Clear(const dec: PVP8Decoder); cdecl; external LIB_WEBP; 443 | 444 | // Destroy the decoder object. 445 | procedure VP8Delete(const dec: PVP8Decoder); cdecl; external LIB_WEBP; 446 | 447 | (****************************************************************************** 448 | WebP encoder: main interface 449 | ******************************************************************************) 450 | 451 | // Return the encoder's version number, packed in hexadecimal using 8bits for 452 | // each of major/minor/revision. E.g: v2.5.7 is 0x020507. 453 | function WebPGetEncoderVersion: Integer; cdecl; external LIB_WEBP; 454 | 455 | //----------------------------------------------------------------------------- 456 | // One-stop-shop call! No questions asked: 457 | 458 | // Returns the size of the compressed data (pointed to by *output), or 0 if 459 | // an error occurred. The compressed data must be released by the caller 460 | // using the call 'WebPFree(output)'. 461 | // Currently, alpha values are discarded. 462 | function WebPEncodeRGB(const rgb: PByte; width, height, stride: Integer; 463 | quality_factor: single; var output: PByte): Cardinal; cdecl; external LIB_WEBP; 464 | 465 | function WebPEncodeBGR(const bgr: PByte; width, height, stride: Integer; 466 | quality_factor: Single; var output: PByte): Cardinal; cdecl; external LIB_WEBP; 467 | 468 | function WebPEncodeRGBA(const rgba: PByte; width, height, stride: Integer; 469 | quality_factor: Single; var output: PByte): Cardinal; cdecl; external LIB_WEBP; 470 | 471 | 472 | function WebPEncodeBGRA(const bgra: PByte; width, height, stride: Integer; 473 | quality_factor: Single; var output: PByte): Cardinal; cdecl; external LIB_WEBP; 474 | 475 | // Note these functions, like the lossy versions, use the library's default 476 | // settings. For lossless this means 'exact' is disabled. RGB values in 477 | // transparent areas will be modified to improve compression. 478 | function WebPEncodeLosslessRGB(const bgra: PByte; width, height, stride: Integer; 479 | var output: PByte): Cardinal; cdecl; external LIB_WEBP; 480 | 481 | function WebPEncodeLosslessBGR(const bgra: PByte; width, height, stride: Integer; 482 | var output: PByte): Cardinal; cdecl; external LIB_WEBP; 483 | 484 | function WebPEncodeLosslessRGBA(const bgra: PByte; width, height, stride: Integer; 485 | var output: PByte): Cardinal; cdecl; external LIB_WEBP; 486 | 487 | function WebPEncodeLosslessBGRA(const bgra: PByte; width, height, stride: Integer; 488 | var output: PByte): Cardinal; cdecl; external LIB_WEBP; 489 | 490 | // Should always be called, to initialize a fresh WebPConfig structure before 491 | // modification. Returns 0 in case of version mismatch. WebPConfigInit() must 492 | // have succeeded before using the 'config' object. 493 | function WebPConfigInit(const config: PWebPConfig): Integer; 494 | 495 | // This function will initialize the configuration according to a predefined 496 | // set of parameters (referred to by 'preset') and a given quality factor. 497 | // This function can be called as a replacement to WebPConfigInit(). Will 498 | // return 0 in case of error. 499 | function WebPConfigPreset(const config: PWebPConfig; preset: TWebPPreset; 500 | quality: Single): Integer; 501 | 502 | // Returns 1 if all parameters are in valid range and the configuration is OK. 503 | function WebPValidateConfig(const config: PWebPConfig): Integer; cdecl; external LIB_WEBP; 504 | 505 | // Should always be called, to initialize the structure. Returns 0 in case of 506 | // version mismatch. WebPPictureInit() must have succeeded before using the 507 | // 'picture' object. 508 | function WebPPictureInit(const picture: PWebPPicture): Integer; 509 | 510 | //----------------------------------------------------------------------------- 511 | // WebPPicture utils 512 | 513 | // Convenience allocation / deallocation based on picture->width/height: 514 | // Allocate y/u/v buffers as per width/height specification. 515 | // Note! This function will free the previous buffer if needed. 516 | // Returns 0 in case of memory error. 517 | function WebPPictureAlloc(const picture: PWebPPicture): Integer; cdecl; external LIB_WEBP; 518 | 519 | // Release memory allocated by WebPPictureAlloc() or WebPPictureImport*() 520 | // Note that this function does _not_ free the memory pointed to by 'picture'. 521 | procedure WebPPictureFree(const picture: PWebPPicture); cdecl; external LIB_WEBP; 522 | 523 | // Copy the pixels of *src into *dst, using WebPPictureAlloc. 524 | // Returns 0 in case of memory allocation error. 525 | function WebPPictureCopy(const src, dst: PWebPPicture): Integer; cdecl; external LIB_WEBP; 526 | 527 | // self-crops a picture to the rectangle defined by top/left/width/height. 528 | // Returns 0 in case of memory allocation error, or if the rectangle is 529 | // outside of the source picture. 530 | function WebPPictureCrop(const picture: PWebPPicture; 531 | left, top, width, height: Integer): Integer; cdecl; external LIB_WEBP; 532 | 533 | // Colorspace conversion function. Previous buffer will be free'd, if any. 534 | // *rgb buffer should have a size of at least height * rgb_stride. 535 | // Returns 0 in case of memory error. 536 | function WebPPictureImportRGB(const picture: PWebPPicture; 537 | const rgb: PByte; rgb_stride: Integer): Integer; cdecl; external LIB_WEBP; 538 | 539 | // Same, but for RGBA buffer. Alpha information is ignored. 540 | function WebPPictureImportRGBA(const picture: PWebPPicture; 541 | const rgba: PByte; rgba_stride: Integer): Integer; cdecl; external LIB_WEBP; 542 | 543 | // Variant of the above, but taking BGR input: 544 | function WebPPictureImportBGR(const picture: PWebPPicture; 545 | const bgr: PByte; bgr_stride: Integer): Integer; cdecl; external LIB_WEBP; 546 | 547 | function WebPPictureImportBGRA(const picture: PWebPPicture; 548 | const bgra: PByte; bgra_stride: Integer): Integer; cdecl; external LIB_WEBP; 549 | 550 | //----------------------------------------------------------------------------- 551 | // Main call 552 | 553 | // Main encoding call, after config and picture have been initialiazed. 554 | // 'picture' must be less than 16384x16384 in dimension, and the 'config' object 555 | // must be a valid one. 556 | // Returns false in case of error, true otherwise. 557 | function WebPEncode(const config: PWebPConfig; const picture: PWebPPicture): Integer; cdecl; external LIB_WEBP; 558 | 559 | 560 | implementation 561 | 562 | function WebPDLLLoaded: boolean; 563 | begin 564 | Result := true; 565 | end; 566 | 567 | // Internal, version-checked, entry point 568 | function VP8InitIoInternal(const io: PVP8Io; bersion: Integer): Integer; cdecl; external LIB_WEBP; 569 | 570 | const 571 | WEBP_DECODER_ABI_VERSION = $0001; 572 | 573 | function WebPGetFeatures(const data: PByte; data_size: Cardinal; features: PWebPBitstreamFeatures): TVP8StatusCode; 574 | begin 575 | Result := WebPGetFeaturesInternal(data, data_size, features, WEBP_DECODER_ABI_VERSION); 576 | end; 577 | 578 | function VP8InitIo(const io: PVP8Io): Integer; 579 | begin 580 | Result := VP8InitIoInternal(io, WEBP_DECODER_ABI_VERSION); 581 | end; 582 | 583 | // Internal, version-checked, entry point 584 | const 585 | WEBP_ENCODER_ABI_VERSION = $0001; 586 | 587 | function WebPConfigInitInternal(const conf: PWebPConfig; preset: TWebPPreset; 588 | quality: single; version: Integer): Integer; cdecl; external LIB_WEBP; 589 | 590 | function WebPConfigInit(const config: PWebPConfig): Integer; 591 | begin 592 | Result := WebPConfigInitInternal(config, WEBP_PRESET_DEFAULT, 75.0, WEBP_ENCODER_ABI_VERSION); 593 | end; 594 | 595 | function WebPConfigPreset(const config: PWebPConfig; preset: TWebPPreset; 596 | quality: Single): Integer; 597 | begin 598 | Result := WebPConfigInitInternal(config, preset, quality, WEBP_ENCODER_ABI_VERSION); 599 | end; 600 | 601 | // Internal, version-checked, entry point 602 | function WebPPictureInitInternal(const picture: PWebPPicture; version: Integer): Integer; cdecl; external LIB_WEBP; 603 | 604 | function WebPPictureInit(const picture: PWebPPicture): Integer; 605 | begin 606 | Result := WebPPictureInitInternal(picture, WEBP_ENCODER_ABI_VERSION); 607 | end; 608 | 609 | end. 610 | -------------------------------------------------------------------------------- /source/Cod.Imaging.Utils.pas: -------------------------------------------------------------------------------- 1 | {***********************************************************} 2 | { Codruts Imaging Global Utilities } 3 | { } 4 | { version 1.0 } 5 | { } 6 | { } 7 | { } 8 | { This library is licensed under a MIT license } 9 | { Copyright 2024 Codrut Software } 10 | { All rights reserved. } 11 | { } 12 | {***********************************************************} 13 | 14 | unit Cod.Imaging.Utils; 15 | 16 | interface 17 | uses 18 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Math, 19 | Types, UITypes, Vcl.Graphics; 20 | 21 | type 22 | TRGBAPixel = $00000000..$FFFFFFFF; 23 | 24 | // FXColor Helper 25 | TRGBAPixelHelper = record helper for TRGBAPixel 26 | class function Create(R, G, B: Byte; A: Byte = 255): TRGBAPixel; overload; static; 27 | class function Create(AColor: TColor; A: Byte = 255): TRGBAPixel; overload; static; 28 | class function Create(AString: string): TRGBAPixel; overload; static; 29 | 30 | public 31 | // Change value 32 | function GetAlpha: byte; 33 | function GetR: byte; 34 | function GetG: byte; 35 | function GetB: byte; 36 | 37 | procedure SetA(Value: byte); 38 | procedure SetR(Value: byte); 39 | procedure SetG(Value: byte); 40 | procedure SetB(Value: byte); 41 | 42 | // Convert 43 | function ToColor: TColor; 44 | function ToString: string; 45 | 46 | // Write utils 47 | procedure WriteTo(R, G, B, A: PByte); overload; 48 | procedure WriteTo(var R, G, B, A: Byte); overload; 49 | end; 50 | 51 | const 52 | DEFAULT_QUALITY = 85; 53 | 54 | implementation 55 | 56 | { TRGBAPixel } 57 | 58 | class function TRGBAPixelHelper.Create(R, G, B, A: Byte): TRGBAPixel; 59 | begin 60 | Result := (B or (G shl 8) or (R shl 16) or (A shl 24)); 61 | end; 62 | 63 | class function TRGBAPixelHelper.Create(AColor: TColor; A: Byte): TRGBAPixel; 64 | begin 65 | {$R-} 66 | Result := (GetBValue(AColor) or (GetGValue(AColor) shl 8) or (GetRValue(AColor) shl 16) or (A shl 24)); 67 | {$R+} 68 | end; 69 | 70 | class function TRGBAPixelHelper.Create(AString: string): TRGBAPixel; 71 | begin 72 | if AString[1] = '#' then 73 | Result := StrToInt('$' + Copy(AString, 2, 8)) 74 | else 75 | Exit( AString.ToInteger ); 76 | end; 77 | 78 | function TRGBAPixelHelper.GetAlpha: byte; 79 | begin 80 | Result := (Self and $FF000000) shr 24; 81 | end; 82 | 83 | function TRGBAPixelHelper.GetB: byte; 84 | begin 85 | Result := (Self and $000000FF); 86 | end; 87 | 88 | function TRGBAPixelHelper.GetG: byte; 89 | begin 90 | Result := (Self and $0000FF00) shr 8; 91 | end; 92 | 93 | function TRGBAPixelHelper.GetR: byte; 94 | begin 95 | Result := (Self and $00FF0000) shr 16; 96 | end; 97 | 98 | procedure TRGBAPixelHelper.SetA(Value: byte); 99 | begin 100 | Self := (Self and $00FFFFFF) or (TRGBAPixel(Value) shl 24); 101 | end; 102 | 103 | procedure TRGBAPixelHelper.SetB(Value: byte); 104 | begin 105 | Self := (Self and $FFFFFF00) or (Value); 106 | end; 107 | 108 | procedure TRGBAPixelHelper.SetG(Value: byte); 109 | begin 110 | Self := (Self and $FFFF00FF) or (TRGBAPixel(Value) shl 8); 111 | end; 112 | 113 | procedure TRGBAPixelHelper.SetR(Value: byte); 114 | begin 115 | Self := (Self and $FF00FFFF) or (TRGBAPixel(Value) shl 16); 116 | end; 117 | 118 | function TRGBAPixelHelper.ToColor: TColor; 119 | begin 120 | Result := RGB(GetR, GetG, GetB); 121 | end; 122 | 123 | function TRGBAPixelHelper.ToString: string; 124 | begin 125 | Result := '#' + IntToHex(Self, 8); 126 | end; 127 | 128 | procedure TRGBAPixelHelper.WriteTo(var R, G, B, A: Byte); 129 | begin 130 | WriteTo(@R, @G, @B, @A); 131 | end; 132 | 133 | procedure TRGBAPixelHelper.WriteTo(R, G, B, A: PByte); 134 | begin 135 | if R <> nil then 136 | R^ := GetR; 137 | if G <> nil then 138 | G^ := GetG; 139 | if B <> nil then 140 | B^ := GetB; 141 | end; 142 | 143 | end. -------------------------------------------------------------------------------- /source/Cod.Imaging.WebP.pas: -------------------------------------------------------------------------------- 1 | {***********************************************************} 2 | { Codruts Imaging WebP image } 3 | { } 4 | { version 1.0 } 5 | { } 6 | { } 7 | { } 8 | { This library is licensed under a MIT license } 9 | { Copyright 2024 Codrut Software } 10 | { All rights reserved. } 11 | { } 12 | {***********************************************************} 13 | 14 | {$DEFINE UseDelphi} //Disable fat vcl units(perfect for small apps) 15 | {$DEFINE RegisterGraphic} //Registers TPNGObject to use with TPicture 16 | 17 | unit Cod.Imaging.WebP; 18 | 19 | interface 20 | uses 21 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Math, 22 | Types, UITypes, Vcl.Graphics, Vcl.Imaging.pngimage, 23 | Cod.Imaging.Utils, 24 | Cod.Imaging.Internal.libwebp, 25 | Cod.Imaging.Internal.WebPHelpers; 26 | 27 | type 28 | TWebPImage = class(TGraphic) 29 | private 30 | FData: PByte; 31 | FWidth, 32 | FHeight: integer; 33 | FQuality: single; // the save quality 34 | FColorSpace: WEBP_CSP_MODE; 35 | FPixelByteSize: integer; 36 | FLibMem: boolean; 37 | FLossless: boolean; 38 | 39 | {Free mem} 40 | procedure FreeData; 41 | procedure FreeByteMemory(Data: PByte; LibraryMemory: boolean); 42 | 43 | {Utils} 44 | function GetPixelStart(X, Y: Integer): cardinal; 45 | function ScanCreateBitmap: TBitMap; 46 | function ScanCreatePNG: TPNGImage; 47 | function ArraySize: cardinal; 48 | // Alloce application memory, return new size 49 | function ReallocateMemory: cardinal; // this does NOT free previous existing memory 50 | 51 | {Properties} 52 | procedure SetQuality(const Value: single); 53 | function GetPixels(const X, Y: Integer): TColor; 54 | procedure SetPixels(const X, Y: Integer; const Value: TColor); 55 | function GetWebPPixel(const X, Y: Integer): TRGBAPixel; 56 | procedure SetWebPPixel(const X, Y: Integer; const Value: TRGBAPixel); 57 | function GetScanline(const Index: Integer): Pointer; 58 | 59 | protected 60 | {Empty} 61 | function GetEmpty: Boolean; override; 62 | 63 | {Internal assign} 64 | procedure AssignWebp(Source: TWebPImage); 65 | 66 | {Draw to canvas} 67 | procedure Draw(ACanvas: TCanvas; const Rect: TRect); override; 68 | 69 | {Sizing} 70 | function GetWidth: Integer; override; 71 | function GetHeight: Integer; override; 72 | procedure SetHeight(Value: Integer); override; 73 | procedure SetWidth(Value: Integer); override; 74 | 75 | public 76 | {Returns a scanline from png} 77 | property Scanline[const Index: Integer]: Pointer read GetScanline; 78 | 79 | {Assigns from another object} 80 | procedure Assign(Source: TPersistent); override; 81 | {Assigns to another object} 82 | procedure AssignTo(Dest: TPersistent); override; 83 | 84 | {Save / Load} 85 | procedure LoadFromStream(Stream: TStream); override; 86 | procedure SaveToStream(Stream: TStream); override; 87 | 88 | {Clipboard} 89 | procedure LoadFromClipboardFormat(AFormat: Word; AData: THandle; 90 | APalette: HPALETTE); override; 91 | procedure SaveToClipboardFormat(var AFormat: Word; var AData: THandle; 92 | var APalette: HPALETTE); override; 93 | 94 | {Save quality level} 95 | property Quality: single read FQuality write SetQuality; 96 | 97 | {Access to the png pixels} 98 | property Pixels[const X, Y: Integer]: TColor read GetPixels write SetPixels; 99 | property WebPPixels[const X, Y: Integer]: TRGBAPixel read GetWebPPixel write SetWebPPixel; 100 | property ColorSpace: WEBP_CSP_MODE read FColorSpace write FColorSpace; 101 | property Lossless: boolean read FLossless write FLossless; 102 | 103 | constructor Create; override; 104 | constructor CreateBlank(Width, Height: integer); 105 | destructor Destroy; override; 106 | end; 107 | 108 | function GetLibraryVersion: string; 109 | 110 | implementation 111 | 112 | const 113 | E_UNSUPORTED_COLORSPACE = 'Unsupported colorspace.'; 114 | 115 | function GetLibraryVersion: string; 116 | begin 117 | Result := GetWebpVersionString(WebPGetEncoderVersion); 118 | end; 119 | 120 | { TWebPImage } 121 | 122 | function TWebPImage.ArraySize: cardinal; 123 | begin 124 | Result := FWidth * FHeight * FPixelByteSize; 125 | end; 126 | 127 | procedure TWebPImage.Assign(Source: TPersistent); 128 | var 129 | Y: integer; 130 | SrcPtr: PByte; 131 | DestPtr: PByte; 132 | BytesPerScanLine: Integer; 133 | begin 134 | // Load 135 | if Source is TWebPImage then 136 | AssignWebp(Source as TWebPImage) 137 | else begin 138 | var Bit: TBitMap; Bit := TBitMap.Create; 139 | try 140 | // Create 141 | Bit.Assign(Source); 142 | 143 | // Pixel format 144 | case Bit.PixelFormat of 145 | pf24bit: begin 146 | FColorSpace := MODE_BGR; 147 | FPixelByteSize := 3; 148 | end; 149 | pf32bit: begin 150 | FColorSpace := MODE_BGRA; 151 | FPixelByteSize := 4; 152 | 153 | Bit.Transparent := true; 154 | Bit.TransparentMode := tmAuto; 155 | end; 156 | 157 | else raise Exception.Create('Pixel format not supported.'); 158 | end; 159 | 160 | // Allocate 161 | FreeData; 162 | FWidth := Bit.Width; 163 | FHeight := Bit.Height; 164 | ReallocateMemory; 165 | 166 | // Read 167 | DestPtr := FData; 168 | 169 | BytesPerScanLine := Bit.Width * FPixelByteSize; 170 | 171 | // Copy picture lines 172 | for Y := 0 to Bit.Height - 1 do begin 173 | SrcPtr := Bit.ScanLine[Y]; 174 | 175 | Move(SrcPtr^, DestPtr^, BytesPerScanLine); // Copy the entire scanline 176 | Inc(DestPtr, BytesPerScanLine); // Move to the next scanline in the source data 177 | end; 178 | finally 179 | Bit.Free; 180 | end; 181 | end; 182 | end; 183 | 184 | procedure TWebPImage.AssignTo(Dest: TPersistent); 185 | begin 186 | if Dest is TWebPImage then 187 | (Dest as TWebPImage).AssignWebp( Self ) 188 | else 189 | if Dest is TPngImage then 190 | begin 191 | const PNG = ScanCreatePNG; 192 | Dest.Assign( PNG ); 193 | end 194 | else 195 | begin 196 | const Bit = ScanCreateBitmap; 197 | try 198 | Dest.Assign( Bit ); 199 | finally 200 | Bit.Free; 201 | end; 202 | end; 203 | end; 204 | 205 | procedure TWebPImage.AssignWebp(Source: TWebPImage); 206 | var 207 | MemSize: integer; 208 | begin 209 | // Free memory 210 | FreeData; 211 | 212 | if not Source.Empty then begin 213 | // Read settings 214 | FWidth := Source.FWidth; 215 | FHeight := Source.FHeight; 216 | FPixelByteSize := Source.FPixelByteSize; 217 | FColorSpace := Source.ColorSpace; 218 | FQuality := Source.FQuality; 219 | 220 | // Clone memory 221 | MemSize := Source.ArraySize; 222 | FData := AllocMem( MemSize ); 223 | Move(Source.FData^, FData^, MemSize); 224 | FLibMem := false; 225 | end; 226 | end; 227 | 228 | constructor TWebPImage.Create; 229 | begin 230 | inherited; 231 | FData := nil; 232 | FQuality := DEFAULT_QUALITY; 233 | Lossless := false; 234 | 235 | FColorSpace := WEBP_CSP_MODE.MODE_BGRA; 236 | FPixelByteSize := 4; {B G R A} 237 | end; 238 | 239 | constructor TWebPImage.CreateBlank(Width, Height: integer); 240 | begin 241 | // Free 242 | FreeData; 243 | 244 | // Size 245 | FWidth := Width; 246 | FHeight := Height; 247 | 248 | // Allocate 249 | ReallocateMemory; 250 | end; 251 | 252 | destructor TWebPImage.Destroy; 253 | begin 254 | FreeData; 255 | 256 | inherited; 257 | end; 258 | 259 | procedure TWebPImage.Draw(ACanvas: TCanvas; const Rect: TRect); 260 | var 261 | Cache: TPNGImage; 262 | begin 263 | if Empty then 264 | Exit; 265 | Cache := ScanCreatePNG; 266 | try 267 | // Draw buffer 268 | ACanvas.StretchDraw(Rect, Cache); 269 | finally 270 | Cache.Free; 271 | end; 272 | end; 273 | 274 | procedure TWebPImage.FreeByteMemory(Data: PByte; LibraryMemory: boolean); 275 | begin 276 | if LibraryMemory then 277 | // Library allocated memory pool, free via calls 278 | WebPFree(Data) 279 | else 280 | // Application memory, free via FreeMem 281 | FreeMem(Data); 282 | end; 283 | 284 | procedure TWebPImage.FreeData; 285 | begin 286 | if not GetEmpty then 287 | FreeByteMemory(FData, FLibMem); 288 | FData := nil; 289 | FWidth := 0; 290 | FHeight := 0; 291 | FLibMem := false; 292 | end; 293 | 294 | function TWebPImage.GetEmpty: Boolean; 295 | begin 296 | Result := FData = nil; 297 | end; 298 | 299 | function TWebPImage.GetHeight: Integer; 300 | begin 301 | Result := FHeight; 302 | end; 303 | 304 | function TWebPImage.GetPixels(const X, Y: Integer): TColor; 305 | begin 306 | Result := GetWebPPixel(X, Y).ToColor; 307 | end; 308 | 309 | function TWebPImage.GetPixelStart(X, Y: Integer): cardinal; 310 | begin 311 | Result := (X+FWidth*Y)*FPixelByteSize; 312 | end; 313 | 314 | function TWebPImage.GetScanline(const Index: Integer): Pointer; 315 | begin 316 | Result := @FData[FWidth*Index*FPixelByteSize]; 317 | end; 318 | 319 | function TWebPImage.GetWebPPixel(const X, Y: Integer): TRGBAPixel; 320 | var 321 | Start: integer; 322 | begin 323 | Start := GetPixelStart(X, Y); 324 | case FColorSpace of 325 | MODE_RGB: Result := TRGBAPixel.Create(FData[Start], FData[Start+1], FData[Start+2], 255); 326 | MODE_RGBA: Result := TRGBAPixel.Create(FData[Start], FData[Start+1], FData[Start+2], FData[Start+3]); 327 | MODE_BGR: Result := TRGBAPixel.Create(FData[Start+2], FData[Start+1], FData[Start], 255); 328 | MODE_BGRA: Result := TRGBAPixel.Create(FData[Start+2], FData[Start+1], FData[Start], FData[Start+3]); 329 | //MODE_YUV: ; 330 | 331 | else raise Exception.Create(E_UNSUPORTED_COLORSPACE); 332 | end; 333 | end; 334 | 335 | function TWebPImage.GetWidth: Integer; 336 | begin 337 | Result := FWidth; 338 | end; 339 | 340 | procedure TWebPImage.LoadFromClipboardFormat(AFormat: Word; AData: THandle; 341 | APalette: HPALETTE); 342 | begin 343 | inherited; 344 | raise Exception.Create('Not supported.'); 345 | end; 346 | 347 | procedure TWebPImage.LoadFromStream(Stream: TStream); 348 | var 349 | Buffer: TBytes; 350 | begin 351 | // Get bytes 352 | Stream.Position := 0; 353 | SetLength(Buffer, Stream.Size); 354 | Stream.ReadBuffer(Buffer, Stream.size); 355 | 356 | try 357 | // Decode 358 | case FColorSpace of 359 | MODE_RGB: begin 360 | FPixelByteSize := 3; 361 | FData := WebPDecodeRGB(@Buffer[0], Stream.Size, @FWidth, @FHeight); 362 | end; 363 | MODE_RGBA: begin 364 | FPixelByteSize := 4; 365 | FData := WebPDecodeRGBA(@Buffer[0], Stream.Size, @FWidth, @FHeight); 366 | end; 367 | MODE_BGR: begin 368 | FPixelByteSize := 3; 369 | FData := WebPDecodeBGRA(@Buffer[0], Stream.Size, @FWidth, @FHeight); 370 | end; 371 | MODE_BGRA: begin 372 | FPixelByteSize := 4; 373 | FData := WebPDecodeBGRA(@Buffer[0], Stream.Size, @FWidth, @FHeight); 374 | end; 375 | //MODE_YUV: ; 376 | 377 | else raise Exception.Create(E_UNSUPORTED_COLORSPACE); 378 | end; 379 | FLibMem := true; 380 | finally 381 | SetLength(Buffer, 0); 382 | end; 383 | end; 384 | 385 | function TWebPImage.ReallocateMemory: cardinal; 386 | begin 387 | Result := ArraySize; 388 | FData := AllocMem(Result); 389 | FLibMem := false; 390 | end; 391 | 392 | procedure TWebPImage.SaveToClipboardFormat(var AFormat: Word; 393 | var AData: THandle; var APalette: HPALETTE); 394 | begin 395 | inherited; 396 | raise Exception.Create('Not supported.'); 397 | end; 398 | 399 | procedure TWebPImage.SaveToStream(Stream: TStream); 400 | var 401 | Output: PByte; 402 | Size: cardinal; 403 | begin 404 | case FColorSpace of 405 | MODE_RGB: if Lossless then 406 | Size := WebPEncodeLosslessRGB(FData, FWidth, FHeight, FWidth*FPixelByteSize, Output) 407 | else 408 | Size := WebPEncodeRGB(FData, FWidth, FHeight, FWidth*FPixelByteSize, Quality, Output); 409 | MODE_RGBA: if Lossless then 410 | Size := WebPEncodeLosslessRGBA(FData, FWidth, FHeight, FWidth*FPixelByteSize, Output) 411 | else 412 | Size := WebPEncodeRGBA(FData, FWidth, FHeight, FWidth*FPixelByteSize, Quality, Output); 413 | MODE_BGR: if Lossless then 414 | Size := WebPEncodeLosslessBGR(FData, FWidth, FHeight, FWidth*FPixelByteSize, Output) 415 | else 416 | Size := WebPEncodeBGR(FData, FWidth, FHeight, FWidth*FPixelByteSize, Quality, Output); 417 | MODE_BGRA: if Lossless then 418 | Size := WebPEncodeLosslessBGRA(FData, FWidth, FHeight, FWidth*FPixelByteSize, Output) 419 | else 420 | Size := WebPEncodeBGRA(FData, FWidth, FHeight, FWidth*FPixelByteSize, Quality, Output); 421 | //MODE_YUV: 422 | 423 | else raise Exception.Create(E_UNSUPORTED_COLORSPACE); 424 | end; 425 | 426 | Stream.Write( Output^, Size ); 427 | end; 428 | 429 | function TWebPImage.ScanCreateBitmap: TBitMap; 430 | var 431 | Y: Integer; 432 | SrcPtr: PByte; 433 | DestPtr: PByte; 434 | BytesPerScanLine: Integer; 435 | begin 436 | Result := TBitmap.Create; 437 | 438 | case FColorSpace of 439 | //MODE_RGB: ; 440 | //MODE_RGBA: ; 441 | MODE_BGR: begin 442 | Result.PixelFormat := pf24bit; 443 | end; 444 | MODE_BGRA: begin 445 | Result.PixelFormat := pf32bit; 446 | Result.Transparent := true; 447 | Result.TransparentMode := tmAuto; 448 | end; 449 | //MODE_YUV: ; 450 | 451 | else raise Exception.Create(E_UNSUPORTED_COLORSPACE); 452 | end; 453 | 454 | Result.Width := FWidth; 455 | Result.Height := FHeight; 456 | 457 | SrcPtr := FData; 458 | BytesPerScanLine := FWidth * FPixelByteSize; 459 | 460 | for Y := 0 to FHeight - 1 do 461 | begin 462 | DestPtr := Result.ScanLine[Y]; // Get the pointer to the start of the scanline 463 | Move(SrcPtr^, DestPtr^, BytesPerScanLine); // Copy the entire scanline 464 | Inc(SrcPtr, BytesPerScanLine); // Move to the next scanline in the source data 465 | end; 466 | end; 467 | 468 | function TWebPImage.ScanCreatePNG: TPNGImage; 469 | const 470 | RGB_SIZE = 3; 471 | RGBA_SIZE = 4; 472 | var 473 | PixelMemSize: integer; 474 | X, Y: Integer; 475 | AlphPtr: PByteArray; 476 | SrcPtr, 477 | DestPtr, 478 | Cursor: PByte; 479 | BytesPerSourceLine: integer; 480 | CopyStandedAlpha: boolean; 481 | begin 482 | if (Width = 0) or (Height = 0) then 483 | Exit( TPNGImage.Create ); 484 | 485 | // Create 486 | case FColorSpace of 487 | //MODE_RGB: ; 488 | //MODE_RGBA: ; 489 | MODE_BGR: begin 490 | PixelMemSize := 3; 491 | Result := TPNGImage.CreateBlank(COLOR_RGB, RGBA_SIZE * 2, FWidth, FHeight); 492 | CopyStandedAlpha := false; 493 | end; 494 | MODE_BGRA: begin 495 | PixelMemSize := 4; 496 | Result := TPNGImage.CreateBlank(COLOR_RGBALPHA, RGBA_SIZE * 2, FWidth, FHeight); 497 | CopyStandedAlpha := true; 498 | end; 499 | //MODE_YUV: ; 500 | 501 | else raise Exception.Create(E_UNSUPORTED_COLORSPACE); 502 | end; 503 | 504 | // Calcualte byte size 505 | SrcPtr := FData; 506 | BytesPerSourceLine := FWidth * PixelMemSize; 507 | 508 | for Y := 0 to FHeight - 1 do 509 | begin 510 | DestPtr := Result.ScanLine[Y]; 511 | AlphPtr := Result.AlphaScanline[Y]; 512 | 513 | // Read 514 | Cursor := SrcPtr; 515 | for X := 0 to FWidth-1 do begin 516 | // Read alpha 517 | Move(Cursor^, DestPtr^, RGB_SIZE); 518 | 519 | if CopyStandedAlpha then 520 | AlphPtr[X] := Cursor[3]; 521 | 522 | // Move 523 | Inc(Cursor, PixelMemSize); 524 | Inc(DestPtr, RGB_SIZE); // this is always 3!! The Alpha Channel is separate 525 | end; 526 | 527 | // Move 528 | Inc(SrcPtr, BytesPerSourceLine); 529 | end; 530 | end; 531 | 532 | procedure TWebPImage.SetHeight(Value: Integer); 533 | var 534 | Previous: PByte; 535 | PreviousSize, 536 | NewSize: cardinal; 537 | PreviousLibMem: boolean; 538 | begin 539 | // Prev 540 | Previous := FData; 541 | PreviousSize := ArraySize; 542 | PreviousLibMem := FLibMem; 543 | 544 | // Set height 545 | FHeight := Value; 546 | 547 | // Allocate memory 548 | NewSize := ReallocateMemory; 549 | 550 | // Transfer bytes 551 | Move(Previous^, FData^, Min(PreviousSize, NewSize)); 552 | 553 | // Free previous 554 | FreeByteMemory(Previous, PreviousLibMem); 555 | end; 556 | 557 | procedure TWebPImage.SetPixels(const X, Y: Integer; const Value: TColor); 558 | begin 559 | SetWebPPixel(X, Y, TRGBAPixel.Create(Value)); 560 | end; 561 | 562 | procedure TWebPImage.SetQuality(const Value: single); 563 | begin 564 | FQuality := EnsureRange(Value, 0, 100); 565 | end; 566 | 567 | procedure TWebPImage.SetWebPPixel(const X, Y: Integer; const Value: TRGBAPixel); 568 | var 569 | Start: integer; 570 | begin 571 | Start := GetPixelStart(X, Y); 572 | 573 | case FColorSpace of 574 | MODE_RGB: Value.WriteTo(@FData[Start], @FData[Start+1], @FData[Start+2], nil); 575 | MODE_RGBA: Value.WriteTo(FData[Start], FData[Start+1], FData[Start+2], FData[Start+3]); 576 | MODE_BGR: Value.WriteTo(@FData[Start+2], @FData[Start+1], @FData[Start], nil); 577 | MODE_BGRA: Value.WriteTo(FData[Start+2], FData[Start+1], FData[Start], FData[Start+3]); 578 | //MODE_YUV: ; 579 | 580 | else raise Exception.Create(E_UNSUPORTED_COLORSPACE); 581 | end; 582 | end; 583 | 584 | procedure TWebPImage.SetWidth(Value: Integer); 585 | var 586 | Previous: PByte; 587 | PreviousLibMem: boolean; 588 | 589 | PreviousWidth: integer; 590 | begin 591 | // Prev 592 | Previous := FData; 593 | PreviousLibMem := FLibMem; 594 | 595 | PreviousWidth := FWidth; 596 | 597 | // Set height 598 | FWidth := Value; 599 | 600 | // Allocate memory 601 | ReallocateMemory; 602 | 603 | // Transfer bytes 604 | const MemoryRead = Min(PreviousWidth, FWidth) * FPixelByteSize; 605 | for var I := 0 to FHeight-1 do begin 606 | Move(Previous[I * PreviousWidth * FPixelByteSize], 607 | FData[I * FWidth * FPixelByteSize], 608 | MemoryRead); 609 | end; 610 | 611 | // Free previous 612 | FreeByteMemory(Previous, PreviousLibMem); 613 | end; 614 | 615 | initialization 616 | // Don't register DLL 617 | if not WebPDLLLoaded then 618 | Exit; 619 | 620 | {Registers THeifImage to use with TPicture} 621 | {$IFDEF UseDelphi}{$IFDEF RegisterGraphic} 622 | TPicture.RegisterFileFormat('webp', 'Web Picture', TWebPImage); 623 | {$ENDIF}{$ENDIF} 624 | finalization 625 | // Don't unregister DLL 626 | if not WebPDLLLoaded then 627 | Exit; 628 | 629 | {$IFDEF UseDelphi}{$IFDEF RegisterGraphic} 630 | TPicture.UnregisterGraphicClass(TWebPImage); 631 | {$ENDIF}{$ENDIF} 632 | end. --------------------------------------------------------------------------------