├── .gitignore
├── BitmapPixels.pas
├── LICENSE
├── README.md
├── Res
├── 0.png
├── 1.png
├── 2.png
└── 3.png
├── SortingPixels.exe
├── SortingPixels.ico
├── SortingPixels.lpi
├── SortingPixels.lpr
├── SortingPixelsAlgorithm.pas
├── UnitMain.lfm
├── UnitMain.pas
├── other_langs
└── readme.md
├── samples
├── 0.bmp
├── 0.png
├── 1.bmp
├── 1.png
├── 10.bmp
├── 10.png
├── 11.bmp
├── 11.png
├── 12.bmp
├── 12.png
├── 13.bmp
├── 13.png
├── 14.bmp
├── 14.png
├── 2.bmp
├── 2.png
├── 3.bmp
├── 3.png
├── 4.bmp
├── 4.png
├── 5.bmp
├── 5.png
├── 6.bmp
├── 6.png
├── 7.bmp
├── 7.png
├── 8.bmp
├── 8.png
├── 9.bmp
└── 9.png
└── scr.png
/.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 |
--------------------------------------------------------------------------------
/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 |
--------------------------------------------------------------------------------
/LICENSE:
--------------------------------------------------------------------------------
1 | MIT License
2 |
3 | Copyright (c) 2024 turborium
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 | # SortingPixels
2 |
3 | [Powered By Lazarus (ObjectPascal)](https://www.lazarus-ide.org/)
4 |
5 | 
6 |
7 | Powered By Lazarus (ObjectPascal) and [✅GDD Methodology✅](https://github.com/turborium/gdd)
8 |
9 | Compiled EXE(Windows): https://github.com/turborium/SortingPixels/raw/main/SortingPixels.exe
10 |
11 | Inspired by
12 | - https://github.com/kimasendorf/ASDFPixelSort
13 | - https://ashlynsart.wordpress.com/wp-content/uploads/2018/09/art-120-kim-asendorf.pdf
14 | - https://www.youtube.com/watch?v=HMmmBDRy-jE
15 |
16 | Прочие яп в папке "other_langs"
17 |
--------------------------------------------------------------------------------
/Res/0.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/turborium/SortingPixels/89a741783b7e56614eada2daab86370890fa44c4/Res/0.png
--------------------------------------------------------------------------------
/Res/1.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/turborium/SortingPixels/89a741783b7e56614eada2daab86370890fa44c4/Res/1.png
--------------------------------------------------------------------------------
/Res/2.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/turborium/SortingPixels/89a741783b7e56614eada2daab86370890fa44c4/Res/2.png
--------------------------------------------------------------------------------
/Res/3.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/turborium/SortingPixels/89a741783b7e56614eada2daab86370890fa44c4/Res/3.png
--------------------------------------------------------------------------------
/SortingPixels.exe:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/turborium/SortingPixels/89a741783b7e56614eada2daab86370890fa44c4/SortingPixels.exe
--------------------------------------------------------------------------------
/SortingPixels.ico:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/turborium/SortingPixels/89a741783b7e56614eada2daab86370890fa44c4/SortingPixels.ico
--------------------------------------------------------------------------------
/SortingPixels.lpi:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
10 |
11 |
12 |
13 |
14 |
15 |
16 |
17 |
18 |
19 |
20 |
21 |
22 |
23 |
24 |
25 |
26 |
27 |
28 |
29 |
30 |
31 |
32 |
33 |
34 |
35 |
36 | -
37 |
38 |
39 |
40 |
41 |
42 |
43 |
44 |
45 |
46 |
47 |
48 |
49 |
50 |
51 |
52 |
53 |
54 |
55 |
56 |
57 |
58 |
59 |
60 |
61 |
62 |
63 |
64 |
65 |
66 |
67 |
68 |
69 |
70 |
71 |
72 |
73 |
74 |
75 |
76 |
77 |
78 |
79 |
80 |
81 | -
82 |
83 |
84 |
85 |
86 |
87 |
88 |
89 |
90 |
91 |
92 |
93 |
94 |
95 |
96 |
97 |
98 |
99 |
100 |
101 |
102 |
103 |
104 |
105 |
106 |
107 |
108 |
109 |
110 |
111 |
112 |
113 |
114 |
115 |
116 |
117 |
118 |
119 |
120 |
121 |
122 |
123 |
124 |
125 |
126 |
127 | -
128 |
129 |
130 | -
131 |
132 |
133 |
134 |
135 |
136 |
137 |
138 |
139 |
140 |
141 |
142 |
143 |
144 |
145 |
146 |
147 |
148 |
149 |
150 |
151 |
152 |
153 |
154 |
155 |
156 |
157 |
158 |
159 |
160 |
161 |
162 |
163 |
164 |
165 |
166 |
167 |
168 |
169 |
170 |
171 |
172 |
173 |
174 |
175 |
176 |
177 |
178 |
179 |
180 |
181 |
182 |
183 |
184 | -
185 |
186 |
187 | -
188 |
189 |
190 | -
191 |
192 |
193 |
194 |
195 |
196 |
--------------------------------------------------------------------------------
/SortingPixels.lpr:
--------------------------------------------------------------------------------
1 | program SortingPixels;
2 |
3 | {$mode objfpc}{$H+}
4 |
5 | uses
6 | {$IFDEF UNIX}
7 | cthreads,
8 | {$ENDIF}
9 | {$IFDEF HASAMIGA}
10 | athreads,
11 | {$ENDIF}
12 | Interfaces, // this includes the LCL widgetset
13 | Forms, imagesforlazarus, UnitMain, BitmapPixels, SortingPixelsAlgorithm
14 | { you can add units after this };
15 |
16 | {$R *.res}
17 |
18 | begin
19 | RequireDerivedFormResource := True;
20 | Application.Scaled := True;
21 | Application.Initialize;
22 | Application.CreateForm(TFormMain, FormMain);
23 | Application.Run;
24 | end.
25 |
26 |
--------------------------------------------------------------------------------
/SortingPixelsAlgorithm.pas:
--------------------------------------------------------------------------------
1 | // .d8888b. 8888888b. 8888888b. 888888b. d8888 .d8888b. 8888888888 8888888b.
2 | // d88P Y88b 888 "Y88b 888 "Y88b 888 "88b d88888 d88P Y88b 888 888 "Y88b
3 | // 888 888 888 888 888 888 888 .88P d88P888 Y88b. 888 888 888
4 | // 888 888 888 888 888 8888888K. d88P 888 "Y888b. 8888888 888 888
5 | // 888 88888 888 888 888 888 888 "Y88b d88P 888 "Y88b. 888 888 888
6 | // 888 888 888 888 888 888 888 888 d88P 888 "888 888 888 888
7 | // Y88b d88P 888 .d88P 888 .d88P 888 d88P d8888888888 Y88b d88P 888 888 .d88P
8 | // "Y8888P88 8888888P" 8888888P" 8888888P" d88P 888 "Y8888P" 8888888888 8888888P"
9 | //
10 | // Turborium(c) 2024-2024
11 |
12 | unit SortingPixelsAlgorithm;
13 |
14 | {$MODE DELPHIUNICODE}
15 | {$SCOPEDENUMS ON}
16 | {$DEFINE STABLE}
17 |
18 | interface
19 |
20 | uses
21 | Classes, SysUtils, Generics.Defaults, Generics.Collections, BitmapPixels;
22 |
23 | type
24 | TSortingDirection = (Left, Up, Right, Down);
25 |
26 | procedure ImageSortingPixels(var Data: TBitmapData; Direction: TSortingDirection; ThresholdMin, ThresholdMax: Integer);
27 |
28 | function PixelBrightness(const Pixel: TPixelRec): Byte; inline;
29 |
30 | implementation
31 |
32 | function PixelBrightness(const Pixel: TPixelRec): Byte;
33 | begin
34 | Result := (299 * Pixel.R + 587 * Pixel.G + 114 * Pixel.B) div 1000;
35 | end;
36 |
37 | function CompareUp({$IFDEF STABLE}constref{$ELSE}const{$ENDIF} Left, Right: TPixelRec): Integer;
38 | begin
39 | Result := PixelBrightness(Right) - PixelBrightness(Left);
40 | end;
41 |
42 | function CompareDown({$IFDEF STABLE}constref{$ELSE}const{$ENDIF} Left, Right: TPixelRec): Integer;
43 | begin
44 | Result := PixelBrightness(Left) - PixelBrightness(Right);
45 | end;
46 |
47 | procedure ImageSortingPixels(var Data: TBitmapData; Direction: TSortingDirection; ThresholdMin, ThresholdMax: Integer);
48 | var
49 | X, Y, Brightness: Integer;
50 | Span: TArray;
51 | Len, TempX, I, TempY: Integer;
52 | Comparer: IComparer;
53 | begin
54 | // создаем компаратор для сортировки по убыванию или возрастанию
55 | if Direction in [TSortingDirection.Left, TSortingDirection.Up] then
56 | Comparer := TComparer.Construct(CompareUp)
57 | else
58 | Comparer := TComparer.Construct(CompareDown);
59 |
60 | if Direction in [TSortingDirection.Left, TSortingDirection.Right] then
61 | begin
62 | // проходимся по всем строкам изображения
63 | for Y := 0 to Data.Height - 1 do
64 | begin
65 | if TThread.CheckTerminated() then
66 | break;
67 |
68 | // обрабатываем строку в цикле
69 | X := 0;
70 | while X < Data.Width do
71 | begin
72 | // вычисляем длину непрерывного куска строки соответсвующего условиям
73 | Len := 0;
74 | TempX := X;
75 | while TempX < Data.Width do
76 | begin
77 | // даже если первый пиксел не соответсвует условиям, мы получим длину куска в единицу
78 | Len := Len + 1;
79 |
80 | // яркость пиксела
81 | Brightness := PixelBrightness(Data.Pixels[TempX, Y]);
82 |
83 | // не соответсвует усливию - выходим
84 | if Brightness < ThresholdMin then
85 | break;
86 | if Brightness > ThresholdMax then
87 | break;
88 |
89 | // следующий пиксель
90 | TempX := TempX + 1;
91 | end;
92 |
93 | // сортируем пикселы куска, если это имеет смысл
94 | if Len > 1 then
95 | begin
96 | // заполняем массив из изображения
97 | SetLength(Span, Len);
98 | for I := 0 to Len - 1 do
99 | begin
100 | Span[I] := Data.Pixels[X + I, Y];
101 | end;
102 |
103 | // сортируем
104 | TArrayHelper.Sort(Span, Comparer);
105 |
106 | // записываем отсортированные пикселы обратно
107 | for I := 0 to Len - 1 do
108 | begin
109 | Data.Pixels[X + I, Y] := Span[I];
110 | end;
111 | end;
112 |
113 | // пропускаем уже отсортированные пикселы
114 | X := X + Len;
115 | end;
116 | end;
117 | end else
118 | begin
119 | // проходимся по всем столбцам изображения
120 | for X := 0 to Data.Width - 1 do
121 | begin
122 | if TThread.CheckTerminated() then
123 | break;
124 |
125 | // обрабатываем столбец в цикле
126 | Y := 0;
127 | while Y < Data.Height do
128 | begin
129 | // вычисляем длину непрерывного куска столбца соответсвующего условиям
130 | Len := 0;
131 | TempY := Y;
132 | while TempY < Data.Height do
133 | begin
134 | // даже если первый пиксел не соответсвует условиям, мы получим длину куска в единицу
135 | Len := Len + 1;
136 |
137 | // яркость пиксела
138 | Brightness := PixelBrightness(Data.Pixels[X, TempY]);
139 |
140 | // не соответсвует усливию - выходим
141 | if Brightness < ThresholdMin then
142 | break;
143 | if Brightness > ThresholdMax then
144 | break;
145 |
146 | // следующий пиксель
147 | TempY := TempY + 1;
148 | end;
149 |
150 | // сортируем пикселы куска, если это имеет смысл
151 | if Len > 1 then
152 | begin
153 | // заполняем массив из изображения
154 | SetLength(Span, Len);
155 | for I := 0 to Len - 1 do
156 | begin
157 | Span[I] := Data.Pixels[X, Y + I];
158 | end;
159 |
160 | // сортируем
161 | TArrayHelper.Sort(Span, Comparer);
162 |
163 | // записываем отсортированные пикселы обратно
164 | for I := 0 to Len - 1 do
165 | begin
166 | Data.Pixels[X, Y + I] := Span[I];
167 | end;
168 | end;
169 |
170 | // пропускаем уже отсортированные пикселы
171 | Y := Y + Len;
172 | end;
173 | end;
174 | end;
175 | end;
176 |
177 |
178 | end.
179 |
180 |
--------------------------------------------------------------------------------
/UnitMain.lfm:
--------------------------------------------------------------------------------
1 | object FormMain: TFormMain
2 | Left = 519
3 | Height = 896
4 | Top = 250
5 | Width = 1410
6 | BorderWidth = 4
7 | Caption = 'Sorting Pixels By Turborium'
8 | ClientHeight = 896
9 | ClientWidth = 1410
10 | Constraints.MinHeight = 600
11 | Constraints.MinWidth = 1410
12 | DesignTimePPI = 154
13 | OnCreate = FormCreate
14 | OnDestroy = FormDestroy
15 | Position = poScreenCenter
16 | object ScrollBoxDisp: TScrollBox
17 | Left = 12
18 | Height = 718
19 | Top = 12
20 | Width = 1386
21 | HorzScrollBar.Page = 224
22 | HorzScrollBar.Tracking = True
23 | VertScrollBar.Page = 208
24 | VertScrollBar.Tracking = True
25 | Align = alClient
26 | BorderSpacing.Left = 8
27 | BorderSpacing.Top = 8
28 | BorderSpacing.Right = 8
29 | ClientHeight = 714
30 | ClientWidth = 1382
31 | TabOrder = 0
32 | object ImageDisp: TImage
33 | AnchorSideLeft.Control = ScrollBoxDisp
34 | AnchorSideTop.Control = ScrollBoxDisp
35 | Left = 0
36 | Height = 208
37 | Top = 0
38 | Width = 224
39 | end
40 | end
41 | object PanelParams: TPanel
42 | Left = 12
43 | Height = 146
44 | Top = 738
45 | Width = 1386
46 | Align = alBottom
47 | AutoSize = True
48 | BorderSpacing.Left = 8
49 | BorderSpacing.Top = 8
50 | BorderSpacing.Right = 8
51 | BorderSpacing.Bottom = 8
52 | BevelOuter = bvNone
53 | ChildSizing.Layout = cclTopToBottomThenLeftToRight
54 | ClientHeight = 146
55 | ClientWidth = 1386
56 | TabOrder = 1
57 | OnResize = PanelParamsResize
58 | object PanelFile: TPanel
59 | Left = 0
60 | Height = 146
61 | Top = 0
62 | Width = 143
63 | AutoSize = True
64 | BevelOuter = bvNone
65 | ChildSizing.EnlargeVertical = crsHomogenousSpaceResize
66 | ChildSizing.Layout = cclLeftToRightThenTopToBottom
67 | ClientHeight = 146
68 | ClientWidth = 143
69 | TabOrder = 0
70 | object ButtonOpen: TButton
71 | Left = 0
72 | Height = 39
73 | Top = 6
74 | Width = 143
75 | AutoSize = True
76 | BorderSpacing.InnerBorder = 2
77 | Caption = 'Open'
78 | TabOrder = 0
79 | OnClick = ButtonOpenClick
80 | end
81 | object ButtonOpenSample: TButton
82 | Left = 0
83 | Height = 39
84 | Top = 51
85 | Width = 143
86 | AutoSize = True
87 | BorderSpacing.Top = 4
88 | BorderSpacing.InnerBorder = 2
89 | Caption = 'Open Sample'
90 | TabOrder = 1
91 | OnClick = ButtonOpenSampleClick
92 | end
93 | object ButtonSave: TButton
94 | Left = 0
95 | Height = 39
96 | Top = 96
97 | Width = 143
98 | AutoSize = True
99 | BorderSpacing.Top = 4
100 | BorderSpacing.InnerBorder = 2
101 | Caption = 'Save'
102 | TabOrder = 2
103 | OnClick = ButtonSaveClick
104 | end
105 | end
106 | object GroupBoxTrashhold: TGroupBox
107 | Left = 159
108 | Height = 146
109 | Top = 0
110 | Width = 402
111 | BorderSpacing.Left = 16
112 | Caption = 'Treshold'
113 | ChildSizing.EnlargeVertical = crsHomogenousSpaceResize
114 | ChildSizing.Layout = cclLeftToRightThenTopToBottom
115 | ChildSizing.ControlsPerLine = 3
116 | ClientHeight = 116
117 | ClientWidth = 398
118 | TabOrder = 1
119 | object LabelThresholdMinCaption: TLabel
120 | Left = 4
121 | Height = 40
122 | Top = 11
123 | Width = 50
124 | BorderSpacing.Left = 4
125 | Caption = 'Min:'
126 | Constraints.MinWidth = 50
127 | Layout = tlCenter
128 | end
129 | object TrackBarThresholdMin: TTrackBar
130 | AnchorSideLeft.Side = asrBottom
131 | Left = 54
132 | Height = 40
133 | Top = 11
134 | Width = 300
135 | AutoSize = True
136 | Frequency = 16
137 | Max = 255
138 | OnChange = TrackBarThresholdMinChange
139 | PageSize = 1
140 | Position = 0
141 | ShowSelRange = False
142 | BorderSpacing.Right = 4
143 | Constraints.MinWidth = 300
144 | TabOrder = 0
145 | end
146 | object LabelThresholdMin: TLabel
147 | Left = 358
148 | Height = 40
149 | Top = 11
150 | Width = 40
151 | Caption = '255'
152 | Constraints.MaxWidth = 40
153 | Constraints.MinWidth = 40
154 | Layout = tlCenter
155 | end
156 | object LabelThresholdMaxCaption: TLabel
157 | Left = 4
158 | Height = 40
159 | Top = 62
160 | Width = 50
161 | BorderSpacing.Left = 4
162 | BorderSpacing.Top = 4
163 | Caption = 'Max:'
164 | Constraints.MinWidth = 50
165 | Layout = tlCenter
166 | end
167 | object TrackBarThresholdMax: TTrackBar
168 | AnchorSideLeft.Side = asrBottom
169 | Left = 54
170 | Height = 40
171 | Top = 62
172 | Width = 300
173 | AutoSize = True
174 | Frequency = 16
175 | Max = 255
176 | OnChange = TrackBarThresholdMaxChange
177 | PageSize = 1
178 | Position = 255
179 | ShowSelRange = False
180 | BorderSpacing.Top = 4
181 | BorderSpacing.Right = 4
182 | Constraints.MinWidth = 300
183 | TabOrder = 1
184 | end
185 | object LabelThresholdMax: TLabel
186 | Left = 358
187 | Height = 40
188 | Top = 62
189 | Width = 40
190 | Caption = '255'
191 | Constraints.MaxWidth = 40
192 | Constraints.MinWidth = 40
193 | Layout = tlCenter
194 | end
195 | end
196 | object GroupBoxSortDirection: TGroupBox
197 | Left = 565
198 | Height = 146
199 | Top = 0
200 | Width = 324
201 | BorderSpacing.Left = 4
202 | Caption = 'Sort Direction'
203 | ChildSizing.EnlargeHorizontal = crsHomogenousSpaceResize
204 | ChildSizing.EnlargeVertical = crsHomogenousSpaceResize
205 | ChildSizing.Layout = cclLeftToRightThenTopToBottom
206 | ClientHeight = 116
207 | ClientWidth = 320
208 | TabOrder = 2
209 | object PanelSortDirection: TPanel
210 | Left = 4
211 | Height = 105
212 | Top = 6
213 | Width = 312
214 | AutoSize = True
215 | BorderSpacing.Left = 4
216 | BorderSpacing.Right = 4
217 | BevelOuter = bvNone
218 | ClientHeight = 105
219 | ClientWidth = 312
220 | TabOrder = 0
221 | object BitBtnUp: TBitBtn
222 | AnchorSideLeft.Control = BitBtnLeft
223 | AnchorSideLeft.Side = asrBottom
224 | AnchorSideTop.Control = PanelSortDirection
225 | Left = 104
226 | Height = 35
227 | Top = 0
228 | Width = 104
229 | AutoSize = True
230 | Caption = 'Up'
231 | Constraints.MaxWidth = 104
232 | Constraints.MinWidth = 104
233 | Margin = 4
234 | Images = ImageListSortDirection
235 | ImageIndex = 1
236 | OnClick = BitBtnUpClick
237 | TabOrder = 1
238 | end
239 | object BitBtnDown: TBitBtn
240 | AnchorSideLeft.Control = BitBtnLeft
241 | AnchorSideLeft.Side = asrBottom
242 | AnchorSideTop.Control = BitBtnLeft
243 | AnchorSideTop.Side = asrBottom
244 | Left = 104
245 | Height = 35
246 | Top = 70
247 | Width = 104
248 | AutoSize = True
249 | Caption = 'Down'
250 | Constraints.MaxWidth = 104
251 | Constraints.MinWidth = 104
252 | Margin = 4
253 | Images = ImageListSortDirection
254 | ImageIndex = 3
255 | OnClick = BitBtnDownClick
256 | TabOrder = 3
257 | end
258 | object BitBtnRight: TBitBtn
259 | AnchorSideLeft.Control = BitBtnUp
260 | AnchorSideLeft.Side = asrBottom
261 | AnchorSideTop.Control = BitBtnUp
262 | AnchorSideTop.Side = asrBottom
263 | Left = 208
264 | Height = 35
265 | Top = 35
266 | Width = 104
267 | AutoSize = True
268 | Caption = 'Right'
269 | Constraints.MaxWidth = 104
270 | Constraints.MinWidth = 104
271 | Margin = 4
272 | Images = ImageListSortDirection
273 | ImageIndex = 2
274 | OnClick = BitBtnRightClick
275 | TabOrder = 2
276 | end
277 | object BitBtnLeft: TBitBtn
278 | AnchorSideLeft.Control = PanelSortDirection
279 | AnchorSideTop.Control = BitBtnUp
280 | AnchorSideTop.Side = asrBottom
281 | Left = 0
282 | Height = 35
283 | Top = 35
284 | Width = 104
285 | AutoSize = True
286 | Caption = 'Left'
287 | Constraints.MaxWidth = 104
288 | Constraints.MinWidth = 104
289 | Margin = 4
290 | Images = ImageListSortDirection
291 | ImageIndex = 0
292 | OnClick = BitBtnLeftClick
293 | TabOrder = 0
294 | end
295 | end
296 | end
297 | object GroupBoxImageScale: TGroupBox
298 | Left = 893
299 | Height = 146
300 | Top = 0
301 | Width = 212
302 | AutoSize = True
303 | BorderSpacing.Left = 4
304 | Caption = 'Image Scale'
305 | ChildSizing.EnlargeHorizontal = crsHomogenousSpaceResize
306 | ChildSizing.EnlargeVertical = crsHomogenousSpaceResize
307 | ChildSizing.Layout = cclLeftToRightThenTopToBottom
308 | ClientHeight = 116
309 | ClientWidth = 208
310 | TabOrder = 3
311 | object TrackBarImageScale: TTrackBar
312 | Left = 4
313 | Height = 40
314 | Top = 17
315 | Width = 200
316 | Frequency = 10
317 | Max = 100
318 | Min = 1
319 | OnChange = TrackBarImageScaleChange
320 | Position = 10
321 | ShowSelRange = False
322 | BorderSpacing.Left = 4
323 | BorderSpacing.Right = 4
324 | Constraints.MinWidth = 200
325 | TabOrder = 0
326 | end
327 | object LabelScale: TLabel
328 | Left = 4
329 | Height = 25
330 | Top = 74
331 | Width = 200
332 | Alignment = taCenter
333 | Caption = 'LabelScale'
334 | end
335 | end
336 | object RadioGroupViewScale: TRadioGroup
337 | Left = 1121
338 | Height = 146
339 | Top = 0
340 | Width = 109
341 | AutoFill = True
342 | BorderSpacing.Left = 16
343 | Caption = 'View Scale'
344 | ChildSizing.LeftRightSpacing = 6
345 | ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
346 | ChildSizing.EnlargeVertical = crsHomogenousSpaceResize
347 | ChildSizing.ShrinkHorizontal = crsScaleChilds
348 | ChildSizing.ShrinkVertical = crsScaleChilds
349 | ChildSizing.Layout = cclLeftToRightThenTopToBottom
350 | ChildSizing.ControlsPerLine = 1
351 | ClientHeight = 116
352 | ClientWidth = 105
353 | Items.Strings = (
354 | '1x'
355 | '2x'
356 | '3x'
357 | '4x'
358 | )
359 | OnClick = RadioGroupViewScaleClick
360 | TabOrder = 4
361 | end
362 | object RadioGroupSaveScale: TRadioGroup
363 | Left = 1234
364 | Height = 146
365 | Top = 0
366 | Width = 107
367 | AutoFill = True
368 | AutoSize = True
369 | BorderSpacing.Left = 4
370 | Caption = 'Save Scale'
371 | ChildSizing.LeftRightSpacing = 6
372 | ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
373 | ChildSizing.EnlargeVertical = crsHomogenousChildResize
374 | ChildSizing.ShrinkHorizontal = crsScaleChilds
375 | ChildSizing.ShrinkVertical = crsScaleChilds
376 | ChildSizing.Layout = cclLeftToRightThenTopToBottom
377 | ChildSizing.ControlsPerLine = 1
378 | ClientHeight = 116
379 | ClientWidth = 103
380 | Items.Strings = (
381 | '1x'
382 | '2x'
383 | '3x'
384 | '4x'
385 | )
386 | OnClick = RadioGroupSaveScaleClick
387 | TabOrder = 5
388 | end
389 | object GroupBoxAutoShow: TGroupBox
390 | Left = 1345
391 | Height = 146
392 | Top = 0
393 | Width = 258
394 | BorderSpacing.Left = 4
395 | Caption = 'Auto Show'
396 | ChildSizing.EnlargeVertical = crsHomogenousSpaceResize
397 | ChildSizing.Layout = cclLeftToRightThenTopToBottom
398 | ClientHeight = 116
399 | ClientWidth = 254
400 | TabOrder = 6
401 | object PanelAutoShow: TPanel
402 | Left = 2
403 | Height = 109
404 | Top = 4
405 | Width = 250
406 | AutoSize = True
407 | BorderSpacing.Left = 2
408 | BorderSpacing.Right = 2
409 | BevelOuter = bvNone
410 | ClientHeight = 109
411 | ClientWidth = 250
412 | TabOrder = 0
413 | object CheckBoxAutoShowEnabled: TCheckBox
414 | AnchorSideLeft.Control = PanelAutoShow
415 | AnchorSideTop.Control = PanelAutoShow
416 | Left = 0
417 | Height = 29
418 | Top = 0
419 | Width = 66
420 | Caption = 'Auto'
421 | TabOrder = 0
422 | OnChange = CheckBoxAutoShowEnabledChange
423 | end
424 | object LabelAutoShowMinRange: TLabel
425 | AnchorSideLeft.Control = PanelAutoShow
426 | AnchorSideTop.Control = TrackBarAutoShowTresholdMin
427 | AnchorSideTop.Side = asrCenter
428 | Left = 0
429 | Height = 25
430 | Top = 38
431 | Width = 50
432 | BorderSpacing.Top = 2
433 | Caption = 'Min:'
434 | Constraints.MaxWidth = 50
435 | Constraints.MinWidth = 50
436 | end
437 | object TrackBarAutoShowTresholdMin: TTrackBar
438 | AnchorSideLeft.Control = LabelAutoShowMinRange
439 | AnchorSideLeft.Side = asrBottom
440 | AnchorSideTop.Control = CheckBoxAutoShowEnabled
441 | AnchorSideTop.Side = asrBottom
442 | Left = 50
443 | Height = 38
444 | Top = 31
445 | Width = 200
446 | Frequency = 16
447 | Max = 255
448 | OnChange = TrackBarAutoShowTresholdMinChange
449 | PageSize = 1
450 | Position = 0
451 | ShowSelRange = False
452 | BorderSpacing.Top = 2
453 | Constraints.MaxHeight = 38
454 | Constraints.MinWidth = 200
455 | TabOrder = 1
456 | end
457 | object LabelAutoShowMaxRange: TLabel
458 | AnchorSideLeft.Control = PanelAutoShow
459 | AnchorSideTop.Control = TrackBarAutoShowTresholdMax
460 | AnchorSideTop.Side = asrCenter
461 | Left = 0
462 | Height = 25
463 | Top = 78
464 | Width = 50
465 | Caption = 'Max:'
466 | Constraints.MaxWidth = 50
467 | Constraints.MinWidth = 50
468 | end
469 | object TrackBarAutoShowTresholdMax: TTrackBar
470 | AnchorSideLeft.Control = LabelAutoShowMaxRange
471 | AnchorSideLeft.Side = asrBottom
472 | AnchorSideTop.Control = TrackBarAutoShowTresholdMin
473 | AnchorSideTop.Side = asrBottom
474 | Left = 50
475 | Height = 38
476 | Top = 71
477 | Width = 200
478 | Frequency = 16
479 | Max = 255
480 | OnChange = TrackBarAutoShowTresholdMaxChange
481 | PageSize = 1
482 | Position = 0
483 | ShowSelRange = False
484 | BorderSpacing.Top = 2
485 | Constraints.MaxHeight = 38
486 | Constraints.MinWidth = 200
487 | TabOrder = 2
488 | end
489 | end
490 | end
491 | end
492 | object PopupMenuSample: TPopupMenu
493 | Images = ImageListSample
494 | Left = 424
495 | Top = 368
496 | end
497 | object ImageListSortDirection: TImageList
498 | Scaled = True
499 | Left = 160
500 | Top = 368
501 | Bitmap = {
502 | 4C7A040000001000000010000000CC0000000000000078DAED96311180301004
503 | 3B242001094888042C2021169080845840021290808454C7AC86AD9849B1E543
504 | F27F97BFDE7BDEF7CDF33CB9EF3BD775A5B596F33C731C476AADD9F73DDBB6A5
505 | 9492755DB32C4BE679CE344DE9A37ED48FFA5FD71BF8B781731BB8B3817E19E8
506 | B581391998B1017D18D096015D1AD0B4013F18F092011F1AF0B085EF7016EE43
507 | 4FE82BB361BE68049DA155F48E67F01DDEC5FFA37ED48FFA7FD7DBB7C360DF4F
508 | FB7EDBFD61F797DD9F767FDBFC60F38BCD4F36BFD9FC68F3ABCDCF36BF7FB890
509 | F5C8
510 | }
511 | BitmapAdv = {
512 | 4C69020000004C7A040000001800000018000000680100000000000078DAEDD9
513 | 2D0F82601405E04EA441331369D234190D4446B2102934379A8548A049A41049
514 | D8B419CD346C44F27187FF7036C30DCF6C67EEE5BD1FE2BAAE589605DFEF179F
515 | CF07EFF71BAFD70BCFE713C330A0EB3AB46D8BBAAE71BBDD509625F23CC7E572
516 | 419AA6389FCF381E8F381C0E88A208611862B7DBC1F77DB8AE8BD5F22DDFF22D
517 | DFF22DDFF22DFF0FF395F8DD95782E4A3C73253E4F25DE1525DE4325DE7125D6
518 | 8F126B538975AFC49EA2C47EA5C45EA8C43EABC41EAEC4F9A0C4D9A3C4B9A6C4
519 | 99A9C479ACC459AFC43D42893B8A92E338DBA7E7790882603BB3FD7EBF3D9BD3
520 | E984388E912409B22C435114B85EAFA8AA0A4DD3E07EBFA3EF7B8CE388C7E3B1
521 | CD2BCEDC699A30CFF3B69F58BEE55BBEE55BBEE55BBEE5FF63BE927A7FE3B928
522 | F1CC95D4FB3FEF8A92FAF711EFB812EB4789B5A9C4BA57624F5162BF52622F54
523 | 629F55620F57E27C50E2EC51E25C5352BFDF56BFFFE7AC57E21EA1A4FEFFE807
524 | 2988691B4C7A040000002000000020000000FE0100000000000078DAEDD7B1AB
525 | 81611805F0F59649168345596E99A464609041168345268345599445D9944559
526 | 9445996452261964609092495994C560914919CFEDFC13F72C67F8CDA7EFFBDE
527 | EF799FF3F97CF0FD7EF1783CF07C3E71B95C70BD5EB1DFEF71381C703C1EB15A
528 | ADB05EAF319BCD309FCF311A8D301E8FD1EBF5D0EFF7D16AB5D06EB751ABD550
529 | AFD7512A95502E9791CD6691CBE590CFE7914824904C26118D46118BC5100C06
530 | 110A85F071BEF39DEF7CE73BDFF9CE77BEF39DEF7CE73BDFF9FF92AFC46757E2
531 | 7B57E23757E27953E25957E27FA6C47F5C89F34589B34D89735589335D89F789
532 | 12EF3225DEA34ABCC395B83F28717751E2DEA4C49D4D89FBA212775525EEC94A
533 | DCD195D80F94D84D94D88B94D8C994D80795D84595D88395D8C1950281007E7E
534 | 7E108944100E87118FC7F1FBFB8B4C2683743A8D542A8562B18842A1806AB58A
535 | 4AA58266B38946A3816EB78B4EA783E17088C16080E9748AC96482E57289C562
536 | 81DD6E87ED768BCD6683F3F98CD3E984FBFD8EDBED86F7FB8DD7EBE57CE73BDF
537 | F9CE77BEF39DEF7CE73BDFF9CE77BEF3FF295F89CFAEC4F7AEC46FAEC4F3A6C4
538 | B3AEC4FF4C89FFB812E78B12679B12E7AA1267BA12EF1325DE654ABC47957887
539 | 2B717F50E2EEA2C4BD49893B9B12F74525EEAA4ADC9395B8A32BB11F28B19B28
540 | B11729B19329B10F2AB18B2AB1072BB1832BFD01D72DD74A
541 | }
542 | end
543 | object ImageListSample: TImageList
544 | Height = 50
545 | Width = 50
546 | Left = 600
547 | Top = 368
548 | end
549 | object OpenPictureDialog: TOpenPictureDialog
550 | Title = 'Open Existing File'
551 | Options = [ofPathMustExist, ofEnableSizing, ofViewDetail]
552 | Left = 360
553 | Top = 168
554 | end
555 | object SavePictureDialog: TSavePictureDialog
556 | Title = 'Save File As'
557 | DefaultExt = '.png'
558 | FileName = 'Unnamed'
559 | FilterIndex = 2
560 | Options = [ofOverwritePrompt, ofEnableSizing, ofViewDetail]
561 | Left = 584
562 | Top = 168
563 | end
564 | object TimerAutoShow: TTimer
565 | Interval = 60
566 | OnTimer = TimerAutoShowTimer
567 | Left = 832
568 | Top = 367
569 | end
570 | end
571 |
--------------------------------------------------------------------------------
/UnitMain.pas:
--------------------------------------------------------------------------------
1 | // .d8888b. 8888888b. 8888888b. 888888b. d8888 .d8888b. 8888888888 8888888b.
2 | // d88P Y88b 888 "Y88b 888 "Y88b 888 "88b d88888 d88P Y88b 888 888 "Y88b
3 | // 888 888 888 888 888 888 888 .88P d88P888 Y88b. 888 888 888
4 | // 888 888 888 888 888 8888888K. d88P 888 "Y888b. 8888888 888 888
5 | // 888 88888 888 888 888 888 888 "Y88b d88P 888 "Y88b. 888 888 888
6 | // 888 888 888 888 888 888 888 888 d88P 888 "888 888 888 888
7 | // Y88b d88P 888 .d88P 888 .d88P 888 d88P d8888888888 Y88b d88P 888 888 .d88P
8 | // "Y8888P88 8888888P" 8888888P" 8888888P" d88P 888 "Y8888P" 8888888888 8888888P"
9 | //
10 | // Turborium(c) 2024-2024
11 |
12 | unit UnitMain;
13 |
14 | {$mode delphiunicode}
15 |
16 | interface
17 |
18 | uses
19 | Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, ComCtrls,
20 | StdCtrls, Menus, Buttons, ExtDlgs, Math, LazPNG,
21 | Generics.Defaults, BitmapPixels, SortingPixelsAlgorithm;
22 |
23 | type
24 |
25 | { TSortThread }
26 |
27 | TSortThread = class(TThread)
28 | private
29 | FBitmap: TBitmap;
30 | FThresholdMax: Integer;
31 | FThresholdMin: Integer;
32 | FSortingDirection: TSortingDirection;
33 | protected
34 | procedure Execute(); override;
35 | public
36 | constructor Create();
37 | destructor Destroy(); override;
38 |
39 | property Bitmap: TBitmap read FBitmap;
40 | property SortingDirection: TSortingDirection read FSortingDirection write FSortingDirection;
41 | property ThresholdMin: Integer read FThresholdMin write FThresholdMin;
42 | property ThresholdBright: Integer read FThresholdMax write FThresholdMax;
43 | end;
44 |
45 | { TFormMain }
46 |
47 | TFormMain = class(TForm)
48 | BitBtnDown: TBitBtn;
49 | BitBtnLeft: TBitBtn;
50 | BitBtnRight: TBitBtn;
51 | BitBtnUp: TBitBtn;
52 | ButtonOpen: TButton;
53 | ButtonOpenSample: TButton;
54 | ButtonSave: TButton;
55 | CheckBoxAutoShowEnabled: TCheckBox;
56 | GroupBoxAutoShow: TGroupBox;
57 | GroupBoxImageScale: TGroupBox;
58 | GroupBoxSortDirection: TGroupBox;
59 | GroupBoxTrashhold: TGroupBox;
60 | ImageDisp: TImage;
61 | ImageListSample: TImageList;
62 | ImageListSortDirection: TImageList;
63 | LabelAutoShowMaxRange: TLabel;
64 | LabelAutoShowMinRange: TLabel;
65 | LabelThresholdMin: TLabel;
66 | LabelThresholdMax: TLabel;
67 | LabelThresholdMaxCaption: TLabel;
68 | LabelThresholdMinCaption: TLabel;
69 | LabelScale: TLabel;
70 | OpenPictureDialog: TOpenPictureDialog;
71 | PanelAutoShow: TPanel;
72 | PanelParams: TPanel;
73 | PanelFile: TPanel;
74 | PanelSortDirection: TPanel;
75 | PopupMenuSample: TPopupMenu;
76 | RadioGroupSaveScale: TRadioGroup;
77 | RadioGroupViewScale: TRadioGroup;
78 | SavePictureDialog: TSavePictureDialog;
79 | ScrollBoxDisp: TScrollBox;
80 | TimerAutoShow: TTimer;
81 | TrackBarAutoShowTresholdMin: TTrackBar;
82 | TrackBarAutoShowTresholdMax: TTrackBar;
83 | TrackBarThresholdMin: TTrackBar;
84 | TrackBarThresholdMax: TTrackBar;
85 | TrackBarImageScale: TTrackBar;
86 | procedure BitBtnDownClick(Sender: TObject);
87 | procedure BitBtnLeftClick(Sender: TObject);
88 | procedure BitBtnRightClick(Sender: TObject);
89 | procedure BitBtnUpClick(Sender: TObject);
90 | procedure ButtonOpenClick(Sender: TObject);
91 | procedure ButtonOpenSampleClick(Sender: TObject);
92 | procedure ButtonSaveClick(Sender: TObject);
93 | procedure CheckBoxAutoShowEnabledChange(Sender: TObject);
94 | procedure FormCreate(Sender: TObject);
95 | procedure FormDestroy(Sender: TObject);
96 | procedure PanelParamsResize(Sender: TObject);
97 | procedure RadioGroupSaveScaleClick(Sender: TObject);
98 | procedure RadioGroupViewScaleClick(Sender: TObject);
99 | procedure LoadSampleToBitmap(var Bitmap: TBitmap; Index: Integer);
100 | procedure TimerAutoShowTimer(Sender: TObject);
101 | procedure TrackBarAutoShowTresholdMaxChange(Sender: TObject);
102 | procedure TrackBarAutoShowTresholdMinChange(Sender: TObject);
103 | procedure TrackBarImageScaleChange(Sender: TObject);
104 | procedure TrackBarThresholdMaxChange(Sender: TObject);
105 | procedure TrackBarThresholdMinChange(Sender: TObject);
106 | private
107 | FRawSource: TBitmap;
108 | FSource: TBitmap;
109 | FDestination: TBitmap;
110 |
111 | FViewScale: Integer;
112 | FImageScale: Integer;
113 | FSortingDirection: TSortingDirection;
114 | FTresholdMax: Integer;
115 | FTresholdMin: Integer;
116 | FSaveScale: Integer;
117 |
118 | FSortThread: TSortThread;
119 | FIsNeedUpdate: Boolean;
120 |
121 | FAutoShowEnabled: Boolean;
122 | FAutoShowRangeMin: Integer;
123 | FAutoShowRangeMax: Integer;
124 | FAutoShowDeltaMin: Double;
125 | FAutoShowDeltaMax: Double;
126 | FAutoShowTresholdMax: Double;
127 | FAutoShowTresholdMin: Double;
128 |
129 | procedure Idle(Sender: TObject; var Done: Boolean);
130 | procedure LoadSample(Index: Integer);
131 | procedure PopupSampleClick(Sender: TObject);
132 | procedure SortThreadTerminate(Sender: TObject);
133 | procedure UpdateSource();
134 | procedure UpdateRawSource();
135 | procedure UpdateUI();
136 | procedure NeedUpdate();
137 | public
138 | constructor Create(AOwner: TComponent); override;
139 | destructor Destroy(); override;
140 | end;
141 |
142 | var
143 | FormMain: TFormMain;
144 |
145 | implementation
146 |
147 | {$R *.lfm}
148 |
149 | const
150 | SampleCount = 15;
151 | MaxSourceSize = 3000;
152 |
153 | { TSortThread }
154 |
155 | constructor TSortThread.Create();
156 | begin
157 | inherited Create(True);
158 |
159 | FBitmap := TBitmap.Create();
160 | end;
161 |
162 | destructor TSortThread.Destroy();
163 | begin
164 | FBitmap.Free();
165 |
166 | inherited Destroy();
167 | end;
168 |
169 | procedure TSortThread.Execute();
170 | var
171 | Data: TBitmapData;
172 | begin
173 | Data.Map(FBitmap, TAccessMode.ReadWrite, False);
174 | try
175 | ImageSortingPixels(Data, FSortingDirection, FThresholdMin, FThresholdMax);
176 | finally
177 | Data.Unmap();
178 | end;
179 | end;
180 |
181 | { TFormMain }
182 |
183 | constructor TFormMain.Create(AOwner: TComponent);
184 | begin
185 | inherited Create(AOwner);
186 |
187 | FormatSettings.DecimalSeparator := '.';
188 | FSource := TBitmap.Create();
189 | FRawSource := TBitmap.Create();
190 | FDestination := TBitmap.Create();
191 |
192 | // defaults
193 | Randomize();
194 | FTresholdMax := 255;
195 | FTresholdMin := 0;
196 | FViewScale := 1;
197 | FImageScale := 100;
198 | FSaveScale := 3;
199 | FSortingDirection := TSortingDirection.Up;
200 | FAutoShowRangeMin := 0 + 100;
201 | FAutoShowRangeMax := 255 - 100;
202 | FAutoShowEnabled := False;
203 | end;
204 |
205 | destructor TFormMain.Destroy();
206 | begin
207 | FSource.Free();
208 | FRawSource.Free();
209 | FDestination.Free();
210 |
211 | inherited Destroy();
212 | end;
213 |
214 | procedure TFormMain.FormCreate(Sender: TObject);
215 | begin
216 | Application.AddOnIdleHandler(Idle, True);
217 |
218 | // load random sample
219 | LoadSample(Random(SampleCount));
220 | end;
221 |
222 | procedure TFormMain.FormDestroy(Sender: TObject);
223 | begin
224 | Application.RemoveOnIdleHandler(Idle);
225 |
226 | if FSortThread <> nil then
227 | FSortThread.WaitFor();
228 | end;
229 |
230 | procedure TFormMain.PanelParamsResize(Sender: TObject);
231 | begin
232 | GroupBoxAutoShow.Visible := GroupBoxAutoShow.Left + GroupBoxAutoShow.Width <= PanelParams.ClientWidth;
233 | end;
234 |
235 | procedure TFormMain.RadioGroupSaveScaleClick(Sender: TObject);
236 | begin
237 | FSaveScale := RadioGroupSaveScale.ItemIndex + 1;
238 |
239 | NeedUpdate();
240 | end;
241 |
242 | procedure TFormMain.SortThreadTerminate(Sender: TObject);
243 | begin
244 | // copy pixels
245 | FDestination.LoadFromRawImage(FSortThread.Bitmap.RawImage, False);
246 |
247 | ImageDisp.Picture.Assign(FDestination);
248 | ImageDisp.Width := ImageDisp.Picture.Width * FViewScale;
249 | ImageDisp.Height := ImageDisp.Picture.Height * FViewScale;
250 | ImageDisp.Stretch := True;
251 | ImageDisp.Repaint;
252 |
253 | FSortThread := nil;
254 | end;
255 |
256 | procedure TFormMain.Idle(Sender: TObject; var Done: Boolean);
257 | begin
258 | if FIsNeedUpdate then
259 | begin
260 | // если потока нет - создаем и сбрасываем флаг необходимости обновления
261 | if FSortThread = nil then
262 | begin
263 | FSortThread := TSortThread.Create();
264 | FSortThread.FreeOnTerminate := True;
265 | FSortThread.OnTerminate := SortThreadTerminate;
266 |
267 | // copy pixels
268 | FSortThread.Bitmap.LoadFromRawImage(FSource.RawImage, False);
269 |
270 | FSortThread.SortingDirection := FSortingDirection;
271 | FSortThread.ThresholdMin := FTresholdMin;
272 | FSortThread.ThresholdBright := FTresholdMax;
273 |
274 | FSortThread.Start();
275 |
276 | FIsNeedUpdate := False;
277 | end;
278 | end;
279 | end;
280 |
281 | procedure TFormMain.RadioGroupViewScaleClick(Sender: TObject);
282 | begin
283 | FViewScale := RadioGroupViewScale.ItemIndex + 1;
284 |
285 | NeedUpdate();
286 | end;
287 |
288 | procedure TFormMain.PopupSampleClick(Sender: TObject);
289 | begin
290 | LoadSample(TMenuItem(Sender).Tag);
291 | end;
292 |
293 | procedure TFormMain.ButtonOpenSampleClick(Sender: TObject);
294 | var
295 | Item: TMenuItem;
296 | I: Integer;
297 | Bitmap: TBitmap;
298 | PopupPoint: TPoint;
299 | begin
300 | // delay loading
301 | if PopupMenuSample.Items.Count = 0 then
302 | begin
303 | Screen.BeginWaitCursor();
304 | try
305 | // load images
306 | for I := 0 to SampleCount - 1 do
307 | begin
308 | Bitmap := TBitmap.Create();
309 | try
310 | LoadSampleToBitmap(Bitmap, I);
311 | ImageListSample.Add(Bitmap, nil);
312 | finally
313 | Bitmap.Free();
314 | end;
315 | end;
316 | // make items
317 | for I := 0 to SampleCount - 1 do
318 | begin
319 | Item := TMenuItem.Create(Self);
320 | Item.Caption := 'Sample ' + IntToStr(I);
321 | Item.ImageIndex := I;
322 | Item.OnClick := PopupSampleClick;
323 | Item.Tag := I;
324 | PopupMenuSample.Items.Add(Item);
325 | end;
326 | finally
327 | Screen.EndWaitCursor();
328 | end;
329 | end;
330 |
331 | // popup
332 | PopupPoint := ButtonOpenSample.ClientToScreen(Point(ButtonOpenSample.Width, ButtonOpenSample.Height));
333 | PopupMenuSample.PopUp(PopupPoint.X, PopupPoint.Y);
334 | end;
335 |
336 | procedure TFormMain.ButtonSaveClick(Sender: TObject);
337 | var
338 | Picture: TPicture;
339 | begin
340 | if FSortThread <> nil then
341 | FSortThread.WaitFor();
342 |
343 | if SavePictureDialog.Execute then
344 | begin
345 | Picture := TPicture.Create();
346 | try
347 | Picture.Bitmap.SetSize(FDestination.Width * FSaveScale, FDestination.Height * FSaveScale);
348 | Picture.Bitmap.Canvas.AntialiasingMode := amOff;
349 | Picture.Bitmap.Canvas.StretchDraw(Rect(0, 0, Picture.Bitmap.Width, Picture.Bitmap.Height), FDestination);
350 |
351 | // jpeg quality fix
352 | if TPicture.FindGraphicClassWithFileExt(ExtractFileExt(SavePictureDialog.FileName)) = TJPEGImage then
353 | Picture.Jpeg.CompressionQuality := 95;
354 |
355 | Picture.SaveToFile(SavePictureDialog.FileName);
356 | finally
357 | Picture.Free();
358 | end;
359 | end;
360 |
361 | NeedUpdate();
362 | end;
363 |
364 | procedure TFormMain.CheckBoxAutoShowEnabledChange(Sender: TObject);
365 | begin
366 | FAutoShowEnabled := CheckBoxAutoShowEnabled.Checked;
367 |
368 | NeedUpdate();
369 | end;
370 |
371 | procedure TFormMain.BitBtnUpClick(Sender: TObject);
372 | begin
373 | FSortingDirection := TSortingDirection.Up;
374 |
375 | NeedUpdate();
376 | end;
377 |
378 | procedure TFormMain.ButtonOpenClick(Sender: TObject);
379 | var
380 | Picture: TPicture;
381 | begin
382 | if OpenPictureDialog.Execute then
383 | begin
384 | Picture := TPicture.Create();
385 | try
386 | Picture.LoadFromFile(OpenPictureDialog.FileName);
387 | FRawSource.Assign(Picture.Graphic);
388 | finally
389 | Picture.Free();
390 | end;
391 |
392 | SavePictureDialog.FileName := ChangeFileExt(ExtractFileName(OpenPictureDialog.FileName), '');
393 |
394 | UpdateRawSource();
395 | end;
396 | end;
397 |
398 | procedure TFormMain.BitBtnLeftClick(Sender: TObject);
399 | begin
400 | FSortingDirection := TSortingDirection.Left;
401 |
402 | NeedUpdate();
403 | end;
404 |
405 | procedure TFormMain.BitBtnDownClick(Sender: TObject);
406 | begin
407 | FSortingDirection := TSortingDirection.Down;
408 |
409 | NeedUpdate();
410 | end;
411 |
412 | procedure TFormMain.BitBtnRightClick(Sender: TObject);
413 | begin
414 | FSortingDirection := TSortingDirection.Right;
415 |
416 | NeedUpdate();
417 | end;
418 |
419 | procedure TFormMain.TrackBarImageScaleChange(Sender: TObject);
420 | begin
421 | FImageScale := TrackBarImageScale.Position;
422 | UpdateSource();
423 |
424 | NeedUpdate();
425 | end;
426 |
427 | procedure TFormMain.TrackBarThresholdMaxChange(Sender: TObject);
428 | begin
429 | FTresholdMax := TrackBarThresholdMax.Position;
430 | if FTresholdMin > FTresholdMax then
431 | FTresholdMin := FTresholdMax;
432 |
433 | NeedUpdate();
434 | end;
435 |
436 | procedure TFormMain.TrackBarThresholdMinChange(Sender: TObject);
437 | begin
438 | FTresholdMin := TrackBarThresholdMin.Position;
439 | if FTresholdMin > FTresholdMax then
440 | FTresholdMax := FTresholdMin;
441 |
442 | NeedUpdate();
443 | end;
444 |
445 | procedure TFormMain.LoadSampleToBitmap(var Bitmap: TBitmap; Index: Integer);
446 | var
447 | Png: TPNGImage;
448 | begin
449 | Png := TPNGImage.Create();
450 | try
451 | Png.LoadFromResourceName(HInstance, IntToStr(Index));
452 | Bitmap.Assign(Png);
453 | finally
454 | Png.Free();
455 | end;
456 | end;
457 |
458 | procedure TFormMain.TimerAutoShowTimer(Sender: TObject);
459 | const
460 | Vals: array of Double = [-1, -0.8, -0.5, -0.3, 0.3, 0.5, 0.8, 1];
461 | begin
462 |
463 | if Random(20) = 0 then
464 | begin
465 | FAutoShowDeltaMin := RandomFrom(Vals);
466 | end;
467 |
468 | if Random(20) = 0 then
469 | begin
470 | FAutoShowDeltaMax := RandomFrom(Vals);
471 | end;
472 |
473 | FAutoShowTresholdMin := FAutoShowTresholdMin + FAutoShowDeltaMin;
474 | FAutoShowTresholdMax := FAutoShowTresholdMax + FAutoShowDeltaMax;
475 |
476 | if (FAutoShowTresholdMax > 255) or (FAutoShowTresholdMax < FAutoShowRangeMax) then
477 | begin
478 | FAutoShowDeltaMax := -FAutoShowDeltaMax;
479 | if FAutoShowTresholdMax < FAutoShowRangeMax then
480 | FAutoShowTresholdMax := FAutoShowRangeMax
481 | else
482 | FAutoShowTresholdMax := 255;
483 | end;
484 |
485 | if (FAutoShowTresholdMin > FAutoShowRangeMin) or (FAutoShowTresholdMin < 0) then
486 | begin
487 | FAutoShowDeltaMin := -FAutoShowDeltaMin;
488 | if FAutoShowTresholdMin > FAutoShowRangeMin then
489 | FAutoShowTresholdMin := FAutoShowRangeMin
490 | else
491 | FAutoShowTresholdMin := 0;
492 | end;
493 |
494 | FTresholdMin := Trunc(FAutoShowTresholdMin);
495 | FTresholdMax := Trunc(FAutoShowTresholdMax);
496 |
497 | UpdateUI();
498 | end;
499 |
500 | procedure TFormMain.TrackBarAutoShowTresholdMaxChange(Sender: TObject);
501 | begin
502 | FAutoShowRangeMax := TrackBarAutoShowTresholdMax.Position;
503 | if FAutoShowRangeMin > FAutoShowRangeMax then
504 | FAutoShowRangeMin := FAutoShowRangeMax;
505 |
506 | NeedUpdate();
507 | end;
508 |
509 | procedure TFormMain.TrackBarAutoShowTresholdMinChange(Sender: TObject);
510 | begin
511 | FAutoShowRangeMin := TrackBarAutoShowTresholdMin.Position;
512 | if FAutoShowRangeMin > FAutoShowRangeMax then
513 | FAutoShowRangeMax := FAutoShowRangeMin;
514 |
515 | NeedUpdate();
516 | end;
517 |
518 | procedure TFormMain.LoadSample(Index: Integer);
519 | begin
520 | FTresholdMax := RandomRange(130, 255);
521 | FTresholdMin := RandomRange(0, 120);
522 | FSortingDirection := TSortingDirection(Random(4));
523 | //FRawSource.LoadFromResourceName(HInstance, IntToStr(Index));
524 | LoadSampleToBitmap(FRawSource, Index);
525 | UpdateRawSource();
526 | end;
527 |
528 | procedure TFormMain.UpdateSource();
529 | var
530 | Scaled: TBitmap;
531 | W, H: Integer;
532 | begin
533 | Scaled := TBitmap.Create();
534 | try
535 | W := Max(1, Trunc(FRawSource.Width * FImageScale / 100));
536 | H := Max(1, Trunc(FRawSource.Height * FImageScale / 100));
537 |
538 | if W > MaxSourceSize then
539 | begin
540 | W := MaxSourceSize;
541 | H := Trunc(W * (FRawSource.Height / FRawSource.Width));
542 | end;
543 | if H > MaxSourceSize then
544 | begin
545 | H := MaxSourceSize;
546 | W := Trunc(H * (FRawSource.Width / FRawSource.Height));
547 | end;
548 |
549 | Scaled.SetSize(W, H);
550 | Scaled.Canvas.AntialiasingMode := amOn;
551 | Scaled.Canvas.StretchDraw(Rect(0, 0, Scaled.Width, Scaled.Height), FRawSource);
552 | FSource.Assign(Scaled);
553 | finally
554 | Scaled.Free();
555 | end;
556 |
557 | NeedUpdate();
558 | end;
559 |
560 | procedure TFormMain.UpdateRawSource();
561 | begin
562 | ScrollBoxDisp.HorzScrollBar.Position := 0;
563 | ScrollBoxDisp.VertScrollBar.Position := 0;
564 | FViewScale := 1;
565 | FImageScale := 100;
566 | UpdateSource();
567 | end;
568 |
569 | procedure TFormMain.UpdateUI();
570 | begin
571 | // update image scale
572 | TrackBarImageScale.Position := FImageScale;
573 | LabelScale.Caption := IntToStr(FImageScale) + '%' + ' [' + IntToStr(FSource.Width) + 'x' + IntToStr(FSource.Height) + ']';
574 |
575 | // update direction buttons
576 | if FSortingDirection = TSortingDirection.Left then
577 | BitBtnLeft.Font.Style := [fsBold]
578 | else
579 | BitBtnLeft.Font.Style := [];
580 | if FSortingDirection = TSortingDirection.Up then
581 | BitBtnUp.Font.Style := [fsBold]
582 | else
583 | BitBtnUp.Font.Style := [];
584 | if FSortingDirection = TSortingDirection.Right then
585 | BitBtnRight.Font.Style := [fsBold]
586 | else
587 | BitBtnRight.Font.Style := [];
588 | if FSortingDirection = TSortingDirection.Down then
589 | BitBtnDown.Font.Style := [fsBold]
590 | else
591 | BitBtnDown.Font.Style := [];
592 |
593 | // update view scale
594 | RadioGroupViewScale.ItemIndex := FViewScale - 1;
595 |
596 | // update trashhold
597 | TrackBarThresholdMin.Position := FTresholdMin;
598 | TrackBarThresholdMax.Position := FTresholdMax;
599 |
600 | // update save scale
601 | RadioGroupSaveScale.ItemIndex := FSaveScale - 1;
602 |
603 | // threshold labels
604 | LabelThresholdMin.Caption := IntToStr(FTresholdMin);
605 | LabelThresholdMax.Caption := IntToStr(FTresholdMax);
606 |
607 | // auto show
608 | CheckBoxAutoShowEnabled.Checked := FAutoShowEnabled;
609 | TrackBarAutoShowTresholdMin.Position := FAutoShowRangeMin;
610 | TrackBarAutoShowTresholdMax.Position := FAutoShowRangeMax;
611 | TrackBarThresholdMax.Enabled := not FAutoShowEnabled;
612 | TrackBarThresholdMin.Enabled := not FAutoShowEnabled;
613 | RadioGroupSaveScale.Enabled := not FAutoShowEnabled;
614 | ButtonSave.Enabled := not FAutoShowEnabled;
615 | end;
616 |
617 | procedure TFormMain.NeedUpdate();
618 | begin
619 | FIsNeedUpdate := True;
620 |
621 | TimerAutoShow.Enabled := FAutoShowEnabled;
622 |
623 | UpdateUI();
624 | end;
625 |
626 | end.
627 |
628 |
--------------------------------------------------------------------------------
/other_langs/readme.md:
--------------------------------------------------------------------------------
1 | Сюда выкладывать версии на других языках.
2 | В папку с названием яп.
3 |
--------------------------------------------------------------------------------
/samples/0.bmp:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/turborium/SortingPixels/89a741783b7e56614eada2daab86370890fa44c4/samples/0.bmp
--------------------------------------------------------------------------------
/samples/0.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/turborium/SortingPixels/89a741783b7e56614eada2daab86370890fa44c4/samples/0.png
--------------------------------------------------------------------------------
/samples/1.bmp:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/turborium/SortingPixels/89a741783b7e56614eada2daab86370890fa44c4/samples/1.bmp
--------------------------------------------------------------------------------
/samples/1.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/turborium/SortingPixels/89a741783b7e56614eada2daab86370890fa44c4/samples/1.png
--------------------------------------------------------------------------------
/samples/10.bmp:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/turborium/SortingPixels/89a741783b7e56614eada2daab86370890fa44c4/samples/10.bmp
--------------------------------------------------------------------------------
/samples/10.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/turborium/SortingPixels/89a741783b7e56614eada2daab86370890fa44c4/samples/10.png
--------------------------------------------------------------------------------
/samples/11.bmp:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/turborium/SortingPixels/89a741783b7e56614eada2daab86370890fa44c4/samples/11.bmp
--------------------------------------------------------------------------------
/samples/11.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/turborium/SortingPixels/89a741783b7e56614eada2daab86370890fa44c4/samples/11.png
--------------------------------------------------------------------------------
/samples/12.bmp:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/turborium/SortingPixels/89a741783b7e56614eada2daab86370890fa44c4/samples/12.bmp
--------------------------------------------------------------------------------
/samples/12.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/turborium/SortingPixels/89a741783b7e56614eada2daab86370890fa44c4/samples/12.png
--------------------------------------------------------------------------------
/samples/13.bmp:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/turborium/SortingPixels/89a741783b7e56614eada2daab86370890fa44c4/samples/13.bmp
--------------------------------------------------------------------------------
/samples/13.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/turborium/SortingPixels/89a741783b7e56614eada2daab86370890fa44c4/samples/13.png
--------------------------------------------------------------------------------
/samples/14.bmp:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/turborium/SortingPixels/89a741783b7e56614eada2daab86370890fa44c4/samples/14.bmp
--------------------------------------------------------------------------------
/samples/14.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/turborium/SortingPixels/89a741783b7e56614eada2daab86370890fa44c4/samples/14.png
--------------------------------------------------------------------------------
/samples/2.bmp:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/turborium/SortingPixels/89a741783b7e56614eada2daab86370890fa44c4/samples/2.bmp
--------------------------------------------------------------------------------
/samples/2.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/turborium/SortingPixels/89a741783b7e56614eada2daab86370890fa44c4/samples/2.png
--------------------------------------------------------------------------------
/samples/3.bmp:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/turborium/SortingPixels/89a741783b7e56614eada2daab86370890fa44c4/samples/3.bmp
--------------------------------------------------------------------------------
/samples/3.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/turborium/SortingPixels/89a741783b7e56614eada2daab86370890fa44c4/samples/3.png
--------------------------------------------------------------------------------
/samples/4.bmp:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/turborium/SortingPixels/89a741783b7e56614eada2daab86370890fa44c4/samples/4.bmp
--------------------------------------------------------------------------------
/samples/4.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/turborium/SortingPixels/89a741783b7e56614eada2daab86370890fa44c4/samples/4.png
--------------------------------------------------------------------------------
/samples/5.bmp:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/turborium/SortingPixels/89a741783b7e56614eada2daab86370890fa44c4/samples/5.bmp
--------------------------------------------------------------------------------
/samples/5.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/turborium/SortingPixels/89a741783b7e56614eada2daab86370890fa44c4/samples/5.png
--------------------------------------------------------------------------------
/samples/6.bmp:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/turborium/SortingPixels/89a741783b7e56614eada2daab86370890fa44c4/samples/6.bmp
--------------------------------------------------------------------------------
/samples/6.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/turborium/SortingPixels/89a741783b7e56614eada2daab86370890fa44c4/samples/6.png
--------------------------------------------------------------------------------
/samples/7.bmp:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/turborium/SortingPixels/89a741783b7e56614eada2daab86370890fa44c4/samples/7.bmp
--------------------------------------------------------------------------------
/samples/7.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/turborium/SortingPixels/89a741783b7e56614eada2daab86370890fa44c4/samples/7.png
--------------------------------------------------------------------------------
/samples/8.bmp:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/turborium/SortingPixels/89a741783b7e56614eada2daab86370890fa44c4/samples/8.bmp
--------------------------------------------------------------------------------
/samples/8.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/turborium/SortingPixels/89a741783b7e56614eada2daab86370890fa44c4/samples/8.png
--------------------------------------------------------------------------------
/samples/9.bmp:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/turborium/SortingPixels/89a741783b7e56614eada2daab86370890fa44c4/samples/9.bmp
--------------------------------------------------------------------------------
/samples/9.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/turborium/SortingPixels/89a741783b7e56614eada2daab86370890fa44c4/samples/9.png
--------------------------------------------------------------------------------
/scr.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/turborium/SortingPixels/89a741783b7e56614eada2daab86370890fa44c4/scr.png
--------------------------------------------------------------------------------