├── examples ├── example1.png ├── example2.png ├── example3.png └── example4.png ├── LICENSE ├── .gitignore ├── README.md └── BitmapPixels.pas /examples/example1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/turborium/BitmapPixels/HEAD/examples/example1.png -------------------------------------------------------------------------------- /examples/example2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/turborium/BitmapPixels/HEAD/examples/example2.png -------------------------------------------------------------------------------- /examples/example3.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/turborium/BitmapPixels/HEAD/examples/example3.png -------------------------------------------------------------------------------- /examples/example4.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/turborium/BitmapPixels/HEAD/examples/example4.png -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2021 CrazzzyPeter 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 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # Uncomment these types if you want even more clean repository. But be careful. 2 | # It can make harm to an existing project source. Read explanations below. 3 | # 4 | # Resource files are binaries containing manifest, project icon and version info. 5 | # They can not be viewed as text or compared by diff-tools. Consider replacing them with .rc files. 6 | #*.res 7 | # 8 | # Type library file (binary). In old Delphi versions it should be stored. 9 | # Since Delphi 2009 it is produced from .ridl file and can safely be ignored. 10 | #*.tlb 11 | # 12 | # Diagram Portfolio file. Used by the diagram editor up to Delphi 7. 13 | # Uncomment this if you are not using diagrams or use newer Delphi version. 14 | #*.ddp 15 | # 16 | # Visual LiveBindings file. Added in Delphi XE2. 17 | # Uncomment this if you are not using LiveBindings Designer. 18 | #*.vlb 19 | # 20 | # Deployment Manager configuration file for your project. Added in Delphi XE2. 21 | # Uncomment this if it is not mobile development and you do not use remote debug feature. 22 | #*.deployproj 23 | # 24 | # C++ object files produced when C/C++ Output file generation is configured. 25 | # Uncomment this if you are not using external objects (zlib library for example). 26 | #*.obj 27 | # 28 | 29 | # Delphi compiler-generated binaries (safe to delete) 30 | *.exe 31 | *.dll 32 | *.bpl 33 | *.bpi 34 | *.dcp 35 | *.so 36 | *.apk 37 | *.drc 38 | *.map 39 | *.dres 40 | *.rsm 41 | *.tds 42 | *.dcu 43 | *.lib 44 | *.a 45 | *.o 46 | *.ocx 47 | 48 | # Delphi autogenerated files (duplicated info) 49 | *.cfg 50 | *.hpp 51 | *Resource.rc 52 | 53 | # Delphi local files (user-specific info) 54 | *.local 55 | *.identcache 56 | *.projdata 57 | *.tvsconfig 58 | *.dsk 59 | 60 | # Delphi history and backups 61 | __history/ 62 | __recovery/ 63 | *.~* 64 | 65 | # Castalia statistics file (since XE7 Castalia is distributed with Delphi) 66 | *.stat 67 | 68 | # Boss dependency manager vendor folder https://github.com/HashLoad/boss 69 | modules/ 70 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # BitmapPixels 2 | ## [ENG] 3 | ### BitmapPixels.pas - Lazarus and Delphi module for direct access to pixels at TBitmap 4 | #### Worked on Windows(WinApi), Linux(GTK2, Qt5), OSX(Cocoa) 5 | 6 | Quite a popular question is how to get quick access to **TBitmap** pixels? 7 | It is easy to do in **Delphi**, with **Scanline[]** property, due to the limited number of pixel formats, but rather difficult in **Lazarus**. 8 | For example: https://wiki.freepascal.org/Fast_direct_pixel_access 9 | 10 | I propose a small, single file, module **"BitmapPixels.pas"** that simplify work to just calling **TBitmapData.Map()** and **TBitmapData.Unmap()**. 11 | You get an array of **$AARRGGBB** pixels in the **Data** property, and abilty set and get color of pixels using **SetPixel()/GetPixel()**. 12 | 13 | ```delphi 14 | var 15 | Data: TBitmapData; 16 | X, Y: Integer; 17 | Pixel: TPixelRec;// for easy access to the channels 18 | begin 19 | // Reading the colors of the image into map "Data", width mode "ReadWrite", in the "False" alpha channel mode. 20 | // The alpha channel will be set to 0 on every element of the array. ($00RRGGBB, $00RRGGBB, ...) 21 | Data.Map(Bitmap, TAccessMode.ReadWrite, False); 22 | try 23 | for Y := 0 to Data.Height - 1 do 24 | begin 25 | for X := 0 to Data.Width - 1 do 26 | begin 27 | // Read color at (X, Y) to Pixel record 28 | Pixel := Data.GetPixel(X, Y); 29 | // some changes of Pixel 30 | Pixel.R := (Pixel.R + Pixel.G + Pixel.B) div 3; 31 | Pixel.G := Pixel.R; 32 | Pixel.B := Pixel.R; 33 | // ... 34 | // Write Pixel record to (X, Y) in map 35 | Data.SetPixel(X, Y, Pixel); 36 | end; 37 | end; 38 | finally 39 | // Writing the map to the image. 40 | // Since we have abandoned Alpha, the pixel format will be set to pf24bit. 41 | Data.Unmap(); 42 | end; 43 | end; 44 | ``` 45 | 46 | **Key Features:** 47 | - cross-platform 48 | - supports all TBitmap pixel formats for reading 49 | - fast processing of popular formats in Windows/GTK/Qt/OSX 50 | - can map any image as having an alpha channel or not (24bit/32bit) 51 | 52 | 53 | #### Example 1 - Invert colors (read and write) 54 | ![example1.png](examples/example1.png) 55 | ```delphi 56 | procedure InvertColors(const Bitmap: TBitmap); 57 | var 58 | Data: TBitmapData; 59 | X, Y: Integer; 60 | Pixel: TPixelRec; 61 | begin 62 | Data.Map(Bitmap, TAccessMode.ReadWrite, False);// RGB access 63 | try 64 | for Y := 0 to Data.Height - 1 do 65 | begin 66 | for X := 0 to Data.Width - 1 do 67 | begin 68 | Pixel := Data.GetPixel(X, Y); 69 | Pixel.R := 255 - Pixel.R; 70 | Pixel.G := 255 - Pixel.G; 71 | Pixel.B := 255 - Pixel.B; 72 | Data.SetPixel(X, Y, Pixel); 73 | end; 74 | end; 75 | finally 76 | Data.Unmap(); 77 | end; 78 | end; 79 | ``` 80 | #### Example 2 - Half bitmap transparency (read and write, alpha) 81 | ![example2.png](examples/example2.png) 82 | ```delphi 83 | procedure HalfAlpha(const Bitmap: TBitmap); 84 | var 85 | Data: TBitmapData; 86 | X, Y: Integer; 87 | Pixel: TPixelRec; 88 | begin 89 | Data.Map(Bitmap, TAccessMode.ReadWrite, True);// ARGB access 90 | try 91 | for Y := 0 to Data.Height - 1 do 92 | begin 93 | for X := 0 to Data.Width - 1 do 94 | begin 95 | Pixel := Data.GetPixel(X, Y); 96 | Pixel.A := Pixel.A div 2; 97 | Data.SetPixel(X, Y, Pixel); 98 | end; 99 | end; 100 | finally 101 | Data.Unmap(); 102 | end; 103 | end; 104 | ``` 105 | #### Example 3 - Make a plasm effect on bitmap (write only) 106 | ![example3.png](examples/example3.png) 107 | ```delphi 108 | function MakePlasm(): TBitmap; 109 | var 110 | Data: TBitmapData; 111 | X, Y: Integer; 112 | Pixel: TPixelRec; 113 | begin 114 | Result := TBitmap.Create(); 115 | Result.SetSize(300, 300); 116 | 117 | Data.Map(Result, TAccessMode.Write, False); 118 | try 119 | for Y := 0 to Data.Height - 1 do 120 | begin 121 | for X := 0 to Data.Width - 1 do 122 | begin 123 | Pixel.R := Byte(Trunc( 124 | 100 + 100 * (Sin(X * Cos(Y * 0.049) * 0.01) + Cos(X * 0.0123 - Y * 0.09)))); 125 | Pixel.G := 0; 126 | Pixel.B := Byte(Trunc( 127 | Pixel.R + 100 * (Sin(X * Cos(X * 0.039) * 0.022) + Sin(X * 0.01 - Y * 0.029)))); 128 | Data.SetPixel(X, Y, Pixel); 129 | end; 130 | end; 131 | finally 132 | Data.Unmap(); 133 | end; 134 | end; 135 | ``` 136 | #### Example 4 - Mix two bitmaps to one bitmap (read only, write only) 137 | ![example4.png](examples/example4.png) 138 | ```delphi 139 | function Mix(const A, B: TBitmap): TBitmap; 140 | function Min(A, B: Integer): Integer; 141 | begin 142 | if A < B then Exit(A) else Exit(B); 143 | end; 144 | var 145 | DataA, DataB, DataResult: TBitmapData; 146 | X, Y: Integer; 147 | PixelA, PixelB, PixelResult: TPixelRec; 148 | begin 149 | Result := TBitmap.Create(); 150 | Result.SetSize(Min(A.Width, B.Width), Min(A.Height, B.Height)); 151 | // this needed for correct Unmap() on exception 152 | DataA.Init(); 153 | DataB.Init(); 154 | DataResult.Init(); 155 | try 156 | DataA.Map(A, TAccessMode.Read, False); 157 | DataB.Map(B, TAccessMode.Read, False); 158 | DataResult.Map(Result, TAccessMode.Write, False); 159 | for Y := 0 to DataResult.Height - 1 do 160 | begin 161 | for X := 0 to DataResult.Width - 1 do 162 | begin 163 | PixelA := DataA.Pixels[X, Y]; 164 | PixelB := DataB.Pixels[X, Y]; 165 | PixelResult.R := (PixelA.R + PixelB.R) div 2; 166 | PixelResult.G := (PixelA.G + PixelB.G) div 2; 167 | PixelResult.B := (PixelA.B + PixelB.B) div 2; 168 | DataResult[X, Y] := PixelResult; 169 | end; 170 | end; 171 | finally 172 | DataA.Unmap(); 173 | DataB.Unmap(); 174 | DataResult.Unmap(); 175 | end; 176 | end; 177 | ``` 178 | 179 | --- 180 | ## [RUS] 181 | ### BitmapPixels.pas - Модуль для Lazarus и Delphi дающий прямой доступ к пикселам TBitmap. 182 | #### Работает на Windows(WinApi), Linux(GTK2, Qt5), OSX(Cocoa) 183 | 184 | Есть довольно популярный, в сообществе Lazarus разработчиков, вопрос: Как получить быстрый доступ к пикселам **TBitmap**? 185 | Это легко сделать в **Delphi** благодаря свойству **Scanline[]** из-за довольно ограниченного количества возможных форматов пикселей, но довольно сложно в **Lazarus**. 186 | Примеры сложностей, которые могут возникнуть: https://wiki.freepascal.org/Fast_direct_pixel_access. 187 | 188 | Я предлагаю небольшой, в виде одного файла, модуль **"BitmapPixels.pas"**, который упрощает работу до простого вызова **TBitmapData.Map()** и **TBitmapData.Unmap()**. 189 | Вы получаете массив пикселей в формате **$AARRGGBB** в свойстве **Data**, а также возможность установить и получить цвет пикселей с помощью **SetPixel()/GetPixel()**. 190 | 191 | ```delphi 192 | var 193 | Data: TBitmapData; 194 | X, Y: Integer; 195 | Pixel: TPixelRec;// for easy access to the channels 196 | begin 197 | // Reading the colors of the image into map "Data", width mode "ReadWrite", in the "False" alpha channel mode. 198 | // The alpha channel will be set to 0 on every element of the array. ($00RRGGBB, $00RRGGBB, ...) 199 | Data.Map(Bitmap, TAccessMode.ReadWrite, False); 200 | try 201 | for Y := 0 to Data.Height - 1 do 202 | begin 203 | for X := 0 to Data.Width - 1 do 204 | begin 205 | // Read color at (X, Y) to Pixel record 206 | Pixel := Data.GetPixel(X, Y); 207 | // some changes of Pixel 208 | Pixel.R := (Pixel.R + Pixel.G + Pixel.B) div 3; 209 | Pixel.G := Pixel.R; 210 | Pixel.B := Pixel.R; 211 | // ... 212 | // Write Pixel record to (X, Y) in map 213 | Data.SetPixel(X, Y, Pixel); 214 | end; 215 | end; 216 | finally 217 | // Writing the map to the image. 218 | // Since we have abandoned Alpha, the pixel format will be set to pf24bit. 219 | Data.Unmap(); 220 | end; 221 | end; 222 | ``` 223 | 224 | **Основные фичи:** 225 | - кроссплатформенность 226 | - поддерживает все форматы пикселей TBitmap для чтения 227 | - ускоренная обработка популярных форматов в Windows/GTK/Qt /OSX 228 | - можно обработать любое изображение, как имеющее альфа-канал, так и нет (24бит/32бит) 229 | 230 | 231 | #### Example 1 - Инвертирование цвета (read and write) 232 | ![example1.png](examples/example1.png) 233 | ```delphi 234 | procedure InvertColors(const Bitmap: TBitmap); 235 | var 236 | Data: TBitmapData; 237 | X, Y: Integer; 238 | Pixel: TPixelRec; 239 | begin 240 | Data.Map(Bitmap, TAccessMode.ReadWrite, False);// RGB access 241 | try 242 | for Y := 0 to Data.Height - 1 do 243 | begin 244 | for X := 0 to Data.Width - 1 do 245 | begin 246 | Pixel := Data.GetPixel(X, Y); 247 | Pixel.R := 255 - Pixel.R; 248 | Pixel.G := 255 - Pixel.G; 249 | Pixel.B := 255 - Pixel.B; 250 | Data.SetPixel(X, Y, Pixel); 251 | end; 252 | end; 253 | finally 254 | Data.Unmap(); 255 | end; 256 | end; 257 | ``` 258 | #### Example 2 - Создание полупрозрачного изображения (read and write, alpha) 259 | ![example2.png](examples/example2.png) 260 | ```delphi 261 | procedure HalfAlpha(const Bitmap: TBitmap); 262 | var 263 | Data: TBitmapData; 264 | X, Y: Integer; 265 | Pixel: TPixelRec; 266 | begin 267 | Data.Map(Bitmap, TAccessMode.ReadWrite, True);// ARGB access 268 | try 269 | for Y := 0 to Data.Height - 1 do 270 | begin 271 | for X := 0 to Data.Width - 1 do 272 | begin 273 | Pixel := Data.GetPixel(X, Y); 274 | Pixel.A := Pixel.A div 2; 275 | Data.SetPixel(X, Y, Pixel); 276 | end; 277 | end; 278 | finally 279 | Data.Unmap(); 280 | end; 281 | end; 282 | ``` 283 | #### Example 3 - Создание эффекта плазмы (write only) 284 | ![example3.png](examples/example3.png) 285 | ```delphi 286 | function MakePlasm(): TBitmap; 287 | var 288 | Data: TBitmapData; 289 | X, Y: Integer; 290 | Pixel: TPixelRec; 291 | begin 292 | Result := TBitmap.Create(); 293 | Result.SetSize(300, 300); 294 | 295 | Data.Map(Result, TAccessMode.Write, False); 296 | try 297 | for Y := 0 to Data.Height - 1 do 298 | begin 299 | for X := 0 to Data.Width - 1 do 300 | begin 301 | Pixel.R := Byte(Trunc( 302 | 100 + 100 * (Sin(X * Cos(Y * 0.049) * 0.01) + Cos(X * 0.0123 - Y * 0.09)))); 303 | Pixel.G := 0; 304 | Pixel.B := Byte(Trunc( 305 | Pixel.R + 100 * (Sin(X * Cos(X * 0.039) * 0.022) + Sin(X * 0.01 - Y * 0.029)))); 306 | Data.SetPixel(X, Y, Pixel); 307 | end; 308 | end; 309 | finally 310 | Data.Unmap(); 311 | end; 312 | end; 313 | ``` 314 | #### Example 4 - Смешивание двух изображений (read only, write only) 315 | ![example4.png](examples/example4.png) 316 | ```delphi 317 | function Mix(const A, B: TBitmap): TBitmap; 318 | function Min(A, B: Integer): Integer; 319 | begin 320 | if A < B then Exit(A) else Exit(B); 321 | end; 322 | var 323 | DataA, DataB, DataResult: TBitmapData; 324 | X, Y: Integer; 325 | PixelA, PixelB, PixelResult: TPixelRec; 326 | begin 327 | Result := TBitmap.Create(); 328 | Result.SetSize(Min(A.Width, B.Width), Min(A.Height, B.Height)); 329 | // this needed for correct Unmap() on exception 330 | DataA.Init(); 331 | DataB.Init(); 332 | DataResult.Init(); 333 | try 334 | DataA.Map(A, TAccessMode.Read, False); 335 | DataB.Map(B, TAccessMode.Read, False); 336 | DataResult.Map(Result, TAccessMode.Write, False); 337 | for Y := 0 to DataResult.Height - 1 do 338 | begin 339 | for X := 0 to DataResult.Width - 1 do 340 | begin 341 | PixelA := DataA.Pixels[X, Y]; 342 | PixelB := DataB.Pixels[X, Y]; 343 | PixelResult.R := (PixelA.R + PixelB.R) div 2; 344 | PixelResult.G := (PixelA.G + PixelB.G) div 2; 345 | PixelResult.B := (PixelA.B + PixelB.B) div 2; 346 | DataResult[X, Y] := PixelResult; 347 | end; 348 | end; 349 | finally 350 | DataA.Unmap(); 351 | DataB.Unmap(); 352 | DataResult.Unmap(); 353 | end; 354 | end; 355 | ``` 356 | --- 357 | ## [UA] 358 | ### BitmapPixels.pas - Модуль для Lazarus і Delphi, що дає прямий доступ до пікселів TBitmap. 359 | #### Працює на Windows(WinApi), Linux(GTK2, Qt5), OSX(Cocoa) 360 | 361 | Є досить популярне, у спільноті Lazarus розробників, питання: Як отримати швидкий доступ до пікселів TBitmap? 362 | Це легко зробити в **Delphi** завдяки властивості **Scanline[]** через досить обмежену кількість можливих форматів пікселів, але досить складно в **Lazarus**. 363 | Приклади складнощів, які можуть виникнути: https://wiki.freepascal.org/Fast_direct_pixel_access. 364 | 365 | Я пропоную невеликий, у вигляді одного файлу, модуль **"BitmapPixels.pas "**, який спрощує роботу до простого виклику **TBitmapData.Map()** і **TBitmapData.Unmap()**. 366 | Ви отримуєте масив пікселів у форматі **$AARRGGBB** у властивості **Data**, а також можливість встановити та отримати колір пікселів за допомогою **SetPixel()/GetPixel()**. 367 | 368 | ```delphi 369 | var 370 | Data: TBitmapData; 371 | X, Y: Integer; 372 | Pixel: TPixelRec;// for easy access to the channels 373 | begin 374 | // Reading the colors of the image into map "Data", width mode "ReadWrite", in the "False" alpha channel mode. 375 | // The alpha channel will be set to 0 on every element of the array. ($00RRGGBB, $00RRGGBB, ...) 376 | Data.Map(Bitmap, TAccessMode.ReadWrite, False); 377 | try 378 | for Y := 0 to Data.Height - 1 do 379 | begin 380 | for X := 0 to Data.Width - 1 do 381 | begin 382 | // Read color at (X, Y) to Pixel record 383 | Pixel := Data.GetPixel(X, Y); 384 | // some changes of Pixel 385 | Pixel.R := (Pixel.R + Pixel.G + Pixel.B) div 3; 386 | Pixel.G := Pixel.R; 387 | Pixel.B := Pixel.R; 388 | // ... 389 | // Write Pixel record to (X, Y) in map 390 | Data.SetPixel(X, Y, Pixel); 391 | end; 392 | end; 393 | finally 394 | // Writing the map to the image. 395 | // Since we have abandoned Alpha, the pixel format will be set to pf24bit. 396 | Data.Unmap(); 397 | end; 398 | end; 399 | ``` 400 | 401 | **Основні фічі:** 402 | - кросплатформеність 403 | - підтримує всі формати пікселів TBitmap для читання 404 | - прискорена обробка популярних форматів у Windows/GTK/Qt /OSX 405 | - можна обробити будь-яке зображення, як таке, що має альфа-канал, так і ні (24біт/32біт) 406 | 407 | 408 | #### Example 1 - Інвертування кольору (read and write) 409 | ![example1.png](examples/example1.png) 410 | ```delphi 411 | procedure InvertColors(const Bitmap: TBitmap); 412 | var 413 | Data: TBitmapData; 414 | X, Y: Integer; 415 | Pixel: TPixelRec; 416 | begin 417 | Data.Map(Bitmap, TAccessMode.ReadWrite, False);// RGB access 418 | try 419 | for Y := 0 to Data.Height - 1 do 420 | begin 421 | for X := 0 to Data.Width - 1 do 422 | begin 423 | Pixel := Data.GetPixel(X, Y); 424 | Pixel.R := 255 - Pixel.R; 425 | Pixel.G := 255 - Pixel.G; 426 | Pixel.B := 255 - Pixel.B; 427 | Data.SetPixel(X, Y, Pixel); 428 | end; 429 | end; 430 | finally 431 | Data.Unmap(); 432 | end; 433 | end; 434 | ``` 435 | #### Example 2 - Створення напівпрозорого зображення (read and write, alpha) 436 | ![example2.png](examples/example2.png) 437 | ```delphi 438 | procedure HalfAlpha(const Bitmap: TBitmap); 439 | var 440 | Data: TBitmapData; 441 | X, Y: Integer; 442 | Pixel: TPixelRec; 443 | begin 444 | Data.Map(Bitmap, TAccessMode.ReadWrite, True);// ARGB access 445 | try 446 | for Y := 0 to Data.Height - 1 do 447 | begin 448 | for X := 0 to Data.Width - 1 do 449 | begin 450 | Pixel := Data.GetPixel(X, Y); 451 | Pixel.A := Pixel.A div 2; 452 | Data.SetPixel(X, Y, Pixel); 453 | end; 454 | end; 455 | finally 456 | Data.Unmap(); 457 | end; 458 | end; 459 | ``` 460 | #### Example 3 - Створення ефекту плазми (write only) 461 | ![example3.png](examples/example3.png) 462 | ```delphi 463 | function MakePlasm(): TBitmap; 464 | var 465 | Data: TBitmapData; 466 | X, Y: Integer; 467 | Pixel: TPixelRec; 468 | begin 469 | Result := TBitmap.Create(); 470 | Result.SetSize(300, 300); 471 | 472 | Data.Map(Result, TAccessMode.Write, False); 473 | try 474 | for Y := 0 to Data.Height - 1 do 475 | begin 476 | for X := 0 to Data.Width - 1 do 477 | begin 478 | Pixel.R := Byte(Trunc( 479 | 100 + 100 * (Sin(X * Cos(Y * 0.049) * 0.01) + Cos(X * 0.0123 - Y * 0.09)))); 480 | Pixel.G := 0; 481 | Pixel.B := Byte(Trunc( 482 | Pixel.R + 100 * (Sin(X * Cos(X * 0.039) * 0.022) + Sin(X * 0.01 - Y * 0.029)))); 483 | Data.SetPixel(X, Y, Pixel); 484 | end; 485 | end; 486 | finally 487 | Data.Unmap(); 488 | end; 489 | end; 490 | ``` 491 | #### Example 4 - Змішування двох зображень (read only, write only) 492 | ![example4.png](examples/example4.png) 493 | ```delphi 494 | function Mix(const A, B: TBitmap): TBitmap; 495 | function Min(A, B: Integer): Integer; 496 | begin 497 | if A < B then Exit(A) else Exit(B); 498 | end; 499 | var 500 | DataA, DataB, DataResult: TBitmapData; 501 | X, Y: Integer; 502 | PixelA, PixelB, PixelResult: TPixelRec; 503 | begin 504 | Result := TBitmap.Create(); 505 | Result.SetSize(Min(A.Width, B.Width), Min(A.Height, B.Height)); 506 | // this needed for correct Unmap() on exception 507 | DataA.Init(); 508 | DataB.Init(); 509 | DataResult.Init(); 510 | try 511 | DataA.Map(A, TAccessMode.Read, False); 512 | DataB.Map(B, TAccessMode.Read, False); 513 | DataResult.Map(Result, TAccessMode.Write, False); 514 | for Y := 0 to DataResult.Height - 1 do 515 | begin 516 | for X := 0 to DataResult.Width - 1 do 517 | begin 518 | PixelA := DataA.Pixels[X, Y]; 519 | PixelB := DataB.Pixels[X, Y]; 520 | PixelResult.R := (PixelA.R + PixelB.R) div 2; 521 | PixelResult.G := (PixelA.G + PixelB.G) div 2; 522 | PixelResult.B := (PixelA.B + PixelB.B) div 2; 523 | DataResult[X, Y] := PixelResult; 524 | end; 525 | end; 526 | finally 527 | DataA.Unmap(); 528 | DataB.Unmap(); 529 | DataResult.Unmap(); 530 | end; 531 | end; 532 | ``` 533 | -------------------------------------------------------------------------------- /BitmapPixels.pas: -------------------------------------------------------------------------------- 1 | // ----------------------------------------------------------------------------- 2 | // *** BitmapPixels *** 3 | // version 1.1, last update 13.12.2021 4 | // ----------------------------------------------------------------------------- 5 | // Module for direct access to pixels at TBitmap 6 | // Tested on Windows(WinApi), Linux(Gtk2, Qt5), OSX(Cocoa) 7 | // ----------------------------------------------------------------------------- 8 | // 9 | // Latest verion of this unit aviable here: 10 | // https://github.com/crazzzypeter/BitmapPixels/ 11 | // 12 | // GitHub: https://github.com/crazzzypeter/ 13 | // Twitch: https://www.twitch.tv/crazzzypeter/ 14 | // YouTube: https://www.youtube.com/c/crazzzypeter/ 15 | // YouTube?: https://www.youtube.com/channel/UCPQmDZGb5mZJ27ev9-t3bGQ/ 16 | // Telegram: @crazzzypeter 17 | // 18 | // ----------------------------------------------------------------------------- 19 | // MIT LICENSE 20 | // 21 | // Copyright (c) 2021-2021 CrazzzyPeter 22 | // 23 | // Permission is hereby granted, free of charge, to any person obtaining a copy 24 | // of this software and associated documentation files (the "Software"), to deal 25 | // in the Software without restriction, including without limitation the rights 26 | // to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 27 | // copies of the Software, and to permit persons to whom the Software is 28 | // furnished to do so, subject to the following conditions: 29 | // 30 | // The above copyright notice and this permission notice shall be included in 31 | // all copies or substantial portions of the Software. 32 | // 33 | // THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 34 | // IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 35 | // FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 36 | // AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 37 | // LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 38 | // OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 39 | // SOFTWARE. 40 | // ----------------------------------------------------------------------------- 41 | 42 | {$REGION 'Examples'} 43 | { 44 | Examples of use: 45 | 46 | --- 1 --- 47 | procedure InvertColors(const Bitmap: TBitmap); 48 | var 49 | Data: TBitmapData; 50 | X, Y: Integer; 51 | Pixel: TPixelRec; 52 | begin 53 | Data.Map(Bitmap, TAccessMode.ReadWrite, False);// RGB access 54 | try 55 | for Y := 0 to Data.Height - 1 do 56 | begin 57 | for X := 0 to Data.Width - 1 do 58 | begin 59 | Pixel := Data.GetPixel(X, Y); 60 | Pixel.R := 255 - Pixel.R; 61 | Pixel.G := 255 - Pixel.G; 62 | Pixel.B := 255 - Pixel.B; 63 | Data.SetPixel(X, Y, Pixel); 64 | end; 65 | end; 66 | finally 67 | Data.Unmap(); 68 | end; 69 | end; 70 | 71 | --- 2 --- 72 | procedure HalfAlpha(const Bitmap: TBitmap); 73 | var 74 | Data: TBitmapData; 75 | X, Y: Integer; 76 | Pixel: TPixelRec; 77 | begin 78 | Data.Map(Bitmap, TAccessMode.ReadWrite, True);// ARGB access 79 | try 80 | for Y := 0 to Data.Height - 1 do 81 | begin 82 | for X := 0 to Data.Width - 1 do 83 | begin 84 | Pixel := Data.GetPixel(X, Y); 85 | Pixel.A := Pixel.A div 2; 86 | Data.SetPixel(X, Y, Pixel); 87 | end; 88 | end; 89 | finally 90 | Data.Unmap(); 91 | end; 92 | end; 93 | 94 | --- 3 --- 95 | function MakePlasm(): TBitmap; 96 | var 97 | Data: TBitmapData; 98 | X, Y: Integer; 99 | Pixel: TPixelRec; 100 | begin 101 | Result := TBitmap.Create(); 102 | Result.SetSize(300, 300); 103 | 104 | Data.Map(Result, TAccessMode.Write, False); 105 | try 106 | for Y := 0 to Data.Height - 1 do 107 | begin 108 | for X := 0 to Data.Width - 1 do 109 | begin 110 | Pixel.R := Byte(Trunc( 111 | 100 + 100 * (Sin(X * Cos(Y * 0.049) * 0.01) + Cos(X * 0.0123 - Y * 0.09)))); 112 | Pixel.G := 0; 113 | Pixel.B := Byte(Trunc( 114 | Pixel.R + 100 * (Sin(X * Cos(X * 0.039) * 0.022) + Sin(X * 0.01 - Y * 0.029)))); 115 | Data.SetPixel(X, Y, Pixel); 116 | end; 117 | end; 118 | finally 119 | Data.Unmap(); 120 | end; 121 | end; 122 | 123 | --- 4 --- 124 | function Mix(const A, B: TBitmap): TBitmap; 125 | function Min(A, B: Integer): Integer; 126 | begin 127 | if A < B then Exit(A) else Exit(B); 128 | end; 129 | var 130 | DataA, DataB, DataResult: TBitmapData; 131 | X, Y: Integer; 132 | PixelA, PixelB, PixelResult: TPixelRec; 133 | begin 134 | Result := TBitmap.Create(); 135 | Result.SetSize(Min(A.Width, B.Width), Min(A.Height, B.Height)); 136 | // this needed for correct Unmap() on exception 137 | DataA.Init(); 138 | DataB.Init(); 139 | DataResult.Init(); 140 | try 141 | DataA.Map(A, TAccessMode.Read, False); 142 | DataB.Map(B, TAccessMode.Read, False); 143 | DataResult.Map(Result, TAccessMode.Write, False); 144 | for Y := 0 to DataResult.Height - 1 do 145 | begin 146 | for X := 0 to DataResult.Width - 1 do 147 | begin 148 | PixelA := DataA.Pixels[X, Y]; 149 | PixelB := DataB.Pixels[X, Y]; 150 | PixelResult.R := (PixelA.R + PixelB.R) div 2; 151 | PixelResult.G := (PixelA.G + PixelB.G) div 2; 152 | PixelResult.B := (PixelA.B + PixelB.B) div 2; 153 | DataResult[X, Y] := PixelResult; 154 | end; 155 | end; 156 | finally 157 | DataA.Unmap(); 158 | DataB.Unmap(); 159 | DataResult.Unmap(); 160 | end; 161 | end; 162 | } 163 | {$ENDREGION} 164 | 165 | unit BitmapPixels; 166 | 167 | {$IFDEF FPC}{$MODE DELPHI}{$ENDIF} 168 | {$SCOPEDENUMS ON} 169 | {$POINTERMATH ON} 170 | interface 171 | 172 | uses 173 | {$IFNDEF FPC}Windows,{$ENDIF} Classes, SysUtils, Graphics{$IFDEF FPC}, FPImage{$ENDIF}; 174 | 175 | type 176 | // $AARRGGBB 177 | TPixel = Cardinal; 178 | PPixel = ^TPixel; 179 | 180 | TPixelArray = array [0..High(Integer) div SizeOf(TPixel) - 1] of TPixel; 181 | PPixelArray = ^TPixelArray; 182 | 183 | TAccessMode = (Read, Write, ReadWrite); 184 | 185 | { TBitmapData } 186 | 187 | TBitmapData = record 188 | private 189 | FData: PPixelArray; 190 | FBitmap: TBitmap; 191 | FWidth: Integer; 192 | FHeight: Integer; 193 | FAccessMode: TAccessMode; 194 | FHasAlpha: Boolean; 195 | FDataArray: array of TPixel;// do not use this 196 | public 197 | procedure Init(); 198 | procedure Map(const Bitmap: TBitmap; const Mode: TAccessMode; const UseAlpha: Boolean; 199 | const Background: TColor = clNone); 200 | procedure Unmap(); 201 | function GetPixel(X, Y: Integer): TPixel; inline; 202 | procedure SetPixel(X, Y: Integer; AValue: TPixel); inline; 203 | function GetPixelUnsafe(X, Y: Integer): TPixel; inline; 204 | procedure SetPixelUnsafe(X, Y: Integer; AValue: TPixel); inline; 205 | property Data: PPixelArray read FData; 206 | property HasAlpha: Boolean read FHasAlpha; 207 | property Width: Integer read FWidth; 208 | property Height: Integer read FHeight; 209 | property Pixels[X, Y: Integer]: TPixel read GetPixel write SetPixel; default; 210 | end; 211 | 212 | { TPixelRec } 213 | 214 | TPixelRec = packed record 215 | constructor Create(const R, G, B: Byte; const A: Byte = 255); 216 | class operator Implicit(Pixel: TPixel): TPixelRec; inline; 217 | class operator Implicit(Pixel: TPixelRec): TPixel; inline; 218 | case Byte of 219 | 0: (B, G, R, A: Byte); 220 | 1: (Color: TPixel); 221 | end; 222 | 223 | TPixelColors = record 224 | {$REGION 'HTML Colors'} 225 | const 226 | AliceBlue = $FFF0F8FF; 227 | AntiqueWhite = $FFFAEBD7; 228 | Aqua = $FF00FFFF; 229 | Aquamarine = $FF7FFFD4; 230 | Azure = $FFF0FFFF; 231 | Beige = $FFF5F5DC; 232 | Bisque = $FFFFE4C4; 233 | Black = $FF000000; 234 | BlanchedAlmond = $FFFFEBCD; 235 | Blue = $FF0000FF; 236 | BlueViolet = $FF8A2BE2; 237 | Brown = $FFA52A2A; 238 | BurlyWood = $FFDEB887; 239 | CadetBlue = $FF5F9EA0; 240 | Chartreuse = $FF7FFF00; 241 | Chocolate = $FFD2691E; 242 | Coral = $FFFF7F50; 243 | CornflowerBlue = $FF6495ED; 244 | Cornsilk = $FFFFF8DC; 245 | Crimson = $FFDC143C; 246 | Cyan = $FF00FFFF; 247 | DarkBlue = $FF00008B; 248 | DarkCyan = $FF008B8B; 249 | DarkGoldenrod = $FFB8860B; 250 | DarkGray = $FFA9A9A9; 251 | DarkGreen = $FF006400; 252 | DarkKhaki = $FFBDB76B; 253 | DarkMagenta = $FF8B008B; 254 | DarkOliveGreen = $FF556B2F; 255 | DarkOrange = $FFFF8C00; 256 | DarkOrchid = $FF9932CC; 257 | DarkRed = $FF8B0000; 258 | DarkSalmon = $FFE9967A; 259 | DarkSeaGreen = $FF8FBC8F; 260 | DarkSlateBlue = $FF483D8B; 261 | DarkSlateGray = $FF2F4F4F; 262 | DarkTurquoise = $FF00CED1; 263 | DarkViolet = $FF9400D3; 264 | DeepPink = $FFFF1493; 265 | DeepSkyBlue = $FF00BFFF; 266 | DimGray = $FF696969; 267 | DodgerBlue = $FF1E90FF; 268 | FireBrick = $FFB22222; 269 | FloralWhite = $FFFFFAF0; 270 | ForestGreen = $FF228B22; 271 | Fuchsia = $FFFF00FF; 272 | Gainsboro = $FFDCDCDC; 273 | GhostWhite = $FFF8F8FF; 274 | Gold = $FFFFD700; 275 | Goldenrod = $FFDAA520; 276 | Gray = $FF808080; 277 | Green = $FF008000; 278 | GreenYellow = $FFADFF2F; 279 | Honeydew = $FFF0FFF0; 280 | HotPink = $FFFF69B4; 281 | IndianRed = $FFCD5C5C; 282 | Indigo = $FF4B0082; 283 | Ivory = $FFFFFFF0; 284 | Khaki = $FFF0E68C; 285 | Lavender = $FFE6E6FA; 286 | LavenderBlush = $FFFFF0F5; 287 | LawnGreen = $FF7CFC00; 288 | LemonChiffon = $FFFFFACD; 289 | LightBlue = $FFADD8E6; 290 | LightCoral = $FFF08080; 291 | LightCyan = $FFE0FFFF; 292 | LightGoldenrodYellow = $FFFAFAD2; 293 | LightGreen = $FF90EE90; 294 | LightGrey = $FFD3D3D3; 295 | LightPink = $FFFFB6C1; 296 | LightSalmon = $FFFFA07A; 297 | LightSeaGreen = $FF20B2AA; 298 | LightSkyBlue = $FF87CEFA; 299 | LightSlateGray = $FF778899; 300 | LightSteelBlue = $FFB0C4DE; 301 | LightYellow = $FFFFFFE0; 302 | Lime = $FF00FF00; 303 | LimeGreen = $FF32CD32; 304 | Linen = $FFFAF0E6; 305 | Magenta = $FFFF00FF; 306 | Maroon = $FF800000; 307 | MediumAquamarine = $FF66CDAA; 308 | MediumBlue = $FF0000CD; 309 | MediumOrchid = $FFBA55D3; 310 | MediumPurple = $FF9370DB; 311 | MediumSeaGreen = $FF3CB371; 312 | MediumSlateBlue = $FF7B68EE; 313 | MediumSpringGreen = $FF00FA9A; 314 | MediumTurquoise = $FF48D1CC; 315 | MediumVioletRed = $FFC71585; 316 | MidnightBlue = $FF191970; 317 | MintCream = $FFF5FFFA; 318 | MistyRose = $FFFFE4E1; 319 | Moccasin = $FFFFE4B5; 320 | NavajoWhite = $FFFFDEAD; 321 | Navy = $FF000080; 322 | OldLace = $FFFDF5E6; 323 | Olive = $FF808000; 324 | OliveDrab = $FF6B8E23; 325 | Orange = $FFFFA500; 326 | OrangeRed = $FFFF4500; 327 | Orchid = $FFDA70D6; 328 | PaleGoldenrod = $FFEEE8AA; 329 | PaleGreen = $FF98FB98; 330 | PaleTurquoise = $FFAFEEEE; 331 | PaleVioletRed = $FFDB7093; 332 | PapayaWhip = $FFFFEFD5; 333 | PeachPuff = $FFFFDAB9; 334 | Peru = $FFCD853F; 335 | Pink = $FFFFC0CB; 336 | Plum = $FFDDA0DD; 337 | PowderBlue = $FFB0E0E6; 338 | Purple = $FF800080; 339 | Red = $FFFF0000; 340 | RosyBrown = $FFBC8F8F; 341 | RoyalBlue = $FF4169E1; 342 | SaddleBrown = $FF8B4513; 343 | Salmon = $FFFA8072; 344 | SandyBrown = $FFF4A460; 345 | SeaGreen = $FF2E8B57; 346 | Seashell = $FFFFF5EE; 347 | Sienna = $FFA0522D; 348 | Silver = $FFC0C0C0; 349 | SkyBlue = $FF87CEEB; 350 | SlateBlue = $FF6A5ACD; 351 | SlateGray = $FF708090; 352 | Snow = $FFFFFAFA; 353 | SpringGreen = $FF00FF7F; 354 | SteelBlue = $FF4682B4; 355 | Tan = $FFD2B48C; 356 | Teal = $FF008080; 357 | Thistle = $FFD8BFD8; 358 | Tomato = $FFFF6347; 359 | Turquoise = $FF40E0D0; 360 | Violet = $FFEE82EE; 361 | Wheat = $FFF5DEB3; 362 | White = $FFFFFFFF; 363 | WhiteSmoke = $FFF5F5F5; 364 | Yellow = $FFFFFF00; 365 | YellowGreen = $FF9ACD32; 366 | {$ENDREGION} 367 | end; 368 | 369 | function MakePixel(const R, G, B: Byte; const A: Byte = 255): TPixel; inline; 370 | function PixelGetA(const Pixel: TPixel): Byte; inline; 371 | function PixelGetR(const Pixel: TPixel): Byte; inline; 372 | function PixelGetG(const Pixel: TPixel): Byte; inline; 373 | function PixelGetB(const Pixel: TPixel): Byte; inline; 374 | {$IFDEF FPC} 375 | function FPColorToPixel(const FPColor: TFPColor): TPixel; inline; 376 | function PixelToFPColor(const Pixel: TPixel): TFPColor; inline; 377 | {$ENDIF} 378 | function ColorToPixel(const Color: TColor): TPixel; inline; 379 | function PixelToColor(const Pixel: TPixel): TColor; inline; 380 | 381 | implementation 382 | 383 | {$IFDEF FPC} 384 | uses 385 | IntfGraphics, GraphType, LCLType, LCLIntf; 386 | {$ENDIF} 387 | 388 | function MakePixel(const R, G, B: Byte; const A: Byte): TPixel; inline; 389 | begin 390 | Result := B or (G shl 8) or (R shl 16) or (A shl 24); 391 | end; 392 | 393 | function PixelGetA(const Pixel: TPixel): Byte; inline; 394 | begin 395 | Result := (Pixel shr 24) and $FF; 396 | end; 397 | 398 | function PixelGetR(const Pixel: TPixel): Byte; inline; 399 | begin 400 | Result := (Pixel shr 16) and $FF; 401 | end; 402 | 403 | function PixelGetG(const Pixel: TPixel): Byte; inline; 404 | begin 405 | Result := (Pixel shr 8) and $FF; 406 | end; 407 | 408 | function PixelGetB(const Pixel: TPixel): Byte; inline; 409 | begin 410 | Result := Pixel and $FF; 411 | end; 412 | 413 | {$IFDEF FPC} 414 | function FPColorToPixel(const FPColor: TFPColor): TPixel; inline; 415 | begin 416 | Result:= 417 | ((FPColor.Blue shr 8) and $ff) or 418 | (FPColor.Green and $ff00) or 419 | ((FPColor.Red shl 8) and $ff0000) or 420 | ((FPColor.Alpha shl 16) and $ff000000); 421 | end; 422 | 423 | function PixelToFPColor(const Pixel: TPixel): TFPColor; inline; 424 | begin 425 | Result.Red := (Pixel and $ff0000) shr 8; 426 | Result.Red := Result.Red + (Result.Red shr 8); 427 | Result.Green := (Pixel and $ff00); 428 | Result.Green := Result.Green + (Result.Green shr 8); 429 | Result.Blue := (Pixel and $ff); 430 | Result.Blue := Result.Blue + (Result.Blue shl 8); 431 | Result.Alpha := (Pixel and $ff000000) shr 16; 432 | Result.Alpha := Result.Alpha + (Result.Alpha shr 8); 433 | end; 434 | {$ENDIF} 435 | 436 | function ColorToPixel(const Color: TColor): TPixel; inline; 437 | begin 438 | Result:= 439 | (Color and $0000FF00) or 440 | ((Color shr 16) and $000000FF) or 441 | ((Color shl 16) and $00FF0000) or 442 | $FF000000; 443 | end; 444 | 445 | function PixelToColor(const Pixel: TPixel): TColor; inline; 446 | begin 447 | Result:= 448 | (Pixel and $0000FF00) or 449 | ((Pixel shr 16) and $000000FF) or 450 | ((Pixel shl 16) and $00FF0000); 451 | end; 452 | 453 | function SwapRedBlueChanel(const Pixel: TPixel): TPixel; inline; 454 | begin 455 | Result:= 456 | (Pixel and $FF00FF00) or 457 | ((Pixel shr 16) and $000000FF) or 458 | ((Pixel shl 16) and $00FF0000); 459 | end; 460 | 461 | procedure BlendData(var BitmapData: TBitmapData; const Background: TColor); 462 | var 463 | I: Integer; 464 | R, G, B, A: Byte; 465 | DestR, DestG, DestB: Byte; 466 | C: TPixel; 467 | begin 468 | DestR := Background and $FF; 469 | DestG := (Background shr 8) and $FF; 470 | DestB := (Background shr 16) and $FF; 471 | 472 | for I := 0 to BitmapData.FWidth * BitmapData.FHeight - 1 do 473 | begin 474 | C := BitmapData.FData[I]; 475 | // read 476 | B := C and $FF; 477 | G := (C shr 8) and $FF; 478 | R := (C shr 16) and $FF; 479 | A := (C shr 24) and $FF; 480 | // blend 481 | B := ((B * A) + (DestB * (255 - A))) div 255; 482 | G := ((G * A) + (DestG * (255 - A))) div 255; 483 | R := ((R * A) + (DestR * (255 - A))) div 255; 484 | // write 485 | BitmapData.FData[I] := B or ((G shl 8) and $0000FF00) or ((R shl 16) and $00FF0000); 486 | end; 487 | end; 488 | 489 | {$IFDEF FPC} 490 | // FPC ACCESS 491 | procedure ReadData(var BitmapData: TBitmapData); 492 | var 493 | IntfImage: TLazIntfImage; 494 | X, Y, Position: Integer; 495 | begin 496 | IntfImage := BitmapData.FBitmap.CreateIntfImage(); 497 | try 498 | Position := 0; 499 | for Y := 0 to BitmapData.FHeight - 1 do 500 | begin 501 | for X := 0 to BitmapData.FWidth - 1 do 502 | begin 503 | BitmapData.FData[Position] := FPColorToPixel(IntfImage.Colors[X, Y]); 504 | Inc(Position, 1); 505 | end; 506 | end; 507 | finally 508 | IntfImage.Free(); 509 | end; 510 | end; 511 | 512 | {function MakeNativeGtk2RawImageDescription(const Width, Height: Integer): TRawImageDescription; 513 | begin 514 | Result.Init; 515 | Result.Format := ricfRGBA; 516 | Result.Width := Width; 517 | Result.Height := Height; 518 | Result.Depth := 32; 519 | Result.BitOrder := riboBitsInOrder; 520 | Result.ByteOrder := riboLSBFirst; 521 | Result.LineOrder := riloTopToBottom; 522 | Result.LineEnd := rileDWordBoundary; 523 | Result.BitsPerPixel := 32; 524 | Result.RedPrec := 8; 525 | Result.RedShift := 0; 526 | Result.GreenPrec := 8; 527 | Result.GreenShift := 8; 528 | Result.BluePrec := 8; 529 | Result.BlueShift := 16; 530 | Result.AlphaPrec := 8; 531 | Result.AlphaShift := 24; 532 | Result.MaskBitsPerPixel := 0; 533 | Result.MaskShift := 0; 534 | Result.MaskLineEnd := rileByteBoundary; 535 | Result.MaskBitOrder := riboBitsInOrder; 536 | Result.PaletteColorCount := 0; 537 | Result.PaletteBitsPerIndex := 0; 538 | Result.PaletteShift := 0; 539 | Result.PaletteLineEnd := rileTight; 540 | Result.PaletteBitOrder := riboBitsInOrder; 541 | Result.PaletteByteOrder := riboLSBFirst; 542 | end;} 543 | 544 | {$IF DEFINED(LCLGTK2) OR DEFINED(WINDOWS)} 545 | procedure WriteData(var BitmapData: TBitmapData); 546 | var 547 | Position: Integer; 548 | RawImage: TRawImage; 549 | begin 550 | if BitmapData.FHasAlpha then 551 | begin 552 | RawImage.Init(); 553 | RawImage.Description.Init_BPP32_B8G8R8A8_BIO_TTB(BitmapData.FWidth, BitmapData.FHeight); 554 | RawImage.Data := PByte(@(BitmapData.FData[0])); 555 | RawImage.DataSize := BitmapData.FWidth * BitmapData.FHeight * SizeOf(TPixel); 556 | BitmapData.FBitmap.LoadFromRawImage(RawImage, False); 557 | end else 558 | begin 559 | RawImage.Init(); 560 | RawImage.Description.Init_BPP32_B8G8R8_BIO_TTB(BitmapData.FWidth, BitmapData.FHeight); 561 | RawImage.DataSize := BitmapData.FWidth * BitmapData.FHeight * SizeOf(TPixel); 562 | RawImage.CreateData(False); 563 | try 564 | for Position := 0 to BitmapData.FWidth * BitmapData.FHeight - 1 do 565 | begin 566 | PPixel(RawImage.Data)[Position] := BitmapData.Data[Position] and $00FFFFFF; 567 | end; 568 | BitmapData.FBitmap.LoadFromRawImage(RawImage, False); 569 | finally 570 | RawImage.FreeData(); 571 | end; 572 | end; 573 | end; 574 | {$ELSE} 575 | procedure WriteData(var BitmapData: TBitmapData); 576 | var 577 | IntfImage: TLazIntfImage; 578 | X, Y, Position: Integer; 579 | //RawImage: TRawImage; 580 | begin 581 | if BitmapData.FHasAlpha then 582 | IntfImage := TLazIntfImage.Create(BitmapData.FWidth, BitmapData.FHeight, [riqfRGB, riqfAlpha]) 583 | else 584 | IntfImage := TLazIntfImage.Create(BitmapData.FWidth, BitmapData.FHeight, [riqfRGB]); 585 | try 586 | IntfImage.CreateData(); 587 | Position := 0; 588 | for Y := 0 to BitmapData.FHeight - 1 do 589 | begin 590 | for X := 0 to BitmapData.FWidth - 1 do 591 | begin 592 | IntfImage.Colors[X, Y] := PixelToFPColor(BitmapData.FData[Position]); 593 | Inc(Position, 1); 594 | end; 595 | end; 596 | BitmapData.FBitmap.LoadFromIntfImage(IntfImage); 597 | // IntfImage.GetRawImage(RawImage, True); 598 | // BitmapData.FBitmap.LoadFromRawImage(RawImage, True); 599 | finally 600 | IntfImage.Free(); 601 | end; 602 | end; 603 | {$ENDIF} 604 | 605 | procedure ReadDataRGB(var BitmapData: TBitmapData); 606 | var 607 | pSrc: PByte; 608 | X, Y, Position: Integer; 609 | begin 610 | BitmapData.FBitmap.BeginUpdate(False); 611 | try 612 | Position := 0; 613 | for Y := 0 to BitmapData.FHeight - 1 do 614 | begin 615 | pSrc := PByte(BitmapData.FBitmap.RawImage.GetLineStart(Y)); 616 | for X := 0 to BitmapData.FWidth - 1 do 617 | begin 618 | BitmapData.FData[Position] := (pSrc[0] shl 16) or (pSrc[1] shl 8) or pSrc[2]; 619 | Inc(Position, 1); 620 | Inc(pSrc, 3); 621 | end; 622 | end; 623 | finally 624 | BitmapData.FBitmap.EndUpdate(False); 625 | end; 626 | end; 627 | 628 | procedure ReadDataRGBOpaque(var BitmapData: TBitmapData); 629 | var 630 | pSrc: PByte; 631 | X, Y, Position: Integer; 632 | begin 633 | BitmapData.FBitmap.BeginUpdate(False); 634 | try 635 | Position := 0; 636 | for Y := 0 to BitmapData.FHeight - 1 do 637 | begin 638 | pSrc := PByte(BitmapData.FBitmap.RawImage.GetLineStart(Y)); 639 | for X := 0 to BitmapData.FWidth - 1 do 640 | begin 641 | BitmapData.FData[Position] := (pSrc[0] shl 16) or (pSrc[1] shl 8) or pSrc[2] or $FF000000; 642 | Inc(Position, 1); 643 | Inc(pSrc, 3); 644 | end; 645 | end; 646 | finally 647 | BitmapData.FBitmap.EndUpdate(False); 648 | end; 649 | end; 650 | 651 | procedure ReadDataBGR(var BitmapData: TBitmapData); 652 | var 653 | pSrc: PByte; 654 | X, Y, Position: Integer; 655 | begin 656 | BitmapData.FBitmap.BeginUpdate(False); 657 | try 658 | Position := 0; 659 | for Y := 0 to BitmapData.FHeight - 1 do 660 | begin 661 | pSrc := PByte(BitmapData.FBitmap.RawImage.GetLineStart(Y)); 662 | for X := 0 to BitmapData.FWidth - 1 do 663 | begin 664 | BitmapData.FData[Position] := pSrc[0] or (pSrc[1] shl 8) or (pSrc[2] shl 16); 665 | Inc(Position, 1); 666 | Inc(pSrc, 3); 667 | end; 668 | end; 669 | finally 670 | BitmapData.FBitmap.EndUpdate(False); 671 | end; 672 | end; 673 | 674 | procedure ReadDataBGROpaque(var BitmapData: TBitmapData); 675 | var 676 | pSrc: PByte; 677 | X, Y, Position: Integer; 678 | begin 679 | BitmapData.FBitmap.BeginUpdate(False); 680 | try 681 | Position := 0; 682 | for Y := 0 to BitmapData.FHeight - 1 do 683 | begin 684 | pSrc := PByte(BitmapData.FBitmap.RawImage.GetLineStart(Y)); 685 | for X := 0 to BitmapData.FWidth - 1 do 686 | begin 687 | BitmapData.FData[Position] := pSrc[0] or (pSrc[1] shl 8) or (pSrc[2] shl 16) or $FF000000; 688 | Inc(Position, 1); 689 | Inc(pSrc, 3); 690 | end; 691 | end; 692 | finally 693 | BitmapData.FBitmap.EndUpdate(False); 694 | end; 695 | end; 696 | 697 | procedure ReadDataBGRA(var BitmapData: TBitmapData);// fast 698 | var 699 | Y: Integer; 700 | pSrc, pDst: PPixel; 701 | begin 702 | BitmapData.FBitmap.BeginUpdate(False); 703 | try 704 | for Y := 0 to BitmapData.FHeight - 1 do 705 | begin 706 | pSrc := PPixel(BitmapData.FBitmap.RawImage.GetLineStart(Y)); 707 | pDst := @(BitmapData.FData[BitmapData.FWidth * Y]); 708 | Move(pSrc^, pDst^, BitmapData.FWidth * SizeOf(TPixel)); 709 | end; 710 | finally 711 | BitmapData.FBitmap.EndUpdate(False); 712 | end; 713 | end; 714 | 715 | procedure ReadDataBGRN(var BitmapData: TBitmapData); 716 | var 717 | Scanline: PPixel; 718 | X, Y, Position: Integer; 719 | begin 720 | BitmapData.FBitmap.BeginUpdate(False); 721 | try 722 | Position := 0; 723 | for Y := 0 to BitmapData.FHeight - 1 do 724 | begin 725 | Scanline := PPixel(BitmapData.FBitmap.RawImage.GetLineStart(Y)); 726 | for X := 0 to BitmapData.FWidth - 1 do 727 | begin 728 | BitmapData.FData[Position] := Scanline[X]; 729 | Inc(Position, 1); 730 | end; 731 | end; 732 | finally 733 | BitmapData.FBitmap.EndUpdate(False); 734 | end; 735 | end; 736 | 737 | procedure ReadDataBGRNOpaque(var BitmapData: TBitmapData); 738 | var 739 | Scanline: PPixel; 740 | X, Y, Position: Integer; 741 | begin 742 | BitmapData.FBitmap.BeginUpdate(False); 743 | try 744 | Position := 0; 745 | for Y := 0 to BitmapData.FHeight - 1 do 746 | begin 747 | Scanline := PPixel(BitmapData.FBitmap.RawImage.GetLineStart(Y)); 748 | for X := 0 to BitmapData.FWidth - 1 do 749 | begin 750 | BitmapData.FData[Position] := Scanline[X] or $FF000000; 751 | Inc(Position, 1); 752 | end; 753 | end; 754 | finally 755 | BitmapData.FBitmap.EndUpdate(False); 756 | end; 757 | end; 758 | 759 | procedure ReadDataRGBA(var BitmapData: TBitmapData); 760 | var 761 | Scanline: PPixel; 762 | X, Y, Position: Integer; 763 | begin 764 | BitmapData.FBitmap.BeginUpdate(False); 765 | try 766 | Position := 0; 767 | for Y := 0 to BitmapData.FHeight - 1 do 768 | begin 769 | Scanline := PPixel(BitmapData.FBitmap.RawImage.GetLineStart(Y)); 770 | for X := 0 to BitmapData.FWidth - 1 do 771 | begin 772 | BitmapData.FData[Position] := SwapRedBlueChanel(Scanline[X]); 773 | Inc(Position, 1); 774 | end; 775 | end; 776 | finally 777 | BitmapData.FBitmap.EndUpdate(False); 778 | end; 779 | end; 780 | 781 | procedure ReadDataRGBN(var BitmapData: TBitmapData); 782 | var 783 | Scanline: PPixel; 784 | Pixel: TPixel; 785 | X, Y, Position: Integer; 786 | begin 787 | BitmapData.FBitmap.BeginUpdate(False); 788 | try 789 | Position := 0; 790 | for Y := 0 to BitmapData.FHeight - 1 do 791 | begin 792 | Scanline := PPixel(BitmapData.FBitmap.RawImage.GetLineStart(Y)); 793 | for X := 0 to BitmapData.FWidth - 1 do 794 | begin 795 | Pixel := Scanline[X]; 796 | BitmapData.FData[Position] := 797 | ((Pixel shr 16) and $000000FF) or 798 | (Pixel and $0000FF00) or 799 | ((Pixel shl 16) and $00FF0000); 800 | Inc(Position, 1); 801 | end; 802 | end; 803 | finally 804 | BitmapData.FBitmap.EndUpdate(False); 805 | end; 806 | end; 807 | 808 | procedure ReadDataRGBNOpaque(var BitmapData: TBitmapData); 809 | var 810 | Scanline: PPixel; 811 | Pixel: TPixel; 812 | X, Y, Position: Integer; 813 | begin 814 | BitmapData.FBitmap.BeginUpdate(False); 815 | try 816 | Position := 0; 817 | for Y := 0 to BitmapData.FHeight - 1 do 818 | begin 819 | Scanline := PPixel(BitmapData.FBitmap.RawImage.GetLineStart(Y)); 820 | for X := 0 to BitmapData.FWidth - 1 do 821 | begin 822 | Pixel := Scanline[X]; 823 | BitmapData.FData[Position] := 824 | ((Pixel shr 16) and $000000FF) or 825 | (Pixel and $0000FF00) or 826 | ((Pixel shl 16) and $00FF0000) or 827 | $FF000000; 828 | Inc(Position, 1); 829 | end; 830 | end; 831 | finally 832 | BitmapData.FBitmap.EndUpdate(False); 833 | end; 834 | end; 835 | 836 | procedure WriteDataRGB(var BitmapData: TBitmapData); 837 | var 838 | pSrc: PByte; 839 | C: TPixel; 840 | X, Y, Position: Integer; 841 | begin 842 | BitmapData.FBitmap.BeginUpdate(False); 843 | try 844 | Position := 0; 845 | for Y := 0 to BitmapData.FHeight - 1 do 846 | begin 847 | pSrc := PByte(BitmapData.FBitmap.RawImage.GetLineStart(Y)); 848 | for X := 0 to BitmapData.FWidth - 1 do 849 | begin 850 | C := BitmapData.FData[Position]; 851 | pSrc[0] := (C shr 16) and $FF; 852 | pSrc[1] := (C shr 8) and $FF; 853 | pSrc[2] := C and $FF; 854 | Inc(Position, 1); 855 | Inc(pSrc, 3); 856 | end; 857 | end; 858 | finally 859 | BitmapData.FBitmap.EndUpdate(False); 860 | end; 861 | end; 862 | 863 | procedure WriteDataBGR(var BitmapData: TBitmapData); 864 | var 865 | pSrc: PByte; 866 | C: TPixel; 867 | X, Y, Position: Integer; 868 | begin 869 | BitmapData.FBitmap.BeginUpdate(False); 870 | try 871 | Position := 0; 872 | for Y := 0 to BitmapData.FHeight - 1 do 873 | begin 874 | pSrc := PByte(BitmapData.FBitmap.RawImage.GetLineStart(Y)); 875 | for X := 0 to BitmapData.FWidth - 1 do 876 | begin 877 | C := BitmapData.FData[Position]; 878 | pSrc[0] := C and $FF; 879 | pSrc[1] := (C shr 8) and $FF; 880 | pSrc[2] := (C shr 16) and $FF; 881 | Inc(Position, 1); 882 | Inc(pSrc, 3); 883 | end; 884 | end; 885 | finally 886 | BitmapData.FBitmap.EndUpdate(False); 887 | end; 888 | end; 889 | 890 | procedure WriteDataBGRA(var BitmapData: TBitmapData);// fast 891 | var 892 | Y: Integer; 893 | pSrc, pDst: PPixel; 894 | begin 895 | BitmapData.FBitmap.BeginUpdate(False); 896 | try 897 | for Y := 0 to BitmapData.FHeight - 1 do 898 | begin 899 | pDst := PPixel(BitmapData.FBitmap.RawImage.GetLineStart(Y)); 900 | pSrc := @(BitmapData.FData[BitmapData.FWidth * Y]); 901 | Move(pSrc^, pDst^, BitmapData.FWidth * SizeOf(TPixel)); 902 | end; 903 | finally 904 | BitmapData.FBitmap.EndUpdate(False); 905 | end; 906 | end; 907 | 908 | procedure WriteDataRGBA(var BitmapData: TBitmapData); 909 | var 910 | Scanline: PPixel; 911 | X, Y, Position: Integer; 912 | begin 913 | BitmapData.FBitmap.BeginUpdate(False); 914 | try 915 | Position := 0; 916 | for Y := 0 to BitmapData.FHeight - 1 do 917 | begin 918 | Scanline := PPixel(BitmapData.FBitmap.RawImage.GetLineStart(Y)); 919 | for X := 0 to BitmapData.FWidth - 1 do 920 | begin 921 | Scanline[X] := SwapRedBlueChanel(BitmapData.FData[Position]); 922 | Inc(Position, 1); 923 | end; 924 | end; 925 | finally 926 | BitmapData.FBitmap.EndUpdate(False); 927 | end; 928 | end; 929 | 930 | procedure WriteDataRGBN(var BitmapData: TBitmapData); 931 | var 932 | Scanline: PPixel; 933 | Pixel: TPixel; 934 | X, Y, Position: Integer; 935 | begin 936 | BitmapData.FBitmap.BeginUpdate(False); 937 | try 938 | Position := 0; 939 | for Y := 0 to BitmapData.FHeight - 1 do 940 | begin 941 | Scanline := PPixel(BitmapData.FBitmap.RawImage.GetLineStart(Y)); 942 | for X := 0 to BitmapData.FWidth - 1 do 943 | begin 944 | Pixel := BitmapData.FData[Position]; 945 | Scanline[X] := 946 | ((Pixel shr 16) and $000000FF) or 947 | (Pixel and $0000FF00) or 948 | ((Pixel shl 16) and $00FF0000); 949 | Inc(Position, 1); 950 | end; 951 | end; 952 | finally 953 | BitmapData.FBitmap.EndUpdate(False); 954 | end; 955 | end; 956 | 957 | procedure WriteDataBGRN(var BitmapData: TBitmapData); 958 | var 959 | Scanline: PPixel; 960 | X, Y, Position: Integer; 961 | begin 962 | BitmapData.FBitmap.BeginUpdate(False); 963 | try 964 | Position := 0; 965 | for Y := 0 to BitmapData.FHeight - 1 do 966 | begin 967 | Scanline := PPixel(BitmapData.FBitmap.RawImage.GetLineStart(Y)); 968 | for X := 0 to BitmapData.FWidth - 1 do 969 | begin 970 | Scanline[X] := BitmapData.FData[Position] and $00FFFFFF; 971 | Inc(Position, 1); 972 | end; 973 | end; 974 | finally 975 | BitmapData.FBitmap.EndUpdate(False); 976 | end; 977 | end; 978 | 979 | type 980 | TDescriptionType = (DeskBGR, DeskRGB, DeskBGRA, DeskRGBA, DeskBGRN, DeskRGBN, DeskOther); 981 | 982 | function CalcDescriptionType(const Description: TRawImageDescription; const IsReadOnly: Boolean = False): TDescriptionType; 983 | begin 984 | Result := TDescriptionType.DeskOther; 985 | if Description.Format <> ricfRGBA then Exit; 986 | if Description.ByteOrder <> riboLSBFirst then Exit; 987 | if Description.PaletteColorCount <> 0 then Exit; 988 | // if Description.BitOrder <> riboBitsInOrder then Exit; // it doesn't matter without a mask 989 | 990 | // ??? I think it makes no difference to us whether there is a mask or not 991 | {$IFDEF LCLGTK2} 992 | // LCLGTK2 image width workaround 993 | // ex: width = 16 - ok, width = 15 bug 994 | if (not IsReadOnly) and (Description.MaskBitsPerPixel <> 0) then 995 | if Description.MaskLineEnd = rileByteBoundary then Exit; 996 | {$ENDIF} 997 | 998 | if Description.BitsPerPixel = 32 then 999 | begin 1000 | if Description.Depth = 32 then 1001 | begin 1002 | // prec 1003 | if Description.RedPrec <> 8 then Exit; 1004 | if Description.GreenPrec <> 8 then Exit; 1005 | if Description.BluePrec <> 8 then Exit; 1006 | if Description.AlphaPrec <> 8 then Exit; 1007 | // A and G 1008 | if Description.AlphaShift <> 24 then Exit; 1009 | if Description.GreenShift <> 8 then Exit; 1010 | // DeskBGRA or DeskRGBA 1011 | if (Description.RedShift = 16) and (Description.BlueShift = 0) then 1012 | Result := TDescriptionType.DeskBGRA 1013 | else if (Description.RedShift = 0) and (Description.BlueShift = 16) then 1014 | Result := TDescriptionType.DeskRGBA 1015 | else 1016 | Result := TDescriptionType.DeskOther; 1017 | end 1018 | else if Description.Depth = 24 then 1019 | begin 1020 | // prec 1021 | if Description.RedPrec <> 8 then Exit; 1022 | if Description.GreenPrec <> 8 then Exit; 1023 | if Description.BluePrec <> 8 then Exit; 1024 | // G 1025 | if Description.GreenShift <> 8 then Exit; 1026 | // DeskBGRN or DeskRGBN 1027 | if (Description.RedShift = 16) and (Description.BlueShift = 0) then 1028 | Result := TDescriptionType.DeskBGRN 1029 | else if (Description.RedShift = 0) and (Description.BlueShift = 16) then 1030 | Result := TDescriptionType.DeskRGBN 1031 | else 1032 | Result := TDescriptionType.DeskOther; 1033 | end; 1034 | end 1035 | else if Description.BitsPerPixel = 24 then 1036 | begin 1037 | if Description.Depth <> 24 then Exit; 1038 | // prec 1039 | if Description.RedPrec <> 8 then Exit; 1040 | if Description.GreenPrec <> 8 then Exit; 1041 | if Description.BluePrec <> 8 then Exit; 1042 | // G 1043 | if Description.GreenShift <> 8 then Exit; 1044 | // DeskBGR or DeskRGB 1045 | if (Description.RedShift = 16) and (Description.BlueShift = 0) then 1046 | Result := TDescriptionType.DeskBGR 1047 | else if (Description.RedShift = 0) and (Description.BlueShift = 16) then 1048 | Result := TDescriptionType.DeskRGB 1049 | else 1050 | Result := TDescriptionType.DeskOther; 1051 | end else 1052 | Result := TDescriptionType.DeskOther; 1053 | end; 1054 | 1055 | procedure BitmapDataMap(out BitmapData: TBitmapData; const Bitmap: TBitmap; const Mode: TAccessMode; 1056 | const UseAlpha: Boolean; const Background: TColor); 1057 | begin 1058 | BitmapData.FBitmap := Bitmap; 1059 | BitmapData.FAccessMode := Mode; 1060 | BitmapData.FHasAlpha := UseAlpha; 1061 | BitmapData.FWidth := Bitmap.Width; 1062 | BitmapData.FHeight := Bitmap.Height; 1063 | 1064 | SetLength(BitmapData.FDataArray, BitmapData.FHeight * BitmapData.FWidth); 1065 | if Length(BitmapData.FDataArray) > 0 then 1066 | BitmapData.FData := @(BitmapData.FDataArray[0]) 1067 | else 1068 | BitmapData.FData := nil; 1069 | 1070 | if (BitmapData.FData <> nil) and (BitmapData.FAccessMode in [TAccessMode.ReadWrite, TAccessMode.Read]) then 1071 | begin 1072 | case CalcDescriptionType(BitmapData.FBitmap.RawImage.Description, True) of 1073 | TDescriptionType.DeskRGB: 1074 | if BitmapData.FHasAlpha then 1075 | ReadDataRGBOpaque(BitmapData) 1076 | else 1077 | ReadDataRGB(BitmapData); 1078 | 1079 | TDescriptionType.DeskBGR: 1080 | if BitmapData.FHasAlpha then 1081 | ReadDataBGROpaque(BitmapData) 1082 | else 1083 | ReadDataBGR(BitmapData); 1084 | 1085 | TDescriptionType.DeskRGBA: 1086 | if BitmapData.FHasAlpha then 1087 | ReadDataRGBA(BitmapData) 1088 | else 1089 | begin 1090 | if Background <> clNone then 1091 | begin 1092 | ReadDataRGBA(BitmapData); 1093 | BlendData(BitmapData, Background); 1094 | end else 1095 | ReadDataRGBN(BitmapData); 1096 | end; 1097 | 1098 | TDescriptionType.DeskBGRA: 1099 | if BitmapData.FHasAlpha then 1100 | ReadDataBGRA(BitmapData) 1101 | else 1102 | begin 1103 | if Background <> clNone then 1104 | begin 1105 | ReadDataBGRA(BitmapData); 1106 | BlendData(BitmapData, Background); 1107 | end else 1108 | ReadDataBGRN(BitmapData); 1109 | end; 1110 | 1111 | TDescriptionType.DeskRGBN: 1112 | if BitmapData.FHasAlpha then 1113 | ReadDataRGBNOpaque(BitmapData) 1114 | else 1115 | ReadDataRGBN(BitmapData); 1116 | 1117 | TDescriptionType.DeskBGRN: 1118 | if BitmapData.FHasAlpha then 1119 | ReadDataBGRNOpaque(BitmapData) 1120 | else 1121 | ReadDataBGRN(BitmapData); 1122 | 1123 | TDescriptionType.DeskOther: 1124 | ReadData(BitmapData); 1125 | end; 1126 | end; 1127 | end; 1128 | 1129 | procedure BitmapDataUnmap(var BitmapData: TBitmapData); 1130 | begin 1131 | try 1132 | if (BitmapData.FData <> nil) and (BitmapData.FAccessMode in [TAccessMode.ReadWrite, TAccessMode.Write]) then 1133 | begin 1134 | if BitmapData.FHasAlpha then 1135 | BitmapData.FBitmap.PixelFormat := pf32bit 1136 | else 1137 | BitmapData.FBitmap.PixelFormat := pf24bit; 1138 | 1139 | case CalcDescriptionType(BitmapData.FBitmap.RawImage.Description) of 1140 | TDescriptionType.DeskRGB: 1141 | WriteDataRGB(BitmapData); 1142 | 1143 | TDescriptionType.DeskBGR: 1144 | WriteDataBGR(BitmapData); 1145 | 1146 | TDescriptionType.DeskRGBA: 1147 | WriteDataRGBA(BitmapData); 1148 | 1149 | TDescriptionType.DeskBGRA: 1150 | WriteDataBGRA(BitmapData); 1151 | 1152 | TDescriptionType.DeskRGBN: 1153 | WriteDataRGBN(BitmapData); 1154 | 1155 | TDescriptionType.DeskBGRN: 1156 | WriteDataBGRN(BitmapData); 1157 | 1158 | TDescriptionType.DeskOther: 1159 | WriteData(BitmapData); 1160 | end; 1161 | end; 1162 | finally 1163 | Finalize(BitmapData.FDataArray); 1164 | end; 1165 | end; 1166 | 1167 | {$ELSE} 1168 | // DELPHI VCL ACCESS 1169 | 1170 | procedure ReadData(var BitmapData: TBitmapData); 1171 | var 1172 | TempBitmap: TBitmap; 1173 | X, Y: Integer; 1174 | pDst: PPixel; 1175 | pSrc: PByte; 1176 | begin 1177 | TempBitmap := TBitmap.Create(); 1178 | try 1179 | TempBitmap.Assign(BitmapData.FBitmap); 1180 | TempBitmap.PixelFormat := pf24bit; 1181 | 1182 | pDst := @(BitmapData.FData[0]); 1183 | for Y := 0 to BitmapData.FHeight - 1 do 1184 | begin 1185 | pSrc := TempBitmap.ScanLine[Y]; 1186 | for X := 0 to BitmapData.FWidth - 1 do 1187 | begin 1188 | pDst^ := pSrc[0] or (pSrc[1] shl 8) or (pSrc[2] shl 16); 1189 | Inc(pDst, 1); 1190 | Inc(pSrc, 3); 1191 | end; 1192 | end; 1193 | finally 1194 | TempBitmap.Free; 1195 | end; 1196 | end; 1197 | 1198 | procedure ReadDataOpaque(var BitmapData: TBitmapData); 1199 | var 1200 | TempBitmap: TBitmap; 1201 | X, Y: Integer; 1202 | pDst: PPixel; 1203 | pSrc: PByte; 1204 | begin 1205 | TempBitmap := TBitmap.Create(); 1206 | try 1207 | TempBitmap.Assign(BitmapData.FBitmap); 1208 | TempBitmap.PixelFormat := pf24bit; 1209 | 1210 | pDst := @(BitmapData.FData[0]); 1211 | for Y := 0 to BitmapData.FHeight - 1 do 1212 | begin 1213 | pSrc := TempBitmap.ScanLine[Y]; 1214 | for X := 0 to BitmapData.FWidth - 1 do 1215 | begin 1216 | pDst^ := pSrc[0] or (pSrc[1] shl 8) or (pSrc[2] shl 16) or $FF000000; 1217 | Inc(pDst, 1); 1218 | Inc(pSrc, 3); 1219 | end; 1220 | end; 1221 | finally 1222 | TempBitmap.Free; 1223 | end; 1224 | end; 1225 | 1226 | procedure ReadDataBGR(var BitmapData: TBitmapData); 1227 | var 1228 | X, Y: Integer; 1229 | pDst: PPixel; 1230 | pSrc: PByte; 1231 | begin 1232 | pDst := @(BitmapData.FData[0]); 1233 | for Y := 0 to BitmapData.FHeight - 1 do 1234 | begin 1235 | pSrc := BitmapData.FBitmap.ScanLine[Y]; 1236 | for X := 0 to BitmapData.FWidth - 1 do 1237 | begin 1238 | pDst^ := pSrc[0] or (pSrc[1] shl 8) or (pSrc[2] shl 16); 1239 | Inc(pDst, 1); 1240 | Inc(pSrc, 3); 1241 | end; 1242 | end; 1243 | end; 1244 | 1245 | procedure ReadDataBGROpaque(var BitmapData: TBitmapData); 1246 | var 1247 | X, Y: Integer; 1248 | pDst: PPixel; 1249 | pSrc: PByte; 1250 | begin 1251 | pDst := @(BitmapData.FData[0]); 1252 | for Y := 0 to BitmapData.FHeight - 1 do 1253 | begin 1254 | pSrc := BitmapData.FBitmap.ScanLine[Y]; 1255 | for X := 0 to BitmapData.FWidth - 1 do 1256 | begin 1257 | pDst^ := pSrc[0] or (pSrc[1] shl 8) or (pSrc[2] shl 16) or $FF000000; 1258 | Inc(pDst, 1); 1259 | Inc(pSrc, 3); 1260 | end; 1261 | end; 1262 | end; 1263 | 1264 | procedure ReadDataBGRA(var BitmapData: TBitmapData);// fast 1265 | var 1266 | Y: Integer; 1267 | pDst: PPixel; 1268 | pSrc: PPixel; 1269 | begin 1270 | for Y := 0 to BitmapData.FHeight - 1 do 1271 | begin 1272 | pSrc := BitmapData.FBitmap.ScanLine[Y]; 1273 | pDst := @(BitmapData.FData[BitmapData.FWidth * Y]); 1274 | Move(pSrc^, pDst^, BitmapData.FWidth * SizeOf(TPixel)); 1275 | end; 1276 | end; 1277 | 1278 | procedure ReadDataPremultipliedBGRA(var BitmapData: TBitmapData);// slow 1279 | var 1280 | X, Y: Integer; 1281 | pDst: PPixel; 1282 | pSrc: PPixel; 1283 | Pixel: TPixelRec; 1284 | begin 1285 | pDst := @(BitmapData.FData[0]); 1286 | for Y := 0 to BitmapData.FHeight - 1 do 1287 | begin 1288 | pSrc := BitmapData.FBitmap.ScanLine[Y]; 1289 | for X := 0 to BitmapData.FWidth - 1 do 1290 | begin 1291 | Pixel := pSrc^; 1292 | if Pixel.A = 0 then 1293 | begin 1294 | Pixel.Color := $00000000; 1295 | end else 1296 | begin 1297 | Pixel.R := MulDiv(Pixel.R, 255, Pixel.A); 1298 | Pixel.G := MulDiv(Pixel.G, 255, Pixel.A); 1299 | Pixel.B := MulDiv(Pixel.B, 255, Pixel.A); 1300 | end; 1301 | pDst^ := Pixel; 1302 | Inc(pDst, 1); 1303 | Inc(pSrc, 1); 1304 | end; 1305 | end; 1306 | end; 1307 | 1308 | procedure ReadDataBGRN(var BitmapData: TBitmapData); 1309 | var 1310 | X, Y: Integer; 1311 | pDst: PPixel; 1312 | pSrc: PPixel; 1313 | begin 1314 | pDst := @(BitmapData.FData[0]); 1315 | for Y := 0 to BitmapData.FHeight - 1 do 1316 | begin 1317 | pSrc := BitmapData.FBitmap.ScanLine[Y]; 1318 | for X := 0 to BitmapData.FWidth - 1 do 1319 | begin 1320 | pDst^ := pSrc^ and $00FFFFFF; 1321 | Inc(pDst, 1); 1322 | Inc(pSrc, 1); 1323 | end; 1324 | end; 1325 | end; 1326 | 1327 | procedure WriteDataBGRA(var BitmapData: TBitmapData);// fast 1328 | var 1329 | Y: Integer; 1330 | pDst: PPixel; 1331 | pSrc: PPixel; 1332 | begin 1333 | for Y := 0 to BitmapData.FHeight - 1 do 1334 | begin 1335 | pSrc := @(BitmapData.FData[BitmapData.FWidth * Y]); 1336 | pDst := BitmapData.FBitmap.ScanLine[Y]; 1337 | Move(pSrc^, pDst^, BitmapData.FWidth * SizeOf(TPixel)); 1338 | end; 1339 | end; 1340 | 1341 | procedure WriteDataPremultipliedBGRA(var BitmapData: TBitmapData);// slow 1342 | var 1343 | X, Y: Integer; 1344 | pDst: PPixel; 1345 | pSrc: PPixel; 1346 | Pixel: TPixelRec; 1347 | begin 1348 | pSrc := @(BitmapData.FData[0]); 1349 | for Y := 0 to BitmapData.FHeight - 1 do 1350 | begin 1351 | pDst := BitmapData.FBitmap.ScanLine[Y]; 1352 | for X := 0 to BitmapData.FWidth - 1 do 1353 | begin 1354 | Pixel := pSrc^; 1355 | Pixel.R := MulDiv(Pixel.R, Pixel.A, 255); 1356 | Pixel.G := MulDiv(Pixel.G, Pixel.A, 255); 1357 | Pixel.B := MulDiv(Pixel.B, Pixel.A, 255); 1358 | pDst^ := Pixel; 1359 | Inc(pDst, 1); 1360 | Inc(pSrc, 1); 1361 | end; 1362 | end; 1363 | end; 1364 | 1365 | procedure WriteDataBGR(var BitmapData: TBitmapData); 1366 | var 1367 | X, Y: Integer; 1368 | pDst: PByte; 1369 | pSrc: PPixel; 1370 | begin 1371 | pSrc := @(BitmapData.FData[0]); 1372 | for Y := 0 to BitmapData.FHeight - 1 do 1373 | begin 1374 | pDst := BitmapData.FBitmap.ScanLine[Y]; 1375 | for X := 0 to BitmapData.FWidth - 1 do 1376 | begin 1377 | pDst[0] := pSrc^ and $FF; 1378 | pDst[1] := (pSrc^ shr 8) and $FF; 1379 | pDst[2] := (pSrc^ shr 16) and $FF; 1380 | Inc(pDst, 3); 1381 | Inc(pSrc, 1); 1382 | end; 1383 | end; 1384 | end; 1385 | 1386 | procedure BitmapDataMap(out BitmapData: TBitmapData; const Bitmap: TBitmap; const Mode: TAccessMode; 1387 | const UseAlpha: Boolean; const Background: TColor); 1388 | begin 1389 | BitmapData.FBitmap := Bitmap; 1390 | BitmapData.FAccessMode := Mode; 1391 | BitmapData.FHasAlpha := UseAlpha; 1392 | BitmapData.FWidth := Bitmap.Width; 1393 | BitmapData.FHeight := Bitmap.Height; 1394 | 1395 | SetLength(BitmapData.FDataArray, BitmapData.FHeight * BitmapData.FWidth); 1396 | if Length(BitmapData.FDataArray) > 0 then 1397 | BitmapData.FData := @(BitmapData.FDataArray[0]) 1398 | else 1399 | BitmapData.FData := nil; 1400 | 1401 | if (BitmapData.FData <> nil) and (BitmapData.FAccessMode in [TAccessMode.ReadWrite, TAccessMode.Read]) then 1402 | begin 1403 | case BitmapData.FBitmap.PixelFormat of 1404 | pfDevice, 1405 | pf1bit, 1406 | pf4bit, 1407 | pf8bit, 1408 | pf15bit, 1409 | pf16bit, 1410 | pfCustom: 1411 | if BitmapData.FHasAlpha then 1412 | ReadDataOpaque(BitmapData) 1413 | else 1414 | ReadData(BitmapData); 1415 | 1416 | pf24bit: 1417 | if BitmapData.FHasAlpha then 1418 | ReadDataBGROpaque(BitmapData) 1419 | else 1420 | ReadDataBGR(BitmapData); 1421 | 1422 | pf32bit: 1423 | if BitmapData.FHasAlpha then 1424 | begin 1425 | if BitmapData.FBitmap.AlphaFormat = afIgnored then 1426 | ReadDataBGRA(BitmapData) 1427 | else 1428 | ReadDataPremultipliedBGRA(BitmapData); 1429 | end 1430 | else 1431 | if Background <> clNone then 1432 | begin 1433 | if BitmapData.FBitmap.AlphaFormat = afIgnored then 1434 | ReadDataBGRA(BitmapData) 1435 | else 1436 | ReadDataPremultipliedBGRA(BitmapData); 1437 | BlendData(BitmapData, Background); 1438 | end else 1439 | ReadDataBGRN(BitmapData); 1440 | end; 1441 | end; 1442 | end; 1443 | 1444 | type 1445 | TOpenBitmap = class(TBitmap); 1446 | 1447 | procedure BitmapDataUnmap(var BitmapData: TBitmapData); 1448 | begin 1449 | try 1450 | if (BitmapData.FData <> nil) and (BitmapData.FAccessMode in [TAccessMode.ReadWrite, TAccessMode.Write]) then 1451 | begin 1452 | if BitmapData.FHasAlpha then 1453 | begin 1454 | if (BitmapData.FBitmap.PixelFormat = pf32bit) and (BitmapData.FBitmap.AlphaFormat = afIgnored) then 1455 | begin 1456 | WriteDataBGRA(BitmapData);// fast way 1457 | end else 1458 | begin 1459 | BitmapData.FBitmap.PixelFormat := pf32bit; 1460 | TOpenBitmap(BitmapData.FBitmap).FAlphaFormat := afPremultiplied; 1461 | WriteDataPremultipliedBGRA(BitmapData); 1462 | end; 1463 | end else 1464 | begin 1465 | BitmapData.FBitmap.PixelFormat := pf24bit; 1466 | WriteDataBGR(BitmapData); 1467 | end; 1468 | 1469 | BitmapData.FBitmap.Modified := True; 1470 | end; 1471 | finally 1472 | Finalize(BitmapData.FDataArray); 1473 | end; 1474 | end; 1475 | {$ENDIF} 1476 | 1477 | { TPixelRec } 1478 | 1479 | constructor TPixelRec.Create(const R, G, B: Byte; const A: Byte); 1480 | begin 1481 | Self.Color := B or (G shl 8) or (R shl 16) or (A shl 24); 1482 | end; 1483 | 1484 | class operator TPixelRec.Implicit(Pixel: TPixel): TPixelRec; 1485 | begin 1486 | Result.Color := Pixel; 1487 | end; 1488 | 1489 | class operator TPixelRec.Implicit(Pixel: TPixelRec): TPixel; 1490 | begin 1491 | Result := Pixel.Color; 1492 | end; 1493 | 1494 | { TBitmapData } 1495 | 1496 | function TBitmapData.GetPixel(X, Y: Integer): TPixel; 1497 | begin 1498 | if (X < 0) or (X >= Self.Width) or (Y < 0) or (Y >= Self.Height) then Exit(0); 1499 | Result := Self.Data[Y * Self.Width + X]; 1500 | end; 1501 | 1502 | procedure TBitmapData.SetPixel(X, Y: Integer; AValue: TPixel); 1503 | begin 1504 | if (X < 0) or (X >= Self.Width) or (Y < 0) or (Y >= Self.Height) then Exit; 1505 | Self.Data[Y * Self.Width + X] := AValue; 1506 | end; 1507 | 1508 | function TBitmapData.GetPixelUnsafe(X, Y: Integer): TPixel; 1509 | begin 1510 | Result := Self.Data[Y * Self.Width + X]; 1511 | end; 1512 | 1513 | procedure TBitmapData.SetPixelUnsafe(X, Y: Integer; AValue: TPixel); 1514 | begin 1515 | Self.Data[Y * Self.Width + X] := AValue; 1516 | end; 1517 | 1518 | procedure TBitmapData.Init(); 1519 | begin 1520 | Self := Default(TBitmapData); 1521 | end; 1522 | 1523 | procedure TBitmapData.Map(const Bitmap: TBitmap; const Mode: TAccessMode; const UseAlpha: Boolean; 1524 | const Background: TColor = clNone); 1525 | begin 1526 | BitmapDataMap(Self, Bitmap, Mode, UseAlpha, Background); 1527 | end; 1528 | 1529 | procedure TBitmapData.Unmap(); 1530 | begin 1531 | BitmapDataUnmap(Self); 1532 | end; 1533 | 1534 | end. 1535 | 1536 | --------------------------------------------------------------------------------