1{-------------------------------------------------------------------------------
2The contents of this file are subject to the Mozilla Public License
3Version 1.1 (the "License"); you may not use this file except in compliance
4with the License. You may obtain a copy of the License at
5http://www.mozilla.org/MPL/
6
7Software distributed under the License is distributed on an "AS IS" basis,
8WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
9the specific language governing rights and limitations under the License.
10
11Alternatively, the contents of this file may be used under the terms of the
12GNU General Public License Version 2 or later (the "GPL"), in which case
13the provisions of the GPL are applicable instead of those above.
14If you wish to allow use of your version of this file only under the terms
15of the GPL and not to allow others to use your version of this file
16under the MPL, indicate your decision by deleting the provisions above and
17replace them with the notice and other provisions required by the GPL.
18If you do not delete the provisions above, a recipient may use your version
19of this file under either the MPL or the GPL.
20
21-------------------------------------------------------------------------------}
22unit SynEditMarkupSelection;
23
24{$mode objfpc}{$H+}
25
26interface
27
28uses
29  Classes, SysUtils, Graphics, Controls, LCLProc,
30  SynEditMarkup, SynEditMiscClasses, SynEditPointClasses;
31
32type
33
34  { TSynEditMarkupSelection }
35
36  TSynEditMarkupSelection = class(TSynEditMarkup)
37  private
38    FSelection: TSynEditSelection;
39    FColorTillEol: boolean; // colorize selection only till EOL
40    FMarkupInfoIncr: TSynSelectedColor; // Markup during incremental search
41    FMarkupInfoSelection: TSynSelectedColor; // Markup for normal Selection
42    FUseIncrementalColor : Boolean;
43    nSelStart, nSelEnd: integer; // start, end of selected area in current line (physical)
44    procedure SetColorTillEol(AValue: boolean);
45    procedure SetUseIncrementalColor(const AValue : Boolean);
46    procedure MarkupChangedIntern(AMarkup: TObject);
47  protected
48    procedure DoMarkupChanged(AMarkup: TSynSelectedColor); override;
49    procedure DoEnabledChanged(Sender: TObject); override;
50  public
51    constructor Create(ASynEdit : TSynEditBase; ASelection: TSynEditSelection);
52    destructor Destroy; override;
53
54    procedure PrepareMarkupForRow(aRow : Integer); override;
55    function GetMarkupAttributeAtRowCol(const aRow: Integer;
56                                        const aStartCol: TLazSynDisplayTokenBound;
57                                        const AnRtlInfo: TLazSynDisplayRtlInfo): TSynSelectedColor; override;
58    procedure GetNextMarkupColAfterRowCol(const aRow: Integer;
59                                         const aStartCol: TLazSynDisplayTokenBound;
60                                         const AnRtlInfo: TLazSynDisplayRtlInfo;
61                                         out   ANextPhys, ANextLog: Integer); override;
62
63    property ColorTillEol: boolean read FColorTillEol write SetColorTillEol;
64    property UseIncrementalColor : Boolean read FUseIncrementalColor write SetUseIncrementalColor;
65    property MarkupInfoSeletion : TSynSelectedColor read FMarkupInfoSelection;
66    property MarkupInfoIncr : TSynSelectedColor read FMarkupInfoIncr;
67  end;
68
69implementation
70uses SynEdit, SynEditTypes;
71
72{ TSynEditMarkupSelection }
73
74procedure TSynEditMarkupSelection.SetUseIncrementalColor(const AValue : Boolean);
75begin
76  if FUseIncrementalColor=AValue then exit;
77  FUseIncrementalColor:=AValue;
78  if FUseIncrementalColor
79  then MarkupInfo.Assign(FMarkupInfoIncr)
80  else MarkupInfo.Assign(FMarkupInfoSelection);
81end;
82
83procedure TSynEditMarkupSelection.SetColorTillEol(AValue: boolean);
84begin
85  if FColorTillEol = AValue then Exit;
86  FColorTillEol := AValue;
87  DoMarkupChanged(nil);
88end;
89
90procedure TSynEditMarkupSelection.MarkupChangedIntern(AMarkup : TObject);
91begin
92  if FUseIncrementalColor
93  then MarkupInfo.Assign(FMarkupInfoIncr)
94  else MarkupInfo.Assign(FMarkupInfoSelection);
95end;
96
97procedure TSynEditMarkupSelection.DoMarkupChanged(AMarkup: TSynSelectedColor);
98var
99  p1, p2 : TPoint;
100begin
101  inherited DoMarkupChanged(AMarkup);
102  if (not FSelection.SelAvail) or (TCustomSynEdit(SynEdit).HideSelection and not TCustomSynEdit(SynEdit).Focused) then
103    exit;
104
105  p1 := FSelection.FirstLineBytePos;  // always ordered
106  p2 := FSelection.LastLineBytePos;
107  InvalidateSynLines(p1.y, p2.y);
108end;
109
110procedure TSynEditMarkupSelection.DoEnabledChanged(Sender: TObject);
111begin
112  DoMarkupChanged(nil);
113end;
114
115constructor TSynEditMarkupSelection.Create(ASynEdit : TSynEditBase; ASelection: TSynEditSelection);
116begin
117  inherited Create(ASynEdit);
118  FSelection := ASelection;
119  FMarkupInfoSelection := TSynSelectedColor.Create;
120  FMarkupInfoSelection.OnChange := @MarkupChangedIntern;
121  FMarkupInfoIncr := TSynSelectedColor.Create;
122  FMarkupInfoIncr.OnChange := @MarkupChangedIntern;
123  FColorTillEol := false;
124
125  MarkupInfo.Style := [];
126  MarkupInfo.StyleMask := [];
127end;
128
129destructor TSynEditMarkupSelection.Destroy;
130begin
131  inherited Destroy;
132  FreeAndNil(FMarkupInfoIncr);
133  FreeAndNil(FMarkupInfoSelection);
134end;
135
136procedure TSynEditMarkupSelection.PrepareMarkupForRow(aRow : Integer);
137var
138  p1, p2 : TPoint;
139begin
140  nSelStart := 0;
141  nSelEnd := 0;
142
143  if (not TCustomSynEdit(SynEdit).HideSelection or TCustomSynEdit(SynEdit).Focused) then begin
144    p1 := FSelection.FirstLineBytePos;  // always ordered
145    p2 := FSelection.LastLineBytePos;
146
147    if (p1.y > aRow) or (p2.y < aRow) or not (FSelection.SelAvail) then
148      exit;
149
150    nSelStart := 1;
151    nSelEnd := -1; // line end
152    if (FSelection.ActiveSelectionMode = smColumn) then begin
153      p1 := LogicalToPhysicalPos(p1);
154      p2 := LogicalToPhysicalPos(p2);
155      if (p1.X < p2.X) then begin
156        nSelStart := p1.X;
157        nSelEnd := p2.X;
158      end else begin
159        nSelStart := p2.X;
160        nSelEnd := p1.X;
161      end;
162    end else if (FSelection.ActiveSelectionMode = smNormal) then begin
163      if p1.y = aRow then begin
164        p1 := LogicalToPhysicalPos(p1);
165        nSelStart := p1.x;
166      end;
167      if p2.y = aRow then begin
168        p2 := LogicalToPhysicalPos(p2);
169        nSelEnd := p2.x;
170      end;
171
172      //colorize selected block only till EOL, not till edge of control
173      if FColorTillEol then begin
174        p2.x := Length(Lines[aRow-1]) + 1;
175        p2.y := aRow;
176        p2 := LogicalToPhysicalPos(p2);
177        if (nSelEnd = -1) then
178          Inc(p2.x, 1);
179
180        if (nSelEnd = -1) or (nSelEnd > p2.x) then
181          nSelEnd := p2.x;
182      end;
183
184    end;
185  end;
186  MarkupInfo.SetFrameBoundsPhys(nSelStart, nSelEnd);
187end;
188
189function TSynEditMarkupSelection.GetMarkupAttributeAtRowCol(const aRow: Integer;
190  const aStartCol: TLazSynDisplayTokenBound; const AnRtlInfo: TLazSynDisplayRtlInfo): TSynSelectedColor;
191begin
192  result := nil;
193  if AnRtlInfo.IsRtl then begin
194    if ( ((nSelStart >= aStartCol.Physical) and (nSelStart < AnRtlInfo.PhysRight) ) or
195          (nSelStart <= AnRtlInfo.PhysLeft)
196       ) and
197       ( ((nSelEnd < aStartCol.Physical) and (nSelEnd > AnRtlInfo.PhysLeft)) or
198          (nSelEnd >= AnRtlInfo.PhysRight) or (nSelEnd < 0))
199    then
200      Result := MarkupInfo;
201  end else begin
202    if (nSelStart <= aStartCol.Physical) and
203      ((nSelEnd > aStartCol.Physical) or (nSelEnd < 0))
204    then
205      Result := MarkupInfo;
206  end;
207end;
208
209procedure TSynEditMarkupSelection.GetNextMarkupColAfterRowCol(const aRow: Integer;
210  const aStartCol: TLazSynDisplayTokenBound; const AnRtlInfo: TLazSynDisplayRtlInfo; out ANextPhys,
211  ANextLog: Integer);
212begin
213  ANextLog := -1;
214  ANextPhys := -1;
215  if AnRtlInfo.IsRtl then begin
216    if (nSelStart < aStartCol.Physical) then
217      ANextPhys := nSelStart;
218    if (nSelEnd < aStartCol.Physical) and (nSelEnd > 0)  and
219       (  (nSelStart >= aStartCol.Physical) or
220         ((nSelStart <= AnRtlInfo.PhysLeft) and (nSelStart > 0))  )
221    then
222      ANextPhys := nSelEnd;
223  end else begin
224    if (nSelStart > aStartCol.Physical) then
225      ANextPhys := nSelStart;
226    if (nSelEnd > aStartCol.Physical) and (nSelStart <= aStartCol.Physical) then
227      ANextPhys := nSelEnd;
228  end;
229end;
230
231end.
232
233