1 {***********************************}
2 { }
3 { ATBinHex Component }
4 { Copyright (C) Alexey Torgashin }
5 { http://uvviewsoft.com }
6 { }
7 {***********************************}
8 unit ATBinHex_StringProc;
9
10 {$mode delphi}
11
12 interface
13
14 uses
15 Classes, SysUtils;
16
17 type
18 atString = UnicodeString;
19 atChar = WideChar;
20
21 const
22 cMaxTabPositionToExpand = 1024;
23 cCharScaleFullwidth = 180; //width of CJK chars
24
IsWordCharnull25 function IsWordChar(ch: atChar): boolean;
IsEolCodenull26 function IsEolCode(N: Word): boolean;
IsAccentCharnull27 function IsAccentChar(ch: WideChar): boolean;
BoolToPlusMinusOnenull28 function BoolToPlusMinusOne(b: boolean): integer;
29
SSwapEndiannull30 function SSwapEndian(const S: UnicodeString): UnicodeString;
SGetIndentSizenull31 function SGetIndentSize(const S: atString; ATabSize: integer): integer;
32
33 procedure SCalcCharOffsets(const AStr: atString; var AList: array of integer; ATabSize: integer);
SExpandTabulationsnull34 function SExpandTabulations(const S: atString; ATabSize: integer): atString;
SFindWordWrapPositionnull35 function SFindWordWrapPosition(const S: atString; AColumns, ATabSize: integer): integer;
SFindClickedPositionnull36 function SFindClickedPosition(const Str: atString;
37 APixelsFromLeft, ACharSize, ATabSize: integer;
38 AAllowVirtualPos: boolean): integer;
39
40
41 implementation
42
43 uses
44 Dialogs, Math;
45
IsEolCodenull46 function IsEolCode(N: Word): boolean;
47 begin
48 Result:= (N=10) or (N=13);
49 end;
50
IsWordCharnull51 function IsWordChar(ch: atChar): boolean;
52 begin
53 Result:=
54 ((ch>='0') and (ch<='9')) or
55 ((ch>='a') and (ch<='z')) or
56 ((ch>='A') and (ch<='Z')) or
57 (ch='_');
58 end;
59
IsSpaceCharnull60 function IsSpaceChar(ch: atChar): boolean;
61 begin
62 Result:= (ch=' ') or (ch=#9);
63 end;
64
65 procedure DoDebugOffsets(const List: array of integer);
66 var
67 i: integer;
68 s: string;
69 begin
70 s:= '';
71 for i:= Low(List) to High(List) do
72 s:= s+IntToStr(List[i])+' ';
73 showmessage('Offsets'#13+s);
74 end;
75
SFindWordWrapPositionnull76 function SFindWordWrapPosition(const S: atString; AColumns, ATabSize: integer): integer;
77 var
78 N, NAvg: integer;
79 List: array of integer;
80 begin
81 if S='' then
82 begin Result:= 0; Exit end;
83
84 AColumns*= 100;
85
86 SetLength(List, Length(S));
87 SCalcCharOffsets(S, List, ATabSize);
88
89 if List[High(List)]<=AColumns then
90 begin
91 Result:= Length(S);
92 Exit
93 end;
94
95 N:= Length(S)-1;
96 while (N>1) and (List[N]>AColumns+100) do Dec(N);
97 NAvg:= N;
98 while (N>1) and IsWordChar(S[N]) and IsWordChar(S[N+1]) do Dec(N);
99
100 if N>1 then
101 Result:= N
102 else
103 if NAvg>1 then
104 Result:= NAvg
105 else
106 Result:= Length(S);
107 end;
108
SGetIndentSizenull109 function SGetIndentSize(const S: atString; ATabSize: integer): integer;
110 var
111 SIndent: atString;
112 begin
113 Result:= 0;
114 while (Result<Length(S)) and IsSpaceChar(S[Result+1]) do
115 Inc(Result);
116 SIndent:= Copy(S, 1, Result);
117 Result:= Length(SExpandTabulations(SIndent, ATabSize));
118 end;
119
SSwapEndiannull120 function SSwapEndian(const S: UnicodeString): UnicodeString;
121 var
122 i: integer;
123 begin
124 Result:= S;
125 for i:= 1 to Length(Result) do
126 Result[i]:= WideChar(SwapEndian(Ord(Result[i])));
127 end;
128
SCalcTabulationSizenull129 function SCalcTabulationSize(const ATabSize, APos: integer): integer;
130 begin
131 if APos>cMaxTabPositionToExpand then
132 Result:= 1
133 else
134 begin
135 Result:= 0;
136 repeat Inc(Result) until ((APos+Result-1) mod ATabSize)=0;
137 end;
138 end;
139
SExpandTabulationsnull140 function SExpandTabulations(const S: atString; ATabSize: integer): atString;
141 var
142 N, NSize: integer;
143 begin
144 Result:= S;
145 repeat
146 N:= Pos(#9, Result);
147 if N=0 then Break;
148 NSize:= SCalcTabulationSize(ATabSize, N);
149 if NSize<=1 then
150 Result[N]:= ' '
151 else
152 begin
153 Delete(Result, N, 1);
154 Insert(StringOfChar(' ', NSize), Result, N);
155 end;
156 until false;
157 end;
158
159 {
160 http://en.wikipedia.org/wiki/Combining_character
161 Combining Diacritical Marks (0300–036F), since version 1.0, with modifications in subsequent versions down to 4.1
162 Combining Diacritical Marks Extended (1AB0–1AFF), version 7.0
163 Combining Diacritical Marks Supplement (1DC0–1DFF), versions 4.1 to 5.2
164 Combining Diacritical Marks for Symbols (20D0–20FF), since version 1.0, with modifications in subsequent versions down to 5.1
165 Combining Half Marks (FE20–FE2F), versions 1.0, updates in 5.2
166 }
IsAccentCharnull167 function IsAccentChar(ch: WideChar): boolean;
168 begin
169 case Ord(ch) of
170 $0300..$036F,
171 $1AB0..$1AFF,
172 $1DC0..$1DFF,
173 $20D0..$20FF,
174 $FE20..$FE2F:
175 Result:= true;
176 else
177 Result:= false;
178 end;
179 end;
180
181 {
182 Ranges that are FullWidth char
183 1100 e1 84 80 .. 115F e1 85 9f
184 2329 e2 8c a9 .. 232A e2 8c aa
185 2E80 e2 ba 80 .. 303E e3 80 be
186 3041 e3 81 81 .. 33FF e3 8f bf
187 3400 e3 90 80 .. 4DB5 e4 b6 b5
188 4E00 e4 b8 80 .. 9FC3 e9 bf 83
189 A000 ea 80 80 .. A4C6 ea 93 86
190 AC00 ea b0 80 .. D7A3 ed 9e a3
191 F900 ef a4 80 .. FAD9 ef ab 99
192 FE10 ef b8 90 .. FE19 ef b8 99
193 FE30 ef b8 b0 .. FE6B ef b9 ab
194 FF01 ef bc 81 .. FF60 ef bd a0
195 FFE0 ef bf a0 .. FFE6 ef bf a6
196 20000 f0 a0 80 80 .. 2FFFD f0 af bf bd
197 30000 f0 b0 80 80 .. 3FFFD f0 bf bf bd
198 }
IsCharFullWidthnull199 function IsCharFullWidth(ch: WideChar): boolean;
200 begin
201 case Ord(ch) of
202 $1100..$115F,
203 $2329..$232A,
204 $2E80..$303E,
205 $3041..$33FF,
206 $3400..$4DB5,
207 $4E00..$9FC3,
208 $A000..$A4C6,
209 $AC00..$D7A3,
210 $F900..$FAD9,
211 $FE10..$FE19,
212 $FE30..$FE6B,
213 $FF01..$FF60,
214 $FFE0..$FFE6:
215 Result:= true;
216 else
217 Result:= false;
218 end;
219 end;
220
221
222 procedure SCalcCharOffsets(const AStr: atString; var AList: array of integer;
223 ATabSize: integer);
224 const
225 cScaleTest = 190; //debug, for test code, commented
226 var
227 S: atString;
228 NOffset, NTabSize, NListIndex, i: integer;
229 Scale: integer;
230 begin
231 if Length(AList)<>Length(AStr) then
232 raise Exception.Create('bad list parameter in CalcCharOffsets');
233 if AStr='' then Exit;
234
235 S:= AStr;
236 i:= 0;
237 NListIndex:= 0;
238
239 repeat
240 Inc(i);
241 if i>Length(S) then Break;
242
243 if IsCharFullWidth(S[i]) then
244 Scale:= cCharScaleFullwidth
245 else
246 Scale:= 100;
247
248 ////debug
249 {
250 if IsSpaceChar(S[i]) then
251 Scale:= 100
252 else
253 Scale:= cTestScale;
254 }
255
256 if S[i]<>#9 then
257 NOffset:= 1
258 else
259 begin
260 NTabSize:= SCalcTabulationSize(ATabSize, i);
261 NOffset:= NTabSize;
262 S[i]:= ' ';
263 if NTabSize>1 then
264 Insert(StringOfChar(' ', NTabSize-1), S, i);
265 Inc(i, NTabSize-1);
266 end;
267
268 if (i<Length(S)) and IsAccentChar(S[i+1]) then
269 begin
270 NOffset:= 0;
271 end;
272
273 if NListIndex=0 then
274 AList[NListIndex]:= NOffset*Scale
275 else
276 AList[NListIndex]:= AList[NListIndex-1]+NOffset*Scale;
277
278 Inc(NListIndex);
279 until false;
280 end;
281
282
SFindClickedPositionnull283 function SFindClickedPosition(const Str: atString;
284 APixelsFromLeft, ACharSize, ATabSize: integer;
285 AAllowVirtualPos: boolean): integer;
286 var
287 ListReal: array of integer;
288 ListEnds, ListMid: array of integer;
289 i: integer;
290 begin
291 if Str='' then
292 begin
293 if AAllowVirtualPos then
294 Result:= 1+APixelsFromLeft div ACharSize
295 else
296 Result:= 1;
297 Exit;
298 end;
299
300 SetLength(ListReal, Length(Str));
301 SetLength(ListEnds, Length(Str));
302 SetLength(ListMid, Length(Str));
303 SCalcCharOffsets(Str, ListReal, ATabSize);
304
305 //positions of each char end
306 for i:= 0 to High(ListEnds) do
307 ListEnds[i]:= ListReal[i]*ACharSize div 100;
308
309 //positions of each char middle
310 for i:= 0 to High(ListEnds) do
311 if i=0 then
312 ListMid[i]:= ListEnds[i] div 2
313 else
314 ListMid[i]:= (ListEnds[i-1]+ListEnds[i]) div 2;
315
316 for i:= 0 to High(ListEnds) do
317 if APixelsFromLeft<ListMid[i] then
318 begin
319 Result:= i+1;
320 Exit
321 end;
322
323 if AAllowVirtualPos then
324 Result:= Length(Str)+1 + (APixelsFromLeft - ListEnds[High(ListEnds)]) div ACharSize
325 else
326 Result:= Length(Str)+1;
327 end;
328
329
BoolToPlusMinusOnenull330 function BoolToPlusMinusOne(b: boolean): integer;
331 begin
332 if b then Result:= 1 else Result:= -1;
333 end;
334
335 end.
336
337