← Back to branch summary

~ubuntu-branches/ubuntu/saucy/lazarus/saucy

« back to all changes in this revision

Viewing changes to lcl/lclproc.pas

  • Committer: Package Import Robot
  • Author(s): Paul Gevers, Abou Al Montacir, Bart Martens, Paul Gevers
  • Date: 2013-06-08 14:12:17 UTC
  • mfrom: (1.1.9)
  • Revision ID: package-import@ubuntu.com-20130608141217-7k0cy9id8ifcnutc
Tags: 1.0.8+dfsg-1
http://bugs.debian.org/708695
[ Abou Al Montacir ]
* New upstream major release and multiple maintenace release offering many
  fixes and new features marking a new milestone for the Lazarus development
  and its stability level.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_fixes_branch
* LCL changes:
  - LCL is now a normal package.
      + Platform independent parts of the LCL are now in the package LCLBase
      + LCL is automatically recompiled when switching the target platform,
        unless pre-compiled binaries for this target are already installed.
      + No impact on existing projects.
      + Linker options needed by LCL are no more added to projects that do
        not use the LCL package.
  - Minor changes in LCL basic classes behaviour
      + TCustomForm.Create raises an exception if a form resource is not
        found.
      + TNotebook and TPage: a new implementation of these classes was added.
      + TDBNavigator: It is now possible to have focusable buttons by setting
        Options = [navFocusableButtons] and TabStop = True, useful for
        accessibility and for devices with neither mouse nor touch screen.
      + Names of TControlBorderSpacing.GetSideSpace and GetSpace were swapped
        and are now consistent. GetSideSpace = Around + GetSpace.
      + TForm.WindowState=wsFullscreen was added
      + TCanvas.TextFitInfo was added to calculate how many characters will
        fit into a specified Width. Useful for word-wrapping calculations.
      + TControl.GetColorResolvingParent and
        TControl.GetRGBColorResolvingParent were added, simplifying the work
        to obtain the final color of the control while resolving clDefault
        and the ParentColor.
      + LCLIntf.GetTextExtentExPoint now has a good default implementation
        which works in any platform not providing a specific implementation.
        However, Widgetset specific implementation is better, when available.
      + TTabControl was reorganized. Now it has the correct class hierarchy
        and inherits from TCustomTabControl as it should.
  - New unit in the LCL:
      + lazdialogs.pas: adds non-native versions of various native dialogs,
        for example TLazOpenDialog, TLazSaveDialog, TLazSelectDirectoryDialog.
        It is used by widgetsets which either do not have a native dialog, or
        do not wish to use it because it is limited. These dialogs can also be
        used by user applications directly.
      + lazdeviceapis.pas: offers an interface to more hardware devices such
        as the accelerometer, GPS, etc. See LazDeviceAPIs
      + lazcanvas.pas: provides a TFPImageCanvas descendent implementing
        drawing in a LCL-compatible way, but 100% in Pascal.
      + lazregions.pas. LazRegions is a wholly Pascal implementation of
        regions for canvas clipping, event clipping, finding in which control
        of a region tree one an event should reach, for drawing polygons, etc.
      + customdrawncontrols.pas, customdrawndrawers.pas,
        customdrawn_common.pas, customdrawn_android.pas and
        customdrawn_winxp.pas: are the Lazarus Custom Drawn Controls -controls
        which imitate the standard LCL ones, but with the difference that they
        are non-native and support skinning.
  - New APIs added to the LCL to improve support of accessibility software
    such as screen readers.
* IDE changes:
  - Many improvments.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/New_IDE_features_since#v1.0_.282012-08-29.29
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes#IDE_Changes
* Debugger / Editor changes:
  - Added pascal sources and breakpoints to the disassembler
  - Added threads dialog.
* Components changes:
  - TAChart: many fixes and new features
  - CodeTool: support Delphi style generics and new syntax extensions.
  - AggPas: removed to honor free licencing. (Closes: Bug#708695)
[Bart Martens]
* New debian/watch file fixing issues with upstream RC release.
[Abou Al Montacir]
* Avoid changing files in .pc hidden directory, these are used by quilt for
  internal purpose and could lead to surprises during build.
[Paul Gevers]
* Updated get-orig-source target and it compinion script orig-tar.sh so that they
  repack the source file, allowing bug 708695 to be fixed.

Show diffs side-by-side

added added

removed removed

Lines of Context:
lcl/lclproc.pas
26
26
 
27
27
{$mode objfpc}{$H+}
28
28
{$inline on}
 
29
{$include include/lcl_defines.inc}
29
30
 
30
31
interface
31
32
 
32
33
uses
33
34
  {$IFDEF Darwin}MacOSAll, {$ENDIF}
 
35
  {$IFDEF win32}
 
36
  {$IFnDEF VER2_4}
 
37
  Win9xWsManager, // Support for Lower/UpperWideStringProc on Win9x, also used by some Utf8 string handling functions
 
38
  {$ENDIF}
 
39
  {$ENDIF}
 
40
  {$IFnDEF WithOldDebugln} LazLogger, {$ENDIF}
34
41
  Classes, SysUtils, Math, TypInfo, Types, FPCAdds, AvgLvlTree, FileUtil,
35
 
  LCLStrConsts, LCLType, WSReferences
36
 
  {$IFNDEF DisableCWString}{$ifdef unix}{$ifndef DisableIconv}, cwstring{$endif}{$endif}{$ENDIF}
37
 
  ;
38
 
 
39
 
type
40
 
  { TMethodList - array of TMethod }
41
 
 
42
 
  TMethodList = class
43
 
  private
44
 
    FItems: ^TMethod;
45
 
    FCount: integer;
46
 
    function GetItems(Index: integer): TMethod;
47
 
    procedure SetItems(Index: integer; const AValue: TMethod);
48
 
  public
49
 
    destructor Destroy; override;
50
 
    function Count: integer;
51
 
    function NextDownIndex(var Index: integer): boolean;
52
 
    function IndexOf(const AMethod: TMethod): integer;
53
 
    procedure Delete(Index: integer);
54
 
    procedure Remove(const AMethod: TMethod);
55
 
    procedure Add(const AMethod: TMethod);
56
 
    procedure Add(const AMethod: TMethod; AsLast: boolean);
57
 
    procedure Insert(Index: integer; const AMethod: TMethod);
58
 
    procedure Move(OldIndex, NewIndex: integer);
59
 
    procedure RemoveAllMethodsOfObject(const AnObject: TObject);
60
 
    procedure CallNotifyEvents(Sender: TObject);
61
 
  public
62
 
    property Items[Index: integer]: TMethod read GetItems write SetItems; default;
63
 
  end;
64
 
 
65
 
type
 
42
  LCLStrConsts, LCLType, WSReferences, LazMethodList, LazUTF8;
 
43
 
 
44
type
 
45
  TMethodList = LazMethodList.TMethodList;
 
46
 
66
47
  TStackTracePointers = array of Pointer;
67
48
 
68
49
  { TDebugLCLItemInfo }
118
99
type
119
100
  TStringsSortCompare = function(const Item1, Item2: string): Integer;
120
101
 
121
 
 
122
 
procedure MergeSort(List: TFPList; const OnCompare: TListSortCompare);
123
 
procedure MergeSort(List: TStrings; const OnCompare: TStringsSortCompare);
 
102
procedure MergeSort(List: TFPList; const OnCompare: TListSortCompare); // sort so that for each i is OnCompare(List[i],List[i+1])<=0
 
103
procedure MergeSort(List: TStrings; const OnCompare: TStringsSortCompare); // sort so that for each i is OnCompare(List[i],List[i+1])<=0
124
104
 
125
105
function GetEnumValueDef(TypeInfo: PTypeInfo; const Name: string;
126
106
                         const DefaultValue: Integer): Integer;
127
107
 
 
108
function KeyAndShiftStateToKeyString(Key: word; ShiftState: TShiftState): String;
 
109
function KeyStringIsIrregular(const s: string): boolean;
128
110
function ShortCutToText(ShortCut: TShortCut): string;// untranslated
129
111
function TextToShortCut(const ShortCutText: string): TShortCut;// untranslated
130
112
 
131
 
function GetCompleteText(sText: string; iSelStart: Integer;
 
113
function GetCompleteText(const sText: string; iSelStart: Integer;
132
114
  bCaseSensitive, bSearchAscending: Boolean; slTextList: TStrings): string;
133
115
function IsEditableTextKey(Key: Word): Boolean;
134
116
 
161
143
procedure MoveRectToFit(var ARect: TRect; const MaxRect: TRect);
162
144
procedure MakeMinMax(var i1, i2: integer);
163
145
procedure CalculateLeftTopWidthHeight(X1,Y1,X2,Y2: integer;
164
 
  var Left,Top,Width,Height: integer);
 
146
  out Left,Top,Width,Height: integer);
165
147
 
166
148
function DeleteAmpersands(var Str : String) : Longint;
167
149
function BreakString(const s: string; MaxLineLength, Indent: integer): string;
180
162
function StrToDouble(const s: string): double;
181
163
 
182
164
 
183
 
 
184
165
// debugging
185
166
procedure RaiseGDBException(const Msg: string);
186
167
procedure RaiseAndCatchException;
192
173
                            UseCache: boolean): string;
193
174
function GetLineInfo(Addr: Pointer; UseCache: boolean): string;
194
175
 
195
 
procedure DebugLn(Args: array of const);
196
 
procedure DebugLn(const S: String; Args: array of const);// similar to Format(s,Args)
197
 
procedure DebugLn;
198
 
procedure DebugLn(const s: string);
199
 
procedure DebugLn(const s1,s2: string);
200
 
procedure DebugLn(const s1,s2,s3: string);
201
 
procedure DebugLn(const s1,s2,s3,s4: string);
202
 
procedure DebugLn(const s1,s2,s3,s4,s5: string);
203
 
procedure DebugLn(const s1,s2,s3,s4,s5,s6: string);
204
 
procedure DebugLn(const s1,s2,s3,s4,s5,s6,s7: string);
205
 
procedure DebugLn(const s1,s2,s3,s4,s5,s6,s7,s8: string);
206
 
procedure DebugLn(const s1,s2,s3,s4,s5,s6,s7,s8,s9: string);
207
 
procedure DebugLn(const s1,s2,s3,s4,s5,s6,s7,s8,s9,s10: string);
208
 
procedure DebugLn(const s1,s2,s3,s4,s5,s6,s7,s8,s9,s10,s11: string);
209
 
procedure DebugLn(const s1,s2,s3,s4,s5,s6,s7,s8,s9,s10,s11,s12: string);
210
 
procedure DebugLn(const s1,s2,s3,s4,s5,s6,s7,s8,s9,s10,s11,s12,s13: string);
211
 
procedure DebugLn(const s1,s2,s3,s4,s5,s6,s7,s8,s9,s10,s11,s12,s13,s14: string);
212
 
procedure DebugLn(const s1,s2,s3,s4,s5,s6,s7,s8,s9,s10,s11,s12,s13,s14,s15: string);
213
 
procedure DebugLn(const s1,s2,s3,s4,s5,s6,s7,s8,s9,s10,s11,s12,s13,s14,s15,s16: string);
214
 
 
215
 
procedure DebugLnEnter(const s: string = nil);
216
 
procedure DebugLnEnter(Args: array of const);
217
 
procedure DebugLnEnter(s: string; Args: array of const);
218
 
procedure DebugLnEnter(const s1, s2: string; const s3: string = nil;
219
 
                     const s4: string = nil; const s5: string = nil; const s6: string = nil;
220
 
                     const s7: string = nil; const s8: string = nil; const s9: string = nil;
221
 
                     const s10: string = nil; const s11: string = nil; const s12: string = nil;
222
 
                     const s13: string = nil; const s14: string = nil; const s15: string = nil;
223
 
                     const s16: string = nil; const s17: string = nil; const s18: string = nil);
224
 
procedure DebugLnExit(const s: string = nil);
225
 
procedure DebugLnExit(Args: array of const);
226
 
procedure DebugLnExit(s: string; Args: array of const);
227
 
procedure DebugLnExit (const s1, s2: string; const s3: string = nil;
228
 
                     const s4: string = nil; const s5: string = nil; const s6: string = nil;
229
 
                     const s7: string = nil; const s8: string = nil; const s9: string = nil;
230
 
                     const s10: string = nil; const s11: string = nil; const s12: string = nil;
231
 
                     const s13: string = nil; const s14: string = nil; const s15: string = nil;
232
 
                     const s16: string = nil; const s17: string = nil; const s18: string = nil);
233
 
 
234
 
function ConvertLineEndings(const s: string): string;
235
 
 
236
 
procedure DbgOut(const S: String; Args: array of const);
237
 
procedure DbgOut(const s: string);
238
 
procedure DbgOut(const s1,s2: string);
239
 
procedure DbgOut(const s1,s2,s3: string);
240
 
procedure DbgOut(const s1,s2,s3,s4: string);
241
 
procedure DbgOut(const s1,s2,s3,s4,s5: string);
242
 
procedure DbgOut(const s1,s2,s3,s4,s5,s6: string);
243
 
procedure DbgOut(const s1,s2,s3,s4,s5,s6,s7: string);
244
 
procedure DbgOut(const s1,s2,s3,s4,s5,s6,s7,s8: string);
245
 
procedure DbgOut(const s1,s2,s3,s4,s5,s6,s7,s8,s9: string);
246
 
procedure DbgOut(const s1,s2,s3,s4,s5,s6,s7,s8,s9,s10: string);
247
 
procedure DbgOut(const s1,s2,s3,s4,s5,s6,s7,s8,s9,s10,s11: string);
248
 
procedure DbgOut(const s1,s2,s3,s4,s5,s6,s7,s8,s9,s10,s11,s12: string);
249
 
 
250
 
function DbgS(const c: cardinal): string; overload;
251
 
function DbgS(const i: longint): string; overload;
252
 
function DbgS(const i: int64): string; overload;
253
 
function DbgS(const q: qword): string; overload;
254
 
function DbgS(const r: TRect): string; overload;
255
 
function DbgS(const p: TPoint): string; overload;
256
 
function DbgS(const p: pointer): string; overload;
257
 
function DbgS(const e: extended; MaxDecimals: integer = 999): string; overload;
258
 
function DbgS(const b: boolean): string; overload;
259
 
function DbgS(const s: TComponentState): string; overload;
260
 
function DbgS(const m: TMethod): string; overload;
261
 
function DbgSName(const p: TObject): string; overload;
262
 
function DbgSName(const p: TClass): string; overload;
263
 
function DbgStr(const StringWithSpecialChars: string): string; overload;
264
 
function DbgWideStr(const StringWithSpecialChars: widestring): string; overload;
265
 
function dbgMemRange(P: PByte; Count: integer; Width: integer = 0): string; overload;
266
 
function dbgMemStream(MemStream: TCustomMemoryStream; Count: integer): string; overload;
267
 
function dbgObjMem(AnObject: TObject): string; overload;
268
 
function dbghex(i: Int64): string; overload;
 
176
{$IFnDEF WithOldDebugln}
 
177
procedure DbgOut(const s: string = ''); inline; overload;
 
178
procedure DbgOut(Args: array of const); {inline;} overload;
 
179
procedure DbgOut(const S: String; Args: array of const); {inline;} overload;// similar to Format(s,Args)
 
180
procedure DbgOut(const s1, s2: string; const s3: string = '';
 
181
                 const s4: string = ''; const s5: string = ''; const s6: string = '';
 
182
                 const s7: string = ''; const s8: string = ''; const s9: string = '';
 
183
                 const s10: string = ''; const s11: string = ''; const s12: string = '';
 
184
                 const s13: string = ''; const s14: string = ''; const s15: string = '';
 
185
                 const s16: string = ''; const s17: string = ''; const s18: string = ''); inline; overload;
 
186
 
 
187
procedure DebugLn(const s: string = ''); inline; overload;
 
188
procedure DebugLn(Args: array of const); {inline;} overload;
 
189
procedure DebugLn(const S: String; Args: array of const); {inline;} overload;// similar to Format(s,Args)
 
190
procedure DebugLn(const s1, s2: string; const s3: string = '';
 
191
                  const s4: string = ''; const s5: string = ''; const s6: string = '';
 
192
                  const s7: string = ''; const s8: string = ''; const s9: string = '';
 
193
                  const s10: string = ''; const s11: string = ''; const s12: string = '';
 
194
                  const s13: string = ''; const s14: string = ''; const s15: string = '';
 
195
                  const s16: string = ''; const s17: string = ''; const s18: string = ''); inline; overload;
 
196
 
 
197
procedure DebugLnEnter(const s: string = ''); inline; overload;
 
198
procedure DebugLnEnter(Args: array of const); {inline;} overload;
 
199
procedure DebugLnEnter(s: string; Args: array of const); {inline;} overload;
 
200
procedure DebugLnEnter(const s1, s2: string; const s3: string = '';
 
201
                       const s4: string = ''; const s5: string = ''; const s6: string = '';
 
202
                       const s7: string = ''; const s8: string = ''; const s9: string = '';
 
203
                       const s10: string = ''; const s11: string = ''; const s12: string = '';
 
204
                       const s13: string = ''; const s14: string = ''; const s15: string = '';
 
205
                       const s16: string = ''; const s17: string = ''; const s18: string = ''); inline; overload;
 
206
 
 
207
procedure DebugLnExit(const s: string = ''); inline; overload;
 
208
procedure DebugLnExit(Args: array of const); {inline;} overload;
 
209
procedure DebugLnExit(s: string; Args: array of const); {inline;} overload;
 
210
procedure DebugLnExit (const s1, s2: string; const s3: string = '';
 
211
                       const s4: string = ''; const s5: string = ''; const s6: string = '';
 
212
                       const s7: string = ''; const s8: string = ''; const s9: string = '';
 
213
                       const s10: string = ''; const s11: string = ''; const s12: string = '';
 
214
                       const s13: string = ''; const s14: string = ''; const s15: string = '';
 
215
                       const s16: string = ''; const s17: string = ''; const s18: string = ''); inline; overload;
 
216
 
 
217
procedure CloseDebugOutput;
 
218
{$ELSE}
 
219
procedure DebugLn(Args: array of const); overload;
 
220
procedure DebugLn(const S: String; Args: array of const); overload;// similar to Format(s,Args)
 
221
procedure DebugLn; overload;
 
222
procedure DebugLn(const s: string); overload;
 
223
procedure DebugLn(const s1,s2: string); overload;
 
224
procedure DebugLn(const s1,s2,s3: string); overload;
 
225
procedure DebugLn(const s1,s2,s3,s4: string); overload;
 
226
procedure DebugLn(const s1,s2,s3,s4,s5: string); overload;
 
227
procedure DebugLn(const s1,s2,s3,s4,s5,s6: string); overload;
 
228
procedure DebugLn(const s1,s2,s3,s4,s5,s6,s7: string); overload;
 
229
procedure DebugLn(const s1,s2,s3,s4,s5,s6,s7,s8: string); overload;
 
230
procedure DebugLn(const s1,s2,s3,s4,s5,s6,s7,s8,s9: string); overload;
 
231
procedure DebugLn(const s1,s2,s3,s4,s5,s6,s7,s8,s9,s10: string); overload;
 
232
procedure DebugLn(const s1,s2,s3,s4,s5,s6,s7,s8,s9,s10,s11: string); overload;
 
233
procedure DebugLn(const s1,s2,s3,s4,s5,s6,s7,s8,s9,s10,s11,s12: string); overload;
 
234
procedure DebugLn(const s1,s2,s3,s4,s5,s6,s7,s8,s9,s10,s11,s12,s13: string); overload;
 
235
procedure DebugLn(const s1,s2,s3,s4,s5,s6,s7,s8,s9,s10,s11,s12,s13,s14: string); overload;
 
236
procedure DebugLn(const s1,s2,s3,s4,s5,s6,s7,s8,s9,s10,s11,s12,s13,s14,s15: string); overload;
 
237
procedure DebugLn(const s1,s2,s3,s4,s5,s6,s7,s8,s9,s10,s11,s12,s13,s14,s15,s16: string); overload;
 
238
 
 
239
procedure DebugLnEnter(const s: string = ''); overload;
 
240
procedure DebugLnEnter(Args: array of const); overload;
 
241
procedure DebugLnEnter(s: string; Args: array of const); overload;
 
242
procedure DebugLnEnter(const s1, s2: string; const s3: string = '';
 
243
                     const s4: string = ''; const s5: string = ''; const s6: string = '';
 
244
                     const s7: string = ''; const s8: string = ''; const s9: string = '';
 
245
                     const s10: string = ''; const s11: string = ''; const s12: string = '';
 
246
                     const s13: string = ''; const s14: string = ''; const s15: string = '';
 
247
                     const s16: string = ''; const s17: string = ''; const s18: string = ''); overload;
 
248
procedure DebugLnExit(const s: string = ''); overload;
 
249
procedure DebugLnExit(Args: array of const); overload;
 
250
procedure DebugLnExit(s: string; Args: array of const); overload;
 
251
procedure DebugLnExit (const s1, s2: string; const s3: string = '';
 
252
                     const s4: string = ''; const s5: string = ''; const s6: string = '';
 
253
                     const s7: string = ''; const s8: string = ''; const s9: string = '';
 
254
                     const s10: string = ''; const s11: string = ''; const s12: string = '';
 
255
                     const s13: string = ''; const s14: string = ''; const s15: string = '';
 
256
                     const s16: string = ''; const s17: string = ''; const s18: string = ''); overload;
 
257
 
 
258
procedure DbgOut(const S: String; Args: array of const); overload;
 
259
procedure DbgOut(const s: string); overload;
 
260
procedure DbgOut(const s1,s2: string); overload;
 
261
procedure DbgOut(const s1,s2,s3: string); overload;
 
262
procedure DbgOut(const s1,s2,s3,s4: string); overload;
 
263
procedure DbgOut(const s1,s2,s3,s4,s5: string); overload;
 
264
procedure DbgOut(const s1,s2,s3,s4,s5,s6: string); overload;
 
265
procedure DbgOut(const s1,s2,s3,s4,s5,s6,s7: string); overload;
 
266
procedure DbgOut(const s1,s2,s3,s4,s5,s6,s7,s8: string); overload;
 
267
procedure DbgOut(const s1,s2,s3,s4,s5,s6,s7,s8,s9: string); overload;
 
268
procedure DbgOut(const s1,s2,s3,s4,s5,s6,s7,s8,s9,s10: string); overload;
 
269
procedure DbgOut(const s1,s2,s3,s4,s5,s6,s7,s8,s9,s10,s11: string); overload;
 
270
procedure DbgOut(const s1,s2,s3,s4,s5,s6,s7,s8,s9,s10,s11,s12: string); overload;
 
271
 
 
272
procedure CloseDebugOutput;
 
273
{$ENDIF}
 
274
 
 
275
function ConvertLineEndings(const s: string): string; inline;
 
276
function DbgS(const c: cardinal): string; overload; inline;
 
277
function DbgS(const i: longint): string; overload; inline;
 
278
function DbgS(const i: int64): string; overload; inline;
 
279
function DbgS(const q: qword): string; overload; inline;
 
280
function DbgS(const r: TRect): string; overload; inline;
 
281
function DbgS(const p: TPoint): string; overload; inline;
 
282
function DbgS(const p: pointer): string; overload; inline;
 
283
function DbgS(const e: extended; MaxDecimals: integer = 999): string; overload; inline;
 
284
function DbgS(const b: boolean): string; overload; inline;
 
285
function DbgS(const s: TComponentState): string; overload; inline;
 
286
function DbgS(const m: TMethod): string; overload; inline;
 
287
function DbgSName(const p: TObject): string; overload; inline;
 
288
function DbgSName(const p: TClass): string; overload; inline;
 
289
function DbgStr(const StringWithSpecialChars: string): string; overload; inline;
 
290
function DbgWideStr(const StringWithSpecialChars: widestring): string; overload; inline;
 
291
function dbgMemRange(P: PByte; Count: integer; Width: integer = 0): string; overload; inline;
 
292
function dbgMemStream(MemStream: TCustomMemoryStream; Count: integer): string; overload; inline;
 
293
function dbgObjMem(AnObject: TObject): string; overload; inline;
 
294
function dbgHex(i: Int64): string; overload; inline;
269
295
function DbgSWindowPosFlags(Flags: UInt): String;
270
296
 
