1 {
2 Copyright (C) Alexey Torgashin, uvviewsoft.com
3 License: MPL 2.0 or LGPL
4 }
5 unit ATSynEdit_Carets;
6
7 {$mode objfpc}{$H+}
8 {$ModeSwitch advancedrecords}
9
10 interface
11
12 uses
13 Classes, SysUtils, Graphics,
14 LCLIntf,
15 ATStringProc,
16 ATStringProc_Separator;
17
18 type
19 TATPosRelation = (
20 cRelateBefore,
21 cRelateInside,
22 cRelateAfter
23 );
24
25 TATRangeSelection = (
26 cRangeAllSelected,
27 cRangeAllUnselected,
28 cRangePartlySelected
29 );
30
31 TATCaretMemoryAction = (
32 cCaretMem_PrepareX,
33 cCaretMem_SaveX,
34 cCaretMem_ClearX
35 );
36
37 procedure SwapInt(var n1, n2: integer); inline;
IsPosSortednull38 function IsPosSorted(X1, Y1, X2, Y2: integer; AllowEq: boolean): boolean; inline;
IsPosInRangenull39 function IsPosInRange(X, Y, X1, Y1, X2, Y2: integer; AllowOnRightEdge: boolean=false): TATPosRelation;
40
41
42 type
43 { TATCaretItem }
44
45 TATCaretItem = class
46 public
47 PosX, PosY, //caret text position
48 EndX, EndY: integer; //end of selection, or (-1,-1) if no selection
49 CoordX, CoordY: integer; //screen coords
50 OldRect: TRect; //screen rect, but before running the last command
51 SavedX, SavedX_Pre: integer; //memory of last column, to use with arrows Up/Down
52 BeforeExtendX: integer; //memory for commands "carets extend: up/down/..."
53 CharStr: UnicodeString; //str is rendered above the inverted-rect, if TATSynEdit.CaretShape's option is on
54 CharColor: TColor;
55 CharStyles: TFontStyles;
56 procedure SelectNone;
57 procedure SelectToPoint(AX, AY: integer);
58 procedure GetRange(out AX1, AY1, AX2, AY2: integer; out ASel: boolean);
59 procedure GetSelLines(out AFrom, ATo: integer; AllowNoSel: boolean=false);
60 function GetLeftEdge: TPoint;
61 function GetRightEdge: TPoint;
62 function Change(APosX, APosY, AEndX, AEndY: integer): boolean;
63 procedure SwapSelection;
64 function IsSelection: boolean;
65 function IsForwardSelection: boolean;
66 function IsMultilineSelection: boolean;
67 function IsInVisibleRect(const R: TRect): boolean;
68 function FirstTouchedLine: integer;
69 procedure UpdateMemory(AMode: TATCaretMemoryAction; AArrowUpDown: boolean);
70 end;
71
72 type
73 TATCaretEdge = (
74 cEdgeTop,
75 cEdgeBottom,
76 cEdgeLeft,
77 cEdgeRight
78 );
79
80 TATCaretScreenSide = (
81 cScreenSideTop,
82 cScreenSideMiddle,
83 cScreenSideBottom
84 );
85
86 type
87 { TATCaretSelections }
88 {
89 why new record here? we could make methods in TATCarets, but during loops,
90 we must always a) skip carets w/o selection,
91 b) call CaretItem.GetRange to get _sorted_ range.
92 code for binary search (Is***Selected) would be ugly.
93 }
94
95 TATCaretSelections = record
96 private
97 type TATCaretSelection = record
98 PosX, PosY, EndX, EndY: integer;
99 end;
100 public
101 Data: array of TATCaretSelection;
102 procedure Clear;
103 function IsEmpty: boolean;
104 function IsMultiline: boolean;
105 function IsLineWithSelection(ALine: integer): boolean;
106 function IsLineAllSelected(ALine, ALineLen: integer): boolean;
107 function IsPosSelected(AX, AY: integer): boolean;
108 function IsRangeSelected(AX1, AY1, AX2, AY2: integer): TATRangeSelection;
109 procedure GetRangesInLineAfterPoint(AX, AY: integer; out ARanges: TATSimpleRangeArray);
110 end;
111
112 type
113 { TATCarets }
114
115 TATCarets = class
116 private const
117 AllowSelectionsTouch = true;
118 private
119 FList: TFPList;
120 FManyAllowed: boolean;
121 FOneLine: boolean;
122 FOnCaretChanged: TNotifyEvent;
123 function GetItem(N: integer): TATCaretItem;
124 procedure DeleteDups(AJoinAdjacentCarets: boolean);
125 function IsJoinNeeded(AIndex1, AIndex2: integer;
126 out OutPosX, OutPosY, OutEndX, OutEndY: integer): boolean;
127 function GetAsArray: TATPointArray;
128 procedure SetAsArray(const Res: TATPointArray);
129 function GetAsString: string;
130 procedure SetAsString(const AValue: string);
131 public
132 constructor Create; virtual;
133 destructor Destroy; override;
134 procedure Clear;
135 procedure Delete(N: integer);
136 function Count: integer; inline;
137 function IsIndexValid(N: integer): boolean; inline;
138 function IsPosSelected(AX, AY: integer; AllowAtEdge: boolean=false): boolean;
139 property Items[N: integer]: TATCaretItem read GetItem; default;
140 procedure Add(APosX, APosY: integer; AEndX: integer=-1; AEndY: integer=-1);
141 procedure Sort(AJoinAdjacentCarets: boolean=true);
142 procedure Assign(Obj: TATCarets);
143 function FindCaretBeforePos(APosX, APosY: integer; ARequireSel: boolean): integer;
144 function FindCaretContainingPos(APosX, APosY: integer): integer;
145 function IndexOfPosXY(APosX, APosY: integer; AUseEndXY: boolean= false): integer;
146 function IndexOfLeftRight(ALeft: boolean): integer;
147 function IsLineWithCaret(APosY: integer; ADisableSelected: boolean=false): boolean;
148 function IsLineWithSelection(APosY: integer): boolean;
149 function IsSelection: boolean;
150 function IsAnyCaretInVisibleRect(const R: TRect): boolean;
151 procedure GetSelections(var D: TATCaretSelections);
152 function CaretAtEdge(AEdge: TATCaretEdge): TPoint;
153 function DebugText: string;
154 property ManyAllowed: boolean read FManyAllowed write FManyAllowed;
155 property OneLine: boolean read FOneLine write FOneLine;
156 property AsArray: TATPointArray read GetAsArray write SetAsArray;
157 property AsString: string read GetAsString write SetAsString;
158 property OnCaretChanged: TNotifyEvent read FOnCaretChanged write FOnCaretChanged;
159 procedure UpdateMemory(AMode: TATCaretMemoryAction; AArrowUpDown: boolean);
160 procedure UpdateAfterRangeFolded(ARangeX, ARangeY, ARangeY2: integer);
161 procedure DoChanged;
162 end;
163
164
165 implementation
166
167 uses
168 Math{%H-};
169
170 function IsPosSorted(X1, Y1, X2, Y2: integer; AllowEq: boolean): boolean; inline;
171 begin
172 if Y1<>Y2 then
173 Result:= Y1<Y2
174 else
175 Result:= (X1<X2) or (AllowEq and (X1=X2));
176 end;
177
178 procedure GetPositionMinOrMax(X1, Y1, X2, Y2: integer; AMaximal: boolean; out OutX, OutY: integer);
179 begin
180 if IsPosSorted(X1, Y1, X2, Y2, true) xor AMaximal then
181 begin
182 OutX:= X1;
183 OutY:= Y1;
184 end
185 else
186 begin
187 OutX:= X2;
188 OutY:= Y2;
189 end;
190 end;
191
192
193 function IsPosInRange(X, Y, X1, Y1, X2, Y2: integer;
194 AllowOnRightEdge: boolean=false): TATPosRelation;
195 begin
196 if IsPosSorted(X, Y, X1, Y1, false) then
197 Result:= cRelateBefore
198 else
199 if IsPosSorted(X, Y, X2, Y2, AllowOnRightEdge) then
200 Result:= cRelateInside
201 else
202 Result:= cRelateAfter;
203 end;
204
205 procedure SwapInt(var n1, n2: integer); inline;
206 var
207 n: integer;
208 begin
209 n:= n1;
210 n1:= n2;
211 n2:= n;
212 end;
213
214 { TATCaretSelections }
215
216 procedure TATCaretSelections.Clear;
217 begin
218 SetLength(Data, 0);
219 end;
220
IsEmptynull221 function TATCaretSelections.IsEmpty: boolean;
222 begin
223 Result:= Length(Data)=0;
224 end;
225
IsMultilinenull226 function TATCaretSelections.IsMultiline: boolean;
227 var
228 i: integer;
229 begin
230 for i:= 0 to High(Data) do
231 if Data[i].EndY<>Data[i].PosY then
232 exit(true);
233 Result:= false;
234 end;
235
IsLineWithSelectionnull236 function TATCaretSelections.IsLineWithSelection(ALine: integer): boolean;
237 var
238 Y1, Y2, X2: integer;
239 a, b, m: integer;
240 begin
241 Result:= false;
242 a:= 0;
243 b:= High(Data);
244
245 repeat
246 if a>b then exit;
247 m:= (a+b+1) div 2;
248
249 Y1:= Data[m].PosY;
250 X2:= Data[m].EndX;
251 Y2:= Data[m].EndY;
252
253 if (X2=0) and (Y2>0) then
254 Dec(Y2);
255
256 if ALine<Y1 then
257 b:= m-1
258 else
259 if ALine<=Y2 then
260 exit(true)
261 else
262 a:= m+1;
263 until false;
264 end;
265
IsLineAllSelectednull266 function TATCaretSelections.IsLineAllSelected(ALine, ALineLen: integer): boolean;
267 var
268 X1, Y1, Y2, X2: integer;
269 a, b, m: integer;
270 begin
271 Result:= false;
272 a:= 0;
273 b:= High(Data);
274
275 repeat
276 if a>b then exit;
277 m:= (a+b+1) div 2;
278
279 X1:= Data[m].PosX;
280 Y1:= Data[m].PosY;
281 X2:= Data[m].EndX;
282 Y2:= Data[m].EndY;
283
284 if not IsPosSorted(X1, Y1, 0, ALine, true) then
285 b:= m-1
286 else
287 if IsPosSorted(ALineLen, ALine, X2, Y2, true) then
288 exit(true)
289 else
290 a:= m+1;
291 until false;
292 end;
293
294
IsPosSelectednull295 function TATCaretSelections.IsPosSelected(AX, AY: integer): boolean;
296 var
297 X1, Y1, X2, Y2: integer;
298 a, b, m: integer;
299 begin
300 Result:= false;
301 a:= 0;
302 b:= High(Data);
303
304 repeat
305 if a>b then exit;
306 m:= (a+b+1) div 2;
307
308 X1:= Data[m].PosX;
309 Y1:= Data[m].PosY;
310 X2:= Data[m].EndX;
311 Y2:= Data[m].EndY;
312
313 case IsPosInRange(AX, AY, X1, Y1, X2, Y2) of
314 cRelateInside:
315 exit(true);
316 cRelateBefore:
317 b:= m-1;
318 cRelateAfter:
319 a:= m+1;
320 end;
321 until false;
322 end;
323
IsRangeSelectednull324 function TATCaretSelections.IsRangeSelected(AX1, AY1, AX2, AY2: integer): TATRangeSelection;
325 var
326 X1, Y1, X2, Y2: integer;
327 a, b, m: integer;
328 bLeft, bRight: TATPosRelation;
329 begin
330 Result:= cRangeAllUnselected;
331 a:= 0;
332 b:= High(Data);
333
334 repeat
335 if a>b then exit;
336 m:= (a+b+1) div 2;
337
338 X1:= Data[m].PosX;
339 Y1:= Data[m].PosY;
340 X2:= Data[m].EndX;
341 Y2:= Data[m].EndY;
342
343 bLeft:= IsPosInRange(AX1, AY1, X1, Y1, X2, Y2);
344 if (bLeft=cRelateAfter) then
345 begin
346 a:= m+1;
347 Continue;
348 end;
349
350 bRight:= IsPosInRange(AX2, AY2, X1, Y1, X2, Y2, true);
351 if (bRight=cRelateBefore) then
352 begin
353 b:= m-1;
354 Continue;
355 end;
356
357 if (bLeft=cRelateInside) and (bRight=cRelateInside) then
358 exit(cRangeAllSelected)
359 else
360 exit(cRangePartlySelected);
361 until false;
362 end;
363
364 procedure TATCaretSelections.GetRangesInLineAfterPoint(AX, AY: integer; out
365 ARanges: TATSimpleRangeArray);
366 var
367 X1, Y1, X2, Y2, XFrom, XTo: integer;
368 i: integer;
369 begin
370 SetLength(ARanges, 0);
371 for i:= 0 to High(Data) do
372 begin
373 X1:= Data[i].PosX;
374 Y1:= Data[i].PosY;
375 X2:= Data[i].EndX;
376 Y2:= Data[i].EndY;
377
378 if (Y1>AY) then Break; //caret is fully after line AY: stop
379 if (Y2<AY) then Continue; //caret is fully before line AY
380
381 if (Y1<AY) then XFrom:= 0 else XFrom:= X1;
382 if (Y2>AY) then XTo:= MaxInt else XTo:= X2;
383
384 if XTo<=AX then Continue;
385 if XFrom<AX then XFrom:= AX;
386
387 SetLength(ARanges, Length(ARanges)+1);
388 with ARanges[High(ARanges)] do
389 begin
390 NFrom:= XFrom;
391 NTo:= XTo;
392 end;
393 end;
394 end;
395
396
397 { TATCaretItem }
398
399 procedure TATCaretItem.GetRange(out AX1, AY1, AX2, AY2: integer; out ASel: boolean);
400 begin
401 AX1:= PosX;
402 AY1:= PosY;
403 AX2:= EndX;
404 AY2:= EndY;
405 ASel:= false;
406
407 if (AX2<0) or (AY2<0) then Exit;
408 if (AX1=AX2) and (AY1=AY2) then Exit;
409
410 ASel:= true;
411 if IsPosSorted(AX2, AY2, AX1, AY1, false) then
412 begin
413 SwapInt(AX1, AX2);
414 SwapInt(AY1, AY2);
415 end;
416 end;
417
418 procedure TATCaretItem.GetSelLines(out AFrom, ATo: integer;
419 AllowNoSel: boolean = false);
420 var
421 X1, Y1, X2, Y2: integer;
422 bSel: boolean;
423 begin
424 AFrom:= -1;
425 ATo:= -1;
426
427 GetRange(X1, Y1, X2, Y2, bSel);
428 if not bSel then
429 begin
430 if AllowNoSel then
431 begin AFrom:= PosY; ATo:= PosY; end;
432 Exit
433 end;
434
435 AFrom:= Y1;
436 ATo:= Y2;
437 //sel ended at line-start?
438 if (X2=0) and (Y2>0) then Dec(ATo);
439 end;
440
GetLeftEdgenull441 function TATCaretItem.GetLeftEdge: TPoint;
442 var
443 X1, Y1, X2, Y2: integer;
444 bSel: boolean;
445 begin
446 if EndY<0 then
447 begin
448 Result.X:= PosX;
449 Result.Y:= PosY;
450 end
451 else
452 begin
453 GetRange(X1, Y1, X2, Y2, bSel);
454 Result:= Point(X1, Y1);
455 end;
456 end;
457
GetRightEdgenull458 function TATCaretItem.GetRightEdge: TPoint;
459 var
460 X1, Y1, X2, Y2: integer;
461 bSel: boolean;
462 begin
463 if EndY<0 then
464 begin
465 Result.X:= PosX;
466 Result.Y:= PosY;
467 end
468 else
469 begin
470 GetRange(X1, Y1, X2, Y2, bSel);
471 Result:= Point(X2, Y2);
472 end;
473 end;
474
Changenull475 function TATCaretItem.Change(APosX, APosY, AEndX, AEndY: integer): boolean;
476 begin
477 Result:=
478 (PosX<>APosX) or
479 (PosY<>APosY) or
480 (EndX<>AEndX) or
481 (EndY<>AEndY);
482 if Result then
483 begin
484 PosX:= APosX;
485 PosY:= APosY;
486 EndX:= AEndX;
487 EndY:= AEndY;
488 end;
489 end;
490
491 procedure TATCaretItem.SwapSelection;
492 begin
493 if EndY>=0 then
494 begin
495 SwapInt(PosX, EndX);
496 SwapInt(PosY, EndY);
497 end;
498 end;
499
IsSelectionnull500 function TATCaretItem.IsSelection: boolean;
501 begin
502 Result:= (EndY>=0) and
503 ((PosX<>EndX) or (PosY<>EndY));
504 end;
505
IsForwardSelectionnull506 function TATCaretItem.IsForwardSelection: boolean;
507 begin
508 Result:= (PosY>=0) and IsPosSorted(EndX, EndY, PosX, PosY, false);
509 end;
510
IsMultilineSelectionnull511 function TATCaretItem.IsMultilineSelection: boolean;
512 begin
513 Result:= (EndY>=0) and (EndY<>PosY);
514 end;
515
IsInVisibleRectnull516 function TATCaretItem.IsInVisibleRect(const R: TRect): boolean;
517 var
518 Pnt: TPoint;
519 begin
520 Pnt.X:= CoordX;
521 Pnt.Y:= CoordY;
522 Result:= PtInRect(R, Pnt);
523 end;
524
FirstTouchedLinenull525 function TATCaretItem.FirstTouchedLine: integer;
526 begin
527 if (EndY>=0) and (EndY<PosY) then
528 Result:= EndY
529 else
530 Result:= PosY;
531 end;
532
533 procedure TATCaretItem.UpdateMemory(AMode: TATCaretMemoryAction; AArrowUpDown: boolean);
534 begin
535 case AMode of
536 cCaretMem_PrepareX:
537 begin
538 SavedX_Pre:= CoordX;
539 end;
540 cCaretMem_SaveX:
541 begin
542 if (not AArrowUpDown) or (SavedX<SavedX_Pre) then
543 SavedX:= SavedX_Pre;
544 end;
545 cCaretMem_ClearX:
546 begin
547 SavedX:= 0;
548 end;
549 end;
550 end;
551
552 procedure TATCaretItem.SelectNone;
553 begin
554 EndX:= -1;
555 EndY:= -1;
556 end;
557
558 procedure TATCaretItem.SelectToPoint(AX, AY: integer);
559 begin
560 if EndX<0 then EndX:= PosX;
561 if EndY<0 then EndY:= PosY;
562 PosX:= AX;
563 PosY:= AY;
564 end;
565
566 { TATCarets }
567
GetItemnull568 function TATCarets.GetItem(N: integer): TATCaretItem;
569 begin
570 if IsIndexValid(N) then
571 Result:= TATCaretItem(FList[N])
572 else
573 Result:= nil;
574 end;
575
576 constructor TATCarets.Create;
577 begin
578 inherited;
579 FList:= TFPList.Create;
580 FManyAllowed:= true;
581 FOneLine:= false;
582 end;
583
584 destructor TATCarets.Destroy;
585 begin
586 Clear;
587 FreeAndNil(FList);
588 inherited;
589 end;
590
591 procedure TATCarets.Clear;
592 var
593 i: integer;
594 begin
595 for i:= FList.Count-1 downto 0 do
596 TObject(FList[i]).Free;
597 FList.Clear;
598 end;
599
600 procedure TATCarets.Delete(N: integer);
601 begin
602 if IsIndexValid(N) then
603 begin
604 TObject(FList[N]).Free;
605 FList.Delete(N);
606 DoChanged;
607 end;
608 end;
609
Countnull610 function TATCarets.Count: integer; inline;
611 begin
612 Result:= FList.Count;
613 end;
614
IsIndexValidnull615 function TATCarets.IsIndexValid(N: integer): boolean; inline;
616 begin
617 Result:= (N>=0) and (N<FList.Count);
618 end;
619
620 procedure TATCarets.Add(APosX, APosY: integer; AEndX: integer=-1; AEndY: integer=-1);
621 var
622 Item: TATCaretItem;
623 begin
624 if (not ManyAllowed) and (Count>=1) then Exit;
625 if OneLine then
626 begin
627 APosY:= 0;
628 if AEndY>0 then AEndY:= 0;
629 end;
630
631 Item:= TATCaretItem.Create;
632 Item.PosX:= APosX;
633 Item.PosY:= APosY;
634 Item.EndX:= AEndX;
635 Item.EndY:= AEndY;
636
637 FList.Add(Item);
638 DoChanged;
639 end;
640
641 function _ListCaretsCompare(Item1, Item2: Pointer): Integer;
642 var
643 Obj1, Obj2: TATCaretItem;
644 begin
645 Obj1:= TATCaretItem(Item1);
646 Obj2:= TATCaretItem(Item2);
647 Result:= Obj1.PosY-Obj2.PosY;
648 if Result=0 then
649 Result:= Obj1.PosX-Obj2.PosX;
650 end;
651
652 procedure TATCarets.Sort(AJoinAdjacentCarets: boolean=true);
653 begin
654 FList.Sort(@_ListCaretsCompare);
655 DeleteDups(AJoinAdjacentCarets);
656 end;
657
658 procedure TATCarets.DeleteDups(AJoinAdjacentCarets: boolean);
659 var
660 i: integer;
661 Item1, Item2: TATCaretItem;
662 OutPosX, OutPosY, OutEndX, OutEndY: integer;
663 begin
664 for i:= Count-1 downto 1 do
665 begin
666 Item1:= GetItem(i);
667 Item2:= GetItem(i-1);
668
669 if (Item1.PosY=Item2.PosY) and (Item1.PosX=Item2.PosX) then
670 Delete(i);
671
672 if AJoinAdjacentCarets and
673 IsJoinNeeded(i, i-1, OutPosX, OutPosY, OutEndX, OutEndY) then
674 begin
675 Delete(i);
676 Item2.PosX:= OutPosX;
677 Item2.PosY:= OutPosY;
678 Item2.EndX:= OutEndX;
679 Item2.EndY:= OutEndY;
680 end;
681 end;
682
683 DoChanged;
684 end;
685
686
687 procedure TATCarets.Assign(Obj: TATCarets);
688 var
689 Caret: TATCaretItem;
690 i: integer;
691 begin
692 Clear;
693 for i:= 0 to Obj.Count-1 do
694 begin
695 Caret:= Obj[i];
696 Add(Caret.PosX, Caret.PosY, Caret.EndX, Caret.EndY);
697 end;
698 DoChanged;
699 end;
700
FindCaretBeforePosnull701 function TATCarets.FindCaretBeforePos(APosX, APosY: integer;
702 ARequireSel: boolean): integer;
703 var
704 Item: TATCaretItem;
705 bSel: boolean;
706 X1, Y1, X2, Y2: integer;
707 i: integer;
708 begin
709 Result:= -1;
710 for i:= Count-1 downto 0 do
711 begin
712 Item:= Items[i];
713 Item.GetRange(X1, Y1, X2, Y2, bSel);
714 if ARequireSel and not bSel then
715 Continue;
716 if (Y1<APosY) or ((Y1=APosY) and (X1<APosX)) then
717 Exit(i);
718 end;
719 end;
720
FindCaretContainingPosnull721 function TATCarets.FindCaretContainingPos(APosX, APosY: integer): integer;
722 var
723 Item: TATCaretItem;
724 X1, Y1, X2, Y2, i: integer;
725 bSel: boolean;
726 begin
727 Result:= -1;
728 for i:= 0 to Count-1 do
729 begin
730 Item:= Items[i];
731 Item.GetRange(X1, Y1, X2, Y2, bSel);
732 if bSel then
733 if IsPosInRange(APosX, APosY, X1, Y1, X2, Y2)=cRelateInside then
734 Exit(i);
735 end;
736 end;
737
IndexOfPosXYnull738 function TATCarets.IndexOfPosXY(APosX, APosY: integer; AUseEndXY: boolean = false): integer;
739 var
740 Item: TATCaretItem;
741 useX, useY: integer;
742 a, b, m, difX, difY: integer;
743 begin
744 Result:= -1;
745 a:= 0;
746 b:= Count-1;
747 repeat
748 if a>b then exit;
749 m:= (a+b+1) div 2;
750 Item:= Items[m];
751 if AUseEndXY and (Item.EndY>=0) then
752 begin
753 useX:= Item.EndX;
754 useY:= Item.EndY;
755 end
756 else
757 begin
758 useX:= Item.PosX;
759 useY:= Item.PosY;
760 end;
761 difX:= useX-APosX;
762 difY:= useY-APosY;
763 if (difX=0) and (difY=0) then
764 exit(m);
765 if (difY>0) or ((difY=0) and (difX>0)) then
766 b:= m-1
767 else
768 a:= m+1;
769 until false;
770 end;
771
IndexOfLeftRightnull772 function TATCarets.IndexOfLeftRight(ALeft: boolean): integer;
773 var
774 Item: TATCaretItem;
775 i, NPos: integer;
776 Upd: boolean;
777 begin
778 Result:= -1;
779 if Count>0 then
780 NPos:= Items[0].PosX;
781 for i:= 0 to Count-1 do
782 begin
783 Item:= Items[i];
784 if ALeft then
785 Upd:= Item.PosX<=NPos
786 else
787 Upd:= Item.PosX>=NPos;
788 if Upd then
789 begin
790 Result:= i;
791 NPos:= Item.PosX;
792 end;
793 end;
794 end;
795
IsLineWithCaretnull796 function TATCarets.IsLineWithCaret(APosY: integer; ADisableSelected: boolean=false): boolean;
797 var
798 a, b, m, dif: integer;
799 begin
800 Result:= false;
801 a:= 0;
802 b:= Count-1;
803 repeat
804 if a>b then exit;
805 m:= (a+b+1) div 2;
806 dif:= Items[m].PosY-APosY;
807 if dif=0 then
808 begin
809 if not ADisableSelected then
810 exit(true)
811 else
812 exit(not Items[m].IsSelection);
813 end;
814 if dif>0 then
815 b:= m-1
816 else
817 a:= m+1;
818 until false;
819 end;
820
IsLineWithSelectionnull821 function TATCarets.IsLineWithSelection(APosY: integer): boolean;
822 var
823 Item: TATCaretItem;
824 Y1, Y2, X1, X2: integer;
825 i: integer;
826 begin
827 Result:= false;
828 for i:= 0 to Count-1 do
829 begin
830 Item:= Items[i];
831 if Item.EndY>=0 then
832 begin
833 X1:= Item.PosX;
834 Y1:= Item.PosY;
835 X2:= Item.EndX;
836 Y2:= Item.EndY;
837 if (Y1>Y2) or ((Y1=Y2) and (X1>X2)) then
838 begin
839 SwapInt(Y1, Y2);
840 SwapInt(X1, X2);
841 end;
842 if (X2=0) and (Y2>0) then
843 Dec(Y2);
844 if (Y1<=APosY) and (APosY<=Y2) then
845 exit(true);
846 end;
847 end;
848 end;
849
850
IsSelectionnull851 function TATCarets.IsSelection: boolean;
852 var
853 i: integer;
854 begin
855 for i:= 0 to Count-1 do
856 if Items[i].IsSelection then
857 exit(true);
858 Result:= false;
859 end;
860
IsAnyCaretInVisibleRectnull861 function TATCarets.IsAnyCaretInVisibleRect(const R: TRect): boolean;
862 var
863 i: integer;
864 begin
865 for i:= 0 to Count-1 do
866 if Items[i].IsInVisibleRect(R) then
867 exit(true);
868 Result:= false;
869 end;
870
871
CaretAtEdgenull872 function TATCarets.CaretAtEdge(AEdge: TATCaretEdge): TPoint;
873 var
874 N: integer;
875 begin
876 Result:= Point(0, 0);
877 case AEdge of
878 cEdgeTop: N:= 0;
879 cEdgeBottom: N:= Count-1;
880 cEdgeLeft: N:= IndexOfLeftRight(true);
881 cEdgeRight: N:= IndexOfLeftRight(false);
882 end;
883 if IsIndexValid(N) then
884 with Items[N] do
885 Result:= Point(PosX, PosY);
886 end;
887
IsJoinNeedednull888 function TATCarets.IsJoinNeeded(AIndex1, AIndex2: integer;
889 out OutPosX, OutPosY, OutEndX, OutEndY: integer): boolean;
890 var
891 Item1, Item2: TATCaretItem;
892 XMin1, XMin2, YMin1, YMin2, XMax1, XMax2, YMax1, YMax2: integer;
893 Sel1, Sel2: boolean;
894 begin
895 Result:= false;
896 if not IsIndexValid(AIndex1) then Exit;
897 if not IsIndexValid(AIndex2) then Exit;
898
899 Item1:= Items[AIndex1];
900 Item2:= Items[AIndex2];
901 Item1.GetRange(XMin1, YMin1, XMax1, YMax1, Sel1);
902 Item2.GetRange(XMin2, YMin2, XMax2, YMax2, Sel2);
903
904 //caret1 w/out selection inside caret2 selection?
905 if not Sel1 and not Sel2 then Exit;
906 if not Sel1 then
907 begin
908 Result:= IsPosInRange(Item1.PosX, Item1.PosY, XMin2, YMin2, XMax2, YMax2)=cRelateInside;
909 if Result then
910 begin OutPosX:= Item2.PosX; OutPosY:= Item2.PosY; OutEndX:= Item2.EndX; OutEndY:= Item2.EndY; end;
911 Exit
912 end;
913 if not Sel2 then
914 begin
915 Result:= IsPosInRange(Item2.PosX, Item2.PosY, XMin1, YMin1, XMax1, YMax1)=cRelateInside;
916 if Result then
917 begin OutPosX:= Item1.PosX; OutPosY:= Item1.PosY; OutEndX:= Item1.EndX; OutEndY:= Item1.EndY; end;
918 Exit
919 end;
920
921 //calc join-result, needed only for Result=true
922 //minimal point
923 GetPositionMinOrMax(XMin1, YMin1, XMin2, YMin2, false, OutPosX, OutPosY);
924 //maximal point
925 GetPositionMinOrMax(XMax1, YMax1, XMax2, YMax2, true, OutEndX, OutEndY);
926
927 //swap points?
928 if Item1.IsForwardSelection then
929 begin
930 SwapInt(OutPosX, OutEndX);
931 SwapInt(OutPosY, OutEndY);
932 end;
933
934 if IsPosSorted(XMax1, YMax1, XMin2, YMin2, AllowSelectionsTouch) then
935 Exit; //ranges not overlap [x1, y1]...[x2, y2]
936
937 if IsPosSorted(XMax2, YMax2, XMin1, YMin1, AllowSelectionsTouch) then
938 Exit; //ranges not overlap [x2, y2]...[x1, y1]
939
940 Result:= true; //ranges overlap
941 end;
942
943 procedure TATCarets.DoChanged;
944 begin
945 if Assigned(FOnCaretChanged) then
946 FOnCaretChanged(Self);
947 end;
948
DebugTextnull949 function TATCarets.DebugText: string;
950 var
951 i: integer;
952 begin
953 Result:= '';
954 for i:= 0 to Count-1 do
955 with Items[i] do
956 Result:= Result+Format('caret[%d] pos %d:%d end %d:%d', [
957 i, posy, posx, endy, endx
958 ])+sLineBreak;
959 end;
960
GetAsArraynull961 function TATCarets.GetAsArray: TATPointArray;
962 var
963 Item: TATCaretItem;
964 i: integer;
965 begin
966 SetLength(Result{%H-}, Count*2);
967 for i:= 0 to Count-1 do
968 begin
969 Item:= Items[i];
970 Result[i*2].X:= Item.PosX;
971 Result[i*2].Y:= Item.PosY;
972 Result[i*2+1].X:= Item.EndX;
973 Result[i*2+1].Y:= Item.EndY;
974 end;
975 end;
976
977 procedure TATCarets.SetAsArray(const Res: TATPointArray);
978 var
979 i: integer;
980 begin
981 Clear;
982 for i:= 0 to Length(Res) div 2 - 1 do
983 Add(
984 Res[i*2].X,
985 Res[i*2].Y,
986 Res[i*2+1].X,
987 Res[i*2+1].Y
988 );
989 DoChanged;
990 end;
991
GetAsStringnull992 function TATCarets.GetAsString: string;
993 var
994 Item: TATCaretItem;
995 S: string;
996 NLast, i: integer;
997 begin
998 Result:= '';
999 NLast:= Count-1;
1000 for i:= 0 to NLast do
1001 begin
1002 Item:= Items[i];
1003 if Item.EndY<0 then
1004 S:= Format('%d,%d', [Item.PosX, Item.PosY])
1005 else
1006 S:= Format('%d,%d,%d,%d', [Item.PosX, Item.PosY, Item.EndX, Item.EndY]);
1007 if i<NLast then
1008 S+= ';';
1009 Result+= S;
1010 end;
1011 end;
1012
1013 procedure TATCarets.SetAsString(const AValue: string);
1014 var
1015 Sep1, Sep2: TATStringSeparator;
1016 OneItem: string;
1017 X1, Y1, X2, Y2: integer;
1018 begin
1019 Clear;
1020 Sep1.Init(AValue, ';');
1021
1022 while Sep1.GetItemStr(OneItem) do
1023 begin
1024 Sep2.Init(OneItem, ',');
1025 Sep2.GetItemInt(X1, -1, 0, MaxInt);
1026 if X1<0 then Continue;
1027 Sep2.GetItemInt(Y1, -1, 0, MaxInt);
1028 if Y1<0 then Continue;
1029 Sep2.GetItemInt(X2, -1, -1{no sel}, MaxInt);
1030 Sep2.GetItemInt(Y2, -1, -1{no sel}, MaxInt);
1031 Add(X1, Y1, X2, Y2);
1032 end;
1033
1034 Sort;
1035 end;
1036
1037 procedure TATCarets.UpdateMemory(AMode: TATCaretMemoryAction; AArrowUpDown: boolean);
1038 var
1039 i: integer;
1040 begin
1041 for i:= 0 to Count-1 do
1042 Items[i].UpdateMemory(AMode, AArrowUpDown);
1043 end;
1044
1045 procedure TATCarets.UpdateAfterRangeFolded(ARangeX, ARangeY, ARangeY2: integer);
1046 var
1047 Caret: TATCaretItem;
1048 bChange: boolean;
1049 i: integer;
1050 begin
1051 bChange:= false;
1052 for i:= 0 to Count-1 do
1053 begin
1054 Caret:= GetItem(i);
1055 if (Caret.PosY>=ARangeY) and (Caret.PosY<=ARangeY2) and
1056 ((Caret.PosY>ARangeY) or (Caret.PosX>ARangeX)) then
1057 begin
1058 bChange:= true;
1059 Caret.PosX:= Max(0, ARangeX-1);
1060 Caret.PosY:= ARangeY;
1061 end;
1062 end;
1063 if bChange then
1064 Sort;
1065 end;
1066
1067 procedure TATCarets.GetSelections(var D: TATCaretSelections);
1068 var
1069 Item: TATCaretItem;
1070 NLen, i: integer;
1071 X1, Y1, X2, Y2: integer;
1072 begin
1073 SetLength(D.Data, Count);
1074 NLen:= 0;
1075
1076 for i:= 0 to Count-1 do
1077 begin
1078 Item:= Items[i];
1079 X1:= Item.PosX;
1080 Y1:= Item.PosY;
1081 X2:= Item.EndX;
1082 Y2:= Item.EndY;
1083 if Y2>=0 then
1084 begin
1085 if (Y1>Y2) or ((Y1=Y2) and (X1>X2)) then
1086 begin
1087 SwapInt(Y1, Y2);
1088 SwapInt(X1, X2);
1089 end;
1090 D.Data[NLen].PosX:= X1;
1091 D.Data[NLen].PosY:= Y1;
1092 D.Data[NLen].EndX:= X2;
1093 D.Data[NLen].EndY:= Y2;
1094 Inc(NLen);
1095 end;
1096 end;
1097
1098 //don't realloc in a loop
1099 SetLength(D.Data, NLen);
1100 end;
1101
1102
TATCarets.IsPosSelectednull1103 function TATCarets.IsPosSelected(AX, AY: integer; AllowAtEdge: boolean): boolean;
1104 var
1105 Caret: TATCaretItem;
1106 X1, Y1, X2, Y2: integer;
1107 bSel: boolean;
1108 i: integer;
1109 begin
1110 Result:= false;
1111 for i:= 0 to Count-1 do
1112 begin
1113 Caret:= Items[i];
1114 Caret.GetRange(X1, Y1, X2, Y2, bSel);
1115 if bSel then
1116 if IsPosInRange(AX, AY, X1, Y1, X2, Y2, AllowAtEdge)=cRelateInside then
1117 exit(true);
1118 end;
1119 end;
1120
1121 end.
1122
1123