-
Notifications
You must be signed in to change notification settings - Fork 0
/
pxlrage.pas
5809 lines (5134 loc) · 174 KB
/
pxlrage.pas
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
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
unit pxlrage;
(* ############################################################################
# Author: Jon Lennart Aasenden #
# Company: Jolead EM #
# License: Copyright Jon Lennart Aasenden, all rights reserved under the #
# international software apartment ownership act #
############################################################################
/$$$$$$$ /$$ /$$ /$$$$$$$
| $$__ $$|__/ | $$| $$__ $$
| $$ \ $$ /$$ /$$ /$$ /$$$$$$ | $$| $$ \ $$ /$$$$$$ /$$$$$$ /$$$$$$
| $$$$$$$/| $$| $$ /$$/ /$$__ $$| $$| $$$$$$$/ |____ $$ /$$__ $$ /$$__ $$
| $$____/ | $$ \ $$$$/ | $$$$$$$$| $$| $$__ $$ /$$$$$$$| $$ \ $$| $$$$$$$$
| $$ | $$ gt;$$ $$ | $$_____/| $$| $$ \ $$ /$$__ $$| $$ | $$| $$__/
| $$ | $$ /$$/\ $$| $$$$$$$| $$| $$ | $$| $$$$$$$| $$$$$$$| $$$$$$$
|__/ |__/|__/ \__/ \_______/|__/|__/ |__/ \_______/ \____ $$ \_______/
/$$ \ $$
| $$$$$$/
\______/
About
=====
PXR is a slim, easy to use and innovative graphics library that
represents a foundation for further, more advanced libraries.
As such SL does not implement everything under the sun, but
aims to provide a rock-solid basis that can be easily extended.
By default the unit implements a RAW surface, which is basically
a surface held in RAM without any device context. It also
provides a Windows DIB implementation that does have a context
and can thus be used with blitting and Delphi canvas operations.
PXR is not about the latest cool feature. It is about providing a platform
independent foundation, assemly free, that other more advanced libraries can
be based.
Features
========
- 8, 15, 16, 24 and 32 bit pixelbuffers
- Fast native blitter between pixel formats (e.g copy from 32bpp -> 8bpp)
- Palette handling
- Clipping
- Basic primitives (circle, ellipse, rectangle)
- Fill mechanism
- Alpha blending
- Transparency
- DIB implementation
- UNI implementation
DIB vs. UNI
===========
A dib (device independent bitmap) allocated un-paged memory to hold the image.
The current dib implementation is windows only (although iOS and OSX have
similar calls).
A "uni surface" is allocated from normal memory (using allocmem). This is
perfect for service applications where security does not allow you to allocate
a device context or window handle.
Dependencies
============
Pixelrage depends on some memory functions in ByteRage:
http://code.google.com/p/byterage/source/browse/trunk/brage.pas
*)
{$DEFINE PXR_USE_DELPHI}
{$DEFINE PXR_USE_WINDOWS}
{.$DEFINE PXR_USE_MAC}
{.$DEFINE PXR_USE_FREEPASCAL}
{.$DEFINE PXR_USE_TESTING}
interface
uses
{$IFDEF MSWINDOWS}
windows,
{$ENDIF}
sysutils, classes, math, brage,
graphics;
Type
(* Exceptions *)
EPXRSurfaceCustom = Class(Exception);
EPXRPalette = Class(Exception);
EPXRColor = Class(Exception);
EPXRRect = Class(Exception);
(* Forward declarations *)
TPXRRect = Class;
TPXRColorCustom = Class;
TPXRPaletteColor = Class;
TPXRPaletteNetScape = Class;
TPXRSurfaceCustom = Class;
TPXRSurfaceUNI = Class;
TPXRSurfaceDIB = Class;
(* Custom types *)
TPXRRectExposure = (esNone,esPartly,esCompletely);
TPXRPointArray = Array of TPoint;
TPXRColorArray = Array of TColor;
TRGBQuadArray = Packed Array[0..255] of TRGBQuad;
PRGBQuadArray = ^TRGBQuadArray;
TPXRColorPercent = 0..100;
TPXRRampType = (rtRampUp,rtRampDown);
TPXRDrawMode = (dmCopy,dmBlend);
TPXRPenStyle = (stOutline,stSolid);
TPXRBlitterProc = procedure of Object;
TPXRReaderProc = Procedure (Const Col,Row:Integer;
var outData) of Object;
TPXRWriterProc = Procedure (Const Col,Row:Integer;
Const inData) of Object;
TPXRFillRegionMethod = Procedure (Const Region:TRect;
Const inData) of Object;
TPXRDrawEllipseMethod = procedure (const Domain:TRect) of Object;
TPXRDrawPolygonMethod = procedure (Const Domain:TPXRPointArray) of Object;
TPXRPixelCopyProc = Procedure (const thispixel;var thatpixel) of Object;
TPXRPixelDecoderProc = Procedure(const ThisPixel;var R,G,B:Byte) of Object;
TPXRPixelEncoderProc = procedure(Const R,G,B:Byte;var ThatPixel) of Object;
(* Event method types *)
TPXREventDrawModeAltered = Procedure (sender:TObject;
const aOldValue:TPXRDrawMode;
const aNewValue:TPXRDrawMode) of Object;
TPXREventPenStyleAltered = Procedure (sender:TObject;
Const aOldValue:TPXRPenStyle;
Const aNewValue:TPXRPenStyle) of Object;
TPXREventTransparencyAltered = Procedure (Sender:TObject;
const aNewValue:Boolean) of Object;
TPXREventPenColorAltered = procedure (sender:TObject;
const aOldValue:TColor;
const aNewValue:TColor) of Object;
TPXREventTransparentColorAltered = procedure (sender:TObject;
const aOldValue:TColor;
const aNewValue:TColor) of Object;
TPXRRect = Class(TObject)
Private
FRect: TRect;
FOnAltered: TNotifyEvent;
Function GetLeft:Integer;
Function GetRight:Integer;
Function GetTop:Integer;
Function GetBottom:Integer;
Function GetWidth:Integer;
Function getHeight:Integer;
Public
class function HeightOf(const Domain:TRect):Integer;
class function WidthOf(Const Domain:TRect):Integer;
class procedure Realize(var Domain:TRect);
class function Intersect(const Primary,Secondary:TRect;
var Intersection:TRect):Boolean;
class procedure ClipTo(var Child:TRect;Const Domain:TRect);
class function IsValid(Const Domain:TRect):Boolean;
class function IsVisible(Const Child,Domain:TRect):TPXRRectExposure;
class function IsWithin(Const Left,Top:Integer;
Const Domain:TRect):Boolean;overload;
class function IsWithin(Const Child:TPoint;
Const Domain:TRect):Boolean;overload;
class function IsWithin(Const Child:TRect;
Const Domain:TRect):Boolean;overload;
class function MakeAbs(const aLeft,aTop,aRight,aBottom:Integer):TRect;
class function Make(const aLeft,aTop,aWidth,aHeight:Integer):TRect;
class function toString(const Domain:TRect;
Const Full:Boolean=True):String;
class function toPoints(const Domain:TRect):TPXRPointArray;
function Contains(Const Child:TRect):Boolean;overload;
Function Contains(Const Left,Top:Integer):Boolean;overload;
Function Contains(Const Child:TPoint):Boolean;overload;
class function NullRect:TRect;
Property Left:Integer read getLeft;
Property Top:Integer read GetTop;
Property Right:Integer read GetRight;
Property Bottom:Integer read GetBottom;
Property Width:Integer read GetWidth;
Property Height:Integer read Getheight;
Property Value:TRect read FRect;
Procedure SetRect(aLeft,aTop,aRight,aBottom:Integer);overload;
Procedure SetRect(Domain:TRect);overload;
procedure setRect(aWidth,aHeight:Integer);overload;
Procedure Clip(var Value:TRect);
Function ContainsRow(Const Row:Integer):Boolean;
Function ContainsColumn(Const Col:Integer):Boolean;
Procedure Clear;
Function Empty:Boolean;
Class Function Compare(Const aFirst,aSecond:TRect):Boolean;
Property OnRectAltered:TNotifyEvent
read FOnAltered write FOnAltered;
Constructor Create;virtual;
End;
TPXRColorPresets = Class(TObject)
Private
FParent: TPXRColorCustom;
Public
Procedure White;
procedure Black;
Procedure Red;
Procedure Green;
Procedure Blue;
Procedure Cyan;
Procedure Magenta;
Procedure Indigo;
Procedure LimeGreen;
Procedure Pink;
Procedure Tomato;
Procedure Orange;
Procedure Violet;
Procedure Gold;
procedure Khaki;
Constructor Create(AOwner:TPXRColorCustom);reintroduce;
End;
(* The color class *)
TPXRColorCustom = Class(TPersistent)
Private
FRed: Byte;
FGreen: Byte;
FBlue: Byte;
FColorRef: TColor;
FOnChange: TNotifyEvent;
FBusy: Boolean;
FPresets: TPXRColorPresets;
Protected
Procedure SetRed(Const Value:Byte);
Procedure SetGreen(Const Value:Byte);
procedure SetBlue(Const Value:Byte);
Procedure SetColorRef(Const Value:TColor);
Procedure TripletsChanged;virtual;
Protected
procedure AssignTo(Dest:TPersistent);override;
Public
Property Red:Byte read FRed write SetRed;
Property Green:Byte read FGreen write SetGreen;
property Blue:Byte read FBlue write SetBlue;
Property Presets:TPXRColorPresets read Fpresets;
Procedure SetRGB(aRed,aGreen,aBlue:Byte);
Procedure toRGB15(var buffer);
Procedure toRGB16(var buffer);
Procedure toRGB24(var buffer);
Procedure toRGB32(var buffer);
Procedure fromRGB15(Const buffer);
Procedure fromRGB16(Const buffer);
Procedure fromRGB24(Const buffer);
Procedure fromRGB32(Const buffer);
Procedure Darker(Const Percent:TPXRColorPercent);
Procedure Brighter(Const Percent:TPXRColorPercent);
Procedure BlendFrom(Const Value:TColor;Const Factor:Byte);
Function BlendTo(Const Value:TColor;Const Factor:Byte):TColor;
Procedure Balance;overload;
Procedure Invert;overload;
Function Luminance:Integer;overload;
Procedure SetHSV(const H,S,V:Integer);
Procedure GetHSV(var H,S,V:Integer);
Function toHTML:String;
{$IFDEF MSWINDOWS}
Class function CheckSysColor(Const Value:TColor):Boolean;
{$ENDIF}
Class Function Blend(Const First,Second:TColor;
Const Factor:TPXRColorPercent):TColor;
Class Function Encode(Const R,G,B:Byte):TColor;
Class procedure Decode(Value:TColor;Var Red,Green,Blue:Byte);
Class Procedure ColorTo15(Const Color:TColor;var Buffer);
Class Procedure ColorTo16(Const Color:TColor;var Buffer);
Class Procedure ColorTo24(Const Color:TColor;var Buffer);
Class Procedure ColorTo32(Const Color:TColor;var Buffer);
Class Function ColorFrom15(Const Buffer):TColor;
Class Function ColorFrom16(Const Buffer):TColor;
Class Function ColorFrom24(Const Buffer):TColor;
Class Function ColorFrom32(Const Buffer):TColor;
Class Procedure RGBFrom15(Const buffer;var R,G,B:Byte);
Class procedure RGBFrom16(Const buffer;var R,G,B:Byte);
Class Procedure RGBFrom24(Const buffer;var R,G,B:Byte);
Class procedure RGBFrom32(Const buffer;var R,G,B:Byte);
Class Procedure RGBTo15(var buffer;Const R,G,B:Byte);
Class procedure RGBTo16(var buffer;Const R,G,B:Byte);
Class Procedure RGBTo24(var buffer;Const R,G,B:Byte);
Class procedure RGBTo32(var buffer;Const R,G,B:Byte);
class procedure Blend15(const first;const second;
Const Alpha:Byte;var target);
class procedure Blend16(const first;const second;
Const Alpha:Byte;var target);
class procedure Blend24(const first;const second;
Const Alpha:Byte;var target);
class procedure Blend32(const first;const second;
Const Alpha:Byte;var target);
Class Function Invert(Const Value:TColor):TColor;overload;
Class Function Luminance(Const Value:TColor):Integer;overload;
Class Function Balance(Const Value:TColor):TColor;overload;
class function Ramp(Const Value:TColor;
aCount:Byte;Style:TPXRRampType):TPXRColorArray;
Constructor Create;virtual;
Destructor Destroy;Override;
Procedure AfterConstruction;Override;
Published
Property OnColorChanged:TNotifyEvent
read FOnChange write FOnChange;
Property ColorRef:TColor read FColorRef write SetColorRef;
End;
TPXRPaletteCustom = Class(TPersistent)
Protected
Function GetByteSize:Integer;virtual;
Procedure GetItemQuad(Index:Integer;Var Data);virtual;abstract;
Function GetCount:Integer;virtual;abstract;
Function GetItem(index:Integer):TColor;virtual;abstract;
Procedure SetItem(Index:Integer;Value:TColor);virtual;abstract;
Function GetReadOnly:Boolean;virtual;abstract;
Protected
procedure AssignTo(Dest: TPersistent);Override;
Public
Property ReadOnly:Boolean read GetReadOnly;
Property Items[index:Integer]:TColor
read GetItem write SetItem;
Property Count:Integer read GetCount;
Property Size:Integer read GetByteSize;
Procedure ExportQuadArray(Const Target);
Procedure ExportRGB(Const index:Integer;var R,G,B:Byte);virtual;
function ExportColorObj(Const index:Byte):TPXRPaletteColor;
Function Match(r,g,b:Byte):Integer;overload;dynamic;abstract;
Function Match(Value:TColor):Integer;overload;dynamic;
End;
TPXRPaletteNetscape = Class(TPXRPaletteCustom)
Private
FQuads: TRGBQuadArray;
Protected
Function GetReadOnly:Boolean;override;
Procedure GetItemQuad(Index:Integer;Var Data);override;
Function GetCount:Integer;override;
Function GetItem(index:Integer):TColor;override;
Procedure SetItem(Index:Integer;Value:TColor);override;
Public
Procedure ExportRGB(Const index:Integer;var R,G,B:Byte);override;
Function Match(r,g,b:Byte):Integer;override;
Constructor Create;virtual;
End;
TPXRPaletteColor = Class(TPXRColorCustom)
public
Procedure toRGB08(Const Palette:TPXRPaletteCustom;var buffer);virtual;
Public
class Function ColorFrom08(Const Palette:TPXRPaletteCustom;
Const Buffer):TColor;virtual;
Class Procedure ColorTo08(Const Color:TColor;
Const Palette:TPXRPaletteCustom;var Buffer);virtual;
Class Procedure RGBFrom08(Const Palette:TPXRPaletteCustom;
Const buffer;var R,G,B:Byte);
class procedure Blend08(Const Palette:TPXRPaletteCustom;
const first;const second;
Const Alpha:Byte;var target);
End;
TPXRSurfaceCustom = Class(TPersistent)
Private
FWidth: Integer;
FHeight: Integer;
FFormat: TPixelFormat;
FBitsPP: Integer;
FBytesPP: Integer;
FPitch: Integer;
FDataSize: Integer;
FColor: TColor;
FColorRaw: Longword;
FBounds: TRect;
FClipRect: TRect;
FClipObj: TPXRRect;
FPenColor: TPXRPaletteColor;
FPenAlpha: Byte;
FTransparent: Boolean;
FTransColor: TColor;
FTransRaw: Longword;
FDrawMode: TPXRDrawMode;
FPenStyle: TPXRPenStyle;
FPalette: TPXRPaletteCustom;
FCursor: TPoint;
(* blitting *)
FCopyTrans: Boolean;
FCopyKey: Longword;
FCopySrc: PByte;
FCopyDst: PByte;
FCopyPal: TPXRPaletteCustom;
FCopyCnt: Integer;
FCopysrcRect: TRect;
FCopydstRect: TRect;
FCopyDecoder: TPXRPixelDecoderProc;
FCopyEncoder: TPXRPixelEncoderProc;
FCopyLPC: TPXRBlitterProc;
Private
(* Event declarations *)
FOnPenStyleAltered: TPXREventPenStyleAltered;
FOnDrawModeAltered: TPXREventDrawModeAltered;
FOnPenColorAltered: TPXREventPenColorAltered;
FOnTransparencyAltered: TPXREventTransparencyAltered;
FOnTransparentColorAltered: TPXREventTransparentColorAltered;
Private
(* To speed things up we use lookup tables for functions that will
be called many times during the use of a surface. For instance,
instead of checking the pixelformat for every write - we test it
once and assign the correct writing procedure to a variable.
That way the surface always knows the fastest way to draw a pixel. *)
FReadLUT: TPXRReaderProc;
FWriteLUT: TPXRWriterProc;
FFillRectLUT: TPXRFillRegionMethod;
FReadLUTEX: Array[pf8bit..pf32bit] of TPXRReaderProc;
FWriteLUTEX: Array[pf8bit..pf32bit,dmCopy..dmBlend] of TPXRWriterProc;
FEllipseLUTEX: Array[stOutline..stSolid] of TPXRDrawEllipseMethod;
FFillRectLUTEX: Array[pf8bit..pf32bit,dmCopy..dmBlend] of TPXRFillRegionMethod;
FBlitterLUT: Array[pf8Bit..pf32Bit,pf8Bit..pf32Bit] of TPXRBlitterProc;
FPXTraLUT: Array[pf8Bit..pf32Bit,pf8Bit..pf32Bit] of TPXRPixelCopyProc;
FDecoderLUT: Array[pf8Bit..pf32Bit] of TPXRPixelDecoderProc;
FEncoderLUT: Array[pf8Bit..pf32Bit] of TPXRPixelEncoderProc;
Private
(* Pixel reader implementations, these are the procs used by our
LUT functin pointers above *)
Procedure Read08(Const Col,Row:Integer;var outData);
Procedure Read16(Const Col,Row:Integer;var outData);
Procedure Read24(Const Col,Row:Integer;var outData);
Procedure Read32(Const Col,Row:Integer;var outData);
Private
(* Pixel writer implementations *)
Procedure Write08(Const Col,Row:Integer;Const inData);
Procedure Write16(Const Col,Row:Integer;Const inData);
Procedure Write24(Const Col,Row:Integer;Const inData);
Procedure Write32(Const Col,Row:Integer;Const inData);
Procedure Write32B(Const Col,Row:Integer;const inData);
Procedure Write24B(Const Col,Row:Integer;const inData);
Procedure Write16B(Const Col,Row:Integer;const inData);
Procedure Write15B(Const Col,Row:Integer;const inData);
Procedure Write08B(Const Col,Row:Integer;const inData);
Private
(* Fill rect implementation *)
Procedure FillRect08(Const Region:TRect;Const inData);
Procedure FillRect16(Const Region:TRect;Const inData);
procedure FillRect24(Const Region:TRect;Const inData);
Procedure FillRect32(Const Region:TRect;Const inData);
procedure FillRectWithWriter(Const Region:TRect;Const inData);
(* Our Blitter engine *)
Private
Procedure CPY8bitTo8Bit;
Procedure CPY8BitTo15Bit;
Procedure CPY8BitTo16Bit;
Procedure CPY8BitTo24Bit;
Procedure CPY8BitTo32Bit;
Procedure CPY15bitTo8Bit;
Procedure CPY15BitTo15Bit;
Procedure CPY15BitTo16Bit;
Procedure CPY15BitTo24Bit;
Procedure CPY15BitTo32Bit;
Procedure CPY16bitTo8Bit;
Procedure CPY16BitTo15Bit;
Procedure CPY16BitTo16Bit;
Procedure CPY16BitTo24Bit;
Procedure CPY16BitTo32Bit;
Procedure CPY24bitTo8Bit;
Procedure CPY24BitTo15Bit;
Procedure CPY24BitTo16Bit;
Procedure CPY24BitTo24Bit;
Procedure CPY24BitTo32Bit;
Procedure CPY32bitTo8Bit;
Procedure CPY32BitTo15Bit;
Procedure CPY32BitTo16Bit;
Procedure CPY32BitTo24Bit;
Procedure CPY32BitTo32Bit;
(* Pixel converters *)
Private
Procedure PxConv08x08(const thispixel;var thatpixel);
Procedure PxConv08x15(const thispixel;var thatpixel);
Procedure PxConv08x16(const thispixel;var thatpixel);
Procedure PxConv08x24(const thispixel;var thatpixel);
Procedure PxConv08x32(const thispixel;var thatpixel);
Procedure PxConv15x08(const thispixel;var thatpixel);
Procedure PxConv15x15(const thispixel;var thatpixel);
Procedure PxConv15x16(const thispixel;var thatpixel);
Procedure PxConv15x24(const thispixel;var thatpixel);
Procedure PxConv15x32(const thispixel;var thatpixel);
Procedure PxConv16x08(const thispixel;var thatpixel);
Procedure PxConv16x15(const thispixel;var thatpixel);
Procedure PxConv16x16(const thispixel;var thatpixel);
Procedure PxConv16x24(const thispixel;var thatpixel);
Procedure PxConv16x32(const thispixel;var thatpixel);
Procedure PxConv24x08(const thispixel;var thatpixel);
Procedure PxConv24x15(const thispixel;var thatpixel);
Procedure PxConv24x16(const thispixel;var thatpixel);
Procedure PxConv24x24(const thispixel;var thatpixel);
Procedure PxConv24x32(const thispixel;var thatpixel);
Procedure PxConv32x08(const thispixel;var thatpixel);
Procedure PxConv32x15(const thispixel;var thatpixel);
Procedure PxConv32x16(const thispixel;var thatpixel);
Procedure PxConv32x24(const thispixel;var thatpixel);
Procedure PxConv32x32(const thispixel;var thatpixel);
Private
(* pixel decoders *)
Procedure Decode08(const thispixel;var R,G,B:Byte);
Procedure Decode15(const thispixel;var R,G,B:Byte);
Procedure Decode16(const thispixel;var R,G,B:Byte);
Procedure Decode24(const thispixel;var R,G,B:Byte);
Procedure Decode32(const thispixel;var R,G,B:Byte);
(* pixel encoders *)
Procedure Encode08(Const R,G,B:Byte; var thatpixel);
Procedure Encode15(Const R,G,B:Byte; var thatpixel);
Procedure Encode16(Const R,G,B:Byte; var thatpixel);
Procedure Encode24(Const R,G,B:Byte; var thatpixel);
Procedure Encode32(Const R,G,B:Byte; var thatpixel);
Private
Procedure EllipseOutline(Const ARect:TRect);
Procedure EllipseFilled(Const ARect:TRect);
Private
Procedure FillRow(Const Row:Integer;Col,inCount:Integer;var inData);
Procedure FillCol(Const Col:Integer;Row,inCount:Integer;var inData);
Protected
(* Cursor functionality *)
Procedure SetCursor(Value:TPoint);
Protected
(* PenStyle *)
function getPenStyle:TPXRPenStyle;
Procedure SetPenStyle(Value:TPXRPenStyle);
Protected
(* Get & Set drawing mode *)
Function GetDrawMode:TPXRDrawMode;virtual;
Procedure SetDrawMode(Value:TPXRDrawMode);virtual;
Protected
(* Methods to get/set current pen color. On setting a new color it is
converted into a "native color" (see above) which is used for drawing *)
Function GetColorValue:TColor;
Procedure SetColorValue(Value:TColor);
Protected
(* Methods dealing with surface transparency. The concept of a transparent
surface only comes into play in context with another surface
(e.g when blitting from A to B) *)
Function GetTransparentColorValue:TColor;
Procedure SetTransparentColorValue(Value:TColor);
Procedure SetTransparent(Value:Boolean);
Protected
Function GetPenAlpha:Byte;
Procedure SetPenAlpha(Value:Byte);
Protected
(* Methods for plotting pixels through the Pixels[] property.
These are safe and implements clipping *)
Function GetPixel(Const col,Row:Integer):TColor;
Procedure SetPixel(Const Col,Row:Integer;Value:TColor);
Protected
(* Helper methods that returns information needed for normal pixmap
operations, these are safe to call without any prior checking *)
Function GetPerPixelBits(aFormat:TPixelFormat):Integer;
Function GetPerPixelBytes(aFormat:TPixelFormat):Integer;
Function GetStrideAlign(Const Value,ElementSize:Integer;
Const AlignSize:Integer=4):Integer;
Protected
(* Method to get the adresse of a pixel. This method does not check
its parameters, so only call this after checking values. It calls the
abstract method "GetScanLine" to get it's root adresse *)
Function GetPixelAddr(Const Col,Row:Integer):PByte;virtual;
Protected
(* Event handler for our current TPXRColor object. Whenever someone
Alters the RGB value within this class, this event triggers here.
This means that the corresponding palette index must be found,
or the colorvalue converted into a native pixel [e.g 8/15/16 bit] *)
Procedure HandleColorChanged(Sender:TObject);virtual;
Procedure HandleClipRectChanged(Sender:TObject);virtual;
Protected
(* Abstract methods. This class provides basic functionality only.
It is up to the implementor to provide code that actually allocate
a pixel buffer. See the TPXRSurfaceDIB and TPXRSurfaceRAW for full
implementations of these methods *)
Function GetScanLine(Const Row:Integer):PByte;virtual;abstract;
Function GetEmpty:Boolean;virtual;abstract;
Procedure ReleaseSurface;virtual;abstract;
Procedure AllocSurface(var aWidth,aHeight:Integer;
var aFormat:TPixelFormat;
out aPitch:Integer;
out aBufferSize:Integer);virtual;abstract;
Procedure PaletteChange(NewPalette:TPXRPaletteCustom);virtual;abstract;
public
(* Methods to convert pixel data between TColor and native, as well as
blending two pixels directly. These methods must only be called after
checking the parameters *)
Procedure NativePixelToColor(Const Data;var Value:TColor);
Procedure ColorToNativePixel(Value:TColor;var Data);
Public
Property Palette:TPXRPaletteCustom read FPalette;
Property Color:TPXRPaletteColor read FPenColor;
Property ClipRect:TPXRRect read FClipObj;
Property Transparent:Boolean
read FTransparent
write SetTransparent;
Property TransparentColor:TColor
read GetTransparentColorValue
write SetTransparentColorValue;
Property ScanLine[Const Row:Integer]:PByte read GetScanline;
Property Pixels[Const Col,Row:Integer]:TColor
read GetPixel write SetPixel;
Property Width:Integer read FWidth;
Property Pitch:Integer read FPitch;
Property Height:Integer read FHeight;
Property Empty:Boolean read GetEmpty;
Property BoundsRect:TRect read FBounds;
Property PerPixelBits:Integer read FBitsPP;
Property PerPixelBytes:Integer read FBytesPP;
Property PixelFormat:TPixelformat read FFormat;
Property Cursor:TPoint read FCursor write SetCursor;
Property DrawMode:TPXRDrawMode read GetDrawMode write SetDrawMode;
Property PenStyle:TPXRPenStyle read getPenStyle write SetPenStyle;
Property PenAlpha:Byte read FPenAlpha write FPenAlpha;
Procedure SetPalette(aPalette:TPXRPaletteCustom);
Function PixelAddr(Const Col,Row:Integer):PByte;
Procedure AdjustToBoundsRect(var Domain:TRect);
Procedure LineH(Col,Row:Integer;NumberOfColumns:Integer);
Procedure LineV(Col,Row:Integer;NumberOfRows:Integer);
Procedure LineTo(Const Col,Row:Integer);
Procedure Line(Left,Top,Right,Bottom:Integer);
Procedure Bezier(Const Domain:TPXRPointArray);
procedure Ellipse(Domain:TRect);
Procedure FillRect(Domain:TRect;Const Value:TColor);overload;
Procedure FillRect(Domain:TRect);overload;
Procedure Rectangle(Const Domain:TRect);overload;
Procedure Rectangle(Const Domain:TRect;Const Value:TColor);overload;
Procedure DiagonalGrid(Domain:TRect;Const Spacing:Integer=8);
Procedure MoveTo(Left,Top:Integer);
Procedure StretchDraw(const Source:TPXRSurfaceCustom;
SourceRect,DestinationRect:TRect);
Procedure Draw(Const Source:TPXRSurfaceCustom;
SourceRect:TRect;DestinationRect:TRect);overload;
Procedure Draw(const Source:TPXRSurfaceCustom;
SourceRect:TRect;Const Col,Row:Integer);overload;
Procedure Read(Const Col,Row:Integer;var aData);
Procedure WriteClipped(Const Col,Row:Integer);overload;
Procedure WriteClipped(Const Col,Row:Integer;Const pxData);overload;
Procedure WriteClipped(Const Col,Row:Integer;Const Color:TColor);overload;
function getDecoder:TPXRPixelDecoderProc;
function getEncoder:TPXRPixelEncoderProc;
function getReader:TPXRReaderProc;
function getWriter:TPXRWriterProc;
Procedure Release;
Procedure Alloc(aWidth,aHeight:Integer;aFormat:TPixelFormat);
Procedure BeforeDestruction;Override;
Constructor Create;virtual;
Destructor Destroy;Override;
public
Property OnPenStyleAltered:TPXREventPenStyleAltered
read FOnPenStyleAltered write FOnPenStyleAltered;
Property OnDrawModeAltered:TPXREventDrawModeAltered
read FOnDrawModeAltered write FOnDrawModeAltered;
Property OnTransparencyAltered:TPXREventTransparencyAltered
read FOnTransparencyAltered
write FOnTransparencyAltered;
Property OnPenColorAltered:TPXREventPenColorAltered
read FOnPenColorAltered
write FOnPenColorAltered;
Property OnTransparentColorAltered:TPXREventTransparentColorAltered
read FOnTransparentColorAltered
write FOnTransparentColorAltered;
End;
TPXRSurfaceUNI = Class(TPXRSurfaceCustom)
Private
FBuffer: PByte;
FBufSize: Integer;
Protected
Procedure PaletteChange(NewPalette:TPXRPaletteCustom);override;
Function GetScanLine(Const Row:Integer):PByte;override;
Function GetEmpty:Boolean;override;
Procedure ReleaseSurface;override;
Procedure AllocSurface(var aWidth,aHeight:Integer;
var aFormat:TPixelFormat;
out aPitch:Integer;
out aBufferSize:Integer);override;
End;
{$IFDEF MSWINDOWS}
TPXRSurfaceDIB = Class(TPXRSurfaceCustom)
Private
FDC: HDC;
FBitmap: HBitmap;
FOldBmp: HBitmap;
FBuffer: Pointer;
FDInfo: PBitmapInfo;
Protected
Procedure PaletteChange(NewPalette:TPXRPaletteCustom);override;
Function GetScanLine(Const Row:Integer):PByte;override;
Function GetEmpty:Boolean;override;
Procedure ReleaseSurface;override;
Procedure AllocSurface(var aWidth,aHeight:Integer;
var aFormat:TPixelFormat;
out aPitch:Integer;
out aBufferSize:Integer);override;
Public
Property DC:HDC read FDC;
Property Bitmap:HBitmap read FBitmap;
End;
{$ENDIF}
Const
ERR_SLSURFACE_NotAllocated =
'Surface is not allocated';
ERR_SLSURFACE_INVALIDCORDINATE =
'Invalid pixel co-ordinates [%d,%d] error';
ERR_SLSURFACE_UNSUPPORTEDFORMAT =
'Unsupported pixelformat error';
ERR_SLSURFACE_FAILEDALLOCATE =
'Failed to allocate surface memory [%s]';
ERR_SLSURFACE_FAILEINSTALLPALETTE =
'Failed to install palette object [%s]';
ERR_SLSURFACE_TARGETISNIL =
'Target surface is NIL or invalid error';
ERR_SLSURFACE_TARGETNotAllocated =
'Target surface is empty error';
ERR_SLSURFACE_SOURCEISNIL =
'Source surface is NIL or invalid error';
const
ERR_SLCOLOR_SOURCEBUFFER_INVALID
= 'Failed to extract color, source is NIL';
ERR_SLCOLOR_TARGETBUFFER_INVALID
= 'Failed to export color, target is NIL';
Const
ERR_SLPALETTE_PALETTEREADONLY =
'Palette is read-only, colors cannot be altered error';
ERR_SLPALETTE_INVALIDCOLORINDEX =
'Invalid palette color index, expected %d..%d, not %d';
ERR_SLPALETTE_ASSIGNToREADONLY =
'Failed to assign palette to read-only target';
CNT_SLPALETTE_NETSCAPE_COUNT = 216;
const
ERR_SLRECT_InvalidRect = 'Invalid rectangle error';
ERR_SLRECT_InvalidValues = 'Invalid values for a rectangle error';
Const
PXR_NULLRECT:TRect =(left:0;top:0;right:0;bottom:0);
Const
PerPixel_Bits: Array[pf8bit..pf32bit] of Integer = (8,16,16,24,32);
PerPixel_Bytes: Array[pf8bit..pf32bit] of Integer = (1,2,2,3,4);
Procedure PXR_SwapInt(Var Primary,Secondary:Integer);
Function PXR_MakePoint(Const Left,Top:Integer):TPoint;
Function PXR_Diff(Const Primary,Secondary:Integer;
Const Exclusive:Boolean=False):Integer;
Function PXR_Positive(Const Value:Integer):Integer;
Function PXR_RectRows(Const Value:TRect):Integer;
Function PXR_RectCols(Const Value:TRect):Integer;
implementation
Function PXR_RectRows(Const Value:TRect):Integer;
Begin
result:=Value.Bottom;
dec(result,Value.Top);
if Value.top<=0 then
inc(result);
end;
Function PXR_RectCols(Const Value:TRect):Integer;
Begin
result:=Value.Right;
dec(result,value.Left);
if Value.Left<=0 then
inc(result);
end;
Function PXR_MakePoint(Const Left,Top:Integer):TPoint;
Begin
result.x:=Left;
result.y:=Top;
end;
Function PXR_Diff(Const Primary,Secondary:Integer;
Const Exclusive:Boolean=False):Integer;
Begin
If Primary<>Secondary then
Begin
If Primary>Secondary then
result:=Primary-Secondary else
result:=Secondary-Primary;
If Exclusive then
If (Primary<1) or (Secondary<1) then
inc(result);
If result<0 then
result:=Result-1 xor -1;
end else
result:=0;
end;
Function PXR_Positive(Const Value:Integer):Integer;
Begin
If Value<0 then
Result:=Value-1 xor -1 else
result:=Value;
end;
Procedure PXR_SwapInt(Var Primary,Secondary:Integer);
var
FTemp: Integer;
Begin
FTemp:=Primary;
Primary:=Secondary;
Secondary:=FTemp;
end;
Function PXR_LineClip(Domain:TRect;
var Left,Top,Right,Bottom:Integer):Boolean;
var
n: Integer;
xdiff: Integer;
yDiff: Integer;
a,b: Single;
begin
(* realize domain if inverted *)
If (Domain.right<Domain.left)
or (Domain.Bottom<Domain.top) then
TPXRRect.Realize(Domain);
result:=TPXRRect.IsValid(Domain);
If result then
Begin
(* determine slope difference *)
xDiff:=Left-Right;
yDiff:=Top-Bottom;
(* pure vertical line *)
if xdiff=0 then
begin
Top:=math.EnsureRange(top,domain.top,domain.bottom);
bottom:=math.EnsureRange(bottom,domain.Top,domain.bottom);
if Top>Bottom then
PXR_SwapInt(Top,Bottom);
result:=(Left>=Domain.Left)
and (right<=Domain.Right)
and (top>=Domain.Top)
and (bottom<=Domain.Bottom);
end else
(* pure horizontal line *)
if yDiff=0 then
begin
Left:=math.EnsureRange(Left,domain.left,domain.right);
right:=math.EnsureRange(right,domain.left,domain.right);
If right<Left then
PXR_SwapInt(right,left);
result:=(Left>=Domain.Left)
and (right<=Domain.Right)
and (top>=Domain.Top)
and (bottom<=Domain.Bottom);
end else
(* Ensure visible results *)
if ((Top<Domain.top) and (Bottom<Domain.top))
or ((Top>Domain.bottom) and (Bottom>Domain.bottom))
or ((Left>Domain.right) and (Right>Domain.right))
or ((Left<Domain.left) and (Right<Domain.left)) then
Result:=False else
Begin
(* sloped line *)
a:=ydiff / xdiff;
b:=(Left * Bottom - Right * Top) / xdiff;
if (Top<Domain.top) or (Bottom<Domain.top) then
begin
n := round ((Domain.top - b) / a);
if (n>=Domain.left) and (n<=Domain.right) then
if (Top<Domain.top) then
begin
Left:=n;
Top:=Domain.top;
end else
begin
Right:=n;
Bottom:=Domain.top;
end;
end;
if (Top>Domain.bottom) or (Bottom>Domain.bottom) then
begin
n := round ((Domain.bottom - b) / a);