271
 
function DbgS(const i1,i2,i3,i4: integer): string; overload;
272
 
function DbgS(const Shift: TShiftState): string; overload;
 
297
function DbgS(const i1,i2,i3,i4: integer): string; overload; inline;
 
298
function DbgS(const Shift: TShiftState): string; overload; inline;
273
299
function DbgsVKCode(c: word): string;
274
300
 
275
 
function DbgS(const ASize: TSize): string; overload;
 
301
function DbgS(const ASize: TSize): string; overload; inline;
276
302
function DbgS(const ATM: TTextMetric): string; overload;
277
303
function DbgS(const AScrollInfo: TScrollInfo): string; overload;
278
304
 
284
310
procedure DbgAppendToFile(FileName, S: String);
285
311
procedure DbgAppendToFileWithoutLn(FileName, S: String);
286
312
 
287
 
procedure CloseDebugOutput;
288
 
 
289
313
// some string manipulation functions
290
314
function StripLN(const ALine: String): String;
291
315
function GetPart(const ASkipTo, AnEnd: String; var ASource: String;
292
 
  const AnIgnoreCase: Boolean = False; const AnUpdateSource: Boolean = True): String;
 
316
  const AnIgnoreCase: Boolean = False; const AnUpdateSource: Boolean = True): String; overload;
293
317
function GetPart(const ASkipTo, AnEnd: array of String; var ASource: String;
294
 
  const AnIgnoreCase: Boolean = False; const AnUpdateSource: Boolean = True): String;
 
318
  const AnIgnoreCase: Boolean = False; const AnUpdateSource: Boolean = True): String; overload;
295
319
function TextToSingleLine(const AText: string): string;
 
320
function SwapCase(Const S: String): String;
296
321
 
297
322
// case..of utility functions
298
323
function StringCase(const AString: String; const ACase: array of String {; const AIgnoreCase = False, APartial = false: Boolean}): Integer; overload;
301
326
function ClassCase(const AClass: TClass; const ACase: array of TClass; const ADecendant: Boolean): Integer; overload;
302
327
 
303
328
 
304
 
// UTF utility functions
305
 
// MG: Should be moved to the RTL  
 
329
// UTF-8 Routines in LCLProc are provided only for backwards compatibility,
 
330
// use the routines from LazUTF8 instead
306
331
 
307
 
// MWE: define (missing) UTF16string similar to UTF8 
 
332
// MWE: define (missing) UTF16string similar to UTF8
308
333
//      strictly spoken, a widestring <> utf16string
309
334
// todo: use it in existing functions
310
335
type
311
 
  UTF16String = type WideString;
 
336
  UTF16String = type UnicodeString;
312
337
  PUTF16String = ^UTF16String;
313
338
 
314
 
function UTF8CharacterLength(p: PChar): integer;
 
339
function UTF8CharacterLength(p: PChar): integer; inline;
315
340
function UTF8Length(const s: string): PtrInt;
316
 
function UTF8Length(p: PChar; ByteCount: PtrInt): PtrInt;
317
 
function UTF8CharacterToUnicode(p: PChar; out CharLen: integer): Cardinal;
 
341
function UTF8Length(p: PChar; ByteCount: PtrInt): PtrInt; inline;
 
342
function UTF8CharacterToUnicode(p: PChar; out CharLen: integer): Cardinal; inline;
318
343
function UnicodeToUTF8(u: cardinal; Buf: PChar): integer; inline;
319
 
function UnicodeToUTF8SkipErrors(u: cardinal; Buf: PChar): integer;
 
344
function UnicodeToUTF8SkipErrors(u: cardinal; Buf: PChar): integer; inline;
320
345
function UnicodeToUTF8(u: cardinal): shortstring; inline;
321
 
function UTF8ToDoubleByteString(const s: string): string;
322
 
function UTF8ToDoubleByte(UTF8Str: PChar; Len: PtrInt; DBStr: PByte): PtrInt;
 
346
function UTF8ToDoubleByteString(const s: string): string; inline;
 
347
function UTF8ToDoubleByte(UTF8Str: PChar; Len: PtrInt; DBStr: PByte): PtrInt; inline;
323
348
function UTF8FindNearestCharStart(UTF8Str: PChar; Len: integer;
324
 
                                  BytePos: integer): integer;
 
349
                                  BytePos: integer): integer; inline;
325
350
// find the n-th UTF8 character, ignoring BIDI
326
 
function UTF8CharStart(UTF8Str: PChar; Len, CharIndex: PtrInt): PChar;
 
351
function UTF8CharStart(UTF8Str: PChar; Len, CharIndex: PtrInt): PChar; inline;
327
352
// find the byte index of the n-th UTF8 character, ignoring BIDI (byte len of substr)
328
 
function UTF8CharToByteIndex(UTF8Str: PChar; Len, CharIndex: PtrInt): PtrInt;
329
 
procedure UTF8FixBroken(P: PChar);
330
 
function UTF8CharacterStrictLength(P: PChar): integer;
331
 
function UTF8CStringToUTF8String(SourceStart: PChar; SourceLen: PtrInt) : string;
332
 
function UTF8Pos(const SearchForText, SearchInText: string): PtrInt;
333
 
function UTF8Copy(const s: string; StartCharIndex, CharCount: PtrInt): string;
334
 
procedure UTF8Delete(var s: String; StartCharIndex, CharCount: PtrInt);
335
 
procedure UTF8Insert(const source: String; var s: string; StartCharIndex: PtrInt);
 
353
function UTF8CharToByteIndex(UTF8Str: PChar; Len, CharIndex: PtrInt): PtrInt; inline;
 
354
procedure UTF8FixBroken(P: PChar); inline;
 
355
function UTF8CharacterStrictLength(P: PChar): integer; inline;
 
356
function UTF8CStringToUTF8String(SourceStart: PChar; SourceLen: PtrInt) : string; inline;
 
357
function UTF8Pos(const SearchForText, SearchInText: string): PtrInt; inline;
 
358
function UTF8Copy(const s: string; StartCharIndex, CharCount: PtrInt): string; inline;
 
359
procedure UTF8Delete(var s: String; StartCharIndex, CharCount: PtrInt); inline;
 
360
procedure UTF8Insert(const source: String; var s: string; StartCharIndex: PtrInt); inline;
336
361
function UTF8LowerCase(const s: String): String;
337
362
function UTF8UpperCase(const s: String): String;
338
 
{$ifdef NewLowerCase}
339
 
function UTF8LowerCaseNew(const s: String): String;
340
 
{$endif}
341
363
function FindInvalidUTF8Character(p: PChar; Count: PtrInt;
342
 
                                  StopOnNonASCII: Boolean = false): PtrInt;
343
 
function ValidUTF8String(const s: String): String;
 
364
                                  StopOnNonASCII: Boolean = false): PtrInt; inline;
 
365
function ValidUTF8String(const s: String): String; inline;
344
366
 
345
367
procedure AssignUTF8ListToAnsi(UTF8List, AnsiList: TStrings);
346
368
 
 
369
// Felipe: Don't substitute with calls to lazutf16 because lazutf16 includes
 
370
// some initialization code and tables, which are not necessary for the LCL
347
371
function UTF16CharacterLength(p: PWideChar): integer;
348
 
function UTF16Length(const s: widestring): PtrInt;
 
372
function UTF16Length(const s: UTF16String): PtrInt;
349
373
function UTF16Length(p: PWideChar; WordCount: PtrInt): PtrInt;
350
374
function UTF16CharacterToUnicode(p: PWideChar; out CharLen: integer): Cardinal;
351
 
function UnicodeToUTF16(u: cardinal): widestring;
 
375
function UnicodeToUTF16(u: cardinal): UTF16String;
 
376
 
 
377
//compare functions
 
378
 
 
379
function UTF8CompareStr(const S1, S2: String): Integer;
 
380
function UTF8CompareText(const S1, S2: String): Integer;
352
381
 
353
382
type
354
 
  TConvertResult = (trNoError, trNullSrc, trNullDest, trDestExhausted,
355
 
    trInvalidChar, trUnfinishedChar);
 
383
  TConvertResult = LazUTF8.TConvertResult;
356
384
 
357
 
  TConvertOption = (toInvalidCharError, toInvalidCharToSymbol,
358
 
    toUnfinishedCharError, toUnfinishedCharToSymbol);
359
 
  TConvertOptions = set of TConvertOption;
 
385
  TConvertOption = LazUTF8.TConvertOption;
 
386
  TConvertOptions = LazUTF8.TConvertOptions;
360
387
 
