-
Notifications
You must be signed in to change notification settings - Fork 30
/
Copy pathApus.Engine.UITypes.pas
1656 lines (1490 loc) · 55.7 KB
/
Apus.Engine.UITypes.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
// -----------------------------------------------------
// User Interface classes
// This is independent brick.
//
// Author: Ivan Polyacov, Apus Software (ivan@apus-software.com)
// This file is licensed under the terms of BSD-3 license (see license.txt)
// This file is a part of the Apus Game Engine (http://apus-software.com/engine/)
// ------------------------------------------------------
unit Apus.Engine.UITypes;
interface
uses Types, Apus.Types, Apus.Classes, Apus.Engine.Types,
Apus.Common, Apus.AnimatedValues, Apus.Regions, Apus.Geom2d;
{$WRITEABLECONST ON}
{$IFDEF CPUARM} {$R-} {$ENDIF}
const
INHERIT = -999999; // constant to inherit integer property from parent
KEEP = -1;
// Predefined pivot point configuration
pivotTopLeft:TPoint2s=(x:0; y:0);
pivotTopRight:TPoint2s=(x:1; y:0);
pivotBottomLeft:TPoint2s=(x:0; y:1);
pivotBottomRight:TPoint2s=(x:1; y:1);
pivotCenter:TPoint2s=(x:0.5; y:0.5);
type
TUIRect=TRect2s;
TAnchorMode=TUIRect;
// UI snapping modes
TSnapMode=(smNone,
smTop, // width=parents clientwidth, top=0
smRight, // height=parents clientheight, left=0
smBottom,
smLeft,
smParent); // area = parents client area
// UI Verbosity modes
TSendSignals=(ssNone, // No signals at all
ssMajor, // Normal mode: major signals only
ssAll); // Verbose mode: all signals
// How element response for mouse/touch events
TElementShape=(shapeEmpty, // whole element is transparent for mouse/touch events
shapeFull, // whole element is opaque for mouse/touch events
shapeCustom); // some pixels are transparent, some are not - it depends on the Region field
// How mouse movement is limited between mouseDown and mouseUp
TClipMouse=(cmNo, // not limited
cmVirtual, // control see mouse as limited, while it is really not
cmReal, // mouse pointer is really limited inside the element
cmLimited); // mouse pointer is limited, but element may see its "out" to track real relative mouse movement
TUIScrollDirection=(sdVertical, // Vertical only
sdHorizontal, // Horizontal only
sdBoth, // Either vertical or horizontal
sdFree); // Free directional
// Behaviour: how element reacts on parent resize
TUIPlacementMode=(pmAnchored, // Anchors are used
pmProportional, // Elements area (position/size) is changed proportionally
pmMoveProportional); // Elements is moved proportionally, but size remains
TUIElement=class;
TUIElements=array of TUIElement;
TRegion = Apus.Regions.TRegion;
// Base class for Layouters: objects that layout child elements or adjust elements considering its children
TLayouter=class
procedure Layout(item:TUIElement); virtual; abstract;
protected
function GetItems(parent:TUIElement):TUIElements; // get aaray of objects to layout
end;
// External scrollbar interface
IScroller=interface
function GetElement:TUIElement; // scrollbar element
procedure SetRange(min,max:single);
procedure SetValue(v:single);
procedure SetStep(step:single);
procedure SetPageSize(pageSize:single);
procedure MoveRel(delta:single;smooth:boolean);
function GetValue:single;
function GetStep:single;
function GetPageSize:single;
end;
// Base class of the UI element
TUIElement=class(TNamedObject)
// This defines element's OUTER rect - in PARENT coordinates (i.e. scale doesn't affect this)
position:TPoint2s; // root point position in parent's client rect
size:TVector2s; // dimension of this element
pivot:TPoint2s; // relative location of the element's root point: 0,0 -> upper left corner, 1,1 - bottom right corner, 0.5,0.5 - center
anchors:TUIRect; // how much left/top/right/bottom border should absorb from parent's size change delta
shape:TElementShape; // define which part of the element can react on mouse input (opaque part)
shapeRegion:TRegion; // when shape=shapeCustom, this object define which area is considered opaque (for mouse input)
// Inner parts - scaled
scale:single; // scale factor for INNER parts of the element and all its children elements
padding:TUIRect; // defines element's client area (how much to deduct from the element's area) using own scale
scroll:TVector2s; // Offset used to draw children elements - SUBTRACT from children pos
scrollerH,scrollerV:IScroller; // scrollbars linked to this element scroll position
autoScroll:boolean; // use mouse wheel to scroll
placementMode:TUIPlacementMode; // How element should react on parent's size change
enabled:boolean; // true if element can and should react on input events
visible:boolean; // true if element should be drawn
manualDraw:boolean; // when true - the element is ignored by a regular DrawUI call, should be drawn manually
cursor:NativeInt; // Идентификатор курсора (0 - default)
order:integer; // Z-order used for arrangement ($10000 - StayOnTop), <0 - special (out-of-order)
// Define how the element should be displayed
styleClass:byte; // Which style handler should be used to draw this element (0 - default style)
styleInfoChanged:boolean; // set true whenever styleInfo changes
styleContext:TObject; // custom context object used by drawer
canHaveFocus:boolean; // может ли элемент обладать фокусом ввода
hint,hintIfDisabled:string; // текст всплывающей подсказки (отдельный вариант - для ситуации, когда элемент disabled, причем именно этот элемент, а не за счёт предков)
hintDelay:integer; // время (в мс), через которое элемент должен показать hint (в режиме показа hint'ов это время значительно меньше)
hintDuration:integer; // длительность (в мс) показа хинта
sendSignals:TSendSignals; // режим сигнализирования (см. выше)
caption:string; // some text associated with element
// Clipping: use clipChildren to allow hovering, not parentClip
// An element is clipped when BOTH conditions are true: parent.clipChildren AND self.parentClip
parentClip:boolean; // clip this element by parents client rect? (default - yes!)
clipChildren:boolean; // clip children elements by self client rect? (default - yes)
timer:integer; // relative time to call the onTimer() handler (only once and not earlier than next frame) 0 - don't call. For example, if timer=100 then onTimer will be called in 100 ms
linkedValue:pointer; // pointer to an external variable used to store elements state (depends on element type)
// Tweening and animation
//tweenings:array of TTweening;
// Custom data
tag:NativeInt; // custom data for manual use
customPtr:pointer; // custom data for manual use
attributes:TNameValueList; // custom attributes
// Relationship
parent:TUIElement; // Ссылка на элемент-предок
children:TUIElements; // Список вложенных элементов
isGroupBox:boolean; // true means that only one child element should be "selected" (switches, radio buttons etc.)
selectedChild:integer; // index of an active child element (when isGroupBox=true), -1 if none
// UI layout
layout:TLayouter; // how to layout child elements
layoutData:single; // custom data for layouter
// Derived attributes. These attributes are calculated at runtime and used for faster access, can be outdated
globalRect:TRect; // положение элемента на экране (может быть устаревшим! для точного положения - GetPosOnScreen)
class var sender:TUIElement; // use this value in any callback handler to find out the event sender element
// Создает элемент
constructor Create(width,height:single;parent_:TUIElement;name_:string='');
// Удаляет элемент (а также все вложенные в него)
destructor Destroy; override;
// Queue element to destroy somewhere later (before the next frame)
procedure SafeDestroy;
// Найти следующий по порядку элемент того же уровня
function GetNext:TUIElement; virtual;
// Найти предыдущий по порядку элемент того же уровня
function GetPrev:TUIElement; virtual;
// Найти самого дальнего предка (корневой элемент)
function GetRoot:TUIElement;
// Виден ли элемент (проверяет видимость всех предков)
function IsVisible:boolean;
// Доступен ли элемент (проверяет доступность всех предков)
function IsEnabled:boolean;
// Является ли указанный элемент потомком данного?
function IsChild(c:TUIElement):boolean;
// Вложен ли данный элемент в указанный (direct or indirect) (HasParent(self)=true)
function HasParent(c:TUIElement):boolean;
// Есть ли у данного элемента указанный потомок (direct or indirect) (HasChild(self)=true)
function HasChild(c:TUIElement):boolean;
// Delete all children elements (using optional filter string 'start:prefix', '!start:prefix', 'substr' etc.)
procedure DeleteChildren(filter:string='');
// Return child index in children array (-1) if no parent
function ChildIndex:integer;
// Attach to a new parent (at children[pos] or at the end of the children list if pos<0)
procedure AttachTo(newParent:TUIElement;pos:integer=-1);
// Detach from parent
procedure Detach(shouldAddToRootControls:boolean=true);
// Insert as a sibling before/after the specified element
procedure InsertAfter(element:TUIElement);
procedure InsertBefore(element:TUIElement);
// Transformations. Element's coordinate system is (0,0 - clientWidth,clinetHeight) where
// 0,0 - is upper-left corner of the client area. This CS is for internal use.
// Transform to given element's CS (nil - screen space). Target must be a parent element.
function TransformTo(const p:TPoint2s;target:TUIElement):TPoint2s; overload;
function TransformTo(const r:TRect2s;target:TUIElement):TRect2s; overload;
// Transform to/from screen space
function TransformToScreen(const p:TPoint2s):TPoint2s; overload;
function TransformToScreen(const r:TRect2s):TRect2s; overload;
function TransformFromScreen(const p:TPoint2s):TPoint2s; overload;
function TransformFromScreen(const r:TRect2s):TRect2s; overload;
function GetRect:TRect2s; // Get element's area in its own CS (i.e. relative to pivot point)
function GetRectInParentSpace:TRect2s; // Get element's area in parent client space)
function GetClientRect:TRect2s; // Get element's client area in its own CS (0,0,clientWidth,clientHeight)
// получить экранные к-ты элемента
function GetPosOnScreen:TRect; // get full element's area in screen space
function GetClientPosOnScreen:TRect; // client area in screen space
// Primary event handlers
// Сцена (или другой клиент) вызывает эти методы у корневого эл-та, а он
// перенаправляет их соответствующим элементам по принципу:
// - движение мыши - по точке начала и конца двжения
// - нажатие и скроллинг - элементу под мышью
// - клавиатура - элементу, имеющему фокус
procedure onMouseMove; virtual;
procedure onMouseScroll(value:integer); virtual;
procedure onMouseButtons(button:byte;state:boolean); virtual;
function onKey(keycode:byte;pressed:boolean;shiftstate:byte):boolean; virtual; // Нужно вернуть false для запрета дальнейшей обработки клавиши
procedure onChar(ch:char;scancode:byte); virtual;
procedure onUniChar(ch:WideChar;scancode:byte); virtual;
function onHotKey(keycode:byte;shiftstate:byte):boolean; virtual;
procedure onTimer; virtual;
procedure onLostFocus; virtual;
// Переключить фокус на себя (с уведомлением других)
procedure SetFocus; virtual;
// Сам элемент или воженный в него владеет фокусом?
function HasFocus:boolean; virtual;
// Перевести фокус на следующий/предыдущий эл-ты
procedure SetFocusToNext;
procedure SetFocusToPrev;
// Set element position using new pivot point
function SetPos(x,y:single;pivotPoint:TPoint2s;autoSnap:boolean=false):TUIElement; overload;
function SetPos(x,y:single;autoSnap:boolean=false):TUIElement; overload;
// Move by given screen pixels
procedure MoveBy(dx,dy:single);
// Set element anchors
function SetAnchors(left,top,right,bottom:single):TUIElement; overload;
function SetAnchors(anchorMode:TAnchorMode):TUIElement; overload;
// Set all padding and resize client area
function SetPadding(padding:single):TUIElement; overload;
function SetPaddings(left,top,right,bottom:single):TUIElement; overload;
// Set same value for X/Y scale and optionally resize to keep the original dimensions
function SetScale(newScale:single):TUIElement;
// Change element size and adjust children elements !!! new size IN PARENTs space!
// Pass -1 to keep current value
procedure Resize(newWidth,newHeight:single); virtual;
procedure ResizeClient(newClientWidth,newClientHeight:single); virtual;
// Place element at the parent's center (and optionally set anchors to follow the center point)
procedure Center(setAnchors:boolean=true);
// Snap element to parent's edge
// Optionally cut from parent's client area, so this element will be outside the client area
procedure Snap(snapTo:TSnapMode;shrinkParent:boolean=true);
// Скроллинг в указанную позицию (с обработкой подчиненных скроллбаров если они есть)
procedure ScrollTo(newX,newY:integer); virtual;
// Setup scrollers to match client area
procedure SetupScrollers; virtual;
// Если данный элемент может обладать фокусом, но ни один другой не имеет фокуса - взять фокус на себя
procedure CheckAndSetFocus;
// Find a descendant UI element at the given point (in screen coordinates)
// Returns true if the found element (and all its parents) are enabled
function FindElementAt(x,y:integer;out c:TUIElement):boolean;
// Same as FindItemAt, but ignores elements transparency mode
function FindAnyElementAt(x,y:integer;out c:TUIElement):boolean;
// Find a descendant element by its name
function FindChildByName(const name:string8):TUIElement;
// Установить либо удалить "горячую клавишу" для данного эл-та
procedure SetHotKey(vKeyCode:integer;shiftstate:byte=0);
procedure RemoveHotKey(vKeyCode:integer;shiftstate:byte=0);
// Check if point is opaque in tmCustom mode (relative coordinates in [0..1] range)
function IsOpaque(x,y:single):boolean; virtual;
// Out-of-order elements are not affected by layouter and other group operations
function IsOutOfOrder:boolean; virtual;
// Helper methods
procedure Show;
procedure Hide;
procedure Toggle; // toggle visibility
procedure Enable;
procedure Disable;
procedure ToggleEnabled;
// Whether element behave as window: track focused child
class function IsWindow:boolean; virtual;
function IsActiveWindow:boolean; virtual;
class procedure SetDefault(name:string;value:variant); // SetClassAttribute('defalut'+name,value)
procedure SetStyle(name,value:string8); // use 'name:value' or 'state.name:value' syntax
protected
focusedChild:TUIElement; // child element which should get focus instead of self
childrenBound:TRect2s; // bounding rect of scrollable children (including 0,0 point as well)
procedure DeleteHotkeys(vKeyCode:integer;shiftstate:byte=0);
private
fStyleInfo:String8; // дополнительные сведения для стиля
fFont:TFontHandle; // not used directly, can be inherited by children or used by custom draw routines
fColor:cardinal; // color value to be inherited by children
fInitialSize:TVector2s; // element's initial size (used for proportional resize)
procedure AddToRootElements;
procedure RemoveFromRootElements;
function GetClientWidth:single;
function GetClientHeight:single;
function GetGlobalScale:single;
procedure SetName(n:String8); override;
procedure SetStyleInfo(sInfo:String8);
procedure ClientSizeChanged(dX,dY:single); // client area was resized because of size or scale change
procedure ParentSizeChanged(dX,dY:single); // parent's client area was resized - adopt element position/size
procedure InsertRel(element:TUIElement;rel:integer);
function GetFont:TFontHandle; // returns own or inherited font handle
function GetColor:cardinal;
class function ClassHash:pointer; override;
public
property width:single read size.x write size.x;
property height:single read size.y write size.y;
property clientWidth:single read GetClientWidth;
property clientHeight:single read GetClientHeight;
property globalScale:single read GetGlobalScale; // how many screen pixels are in an element with size=1.0
property initialSize:TVector2s read fInitialSize; // size when created
property styleInfo:String8 read fStyleInfo write SetStyleInfo;
property font:TFontHandle read GetFont write fFont; // not scaled by SELF scale, scaled by PARENT scale
property color:cardinal read GetColor write fColor;
end;
var
underMouse:TUIElement; // элемент под мышью
modalElement:TUIElement; // Если есть модальный эл-т - он тут
hooked:TUIElement; // если установлен - теряет фокус даже если не обладал им
defaultEncoding:TTextEncoding=teUnknown; // кодировка элементов ввода по умолчанию
clipMouse:TClipMouse; // Ограничивать ли движение мыши
clipMouseRect:TRect; // Область допустимого перемещения мыши
curMouseX,curMouseY,oldMouseX,oldMouseY:integer; // координаты курсора мыши (для onMouseMove!)
// Корневые элементы (не имеющие предка)
// Список используется для передачи (обработки) первичных событий строго
// по порядку, начиная с 1-го
rootElements:array of TUIElement;
UICritSect:TMyCriticalSection; // для многопоточного доступа к глобальным переменным UI
function DescribeElement(c:TUIElement):string;
function FocusedElement:TUIElement;
procedure SetFocusTo(control:TUIElement);
// Keycode - virtual key
procedure ProcessHotKey(keycode:integer;shiftstate:byte);
// Destroy elements queued by SafeDestroy
procedure DestroyQueuedElements;
implementation
uses Classes, SysUtils, Apus.CrossPlatform, Apus.EventMan, Apus.Clipboard, Apus.Structs, Apus.Engine.API;
type
// Hotkey handler
THotKey=record
vKey:integer;
shiftstate:byte;
element:TUIElement;
end;
var
// TUIElement class hash
UIHash:TObjectHash;
// Hotkeys
hotKeys:array of THotKey;
fControl:TUIElement; // элемент, имеющий фокус ввода (с клавиатуры)
// устанавливается автоматически либо вручную
activeWnd:TUIElement; // Активное окно (автоматически устанавливается при переводе фокуса)
toDelete:TObjectList; // List of elements marked for deletion
procedure ProcessHotKey(keycode:integer;shiftstate:byte);
var
i:integer;
c:TUIElement;
begin
for i:=0 to high(hotKeys) do
if (hotKeys[i].vKey=keycode) then
if (HotKeys[i].shiftstate=shiftstate) or
((HotKeys[i].shiftstate>0) and (HotKeys[i].shiftstate and ShiftState=HotKeys[i].shiftstate)) then
begin
c:=hotkeys[i].element;
// Element should be visible and enabled
if c.IsVisible and c.IsEnabled then
// If there is a modal element - it should be parent
if (modalElement=nil) or (c.HasParent(modalElement)) then
if c.onHotKey(keycode,shiftstate) then exit;
end;
end;
function DescribeElement(c:TUIElement):string;
begin
if c=nil then begin
result:='nil'; exit;
end;
result:=c.ClassName+'('+PtrToStr(c)+')='+c.name;
end;
function FocusedElement;
begin
result:=fControl;
end;
procedure SetFocusTo(control:TUIElement);
begin
try
if control<>nil then control.SetFocus
else begin
if fControl<>nil then fControl.onLostFocus;
end;
finally
fcontrol:=control;
end;
end;
{ TUIElement }
// Transform point from element own CS to the target parent element's CS (nil - to the screen)
// I.e. (0,0) is a top-left corner of the element's CLIENT area
function TUIElement.TransformTo(const p:TPoint2s;target:TUIElement):TPoint2s;
var
parentScrollX,parentScrollY:single;
c:TUIElement;
begin
c:=self;
result:=p;
if c=target then exit;
repeat
with c do begin
if parent<>nil then begin
parentScrollX:=parent.scroll.X;
parentScrollY:=parent.scroll.Y;
end else begin
parentScrollX:=0;
parentScrollY:=0;
end;
// Explanation of transformation:
// result.x:=(p.x+paddingLeft); // теперь относительно угла элемента
// result.x:=result.x-size.x*pivot.x; // теперь относительно pivot point
// result.x:=result.x*scale.x; // теперь в масштабе предка
// result.x:=position.x-parentScrollX+result.x; // теперь относительно верхнего левого угла клиентской области предка
result.x:=position.x-parentScrollX-size.x*pivot.x+scale*(result.x+padding.Left);
result.y:=position.y-parentScrollY-size.y*pivot.y+scale*(result.y+padding.Top);
end;
c:=c.parent;
until (c=nil) or (c=target);
end;
function TUIElement.TransformTo(const r:TRect2s;target:TUIElement):TRect2s;
var
p1,p2:TPoint2s;
begin
p1:=TransformTo(Point2s(r.x1,r.y1),target);
p2:=TransformTo(Point2s(r.x2,r.y2),target);
result:=Rect2s(p1.x,p1.y, p2.x,p2.y);
end;
function TUIElement.TransformToScreen(const p:TPoint2s):TPoint2s;
begin
result:=TransformTo(p,nil);
end;
function TUIElement.TransformToScreen(const r:TRect2s):TRect2s;
begin
result:=TransformTo(r,nil);
end;
function TUIElement.TransformFromScreen(const p:TPoint2s):TPoint2s;
var
kx,ky,bx,by:single;
c:TUIElement;
sx:single;
begin
// Xscr = k*x+b, so test x=0 and x=1 to calculate K and B
// This is probably not very efficient, but easier and safier
with TransformToScreen(Point2s(0,0)) do begin
bx:=x;
by:=y;
end;
with TransformToScreen(Point2s(1,1)) do begin
kx:=x-bx;
ky:=y-by;
end;
ASSERT(abs(kx-ky)<0.001);
// X = (Xscr-B)/K
result.x:=(p.x-bx)/kx;
result.y:=(p.y-by)/ky;
end;
function TUIElement.TransformFromScreen(const r:TRect2s):TRect2s;
begin
result.topLeft:=TransformFromScreen(r.topLeft);
result.bottomRight:=TransformFromScreen(r.bottomRight);
end;
function TUIElement.GetPosOnScreen:TRect;
begin
globalRect:=RoundRect(TransformToScreen(GetRect));
result:=globalRect;
end;
function TUIElement.GetClientPosOnScreen:TRect;
begin
result:=RoundRect(TransformToScreen(GetClientRect));
end;
function TUIElement.GetRect:TRect2s; // Get element's area in own CS
begin
result.x1:=-padding.Left;
result.y1:=-padding.Top;
result.x2:=size.x/scale-padding.Left;
result.y2:=size.y/scale-padding.Top;
end;
function TUIElement.GetClientRect:TRect2s; // Get element's client area in own CS
begin
result.InitWH(0,0,clientWidth,clientHeight);
end;
function TUIElement.GetRectInParentSpace:TRect2s; // Get element's area in parent client space)
begin
result.left:=position.x-size.x*pivot.x;
result.top:=position.y-size.y*pivot.y;
result.right:=position.x+size.x*(1-pivot.x);
result.bottom:=position.y+size.y*(1-pivot.y);
end;
procedure TUIElement.Center(setAnchors:boolean=true);
begin
ASSERT(parent<>nil,'Cannot center a root UI element');
SetPos(parent.clientWidth/2,parent.clientHeight/2,pivotCenter);
if setAnchors then self.SetAnchors(0.5,0.5,0.5,0.5);
end;
procedure TUIElement.CheckAndSetFocus;
begin
if CanHaveFocus and (FocusedElement=nil) then
SetFocus;
end;
class function TUIElement.ClassHash:pointer;
begin
result:=@UIHash;
end;
procedure TUIElement.DeleteChildren(filter:string='');
var
i,n:integer;
keep:TUIElements;
items:StringArray;
value:string8;
mode:integer;
function ShouldDelete(e:TUIElement):boolean;
begin
case mode of
0:result:=pos(value,e.name)>0;
1:result:=HasPrefix(e.name,value,true);
2:result:=not HasPrefix(e.name,value,true);
end;
end;
begin
UICritSect.Enter;
try
if filter<>'' then begin
SetLength(keep,length(children));
items:=split(':',filter);
value:=items[1];
mode:=0;
if SameText(items[0],'start') then mode:=1;
if SameText(items[0],'!start') then mode:=2;
end;
n:=0;
for i:=0 to high(children) do begin
if (filter='') or ShouldDelete(children[i]) then
FreeAndNil(children[i])
else begin
keep[n]:=children[i];
inc(n);
end;
end;
SetLength(children,0);
if filter<>'' then begin
SetLength(keep,n);
children:=keep;
end;
finally
UICritSect.Leave;
end;
end;
constructor TUIElement.Create(width,height:single;parent_:TUIElement;name_:string='');
var
n:integer;
begin
position:=Point2s(0,0);
size:=Point2s(width,height);
scale:=GetClassAttribute('defaultScale',1.0);
pivot:=Point2s(0,0);
SetPadding(GetClassAttribute('defaultPadding',0));
padding.left:=GetClassAttribute('defaultPaddingLeft',padding.left);
padding.right:=GetClassAttribute('defaultPaddingRight',padding.right);
padding.top:=GetClassAttribute('defaultPaddingTop',padding.top);
padding.bottom:=GetClassAttribute('defaultPaddingBottom',padding.bottom);
shape:=shapeFull;
timer:=0;
parent:=parent_;
parentClip:=GetClassAttribute('defaultParentClip',true);
clipChildren:=GetClassAttribute('defaultClipChildren',true);
name:=name_;
hint:=''; hintIfDisabled:='';
hintDelay:=GetClassAttribute('defaulthintDelay',1000);
hintDuration:=GetClassAttribute('defaultHintDuration',3000);
// No anchors: element's size doesn't change when parent is resized
//anchors:=anchorNone;
cursor:=int64(GetClassAttribute('defaultCursor',CursorID.Default));
enabled:=GetClassAttribute('defaultEnabled',true);
visible:=GetClassAttribute('defaultVisible',true);
manualDraw:=false;
font:=GetClassAttribute('defaultFont',0);
color:=GetClassAttribute('defaultColor',clDefault);
styleClass:=GetClassAttribute('defaultStyle',0);
styleInfo:=GetClassAttribute('defaultStyleInfo','');
canHaveFocus:=GetClassAttribute('defaultCanHaveFocus',false);
sendSignals:=ssNone;
scroll:=Point2s(0,0);
scrollerH:=nil; scrollerV:=nil;
focusedChild:=nil;
shapeRegion:=nil;
selectedChild:=-1;
UICritSect.Enter;
try
if parent<>nil then begin // add to the parents children
n:=length(parent.children);
inc(n); order:=n;
SetLength(parent.children,n);
parent.children[n-1]:=self;
if width=-1 then begin
size.x:=parent.clientWidth;
anchors.left:=0; anchors.right:=1;
end;
if height=-1 then begin
size.y:=parent.clientHeight;
anchors.top:=0; anchors.bottom:=1;
end;
end else begin
// Элемент без предка -> занести в список
AddToRootElements;
order:=1;
end;
fInitialSize:=size;
globalRect:=GetPosOnScreen;
finally
UICritSect.Leave;
end;
Signal('UI\ItemCreated',TTag(self));
end;
destructor TUIElement.Destroy;
var
i,n:integer;
begin
try
if fControl=self then begin
onLostFocus;
fControl:=nil;
end;
if underMouse=self then underMouse:=parent;
if parent=nil then
RemoveFromRootElements
else
Detach(false);
DeleteChildren;
FreeAndNil(shapeRegion);
FreeAndNil(styleContext);
DeleteHotkeys(0);
Signal('UI\ItemDestroyed',TTag(self));
except
on e:Exception do raise EError.Create(Format('Destroy error for %s: %s',[name,ExceptionMsg(e)]));
end;
inherited;
end;
procedure TUIElement.Detach(shouldAddToRootControls:boolean=true);
var
i,pos,n:integer;
begin
if parent=nil then exit;
n:=high(parent.children);
pos:=-1;
for i:=0 to n do
if parent.children[i]=self then begin
pos:=i; break;
end;
if pos>=0 then begin
for i:=pos to n-1 do parent.children[i]:=parent.children[i+1];
SetLength(parent.children,n);
end;
parent:=nil;
if shouldAddToRootControls then AddToRootElements;
end;
procedure TUIElement.AttachTo(newParent:TUIElement;pos:integer=-1);
var
i,n:integer;
begin
ASSERT(newParent<>nil);
if parent=newParent then exit;
if parent<>nil then Detach(false)
else RemoveFromRootElements;
parent:=newParent;
n:=length(parent.children);
SetLength(parent.children,n+1);
if pos<0 then pos:=n
else
for i:=n downto pos+1 do
parent.children[i]:=parent.children[i-1];
parent.children[pos]:=self;
end;
procedure TUIElement.InsertRel(element:TUIElement;rel:integer);
var
p:TUIElement;
n:integer;
begin
p:=element.parent;
ASSERT(p<>nil);
//Detach(false);
n:=element.ChildIndex;
AttachTo(p,n+rel);
end;
procedure TUIElement.InsertAfter(element:TUIElement);
begin
InsertRel(element,1);
end;
procedure TUIElement.InsertBefore(element:TUIElement);
begin
InsertRel(element,0);
end;
function TUIElement.FindChildByName(const name:string8):TUIElement;
var
i:integer;
c:TUIElement;
begin
if SameText(self.name,name) then begin
result:=self; exit;
end;
for i:=0 to length(children)-1 do begin
c:=children[i].FindChildByName(name);
if c<>nil then begin
result:=c; exit;
end;
end;
result:=nil;
end;
function TUIElement.FindElementAt(x,y:integer; out c:TUIElement):boolean;
var
r,r2:Trect;
p:TPoint;
i,j:integer;
fl,en:boolean;
c2:TUIElement;
ca:array of TUIElement;
cnt:byte;
outside:boolean;
begin
// Тут нужно быть предельно внимательным!!!
result:=enabled and visible;
c:=nil;
if not visible then exit; // если элемент невидим, то уж точно ничего не спасет!
r:=GetPosOnScreen;
p:=Point(x,y);
outside:=false; // ignore clipped
if clipChildren and not r.Contains(p) then outside:=true; // за пределами эл-та
if (shape=shapeFull) and r.Contains(p) then c:=self;
// На данный момент известно, что точка в пределах текущего эл-та
// Но возможно здесь есть кто-то из вложенных эл-тов! Нужно их проверить:
// выполнить поиск по ним в порядке обратном отрисовке.
// В невидимых и запредельных искать ессно не нужно, а вот в прозрачных - нужно!
cnt:=0;
SetLength(ca,length(children));
for i:=0 to length(children)-1 do with children[i] do begin
if not visible then continue;
ca[cnt]:=self.children[i];
inc(cnt);
end;
// Список создан, теперь его отсортируем
if cnt>1 then
for i:=0 to cnt-2 do
for j:=cnt-1 downto i+1 do
if ca[j-1].order<ca[j].order then begin
c2:=ca[j]; ca[j]:=ca[j-1]; ca[j-1]:=c2;
end;
// Теперь порядок правильный, нужно искать
fl:=false;
for i:=0 to cnt-1 do begin
if outside and ca[i].parentClip then continue;
en:=ca[i].FindElementAt(x,y,c2);
if c2<>nil then begin
c:=c2; result:=result and en;
fl:=true; break;
end;
end;
// Ни одного непрозрачного потомка в данной точке, но сам элемент может быть непрозрачен здесь!
if not fl and (shape=shapeCustom) then
if IsOpaque((x-r.Left)/r.Width,(y-r.Top)/r.Height) then c:=self;
if c=nil then result:=false;
end;
function TUIElement.FindAnyElementAt(x,y:integer; out c:TUIElement):boolean;
var
r,r2:Trect;
p:TPoint;
i,j:integer;
fl,en:boolean;
c2:TUIElement;
ca:array of TUIElement;
cnt:byte;
begin
// Тут нужно быть предельно внимательным!!!
result:=enabled and visible;
c:=nil;
if not visible then exit; // если элемент невидим, то уж точно ничего не спасет!
r:=GetPosOnScreen;
p:=Point(x,y);
if not PtInRect(r,p) then begin result:=false; exit; end; // за пределами эл-та
c:=self;
// На данный момент известно, что точка в пределах текущего эл-та
// Но возможно здесь есть кто-то из вложенных эл-тов! Нужно их проверить:
// выполнить поиск по ним в порядке обратном отрисовке.
// В невидимых и запредельных искать ессно не нужно, а вот в прозрачных - нужно!
cnt:=0;
SetLength(ca,length(children));
for i:=0 to length(children)-1 do with children[i] do begin
if not visible then continue;
ca[cnt]:=self.children[i];
inc(cnt);
end;
// Список создан, теперь его отсортируем
if cnt>1 then
for i:=0 to cnt-2 do
for j:=cnt-1 downto i+1 do
if ca[j-1].order<ca[j].order then begin
c2:=ca[j]; ca[j]:=ca[j-1]; ca[j-1]:=c2;
end;
// Теперь порядок правильный, нужно искать
fl:=false;
for i:=0 to cnt-1 do begin
en:=ca[i].FindElementAt(x,y,c2);
if c2<>nil then begin
c:=c2; result:=result and en;
fl:=true; break;
end;
end;
// Ни одного непрозрачного потомка в данной точке, но сам элемент может быть непрозрачен здесь!
if not fl then c:=self;
if c=nil then result:=false;
end;
procedure TUIElement.SetName(n:String8);
var
oldName:String8;
begin
oldName:=name;
inherited;
if (oldName<>'') and (name<>oldName) then
Signal('UI\ItemRenamed',TTag(self));
end;
procedure TUIElement.Snap(snapTo:TSnapMode;shrinkParent:boolean=true);
var
r:TUIRect;
begin
if parent=nil then exit;
if snapTo=smNone then exit;
if snapTo in [smTop,smBottom] then Resize(parent.clientWidth,-1);
if snapTo in [smLeft,smRight] then Resize(-1,parent.clientHeight);
if snapTo=smParent then Resize(parent.clientWidth,parent.clientHeight);
case snapTo of
smTop:SetAnchors(0,0,1,0).SetPos(0,0,pivotTopLeft);
smLeft:SetAnchors(0,0,0,1).SetPos(0,0,pivotTopLeft);
smRight:SetAnchors(1,0,1,1).SetPos(parent.clientWidth,0,pivotTopRight);
smBottom:SetAnchors(0,1,1,1).SetPos(0,parent.clientHeight,pivotBottomLeft);
smParent:SetAnchors(0,0,1,1).SetPos(0,0,pivotTopLeft);
end;
{ if shrinkParent then begin
r:=parent.padding;
case snapTo of
smTop:r.top:=r.top+
smLeft:SetAnchors(0,0,0,1).SetPos(0,0,pivotTopLeft);
smRight:SetAnchors(1,0,1,1).SetPos(parent.clientWidth,0,pivotTopRight);
smBottom:SetAnchors(0,1,1,1).SetPos(0,parent.clientHeight,pivotBottomLeft);
smParent:SetAnchors(0,0,1,1).SetPos(0,0,pivotTopLeft);
end;
end;}
end;
function TUIElement.ChildIndex:integer;
var
i:integer;
p:TUIElement;
begin
result:=-1;
p:=parent;
if p=nil then exit;
for i:=0 to high(p.children) do
if p.children[i]=self then exit(i);
end;
function TUIElement.GetNext:TUIElement;
var
i:integer;
begin
if parent=nil then exit(self);
i:=childIndex+1;
if i>high(parent.children) then i:=0;
result:=parent.children[i];
end;
function TUIElement.GetPrev:TUIElement;
var
i,n:integer;
begin
if parent=nil then exit(self);
i:=childIndex-1;
if i<0 then i:=high(parent.children);
result:=parent.children[i];
end;
function TUIElement.GetRoot:TUIElement;
begin
result:=self;
if self=nil then exit;
while result.parent<>nil do result:=result.parent;
end;
procedure TUIElement.Show;
begin
visible:=true;
end;
procedure TUIElement.Hide;
begin
visible:=false;
end;
procedure TUIElement.Toggle;
begin
visible:=not visible;
end;
procedure TUIElement.Enable;
begin
enabled:=true;
end;
procedure TUIElement.Disable;
begin
enabled:=false;
end;
procedure TUIElement.ToggleEnabled;
begin
enabled:=not enabled;
end;
function TUIElement.IsVisible:boolean;
var
c:TUIElement;
begin
result:=false;
if self=nil then exit;
result:=visible;
c:=self;
while c.parent<>nil do begin