Context Navigation

blendpixelinline.inc

Last change on this file was 2, checked in by chronos, 6 years ago
Source code taken from https://svn.zdechov.net/PascalClassLibrary/GraphicTest/ rev 543.
File size: 28.6 KB

Line
1	function ByteLinearMultiplyInline(a, b: byte): byte;
2	begin
3	Result := (a * b) shr 8;
4	end;
5
6	procedure LinearMultiplyPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline;
7	var
8	destalpha: byte;
9	begin
10	destalpha := dest^.alpha;
11	if destalpha = 0 then
12	begin
13	dest^ := c
14	end else
15	if destalpha = 255 then
16	begin
17	dest^.red := ByteLinearMultiplyInline(dest^.red, c.red);
18	dest^.green := ByteLinearMultiplyInline(dest^.green, c.green);
19	dest^.blue := ByteLinearMultiplyInline(dest^.blue, c.blue);
20	dest^.alpha := c.alpha;
21	end else
22	begin
23	dest^.red := (ByteLinearMultiplyInline(dest^.red, c.red) *
24	destalpha + c.red * (not destalpha)) shr 8;
25	dest^.green := (ByteLinearMultiplyInline(dest^.green, c.green) *
26	destalpha + c.green * (not destalpha)) shr 8;
27	dest^.blue := (ByteLinearMultiplyInline(dest^.blue, c.blue) *
28	destalpha + c.blue * (not destalpha)) shr 8;
29	dest^.alpha := c.alpha;
30	end;
31	end;
32
33	{$hints off}
34	function ByteAddInline(a, b: byte): byte;
35	var
36	temp: longword;
37	begin
38	temp := longword(GammaExpansionTab[a]) + longword(GammaExpansionTab[b]);
39	if temp > 65535 then
40	temp := 65535;
41	Result := GammaCompressionTab[temp];
42	end;
43	{$hints on}
44
45	function ByteLinearAddInline(a, b: byte): byte;
46	var
47	temp: integer;
48	begin
49	temp := integer(a) + integer(b);
50	if temp > 255 then
51	temp := 255;
52	Result := temp;
53	end;
54
55	procedure AddPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline;
56	var
57	destalpha: byte;
58	begin
59	destalpha := dest^.alpha;
60	if destalpha = 0 then
61	begin
62	dest^ := c
63	end else
64	if destalpha = 255 then
65	begin
66	dest^.red := ByteAddInline(dest^.red, c.red);
67	dest^.green := ByteAddInline(dest^.green, c.green);
68	dest^.blue := ByteAddInline(dest^.blue, c.blue);
69	dest^.alpha := c.alpha;
70	end else
71	begin
72	dest^.red := ByteAddInline(dest^.red * destalpha shr 8, c.red);
73	dest^.green := ByteAddInline(dest^.green * destalpha shr 8, c.green);
74	dest^.blue := ByteAddInline(dest^.blue * destalpha shr 8, c.blue);
75	dest^.alpha := c.alpha;
76	end;
77	end;
78
79	procedure LinearAddPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline;
80	var
81	destalpha: byte;
82	begin
83	destalpha := dest^.alpha;
84	if destalpha = 0 then
85	begin
86	dest^ := c
87	end else
88	if destalpha = 255 then
89	begin
90	dest^.red := ByteLinearAddInline(dest^.red, c.red);
91	dest^.green := ByteLinearAddInline(dest^.green, c.green);
92	dest^.blue := ByteLinearAddInline(dest^.blue, c.blue);
93	dest^.alpha := c.alpha;
94	end else
95	begin
96	dest^.red := ByteLinearAddInline(dest^.red * destalpha shr 8, c.red);
97	dest^.green := ByteLinearAddInline(dest^.green * destalpha shr 8, c.green);
98	dest^.blue := ByteLinearAddInline(dest^.blue * destalpha shr 8, c.blue);
99	dest^.alpha := c.alpha;
100	end;
101	end;
102
103	function ByteBurnInline(a, b: byte): byte; inline;
104	var
105	temp: integer;
106	begin
107	if b = 0 then
108	Result := 0
109	else
110	begin
111	temp := 255 - (((255 - a) shl 8) div b);
112	if temp < 0 then
113	Result := 0
114	else
115	Result := temp;
116	end;
117	end;
118
119	procedure ColorBurnPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline;
120	var
121	destalpha: byte;
122	begin
123	destalpha := dest^.alpha;
124	if destalpha = 0 then
125	begin
126	dest^ := c
127	end else
128	if destalpha = 255 then
129	begin
130	dest^.red := ByteBurnInline(dest^.red, c.red);
131	dest^.green := ByteBurnInline(dest^.green, c.green);
132	dest^.blue := ByteBurnInline(dest^.blue, c.blue);
133	dest^.alpha := c.alpha;
134	end else
135	begin
136	dest^.red := (ByteBurnInline(dest^.red, c.red) * destalpha +
137	c.red * (not destalpha)) shr 8;
138	dest^.green := (ByteBurnInline(dest^.green, c.green) * destalpha +
139	c.green * (not destalpha)) shr 8;
140	dest^.blue := (ByteBurnInline(dest^.blue, c.blue) * destalpha +
141	c.blue * (not destalpha)) shr 8;
142	dest^.alpha := c.alpha;
143	end;
144	end;
145
146	{$hints off}
147	function ByteDodgeInline(a, b: byte): byte; inline;
148	var
149	temp: integer;
150	begin
151	if b = 255 then
152	Result := 255
153	else
154	begin
155	temp := (a shl 8) div (not b);
156	if temp > 255 then
157	Result := 255
158	else
159	Result := temp;
160	end;
161	end;
162	{$hints on}
163
164	procedure ColorDodgePixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline;
165	var
166	destalpha: byte;
167	begin
168	destalpha := dest^.alpha;
169	if destalpha = 0 then
170	begin
171	dest^ := c
172	end else
173	if destalpha = 255 then
174	begin
175	dest^.red := ByteDodgeInline(dest^.red, c.red);
176	dest^.green := ByteDodgeInline(dest^.green, c.green);
177	dest^.blue := ByteDodgeInline(dest^.blue, c.blue);
178	dest^.alpha := c.alpha;
179	end else
180	begin
181	dest^.red := (ByteDodgeInline(dest^.red, c.red) * destalpha +
182	c.red * (not destalpha)) shr 8;
183	dest^.green := (ByteDodgeInline(dest^.green, c.green) * destalpha +
184	c.green * (not destalpha)) shr 8;
185	dest^.blue := (ByteDodgeInline(dest^.blue, c.blue) * destalpha +
186	c.blue * (not destalpha)) shr 8;
187	dest^.alpha := c.alpha;
188	end;
189	end;
190
191	{$hints off}
192	function ByteDivideInline(a, b: byte): byte; inline;
193	var
194	temp: integer;
195	begin
196	if b = 0 then
197	Result := 255
198	else
199	begin
200	temp := (a shl 8) div b;
201	if temp > 255 then
202	Result := 255
203	else
204	Result := temp;
205	end;
206	end;
207	{$hints on}
208
209	procedure DividePixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline;
210	var
211	destalpha: byte;
212	begin
213	destalpha := dest^.alpha;
214	if destalpha = 0 then
215	begin
216	dest^ := c
217	end else
218	if destalpha = 255 then
219	begin
220	dest^.red := ByteDivideInline(dest^.red, c.red);
221	dest^.green := ByteDivideInline(dest^.green, c.green);
222	dest^.blue := ByteDivideInline(dest^.blue, c.blue);
223	dest^.alpha := c.alpha;
224	end else
225	begin
226	dest^.red := (ByteDivideInline(dest^.red, c.red) * destalpha +
227	c.red * (not destalpha)) shr 8;
228	dest^.green := (ByteDivideInline(dest^.green, c.green) * destalpha +
229	c.green * (not destalpha)) shr 8;
230	dest^.blue := (ByteDivideInline(dest^.blue, c.blue) * destalpha +
231	c.blue * (not destalpha)) shr 8;
232	dest^.alpha := c.alpha;
233	end;
234	end;
235
236	{$hints off}
237	function ByteNonLinearReflectInline(a, b: byte): byte; inline;
238	var
239	temp: longword;
240	wa,wb: word;
241	begin
242	if b = 255 then
243	Result := 255
244	else
245	begin
246	wa := GammaExpansionTab[a];
247	wb := GammaExpansionTab[b];
248	temp := wa * wa div (not wb);
249	if temp >= 65535 then
250	Result := 255
251	else
252	Result := GammaCompressionTab[ temp ];
253	end;
254	end;
255
256	function ByteReflectInline(a, b: byte): byte; inline;
257	var
258	temp: integer;
259	begin
260	if b = 255 then
261	Result := 255
262	else
263	begin
264	temp := a * a div (not b);
265	if temp > 255 then
266	Result := 255
267	else
268	Result := temp;
269	end;
270	end;
271	{$hints on}
272
273	procedure ReflectPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline;
274	var
275	destalpha: byte;
276	begin
277	destalpha := dest^.alpha;
278	if destalpha = 0 then
279	begin
280	dest^ := c
281	end else
282	if destalpha = 255 then
283	begin
284	dest^.red := ByteReflectInline(dest^.red, c.red);
285	dest^.green := ByteReflectInline(dest^.green, c.green);
286	dest^.blue := ByteReflectInline(dest^.blue, c.blue);
287	dest^.alpha := c.alpha;
288	end else
289	begin
290	dest^.red := (ByteReflectInline(dest^.red, c.red) * destalpha +
291	c.red * (not destalpha)) shr 8;
292	dest^.green := (ByteReflectInline(dest^.green, c.green) * destalpha +
293	c.green * (not destalpha)) shr 8;
294	dest^.blue := (ByteReflectInline(dest^.blue, c.blue) * destalpha +
295	c.blue * (not destalpha)) shr 8;
296	dest^.alpha := c.alpha;
297	end;
298	end;
299
300	procedure GlowPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline;
301	var
302	destalpha: byte;
303	begin
304	destalpha := dest^.alpha;
305	if destalpha = 0 then
306	begin
307	dest^ := c
308	end else
309	if destalpha = 255 then
310	begin
311	dest^.red := ByteReflectInline(c.red, dest^.red);
312	dest^.green := ByteReflectInline(c.green, dest^.green);
313	dest^.blue := ByteReflectInline(c.blue, dest^.blue);
314	dest^.alpha := c.alpha;
315	end else
316	begin
317	dest^.red := (ByteReflectInline(c.red, dest^.red) * destalpha +
318	c.red * (not destalpha)) shr 8;
319	dest^.green := (ByteReflectInline(c.green, dest^.green) * destalpha +
320	c.green * (not destalpha)) shr 8;
321	dest^.blue := (ByteReflectInline(c.blue, dest^.blue) * destalpha +
322	c.blue * (not destalpha)) shr 8;
323	dest^.alpha := c.alpha;
324	end;
325	end;
326
327	procedure NiceGlowPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline;
328	var
329	destalpha: byte;
330	begin
331	destalpha := dest^.alpha;
332
333	if destalpha = 0 then
334	begin
335	dest^ := c
336	end else
337	if destalpha = 255 then
338	begin
339	dest^.red := ByteReflectInline(c.red, dest^.red);
340	dest^.green := ByteReflectInline(c.green, dest^.green);
341	dest^.blue := ByteReflectInline(c.blue, dest^.blue);
342	end else
343	begin
344	dest^.red := (ByteReflectInline(c.red, dest^.red) * destalpha +
345	c.red * (not destalpha)) shr 8;
346	dest^.green := (ByteReflectInline(c.green, dest^.green) * destalpha +
347	c.green * (not destalpha)) shr 8;
348	dest^.blue := (ByteReflectInline(c.blue, dest^.blue) * destalpha +
349	c.blue * (not destalpha)) shr 8;
350	end;
351
352	if (c.red > c.green) and (c.red > c.blue) then
353	dest^.alpha := c.red else
354	if (c.green > c.blue) then
355	dest^.alpha := c.green else
356	dest^.alpha := c.blue;
357	dest^.alpha := ApplyOpacity(GammaExpansionTab[dest^.alpha] shr 8,c.alpha);
358	end;
359
360	procedure NonLinearReflectPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline;
361	var
362	destalpha: byte;
363	begin
364	destalpha := dest^.alpha;
365	if destalpha = 0 then
366	begin
367	dest^ := c
368	end else
369	if destalpha = 255 then
370	begin
371	dest^.red := ByteNonLinearReflectInline(dest^.red, c.red);
372	dest^.green := ByteNonLinearReflectInline(dest^.green, c.green);
373	dest^.blue := ByteNonLinearReflectInline(dest^.blue, c.blue);
374	dest^.alpha := c.alpha;
375	end else
376	begin
377	dest^.red := (ByteNonLinearReflectInline(dest^.red, c.red) * destalpha +
378	c.red * (not destalpha)) shr 8;
379	dest^.green := (ByteNonLinearReflectInline(dest^.green, c.green) * destalpha +
380	c.green * (not destalpha)) shr 8;
381	dest^.blue := (ByteNonLinearReflectInline(dest^.blue, c.blue) * destalpha +
382	c.blue * (not destalpha)) shr 8;
383	dest^.alpha := c.alpha;
384	end;
385	end;
386
387	{$hints off}
388	function ByteOverlayInline(a, b: byte): byte; inline;
389	var wa,wb: word;
390	begin
391	wa := GammaExpansionTab[a];
392	wb := GammaExpansionTab[b];
393	if wa < 32768 then
394	Result := GammaCompressionTab[ (wa * wb) shr 15 ]
395	else
396	Result := GammaCompressionTab[ 65535 - ((not wa) * (not wb) shr 15) ];
397	end;
398	{$hints on}
399
400	function ByteLinearOverlayInline(a, b: byte): byte; inline;
401	begin
402	if a < 128 then
403	Result := (a * b) shr 7
404	else
405	Result := 255 - ((not a) * (not b) shr 7);
406	end;
407
408	procedure OverlayPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline;
409	var
410	destalpha: byte;
411	begin
412	destalpha := dest^.alpha;
413	if destalpha = 0 then
414	begin
415	dest^ := c
416	end else
417	if destalpha = 255 then
418	begin
419	dest^.red := ByteOverlayInline(dest^.red, c.red);
420	dest^.green := ByteOverlayInline(dest^.green, c.green);
421	dest^.blue := ByteOverlayInline(dest^.blue, c.blue);
422	dest^.alpha := c.alpha;
423	end else
424	begin
425	dest^.red := (ByteOverlayInline(dest^.red, c.red) * destalpha +
426	c.red * (not destalpha)) shr 8;
427	dest^.green := (ByteOverlayInline(dest^.green, c.green) * destalpha +
428	c.green * (not destalpha)) shr 8;
429	dest^.blue := (ByteOverlayInline(dest^.blue, c.blue) * destalpha +
430	c.blue * (not destalpha)) shr 8;
431	dest^.alpha := c.alpha;
432	end;
433	end;
434
435	procedure LinearOverlayPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline;
436	var
437	destalpha: byte;
438	begin
439	destalpha := dest^.alpha;
440	if destalpha = 0 then
441	begin
442	dest^ := c
443	end else
444	if destalpha = 255 then
445	begin
446	dest^.red := ByteLinearOverlayInline(dest^.red, c.red);
447	dest^.green := ByteLinearOverlayInline(dest^.green, c.green);
448	dest^.blue := ByteLinearOverlayInline(dest^.blue, c.blue);
449	dest^.alpha := c.alpha;
450	end else
451	begin
452	dest^.red := (ByteLinearOverlayInline(dest^.red, c.red) * destalpha +
453	c.red * (not destalpha)) shr 8;
454	dest^.green := (ByteLinearOverlayInline(dest^.green, c.green) * destalpha +
455	c.green * (not destalpha)) shr 8;
456	dest^.blue := (ByteLinearOverlayInline(dest^.blue, c.blue) * destalpha +
457	c.blue * (not destalpha)) shr 8;
458	dest^.alpha := c.alpha;
459	end;
460	end;
461
462	function ByteDifferenceInline(a, b: byte): byte; inline;
463	begin
464	Result := GammaCompressionTab[abs(integer(GammaExpansionTab[a]) -
465	integer(GammaExpansionTab[b]))];
466	end;
467
468	procedure DifferencePixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline;
469	var
470	destalpha: byte;
471	begin
472	destalpha := dest^.alpha;
473	if destalpha = 0 then
474	begin
475	dest^ := c
476	end else
477	if destalpha = 255 then
478	begin
479	dest^.red := ByteDifferenceInline(dest^.red, c.red);
480	dest^.green := ByteDifferenceInline(dest^.green, c.green);
481	dest^.blue := ByteDifferenceInline(dest^.blue, c.blue);
482	dest^.alpha := c.alpha;
483	end else
484	begin
485	dest^.red := (ByteDifferenceInline(dest^.red, c.red) * destalpha +
486	c.red * (not destalpha)) shr 8;
487	dest^.green := (ByteDifferenceInline(dest^.green, c.green) *
488	destalpha + c.green * (not destalpha)) shr 8;
489	dest^.blue := (ByteDifferenceInline(dest^.blue, c.blue) * destalpha +
490	c.blue * (not destalpha)) shr 8;
491	dest^.alpha := c.alpha;
492	end;
493	end;
494
495	function ByteLinearDifferenceInline(a, b: byte): byte; inline;
496	begin
497	Result := abs(a - b);
498	end;
499
500	procedure LinearDifferencePixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline;
501	var
502	destalpha: byte;
503	begin
504	destalpha := dest^.alpha;
505	if destalpha = 0 then
506	begin
507	dest^ := c
508	end else
509	if destalpha = 255 then
510	begin
511	dest^.red := ByteLinearDifferenceInline(dest^.red, c.red);
512	dest^.green := ByteLinearDifferenceInline(dest^.green, c.green);
513	dest^.blue := ByteLinearDifferenceInline(dest^.blue, c.blue);
514	dest^.alpha := c.alpha;
515	end else
516	begin
517	dest^.red := (ByteLinearDifferenceInline(dest^.red, c.red) *
518	destalpha + c.red * (not destalpha)) shr 8;
519	dest^.green := (ByteLinearDifferenceInline(dest^.green, c.green) *
520	destalpha + c.green * (not destalpha)) shr 8;
521	dest^.blue := (ByteLinearDifferenceInline(dest^.blue, c.blue) *
522	destalpha + c.blue * (not destalpha)) shr 8;
523	dest^.alpha := c.alpha;
524	end;
525	end;
526
527	function ByteExclusionInline(a, b: byte): byte; inline;
528	var aw,bw: word;
529	begin
530	aw := GammaExpansionTab[a];
531	bw := GammaExpansionTab[b];
532	{$HINTS OFF}
533	Result := GammaCompressionTab[aw+bw-(longword(aw)*longword(bw) shr 15)];
534	{$HINTS ON}
535	end;
536
537	procedure ExclusionPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline;
538	var
539	destalpha: byte;
540	begin
541	destalpha := dest^.alpha;
542	if destalpha = 0 then
543	begin
544	dest^ := c
545	end else
546	if destalpha = 255 then
547	begin
548	dest^.red := ByteExclusionInline(dest^.red, c.red);
549	dest^.green := ByteExclusionInline(dest^.green, c.green);
550	dest^.blue := ByteExclusionInline(dest^.blue, c.blue);
551	dest^.alpha := c.alpha;
552	end else
553	begin
554	dest^.red := (ByteExclusionInline(dest^.red, c.red) * destalpha +
555	c.red * (not destalpha)) shr 8;
556	dest^.green := (ByteExclusionInline(dest^.green, c.green) *
557	destalpha + c.green * (not destalpha)) shr 8;
558	dest^.blue := (ByteExclusionInline(dest^.blue, c.blue) * destalpha +
559	c.blue * (not destalpha)) shr 8;
560	dest^.alpha := c.alpha;
561	end;
562	end;
563
564	function ByteLinearExclusionInline(a, b: byte): byte; inline;
565	begin
566	{$HINTS OFF}
567	Result := a+b-(a*b shr 7);
568	{$HINTS ON}
569	end;
570
571	procedure LinearExclusionPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline;
572	var
573	destalpha: byte;
574	begin
575	destalpha := dest^.alpha;
576	if destalpha = 0 then
577	begin
578	dest^ := c
579	end else
580	if destalpha = 255 then
581	begin
582	dest^.red := ByteLinearExclusionInline(dest^.red, c.red);
583	dest^.green := ByteLinearExclusionInline(dest^.green, c.green);
584	dest^.blue := ByteLinearExclusionInline(dest^.blue, c.blue);
585	dest^.alpha := c.alpha;
586	end else
587	begin
588	dest^.red := (ByteLinearExclusionInline(dest^.red, c.red) *
589	destalpha + c.red * (not destalpha)) shr 8;
590	dest^.green := (ByteLinearExclusionInline(dest^.green, c.green) *
591	destalpha + c.green * (not destalpha)) shr 8;
592	dest^.blue := (ByteLinearExclusionInline(dest^.blue, c.blue) *
593	destalpha + c.blue * (not destalpha)) shr 8;
594	dest^.alpha := c.alpha;
595	end;
596	end;
597
598	function ByteLinearSubtractInline(a, b: byte): byte; inline;
599	begin
600	if b >= a then
601	result := 0
602	else
603	result := a-b;
604	end;
605
606	procedure LinearSubtractPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline;
607	var
608	destalpha: byte;
609	begin
610	destalpha := dest^.alpha;
611	if destalpha = 0 then
612	begin
613	dest^ := c
614	end else
615	if destalpha = 255 then
616	begin
617	dest^.red := ByteLinearSubtractInline(dest^.red, c.red);
618	dest^.green := ByteLinearSubtractInline(dest^.green, c.green);
619	dest^.blue := ByteLinearSubtractInline(dest^.blue, c.blue);
620	dest^.alpha := c.alpha;
621	end else
622	begin
623	dest^.red := (ByteLinearSubtractInline(dest^.red, c.red) * destalpha +
624	c.red * (not destalpha)) shr 8;
625	dest^.green := (ByteLinearSubtractInline(dest^.green, c.green) *
626	destalpha + c.green * (not destalpha)) shr 8;
627	dest^.blue := (ByteLinearSubtractInline(dest^.blue, c.blue) * destalpha +
628	c.blue * (not destalpha)) shr 8;
629	dest^.alpha := c.alpha;
630	end;
631	end;
632
633	procedure LinearSubtractInversePixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline;
634	var
635	destalpha: byte;
636	begin
637	destalpha := dest^.alpha;
638	if destalpha = 0 then
639	begin
640	dest^ := c
641	end else
642	if destalpha = 255 then
643	begin
644	dest^.red := ByteLinearSubtractInline(dest^.red, not c.red);
645	dest^.green := ByteLinearSubtractInline(dest^.green, not c.green);
646	dest^.blue := ByteLinearSubtractInline(dest^.blue, not c.blue);
647	dest^.alpha := c.alpha;
648	end else
649	begin
650	dest^.red := (ByteLinearSubtractInline(dest^.red, not c.red) * destalpha +
651	c.red * (not destalpha)) shr 8;
652	dest^.green := (ByteLinearSubtractInline(dest^.green, not c.green) *
653	destalpha + c.green * (not destalpha)) shr 8;
654	dest^.blue := (ByteLinearSubtractInline(dest^.blue, not c.blue) * destalpha +
655	c.blue * (not destalpha)) shr 8;
656	dest^.alpha := c.alpha;
657	end;
658	end;
659
660	function ByteSubtractInline(a, b: byte): byte; inline;
661	begin
662	if b >= a then
663	result := 0
664	else
665	result := GammaCompressionTab[integer(GammaExpansionTab[a]) -
666	integer(GammaExpansionTab[b])];
667	end;
668
669	procedure SubtractPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline;
670	var
671	destalpha: byte;
672	begin
673	destalpha := dest^.alpha;
674	if destalpha = 0 then
675	begin
676	dest^ := c
677	end else
678	if destalpha = 255 then
679	begin
680	dest^.red := ByteSubtractInline(dest^.red, c.red);
681	dest^.green := ByteSubtractInline(dest^.green, c.green);
682	dest^.blue := ByteSubtractInline(dest^.blue, c.blue);
683	dest^.alpha := c.alpha;
684	end else
685	begin
686	dest^.red := (ByteSubtractInline(dest^.red, c.red) * destalpha +
687	c.red * (not destalpha)) shr 8;
688	dest^.green := (ByteSubtractInline(dest^.green, c.green) *
689	destalpha + c.green * (not destalpha)) shr 8;
690	dest^.blue := (ByteSubtractInline(dest^.blue, c.blue) * destalpha +
691	c.blue * (not destalpha)) shr 8;
692	dest^.alpha := c.alpha;
693	end;
694	end;
695
696	function ByteSubtractInverseInline(a, b: byte): byte; inline;
697	var aw,bw: word;
698	begin
699	aw := GammaExpansionTab[a];
700	bw := not GammaExpansionTab[b];
701	if bw >= aw then
702	result := 0
703	else
704	result := GammaCompressionTab[aw-bw];
705	end;
706
707	procedure SubtractInversePixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline;
708	var
709	destalpha: byte;
710	begin
711	destalpha := dest^.alpha;
712	if destalpha = 0 then
713	begin
714	dest^ := c
715	end else
716	if destalpha = 255 then
717	begin
718	dest^.red := ByteSubtractInverseInline(dest^.red, c.red);
719	dest^.green := ByteSubtractInverseInline(dest^.green, c.green);
720	dest^.blue := ByteSubtractInverseInline(dest^.blue, c.blue);
721	dest^.alpha := c.alpha;
722	end else
723	begin
724	dest^.red := (ByteSubtractInverseInline(dest^.red, c.red) * destalpha +
725	c.red * (not destalpha)) shr 8;
726	dest^.green := (ByteSubtractInverseInline(dest^.green, c.green) *
727	destalpha + c.green * (not destalpha)) shr 8;
728	dest^.blue := (ByteSubtractInverseInline(dest^.blue, c.blue) * destalpha +
729	c.blue * (not destalpha)) shr 8;
730	dest^.alpha := c.alpha;
731	end;
732	end;
733
734	function ByteNegationInline(a, b: byte): byte; inline;
735	var
736	sum: integer;
737	begin
738	sum := integer(GammaExpansionTab[a]) + integer(GammaExpansionTab[b]);
739	if sum > 65535 then
740	sum := 131071 - sum;
741	Result := GammaCompressionTab[sum];
742	end;
743
744	function ByteLinearNegationInline(a, b: byte): byte; inline;
745	var
746	sum: integer;
747	begin
748	sum := integer(a) + integer(b);
749	if sum > 255 then
750	Result := 511 - sum
751	else
752	Result := sum;
753	end;
754
755	procedure NegationPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline;
756	var
757	destalpha: byte;
758	begin
759	destalpha := dest^.alpha;
760	if destalpha = 0 then
761	begin
762	dest^ := c
763	end else
764	if destalpha = 255 then
765	begin
766	dest^.red := ByteNegationInline(dest^.red, c.red);
767	dest^.green := ByteNegationInline(dest^.green, c.green);
768	dest^.blue := ByteNegationInline(dest^.blue, c.blue);
769	dest^.alpha := c.alpha;
770	end else
771	begin
772	dest^.red := (ByteNegationInline(dest^.red, c.red) * destalpha +
773	c.red * (not destalpha)) shr 8;
774	dest^.green := (ByteNegationInline(dest^.green, c.green) * destalpha +
775	c.green * (not destalpha)) shr 8;
776	dest^.blue := (ByteNegationInline(dest^.blue, c.blue) * destalpha +
777	c.blue * (not destalpha)) shr 8;
778	dest^.alpha := c.alpha;
779	end;
780	end;
781
782	procedure LinearNegationPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline;
783	var
784	destalpha: byte;
785	begin
786	destalpha := dest^.alpha;
787	if destalpha = 0 then
788	begin
789	dest^ := c
790	end else
791	if destalpha = 255 then
792	begin
793	dest^.red := ByteLinearNegationInline(dest^.red, c.red);
794	dest^.green := ByteLinearNegationInline(dest^.green, c.green);
795	dest^.blue := ByteLinearNegationInline(dest^.blue, c.blue);
796	dest^.alpha := c.alpha;
797	end else
798	begin
799	dest^.red := (ByteLinearNegationInline(dest^.red, c.red) *
800	destalpha + c.red * (not destalpha)) shr 8;
801	dest^.green := (ByteLinearNegationInline(dest^.green, c.green) *
802	destalpha + c.green * (not destalpha)) shr 8;
803	dest^.blue := (ByteLinearNegationInline(dest^.blue, c.blue) *
804	destalpha + c.blue * (not destalpha)) shr 8;
805	dest^.alpha := c.alpha;
806	end;
807	end;
808
809	function ByteLightenInline(a, b: byte): byte; inline;
810	begin
811	if a > b then
812	Result := a
813	else
814	Result := b;
815	end;
816
817	procedure LightenPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline;
818	var
819	destalpha: byte;
820	begin
821	destalpha := dest^.alpha;
822	if destalpha = 0 then
823	begin
824	dest^ := c
825	end else
826	if destalpha = 255 then
827	begin
828	dest^.red := ByteLightenInline(dest^.red, c.red);
829	dest^.green := ByteLightenInline(dest^.green, c.green);
830	dest^.blue := ByteLightenInline(dest^.blue, c.blue);
831	dest^.alpha := c.alpha;
832	end else
833	begin
834	dest^.red := (ByteLightenInline(dest^.red, c.red) * destalpha +
835	c.red * (not destalpha)) shr 8;
836	dest^.green := (ByteLightenInline(dest^.green, c.green) * destalpha +
837	c.green * (not destalpha)) shr 8;
838	dest^.blue := (ByteLightenInline(dest^.blue, c.blue) * destalpha +
839	c.blue * (not destalpha)) shr 8;
840	dest^.alpha := c.alpha;
841	end;
842	end;
843
844	function ByteDarkenInline(a, b: byte): byte; inline;
845	begin
846	if a < b then
847	Result := a
848	else
849	Result := b;
850	end;
851
852	procedure DarkenPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline;
853	var
854	destalpha: byte;
855	begin
856	destalpha := dest^.alpha;
857	if destalpha = 0 then
858	begin
859	dest^ := c
860	end else
861	if destalpha = 255 then
862	begin
863	dest^.red := ByteDarkenInline(dest^.red, c.red);
864	dest^.green := ByteDarkenInline(dest^.green, c.green);
865	dest^.blue := ByteDarkenInline(dest^.blue, c.blue);
866	dest^.alpha := c.alpha;
867	end else
868	begin
869	dest^.red := (ByteDarkenInline(dest^.red, c.red) * destalpha +
870	c.red * (not destalpha)) shr 8;
871	dest^.green := (ByteDarkenInline(dest^.green, c.green) * destalpha +
872	c.green * (not destalpha)) shr 8;
873	dest^.blue := (ByteDarkenInline(dest^.blue, c.blue) * destalpha +
874	c.blue * (not destalpha)) shr 8;
875	dest^.alpha := c.alpha;
876	end;
877	end;
878
879	{$hints off}
880	function ScreenByteInline(a, b: byte): byte;
881	begin
882	Result := 255 - ((not a) * (not b) shr 8);
883	end;
884	{$hints on}
885
886	procedure ScreenPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline;
887	var
888	destalpha: byte;
889	begin
890	destalpha := dest^.alpha;
891	if destalpha = 0 then
892	begin
893	dest^ := c
894	end else
895	if destalpha = 255 then
896	begin
897	dest^.red := ScreenByteInline(dest^.red, c.red);
898	dest^.green := ScreenByteInline(dest^.green, c.green);
899	dest^.blue := ScreenByteInline(dest^.blue, c.blue);
900	dest^.alpha := c.alpha;
901	end else
902	begin
903	dest^.red := (ScreenByteInline(dest^.red, c.red) * destalpha +
904	c.red * (not destalpha)) shr 8;
905	dest^.green := (ScreenByteInline(dest^.green, c.green) * destalpha +
906	c.green * (not destalpha)) shr 8;
907	dest^.blue := (ScreenByteInline(dest^.blue, c.blue) * destalpha +
908	c.blue * (not destalpha)) shr 8;
909	dest^.alpha := c.alpha;
910	end;
911	end;
912
913	function ByteSoftLightInline(a,b: byte): byte; inline;
914	begin
915	result := ((not a)b shr 7 + a)a div 255;
916	end;
917
918	procedure SoftLightPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline;
919	var
920	destalpha: byte;
921	begin
922	destalpha := dest^.alpha;
923	if destalpha = 0 then
924	begin
925	dest^ := c
926	end else
927	if destalpha = 255 then
928	begin
929	dest^.red := ByteSoftLightInline(dest^.red, c.red);
930	dest^.green := ByteSoftLightInline(dest^.green, c.green);
931	dest^.blue := ByteSoftLightInline(dest^.blue, c.blue);
932	dest^.alpha := c.alpha;
933	end else
934	begin
935	dest^.red := (ByteSoftLightInline(dest^.red, c.red) * destalpha +
936	c.red * (not destalpha)) shr 8;
937	dest^.green := (ByteSoftLightInline(dest^.green, c.green) * destalpha +
938	c.green * (not destalpha)) shr 8;
939	dest^.blue := (ByteSoftLightInline(dest^.blue, c.blue) * destalpha +
940	c.blue * (not destalpha)) shr 8;
941	dest^.alpha := c.alpha;
942	end;
943	end;
944
945	function ByteSvgSoftLightInline(a,b: byte): byte; inline;
946	begin
947	if b <= 128 then
948	result := a - (((256 - b-b)a shr 8)(not a) shr 8)
949	else
950	begin
951	dec(b, 128);
952	if a <= 64 then
953	result := a + ((b+b) * NativeUInt(a7 - ((a shl 2)(a shl 2 + 256)*NativeUInt(256 - a) shr 16)) shr 8)
954	else
955	result := a + ((b+b+1) * NativeUInt(ByteSqrt(a)-a) shr 8);
956	end;
957	end;
958
959	procedure SvgSoftLightPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline;
960	var
961	destalpha: byte;
962	begin
963	destalpha := dest^.alpha;
964	if destalpha = 0 then
965	begin
966	dest^ := c
967	end else
968	if destalpha = 255 then
969	begin
970	dest^.red := ByteSvgSoftLightInline(dest^.red, c.red);
971	dest^.green := ByteSvgSoftLightInline(dest^.green, c.green);
972	dest^.blue := ByteSvgSoftLightInline(dest^.blue, c.blue);
973	dest^.alpha := c.alpha;
974	end else
975	begin
976	dest^.red := (ByteSvgSoftLightInline(dest^.red, c.red) * destalpha +
977	c.red * (not destalpha)) shr 8;
978	dest^.green := (ByteSvgSoftLightInline(dest^.green, c.green) * destalpha +
979	c.green * (not destalpha)) shr 8;
980	dest^.blue := (ByteSvgSoftLightInline(dest^.blue, c.blue) * destalpha +
981	c.blue * (not destalpha)) shr 8;
982	dest^.alpha := c.alpha;
983	end;
984	end;
985
986	function ByteHardLightInline(a,b: byte): byte; inline;
987	begin
988	if b <= 128 then
989	result := a*b shr 7
990	else
991	result := 255 - ((not a)*(not b) shr 7);
992	end;
993
994	procedure HardLightPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline;
995	var
996	destalpha: byte;
997	begin
998	destalpha := dest^.alpha;
999	if destalpha = 0 then
1000	begin
1001	dest^ := c
1002	end else
1003	if destalpha = 255 then
1004	begin
1005	dest^.red := ByteHardLightInline(dest^.red, c.red);
1006	dest^.green := ByteHardLightInline(dest^.green, c.green);
1007	dest^.blue := ByteHardLightInline(dest^.blue, c.blue);
1008	dest^.alpha := c.alpha;
1009	end else
1010	begin
1011	dest^.red := (ByteHardLightInline(dest^.red, c.red) * destalpha +
1012	c.red * (not destalpha)) shr 8;
1013	dest^.green := (ByteHardLightInline(dest^.green, c.green) * destalpha +
1014	c.green * (not destalpha)) shr 8;
1015	dest^.blue := (ByteHardLightInline(dest^.blue, c.blue) * destalpha +
1016	c.blue * (not destalpha)) shr 8;
1017	dest^.alpha := c.alpha;
1018	end;
1019	end;
1020
1021	procedure BlendXorPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline;
1022	var
1023	destalpha: byte;
1024	begin
1025	destalpha := dest^.alpha;
1026	if destalpha = 0 then
1027	begin
1028	dest^ := c
1029	end else
1030	if destalpha = 255 then
1031	begin
1032	dest^.red := dest^.red xor c.red;
1033	dest^.green := dest^.green xor c.green;
1034	dest^.blue := dest^.blue xor c.blue;
1035	dest^.alpha := c.alpha;
1036	end else
1037	begin
1038	dest^.red := ((dest^.red xor c.red) * destalpha + c.red * (not destalpha)) shr 8;
1039	dest^.green := ((dest^.green xor c.green) * destalpha + c.green *
1040	(not destalpha)) shr 8;
1041	dest^.blue := ((dest^.blue xor c.blue) * destalpha + c.blue * (not destalpha)) shr 8;
1042	dest^.alpha := c.alpha;
1043	end;
1044	end;
1045

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format