1 {
2 Copyright (C) Alexey Torgashin, uvviewsoft.com
3 License: MPL 2.0 or LGPL
4 }
5 unit ATSynEdit_LineParts;
6
7 {$mode objfpc}{$H+}
8
9 interface
10
11 uses
12 SysUtils, Graphics;
13
14 type
15 TATLineStyle = (
16 cLineStyleNone,
17 cLineStyleSolid,
18 cLineStyleDash,
19 cLineStyleSolid2px,
20 cLineStyleDotted,
21 cLineStyleRounded,
22 cLineStyleWave
23 );
24
25 const
26 afsFontBold = 1;
27 afsFontItalic = 2;
28 afsFontCrossed = 4;
29
30 type
31 TATLinePart = packed record
32 Offset: SmallInt; //2 bytes
33 Len: word; //2 bytes
34 ColorFont, ColorBG, ColorBorder: TColor;
35 FontStyles: byte;
36 BorderUp, BorderDown, BorderLeft, BorderRight: TATLineStyle;
37 end;
38 PATLinePart = ^TATLinePart;
39
40 type
41 TATLinePartClass = class
42 public
43 Data: TATLinePart;
44 ColumnTag: Int64;
45 end;
46
47 const
48 cMaxLineParts = 210;
49 type
50 TATLineParts = array[0..cMaxLineParts-1] of TATLinePart;
51 PATLineParts = ^TATLineParts;
52
53 procedure DoPartFind(constref AParts: TATLineParts; APos: integer; out AIndex, AOffsetLeft: integer);
DoPartInsertnull54 function DoPartInsert(var AParts: TATLineParts; var APart: TATLinePart; AKeepFontStyles: boolean): boolean;
55 procedure DoPartSetColorBG(var AParts: TATLineParts; AColor: TColor; AForceColor: boolean);
56
DoPartsGetCountnull57 function DoPartsGetCount(constref AParts: TATLineParts): integer;
DoPartsShownull58 function DoPartsShow(var P: TATLineParts): string;
59 procedure DoPartsDim(var P: TATLineParts; ADimLevel255: integer; AColorBG: TColor);
60 procedure DoPartsCutFromOffset(var P: TATLineParts; AOffset: integer);
61
ColorBlendnull62 function ColorBlend(c1, c2: Longint; A: Longint): Longint;
ColorBlendHalfnull63 function ColorBlendHalf(c1, c2: Longint): Longint;
64
ConvertFontStylesToIntegernull65 function ConvertFontStylesToInteger(Styles: TFontStyles): integer;
ConvertIntegerToFontStylesnull66 function ConvertIntegerToFontStyles(Value: integer): TFontStyles;
67
68 implementation
69
ColorBlendnull70 function ColorBlend(c1, c2: Longint; A: Longint): Longint;
71 //blend level: 0..255
72 var
73 r, g, b, v1, v2: byte;
74 begin
75 v1:= Byte(c1);
76 v2:= Byte(c2);
77 r:= A * (v1 - v2) shr 8 + v2;
78 v1:= Byte(c1 shr 8);
79 v2:= Byte(c2 shr 8);
80 g:= A * (v1 - v2) shr 8 + v2;
81 v1:= Byte(c1 shr 16);
82 v2:= Byte(c2 shr 16);
83 b:= A * (v1 - v2) shr 8 + v2;
84 Result := (b shl 16) + (g shl 8) + r;
85 end;
86
ColorBlendHalfnull87 function ColorBlendHalf(c1, c2: Longint): Longint;
88 var
89 r, g, b, v1, v2: byte;
90 begin
91 v1:= Byte(c1);
92 v2:= Byte(c2);
93 r:= (v1+v2) shr 1;
94 v1:= Byte(c1 shr 8);
95 v2:= Byte(c2 shr 8);
96 g:= (v1+v2) shr 1;
97 v1:= Byte(c1 shr 16);
98 v2:= Byte(c2 shr 16);
99 b:= (v1+v2) shr 1;
100 Result := (b shl 16) + (g shl 8) + r;
101 end;
102
103
104 procedure DoPartFind(constref AParts: TATLineParts; APos: integer; out AIndex,
105 AOffsetLeft: integer);
106 var
107 iStart, iEnd, i: integer;
108 begin
109 AIndex:= -1;
110 AOffsetLeft:= 0;
111
112 for i:= Low(AParts) to High(AParts)-1 do
113 begin
114 if AParts[i].Len=0 then
115 begin
116 //pos after last part?
117 if i>Low(AParts) then
118 if APos>=AParts[i-1].Offset+AParts[i-1].Len then
119 AIndex:= i;
120 Break;
121 end;
122
123 iStart:= AParts[i].Offset;
124 iEnd:= iStart+AParts[i].Len;
125
126 //pos at part begin?
127 if (APos=iStart) then
128 begin AIndex:= i; Break end;
129
130 //pos at part middle?
131 if (APos>=iStart) and (APos<iEnd) then
132 begin AIndex:= i; AOffsetLeft:= APos-iStart; Break end;
133 end;
134 end;
135
136
DoPartsGetTotalLennull137 function DoPartsGetTotalLen(constref AParts: TATLineParts): integer;
138 var
139 N: integer;
140 begin
141 N:= 0;
142 while (N<=High(AParts)) and (AParts[N].Len>0) do Inc(N);
143 if N=0 then
144 Result:= 0
145 else
146 Result:= AParts[N-1].Offset+AParts[N-1].Len;
147 end;
148
DoPartsGetCountnull149 function DoPartsGetCount(constref AParts: TATLineParts): integer;
150 //func considers case when some middle part has Len=0
151 begin
152 Result:= High(AParts)+1;
153 while (Result>0) and (AParts[Result-1].Len=0) do
154 Dec(Result);
155 end;
156
157 var
158 ResultParts: TATLineParts; //size is huge, so not local var
159
DoPartInsertnull160 function DoPartInsert(var AParts: TATLineParts; var APart: TATLinePart;
161 AKeepFontStyles: boolean): boolean;
162 var
163 ResultPartIndex: integer;
164 //
165 procedure AddPart(constref P: TATLinePart); inline;
166 begin
167 if P.Len>0 then
168 if ResultPartIndex<High(ResultParts) then
169 begin
170 Move(P, ResultParts[ResultPartIndex], SizeOf(P));
171 Inc(ResultPartIndex);
172 end;
173 end;
174 //
175 procedure FixPartLen(var P: TATLinePart; NOffsetEnd: integer); inline;
176 begin
177 if P.Len>NOffsetEnd-P.Offset then
178 P.Len:= NOffsetEnd-P.Offset;
179 end;
180 //
181 var
182 PartSelBegin, PartSelEnd: TATLinePart;
183 ColorFontLeft, ColorFontRight: TColor;
184 nIndex1, nIndex2,
185 nOffset1, nOffset2, nOffsetLimit,
186 newLen2, newOffset2: integer;
187 i: integer;
188 begin
189 Result:= false;
190
191 //if editor scrolled to right, passed parts have Offset<0,
192 //shrink such parts
193 if (APart.Offset<0) and (APart.Offset+APart.Len>0) then
194 begin
195 Inc(APart.Len, APart.Offset);
196 APart.Offset:= 0;
197 end;
198
199 DoPartFind(AParts, APart.Offset, nIndex1, nOffset1);
200 DoPartFind(AParts, APart.Offset+APart.Len, nIndex2, nOffset2);
201 if nIndex1<0 then Exit;
202 if nIndex2<0 then Exit;
203
204 //if ColorBG=clNone, use ColorBG of previous part at that position
205 //tested on URLs in JS inside HTML
206 if APart.ColorBG=clNone then
207 APart.ColorBG:= AParts[nIndex1].ColorBG; //clYellow;
208
209 if APart.ColorFont<>clNone then
210 begin
211 ColorFontLeft:= APart.ColorFont;
212 ColorFontRight:= APart.ColorFont;
213 end
214 else
215 begin
216 ColorFontLeft:= AParts[nIndex1].ColorFont;
217 ColorFontRight:= AParts[nIndex2].ColorFont;
218 end;
219
220 //these 2 parts are for edges of selection
221 FillChar(PartSelBegin{%H-}, SizeOf(TATLinePart), 0);
222 FillChar(PartSelEnd{%H-}, SizeOf(TATLinePart), 0);
223
224 PartSelBegin.ColorFont:= ColorFontLeft;
225 PartSelBegin.ColorBG:= APart.ColorBG;
226
227 PartSelBegin.Offset:= AParts[nIndex1].Offset+nOffset1;
228 PartSelBegin.Len:= AParts[nIndex1].Len-nOffset1;
229
230 PartSelBegin.FontStyles:= AParts[nIndex1].FontStyles;
231 PartSelBegin.BorderDown:= AParts[nIndex1].BorderDown;
232 PartSelBegin.BorderLeft:= AParts[nIndex1].BorderLeft;
233 PartSelBegin.BorderRight:= AParts[nIndex1].BorderRight;
234 PartSelBegin.BorderUp:= AParts[nIndex1].BorderUp;
235 PartSelBegin.ColorBorder:= AParts[nIndex1].ColorBorder;
236
237 PartSelEnd.ColorFont:= ColorFontRight;
238 PartSelEnd.ColorBG:= APart.ColorBG;
239 PartSelEnd.Offset:= AParts[nIndex2].Offset;
240 PartSelEnd.Len:= nOffset2;
241 PartSelEnd.FontStyles:= AParts[nIndex2].FontStyles;
242 PartSelEnd.BorderDown:= AParts[nIndex2].BorderDown;
243 PartSelEnd.BorderLeft:= AParts[nIndex2].BorderLeft;
244 PartSelEnd.BorderRight:= AParts[nIndex2].BorderRight;
245 PartSelEnd.BorderUp:= AParts[nIndex2].BorderUp;
246 PartSelEnd.ColorBorder:= AParts[nIndex2].ColorBorder;
247
248 with AParts[nIndex2] do
249 begin
250 newLen2:= Len-nOffset2;
251 newOffset2:= Offset+nOffset2;
252 end;
253
254 FillChar(ResultParts, SizeOf(ResultParts), 0);
255 ResultPartIndex:= 0;
256
257 //add parts before selection
258 for i:= 0 to nIndex1-1 do
259 AddPart(AParts[i]);
260 if nOffset1>0 then
261 begin
262 FixPartLen(AParts[nIndex1], APart.Offset);
263 AddPart(AParts[nIndex1]);
264 end;
265
266 //add middle (one APart of many parts)
267 if not AKeepFontStyles then
268 begin
269 if APart.ColorFont=clNone then //fix CudaText issue #3571, #3574
270 APart.ColorFont:= ColorFontLeft;
271 AddPart(APart);
272 end
273 else
274 begin
275 nOffsetLimit:= APart.Offset+APart.Len;
276 FixPartLen(PartSelBegin, nOffsetLimit);
277 AddPart(PartSelBegin);
278
279 for i:= nIndex1+1 to nIndex2-1 do
280 begin
281 AParts[i].ColorFont:= ColorFontLeft;
282 AParts[i].ColorBG:= APart.ColorBG;
283 FixPartLen(AParts[i], nOffsetLimit);
284 AddPart(AParts[i]);
285 end;
286
287 if nIndex1<nIndex2 then
288 begin
289 FixPartLen(PartSelEnd, nOffsetLimit);
290 AddPart(PartSelEnd);
291 end;
292 end;
293
294 //add parts after selection
295 if nOffset2>0 then
296 begin
297 AParts[nIndex2].Len:= newLen2;
298 AParts[nIndex2].Offset:= newOffset2;
299 end;
300
301 for i:= nIndex2 to High(AParts) do
302 begin
303 if AParts[i].Len=0 then Break;
304 AddPart(AParts[i]);
305 end;
306
307 Move(ResultParts, AParts, SizeOf(AParts));
308 Result:= true;
309 end;
310
311
312 procedure DoPartSetColorBG(var AParts: TATLineParts; AColor: TColor;
313 AForceColor: boolean);
314 var
315 PartPtr: PATLinePart;
316 i: integer;
317 begin
318 for i:= Low(AParts) to High(AParts) do
319 begin
320 PartPtr:= @AParts[i];
321 if PartPtr^.Len=0 then Break; //comment to colorize all parts to hide possible bugs
322 if AForceColor or (PartPtr^.ColorBG=clNone) then
323 PartPtr^.ColorBG:= AColor;
324 end;
325 end;
326
DoPartsShownull327 function DoPartsShow(var P: TATLineParts): string;
328 var
329 i: integer;
330 begin
331 Result:= '';
332 for i:= Low(P) to High(P) do
333 begin
334 if P[i].Len=0 then break;
335 Result+= Format('[%d %d]', [P[i].Offset, P[i].Len]);
336 end;
337 end;
338
339
340 procedure DoPartsDim(var P: TATLineParts; ADimLevel255: integer; AColorBG: TColor);
341 var
342 i: integer;
343 begin
344 for i:= Low(P) to High(P) do
345 begin
346 if P[i].Len=0 then break;
347 with P[i] do
348 begin
349 ColorFont:= ColorBlend(ColorBG, ColorFont, ADimLevel255);
350 if ColorBG<>clNone then
351 ColorBG:= ColorBlend(AColorBG, ColorBG, ADimLevel255);
352 if ColorBorder<>clNone then
353 ColorBorder:= ColorBlend(ColorBG, ColorBorder, ADimLevel255);
354 end;
355 end;
356 end;
357
358 procedure DoPartsCutFromOffset(var P: TATLineParts; AOffset: integer);
359 var
360 NCount, N, i: integer;
361 PartPtr: PATLinePart;
362 begin
363 NCount:= DoPartsGetCount(P);
364
365 //how many parts to delete from start
366 N:= 0;
367 repeat
368 PartPtr:= @P[N];
369 if PartPtr^.Len<=0 then Break;
370 if PartPtr^.Offset+PartPtr^.Len>AOffset then Break;
371 Inc(N);
372 until false;
373
374 //shift all parts by N items
375 for i:= 0 to NCount-N-1 do
376 P[i]:= P[i+N];
377
378 //fill tail with zeros
379 for i:= NCount-N to NCount-1 do
380 FillChar(P[i], SizeOf(TATLinePart), 0);
381
382 for i:= 0 to NCount-1-N do
383 with P[i] do
384 if Len>0 then
385 begin
386 Dec(Offset, AOffset);
387 if Offset<0 then
388 begin
389 Inc(Len, Offset);
390 Offset:= 0;
391 end;
392 end;
393 end;
394
395
ConvertFontStylesToIntegernull396 function ConvertFontStylesToInteger(Styles: TFontStyles): integer;
397 begin
398 Result:= 0;
399 if fsBold in Styles then
400 Result:= Result or afsFontBold;
401 if fsItalic in Styles then
402 Result:= Result or afsFontItalic;
403 if fsStrikeOut in Styles then
404 Result:= Result or afsFontCrossed;
405 end;
406
ConvertIntegerToFontStylesnull407 function ConvertIntegerToFontStyles(Value: integer): TFontStyles;
408 begin
409 Result:= [];
410 if (Value and afsFontBold)<>0 then
411 Include(Result, fsBold);
412 if (Value and afsFontItalic)<>0 then
413 Include(Result, fsItalic);
414 if (Value and afsFontCrossed)<>0 then
415 Include(Result, fsStrikeOut);
416 end;
417
418
419 end.
420