361
388
function ConvertUTF8ToUTF16(Dest: PWideChar; DestWideCharCount: SizeUInt;
362
389
  Src: PChar; SrcCharCount: SizeUInt; Options: TConvertOptions;
376
403
function CreateFirstIdentifier(const Identifier: string): string;
377
404
function CreateNextIdentifier(const Identifier: string): string;
378
405
 
 
406
{$IFDEF WithOldDebugln}
 
407
type
 
408
  TDebugLnProc = procedure (s: string) of object;
 
409
 
379
410
var
380
411
  DebugLnMaxNestPrefixLen: Integer = 15;
381
412
  DebugLnNestLvlIndent: Integer = 2;
 
413
  DebugText: ^Text;
 
414
 
 
415
  DebugLnProc: TDebugLnProc = nil;
 
416
  DebugOutProc: TDebugLnProc = nil;
 
417
{$ENDIF}
382
418
 
383
419
implementation
384
420
 
385
421
uses gettext;
386
422
 
387
423
const
 
424
  {$IFDEF WithOldDebugln}
388
425
  Str_LCL_Debug_File = 'lcldebug.log';
 
426
  {$ENDIF}
 
427
  UNKNOWN_VK_PREFIX = 'Word(''';
 
428
  UNKNOWN_VK_POSTFIX = ''')';
389
429
 
390
430
var
391
431
  InterfaceInitializationHandlers: TFPList = nil;
392
432
  InterfaceFinalizationHandlers: TFPList = nil;
 
433
  {$IFDEF WithOldDebugln}
393
434
  DebugTextAllocated: boolean;
394
 
  DebugText: ^Text;
395
435
  DebugNestLvl: Integer = 0;
396
436
  DebugNestPrefix: PChar = nil;
397
437
  DebugNestAtBOL: Boolean;
 
438
  {$ENDIF}
398
439
  LineInfoCache: TAvgLvlTree = nil;
399
440
 
400
 
{$ifdef NewLowerCase}
401
 
var
402
 
  UnicodeLower00C0_00DE: array[$00C0..$00DE] of word;
403
 
  UnicodeLower0100_024E: array[$0100..$024E] of word;
404
 
  UnicodeLower0386_03AB: array[$0386..$03AB] of word;
405
 
  UnicodeLower03D8_042F: array[$03D8..$042F] of word;
406
 
  UnicodeLower0460_0512: array[$0460..$0512] of word;
407
 
  UnicodeLower1E00_1FFC: array[$1E00..$1FFC] of word;
408
 
  UnicodeLower2126_2183: array[$2126..$2183] of word;
409
 
  UnicodeLower2C60_2CE2: array[$2C60..$2CE2] of word;
410
 
 
411
 
procedure InitUnicodeTables;
412
 
var
413
 
  i: Integer;
414
 
begin
415
 
  for i:=Low(UnicodeLower00C0_00DE) to High(UnicodeLower00C0_00DE) do
416
 
    UnicodeLower00C0_00DE[i]:=i+32;
417
 
  UnicodeLower00C0_00DE[$00D7]:=$00D7;
418
 
 
419
 
  for i:=Low(UnicodeLower0100_024E) to High(UnicodeLower0100_024E) do
420
 
    UnicodeLower0100_024E[i]:=i;
421
 
  UnicodeLower0100_024E[$0100]:=$0101;
422
 
  UnicodeLower0100_024E[$0102]:=$0103;
423
 
  UnicodeLower0100_024E[$0104]:=$0105;
424
 
  UnicodeLower0100_024E[$0106]:=$0107;
425
 
  UnicodeLower0100_024E[$0108]:=$0109;
426
 
  UnicodeLower0100_024E[$010A]:=$010B;
427
 
  UnicodeLower0100_024E[$010C]:=$010D;
428
 
  UnicodeLower0100_024E[$010E]:=$010F;
429
 
  UnicodeLower0100_024E[$0110]:=$0111;
430
 
  UnicodeLower0100_024E[$0112]:=$0113;
431
 
  UnicodeLower0100_024E[$0114]:=$0115;
432
 
  UnicodeLower0100_024E[$0116]:=$0117;
433
 
  UnicodeLower0100_024E[$0118]:=$0119;
434
 
  UnicodeLower0100_024E[$011A]:=$011B;
435
 
  UnicodeLower0100_024E[$011C]:=$011D;
436
 
  UnicodeLower0100_024E[$011E]:=$011F;
437
 
  UnicodeLower0100_024E[$0120]:=$0121;
438
 
  UnicodeLower0100_024E[$0122]:=$0123;
439
 
  UnicodeLower0100_024E[$0124]:=$0125;
440
 
  UnicodeLower0100_024E[$0126]:=$0127;
441
 
  UnicodeLower0100_024E[$0128]:=$0129;
442
 
  UnicodeLower0100_024E[$012A]:=$012B;
443
 
  UnicodeLower0100_024E[$012C]:=$012D;
444
 
  UnicodeLower0100_024E[$012E]:=$012F;
445
 
  UnicodeLower0100_024E[$0130]:=$0069;
446
 
  UnicodeLower0100_024E[$0132]:=$0133;
447
 
  UnicodeLower0100_024E[$0134]:=$0135;
448
 
  UnicodeLower0100_024E[$0136]:=$0137;
449
 
  UnicodeLower0100_024E[$0139]:=$013A;
450
 
  UnicodeLower0100_024E[$013B]:=$013C;
451
 
  UnicodeLower0100_024E[$013D]:=$013E;
452
 
  UnicodeLower0100_024E[$013F]:=$0140;
453
 
  UnicodeLower0100_024E[$0141]:=$0142;
454
 
  UnicodeLower0100_024E[$0143]:=$0144;
455
 
  UnicodeLower0100_024E[$0145]:=$0146;
456
 
  UnicodeLower0100_024E[$0147]:=$0148;
457
 
  UnicodeLower0100_024E[$014A]:=$014B;
458
 
  UnicodeLower0100_024E[$014C]:=$014D;
459
 
  UnicodeLower0100_024E[$014E]:=$014F;
460
 
  UnicodeLower0100_024E[$0150]:=$0151;
461
 
  UnicodeLower0100_024E[$0152]:=$0153;
462
 
  UnicodeLower0100_024E[$0154]:=$0155;
463
 
  UnicodeLower0100_024E[$0156]:=$0157;
464
 
  UnicodeLower0100_024E[$0158]:=$0159;
465
 
  UnicodeLower0100_024E[$015A]:=$015B;
466
 
  UnicodeLower0100_024E[$015C]:=$015D;
467
 
  UnicodeLower0100_024E[$015E]:=$015F;
468
 
  UnicodeLower0100_024E[$0160]:=$0161;
469
 
  UnicodeLower0100_024E[$0162]:=$0163;
470
 
  UnicodeLower0100_024E[$0164]:=$0165;
471
 
  UnicodeLower0100_024E[$0166]:=$0167;
472
 
  UnicodeLower0100_024E[$0168]:=$0169;
473
 
  UnicodeLower0100_024E[$016A]:=$016B;
474
 
  UnicodeLower0100_024E[$016C]:=$016D;
475
 
  UnicodeLower0100_024E[$016E]:=$016F;
476
 
  UnicodeLower0100_024E[$0170]:=$0171;
477
 
  UnicodeLower0100_024E[$0172]:=$0173;
478
 
  UnicodeLower0100_024E[$0174]:=$0175;
479
 
  UnicodeLower0100_024E[$0176]:=$0177;
480
 
  UnicodeLower0100_024E[$0178]:=$00FF;
481
 
  UnicodeLower0100_024E[$0179]:=$017A;
482
 
  UnicodeLower0100_024E[$017B]:=$017C;
483
 
  UnicodeLower0100_024E[$017D]:=$017E;
484
 
  UnicodeLower0100_024E[$0181]:=$0253;
485
 
  UnicodeLower0100_024E[$0182]:=$0183;
486
 
  UnicodeLower0100_024E[$0184]:=$0185;
487
 
  UnicodeLower0100_024E[$0186]:=$0254;
488
 
  UnicodeLower0100_024E[$0187]:=$0188;
489
 
  UnicodeLower0100_024E[$0189]:=$0256;
490
 
  UnicodeLower0100_024E[$018A]:=$0257;
491
 
  UnicodeLower0100_024E[$018B]:=$018C;
492
 
  UnicodeLower0100_024E[$018E]:=$01DD;
493
 
  UnicodeLower0100_024E[$018F]:=$0259;
494
 
  UnicodeLower0100_024E[$0190]:=$025B;
495
 
  UnicodeLower0100_024E[$0191]:=$0192;
496
 
  UnicodeLower0100_024E[$0193]:=$0260;
497
 
  UnicodeLower0100_024E[$0194]:=$0263;
498
 
  UnicodeLower0100_024E[$0196]:=$0269;
499
 
  UnicodeLower0100_024E[$0197]:=$0268;
500
 
  UnicodeLower0100_024E[$0198]:=$0199;
501
 
  UnicodeLower0100_024E[$019C]:=$026F;
502
 
  UnicodeLower0100_024E[$019D]:=$0272;
503
 
  UnicodeLower0100_024E[$019F]:=$0275;
504
 
  UnicodeLower0100_024E[$01A0]:=$01A1;
505
 
  UnicodeLower0100_024E[$01A2]:=$01A3;
506
 
  UnicodeLower0100_024E[$01A4]:=$01A5;
507
 
  UnicodeLower0100_024E[$01A6]:=$0280;
508
 
  UnicodeLower0100_024E[$01A7]:=$01A8;
509
 
  UnicodeLower0100_024E[$01A9]:=$0283;
510
 
  UnicodeLower0100_024E[$01AC]:=$01AD;
511
 
  UnicodeLower0100_024E[$01AE]:=$0288;
512
 
  UnicodeLower0100_024E[$01AF]:=$01B0;
513
 
  UnicodeLower0100_024E[$01B1]:=$028A;
514
 
  UnicodeLower0100_024E[$01B2]:=$028B;
515
 
  UnicodeLower0100_024E[$01B3]:=$01B4;
516
 
  UnicodeLower0100_024E[$01B5]:=$01B6;
517
 
  UnicodeLower0100_024E[$01B7]:=$0292;
518
 
  UnicodeLower0100_024E[$01B8]:=$01B9;
519
 
  UnicodeLower0100_024E[$01BC]:=$01BD;
520
 
  UnicodeLower0100_024E[$01C4]:=$01C6;
521
 
  UnicodeLower0100_024E[$01C5]:=$01C6;
522
 
  UnicodeLower0100_024E[$01C7]:=$01C9;
523
 
  UnicodeLower0100_024E[$01C8]:=$01C9;
524
 
  UnicodeLower0100_024E[$01CA]:=$01CC;
525
 
  UnicodeLower0100_024E[$01CB]:=$01CC;
526
 
  UnicodeLower0100_024E[$01CD]:=$01CE;
527
 
  UnicodeLower0100_024E[$01CF]:=$01D0;
528
 
  UnicodeLower0100_024E[$01D1]:=$01D2;
529
 
  UnicodeLower0100_024E[$01D3]:=$01D4;
530
 
  UnicodeLower0100_024E[$01D5]:=$01D6;
531
 
  UnicodeLower0100_024E[$01D7]:=$01D8;
532
 
  UnicodeLower0100_024E[$01D9]:=$01DA;
533
 
  UnicodeLower0100_024E[$01DB]:=$01DC;
534
 
  UnicodeLower0100_024E[$01DE]:=$01DF;
535
 
  UnicodeLower0100_024E[$01E0]:=$01E1;
536
 
  UnicodeLower0100_024E[$01E2]:=$01E3;
537
 
  UnicodeLower0100_024E[$01E4]:=$01E5;
538
 
  UnicodeLower0100_024E[$01E6]:=$01E7;
539
 
  UnicodeLower0100_024E[$01E8]:=$01E9;
540
 
  UnicodeLower0100_024E[$01EA]:=$01EB;
541
 
  UnicodeLower0100_024E[$01EC]:=$01ED;
542
 
  UnicodeLower0100_024E[$01EE]:=$01EF;
543
 
  UnicodeLower0100_024E[$01F1]:=$01F3;
544
 
  UnicodeLower0100_024E[$01F2]:=$01F3;
545
 
  UnicodeLower0100_024E[$01F4]:=$01F5;
546
 
  UnicodeLower0100_024E[$01F6]:=$0195;
547
 
  UnicodeLower0100_024E[$01F7]:=$01BF;
548
 
  UnicodeLower0100_024E[$01F8]:=$01F9;
549
 
  UnicodeLower0100_024E[$01FA]:=$01FB;
550
 
  UnicodeLower0100_024E[$01FC]:=$01FD;
551
 
  UnicodeLower0100_024E[$01FE]:=$01FF;
552
 
  UnicodeLower0100_024E[$0200]:=$0201;
553
 
  UnicodeLower0100_024E[$0202]:=$0203;
554
 
  UnicodeLower0100_024E[$0204]:=$0205;
555
 
  UnicodeLower0100_024E[$0206]:=$0207;
556
 
  UnicodeLower0100_024E[$0208]:=$0209;
557
 
  UnicodeLower0100_024E[$020A]:=$020B;
558
 
  UnicodeLower0100_024E[$020C]:=$020D;
559
 
  UnicodeLower0100_024E[$020E]:=$020F;
560
 
  UnicodeLower0100_024E[$0210]:=$0211;
561
 
  UnicodeLower0100_024E[$0212]:=$0213;
562
 
  UnicodeLower0100_024E[$0214]:=$0215;
563
 
  UnicodeLower0100_024E[$0216]:=$0217;
564
 
  UnicodeLower0100_024E[$0218]:=$0219;
565
 
  UnicodeLower0100_024E[$021A]:=$021B;
566
 
  UnicodeLower0100_024E[$021C]:=$021D;
567
 
  UnicodeLower0100_024E[$021E]:=$021F;
568
 
  UnicodeLower0100_024E[$0220]:=$019E;
569
 
  UnicodeLower0100_024E[$0222]:=$0223;
570
 
  UnicodeLower0100_024E[$0224]:=$0225;
571
 
  UnicodeLower0100_024E[$0226]:=$0227;
572
 
  UnicodeLower0100_024E[$0228]:=$0229;
573
 
  UnicodeLower0100_024E[$022A]:=$022B;
574
 
  UnicodeLower0100_024E[$022C]:=$022D;
575
 
  UnicodeLower0100_024E[$022E]:=$022F;
576
 
  UnicodeLower0100_024E[$0230]:=$0231;
577
 
  UnicodeLower0100_024E[$0232]:=$0233;
578
 
  UnicodeLower0100_024E[$023A]:=$2C65;
579
 
  UnicodeLower0100_024E[$023B]:=$023C;
580
 
  UnicodeLower0100_024E[$023D]:=$019A;
581
 
  UnicodeLower0100_024E[$023E]:=$2C66;
582
 
  UnicodeLower0100_024E[$0241]:=$0242;
583
 
  UnicodeLower0100_024E[$0243]:=$0180;
584
 
  UnicodeLower0100_024E[$0244]:=$0289;
585
 
  UnicodeLower0100_024E[$0245]:=$028C;
586
 
  UnicodeLower0100_024E[$0246]:=$0247;
587
 
  UnicodeLower0100_024E[$0248]:=$0249;
588
 
  UnicodeLower0100_024E[$024A]:=$024B;
589
 
  UnicodeLower0100_024E[$024C]:=$024D;
590
 
  UnicodeLower0100_024E[$024E]:=$024F;
591
 
 
592
 
  for i:=Low(UnicodeLower0386_03AB) to High(UnicodeLower0386_03AB) do
593
 
    UnicodeLower0386_03AB[i]:=i;
594
 
  UnicodeLower0386_03AB[$0386]:=$03AC;
595
 
  UnicodeLower0386_03AB[$0388]:=$03AD;
596
 
  UnicodeLower0386_03AB[$0389]:=$03AE;
597
 
  UnicodeLower0386_03AB[$038A]:=$03AF;
598
 
  UnicodeLower0386_03AB[$038C]:=$03CC;
599
 
  UnicodeLower0386_03AB[$038E]:=$03CD;
600
 
  UnicodeLower0386_03AB[$038F]:=$03CE;
601
 
  UnicodeLower0386_03AB[$0391]:=$03B1;
602
 
  UnicodeLower0386_03AB[$0392]:=$03B2;
603
 
  UnicodeLower0386_03AB[$0393]:=$03B3;
604
 
  UnicodeLower0386_03AB[$0394]:=$03B4;
605
 
  UnicodeLower0386_03AB[$0395]:=$03B5;
606
 
  UnicodeLower0386_03AB[$0396]:=$03B6;
607
 
  UnicodeLower0386_03AB[$0397]:=$03B7;
608
 
  UnicodeLower0386_03AB[$0398]:=$03B8;
609
 
  UnicodeLower0386_03AB[$0399]:=$03B9;
610
 
  UnicodeLower0386_03AB[$039A]:=$03BA;
611
 
  UnicodeLower0386_03AB[$039B]:=$03BB;
612
 
  UnicodeLower0386_03AB[$039C]:=$03BC;
613
 
  UnicodeLower0386_03AB[$039D]:=$03BD;
614
 
  UnicodeLower0386_03AB[$039E]:=$03BE;
615
 
  UnicodeLower0386_03AB[$039F]:=$03BF;
616
 
  UnicodeLower0386_03AB[$03A0]:=$03C0;
617
 
  UnicodeLower0386_03AB[$03A1]:=$03C1;
618
 
  UnicodeLower0386_03AB[$03A3]:=$03C3;
619
 
  UnicodeLower0386_03AB[$03A4]:=$03C4;
620
 
  UnicodeLower0386_03AB[$03A5]:=$03C5;
621
 
  UnicodeLower0386_03AB[$03A6]:=$03C6;
622
 
  UnicodeLower0386_03AB[$03A7]:=$03C7;
623
 
  UnicodeLower0386_03AB[$03A8]:=$03C8;
624
 
  UnicodeLower0386_03AB[$03A9]:=$03C9;
625
 
  UnicodeLower0386_03AB[$03AA]:=$03CA;
626
 
  UnicodeLower0386_03AB[$03AB]:=$03CB;
627
 
 
628
 
  for i:=Low(UnicodeLower03D8_042F) to High(UnicodeLower03D8_042F) do
629
 
    UnicodeLower03D8_042F[i]:=i;
630
 
  UnicodeLower03D8_042F[$03D8]:=$03D9;
631
 
  UnicodeLower03D8_042F[$03DA]:=$03DB;
632
 
  UnicodeLower03D8_042F[$03DC]:=$03DD;
633
 
  UnicodeLower03D8_042F[$03DE]:=$03DF;
634
 
  UnicodeLower03D8_042F[$03E0]:=$03E1;
635
 
  UnicodeLower03D8_042F[$03E2]:=$03E3;
636
 
  UnicodeLower03D8_042F[$03E4]:=$03E5;
637
 
  UnicodeLower03D8_042F[$03E6]:=$03E7;
638
 
  UnicodeLower03D8_042F[$03E8]:=$03E9;
639
 
  UnicodeLower03D8_042F[$03EA]:=$03EB;
640
 
  UnicodeLower03D8_042F[$03EC]:=$03ED;
641
 
  UnicodeLower03D8_042F[$03EE]:=$03EF;
642
 
  UnicodeLower03D8_042F[$03F4]:=$03B8;
643
 
  UnicodeLower03D8_042F[$03F7]:=$03F8;
644
 
  UnicodeLower03D8_042F[$03F9]:=$03F2;
645
 
  UnicodeLower03D8_042F[$03FA]:=$03FB;
646
 
  UnicodeLower03D8_042F[$03FD]:=$037B;
647
 
  UnicodeLower03D8_042F[$03FE]:=$037C;
648
 
  UnicodeLower03D8_042F[$03FF]:=$037D;
649
 
  UnicodeLower03D8_042F[$0400]:=$0450;
650
 
  UnicodeLower03D8_042F[$0401]:=$0451;
651
 
  UnicodeLower03D8_042F[$0402]:=$0452;
652
 
  UnicodeLower03D8_042F[$0403]:=$0453;
653
 
  UnicodeLower03D8_042F[$0404]:=$0454;
654
 
  UnicodeLower03D8_042F[$0405]:=$0455;
655
 
  UnicodeLower03D8_042F[$0406]:=$0456;
656
 
  UnicodeLower03D8_042F[$0407]:=$0457;
657
 
  UnicodeLower03D8_042F[$0408]:=$0458;
658
 
  UnicodeLower03D8_042F[$0409]:=$0459;
659
 
  UnicodeLower03D8_042F[$040A]:=$045A;
660
 
  UnicodeLower03D8_042F[$040B]:=$045B;
661
 
  UnicodeLower03D8_042F[$040C]:=$045C;
662
 
  UnicodeLower03D8_042F[$040D]:=$045D;
663
 
  UnicodeLower03D8_042F[$040E]:=$045E;
664
 
  UnicodeLower03D8_042F[$040F]:=$045F;
665
 
  UnicodeLower03D8_042F[$0410]:=$0430;
666
 
  UnicodeLower03D8_042F[$0411]:=$0431;
667
 
  UnicodeLower03D8_042F[$0412]:=$0432;
668
 
  UnicodeLower03D8_042F[$0413]:=$0433;
669
 
  UnicodeLower03D8_042F[$0414]:=$0434;
670
 
  UnicodeLower03D8_042F[$0415]:=$0435;
671
 
  UnicodeLower03D8_042F[$0416]:=$0436;
672
 
  UnicodeLower03D8_042F[$0417]:=$0437;
673
 
  UnicodeLower03D8_042F[$0418]:=$0438;
674
 
  UnicodeLower03D8_042F[$0419]:=$0439;
675
 
  UnicodeLower03D8_042F[$041A]:=$043A;
676
 
  UnicodeLower03D8_042F[$041B]:=$043B;
677
 
  UnicodeLower03D8_042F[$041C]:=$043C;
678
 
  UnicodeLower03D8_042F[$041D]:=$043D;
679
 
  UnicodeLower03D8_042F[$041E]:=$043E;
680
 
  UnicodeLower03D8_042F[$041F]:=$043F;
681
 
  UnicodeLower03D8_042F[$0420]:=$0440;
682
 
  UnicodeLower03D8_042F[$0421]:=$0441;
683
 
  UnicodeLower03D8_042F[$0422]:=$0442;
684
 
  UnicodeLower03D8_042F[$0423]:=$0443;
685
 
  UnicodeLower03D8_042F[$0424]:=$0444;
686
 
  UnicodeLower03D8_042F[$0425]:=$0445;
687
 
  UnicodeLower03D8_042F[$0426]:=$0446;
688
 
  UnicodeLower03D8_042F[$0427]:=$0447;
689
 
  UnicodeLower03D8_042F[$0428]:=$0448;
690
 
  UnicodeLower03D8_042F[$0429]:=$0449;
691
 
  UnicodeLower03D8_042F[$042A]:=$044A;
692
 
  UnicodeLower03D8_042F[$042B]:=$044B;
693
 
  UnicodeLower03D8_042F[$042C]:=$044C;
694
 
  UnicodeLower03D8_042F[$042D]:=$044D;
695
 
  UnicodeLower03D8_042F[$042E]:=$044E;
696
 
  UnicodeLower03D8_042F[$042F]:=$044F;
697
 
 
698
 
  for i:=Low(UnicodeLower0460_0512) to High(UnicodeLower0460_0512) do
699
 
    UnicodeLower0460_0512[i]:=i;
700
 
  UnicodeLower0460_0512[$0460]:=$0461;
701
 
  UnicodeLower0460_0512[$0462]:=$0463;
702
 
  UnicodeLower0460_0512[$0464]:=$0465;
703
 
  UnicodeLower0460_0512[$0466]:=$0467;
704
 
  UnicodeLower0460_0512[$0468]:=$0469;
705
 
  UnicodeLower0460_0512[$046A]:=$046B;
706
 
  UnicodeLower0460_0512[$046C]:=$046D;
707
 
  UnicodeLower0460_0512[$046E]:=$046F;
708
 
  UnicodeLower0460_0512[$0470]:=$0471;
709
 
  UnicodeLower0460_0512[$0472]:=$0473;
710
 
  UnicodeLower0460_0512[$0474]:=$0475;
711
 
  UnicodeLower0460_0512[$0476]:=$0477;
712
 
  UnicodeLower0460_0512[$0478]:=$0479;
713
 
  UnicodeLower0460_0512[$047A]:=$047B;
714
 
  UnicodeLower0460_0512[$047C]:=$047D;
715
 
  UnicodeLower0460_0512[$047E]:=$047F;
716
 
  UnicodeLower0460_0512[$0480]:=$0481;
717
 
  UnicodeLower0460_0512[$048A]:=$048B;
718
 
  UnicodeLower0460_0512[$048C]:=$048D;
719
 
  UnicodeLower0460_0512[$048E]:=$048F;
720
 
  UnicodeLower0460_0512[$0490]:=$0491;
721
 
  UnicodeLower0460_0512[$0492]:=$0493;
722
 
  UnicodeLower0460_0512[$0494]:=$0495;
723
 
  UnicodeLower0460_0512[$0496]:=$0497;
724
 
  UnicodeLower0460_0512[$0498]:=$0499;
725
 
  UnicodeLower0460_0512[$049A]:=$049B;
726
 
  UnicodeLower0460_0512[$049C]:=$049D;
727
 
  UnicodeLower0460_0512[$049E]:=$049F;
728
 
  UnicodeLower0460_0512[$04A0]:=$04A1;
729
 
  UnicodeLower0460_0512[$04A2]:=$04A3;
730
 
  UnicodeLower0460_0512[$04A4]:=$04A5;
731
 
  UnicodeLower0460_0512[$04A6]:=$04A7;
732
 
  UnicodeLower0460_0512[$04A8]:=$04A9;
733
 
  UnicodeLower0460_0512[$04AA]:=$04AB;
734
 
  UnicodeLower0460_0512[$04AC]:=$04AD;
735
 
  UnicodeLower0460_0512[$04AE]:=$04AF;
736
 
  UnicodeLower0460_0512[$04B0]:=$04B1;
737
 
  UnicodeLower0460_0512[$04B2]:=$04B3;
738
 
  UnicodeLower0460_0512[$04B4]:=$04B5;
739
 
  UnicodeLower0460_0512[$04B6]:=$04B7;
740
 
  UnicodeLower0460_0512[$04B8]:=$04B9;
741
 
  UnicodeLower0460_0512[$04BA]:=$04BB;
742
 
  UnicodeLower0460_0512[$04BC]:=$04BD;
743
 
  UnicodeLower0460_0512[$04BE]:=$04BF;
744
 
  UnicodeLower0460_0512[$04C0]:=$04CF;
745
 
  UnicodeLower0460_0512[$04C1]:=$04C2;
746
 
  UnicodeLower0460_0512[$04C3]:=$04C4;
747
 
  UnicodeLower0460_0512[$04C5]:=$04C6;
748
 
  UnicodeLower0460_0512[$04C7]:=$04C8;
749
 
  UnicodeLower0460_0512[$04C9]:=$04CA;
750
 
  UnicodeLower0460_0512[$04CB]:=$04CC;
751
 
  UnicodeLower0460_0512[$04CD]:=$04CE;
752
 
  UnicodeLower0460_0512[$04D0]:=$04D1;
753
 
  UnicodeLower0460_0512[$04D2]:=$04D3;
754
 
  UnicodeLower0460_0512[$04D4]:=$04D5;
755
 
  UnicodeLower0460_0512[$04D6]:=$04D7;
756
 
  UnicodeLower0460_0512[$04D8]:=$04D9;
757
 
  UnicodeLower0460_0512[$04DA]:=$04DB;
758
 
  UnicodeLower0460_0512[$04DC]:=$04DD;
759
 
  UnicodeLower0460_0512[$04DE]:=$04DF;
760
 
  UnicodeLower0460_0512[$04E0]:=$04E1;
761
 
  UnicodeLower0460_0512[$04E2]:=$04E3;
762
 
  UnicodeLower0460_0512[$04E4]:=$04E5;
763
 
  UnicodeLower0460_0512[$04E6]:=$04E7;
764
 
  UnicodeLower0460_0512[$04E8]:=$04E9;
765
 
  UnicodeLower0460_0512[$04EA]:=$04EB;
766
 
  UnicodeLower0460_0512[$04EC]:=$04ED;
767
 
  UnicodeLower0460_0512[$04EE]:=$04EF;
768
 
  UnicodeLower0460_0512[$04F0]:=$04F1;
769
 
  UnicodeLower0460_0512[$04F2]:=$04F3;
770
 
  UnicodeLower0460_0512[$04F4]:=$04F5;
771
 
  UnicodeLower0460_0512[$04F6]:=$04F7;
772
 
  UnicodeLower0460_0512[$04F8]:=$04F9;
773
 
  UnicodeLower0460_0512[$04FA]:=$04FB;
774
 
  UnicodeLower0460_0512[$04FC]:=$04FD;
775
 
  UnicodeLower0460_0512[$04FE]:=$04FF;
776
 
  UnicodeLower0460_0512[$0500]:=$0501;
777
 
  UnicodeLower0460_0512[$0502]:=$0503;
778
 
  UnicodeLower0460_0512[$0504]:=$0505;
779
 
  UnicodeLower0460_0512[$0506]:=$0507;
780
 
  UnicodeLower0460_0512[$0508]:=$0509;
781
 
  UnicodeLower0460_0512[$050A]:=$050B;
782
 
  UnicodeLower0460_0512[$050C]:=$050D;
783
 
  UnicodeLower0460_0512[$050E]:=$050F;
784
 
  UnicodeLower0460_0512[$0510]:=$0511;
785
 
  UnicodeLower0460_0512[$0512]:=$0513;
786
 
 
787
 
  for i:=Low(UnicodeLower1E00_1FFC) to High(UnicodeLower1E00_1FFC) do
788
 
    UnicodeLower1E00_1FFC[i]:=i;
789
 
  UnicodeLower1E00_1FFC[$1E00]:=$1E01;
790
 
  UnicodeLower1E00_1FFC[$1E02]:=$1E03;
791
 
  UnicodeLower1E00_1FFC[$1E04]:=$1E05;
792
 
  UnicodeLower1E00_1FFC[$1E06]:=$1E07;
793
 
  UnicodeLower1E00_1FFC[$1E08]:=$1E09;
794
 
  UnicodeLower1E00_1FFC[$1E0A]:=$1E0B;
795
 
  UnicodeLower1E00_1FFC[$1E0C]:=$1E0D;
796
 
  UnicodeLower1E00_1FFC[$1E0E]:=$1E0F;
797
 
  UnicodeLower1E00_1FFC[$1E10]:=$1E11;
798
 
  UnicodeLower1E00_1FFC[$1E12]:=$1E13;
799
 
  UnicodeLower1E00_1FFC[$1E14]:=$1E15;
800
 
  UnicodeLower1E00_1FFC[$1E16]:=$1E17;
801
 
  UnicodeLower1E00_1FFC[$1E18]:=$1E19;
802
 
  UnicodeLower1E00_1FFC[$1E1A]:=$1E1B;
803
 
  UnicodeLower1E00_1FFC[$1E1C]:=$1E1D;
804
 
  UnicodeLower1E00_1FFC[$1E1E]:=$1E1F;
805
 
  UnicodeLower1E00_1FFC[$1E20]:=$1E21;
806
 
  UnicodeLower1E00_1FFC[$1E22]:=$1E23;
807
 
  UnicodeLower1E00_1FFC[$1E24]:=$1E25;
808
 
  UnicodeLower1E00_1FFC[$1E26]:=$1E27;
809
 
  UnicodeLower1E00_1FFC[$1E28]:=$1E29;
810
 
  UnicodeLower1E00_1FFC[$1E2A]:=$1E2B;
811
 
  UnicodeLower1E00_1FFC[$1E2C]:=$1E2D;
812
 
  UnicodeLower1E00_1FFC[$1E2E]:=$1E2F;
813
 
  UnicodeLower1E00_1FFC[$1E30]:=$1E31;
814
 
  UnicodeLower1E00_1FFC[$1E32]:=$1E33;
815
 
  UnicodeLower1E00_1FFC[$1E34]:=$1E35;
816
 
  UnicodeLower1E00_1FFC[$1E36]:=$1E37;
817
 
  UnicodeLower1E00_1FFC[$1E38]:=$1E39;
818
 
  UnicodeLower1E00_1FFC[$1E3A]:=$1E3B;
819
 
  UnicodeLower1E00_1FFC[$1E3C]:=$1E3D;
820
 
  UnicodeLower1E00_1FFC[$1E3E]:=$1E3F;
821
 
  UnicodeLower1E00_1FFC[$1E40]:=$1E41;
822
 
  UnicodeLower1E00_1FFC[$1E42]:=$1E43;
823
 
  UnicodeLower1E00_1FFC[$1E44]:=$1E45;
824
 
  UnicodeLower1E00_1FFC[$1E46]:=$1E47;
825
 
  UnicodeLower1E00_1FFC[$1E48]:=$1E49;
826
 
  UnicodeLower1E00_1FFC[$1E4A]:=$1E4B;
827
 
  UnicodeLower1E00_1FFC[$1E4C]:=$1E4D;
828
 
  UnicodeLower1E00_1FFC[$1E4E]:=$1E4F;
829
 
  UnicodeLower1E00_1FFC[$1E50]:=$1E51;
830
 
  UnicodeLower1E00_1FFC[$1E52]:=$1E53;
831
 
  UnicodeLower1E00_1FFC[$1E54]:=$1E55;
832
 
  UnicodeLower1E00_1FFC[$1E56]:=$1E57;
833
 
  UnicodeLower1E00_1FFC[$1E58]:=$1E59;
834
 
  UnicodeLower1E00_1FFC[$1E5A]:=$1E5B;
835
 
  UnicodeLower1E00_1FFC[$1E5C]:=$1E5D;
836
 
  UnicodeLower1E00_1FFC[$1E5E]:=$1E5F;
837
 
  UnicodeLower1E00_1FFC[$1E60]:=$1E61;
838
 
  UnicodeLower1E00_1FFC[$1E62]:=$1E63;
839
 
  UnicodeLower1E00_1FFC[$1E64]:=$1E65;
840
 
  UnicodeLower1E00_1FFC[$1E66]:=$1E67;
841
 
  UnicodeLower1E00_1FFC[$1E68]:=$1E69;
842
 
  UnicodeLower1E00_1FFC[$1E6A]:=$1E6B;
843
 
  UnicodeLower1E00_1FFC[$1E6C]:=$1E6D;
844
 
  UnicodeLower1E00_1FFC[$1E6E]:=$1E6F;
845
 
  UnicodeLower1E00_1FFC[$1E70]:=$1E71;
846
 
  UnicodeLower1E00_1FFC[$1E72]:=$1E73;
847
 
  UnicodeLower1E00_1FFC[$1E74]:=$1E75;
848
 
  UnicodeLower1E00_1FFC[$1E76]:=$1E77;
849
 
  UnicodeLower1E00_1FFC[$1E78]:=$1E79;
850
 
  UnicodeLower1E00_1FFC[$1E7A]:=$1E7B;
851
 
  UnicodeLower1E00_1FFC[$1E7C]:=$1E7D;
852
 
  UnicodeLower1E00_1FFC[$1E7E]:=$1E7F;
853
 
  UnicodeLower1E00_1FFC[$1E80]:=$1E81;
854
 
  UnicodeLower1E00_1FFC[$1E82]:=$1E83;
855
 
  UnicodeLower1E00_1FFC[$1E84]:=$1E85;
856
 
  UnicodeLower1E00_1FFC[$1E86]:=$1E87;
857
 
  UnicodeLower1E00_1FFC[$1E88]:=$1E89;
858
 
  UnicodeLower1E00_1FFC[$1E8A]:=$1E8B;
859
 
  UnicodeLower1E00_1FFC[$1E8C]:=$1E8D;
860
 
  UnicodeLower1E00_1FFC[$1E8E]:=$1E8F;
861
 
  UnicodeLower1E00_1FFC[$1E90]:=$1E91;
862
 
  UnicodeLower1E00_1FFC[$1E92]:=$1E93;
863
 
  UnicodeLower1E00_1FFC[$1E94]:=$1E95;
864
 
  UnicodeLower1E00_1FFC[$1EA0]:=$1EA1;
865
 
  UnicodeLower1E00_1FFC[$1EA2]:=$1EA3;
866
 
  UnicodeLower1E00_1FFC[$1EA4]:=$1EA5;
867
 
  UnicodeLower1E00_1FFC[$1EA6]:=$1EA7;
868
 
  UnicodeLower1E00_1FFC[$1EA8]:=$1EA9;
869
 
  UnicodeLower1E00_1FFC[$1EAA]:=$1EAB;
870
 
  UnicodeLower1E00_1FFC[$1EAC]:=$1EAD;
871
 
  UnicodeLower1E00_1FFC[$1EAE]:=$1EAF;
872
 
  UnicodeLower1E00_1FFC[$1EB0]:=$1EB1;
873
 
  UnicodeLower1E00_1FFC[$1EB2]:=$1EB3;
874
 
  UnicodeLower1E00_1FFC[$1EB4]:=$1EB5;
875
 
  UnicodeLower1E00_1FFC[$1EB6]:=$1EB7;
876
 
  UnicodeLower1E00_1FFC[$1EB8]:=$1EB9;
877
 
  UnicodeLower1E00_1FFC[$1EBA]:=$1EBB;
878
 
  UnicodeLower1E00_1FFC[$1EBC]:=$1EBD;
879
 
  UnicodeLower1E00_1FFC[$1EBE]:=$1EBF;
880
 
  UnicodeLower1E00_1FFC[$1EC0]:=$1EC1;
881
 
  UnicodeLower1E00_1FFC[$1EC2]:=$1EC3;
882
 
  UnicodeLower1E00_1FFC[$1EC4]:=$1EC5;
883
 
  UnicodeLower1E00_1FFC[$1EC6]:=$1EC7;
884
 
  UnicodeLower1E00_1FFC[$1EC8]:=$1EC9;
885
 
  UnicodeLower1E00_1FFC[$1ECA]:=$1ECB;
886
 
  UnicodeLower1E00_1FFC[$1ECC]:=$1ECD;
887
 
  UnicodeLower1E00_1FFC[$1ECE]:=$1ECF;
888
 
  UnicodeLower1E00_1FFC[$1ED0]:=$1ED1;
889
 
  UnicodeLower1E00_1FFC[$1ED2]:=$1ED3;
890
 
  UnicodeLower1E00_1FFC[$1ED4]:=$1ED5;
891
 
  UnicodeLower1E00_1FFC[$1ED6]:=$1ED7;
892
 
  UnicodeLower1E00_1FFC[$1ED8]:=$1ED9;
893
 
  UnicodeLower1E00_1FFC[$1EDA]:=$1EDB;
894
 
  UnicodeLower1E00_1FFC[$1EDC]:=$1EDD;
895
 
  UnicodeLower1E00_1FFC[$1EDE]:=$1EDF;
896
 
  UnicodeLower1E00_1FFC[$1EE0]:=$1EE1;
897
 
  UnicodeLower1E00_1FFC[$1EE2]:=$1EE3;
898
 
  UnicodeLower1E00_1FFC[$1EE4]:=$1EE5;
899
 
  UnicodeLower1E00_1FFC[$1EE6]:=$1EE7;
900
 
  UnicodeLower1E00_1FFC[$1EE8]:=$1EE9;
901
 
  UnicodeLower1E00_1FFC[$1EEA]:=$1EEB;
902
 
  UnicodeLower1E00_1FFC[$1EEC]:=$1EED;
903
 
  UnicodeLower1E00_1FFC[$1EEE]:=$1EEF;
904
 
  UnicodeLower1E00_1FFC[$1EF0]:=$1EF1;
905
 
  UnicodeLower1E00_1FFC[$1EF2]:=$1EF3;
906
 
  UnicodeLower1E00_1FFC[$1EF4]:=$1EF5;
907
 
  UnicodeLower1E00_1FFC[$1EF6]:=$1EF7;
908
 
  UnicodeLower1E00_1FFC[$1EF8]:=$1EF9;
909
 
  UnicodeLower1E00_1FFC[$1F08]:=$1F00;
910
 
  UnicodeLower1E00_1FFC[$1F09]:=$1F01;
911
 
  UnicodeLower1E00_1FFC[$1F0A]:=$1F02;
912
 
  UnicodeLower1E00_1FFC[$1F0B]:=$1F03;
913
 
  UnicodeLower1E00_1FFC[$1F0C]:=$1F04;
914
 
  UnicodeLower1E00_1FFC[$1F0D]:=$1F05;
915
 
  UnicodeLower1E00_1FFC[$1F0E]:=$1F06;
916
 
  UnicodeLower1E00_1FFC[$1F0F]:=$1F07;
917
 
  UnicodeLower1E00_1FFC[$1F18]:=$1F10;
918
 
  UnicodeLower1E00_1FFC[$1F19]:=$1F11;
919
 
  UnicodeLower1E00_1FFC[$1F1A]:=$1F12;
920
 
  UnicodeLower1E00_1FFC[$1F1B]:=$1F13;
921
 
  UnicodeLower1E00_1FFC[$1F1C]:=$1F14;
922
 
  UnicodeLower1E00_1FFC[$1F1D]:=$1F15;
923
 
  UnicodeLower1E00_1FFC[$1F28]:=$1F20;
924
 
  UnicodeLower1E00_1FFC[$1F29]:=$1F21;
925
 
  UnicodeLower1E00_1FFC[$1F2A]:=$1F22;
926
 
  UnicodeLower1E00_1FFC[$1F2B]:=$1F23;
927
 
  UnicodeLower1E00_1FFC[$1F2C]:=$1F24;
928
 
  UnicodeLower1E00_1FFC[$1F2D]:=$1F25;
929
 
  UnicodeLower1E00_1FFC[$1F2E]:=$1F26;
930
 
  UnicodeLower1E00_1FFC[$1F2F]:=$1F27;
931
 
  UnicodeLower1E00_1FFC[$1F38]:=$1F30;
932
 
  UnicodeLower1E00_1FFC[$1F39]:=$1F31;
933
 
  UnicodeLower1E00_1FFC[$1F3A]:=$1F32;
934
 
  UnicodeLower1E00_1FFC[$1F3B]:=$1F33;
935
 
  UnicodeLower1E00_1FFC[$1F3C]:=$1F34;
936
 
  UnicodeLower1E00_1FFC[$1F3D]:=$1F35;
937
 
  UnicodeLower1E00_1FFC[$1F3E]:=$1F36;
938
 
  UnicodeLower1E00_1FFC[$1F3F]:=$1F37;
939
 
  UnicodeLower1E00_1FFC[$1F48]:=$1F40;
940
 
  UnicodeLower1E00_1FFC[$1F49]:=$1F41;
941
 
  UnicodeLower1E00_1FFC[$1F4A]:=$1F42;
942
 
  UnicodeLower1E00_1FFC[$1F4B]:=$1F43;
943
 
  UnicodeLower1E00_1FFC[$1F4C]:=$1F44;
944
 
  UnicodeLower1E00_1FFC[$1F4D]:=$1F45;
945
 
  UnicodeLower1E00_1FFC[$1F59]:=$1F51;
946
 
  UnicodeLower1E00_1FFC[$1F5B]:=$1F53;
947
 
  UnicodeLower1E00_1FFC[$1F5D]:=$1F55;
948
 
  UnicodeLower1E00_1FFC[$1F5F]:=$1F57;
949
 
  UnicodeLower1E00_1FFC[$1F68]:=$1F60;
950
 
  UnicodeLower1E00_1FFC[$1F69]:=$1F61;
951
 
  UnicodeLower1E00_1FFC[$1F6A]:=$1F62;
952
 
  UnicodeLower1E00_1FFC[$1F6B]:=$1F63;
953
 
  UnicodeLower1E00_1FFC[$1F6C]:=$1F64;
954
 
  UnicodeLower1E00_1FFC[$1F6D]:=$1F65;
955
 
  UnicodeLower1E00_1FFC[$1F6E]:=$1F66;
956
 
  UnicodeLower1E00_1FFC[$1F6F]:=$1F67;
957
 
  UnicodeLower1E00_1FFC[$1F88]:=$1F80;
958
 
  UnicodeLower1E00_1FFC[$1F89]:=$1F81;
959
 
  UnicodeLower1E00_1FFC[$1F8A]:=$1F82;
960
 
  UnicodeLower1E00_1FFC[$1F8B]:=$1F83;
961
 
  UnicodeLower1E00_1FFC[$1F8C]:=$1F84;
962
 
  UnicodeLower1E00_1FFC[$1F8D]:=$1F85;
963
 
  UnicodeLower1E00_1FFC[$1F8E]:=$1F86;
964
 
  UnicodeLower1E00_1FFC[$1F8F]:=$1F87;
965
 
  UnicodeLower1E00_1FFC[$1F98]:=$1F90;
966
 
  UnicodeLower1E00_1FFC[$1F99]:=$1F91;
967
 
  UnicodeLower1E00_1FFC[$1F9A]:=$1F92;
968
 
  UnicodeLower1E00_1FFC[$1F9B]:=$1F93;
969
 
  UnicodeLower1E00_1FFC[$1F9C]:=$1F94;
970
 
  UnicodeLower1E00_1FFC[$1F9D]:=$1F95;
971
 
  UnicodeLower1E00_1FFC[$1F9E]:=$1F96;
972
 
  UnicodeLower1E00_1FFC[$1F9F]:=$1F97;
973
 
  UnicodeLower1E00_1FFC[$1FA8]:=$1FA0;
974
 
  UnicodeLower1E00_1FFC[$1FA9]:=$1FA1;
975
 
  UnicodeLower1E00_1FFC[$1FAA]:=$1FA2;
976
 
  UnicodeLower1E00_1FFC[$1FAB]:=$1FA3;
977
 
  UnicodeLower1E00_1FFC[$1FAC]:=$1FA4;
978
 
  UnicodeLower1E00_1FFC[$1FAD]:=$1FA5;
979
 
  UnicodeLower1E00_1FFC[$1FAE]:=$1FA6;
980
 
  UnicodeLower1E00_1FFC[$1FAF]:=$1FA7;
981
 
  UnicodeLower1E00_1FFC[$1FB8]:=$1FB0;
982
 
  UnicodeLower1E00_1FFC[$1FB9]:=$1FB1;
983
 
  UnicodeLower1E00_1FFC[$1FBA]:=$1F70;
984
 
  UnicodeLower1E00_1FFC[$1FBB]:=$1F71;
985
 
  UnicodeLower1E00_1FFC[$1FBC]:=$1FB3;
986
 
  UnicodeLower1E00_1FFC[$1FC8]:=$1F72;
987
 
  UnicodeLower1E00_1FFC[$1FC9]:=$1F73;
988
 
  UnicodeLower1E00_1FFC[$1FCA]:=$1F74;
989
 
  UnicodeLower1E00_1FFC[$1FCB]:=$1F75;
990
 
  UnicodeLower1E00_1FFC[$1FCC]:=$1FC3;
991
 
  UnicodeLower1E00_1FFC[$1FD8]:=$1FD0;
992
 
  UnicodeLower1E00_1FFC[$1FD9]:=$1FD1;
993
 
  UnicodeLower1E00_1FFC[$1FDA]:=$1F76;
994
 
  UnicodeLower1E00_1FFC[$1FDB]:=$1F77;
995
 
  UnicodeLower1E00_1FFC[$1FE8]:=$1FE0;
996
 
  UnicodeLower1E00_1FFC[$1FE9]:=$1FE1;
997
 
  UnicodeLower1E00_1FFC[$1FEA]:=$1F7A;
998
 
  UnicodeLower1E00_1FFC[$1FEB]:=$1F7B;
999
 
  UnicodeLower1E00_1FFC[$1FEC]:=$1FE5;
1000
 
  UnicodeLower1E00_1FFC[$1FF8]:=$1F78;
1001
 
  UnicodeLower1E00_1FFC[$1FF9]:=$1F79;
1002
 
  UnicodeLower1E00_1FFC[$1FFA]:=$1F7C;
1003
 
  UnicodeLower1E00_1FFC[$1FFB]:=$1F7D;
1004
 
  UnicodeLower1E00_1FFC[$1FFC]:=$1FF3;
1005
 
 
1006
 
  for i:=Low(UnicodeLower2126_2183) to High(UnicodeLower2126_2183) do
1007
 
    UnicodeLower2126_2183[i]:=i;
1008
 
  UnicodeLower2126_2183[$2126]:=$03C9;
1009
 
  UnicodeLower2126_2183[$212A]:=$006B;
1010
 
  UnicodeLower2126_2183[$212B]:=$00E5;
1011
 
  UnicodeLower2126_2183[$2132]:=$214E;
1012
 
  UnicodeLower2126_2183[$2160]:=$2170;
1013
 
  UnicodeLower2126_2183[$2161]:=$2171;
1014
 
  UnicodeLower2126_2183[$2162]:=$2172;
1015
 
  UnicodeLower2126_2183[$2163]:=$2173;
1016
 
  UnicodeLower2126_2183[$2164]:=$2174;
1017
 
  UnicodeLower2126_2183[$2165]:=$2175;
1018
 
  UnicodeLower2126_2183[$2166]:=$2176;
1019
 
  UnicodeLower2126_2183[$2167]:=$2177;
1020
 
  UnicodeLower2126_2183[$2168]:=$2178;
1021
 
  UnicodeLower2126_2183[$2169]:=$2179;
1022
 
  UnicodeLower2126_2183[$216A]:=$217A;
1023
 
  UnicodeLower2126_2183[$216B]:=$217B;
1024
 
  UnicodeLower2126_2183[$216C]:=$217C;
1025
 
  UnicodeLower2126_2183[$216D]:=$217D;
1026
 
  UnicodeLower2126_2183[$216E]:=$217E;
1027
 
  UnicodeLower2126_2183[$216F]:=$217F;
1028
 
  UnicodeLower2126_2183[$2183]:=$2184;
1029
 
 
1030
 
  for i:=Low(UnicodeLower2C60_2CE2) to High(UnicodeLower2C60_2CE2) do
1031
 
    UnicodeLower2C60_2CE2[i]:=i;
1032
 
  UnicodeLower2C60_2CE2[$2C60]:=$2C61;
1033
 
  UnicodeLower2C60_2CE2[$2C62]:=$026B;
1034
 
  UnicodeLower2C60_2CE2[$2C63]:=$1D7D;
1035
 
  UnicodeLower2C60_2CE2[$2C64]:=$027D;
1036
 
  UnicodeLower2C60_2CE2[$2C67]:=$2C68;
1037
 
  UnicodeLower2C60_2CE2[$2C69]:=$2C6A;
1038
 
  UnicodeLower2C60_2CE2[$2C6B]:=$2C6C;
1039
 
  UnicodeLower2C60_2CE2[$2C75]:=$2C76;
1040
 
  UnicodeLower2C60_2CE2[$2C80]:=$2C81;
1041
 
  UnicodeLower2C60_2CE2[$2C82]:=$2C83;
1042
 
  UnicodeLower2C60_2CE2[$2C84]:=$2C85;
1043
 
  UnicodeLower2C60_2CE2[$2C86]:=$2C87;
1044
 
  UnicodeLower2C60_2CE2[$2C88]:=$2C89;
1045
 
  UnicodeLower2C60_2CE2[$2C8A]:=$2C8B;
1046
 
  UnicodeLower2C60_2CE2[$2C8C]:=$2C8D;
1047
 
  UnicodeLower2C60_2CE2[$2C8E]:=$2C8F;
1048
 
  UnicodeLower2C60_2CE2[$2C90]:=$2C91;
1049
 
  UnicodeLower2C60_2CE2[$2C92]:=$2C93;
1050
 
  UnicodeLower2C60_2CE2[$2C94]:=$2C95;
1051
 
  UnicodeLower2C60_2CE2[$2C96]:=$2C97;
1052
 
  UnicodeLower2C60_2CE2[$2C98]:=$2C99;
1053
 
  UnicodeLower2C60_2CE2[$2C9A]:=$2C9B;
1054
 
  UnicodeLower2C60_2CE2[$2C9C]:=$2C9D;
1055
 
  UnicodeLower2C60_2CE2[$2C9E]:=$2C9F;
1056
 
  UnicodeLower2C60_2CE2[$2CA0]:=$2CA1;
1057
 
  UnicodeLower2C60_2CE2[$2CA2]:=$2CA3;
1058
 
  UnicodeLower2C60_2CE2[$2CA4]:=$2CA5;
1059
 
  UnicodeLower2C60_2CE2[$2CA6]:=$2CA7;
1060
 
  UnicodeLower2C60_2CE2[$2CA8]:=$2CA9;
1061
 
  UnicodeLower2C60_2CE2[$2CAA]:=$2CAB;
1062
 
  UnicodeLower2C60_2CE2[$2CAC]:=$2CAD;
1063
 
  UnicodeLower2C60_2CE2[$2CAE]:=$2CAF;
1064
 
  UnicodeLower2C60_2CE2[$2CB0]:=$2CB1;
1065
 
  UnicodeLower2C60_2CE2[$2CB2]:=$2CB3;
1066
 
  UnicodeLower2C60_2CE2[$2CB4]:=$2CB5;
1067
 
  UnicodeLower2C60_2CE2[$2CB6]:=$2CB7;
1068
 
  UnicodeLower2C60_2CE2[$2CB8]:=$2CB9;
1069
 
  UnicodeLower2C60_2CE2[$2CBA]:=$2CBB;
1070
 
  UnicodeLower2C60_2CE2[$2CBC]:=$2CBD;
1071
 
  UnicodeLower2C60_2CE2[$2CBE]:=$2CBF;
1072
 
  UnicodeLower2C60_2CE2[$2CC0]:=$2CC1;
1073
 
  UnicodeLower2C60_2CE2[$2CC2]:=$2CC3;
1074
 
  UnicodeLower2C60_2CE2[$2CC4]:=$2CC5;
1075
 
  UnicodeLower2C60_2CE2[$2CC6]:=$2CC7;
1076
 
  UnicodeLower2C60_2CE2[$2CC8]:=$2CC9;
1077
 
  UnicodeLower2C60_2CE2[$2CCA]:=$2CCB;
1078
 
  UnicodeLower2C60_2CE2[$2CCC]:=$2CCD;
1079
 
  UnicodeLower2C60_2CE2[$2CCE]:=$2CCF;
1080
 
  UnicodeLower2C60_2CE2[$2CD0]:=$2CD1;
1081
 
  UnicodeLower2C60_2CE2[$2CD2]:=$2CD3;
1082
 
  UnicodeLower2C60_2CE2[$2CD4]:=$2CD5;
1083
 
  UnicodeLower2C60_2CE2[$2CD6]:=$2CD7;
1084
 
  UnicodeLower2C60_2CE2[$2CD8]:=$2CD9;
1085
 
  UnicodeLower2C60_2CE2[$2CDA]:=$2CDB;
1086
 
  UnicodeLower2C60_2CE2[$2CDC]:=$2CDD;
1087
 
  UnicodeLower2C60_2CE2[$2CDE]:=$2CDF;
1088
 
  UnicodeLower2C60_2CE2[$2CE0]:=$2CE1;
1089
 
  UnicodeLower2C60_2CE2[$2CE2]:=$2CE3;
1090
 
end;
1091
 
{$endif NewLowerCase}
1092
 
 
1093
441
function DeleteAmpersands(var Str : String) : Longint;
1094
442
// Replace all &x with x
1095
443
// and return the position of the first ampersand letter in the resulting Str.
1192
540
    Result:=DefaultValue;
1193
541
end;
1194
542
 
 
543
// Used also by TWidgetSet.GetAcceleratorString
 
544
function KeyAndShiftStateToKeyString(Key: word; ShiftState: TShiftState): String;
 
545
 
 
546
  procedure AddPart(const APart: string);
 
547
  begin
 
548
    if Result <> '' then
 
549
      Result := Result + '+';
 
550
    Result := Result + APart;
 
551
  end;
 
552
 
 
553
  // Tricky routine. This only works for western languages
 
554
  procedure AddKey;
 
555
  begin
 
556
    case Key of
 
557
      VK_UNKNOWN    :AddPart(ifsVK_UNKNOWN);
 
558
      VK_LBUTTON    :AddPart(ifsVK_LBUTTON);
 
559
      VK_RBUTTON    :AddPart(ifsVK_RBUTTON);
 
560
      VK_CANCEL     :AddPart(ifsVK_CANCEL);
 
561
      VK_MBUTTON    :AddPart(ifsVK_MBUTTON);
 
562
      VK_BACK       :AddPart(ifsVK_BACK);
 
563
      VK_TAB        :AddPart(ifsVK_TAB);
 
564
      VK_CLEAR      :AddPart(ifsVK_CLEAR);
 
565
      VK_RETURN     :AddPart(ifsVK_RETURN);
 
566
      VK_SHIFT      :AddPart(ifsVK_SHIFT);
 
567
      VK_CONTROL    :AddPart(ifsVK_CONTROL);
 
568
      VK_MENU       :AddPart(ifsVK_MENU);
 
569
      VK_PAUSE      :AddPart(ifsVK_PAUSE);
 
570
      VK_CAPITAL    :AddPart(ifsVK_CAPITAL);
 
571
      VK_KANA       :AddPart(ifsVK_KANA);
 
572
    //  VK_HANGUL     :AddPart('Hangul');
 
573
      VK_JUNJA      :AddPart(ifsVK_JUNJA);
 
574
      VK_FINAL      :AddPart(ifsVK_FINAL);
 
575
      VK_HANJA      :AddPart(ifsVK_HANJA );
 
576
    //  VK_KANJI      :AddPart('Kanji');
 
577
      VK_ESCAPE     :AddPart(ifsVK_ESCAPE);
 
578
      VK_CONVERT    :AddPart(ifsVK_CONVERT);
 
579
      VK_NONCONVERT :AddPart(ifsVK_NONCONVERT);
 
580
      VK_ACCEPT     :AddPart(ifsVK_ACCEPT);
 
581
      VK_MODECHANGE :AddPart(ifsVK_MODECHANGE);
 
582
      VK_SPACE      :AddPart(ifsVK_SPACE);
 
583
      VK_PRIOR      :AddPart(ifsVK_PRIOR);
 
584
      VK_NEXT       :AddPart(ifsVK_NEXT);
 
585
      VK_END        :AddPart(ifsVK_END);
 
586
      VK_HOME       :AddPart(ifsVK_HOME);
 
587
      VK_LEFT       :AddPart(ifsVK_LEFT);
 
588
      VK_UP         :AddPart(ifsVK_UP);
 
589
      VK_RIGHT      :AddPart(ifsVK_RIGHT);
 
590
      VK_DOWN       :AddPart(ifsVK_DOWN);
 
591
      VK_SELECT     :AddPart(ifsVK_SELECT);
 
592
      VK_PRINT      :AddPart(ifsVK_PRINT);
 
593
      VK_EXECUTE    :AddPart(ifsVK_EXECUTE);
 
594
      VK_SNAPSHOT   :AddPart(ifsVK_SNAPSHOT);
 
595
      VK_INSERT     :AddPart(ifsVK_INSERT);
 
596
      VK_DELETE     :AddPart(ifsVK_DELETE);
 
597
      VK_HELP       :AddPart(ifsVK_HELP);
 
598
      VK_0..VK_9    :AddPart(chr(ord('0')+Key-VK_0));
 
599
      VK_A..VK_Z    :AddPart(chr(ord('A')+Key-VK_A));
 
600
      VK_LWIN       :AddPart(ifsVK_LWIN);
 
601
      VK_RWIN       :AddPart(ifsVK_RWIN);
 
602
      VK_APPS       :AddPart(ifsVK_APPS);
 
603
      VK_NUMPAD0..VK_NUMPAD9:  AddPart(Format(ifsVK_NUMPAD,[Key-VK_NUMPAD0]));
 
604
      VK_MULTIPLY   :AddPart('*');
 
605
      VK_ADD        :AddPart('+');
 
606
      VK_OEM_PLUS   :AddPart('+');
 
607
      VK_SEPARATOR  :AddPart('|');
 
608
      VK_SUBTRACT   :AddPart('-');
 
609
      VK_OEM_MINUS  :AddPart('-');
 
610
      VK_DECIMAL    :AddPart('.');
 
611
      VK_OEM_PERIOD :AddPart('.');
 
612
      VK_OEM_COMMA  :AddPart(',');
 
613
      VK_DIVIDE     :AddPart('/');
 
614
      VK_F1..VK_F24: AddPart('F'+IntToStr(Key-VK_F1+1));
 
615
      VK_NUMLOCK    :AddPart(ifsVK_NUMLOCK);
 
616
      VK_SCROLL     :AddPart(ifsVK_SCROLL);
 
617
      VK_OEM_2      :AddPart('OEM2');
 
618
      VK_OEM_3      :AddPart('OEM3');
 
619
//    VK_EQUAL      :AddPart('=');
 
620
//    VK_AT         :AddPart('@');
 
621
    else
 
622
      AddPart(UNKNOWN_VK_PREFIX + IntToStr(Key) + UNKNOWN_VK_POSTFIX);
 
623
    end;
 
624
  end;
 
625
 
 
626
begin
 
627
  Result := '';
 
628
  if ssCtrl in ShiftState then AddPart(ifsCtrl);
 
629
  if ssAlt in ShiftState then AddPart(ifsAlt);
 
630
  if ssShift in ShiftState then AddPart(ifsVK_SHIFT);
 
631
  if ssMeta in ShiftState then
 
632
    {$IFDEF LCLcarbon}
 
633
    AddPart(ifsVK_CMD);
 
634
    {$ELSE}
 
635
    AddPart(ifsVK_META);
 
636
    {$ENDIF}
 
637
  if ssSuper in ShiftState then AddPart(ifsVK_SUPER);
 
638
  AddKey;
 
639
end;
 
640
 
 
641
function KeyStringIsIrregular(const s: string): boolean;
 
642
begin
 
643
  Result:=(length(UNKNOWN_VK_PREFIX)<length(s)) and
 
644
    (AnsiStrLComp(PChar(s),PChar(UNKNOWN_VK_PREFIX),length(UNKNOWN_VK_PREFIX))=0);
 
645
end;
 
646
 
1195
647
function ShortCutToText(ShortCut: TShortCut): string;
1196
648
var
1197
649
  Name: string;
1277
729
  end;
1278
730
end;
1279
731
 
1280
 
function GetCompleteText(sText: string; iSelStart: Integer;
 
732
function GetCompleteText(const sText: string; iSelStart: Integer;
1281
733
  bCaseSensitive, bSearchAscending: Boolean; slTextList: TStrings): string;
1282
734
 
1283
 
  function IsSamePrefix(sCompareText, sPrefix: string; iStart: Integer;
 
735
  function IsSamePrefix(const sCompareText, sPrefix: string; iStart: Integer;
1284
736
    var ResultText: string): Boolean;
1285
737
  var
1286
738
    sTempText: string;
1358
810
    Top := Top + dy;
1359
811
    Bottom := Bottom + dy;
1360
812
  end;
1361
 
  if (ARect.Left >= 0) and (ARect.Top >= 0) then
1362
 
    Result := True
1363
 
  else
1364
 
    Result := False;
 
813
  Result := (ARect.Left >= 0) and (ARect.Top >= 0);
1365
814
end;
1366
815
 
1367
816
procedure FreeThenNil(var obj);
1399
848
    TProcedure(InterfaceFinalizationHandlers[i])();
1400
849
end;
1401
850
 
1402
 
{ TMethodList }
1403
 
 
1404
 
function TMethodList.GetItems(Index: integer): TMethod;
1405
 
begin
1406
 
  Result:=FItems[Index];
1407
 
end;
1408
 
 
1409
 
procedure TMethodList.SetItems(Index: integer; const AValue: TMethod);
1410
 
begin
1411
 
  FItems[Index]:=AValue;
1412
 
end;
1413
 
 
1414
 
destructor TMethodList.Destroy;
1415
 
begin
1416
 
  ReAllocMem(FItems,0);
1417
 
  inherited Destroy;
1418
 
end;
1419
 
 
1420
 
function TMethodList.Count: integer;
1421
 
begin
1422
 
  if Self<>nil then
1423
 
    Result:=FCount
1424
 
  else
1425
 
    Result:=0;
1426
 
end;
1427
 
 
1428
 
function TMethodList.NextDownIndex(var Index: integer): boolean;
1429
 
begin
1430
 
  if Self<>nil then begin
1431
 
    dec(Index);
1432
 
    if (Index>=FCount) then
1433
 
      Index:=FCount-1;
1434
 
  end else
1435
 
    Index:=-1;
1436
 
  Result:=(Index>=0);
1437
 
end;
1438
 
 
1439
 
function TMethodList.IndexOf(const AMethod: TMethod): integer;
1440
 
begin
1441
 
  if Self<>nil then begin
1442
 
    Result:=FCount-1;
1443
 
    while Result>=0 do begin
1444
 
      if (FItems[Result].Code=AMethod.Code)
1445
 
      and (FItems[Result].Data=AMethod.Data) then exit;
1446
 
      dec(Result);
1447
 
    end;
1448
 
  end else
1449
 
    Result:=-1;
1450
 
end;
1451
 
 
1452
 
procedure TMethodList.Delete(Index: integer);
1453
 
begin
1454
 
  dec(FCount);
1455
 
  if FCount>Index then
1456
 
    System.Move(FItems[Index+1],FItems[Index],(FCount-Index)*SizeOf(TMethod));
1457
 
  ReAllocMem(FItems,FCount*SizeOf(TMethod));
1458
 
end;
1459
 
 
1460
 
procedure TMethodList.Remove(const AMethod: TMethod);
1461
 
var
1462
 
  i: integer;
1463
 
begin
1464
 
  if Self<>nil then begin
1465
 
    i:=IndexOf(AMethod);
1466
 
    if i>=0 then Delete(i);
1467
 
  end;
1468
 
end;
1469
 
 
1470
 
procedure TMethodList.Add(const AMethod: TMethod);
1471
 
begin
1472
 
  inc(FCount);
1473
 
  ReAllocMem(FItems,FCount*SizeOf(TMethod));
1474
 
  FItems[FCount-1]:=AMethod;
1475
 
end;
1476
 
 
1477
 
procedure TMethodList.Add(const AMethod: TMethod; AsLast: boolean);
1478
 
begin
1479
 
  if AsLast then
1480
 
    Add(AMethod)
1481
 
  else
1482
 
    Insert(0,AMethod);
1483
 
end;
1484
 
 
1485
 
procedure TMethodList.Insert(Index: integer; const AMethod: TMethod);
1486
 
begin
1487
 
  inc(FCount);
1488
 
  ReAllocMem(FItems,FCount*SizeOf(TMethod));
1489
 
  if Index<FCount then
1490
 
    System.Move(FItems[Index],FItems[Index+1],(FCount-Index-1)*SizeOf(TMethod));
1491
 
  FItems[Index]:=AMethod;
1492
 
end;
1493
 
 
1494
 
procedure TMethodList.Move(OldIndex, NewIndex: integer);
1495
 
var
1496
 
  MovingMethod: TMethod;
1497
 
begin
1498
 
  if OldIndex=NewIndex then exit;
1499
 
  MovingMethod:=FItems[OldIndex];
1500
 
  if OldIndex>NewIndex then
1501
 
    System.Move(FItems[NewIndex],FItems[NewIndex+1],
1502
 
                SizeOf(TMethod)*(OldIndex-NewIndex))
1503
 
  else
1504
 
    System.Move(FItems[NewIndex+1],FItems[NewIndex],
1505
 
                SizeOf(TMethod)*(NewIndex-OldIndex));
1506
 
  FItems[NewIndex]:=MovingMethod;
1507
 
end;
1508
 
 
1509
 
procedure TMethodList.RemoveAllMethodsOfObject(const AnObject: TObject);
1510
 
var
1511
 
  i: Integer;
1512
 
begin
1513
 
  if Self=nil then exit;
1514
 
  i:=FCount-1;
1515
 
  while i>=0 do begin
1516
 
    if TObject(FItems[i].Data)=AnObject then Delete(i);
1517
 
    dec(i);
1518
 
  end;
1519
 
end;
1520
 
 
1521
 
procedure TMethodList.CallNotifyEvents(Sender: TObject);
1522
 
var
1523
 
  i: LongInt;
1524
 
begin
1525
 
  i:=Count;
1526
 
  while NextDownIndex(i) do
1527
 
    TNotifyEvent(Items[i])(Sender);
1528
 
end;
1529
 
 
1530
851
{------------------------------------------------------------------------------
1531
852
  procedure RaiseGDBException(const Msg: string);
1532
853
 
1533
854
  Raises an exception.
1534
855
  Normally gdb does not catch fpc Exception objects, therefore this procedure
1535
856
  raises a standard "division by zero" exception which is catched by gdb.
1536
 
  This allows to stop a program, without extra gdb configuration.
 
857
  This allows one to stop a program, without extra gdb configuration.
1537
858
 ------------------------------------------------------------------------------}
1538
859
procedure RaiseGDBException(const Msg: string);
1539
860
begin
1576
897
    DumpAddr(Frames[FrameNumber]);
1577
898
end;
1578
899
 
1579
 
procedure DumpStack;
1580
 
begin
1581
 
  if Assigned(DebugText) then
1582
 
    Dump_Stack(DebugText^, get_frame);
1583
 
end;
1584
 
 
1585
900
function GetStackTrace(UseCache: boolean): string;
1586
901
var
1587
902
  bp: Pointer;
1716
1031
end;
1717
1032
 
1718
1033
procedure CalculateLeftTopWidthHeight(X1, Y1, X2, Y2: integer;
1719
 
  var Left, Top, Width, Height: integer);
 
1034
  out Left, Top, Width, Height: integer);
1720
1035
begin
1721
1036
  if X1 <= X2 then 
1722
1037
   begin
1919
1234
end;
1920
1235
 
1921
1236
procedure MergeSort(List: TFPList; const OnCompare: TListSortCompare);
 
1237
// sort so that for each i is OnCompare(List[i],List[i+1])<=0
1922
1238
var
1923
1239
  MergeList: PPointer;
1924
1240
 
 
1241
  procedure SmallSort(StartPos, EndPos: PtrInt);
 
1242
  // use insertion sort for small lists
 
1243
  var
 
1244
    i: PtrInt;
 
1245
    Best: PtrInt;
 
1246
    j: PtrInt;
 
1247
    Item: Pointer;
 
1248
  begin
 
1249
    for i:=StartPos to EndPos-1 do begin
 
1250
      Best:=i;
 
1251
      for j:=i+1 to EndPos do
 
1252
        if OnCompare(List[Best],List[j])>0 then
 
1253
          Best:=j;
 
1254
      if Best>i then begin
 
1255
        Item:=List[i];
 
1256
        List[i]:=List[Best];
 
1257
        List[Best]:=Item;
 
1258
      end;
 
1259
    end;
 
1260
  end;
 
1261
 
1925
1262
  procedure Merge(Pos1, Pos2, Pos3: PtrInt);
1926
1263
  // merge two sorted arrays
1927
1264
  // the first array ranges Pos1..Pos2-1, the second ranges Pos2..Pos3
1956
1293
  procedure Sort(StartPos, EndPos: PtrInt);
1957
1294
  // sort an interval in List. Use MergeList as work space.
1958
1295
  var
1959
 
    cmp, mid: integer;
1960
 
    p: Pointer;
 
1296
    mid: integer;
1961
1297
  begin
1962
 
    if StartPos=EndPos then begin
1963
 
    end else if StartPos+1=EndPos then begin
1964
 
      cmp:=OnCompare(List[StartPos],List[EndPos]);
1965
 
      if cmp>0 then begin
1966
 
        p:=List[StartPos];
1967
 
        List[StartPos]:=List[EndPos];
1968
 
        List[EndPos]:=p;
1969
 
      end;
1970
 
    end else if EndPos>StartPos then begin
 
1298
    if EndPos-StartPos<6 then begin
 
1299
      SmallSort(StartPos,EndPos);
 
1300
    end else begin
1971
1301
      mid:=(StartPos+EndPos) shr 1;
1972
1302
      Sort(StartPos,mid);
1973
1303
      Sort(mid+1,EndPos);
1983
1313
end;
1984
1314
 
1985
1315
procedure MergeSort(List: TStrings; const OnCompare: TStringsSortCompare);
 
1316
// sort so that for each i is OnCompare(List[i],List[i+1])<=0
1986
1317
var
1987
1318
  MergeList: PAnsiString;
1988
1319
 
 
1320
  procedure SmallSort(StartPos, EndPos: PtrInt);
 
1321
  // use insertion sort for small lists
 
1322
  var
 
1323
    i: PtrInt;
 
1324
    Best: PtrInt;
 
1325
    j: PtrInt;
 
1326
    Item: string;
 
1327
  begin
 
1328
    for i:=StartPos to EndPos-1 do begin
 
1329
      Best:=i;
 
1330
      for j:=i+1 to EndPos do
 
1331
        if OnCompare(List[Best],List[j])>0 then
 
1332
          Best:=j;
 
1333
      if Best>i then begin
 
1334
        Item:=List[i];
 
1335
        List[i]:=List[Best];
 
1336
        List[Best]:=Item;
 
1337
      end;
 
1338
    end;
 
1339
  end;
 
1340
 
1989
1341
  procedure Merge(Pos1, Pos2, Pos3: PtrInt);
1990
1342
  // merge two sorted arrays
1991
1343
  // the first array ranges Pos1..Pos2-1, the second ranges Pos2..Pos3
2020
1372
  procedure Sort(StartPos, EndPos: PtrInt);
2021
1373
  // sort an interval in List. Use MergeList as work space.
2022
1374
  var
2023
 
    cmp, mid: integer;
2024
 
    s: string;
 
1375
    mid: integer;
2025
1376
  begin
2026
 
    if StartPos=EndPos then begin
2027
 
    end else if StartPos+1=EndPos then begin
2028
 
      cmp:=OnCompare(List[StartPos],List[EndPos]);
2029
 
      if cmp>0 then begin
2030
 
        s:=List[StartPos];
2031
 
        List[StartPos]:=List[EndPos];
2032
 
        List[EndPos]:=s;
2033
 
      end;
2034
 
    end else if EndPos>StartPos then begin
 
1377
    if EndPos-StartPos<6 then begin
 
1378
      SmallSort(StartPos,EndPos);
 
1379
    end else begin
2035
1380
      mid:=(StartPos+EndPos) shr 1;
2036
1381
      Sort(StartPos,mid);
2037
1382
      Sort(mid+1,EndPos);
2052
1397
  Freemem(MergeList);
2053
1398
end;
2054
1399
 
 
1400
 
 
1401
// Debug funcs :
 
1402
 
 
1403
{$IFnDEF WithOldDebugln}
 
1404
procedure DumpStack;
 
1405
begin
 
1406
  DebugLogger.DebuglnStack;
 
1407
end;
 
1408
 
 
1409
procedure CloseDebugOutput;
 
1410
begin
 
1411
  DebugLogger.Finish;
 
1412
end;
 
1413
 
 
1414
procedure DbgOut(const s: string);
 
1415
begin
 
1416
  DebugLogger.DbgOut(s);
 
1417
end;
 
1418
 
 
1419
procedure DbgOut(Args: array of const);
 
1420
begin
 
1421
  DebugLogger.DbgOut(Args);
 
1422
end;
 
1423
 
 
1424
procedure DbgOut(const S: String; Args: array of const);
 
1425
begin
 
1426
  DebugLogger.DbgOut(S, Args);
 
1427
end;
 
1428
 
 
1429
procedure DbgOut(const s1, s2: string; const s3: string; const s4: string; const s5: string;
 
1430
  const s6: string; const s7: string; const s8: string; const s9: string; const s10: string;
 
1431
  const s11: string; const s12: string; const s13: string; const s14: string;
 
1432
  const s15: string; const s16: string; const s17: string; const s18: string);
 
1433
begin
 
1434
  DebugLogger.DbgOut(s1, s2, s3, s4, s5, s6, s7, s8, s9, s10, s11, s12, s13, s14, s15, s16, s17, s18);
 
1435
end;
 
1436
 
 
1437
procedure DebugLn(const s: string);
 
1438
begin
 
1439
  DebugLogger.DebugLn(s);
 
1440
end;
 
1441
 
 
1442
procedure DebugLn(Args: array of const);
 
1443
begin
 
1444
  DebugLogger.DebugLn(Args);
 
1445
end;
 
1446
 
 
1447
procedure DebugLn(const S: String; Args: array of const);
 
1448
begin
 
1449
  DebugLogger.DebugLn(S, Args);
 
1450
end;
 
1451
 
 
1452
procedure DebugLn(const s1, s2: string; const s3: string; const s4: string; const s5: string;
 
1453
  const s6: string; const s7: string; const s8: string; const s9: string; const s10: string;
 
1454
  const s11: string; const s12: string; const s13: string; const s14: string;
 
1455
  const s15: string; const s16: string; const s17: string; const s18: string);
 
1456
begin
 
1457
  DebugLogger.DebugLn(s1, s2, s3, s4, s5, s6, s7, s8, s9, s10, s11, s12, s13, s14, s15, s16, s17, s18);
 
1458
end;
 
1459
 
 
1460
procedure DebugLnEnter(const s: string);
 
1461
begin
 
1462
  DebugLogger.DebugLnEnter(s);
 
1463
end;
 
1464
 
 
1465
procedure DebugLnEnter(Args: array of const);
 
1466
begin
 
1467
  DebugLogger.DebugLnEnter(Args);
 
1468
end;
 
1469
 
 
1470
procedure DebugLnEnter(s: string; Args: array of const);
 
1471
begin
 
1472
  DebugLogger.DebugLnEnter(s, Args);
 
1473
end;
 
1474
 
 
1475
procedure DebugLnEnter(const s1, s2: string; const s3: string; const s4: string;
 
1476
  const s5: string; const s6: string; const s7: string; const s8: string; const s9: string;
 
1477
  const s10: string; const s11: string; const s12: string; const s13: string;
 
1478
  const s14: string; const s15: string; const s16: string; const s17: string;
 
1479
  const s18: string);
 
1480
begin
 
1481
  DebugLogger.DebugLnEnter(s1, s2, s3, s4, s5, s6, s7, s8, s9, s10, s11, s12, s13, s14, s15, s16, s17, s18);
 
1482
end;
 
1483
 
 
1484
procedure DebugLnExit(const s: string);
 
1485
begin
 
1486
  DebugLogger.DebugLnExit(s);
 
1487
end;
 
1488
 
 
1489
procedure DebugLnExit(Args: array of const);
 
1490
begin
 
1491
  DebugLogger.DebugLnExit(Args);
 
1492
end;
 
1493
 
 
1494
procedure DebugLnExit(s: string; Args: array of const);
 
1495
begin
 
1496
  DebugLogger.DebugLnExit(s, Args);
 
1497
end;
 
1498
 
 
1499
procedure DebugLnExit(const s1, s2: string; const s3: string; const s4: string;
 
1500
  const s5: string; const s6: string; const s7: string; const s8: string; const s9: string;
 
1501
  const s10: string; const s11: string; const s12: string; const s13: string;
 
1502
  const s14: string; const s15: string; const s16: string; const s17: string;
 
1503
  const s18: string);
 
1504
begin
 
1505
  DebugLogger.DebugLnExit(s1, s2, s3, s4, s5, s6, s7, s8, s9, s10, s11, s12, s13, s14, s15, s16, s17, s18);
 
1506
end;
 
1507
 
 
1508
 
 
1509
{$ELSE}
 
1510
 
2055
1511
procedure InitializeDebugOutput;
2056
1512
var
2057
1513
  DebugFileName: string;
2132
1588
  CloseDebugOutput;
2133
1589
end;
2134
1590
 
 
1591
procedure DebugLnNestCreatePrefix;
 
1592
const
 
1593
  CurrentLen: Integer = 0;
 
1594
var
 
1595
  s: String;
 
1596
  NewLen: Integer;
 
1597
begin
 
1598
  NewLen := DebugNestLvl * DebugLnNestLvlIndent;
 
1599
  if NewLen < 0 then NewLen := 0;
 
1600
  if (NewLen >= DebugLnMaxNestPrefixLen) then begin
 
1601
    NewLen := DebugLnMaxNestPrefixLen;
 
1602
    s := IntToStr(DebugNestLvl);
 
1603
    if length(s)+1 > NewLen then
 
1604
      NewLen := length(s)+1;
 
1605
  end else
 
1606
    s := '';
 
1607
 
 
1608
  if NewLen > CurrentLen then
 
1609
    ReAllocMem(DebugNestPrefix, NewLen+21);
 
1610
  CurrentLen := NewLen+20;
 
1611
 
 
1612
  FillChar(DebugNestPrefix^, NewLen, ' ');
 
1613
  if s <> '' then
 
1614
    System.Move(s[1], DebugNestPrefix[0], length(s));
 
1615
 
 
1616
  if (NewLen >= DebugLnMaxNestPrefixLen) then
 
1617
    DebugNestPrefix[DebugLnMaxNestPrefixLen] := #0
 
1618
  else
 
1619
    DebugNestPrefix[NewLen] := #0;
 
1620
end;
 
1621
 
 
1622
procedure DebugLnNestFreePrefix;
 
1623
begin
 
1624
  if DebugNestPrefix <> nil then
 
1625
    ReAllocMem(DebugNestPrefix, 0);
 
1626
end;
 
1627
 
 
1628
procedure DumpStack;
 
1629
begin
 
1630
  if Assigned(DebugText) then
 
1631
    Dump_Stack(DebugText^, get_frame);
 
1632
end;
 
1633
 
2135
1634
procedure DebugLn(Args: array of const);
2136
1635
var
2137
1636
  i: Integer;
2156
1655
    vtChar: DbgOut(Args[i].VChar);
2157
1656
    vtPChar: DbgOut(Args[i].VPChar);
2158
1657
    vtPWideChar: DbgOut(Args[i].VPWideChar);
2159
 
    vtWideChar: DbgOut(Args[i].VWideChar);
2160
 
    vtWidestring: DbgOut(WideString(Args[i].VWideString));
 
1658
    vtWideChar: DbgOut(AnsiString(Args[i].VWideChar));
 
1659
    vtWidestring: DbgOut(AnsiString(WideString(Args[i].VWideString)));
 
1660
    vtUnicodeString: DbgOut(AnsiString(UnicodeString(Args[i].VUnicodeString)));
2161
1661
    vtObject: DbgOut(DbgSName(Args[i].VObject));
2162
1662
    vtClass: DbgOut(DbgSName(Args[i].VClass));
2163
1663
    vtPointer: DbgOut(Dbgs(Args[i].VPointer));
2186
1686
  else
2187
1687
    DbgAppendToFile(ExtractFilePath(ParamStr(0)) + Str_LCL_Debug_File, s);
2188
1688
  {$else}
 
1689
  // First of all verify if a widgetset has override DebugLn
 
1690
  if DebugLnProc <> nil then
 
1691
  begin
 
1692
    DebugLnProc(s);
 
1693
    Exit;
 
1694
  end;
 
1695
 
 
1696
  // Now the default code
2189
1697
  if not Assigned(DebugText) then exit;
2190
1698
  if DebugNestAtBOL and (s <> '') then
2191
1699
    write(DebugText^, DebugNestPrefix);
2274
1782
  DebugLn(s1+s2+s3+s4+s5+s6+s7+s8+s9+s10+s11+s12+s13+s14+s15+s16);
2275
1783
end;
2276
1784
 
2277
 
procedure DebugLnNestCreatePrefix;
2278
 
const
2279
 
  CurrentLen: Integer = 0;
2280
 
var
2281
 
  s: String;
2282
 
  NewLen: Integer;
2283
 
begin
2284
 
  NewLen := DebugNestLvl * DebugLnNestLvlIndent;
2285
 
  if NewLen < 0 then NewLen := 0;
2286
 
  if (NewLen >= DebugLnMaxNestPrefixLen) then begin
2287
 
    NewLen := DebugLnMaxNestPrefixLen;
2288
 
    s := IntToStr(DebugNestLvl);
2289
 
    if length(s)+1 > NewLen then
2290
 
      NewLen := length(s)+1;
2291
 
  end else
2292
 
    s := '';
2293
 
 
2294
 
  if NewLen > CurrentLen then
2295
 
    ReAllocMem(DebugNestPrefix, NewLen+21);
2296
 
  CurrentLen := NewLen+20;
2297
 
 
2298
 
  FillChar(DebugNestPrefix^, NewLen, ' ');
2299
 
  if s <> '' then
2300
 
    System.Move(s[1], DebugNestPrefix[0], length(s));
2301
 
 
2302
 
  if (NewLen >= DebugLnMaxNestPrefixLen) then
2303
 
    DebugNestPrefix[DebugLnMaxNestPrefixLen] := #0
2304
 
  else
2305
 
    DebugNestPrefix[NewLen] := #0;
2306
 
end;
2307
 
 
2308
 
procedure DebugLnNestFreePrefix;
2309
 
begin
2310
 
  if DebugNestPrefix <> nil then
2311
 
    ReAllocMem(DebugNestPrefix, 0);
2312
 
end;
2313
 
 
2314
1785
procedure DebugLnEnter(const s: string);
2315
1786
begin
2316
1787
  if not DebugNestAtBOL then
2379
1850
  DebugLnExit(s1+s2+s3+s4+s5+s6+s7+s8+s9+s10+s11+s12+s13+s14+s15+s16+s17+s18);
2380
1851
end;
2381
1852
 
2382
 
function ConvertLineEndings(const s: string): string;
2383
 
var
2384
 
  i: Integer;
2385
 
  EndingStart: LongInt;
2386
 
begin
2387
 
  Result:=s;
2388
 
  i:=1;
2389
 
  while (i<=length(Result)) do begin
2390
 
    if Result[i] in [#10,#13] then begin
2391
 
      EndingStart:=i;
2392
 
      inc(i);
2393
 
      if (i<=length(Result)) and (Result[i] in [#10,#13])
2394
 
      and (Result[i]<>Result[i-1]) then begin
2395
 
        inc(i);
2396
 
      end;
2397
 
      if (length(LineEnding)<>i-EndingStart)
2398
 
      or (LineEnding<>copy(Result,EndingStart,length(LineEnding))) then begin
2399
 
        // line end differs => replace with current LineEnding
2400
 
        Result:=
2401
 
          copy(Result,1,EndingStart-1)+LineEnding+copy(Result,i,length(Result));
2402
 
        i:=EndingStart+length(LineEnding);
2403
 
      end;
2404
 
    end else
2405
 
      inc(i);
2406
 
  end;
2407
 
end;
2408
 
 
2409
1853
procedure DbgOut(const S: String; Args: array of const);
2410
1854
begin
2411
1855
  DbgOut(Format(S, Args));
2418
1862
    DbgAppendToFileWithoutLn(ExtractFilePath(ParamStr(0)) + Str_LCL_Debug_File, DebugNestPrefix);
2419
1863
  DbgAppendToFileWithoutLn(ExtractFilePath(ParamStr(0)) + Str_LCL_Debug_File, s);
2420
1864
  {$else}
 
1865
  if DebugOutProc <> nil then
 
1866
  begin
 
1867
    DebugOutProc(s);
 
1868
    Exit;
 
1869
  end;
 
1870
 
2421
1871
  if Assigned(DebugText) then begin
2422
1872
    if DebugNestAtBOL and (s <> '') then
2423
1873
      write(DebugText^, DebugNestPrefix);
2477
1927
  DbgOut(s1+s2+s3+s4+s5+s6+s7+s8+s9+s10+s11);
2478
1928
end;
2479
1929
 
2480
 
procedure DbgOut(const s1, s2, s3, s4, s5, s6, s7, s8, s9, s10, s11, s12: string
2481
 
  );
 
1930
procedure DbgOut(const s1, s2, s3, s4, s5, s6, s7, s8, s9, s10, s11, s12: string);
2482
1931
begin
2483
1932
  DbgOut(s1+s2+s3+s4+s5+s6+s7+s8+s9+s10+s11+s12);
2484
1933
end;
 
1934
{$ENDIF}
 
1935
 
 
1936
function ConvertLineEndings(const s: string): string;
 
1937
begin
 
1938
  Result:=LazLogger.ConvertLineEndings(s);
 
1939
end;
2485
1940
 
2486
1941
function DbgS(const c: cardinal): string;
2487
1942
begin
2488
 
  Result:=IntToStr(c);
 
1943
  Result:=LazLogger.DbgS(c);
2489
1944
end;
2490
1945
 
2491
1946
function DbgS(const i: longint): string;
2492
1947
begin
2493
 
  Result:=IntToStr(i);
 
1948
  Result:=LazLogger.DbgS(i);
2494
1949
end;
2495
1950
 
2496
1951
function DbgS(const i: int64): string;
2497
1952
begin
2498
 
  Result:=IntToStr(i);
 
1953
  Result:=LazLogger.DbgS(i);
2499
1954
end;
2500
1955
 
2501
1956
function DbgS(const q: qword): string;
2502
1957
begin
2503
 
  Result:=IntToStr(q);
 
1958
  Result:=LazLogger.DbgS(q);
2504
1959
end;
2505
1960
 
2506
1961
function DbgS(const r: TRect): string;
2507
1962
begin
2508
 
  Result:='l='+IntToStr(r.Left)+',t='+IntToStr(r.Top)
2509
 
         +',r='+IntToStr(r.Right)+',b='+IntToStr(r.Bottom);
 
1963
  Result:=LazLogger.DbgS(r);
2510
1964
end;
2511
1965
 
2512
1966
function DbgS(const p: TPoint): string;
2513
1967
begin
2514
 
  Result:='(x='+IntToStr(p.x)+',y='+IntToStr(p.y)+')';
 
1968
  Result:=LazLogger.DbgS(p);
2515
1969
end;
2516
1970
 
2517
1971
function DbgS(const p: pointer): string;
2518
1972
begin
2519
 
  Result:=HexStr(PtrUInt(p),2*sizeof(PtrInt));
 
1973
  Result:=LazLogger.DbgS(p);
2520
1974
end;
2521
1975
 
2522
1976
function DbgS(const e: extended; MaxDecimals: integer): string;
2523
1977
begin
2524
 
  Result:=copy(FloatToStr(e),1,MaxDecimals);
 
1978
  Result:=LazLogger.DbgS(e,MaxDecimals);
2525
1979
end;
2526
1980
 
2527
1981
function DbgS(const b: boolean): string;
2528
1982
begin
2529
 
  if b then Result:='True' else Result:='False';
 
1983
  Result:=LazLogger.DbgS(b);
2530
1984
end;
2531
1985
 
2532
1986
function DbgS(const s: TComponentState): string;
2533
 
 
2534
 
  procedure Add(const a: string);
2535
 
  begin
2536
 
    if Result<>'' then
2537
 
      Result:=Result+',';
2538
 
    Result:=Result+a;
2539
 
  end;
2540
 
 
2541
1987
begin
2542
 
  Result:='';
2543
 
  if csLoading in s then Add('csLoading');
2544
 
  if csReading in s then Add('csReading');
2545
 
  if csWriting in s then Add('csWriting');
2546
 
  if csDestroying in s then Add('csDestroying');
2547
 
  if csDesigning in s then Add('csDesigning');
2548
 
  if csAncestor in s then Add('csAncestor');
2549
 
  if csUpdating in s then Add('csUpdating');
2550
 
  if csFixups in s then Add('csFixups');
2551
 
  if csFreeNotification in s then Add('csFreeNotification');
2552
 
  if csInline in s then Add('csInline');
2553
 
  if csDesignInstance in s then Add('csDesignInstance');
2554
 
  Result:='['+Result+']';
 
1988
  Result:=LazLogger.DbgS(s);
2555
1989
end;
2556
1990
 
2557
1991
function DbgS(const m: TMethod): string;
2558
 
var
2559
 
  o: TObject;
2560
 
  aMethodName: ShortString;
2561
1992
begin
2562
 
  o:=TObject(m.Data);
2563
 
  Result:=dbgsname(o)+'.'+dbgs(m.Code);
2564
 
  if (o<>nil) and (m.Code<>nil) then begin
2565
 
    aMethodName:=o.MethodName(m.Code);
2566
 
    Result:=Result+'='''+aMethodName+'''';
2567
 
  end;
 
1993
  Result:=LazLogger.DbgS(m);
2568
1994
end;
2569
1995
 
2570
1996
function DbgSName(const p: TObject): string;
2571
1997
begin
2572
 
  if p=nil then
2573
 
    Result:='nil'
2574
 
  else if p is TComponent then
2575
 
    Result:=TComponent(p).Name+':'+p.ClassName
2576
 
  else
2577
 
    Result:=p.ClassName;
 
1998
  Result:=LazLogger.DbgSName(p);
2578
1999
end;
2579
2000
 
2580
2001
function DbgSName(const p: TClass): string;
2581
2002
begin
2582
 
  if p=nil then
2583
 
    Result:='nil'
2584
 
  else
2585
 
    Result:=p.ClassName;
 
2003
  Result:=LazLogger.DbgSName(p);
2586
2004
end;
2587
2005
 
2588
2006
function DbgStr(const StringWithSpecialChars: string): string;
2589
 
var
2590
 
  i: Integer;
2591
 
  s: String;
2592
2007
begin
2593
 
  Result:=StringWithSpecialChars;
2594
 
  i:=1;
2595
 
  while (i<=length(Result)) do begin
2596
 
    case Result[i] of
2597
 
    ' '..#126: inc(i);
2598
 
    else
2599
 
      s:='#'+HexStr(ord(Result[i]),2);
2600
 
      Result:=copy(Result,1,i-1)+s+copy(Result,i+1,length(Result)-i);
2601
 
      inc(i,length(s));
2602
 
    end;
2603
 
  end;
 
2008
  Result:=LazLogger.DbgStr(StringWithSpecialChars);
2604
2009
end;
2605
2010
 
2606
2011
function DbgWideStr(const StringWithSpecialChars: widestring): string;
2607
 
var
2608
 
  s: String;
2609
 
  SrcPos: Integer;
2610
 
  DestPos: Integer;
2611
 
  i: Integer;
2612
2012
begin
2613
 
  SetLength(Result,length(StringWithSpecialChars));
2614
 
  SrcPos:=1;
2615
 
  DestPos:=1;
2616
 
  while SrcPos<=length(StringWithSpecialChars) do begin
2617
 
    i:=ord(StringWithSpecialChars[SrcPos]);
2618
 
    case i of
2619
 
    32..126:
2620
 
      begin
2621
 
        Result[DestPos]:=chr(i);
2622
 
        inc(SrcPos);
2623
 
        inc(DestPos);
2624
 
      end;
2625
 
    else
2626
 
      s:='#'+HexStr(i,4);
2627
 
      inc(SrcPos);
2628
 
      Result:=copy(Result,1,DestPos-1)+s+copy(Result,DestPos+1,length(Result));
2629
 
      inc(DestPos,length(s));
2630
 
    end;
2631
 
  end;
 
2013
  Result:=LazLogger.DbgWideStr(StringWithSpecialChars);
2632
2014
end;
2633
2015
 
2634
2016
function dbgMemRange(P: PByte; Count: integer; Width: integer): string;
2635
 
const
2636
 
  HexChars: array[0..15] of char = '0123456789ABCDEF';
2637
 
  LineEnd: shortstring = LineEnding;
2638
 
var
2639
 
  i: Integer;
2640
 
  NewLen: Integer;
2641
 
  Dest: PChar;
2642
 
  Col: Integer;
2643
 
  j: Integer;
2644
2017
begin
2645
 
  Result:='';
2646
 
  if (p=nil) or (Count<=0) then exit;
2647
 
  NewLen:=Count*2;
2648
 
  if Width>0 then begin
2649
 
    inc(NewLen,(Count div Width)*length(LineEnd));
2650
 
  end;
2651
 
  SetLength(Result,NewLen);
2652
 
  Dest:=PChar(Result);
2653
 
  Col:=1;
2654
 
  for i:=0 to Count-1 do begin
2655
 
    Dest^:=HexChars[PByte(P)[i] shr 4];
2656
 
    inc(Dest);
2657
 
    Dest^:=HexChars[PByte(P)[i] and $f];
2658
 
    inc(Dest);
2659
 
    inc(Col);
2660
 
    if (Width>0) and (Col>Width) then begin
2661
 
      Col:=1;
2662
 
      for j:=1 to length(LineEnd) do begin
2663
 
        Dest^:=LineEnd[j];
2664
 
        inc(Dest);
2665
 
      end;
2666
 
    end;
2667
 
  end;
 
2018
  Result:=LazLogger.dbgMemRange(P,Count,Width);
2668
2019
end;
2669
2020
 
2670
2021
function dbgMemStream(MemStream: TCustomMemoryStream; Count: integer): string;
2671
 
var
2672
 
  s: string;
2673
2022
begin
2674
 
  Result:='';
2675
 
  if (MemStream=nil) or (not (MemStream is TCustomMemoryStream)) or (Count<=0)
2676
 
  then exit;
2677
 
  Count:=Min(Count,MemStream.Size);
2678
 
  if Count<=0 then exit;
2679
 
  SetLength(s,Count);
2680
 
  Count:=MemStream.Read(s[1],Count);
2681
 
  Result:=dbgMemRange(PByte(s),Count);
 
2023
  Result:=LazLogger.dbgMemStream(MemStream,Count);
2682
2024
end;
2683
2025
 
2684
2026
function dbgObjMem(AnObject: TObject): string;
2685
2027
begin
2686
 
  Result:='';
2687
 
  if AnObject=nil then exit;
2688
 
  Result:=dbgMemRange(PByte(AnObject),AnObject.InstanceSize);
 
2028
  Result:=LazLogger.dbgObjMem(AnObject);
2689
2029
end;
2690
2030
 
2691
2031
function dbghex(i: Int64): string;
2692
 
const
2693
 
  Hex = '0123456789ABCDEF';
2694
 
var
2695
 
  Negated: Boolean;
2696
2032
begin
2697
 
  Result:='';
2698
 
  if i<0 then begin
2699
 
    Negated:=true;
2700
 
    i:=-i;
2701
 
  end else
2702
 
    Negated:=false;
2703
 
  repeat
2704
 
    Result:=Hex[(i mod 16)+1]+Result;
2705
 
    i:=i div 16;
2706
 
  until i=0;
2707
 
  if Negated then
2708
 
    Result:='-'+Result;
 
2033
  Result:=LazLogger.dbghex(i);
2709
2034
end;
2710
2035
 
2711
2036
function DbgSWindowPosFlags(Flags: UInt): String;
2747
2072
 
2748
2073
function DbgS(const i1, i2, i3, i4: integer): string;
2749
2074
begin
2750
 
  Result:=dbgs(i1)+','+dbgs(i2)+','+dbgs(i3)+','+dbgs(i4);
 
2075
  Result:=LazLogger.DbgS(i1,i2,i3,i4);
2751
2076
end;
2752
2077
 
2753
2078
function DbgS(const Shift: TShiftState): string;
2754
 
 
2755
 
  procedure Add(const s: string);
2756
 
  begin
2757
 
    if Result<>'' then Result:=Result+',';
2758
 
    Result:=Result+s;
2759
 
  end;
2760
 
 
2761
2079
begin
2762
 
  Result:='';
2763
 
  if ssShift in Shift then Add('ssShift');
2764
 
  if ssAlt in Shift then Add('ssAlt');
2765
 
  if ssCtrl in Shift then Add('ssCtrl');
2766
 
  if ssLeft in Shift then Add('ssLeft');
2767
 
  if ssRight in Shift then Add('ssRight');
2768
 
  if ssMiddle in Shift then Add('ssMiddle');
2769
 
  if ssDouble in Shift then Add('ssDouble');
2770
 
  if ssMeta in Shift then Add('ssMeta');
2771
 
  if ssSuper in Shift then Add('ssSuper');
2772
 
  if ssHyper in Shift then Add('ssHyper');
2773
 
  if ssAltGr in Shift then Add('ssAltGr');
2774
 
  if ssCaps in Shift then Add('ssCaps');
2775
 
  if ssNum in Shift then Add('ssNum');
2776
 
  if ssScroll in Shift then Add('ssScroll');
2777
 
  if ssTriple in Shift then Add('ssTriple');
2778
 
  if ssQuad in Shift then Add('ssQuad');
2779
 
  Result:='['+Result+']';
 
2080
  Result:=LazLogger.DbgS(Shift);
2780
2081
end;
2781
2082
 
2782
2083
function DbgsVKCode(c: word): string;
2934
2235
  VK_LAUNCH_MEDIA_SELECT: Result:='VK_LAUNCH_MEDIA_SELECT';
2935
2236
  VK_LAUNCH_APP1: Result:='VK_LAUNCH_APP1';
2936
2237
  VK_LAUNCH_APP2: Result:='VK_LAUNCH_APP2';
 
2238
  // New keys in 0.9.31+
 
2239
  VK_LCL_EQUAL: Result:='VK_LCL_EQUAL';
 
2240
  VK_LCL_COMMA: Result:='VK_LCL_COMMA';
 
2241
  VK_LCL_POINT: Result:='VK_LCL_POINT';
 
2242
  VK_LCL_SLASH: Result:='VK_LCL_SLASH';
 
2243
  VK_LCL_SEMI_COMMA:Result:='VK_LCL_SEMI_COMMA';
 
2244
  VK_LCL_MINUS     :Result:='VK_LCL_MINUS';
 
2245
  VK_LCL_OPEN_BRAKET:Result:='VK_LCL_OPEN_BRAKET';
 
2246
  VK_LCL_CLOSE_BRAKET:Result:='VK_LCL_CLOSE_BRAKET';
 
2247
  VK_LCL_BACKSLASH :Result:='VK_LCL_BACKSLASH';
 
2248
  VK_LCL_TILDE     :Result:='VK_LCL_TILDE';
 
2249
  VK_LCL_QUOTE     :Result:='VK_LCL_QUOTE';
 
2250
  //
 
2251
  VK_LCL_POWER: Result:='VK_LCL_POWER';
 
2252
  VK_LCL_CALL: Result:='VK_LCL_CALL';
 
2253
  VK_LCL_ENDCALL: Result:='VK_LCL_ENDCALL';
 
2254
  VK_LCL_AT: Result:='VK_LCL_AT';
2937
2255
  else
2938
2256
    Result:='VK_('+dbgs(c)+')';
2939
2257
  end;
2941
2259
 
2942
2260
function DbgS(const ASize: TSize): string;
2943
2261
begin
2944
 
   Result := 'cx: ' + DbgS(ASize.cx) + ' cy: ' + DbgS(ASize.cy);
 
2262
  Result:=LazLogger.DbgS(ASize);
2945
2263
end;
2946
2264
 
2947
2265
function DbgS(const ATM: TTextMetric): string;
3037
2355
    vtAnsiString: s:=s+AnsiString(Args[i].VAnsiString);
3038
2356
    vtChar: s:=s+Args[i].VChar;
3039
2357
    vtPChar: s:=s+Args[i].VPChar;
3040
 
    vtPWideChar: s:=s+Args[i].VPWideChar;
3041
 
    vtWideChar: s:=s+Args[i].VWideChar;
3042
 
    vtWidestring: s:=s+WideString(Args[i].VWideString);
 
2358
    vtPWideChar: s:=AnsiString(WideString(s)+Args[i].VPWideChar);
 
2359
    vtWideChar: s:=AnsiString(WideString(s)+Args[i].VWideChar);
 
2360
    vtWidestring: s:=AnsiString(WideString(s)+WideString(Args[i].VWideString));
 
2361
{$IF FPC_FULLVERSION>=20701}
 
2362
    vtUnicodeString: s:=AnsiString(UnicodeString(s)+UnicodeString(Args[i].VUnicodeString));
 
2363
{$endif}
3043
2364
    vtObject: s:=s+DbgSName(Args[i].VObject);
3044
2365
    vtClass: s:=s+DbgSName(Args[i].VClass);
3045
2366
    vtPointer: s:=s+Dbgs(Args[i].VPointer);
3225
2546
  Result := str;
3226
2547
end;
3227
2548
 
 
2549
function SwapCase(Const S: String): String;
 
2550
// Inverts the character case. Like LowerCase and UpperCase combined.
 
2551
var
 
2552
  i : Integer;
 
2553
  P : PChar;
 
2554
begin
 
2555
  Result := S;
 
2556
  if not assigned(pointer(result)) then exit;
 
2557
  UniqueString(Result);
 
2558
  P:=Pchar(pointer(Result));
 
2559
  for i := 1 to Length(Result) do begin
 
2560
    if (P^ in ['a'..'z']) then
 
2561
      P^ := char(byte(p^) - 32)
 
2562
    else if (P^ in ['A'..'Z']) then
 
2563
      P^ := char(byte(p^) + 32);
 
2564
    Inc(P);
 
2565
  end;
 
2566
end;
 
2567
 
3228
2568
function StringCase(const AString: String; const ACase: array of String {; const AIgnoreCase = False, APartial = false: Boolean}): Integer;
3229
2569
begin
3230
2570
  Result := StringCase(AString, ACase, False, False);
3278
2618
 
3279
2619
function UTF8CharacterLength(p: PChar): integer;
3280
2620
begin
3281
 
  if p<>nil then begin
3282
 
    if ord(p^)<%11000000 then begin
3283
 
      // regular single byte character (#0 is a character, this is pascal ;)
3284
 
      Result:=1;
3285
 
    end
3286
 
    else if ((ord(p^) and %11100000) = %11000000) then begin
3287
 
      // could be 2 byte character
3288
 
      if (ord(p[1]) and %11000000) = %10000000 then
3289
 
        Result:=2
3290
 
      else
3291
 
        Result:=1;
3292
 
    end
3293
 
    else if ((ord(p^) and %11110000) = %11100000) then begin
3294
 
      // could be 3 byte character
3295
 
      if ((ord(p[1]) and %11000000) = %10000000)
3296
 
      and ((ord(p[2]) and %11000000) = %10000000) then
3297
 
        Result:=3
3298
 
      else
3299
 
        Result:=1;
3300
 
    end
3301
 
    else if ((ord(p^) and %11111000) = %11110000) then begin
3302
 
      // could be 4 byte character
3303
 
      if ((ord(p[1]) and %11000000) = %10000000)
3304
 
      and ((ord(p[2]) and %11000000) = %10000000)
3305
 
      and ((ord(p[3]) and %11000000) = %10000000) then
3306
 
        Result:=4
3307
 
      else
3308
 
        Result:=1;
3309
 
    end
3310
 
    else
3311
 
      Result:=1
3312
 
  end else
3313
 
    Result:=0;
 
2621
  Result := LazUTF8.UTF8CharacterLength(p);
3314
2622
end;
3315
2623
 
3316
2624
function UTF8Length(const s: string): PtrInt;
3319
2627
end;
3320
2628
 
3321
2629
function UTF8Length(p: PChar; ByteCount: PtrInt): PtrInt;
3322
 
var
3323
 
  CharLen: LongInt;
3324
2630
begin
3325
 
  Result:=0;
3326
 
  while (ByteCount>0) do begin
3327
 
    inc(Result);
3328
 
    CharLen:=UTF8CharacterLength(p);
3329
 
    inc(p,CharLen);
3330
 
    dec(ByteCount,CharLen);
3331
 
  end;
 
2631
  Result := LazUTF8.UTF8Length(p, ByteCount);
3332
2632
end;
3333
2633
 
3334
2634
function UTF8CharacterToUnicode(p: PChar; out CharLen: integer): Cardinal;
3335
2635
begin
3336
 
  if p<>nil then begin
3337
 
    if ord(p^)<%11000000 then begin
3338
 
      // regular single byte character (#0 is a normal char, this is pascal ;)
3339
 
      Result:=ord(p^);
3340
 
      CharLen:=1;
3341
 
    end
3342
 
    else if ((ord(p^) and %11100000) = %11000000) then begin
3343
 
      // could be double byte character
3344
 
      if (ord(p[1]) and %11000000) = %10000000 then begin
3345
 
        Result:=((ord(p^) and %00011111) shl 6)
3346
 
                or (ord(p[1]) and %00111111);
3347
 
        CharLen:=2;
3348
 
      end else begin
3349
 
        Result:=ord(p^);
3350
 
        CharLen:=1;
3351
 
      end;
3352
 
    end
3353
 
    else if ((ord(p^) and %11110000) = %11100000) then begin
3354
 
      // could be triple byte character
3355
 
      if ((ord(p[1]) and %11000000) = %10000000)
3356
 
      and ((ord(p[2]) and %11000000) = %10000000) then begin
3357
 
        Result:=((ord(p^) and %00011111) shl 12)
3358
 
                or ((ord(p[1]) and %00111111) shl 6)
3359
 
                or (ord(p[2]) and %00111111);
3360
 
        CharLen:=3;
3361
 
      end else begin
3362
 
        Result:=ord(p^);
3363
 
        CharLen:=1;
3364
 
      end;
3365
 
    end
3366
 
    else if ((ord(p^) and %11111000) = %11110000) then begin
3367
 
      // could be 4 byte character
3368
 
      if ((ord(p[1]) and %11000000) = %10000000)
3369
 
      and ((ord(p[2]) and %11000000) = %10000000)
3370
 
      and ((ord(p[3]) and %11000000) = %10000000) then begin
3371
 
        Result:=((ord(p^) and %00001111) shl 18)
3372
 
                or ((ord(p[1]) and %00111111) shl 12)
3373
 
                or ((ord(p[2]) and %00111111) shl 6)
3374
 
                or (ord(p[3]) and %00111111);
3375
 
        CharLen:=4;
3376
 
      end else begin
3377
 
        Result:=ord(p^);
3378
 
        CharLen:=1;
3379
 
      end;
3380
 
    end
3381
 
    else begin
3382
 
      // invalid character
3383
 
      Result:=ord(p^);
3384
 
      CharLen:=1;
3385
 
    end;
3386
 
  end else begin
3387
 
    Result:=0;
3388
 
    CharLen:=0;
3389
 
  end;
 
2636
  Result := LazUTF8.UTF8CharacterToUnicode(p, CharLen);
3390
2637
end;
3391
2638
 
3392
2639
function UnicodeToUTF8(u: cardinal; Buf: PChar): integer;
3393
 
 
3394
 
  procedure RaiseInvalidUnicode;
3395
 
  begin
3396
 
    raise Exception.Create('UnicodeToUTF8: invalid unicode: '+IntToStr(u));
3397
 
  end;
3398
 
 
3399
2640
begin
3400
 
  Result:=UnicodeToUTF8SkipErrors(u,Buf);
3401
 
  if Result=0 then
3402
 
    RaiseInvalidUnicode;
 
2641
  Result := LazUTF8.UnicodeToUTF8(u, Buf);
3403
2642
end;
3404
2643
 
3405
2644
function UnicodeToUTF8SkipErrors(u: cardinal; Buf: PChar): integer;
3406
2645
begin
3407
 
  case u of
3408
 
    0..$7f:
3409
 
      begin
3410
 
        Result:=1;
3411
 
        Buf[0]:=char(byte(u));
3412
 
      end;
3413
 
    $80..$7ff:
3414
 
      begin
3415
 
        Result:=2;
3416
 
        Buf[0]:=char(byte($c0 or (u shr 6)));
3417
 
        Buf[1]:=char(byte($80 or (u and $3f)));
3418
 
      end;
3419
 
    $800..$ffff:
3420
 
      begin
3421
 
        Result:=3;
3422
 
        Buf[0]:=char(byte($e0 or (u shr 12)));
3423
 
        Buf[1]:=char(byte((u shr 6) and $3f) or $80);
3424
 
        Buf[2]:=char(byte(u and $3f) or $80);
3425
 
      end;
3426
 
    $10000..$10ffff:
3427
 
      begin
3428
 
        Result:=4;
3429
 
        Buf[0]:=char(byte($f0 or (u shr 18)));
3430
 
        Buf[1]:=char(byte((u shr 12) and $3f) or $80);
3431
 
        Buf[2]:=char(byte((u shr 6) and $3f) or $80);
3432
 
        Buf[3]:=char(byte(u and $3f) or $80);
3433
 
      end;
3434
 
  else
3435
 
    Result:=0;
3436
 
  end;
 
2646
  Result := LazUTF8.UnicodeToUTF8SkipErrors(u, Buf);
3437
2647
end;
3438
2648
 
3439
2649
function UnicodeToUTF8(u: cardinal): shortstring;
3442
2652
end;
3443
2653
 
3444
2654
function UTF8ToDoubleByteString(const s: string): string;
3445
 
var
3446
 
  Len: Integer;
3447
2655
begin
3448
 
  Len:=UTF8Length(s);
3449
 
  SetLength(Result,Len*2);
3450
 
  if Len=0 then exit;
3451
 
  UTF8ToDoubleByte(PChar(s),length(s),PByte(Result));
 
2656
  Result := LazUTF8.UTF8ToDoubleByteString(s);
3452
2657
end;
3453
2658
 
3454
2659
{ returns number of double bytes }
3455
2660
function UTF8ToDoubleByte(UTF8Str: PChar; Len: PtrInt; DBStr: PByte): PtrInt;
3456
 
var
3457
 
  SrcPos: PChar;
3458
 
  CharLen: LongInt;
3459
 
  DestPos: PByte;
3460
 
  u: Cardinal;
3461
2661
begin
3462
 
  SrcPos:=UTF8Str;
3463
 
  DestPos:=DBStr;
3464
 
  Result:=0;
3465
 
  while Len>0 do begin
3466
 
    u:=UTF8CharacterToUnicode(SrcPos,CharLen);
3467
 
    DestPos^:=byte((u shr 8) and $ff);
3468
 
    inc(DestPos);
3469
 
    DestPos^:=byte(u and $ff);
3470
 
    inc(DestPos);
3471
 
    inc(SrcPos,CharLen);
3472
 
    dec(Len,CharLen);
3473
 
    inc(Result);
3474
 
  end;
 
2662
  Result := LazUTF8.UTF8ToDoubleByte(UTF8Str, Len, DBStr);
3475
2663
end;
3476
2664
 
3477
2665
{ Find the start of the UTF8 character which contains BytePos,
3479
2667
function UTF8FindNearestCharStart(UTF8Str: PChar; Len: integer;
3480
2668
  BytePos: integer): integer;
3481
2669
begin
3482
 
  Result:=0;
3483
 
  if (UTF8Str<>nil) and (Len>0) and (BytePos>=0) then begin
3484
 
    Result:=BytePos;
3485
 
    if Result>Len then Result:=Len-1;
3486
 
    if (Result>0) and (ord(UTF8Str[Result]) and %11000000=%10000000) then begin
3487
 
      dec(Result);
3488
 
      if (Result>0) and (ord(UTF8Str[Result]) and %11000000=%10000000) then begin
3489
 
        dec(Result);
3490
 
        if (Result>0) and (ord(UTF8Str[Result]) and %11000000=%10000000) then begin
3491
 
          dec(Result);
3492
 
          // should be four byte character
3493
 
          if (ord(UTF8Str[Result]) and %11111000<>%11110000) then begin
3494
 
            // broken UTF8 character
3495
 
            inc(Result,3);
3496
 
          end else begin
3497
 
            // is four byte character
3498
 
          end;
3499
 
        end else if (ord(UTF8Str[Result]) and %11110000<>%11100000) then begin
3500
 
          // broken UTF8 character, should be three byte
3501
 
          inc(Result,2);
3502
 
        end else
3503
 
        begin
3504
 
          // is three byte character
3505
 
        end;
3506
 
      end else if (ord(UTF8Str[Result]) and %11100000<>%11000000) then begin
3507
 
        // broken UTF8 character, should be two byte
3508
 
        inc(Result);
3509
 
      end else
3510
 
      begin
3511
 
        // is two byte character
3512
 
      end;
3513
 
    end;
3514
 
  end;
 
2670
  Result := LazUTF8.UTF8FindNearestCharStart(UTF8Str, Len, BytePos);
3515
2671
end;
3516
2672
 
3517
2673
{ Len is the length in bytes of UTF8Str
3520
2676
  This function is similar to UTF8FindNearestCharStart
3521
2677
}
3522
2678
function UTF8CharStart(UTF8Str: PChar; Len, CharIndex: PtrInt): PChar;
3523
 
var
3524
 
  CharLen: LongInt;
3525
2679
begin
3526
 
  Result:=UTF8Str;
3527
 
  if Result<>nil then begin
3528
 
    while (CharIndex>0) and (Len>0) do begin
3529
 
      CharLen:=UTF8CharacterLength(Result);
3530
 
      dec(Len,CharLen);
3531
 
      dec(CharIndex);
3532
 
      inc(Result,CharLen);
3533
 
    end;
3534
 
    if (CharIndex>0) or (Len<0) then
3535
 
      Result:=nil;
3536
 
  end;
 
2680
  Result := LazUTF8.UTF8CharStart(UTF8Str, Len, CharIndex);
3537
2681
end;
3538
2682
 
3539
2683
function UTF8CharToByteIndex(UTF8Str: PChar; Len, CharIndex: PtrInt): PtrInt;
3540
 
var
3541
 
  p: PChar;
3542
2684
begin
3543
 
  p := UTF8CharStart(UTF8Str, Len, CharIndex);
3544
 
  if p = nil
3545
 
  then Result := -1
3546
 
  else Result := p - UTF8Str;
 
2685
  Result := LazUTF8.UTF8CharToByteIndex(UTF8Str, Len, CharIndex);
3547
2686
end;
3548
2687
 
3549
2688
{ fix any broken UTF8 sequences with spaces }
3550
2689
procedure UTF8FixBroken(P: PChar);
3551
2690
begin
3552
 
  if p=nil then exit;
3553
 
  while p^<>#0 do begin
3554
 
    if ord(p^)<%10000000 then begin
3555
 
      // regular single byte character
3556
 
      inc(p);
3557
 
    end
3558
 
    else if ord(p^)<%11000000 then begin
3559
 
      // invalid
3560
 
      p^:=' ';
3561
 
      inc(p);
3562
 
    end
3563
 
    else if ((ord(p^) and %11100000) = %11000000) then begin
3564
 
      // should be 2 byte character
3565
 
      if (ord(p[1]) and %11000000) = %10000000 then
3566
 
        inc(p,2)
3567
 
      else if p[1]<>#0 then
3568
 
        p^:=' ';
3569
 
    end
3570
 
    else if ((ord(p^) and %11110000) = %11100000) then begin
3571
 
      // should be 3 byte character
3572
 
      if ((ord(p[1]) and %11000000) = %10000000)
3573
 
      and ((ord(p[2]) and %11000000) = %10000000) then
3574
 
        inc(p,3)
3575
 
      else
3576
 
        p^:=' ';
3577
 
    end
3578
 
    else if ((ord(p^) and %11111000) = %11110000) then begin
3579
 
      // should be 4 byte character
3580
 
      if ((ord(p[1]) and %11000000) = %10000000)
3581
 
      and ((ord(p[2]) and %11000000) = %10000000)
3582
 
      and ((ord(p[3]) and %11000000) = %10000000) then
3583
 
        inc(p,4)
3584
 
      else
3585
 
        p^:=' ';
3586
 
    end
3587
 
    else begin
3588
 
      p^:=' ';
3589
 
      inc(p);
3590
 
    end;
3591
 
  end;
 
2691
  LazUTF8.UTF8FixBroken(P);
3592
2692
end;
3593
2693
 
3594
2694
function UTF8CharacterStrictLength(P: PChar): integer;
3595
2695
begin
3596
 
  if p=nil then exit(0);
3597
 
  if ord(p^)<%10000000 then begin
3598
 
    // regular single byte character
3599
 
    exit(1);
3600
 
  end
3601
 
  else if ord(p^)<%11000000 then begin
3602
 
    // invalid single byte character
3603
 
    exit(0);
3604
 
  end
3605
 
  else if ((ord(p^) and %11100000) = %11000000) then begin
3606
 
    // should be 2 byte character
3607
 
    if (ord(p[1]) and %11000000) = %10000000 then
3608
 
      exit(2)
3609
 
    else
3610
 
      exit(0);
3611
 
  end
3612
 
  else if ((ord(p^) and %11110000) = %11100000) then begin
3613
 
    // should be 3 byte character
3614
 
    if ((ord(p[1]) and %11000000) = %10000000)
3615
 
    and ((ord(p[2]) and %11000000) = %10000000) then
3616
 
      exit(3)
3617
 
    else
3618
 
      exit(0);
3619
 
  end
3620
 
  else if ((ord(p^) and %11111000) = %11110000) then begin
3621
 
    // should be 4 byte character
3622
 
    if ((ord(p[1]) and %11000000) = %10000000)
3623
 
    and ((ord(p[2]) and %11000000) = %10000000)
3624
 
    and ((ord(p[3]) and %11000000) = %10000000) then
3625
 
      exit(4)
3626
 
    else
3627
 
      exit(0);
3628
 
  end else
3629
 
    exit(0);
 
2696
  Result := LazUTF8.UTF8CharacterStrictLength(P);
3630
2697
end;
3631
2698
 
3632
2699
function UTF8CStringToUTF8String(SourceStart: PChar; SourceLen: PtrInt) : string;
3633
 
var
3634
 
  Source: PChar;
3635
 
  Dest: PChar;
3636
 
  SourceEnd: PChar;
3637
 
  CharLen: integer;
3638
 
  SourceCopied: PChar;
3639
 
 
3640
 
  // Copies from SourceStart till Source to Dest and updates Dest
3641
 
  procedure CopyPart; inline;
3642
 
  var
3643
 
    CopyLength: SizeInt;
3644
 
  begin
3645
 
    CopyLength := Source - SourceCopied;
3646
 
    if CopyLength=0 then exit;
3647
 
    System.move(SourceCopied^ , Dest^, CopyLength);
3648
 
    SourceCopied:=Source;
3649
 
    inc(Dest, CopyLength);
3650
 
  end;
3651
 
 
3652
2700
begin
3653
 
  SetLength(Result, SourceLen);
3654
 
  if SourceLen=0 then exit;
3655
 
  SourceCopied:=SourceStart;
3656
 
  Source:=SourceStart;
3657
 
  Dest:=PChar(Result);
3658
 
  SourceEnd := Source + SourceLen;
3659
 
  while Source<SourceEnd do begin
3660
 
    CharLen := UTF8CharacterLength(Source);
3661
 
    if (CharLen=1) and (Source^='\') then begin
3662
 
      CopyPart;
3663
 
      inc(Source);
3664
 
      if Source^ in ['t', 'n', '"', '\'] then begin
3665
 
        case Source^ of
3666
 
         't' : Dest^ := #9;
3667
 
         '"' : Dest^ := '"';
3668
 
         '\' : Dest^ := '\';
3669
 
         'n' :
3670
 
         // fpc 2.1.1 stores string constants as array of char so maybe this
3671
 
         // will work for without ifdef (once available in 2.0.x too):
3672
 
         // move(lineending, dest^, sizeof(LineEnding));
3673
 
{$IFDEF WINDOWS}
3674
 
               begin
3675
 
                 move(lineending[1], dest^, length(LineEnding));
3676
 
                 inc(dest, length(LineEnding)-1);
3677
 
               end;
3678
 
{$ELSE}
3679
 
               Dest^ := LineEnding;
3680
 
{$ENDIF}
3681
 
        end;
3682
 
        inc(Source);
3683
 
        inc(Dest);
3684
 
      end;
3685
 
      SourceCopied := Source;
3686
 
    end
3687
 
    else
3688
 
      Inc(Source, CharLen);
3689
 
  end;
3690
 
  CopyPart;
3691
 
  SetLength(Result, Dest - PChar(Result));
 
2701
  Result := LazUTF8.UTF8CStringToUTF8String(SourceStart, SourceLen);
3692
2702
end;
3693
2703
 
3694
2704
function UTF8Pos(const SearchForText, SearchInText: string): PtrInt;
3695
 
// returns the character index, where the SearchForText starts in SearchInText
3696
 
var
3697
 
  p: LongInt;
3698
2705
begin
3699
 
  p:=System.Pos(SearchForText,SearchInText);
3700
 
  if p>0 then
3701
 
    Result:=UTF8Length(PChar(SearchInText),p-1)+1
3702
 
  else
3703
 
    Result:=0;
 
2706
  Result := LazUTF8.UTF8Pos(SearchForText, SearchInText);
3704
2707
end;
3705
2708
 
3706
2709
function UTF8Copy(const s: string; StartCharIndex, CharCount: PtrInt): string;
3707
 
// returns substring
3708
 
var
3709
 
  StartBytePos: PChar;
3710
 
  EndBytePos: PChar;
3711
 
  MaxBytes: PtrInt;
3712
2710
begin
3713
 
  StartBytePos:=UTF8CharStart(PChar(s),length(s),StartCharIndex-1);
3714
 
  if StartBytePos=nil then
3715
 
    Result:=''
3716
 
  else begin
3717
 
    MaxBytes:=PtrInt(PChar(s)+length(s)-StartBytePos);
3718
 
    EndBytePos:=UTF8CharStart(StartBytePos,MaxBytes,CharCount);
3719
 
    if EndBytePos=nil then
3720
 
      Result:=copy(s,StartBytePos-PChar(s)+1,MaxBytes)
3721
 
    else
3722
 
      Result:=copy(s,StartBytePos-PChar(s)+1,EndBytePos-StartBytePos);
3723
 
  end;
 
2711
  Result := LazUTF8.UTF8Copy(s, StartCharIndex, CharCount);
3724
2712
end;
3725
2713
 
3726
2714
procedure UTF8Delete(var s: String; StartCharIndex, CharCount: PtrInt);
3727
 
var
3728
 
  StartBytePos: PChar;
3729
 
  EndBytePos: PChar;
3730
 
  MaxBytes: PtrInt;
3731
2715
begin
3732
 
  StartBytePos:=UTF8CharStart(PChar(s),length(s),StartCharIndex-1);
3733
 
  if StartBytePos <> nil then
3734
 
  begin
3735
 
    MaxBytes:=PtrInt(PChar(s)+length(s)-StartBytePos);
3736
 
    EndBytePos:=UTF8CharStart(StartBytePos,MaxBytes,CharCount);
3737
 
    if EndBytePos=nil then
3738
 
      Delete(s,StartBytePos-PChar(s)+1,MaxBytes)
3739
 
    else
3740
 
      Delete(s,StartBytePos-PChar(s)+1,EndBytePos-StartBytePos);
3741
 
  end;
 
2716
  LazUTF8.UTF8Delete(s, StartCharIndex, CharCount);
3742
2717
end;
3743
2718
 
3744
2719
procedure UTF8Insert(const source: String; var s: string; StartCharIndex: PtrInt);
3745
 
var
3746
 
  StartBytePos: PChar;
3747
2720
begin
3748
 
  StartBytePos:=UTF8CharStart(PChar(s),length(s),StartCharIndex-1);
3749
 
  if StartBytePos <> nil then
3750
 
    Insert(source, s, StartBytePos-PChar(s)+1);
 
2721
  LazUTF8.UTF8Insert(source, s, StartCharIndex);
3751
2722
end;
3752
2723
 
3753
2724
function UTF8LowerCase(const s: String): String;
3754
2725
begin
3755
 
  Result := UTF8Encode(WideLowerCase(UTF8Decode(s)));
 
2726
  Result := LazUTF8.UTF8LowerCase(S);
3756
2727
end;
3757
2728
 
3758
2729
function UTF8UpperCase(const s: String): String;
3759
2730
begin
3760
 
  Result := UTF8Encode(WideUpperCase(UTF8Decode(s)));
3761
 
end;
3762
 
 
3763
 
{$ifdef NewLowerCase}
3764
 
function UnicodeLowercase(u: cardinal): cardinal;
3765
 
begin
3766
 
  if u<$00C0 then begin
3767
 
    // most common
3768
 
    if (u>=$0041) and (u<=$0061) then
3769
 
      Result:=u+32
3770
 
    else
3771
 
      Result:=u;
3772
 
  end else
3773
 
    case u of
3774
 
    $00C0..$00DE: Result:=UnicodeLower00C0_00DE[u];
3775
 
    $0100..$024E: Result:=UnicodeLower0100_024E[u];
3776
 
    $0386..$03AB: Result:=UnicodeLower0386_03AB[u];
3777
 
    $03D8..$042F: Result:=UnicodeLower03D8_042F[u];
3778
 
    $0460..$0512: Result:=UnicodeLower0460_0512[u];
3779
 
    $0531..$0556: Result:=u+48;
3780
 
    $10A0..$10C5: Result:=u+7264;
3781
 
    $1E00..$1FFC: Result:=UnicodeLower1E00_1FFC[u];
3782
 
    $2126..$2183: Result:=UnicodeLower2126_2183[u];
3783
 
    $24B6..$24CF: Result:=u+26;
3784
 
    $2C00..$2C2E: Result:=u+48;
3785
 
    $2C60..$2CE2: Result:=UnicodeLower2C60_2CE2[u];
3786
 
    $FF21..$FF3A: Result:=u+32;
3787
 
    else          Result:=u;
3788
 
  end;
3789
 
end;
3790
 
 
3791
 
function UTF8LowercaseDynLength(const s: string): string;
3792
 
var
3793
 
  Buf: shortstring;
3794
 
  SrcPos: PtrInt;
3795
 
  DstPos: PtrInt;
3796
 
  CharLen: integer;
3797
 
  OldCode: LongWord;
3798
 
  NewCode: LongWord;
3799
 
begin
3800
 
  // first compute needed length
3801
 
  SrcPos:=1;
3802
 
  DstPos:=1;
3803
 
  while SrcPos<=length(s) do begin
3804
 
    case s[SrcPos] of
3805
 
    #192..#240:
3806
 
      begin
3807
 
        OldCode:=UTF8CharacterToUnicode(@s[SrcPos],CharLen);
3808
 
        NewCode:=UnicodeLowercase(OldCode);
3809
 
        if NewCode=OldCode then begin
3810
 
          inc(DstPos,CharLen);
3811
 
        end else begin
3812
 
          inc(DstPos,UnicodeToUTF8(NewCode,@Buf[1]));
3813
 
        end;
3814
 
        inc(SrcPos,CharLen);
3815
 
      end;
3816
 
    else
3817
 
      inc(SrcPos);
3818
 
      inc(DstPos);
3819
 
    end;
3820
 
  end;
3821
 
  SetLength(Result,DstPos-1);
3822
 
  if Result='' then exit;
3823
 
  // create the new string
3824
 
  SrcPos:=1;
3825
 
  DstPos:=1;
3826
 
  while SrcPos<=length(s) do begin
3827
 
    case s[SrcPos] of
3828
 
    #192..#240:
3829
 
      begin
3830
 
        OldCode:=UTF8CharacterToUnicode(@s[SrcPos],CharLen);
3831
 
        NewCode:=UnicodeLowercase(OldCode);
3832
 
        if NewCode=OldCode then begin
3833
 
          System.Move(s[SrcPos],Result[DstPos],CharLen);
3834
 
          inc(DstPos,CharLen);
3835
 
        end else begin
3836
 
          inc(DstPos,UnicodeToUTF8(NewCode,@Result[DstPos]));
3837
 
        end;
3838
 
        inc(SrcPos,CharLen);
3839
 
      end;
3840
 
    else
3841
 
      Result[DstPos]:=s[SrcPos];
3842
 
      inc(SrcPos);
3843
 
      inc(DstPos);
3844
 
    end;
3845
 
  end;
3846
 
end;
3847
 
 
3848
 
function UTF8LowerCaseNew(const s: string): string;
3849
 
var
3850
 
  i: PtrInt;
3851
 
  CharLen: integer;
3852
 
  OldCode: LongWord;
3853
 
  NewCode: LongWord;
3854
 
  NewCharLen: integer;
3855
 
begin
3856
 
  Result:=s;
3857
 
  i:=1;
3858
 
  while i<=length(Result) do begin
3859
 
    case Result[i] of
3860
 
    { First ASCII chars }
3861
 
    'A'..'Z':
3862
 
      begin
3863
 
        Result[i]:=chr(ord(Result[i])+32);
3864
 
        inc(i);
3865
 
      end;
3866
 
    { Now chars with multiple bytes }
3867
 
    #192..#240:
3868
 
      begin
3869
 
        OldCode:=UTF8CharacterToUnicode(@Result[i],CharLen);
3870
 
        NewCode:=UnicodeLowercase(OldCode);
3871
 
        if NewCode=OldCode then begin
3872
 
          inc(i,CharLen);
3873
 
        end else begin
3874
 
          UniqueString(Result);
3875
 
          NewCharLen:=UnicodeToUTF8(NewCode,@Result[i]);
3876
 
          if CharLen=NewCharLen then begin
3877
 
            inc(i,NewCharLen);
3878
 
          end else begin
3879
 
            // string size changed => use slower function
3880
 
            Result:=UTF8LowercaseDynLength(s);
3881
 
            exit;
3882
 
          end;
3883
 
        end;
3884
 
      end;
3885
 
    else
3886
 
      inc(i);
3887
 
    end;
3888
 
  end;
3889
 
end;
3890
 
{$endif NewLowerCase}
 
2731
  Result := LazUTF8.UTF8UpperCase(s);
 
2732
end;
3891
2733
 
3892
2734
function FindInvalidUTF8Character(p: PChar; Count: PtrInt;
3893
2735
  StopOnNonASCII: Boolean): PtrInt;
3894
2736
// return -1 if ok
3895
 
var
3896
 
  CharLen: Integer;
3897
2737
begin
3898
 
  if (p<>nil) then begin
3899
 
    Result:=0;
3900
 
    while Result<Count do begin
3901
 
      if ord(p^)<128 then begin
3902
 
        // regular single byte ASCII character (#0 is a character, this is pascal ;)
3903
 
        CharLen:=1;
3904
 
      end
3905
 
      else if ord(p^)<%11000000 then begin
3906
 
        // regular single byte character
3907
 
        if StopOnNonASCII then
3908
 
          exit;
3909
 
        CharLen:=1;
3910
 
      end
3911
 
      else if ((ord(p^) and %11100000) = %11000000) then begin
3912
 
        // could be 2 byte character
3913
 
        if (Result<Count-1) and ((ord(p[1]) and %11000000) = %10000000) then
3914
 
          CharLen:=2
3915
 
        else
3916
 
          exit; // missing following bytes
3917
 
      end
3918
 
      else if ((ord(p^) and %11110000) = %11100000) then begin
3919
 
        // could be 3 byte character
3920
 
        if (Result<Count-2) and ((ord(p[1]) and %11000000) = %10000000)
3921
 
        and ((ord(p[2]) and %11000000) = %10000000) then
3922
 
          CharLen:=3
3923
 
        else
3924
 
          exit; // missing following bytes
3925
 
      end
3926
 
      else if ((ord(p^) and %11111000) = %11110000) then begin
3927
 
        // could be 4 byte character
3928
 
        if (Result<Count-3) and ((ord(p[1]) and %11000000) = %10000000)
3929
 
        and ((ord(p[2]) and %11000000) = %10000000)
3930
 
        and ((ord(p[3]) and %11000000) = %10000000) then
3931
 
          CharLen:=4
3932
 
        else
3933
 
          exit; // missing following bytes
3934
 
      end
3935
 
      else begin
3936
 
        if StopOnNonASCII then
3937
 
          exit;
3938
 
        CharLen:=1;
3939
 
      end;
3940
 
      inc(Result,CharLen);
3941
 
      inc(p,CharLen);
3942
 
      if Result>Count then begin
3943
 
        dec(Result,CharLen);
3944
 
        exit; // missing following bytes
3945
 
      end;
3946
 
    end;
3947
 
  end;
3948
 
  // ok
3949
 
  Result:=-1;
 
2738
  Result := LazUTF8.FindInvalidUTF8Character(p, Count, StopOnNonASCII);
3950
2739
end;
3951
2740
 
3952
2741
function ValidUTF8String(const s: String): String;
3953
 
var
3954
 
  p, cur: PChar;
3955
 
  l, lr: integer;
3956
 
  NeedFree: Boolean;
3957
2742
begin
3958
 
  if FindInvalidUTF8Character(PChar(s), Length(s)) <> -1 then
3959
 
  begin
3960
 
    NeedFree := True;
3961
 
    GetMem(p, Length(s) + 1);
3962
 
    StrPCopy(p, s);
3963
 
    UTF8FixBroken(p);
3964
 
  end
3965
 
  else
3966
 
  begin
3967
 
    p := PChar(s);
3968
 
    NeedFree := False;
3969
 
  end;
3970
 
 
3971
 
  Result := '';
3972
 
  cur := p;
3973
 
  while cur^ <> #0 do
3974
 
  begin
3975
 
    l := UTF8CharacterLength(cur);
3976
 
    if (l = 1) and (cur^ < #32) then
3977
 
      Result := Result + '#' + IntToStr(Ord(cur^))
3978
 
    else
3979
 
    begin
3980
 
      lr := Length(Result);
3981
 
      SetLength(Result, lr + l);
3982
 
      System.Move(cur^, Result[lr + 1], l);
3983
 
    end;
3984
 
    inc(cur, l)
3985
 
  end;
3986
 
 
3987
 
  if NeedFree then
3988
 
    FreeMem(p);
 
2743
  Result := LazUTF8.ValidUTF8String(s);
3989
2744
end;
3990
2745
 
3991
2746
procedure AssignUTF8ListToAnsi(UTF8List, AnsiList: TStrings);
3992
 
var
3993
 
  i: Integer;
3994
2747
begin
3995
 
  AnsiList.Clear;
3996
 
  if UTF8List=nil then exit;
3997
 
  for i:=0 to UTF8List.Count-1 do
3998
 
    AnsiList.Add(UTF8ToSys(UTF8List[i]));
 
2748
  LazUTF8.AssignUTF8ListToAnsi(UTF8List, AnsiList);
3999
2749
end;
4000
2750
 
4001
2751
function UTF16CharacterLength(p: PWideChar): integer;
4012
2762
  end;
4013
2763
end;
4014
2764
 
4015
 
function UTF16Length(const s: widestring): PtrInt;
 
2765
function UTF16Length(const s: UTF16String): PtrInt;
4016
2766
begin
4017
2767
  Result:=UTF16Length(PWideChar(s),length(s));
4018
2768
end;
4060
2810
  end;
4061
2811
end;
4062
2812
 
4063
 
function UnicodeToUTF16(u: cardinal): widestring;
 
2813
function UnicodeToUTF16(u: cardinal): UTF16String;
4064
2814
begin
4065
2815
  // u should be <= $10FFFF to fit into UTF-16
4066
2816
 
4071
2821
    Result:=system.widechar($D800+((u - $10000) shr 10))+system.widechar($DC00+((u - $10000) and $3ff));
4072
2822
end;
4073
2823
 
 
2824
 
 
2825
{------------------------------------------------------------------------------
 
2826
  Name:    UTF8CompareStr
 
2827
  Params: S1, S2 - UTF8 encoded strings
 
2828
  Returns: < 0 if S1 < S2, 0 if S1 = S2, > 0 if S2 > S1.
 
2829
  Compare 2 UTF8 encoded strings, case sensitive.
 
2830
  Remark: A widestring manager must be installed in order for this function
 
2831
  to work correctly with various character sets. eg. under unixes cwstring unit
 
2832
  must be included in project.
 
2833
  Note: Use this function instead of AnsiCompareStr.
 
2834
  This function guarantees proper collation on all supported platforms.
 
2835
 ------------------------------------------------------------------------------}
 
2836
function UTF8CompareStr(const S1, S2: String): Integer;
 
2837
begin
 
2838
  Result := WideCompareStr(UTF8ToUTF16(S1), UTF8ToUTF16(S2));
 
2839
end;
 
2840
 
 
2841
{------------------------------------------------------------------------------
 
2842
  Name:    UTF8CompareText
 
2843
  Params: S1, S2 - UTF8 encoded strings
 
2844
  Returns: < 0 if S1 < S2, 0 if S1 = S2, > 0 if S2 > S1.
 
2845
  Compare 2 UTF8 encoded strings, case insensitive.
 
2846
  Remark: A widestring manager must be installed in order for this function
 
2847
  to work correctly with various character sets. eg. under unixes cwstring unit
 
2848
  must be included in project.
 
2849
  Note: Use this function instead of AnsiCompareText.
 
2850
  This function guarantees proper collation on all supported platforms.
 
2851
 ------------------------------------------------------------------------------}
 
2852
function UTF8CompareText(const S1, S2: String): Integer;
 
2853
begin
 
2854
  Result := WideCompareText(UTF8ToUTF16(S1), UTF8ToUTF16(S2));
 
2855
end;
 
2856
 
4074
2857
{------------------------------------------------------------------------------
4075
2858
  Name:    ConvertUTF8ToUTF16
4076
2859
  Params:  Dest                - Pointer to destination string
4104
2887
function ConvertUTF8ToUTF16(Dest: PWideChar; DestWideCharCount: SizeUInt;
4105
2888
  Src: PChar; SrcCharCount: SizeUInt; Options: TConvertOptions;
4106
2889
  out ActualWideCharCount: SizeUInt): TConvertResult;
4107
 
var
4108
 
  DestI, SrcI: SizeUInt;
4109
 
  B1, B2, B3, B4: Byte;
4110
 
  W: Word;
4111
 
  C: Cardinal;
4112
 
 
4113
 
  function UnfinishedCharError: Boolean;
4114
 
  begin
4115
 
    if toUnfinishedCharToSymbol in Options then
4116
 
    begin
4117
 
      Dest[DestI] := System.WideChar('?');
4118
 
      Inc(DestI);
4119
 
      Result := False;
4120
 
    end
4121
 
    else
4122
 
      if toUnfinishedCharError in Options then
4123
 
      begin
4124
 
        ConvertUTF8ToUTF16 := trUnfinishedChar;
4125
 
        Result := True;
4126
 
      end
4127
 
      else Result := False;
4128
 
  end;
4129
 
 
4130
 
  function InvalidCharError(Count: SizeUInt): Boolean; inline;
4131
 
  begin
4132
 
    if not (toInvalidCharError in Options) then
4133
 
    begin
4134
 
      if toInvalidCharToSymbol in Options then
4135
 
      begin
4136
 
        Dest[DestI] := System.WideChar('?');
4137
 
        Inc(DestI);
4138
 
      end;
4139
 
 
4140
 
      Dec(SrcI, Count);
4141
 
 
4142
 
      // skip trailing UTF-8 char bytes
4143
 
      while (Count > 0) do
4144
 
      begin
4145
 
        if (Byte(Src[SrcI]) and %11000000) <> %10000000 then Break;
4146
 
        Inc(SrcI);
4147
 
        Dec(Count);
4148
 
      end;
4149
 
 
4150
 
      Result := False;
4151
 
    end
4152
 
    else
4153
 
      if toInvalidCharError in Options then
4154
 
      begin
4155
 
        ConvertUTF8ToUTF16 := trUnfinishedChar;
4156
 
        Result := True;
4157
 
      end;
4158
 
  end;
4159
 
 
4160
2890
begin
4161
 
  ActualWideCharCount := 0;
4162
 
 
4163
 
  if not Assigned(Src) then
4164
 
  begin
4165
 
    Result := trNullSrc;
4166
 
    Exit;
4167
 
  end;
4168
 
 
4169
 
  if not Assigned(Dest) then
4170
 
  begin
4171
 
    Result := trNullDest;
4172
 
    Exit;
4173
 
  end;
4174
 
  SrcI := 0;
4175
 
  DestI := 0;
4176
 
 
4177
 
  while (DestI < DestWideCharCount) and (SrcI < SrcCharCount) do
4178
 
  begin
4179
 
    B1 := Byte(Src[SrcI]);
4180
 
    Inc(SrcI);
4181
 
 
4182
 
    if B1 < 128 then // single byte UTF-8 char
4183
 
    begin
4184
 
      Dest[DestI] := System.WideChar(B1);
4185
 
      Inc(DestI);
4186
 
    end
4187
 
    else
4188
 
    begin
4189
 
      if SrcI >= SrcCharCount then
4190
 
        if UnfinishedCharError then Exit(trInvalidChar)
4191
 
        else Break;
4192
 
 
4193
 
      B2 := Byte(Src[SrcI]);
4194
 
      Inc(SrcI);
4195
 
 
4196
 
      if (B1 and %11100000) = %11000000 then // double byte UTF-8 char
4197
 
      begin
4198
 
        if (B2 and %11000000) = %10000000 then
4199
 
        begin
4200
 
          Dest[DestI] := System.WideChar(((B1 and %00011111) shl 6) or (B2 and %00111111));
4201
 
          Inc(DestI);
4202
 
        end
4203
 
        else // invalid character, assume single byte UTF-8 char
4204
 
          if InvalidCharError(1) then Exit(trInvalidChar);
4205
 
      end
4206
 
      else
4207
 
      begin
4208
 
        if SrcI >= SrcCharCount then
4209
 
          if UnfinishedCharError then Exit(trInvalidChar)
4210
 
          else Break;
4211
 
 
4212
 
        B3 := Byte(Src[SrcI]);
4213
 
        Inc(SrcI);
4214
 
 
4215
 
        if (B1 and %11110000) = %11100000 then // triple byte UTF-8 char
4216
 
        begin
4217
 
          if ((B2 and %11000000) = %10000000) and ((B3 and %11000000) = %10000000) then
4218
 
          begin
4219
 
            W := ((B1 and %00011111) shl 12) or ((B2 and %00111111) shl 6) or (B3 and %00111111);
4220
 
            if (W < $D800) or (W > $DFFF) then // to single wide char UTF-16 char
4221
 
            begin
4222
 
              Dest[DestI] := System.WideChar(W);
4223
 
              Inc(DestI);
4224
 
            end
4225
 
            else // invalid UTF-16 character, assume double byte UTF-8 char
4226
 
              if InvalidCharError(2) then Exit(trInvalidChar);
4227
 
          end
4228
 
          else // invalid character, assume double byte UTF-8 char
4229
 
            if InvalidCharError(2) then Exit(trInvalidChar);
4230
 
        end
4231
 
        else
4232
 
        begin
4233
 
          if SrcI >= SrcCharCount then
4234
 
            if UnfinishedCharError then Exit(trInvalidChar)
4235
 
            else Break;
4236
 
 
4237
 
          B4 := Byte(Src[SrcI]);
4238
 
          Inc(SrcI);
4239
 
 
4240
 
          if ((B1 and %11111000) = %11110000) and ((B2 and %11000000) = %10000000)
4241
 
            and ((B3 and %11000000) = %10000000) and ((B4 and %11000000) = %10000000) then
4242
 
          begin // 4 byte UTF-8 char
4243
 
            C := ((B1 and %00011111) shl 18) or ((B2 and %00111111) shl 12)
4244
 
              or ((B3 and %00111111) shl 6)  or (B4 and %00111111);
4245
 
            // to double wide char UTF-16 char
4246
 
            Dest[DestI] := System.WideChar($D800 or ((C - $10000) shr 10));
4247
 
            Inc(DestI);
4248
 
            if DestI >= DestWideCharCount then Break;
4249
 
            Dest[DestI] := System.WideChar($DC00 or ((C - $10000) and %0000001111111111));
4250
 
            Inc(DestI);
4251
 
          end
4252
 
          else // invalid character, assume triple byte UTF-8 char
4253
 
            if InvalidCharError(3) then Exit(trInvalidChar);
4254
 
        end;
4255
 
      end;
4256
 
    end;
4257
 
  end;
4258
 
 
4259
 
  if DestI >= DestWideCharCount then
4260
 
  begin
4261
 
    DestI := DestWideCharCount - 1;
4262
 
    Result := trDestExhausted;
4263
 
  end
4264
 
  else
4265
 
    Result := trNoError;
4266
 
 
4267
 
  Dest[DestI] := #0;
4268
 
  ActualWideCharCount := DestI + 1;
 
2891
  Result := LazUTF8.ConvertUTF8ToUTF16(Dest, DestWideCharCount,
 
2892
    Src, SrcCharCount, Options, ActualWideCharCount);
4269
2893
end;
4270
2894
 
4271
2895
{------------------------------------------------------------------------------
4287
2911
function ConvertUTF16ToUTF8(Dest: PChar; DestCharCount: SizeUInt;
4288
2912
  Src: PWideChar; SrcWideCharCount: SizeUInt; Options: TConvertOptions;
4289
2913
  out ActualCharCount: SizeUInt): TConvertResult;
4290
 
var
4291
 
  DestI, SrcI: SizeUInt;
4292
 
  W1, W2: Word;
4293
 
  C: Cardinal;
4294
 
 
4295
 
  function UnfinishedCharError: Boolean;
4296
 
  begin
4297
 
    if toUnfinishedCharToSymbol in Options then
4298
 
    begin
4299
 
      Dest[DestI] := Char('?');
4300
 
      Inc(DestI);
4301
 
      Result := False;
4302
 
    end
4303
 
    else
4304
 
      if toUnfinishedCharError in Options then
4305
 
      begin
4306
 
        ConvertUTF16ToUTF8 := trUnfinishedChar;
4307
 
        Result := True;
4308
 
      end
4309
 
      else Result := False;
4310
 
  end;
4311
 
 
4312
 
  function InvalidCharError(Count: SizeUInt): Boolean; inline;
4313
 
  begin
4314
 
    if not (toInvalidCharError in Options) then
4315
 
    begin
4316
 
      if toInvalidCharToSymbol in Options then
4317
 
      begin
4318
 
        Dest[DestI] := Char('?');
4319
 
        Inc(DestI);
4320
 
      end;
4321
 
 
4322
 
      Dec(SrcI, Count);
4323
 
      // skip trailing UTF-16 wide char
4324
 
      if (Word(Src[SrcI]) and $FC00) = $DC00 then Inc(SrcI);
4325
 
 
4326
 
      Result := False;
4327
 
    end
4328
 
    else
4329
 
      if toInvalidCharError in Options then
4330
 
      begin
4331
 
        ConvertUTF16ToUTF8 := trUnfinishedChar;
4332
 
        Result := True;
4333
 
      end;
4334
 
  end;
4335
 
 
4336
2914
begin
4337
 
  ActualCharCount := 0;
4338
 
 
4339
 
  if not Assigned(Src) then
4340
 
  begin
4341
 
    Result := trNullSrc;
4342
 
    Exit;
4343
 
  end;
4344
 
 
4345
 
  if not Assigned(Dest) then
4346
 
  begin
4347
 
    Result := trNullDest;
4348
 
    Exit;
4349
 
  end;
4350
 
  SrcI := 0;
4351
 
  DestI := 0;
4352
 
 
4353
 
  while (DestI < DestCharCount) and (SrcI < SrcWideCharCount) do
4354
 
  begin
4355
 
    W1 := Word(Src[SrcI]);
4356
 
    Inc(SrcI);
4357
 
 
4358
 
    if (W1 < $D800) or (W1 > $DFFF) then // single wide char UTF-16 char
4359
 
    begin
4360
 
      if W1 < $0080 then // to single byte UTF-8 char
4361
 
      begin
4362
 
        Dest[DestI] := Char(W1);
4363
 
        Inc(DestI);
4364
 
      end
4365
 
      else
4366
 
        if W1 < $0800 then // to double byte UTF-8 char
4367
 
        begin
4368
 
          Dest[DestI] := Char(%11000000 or ((W1 and %11111000000) shr 6));
4369
 
          Inc(DestI);
4370
 
          if DestI >= DestCharCount then Break;
4371
 
          Dest[DestI] := Char(%10000000 or (W1 and %111111));
4372
 
          Inc(DestI);
4373
 
        end
4374
 
        else
4375
 
        begin // to triple byte UTF-8 char
4376
 
          Dest[DestI] := Char(%11100000 or ((W1 and %1111000000000000) shr 12));
4377
 
          Inc(DestI);
4378
 
          if DestI >= DestCharCount then Break;
4379
 
          Dest[DestI] := Char(%10000000 or ((W1 and %111111000000) shr 6));
4380
 
          Inc(DestI);
4381
 
          if DestI >= DestCharCount then Break;
4382
 
          Dest[DestI] := Char(%10000000 or (W1 and %111111));
4383
 
          Inc(DestI);
4384
 
        end;
4385
 
    end
4386
 
    else
4387
 
    begin
4388
 
      if SrcI >= SrcWideCharCount then
4389
 
        if UnfinishedCharError then Exit(trInvalidChar)
4390
 
        else Break;
4391
 
 
4392
 
      W2 := Word(Src[SrcI]);
4393
 
      Inc(SrcI);
4394
 
 
4395
 
      if (W1 and $F800) = $D800 then // double wide char UTF-16 char
4396
 
      begin
4397
 
        if (W2 and $FC00) = $DC00 then
4398
 
        begin
4399
 
          C := (W1 - $D800) shl 10 + (W2 - $DC00) + $10000;
4400
 
 
4401
 
          // to 4 byte UTF-8 char
4402
 
          Dest[DestI] := Char(%11110000 or (C shr 18));
4403
 
          Inc(DestI);
4404
 
          if DestI >= DestCharCount then Break;
4405
 
          Dest[DestI] := Char(%10000000 or ((C and $3F000) shr 12));
4406
 
          Inc(DestI);
4407
 
          if DestI >= DestCharCount then Break;
4408
 
          Dest[DestI] := Char(%10000000 or ((C and %111111000000) shr 6));
4409
 
          Inc(DestI);
4410
 
          if DestI >= DestCharCount then Break;
4411
 
          Dest[DestI] := Char(%10000000 or (C and %111111));
4412
 
          Inc(DestI);
4413
 
        end
4414
 
        else // invalid character, assume single wide char UTF-16 char
4415
 
          if InvalidCharError(1) then Exit(trInvalidChar);
4416
 
      end
4417
 
      else // invalid character, assume single wide char UTF-16 char
4418
 
        if InvalidCharError(1) then Exit(trInvalidChar);
4419
 
    end;
4420
 
  end;
4421
 
 
4422
 
  if DestI >= DestCharCount then
4423
 
  begin
4424
 
    DestI := DestCharCount - 1;
4425
 
    Result := trDestExhausted;
4426
 
  end
4427
 
  else
4428
 
    Result := trNoError;
4429
 
 
4430
 
  Dest[DestI] := #0;
4431
 
  ActualCharCount := DestI + 1;
 
2915
  Result := LazUTF8.ConvertUTF16ToUTF8(Dest, DestCharCount,
 
2916
    Src, SrcWideCharCount, Options, ActualCharCount);
4432
2917
end;
4433
2918
 
4434
2919
{------------------------------------------------------------------------------
4441
2926
  copy
4442
2927
 ------------------------------------------------------------------------------}
4443
2928
function UTF8ToUTF16(const S: AnsiString): UTF16String;
4444
 
var
4445
 
  L: SizeUInt;
4446
2929
begin
4447
 
  if S = '' 
4448
 
  then begin
4449
 
    Result := '';
4450
 
    Exit;
4451
 
  end;
4452
 
 
4453
 
  SetLength(Result, Length(S));
4454
 
  // wide chars of UTF-16 <= bytes of UTF-8 string
4455
 
  if ConvertUTF8ToUTF16(PWideChar(Result), Length(Result) + 1, PChar(S), Length(S),
4456
 
    [toInvalidCharToSymbol], L) = trNoError 
4457
 
  then SetLength(Result, L - 1)
4458
 
  else Result := '';
 
2930
  Result := LazUTF8.UTF8ToUTF16(S);
4459
2931
end;
4460
2932
 
4461
2933
{------------------------------------------------------------------------------
4466
2938
  Converts the specified UTF-16 encoded string (system endian) to UTF-8 encoded
4467
2939
 ------------------------------------------------------------------------------}
4468
2940
function UTF16ToUTF8(const S: UTF16String): AnsiString;
4469
 
var
4470
 
  L: SizeUInt;
4471
 
  R: AnsiString;
4472
2941
begin
4473
 
  Result := '';
4474
 
  if S = '' then Exit;
4475
 
 
4476
 
  SetLength(R, Length(S) * 3);
4477
 
  // bytes of UTF-8 <= 3 * wide chars of UTF-16 string
4478
 
  // e.g. %11100000 10100000 10000000 (UTF-8) is $0800 (UTF-16)
4479
 
  if ConvertUTF16ToUTF8(PChar(R), Length(R) + 1, PWideChar(S), Length(S),
4480
 
    [toInvalidCharToSymbol], L) = trNoError then
4481
 
  begin
4482
 
    SetLength(R, L - 1);
4483
 
    Result := R;
4484
 
  end;
 
2942
  Result := LazUTF8.UTF16ToUTF8(S);
4485
2943
end;
4486
2944
 
4487
2945
procedure LCLGetLanguageIDs(var Lang, FallbackLang: String);
4488
 
 
4489
 
  {$IFDEF DARWIN}
4490
 
  function GetLanguage: boolean;
4491
 
  var
4492
 
    Ref: CFStringRef;
4493
 
    LangArray: CFMutableArrayRef;
4494
 
    StrSize: CFIndex;
4495
 
    StrRange: CFRange;
4496
 
    Locals: CFArrayRef;
4497
 
    Bundle: CFBundleRef;
4498
 
  begin
4499
 
    Result := false;
4500
 
    Bundle:=CFBundleGetMainBundle;
4501
 
    if Bundle=nil then exit;
4502
 
    Locals:=CFBundleCopyBundleLocalizations(Bundle);
4503
 
    if Locals=nil then exit;
4504
 
    LangArray := CFBundleCopyLocalizationsForPreferences(Locals, nil);
4505
 
    try
4506
 
      if CFArrayGetCount(LangArray) > 0 then
4507
 
      begin
4508
 
        Ref := CFArrayGetValueAtIndex(LangArray, 0);
4509
 
        StrRange.location := 0;
4510
 
        StrRange.length := CFStringGetLength(Ref);
4511
 
 
4512
 
        CFStringGetBytes(Ref, StrRange, kCFStringEncodingUTF8,
4513
 
          Ord('?'), False, nil, 0, StrSize);
4514
 
        SetLength(Lang, StrSize);
4515
 
 
4516
 
        if StrSize > 0 then
4517
 
        begin
4518
 
          CFStringGetBytes(Ref, StrRange, kCFStringEncodingUTF8,
4519
 
            Ord('?'), False, @Lang[1], StrSize, StrSize);
4520
 
          Result:=true;
4521
 
          FallbackLang := Copy(Lang, 1, 2);
4522
 
        end;
4523
 
      end;
4524
 
    finally
4525
 
      CFRelease(LangArray);
4526
 
    end;
4527
 
  end;
4528
 
  {$ENDIF}
4529
2946
begin
4530
 
{$IFDEF DARWIN}
4531
 
  if not GetLanguage then
4532
 
    GetLanguageIDs(Lang, FallbackLang);
4533
 
{$ELSE}
4534
 
  GetLanguageIDs(Lang, FallbackLang);
4535
 
{$ENDIF}
 
2947
  LazUTF8.LazGetLanguageIDs(Lang, FallbackLang);
4536
2948
end;
4537
2949
 
4538
2950
function CreateFirstIdentifier(const Identifier: string): string;
4724
3136
end;
4725
3137
 
4726
3138
initialization
4727
 
  InitializeDebugOutput;
 
3139
  {$IFDEF WithOldDebugln} InitializeDebugOutput; {$ENDIF}
4728
3140
  {$ifdef WinCE}
4729
3141
  // The stabs based back trace function crashes on wince,
4730
3142
  // see http://bugs.freepascal.org/view.php?id=14330
4737
3149
  {$IFDEF DebugLCLComponents}
4738
3150
  DebugLCLComponents:=TDebugLCLItems.Create('LCLComponents');
4739
3151
  {$ENDIF}
4740
 
  {$ifdef NewLowerCase}
4741
 
  InitUnicodeTables;
4742
 
  {$endif NewLowerCase}
4743
3152
finalization
4744
3153
  InterfaceInitializationHandlers.Free;
4745
3154
  InterfaceInitializationHandlers:=nil;
4750
3159
  DebugLCLComponents:=nil;
4751
3160
  {$ENDIF}
4752
3161
  FreeLineInfoCache;
 
3162
  {$IFDEF WithOldDebugln}
4753
3163
  FinalizeDebugOutput;
4754
3164
  DebugLnNestFreePrefix;
 
3165
  {$ENDIF}
4755
3166
 
4756
3167
end.