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