{ *************************************************************************** }
{                                                                             }
{ EControl Common Library                                                     }
{                                                                             }
{ Copyright (c) 2004 - 2006 EControl Ltd., Zaharov Michael                    }
{     www.econtrol.ru                                                         }
{     support@econtrol.ru                                                     }
{                                                                             }
{ *************************************************************************** }
{$I ecSyntEdit.INC}

unit ecStrUtils;

interface

uses Windows, Classes, Graphics, SysUtils
    {$IFDEF EC_UNICODE}{$IFNDEF EC_VCL12_UP}, ecUnicode {$ENDIF}{$ENDIF}
    {$IFDEF EC_DOTNET}, System.Runtime.InteropServices, System.Text{$ENDIF};

const
  // Clipboard block types CF_BLOCKTYPE
  TEXT_BLOCK_LINEAR = 3;
  TEXT_BLOCK_RECTANGLE = 2;
  { Search flag.

    Specifies case sensitive text searching. }
  FF_CASESENSITIVE  = 1;
  FF_WHOLEWORD      = 2;
  FF_BACKWARD       = 4;
{$IFNDEF EC_VCL6_UP}
  sLineBreak = #13#10;
{$ENDIF}


{ Windows.pas doesn't declare next functions correctly. }
{$IFNDEF EC_DOTNET}
{$EXTERNALSYM TranslateCharsetInfo}
function TranslateCharsetInfo(lpSrc: PDWORD; var lpCs: TCharsetInfo; dwFlags: DWORD): BOOL; stdcall; external gdi32 name 'TranslateCharsetInfo';
{$EXTERNALSYM GetCharacterPlacementW}
function GetCharacterPlacementW(DC: HDC; p2: PWideChar; p3, p4: Integer;
  var p5: TGCPResultsW; p6: DWORD): DWORD; stdcall; external gdi32 name 'GetCharacterPlacementW';
{$ENDIF}

type
 {$IFDEF EC_VCL12_UP}  // Delphi 2009
  ecString = string;
  ecChar = Char;
  PecChar = PChar;
  TecStrings = TStrings;
  TecStringList = TStringList;
 {$ELSE}
 {$IFDEF EC_DOTNET}
  ecString = string;
  ecChar = Char;
  PecChar = Char;
  TecStrings = TStrings;
  TecStringList = TStringList;
 {$ELSE}
 {$IFDEF EC_UNICODE}
  ecString = WideString;
  ecChar = WideChar;
  PecChar = PWideChar;
  TecStrings = TWideStrings;
  TecStringList = TWideStringList;
 {$ELSE}
  ecString = AnsiString;
  ecChar = Char;
  PecChar = PChar;
  TecStrings = TStrings;
  TecStringList = TStringList;
 {$ENDIF}
 {$ENDIF}
 {$ENDIF}

 {$IFDEF EC_DOTNET}
  ecPointer = TObject;
  ecPChar = string;
 {$ELSE}
  ecPointer = Pointer;
  ecPChar = PChar;
 {$ENDIF}


  // Encoding
  TTextCoding = (tcAnsi,
                 tcUnicode,
                 tcSwapUnicode,
                 tcUTF8);

  // Line break format
  TTextFormat = (tfDefault,       // Line breaks is unchanged
                 tfCR_NL,         // Windows
                 tfCR,            // Unix
                 tfNL);           // Mac

  // Change case commands
  TChangeCase = (ccNone, ccUpper, ccLower, ccToggle, ccTitle);

  // Event to define "word" characters
  // Used by several components and may be shared
  TCheckCharEvent = procedure(Sender: TObject; C: Word; var IsWord: Boolean) of object;

{$IFDEF EC_VCL6_UP}
  TzStringList = class(TStringList);
{$ELSE}
  TzStringList = class(TStringList)
  private
    FDelimiter: Char;
    FCaseSensitive: Boolean;
    function GetDelimitedText: string;
    procedure SetDelimitedText(const Value: string);
    procedure SetCaseSensitive(const Value: Boolean);
  public
    function Find(const S: string; var Index: Integer): Boolean; override;
    procedure Sort; override;
    property Delimiter: Char read FDelimiter write FDelimiter;
    property DelimitedText: string read GetDelimitedText write SetDelimitedText;
    property CaseSensitive: Boolean read FCaseSensitive write SetCaseSensitive;
  end;
{$ENDIF}


function GetStreamFormat(Stream: TStream): TTextCoding;
procedure WriteTextSignature(Stream: TStream; TextCoding: TTextCoding);
procedure ReadStringFromStream(var Text: ecString; Stream: TStream;
                                    TextCoding: TTextCoding = tcAnsi;
                                    CharSet: TFontCharSet = DEFAULT_CHARSET;
                                    CodePage: integer = CP_ACP);
procedure WriteStringToStream(const Text: ecString; Stream: TStream;
                                    TextCoding: TTextCoding = tcAnsi;
                                    CharSet: TFontCharSet = DEFAULT_CHARSET;
                                    CodePage: integer = CP_ACP);

// ANSI version:
function IsLetterA(c: Char): Boolean;
function IsDigitA(c: Char): Boolean;

function IsDigitChar(const c: ecChar): Boolean;
function IsHexDigitChar(const c: ecChar): Boolean;
function IsLineBreakChar(const c: ecChar): Boolean;
function IsWordChar(const c: ecChar): Boolean;
function IsSpaceChar(const c: ecChar): Boolean;
function IsAlphaChar(const C: ecChar): Boolean;

function IsIdentChar(const C: ecChar): Boolean;
function IsIdentDigitChar(const C: ecChar): Boolean;
function IsIdentLetterChar(const C: ecChar): Boolean;
function IsWordBreak(aPos: integer; const Text: ecString): Boolean;

function IsRightToLefChar(const C: ecChar): Boolean;

function ecUpCase(const C: ecChar): ecChar;
function ecLoCase(const C: ecChar): ecChar;
function ecKeyChar(const C: Char): ecChar;

function ecTextExtent(Canvas: TCanvas; const S: ecString; StartPos: integer = 1; Len: integer = -1): TSize;
procedure ecTextOut(Canvas: TCanvas; X, Y: integer; const S: ecString);

function SkipSpaces(const Source: ecString; var APos: integer): integer;
function SkipSpacesNoLineBreak(const Source: ecString; var APos: integer): integer;
function IsStringEmpty(const S: ecString): Boolean;
function GetLineIndex(const S: ecString; aPos: integer): integer;
function SearchText(const Text, SubStr: ecString; FromPos: integer; Backward, IgnoreCase: Boolean): integer;
function CompStr(const S1, S2: ecString; NoCase: Boolean = True): Integer;
function GetLines(const AText: ecString; List: TList = nil): integer; // Calculates line number in the Text, fills indexes List
function ecEncodeString(const S: string): string;
function ecDecodeString(const S: string): string;

function StringFromHandle(HMem: integer; Format: WORD; CharSet: TFontCharset = DEFAULT_CHARSET): ecString;
function BlockTypeFromHandle(HMem: integer): Byte;
{$IFDEF EC_DOTNET}
function GetClipboardToBuffer(Format: WORD; Buffer: TBytes; Size: Integer): Integer;
procedure SetClipboardFromBuffer(Format: Word; Buffer: TBytes; Size: Integer);
{$ELSE}
function GetClipboardToBuffer(Format: WORD; var Buffer; Size: Integer): Integer;
procedure SetClipboardFromBuffer(Format: Word; var Buffer; Size: Integer);
{$ENDIF}
function GetClipboardBlockType: BYTE;
procedure SetClipboardBlockType(BlockType: BYTE);
function GetClipboardTextEx(CharSet: TFontCharset = DEFAULT_CHARSET): ecString;
function GetClipboardText(CharSet: TFontCharset = DEFAULT_CHARSET): ecString;
procedure SetClipboardText(const Text: ecString; CharSet: TFontCharset = DEFAULT_CHARSET);

{$IFDEF EC_DOTNET}
function UTF8Decode(const S: string): string;
function UTF8Encode(const S: string): string;
function AnsiToUnicode(const S: string; Charset: TFontCharset = DEFAULT_CHARSET): string;
function UnicodeToAnsi(const S: string; Charset: TFontCharset = DEFAULT_CHARSET): string;
function Utf8_Ansi(const utf8Str: string; const Charset: integer): string;
function Ansi_Utf8(const ansiStr: string; const Charset: integer): string;
{$ELSE}
function AnsiToUnicodeCP(const S: AnsiString; CodePage: integer): WideString;
function UnicodeToAnsiCP(const S: WideString; CodePage: integer): AnsiString;
function AnsiToUnicode(const S: AnsiString; Charset: TFontCharset = DEFAULT_CHARSET; CodePage: integer = CP_ACP): WideString;
function UnicodeToAnsi(const S: WideString; Charset: TFontCharset = DEFAULT_CHARSET; CodePage: integer = CP_ACP): AnsiString;

function CharSetToCodePage(ciCharset: UINT): Cardinal;
function Utf8_Ansi(const utf8Str: AnsiString; const Charset: integer): AnsiString;
function Ansi_Utf8(const ansiStr: AnsiString; const Charset: integer): AnsiString;
function UTF8Decode(const S: AnsiString): WideString;
function UTF8Encode(const S: WideString): AnsiString;
{$ENDIF}

{$IFDEF EC_MBCS}
function TestCharType(const S: string; Index: integer; Charset: TFontCharset = DEFAULT_CHARSET): TMbcsByteType;
{$ENDIF}

procedure ChangeStrCase(var S: ecString; ChangeCase: TChangeCase);

function ecPosEx(const SubStr, S: ecString; Offset: Cardinal = 1): Integer;
function ec_UpperCase(const S: ecString): ecString;

var
  CF_BLOCKTYPE: WORD = 0;    //  Borland IDE Block Type
  CF_RTF: WORD = 0;          //  Rich Text Format
{$NODEFINE CF_RTF}

resourcestring
  SecListIndexError = 'Index %d is out of range';

implementation

uses Clipbrd, Contnrs, Controls, Forms, {$IFDEF EC_DOTNET}Types,{$ENDIF}
     ecLists, math;

{$IFNDEF EC_VCL6_UP}
const
  QuoteChar: Char = ' ';

function TzStringList.GetDelimitedText: string;
var
  S: string;
  P: PChar;
  I, Count: Integer;
begin
  Count := GetCount;
  if (Count = 1) and (Get(0) = '') then
    Result := QuoteChar + QuoteChar
  else
  begin
    Result := '';
    for I := 0 to Count - 1 do
    begin
      S := Get(I);
      P := PChar(S);
      while not (P^ in [#0..' ', QuoteChar, Delimiter]) do
        Inc(P);
      if (P^ <> #0) then S := AnsiQuotedStr(S, QuoteChar);
      Result := Result + S + Delimiter;
    end;
      System.Delete(Result, Length(Result), 1);
  end;
end;

procedure TzStringList.SetCaseSensitive(const Value: Boolean);
begin
  if Value <> FCaseSensitive then
  begin
    FCaseSensitive := Value;
    if Sorted then Sort;
  end;
end;

procedure TzStringList.SetDelimitedText(const Value: string);
var
  P, P1: PChar;
  S: string;
begin
  BeginUpdate;
  try
    Clear;
    P := PChar(Value);
    while P^ in [#1..' '] do
      Inc(P);
    while P^ <> #0 do
    begin
      P1 := P;
      while (P^ > ' ') and (P^ <> Delimiter) do
        Inc(P);
      SetString(S, P1, P - P1);
      Add(S);
      while P^ in [#1..' '] do
        Inc(P);
      if P^ = Delimiter then
      begin
        P1 := P;
        Inc(P1);
        if P1^ = #0 then
          Add('');
        repeat
          Inc(P);
        until not (P^ in [#1..' ']);
      end;
    end;
  finally
    EndUpdate;
  end;
end;

function StrAnsiCompare(List: TStringList; const S1, S2: string): Integer;
begin
  with TzStringList(List) do
   if CaseSensitive then
     Result := AnsiCompareStr(S1, S2)
   else
     Result := AnsiCompareText(S1, S2);
end;

function StringListAnsiCompare(List: TStringList; Index1, Index2: Integer): Integer;
begin
  Result := StrAnsiCompare(List, List[Index1], List[Index2]);
end;

function TzStringList.Find(const S: string; var Index: Integer): Boolean;
var
  L, H, I, C: Integer;
begin
  Result := False;
  L := 0;
  H := Count - 1;
  while L <= H do
  begin
    I := (L + H) shr 1;
    C := StrAnsiCompare(Self, Strings[I], S);
    if C < 0 then L := I + 1 else
    begin
      H := I - 1;
      if C = 0 then
      begin
        Result := True;
        if Duplicates <> dupAccept then L := I;
      end;
    end;
  end;
  Index := L;
end;

procedure TzStringList.Sort;
begin
  CustomSort(StringListAnsiCompare);
end;

{$ENDIF}

function GetStreamFormat(Stream: TStream): TTextCoding;
var BytesRead: Integer;
    Sign: WORD;
    C: BYTE;
begin
  Result := tcAnsi;
  if Stream.Size - Stream.Position < 2 then Exit;
  BytesRead := Stream.Read(Sign, 2);
  if (Sign = $FEFF) or (Sign = $FFFE) then
   begin
    if Sign = $FFFE then Result := tcSwapUnicode
     else Result := tcUnicode;
    Exit;
   end;
  if Sign = $BBEF then
   begin
    Inc(BytesRead, Stream.Read(C, 1));
    if C = $BF then
     begin
      Result := tcUTF8;
      Exit;
     end;
   end;
  Stream.Seek(-BytesRead, soFromCurrent);
end;

procedure WriteTextSignature(Stream: TStream; TextCoding: TTextCoding);
  procedure Write(const Bytes: array of Byte);
  begin
    Stream.Write(Bytes[0], Length(Bytes));
  end;
begin
  case TextCoding of
    tcUnicode:    Write([$FF, $FE]);
    tcSwapUnicode:Write([$FE, $FF]);
    tcUTF8:       Write([$EF, $BB, $BF]);
  end;
end;

{$IFDEF EC_DOTNET}
function GetEncoding(TextCoding: TTextCoding): System.Text.Encoding;
begin
  case TextCoding of
    tcUnicode:      Result := System.Text.Encoding.Unicode;
    tcSwapUnicode:  Result := System.Text.Encoding.BigEndianUnicode;
    tcUTF8:         Result := System.Text.Encoding.UTF8;
    else            Result := System.Text.Encoding.Default;
  end;
end;


procedure WriteStringToStream(const Text: ecString; Stream: TStream;
                                    TextCoding: TTextCoding;
                                    CharSet: TFontCharSet;
                                    CodePage: integer);
var Encoding: System.Text.Encoding;
    Buffer: array of Byte;
begin
  Encoding := GetEncoding(TextCoding);
  Buffer := Encoding.GetBytes(Text);
  Stream.WriteBuffer(Buffer, Length(Buffer));
end;

procedure ReadStringFromStream(var Text: ecString; Stream: TStream; TextCoding: TTextCoding;
                                    CharSet: TFontCharSet; CodePage: integer);
var Encoding: System.Text.Encoding;
    Buffer: array of Byte;
    Size: Integer;
begin
  Encoding := GetEncoding(TextCoding);
  Size := Stream.Size - Stream.Position;
  SetLength(Buffer, Size);
  Stream.Read(Buffer, Size);
  Text := Encoding.GetString(Buffer, Size, Length(Buffer) - Size);
end;
{$ELSE}

{$IFNDEF EC_UNICODE}
  {$DEFINE UNICDOE_UTILS}
{$ENDIF}
{$IFDEF EC_VCL12_UP}
  {$DEFINE UNICDOE_UTILS}
{$ENDIF}

{$IFDEF UNICDOE_UTILS}
procedure StrSwapByteOrder(Str: PWideChar);
asm
         PUSH ESI
         PUSH EDI
         MOV ESI, EAX
         MOV EDI, ESI
         XOR EAX, EAX  // clear high order byte to be able to use 32bit operand below
@@1:     LODSW
         OR EAX, EAX
         JZ @@2
         XCHG AL, AH
         STOSW
         JMP @@1

@@2:     POP EDI
         POP ESI
end;

function CodePageFromLocale(Language: LCID): Integer;
var Buf: array[0..6] of Char;
begin
  GetLocaleInfo(Language, LOCALE_IDefaultAnsiCodePage, Buf, 6);
  Result := StrToIntDef(Buf, GetACP);
end;
{$ENDIF}

procedure WriteStringToStream(const Text: ecString; Stream: TStream;
                                    TextCoding: TTextCoding;
                                    CharSet: TFontCharSet;
                                    CodePage: integer);
var S: AnsiString;
    W: WideString;
begin
  // Write text
  case TextCoding of
    tcAnsi:
        begin
          {$IFDEF EC_UNICODE}
          S := UnicodeToAnsi(Text, CharSet, CodePage);
          Stream.Write(Pointer(S)^, Length(S));
          {$ELSE}
          if CodePage <> CP_ACP then
            begin
              W := AnsiToUnicode(Text, CharSet);
              S := UnicodeToAnsiCP(W, CodePage);
            end
          else
            S := Text;
          Stream.Write(Pointer(S)^, Length(S));
          {$ENDIF}
        end;
    tcUnicode:
        begin
          {$IFDEF EC_UNICODE}
          Stream.Write(Pointer(Text)^, Length(Text) * 2);
          {$ELSE}
          W := AnsiToUnicode(Text, CharSet, CodePage);
          Stream.Write(Pointer(W)^, Length(W) * 2);
          {$ENDIF}
        end;
    tcSwapUnicode:
        begin
          {$IFDEF EC_UNICODE}
          W := Text;
          {$ELSE}
          W := AnsiToUnicode(Text, CharSet, CodePage);
          {$ENDIF}
          StrSwapByteOrder(PWideChar(W));
          Stream.Write(Pointer(W)^, Length(W) * 2);
        end;
    tcUTF8:
        begin
          {$IFDEF EC_UNICODE}
          W := Text;
          {$ELSE}
          W := AnsiToUnicode(Text, CharSet, CodePage);
          {$ENDIF}

          S := Utf8Encode(W);
          Stream.Write(Pointer(S)^, Length(S));
        end;
  end;
end;

procedure ReadStringFromStream(var Text: ecString; Stream: TStream;
                               TextCoding: TTextCoding;
                               CharSet: TFontCharSet;
                               CodePage: integer);
var Size: Cardinal;
    S: AnsiString;
    W: WideString;
begin
  Size := Stream.Size - Stream.Position;
  try
    case TextCoding of
      tcAnsi:
         begin
          {$IFDEF EC_UNICODE}
          SetLength(S, Size);
          Stream.Read(S[1], Size);
          Text := AnsiToUnicode(S, CharSet, CodePage);
          {$ELSE}
          SetLength(Text, Size);
          Stream.Read(Text[1], Size);
          if CodePage <> CP_ACP then
            begin
              W := AnsiToUnicodeCP(Text, CodePage);
              Text := UnicodeToAnsi(W, CharSet);
            end;
          {$ENDIF}
         end;
      tcUnicode:
         begin
          Size := Size shr 1;
          {$IFNDEF EC_UNICODE}
          SetLength(W, Size);
          Stream.Read(W[1], Size shl 1);
          Text := UnicodeToAnsi(W, CharSet, CodePage);
          {$ELSE}
          SetLength(Text, Size);
          Stream.Read(Text[1], Size shl 1);
          {$ENDIF}
         end;
      tcSwapUnicode:
         begin
          Size := Size shr 1;
          {$IFNDEF EC_UNICODE}
          SetLength(W, Size);
          Stream.Read(W[1], Size shl 1);
          StrSwapByteOrder(PWideChar(W));
          Text := UnicodeToAnsi(W, CharSet, CodePage);
          {$ELSE}
          SetLength(Text, Size);
          Stream.Read(Text[1], Size shl 1);
          StrSwapByteOrder(PWideChar(Text));
          {$ENDIF}
         end;
      tcUTF8:
         begin
          SetLength(S, Size);
          Stream.Read(S[1], Size);
          W := UTF8Decode(S);

          {$IFDEF EC_UNICODE}
          Text := W;
          {$ELSE}
          Text := UnicodeToAnsi(W, CharSet, CodePage);
          {$ENDIF}
         end;
    end;
  except
  end;
end;
{$ENDIF}


//==============================================================================
//  Routines
//==============================================================================

function GetCharType(const C: ecChar): Word;
{$IFDEF EC_DOTNET}
var wa: TWordDynArray;
{$ENDIF}
begin
  {$IFDEF EC_DOTNET}
    GetStringTypeEx(LOCALE_USER_DEFAULT, CT_CTYPE1, string(C), 1, wa);
    Result := wa[0];
  {$ELSE}
    {$IFDEF EC_UNICODE}
    GetStringTypeExW(LOCALE_USER_DEFAULT, CT_CTYPE1, @C, 1, Result);
    {$ELSE}
    GetStringTypeExA(LOCALE_USER_DEFAULT, CT_CTYPE1, @C, 1, Result);
    {$ENDIF}
  {$ENDIF}
end;

function IsLetterA(c: Char): Boolean;
begin
  Result := (c >= 'A') and (c <= 'Z') or (c >= 'a') and (c <= 'z') or (c= '_');
end;

function IsDigitA(c: Char): Boolean;
begin
  Result := (c >= '0') and (c <= '9');
end;

function IsSpaceChar(const c: ecChar): Boolean;
begin
  Result := (GetCharType(C) and C1_SPACE) <> 0;
end;

function IsLineBreakChar(const c: ecChar): Boolean;
begin
   case C of
     #$A, #$D{$IFDEF EC_UNICODE}, #$B, #$C, #$2028, #$2029, #$85{$ENDIF}: Result := True;
     else Result := False;
   end;
end;

function IsDigitChar(const C: ecChar): Boolean;
begin
  Result := (GetCharType(C) and C1_DIGIT) <> 0;
end;

function IsHexDigitChar(const C: ecChar): Boolean;
begin
  Result := (GetCharType(C) and C1_XDIGIT) <> 0;
end;

function IsWordChar(const C: ecChar): Boolean;
begin
  Result := ((GetCharType(C) and (C1_ALPHA or C1_DIGIT)) <> 0) or (C = '_');
end;

function IsAlphaChar(const C: ecChar): Boolean;
begin
  Result := (GetCharType(C) and C1_ALPHA) <> 0;
end;

function IsIdentChar(const C: ecChar): Boolean;
begin
  Result := IsIdentLetterChar(C) or (C >= '0') and (C <= '9');
end;

function IsIdentLetterChar(const C: ecChar): Boolean;
begin
  Result := (C >= 'a') and (C <= 'z') or (C >= 'A') and (C <= 'Z') or (C = '_');
end;

function IsIdentDigitChar(const C: ecChar): Boolean;
begin
  Result := (C >= '0') and (C <= '9');
end;

function IsWordBreak(aPos: integer; const Text: ecString): Boolean;
begin
  Result := (aPos = 1) or (aPos > Length(Text)) or
            (IsWordChar(Text[aPos]) xor IsWordChar(Text[aPos - 1]));
end;

function ecUpCase(const C: ecChar): ecChar;
begin
  {$IFDEF EC_DOTNET}
    Result := C.ToString.ToUpper[1];
  {$ELSE}
    {$IFDEF EC_UNICODE}
     Result := WideChar(CharUpperW(PWideChar(c)));
    {$ELSE}
     Result := Char(CharUpperA(PChar(c)));
    {$ENDIF}
  {$ENDIF}
end;

function ecLoCase(const C: ecChar): ecChar;
begin
  {$IFDEF EC_DOTNET}
    Result := C.ToString.ToLower[1];
  {$ELSE}
    {$IFDEF EC_UNICODE}
      Result := WideChar(CharLowerW(PWideChar(c)));
    {$ELSE}
      Result := Char(CharLowerA(PChar(c)));
    {$ENDIF}
  {$ENDIF}
end;

function ecKeyChar(const C: Char): ecChar;
begin
  {$IFDEF EC_UNICODE}
    MultiByteToWideChar(CodePageFromLocale(GetKeyboardLayout(0) and $FFFF),
                        MB_USEGLYPHCHARS, @C, 1, @Result, 1);
  {$ELSE}
    Result := C;
  {$ENDIF}
end;

function IsRightToLefChar(const C: ecChar): Boolean;
var tp: Word;
{$IFDEF EC_DOTNET}
    wa: TWordDynArray;
{$ENDIF}
begin
  {$IFDEF EC_DOTNET}
    GetStringTypeEx(LOCALE_USER_DEFAULT, CT_CTYPE1, string(C), 1, wa);
    Result := wa[0] = C2_RIGHTTOLEFT;
  {$ELSE}
    {$IFDEF EC_UNICODE}
    GetStringTypeExW(LOCALE_USER_DEFAULT, CT_CTYPE2, @C, 1, tp);
    {$ELSE}
    GetStringTypeExA(LOCALE_USER_DEFAULT, CT_CTYPE2, @C, 1, tp);
    {$ENDIF}
    Result := tp = C2_RIGHTTOLEFT;
  {$ENDIF}
end;

function SkipSpacesNoLineBreak(const Source: ecString; var APos: integer): integer;
var N: integer;
begin
  Result := 0;
  N := Length(Source);
  while (APos <= N) and IsSpaceChar(Source[APos]) and not IsLineBreakChar(Source[APos]) do
    inc(APos);
  if APos > N then Result := -1;
end;

function SkipSpaces(const Source: ecString; var APos: integer): integer;
var N: integer;
begin
  Result := 0;
  N := Length(Source);
  while (APos <= N) and IsSpaceChar(Source[APos]) do
   begin
    if Source[APos] = #10 then inc(Result);
    inc(APos);
   end;
  if APos > N then Result := -1;
end;

function IsStringEmpty(const S: ecString): Boolean;
var i: integer;
begin
  for i := 1 to Length(s) do
   if not IsSpaceChar(s[i]) then
    begin
      Result := False;
      Exit;
    end;
  Result := True;
end;

function GetLineIndex(const S: ecString; aPos: integer): integer;
var i, N: integer;
begin
  Result := 0;
  N := Length(S);
  Inc(aPos);
  if N > aPos then N := aPos;
  for i := 1 to N do
   if S[i] = #10 then inc(Result);
end;

function CompStr(const S1, S2: ecString; NoCase: Boolean): integer;
var fl: integer;
begin
  if NoCase then fl := NORM_IGNORECASE else fl := 0;
  {$IFDEF EC_DOTNET}
  Result := CompareStringW(LOCALE_SYSTEM_DEFAULT, fl, S1, -1, S2, -1) - 2;
  {$ELSE}
    {$IFDEF EC_UNICODE}
    Result := CompareStringW(LOCALE_SYSTEM_DEFAULT, fl, PWideChar(S1), -1, PWideChar(S2), -1) - 2;
    {$ELSE}
    Result := CompareStringA(LOCALE_SYSTEM_DEFAULT, fl, PChar(S1), -1, PChar(S2), -1) - 2;
    {$ENDIF}
  {$ENDIF}
end;

function SearchText(const Text, SubStr: ecString; FromPos: integer; Backward, IgnoreCase: Boolean): integer;
var i: integer;

  function Compare(Pos: integer): Boolean;
  var i: integer;
  begin
    Result := False;
    if (Pos > 0) and (Length(SubStr) + Pos - 1 <= Length(Text)) then
     begin
       for i := 1 to Length(SubStr) do
        if IgnoreCase then
         begin
          if ecUpCase(SubStr[i]) <> ecUpCase(Text[Pos + i - 1]) then Exit;
         end else
          if SubStr[i] <> Text[Pos + i - 1] then Exit;
       Result := True;
     end;
  end;

begin
  Result := 0;
  if Length(Text) = 0 then  Exit;
  if FromPos >= Length(Text) then FromPos := Length(Text) - 1;
  if FromPos < 0 then FromPos := 1;
  if Backward then
   begin
    for i := FromPos downto 1 do
     if Compare(i) then
      begin
        Result := i;
        Exit;
      end;
   end
  else
    for i := FromPos to Length(Text) - Length(SubStr) do
     if Compare(i) then
      begin
        Result := i;
        Exit;
      end
end;

function GetLines(const AText: ecString; List: TList): integer;
var i, L, st: Integer;
begin
  if List <> nil then
    List.Clear;
  Result := 0;

  L := Length(AText);
  if L = 0 then Exit;
  st := 1;
  i := 1;
  while i <= L do
   if (AText[i] = #13) or (AText[i] = #10) then
    begin
     if List <> nil then
       List.Add(TObject(st - 1));
     Inc(Result);
     if AText[i] = #13 then begin
       Inc(i);
       if i > L then Exit;
     end;
     if AText[i] = #10 then begin
       Inc(i);
       if i > L then Exit;
     end;
     st := i;
    end else inc(i);

  if List <> nil then
   List.Add(TObject(st - 1));
  Inc(Result);
end;

function ecEncodeString(const S: string): string;
var I, L, K: integer;
begin
  Result := '';
  L := Length(S);
  I := 1;
  while I <= L do
    if (S[I] >= ' ') and (S[I] <> '''') then
     begin
       K := I;
       repeat
         Inc(I)
       until (I > L) or (S[I] < ' ') or (S[I] = '''');
       Result := Result + '''' + Copy(S, K, I - K) + '''';
     end else
     begin
      Result := Result + '#' + IntToStr(Ord(S[I]));
      Inc(I);
     end;
end;

function ecDecodeString(const S: string): string;
var I, L, K: integer;
begin
  Result := '';
  L := Length(S);
  I := 1;
  while I <= L do
   if S[I] = '''' then
     begin
       K := I;
       repeat
         Inc(I);
       until (I > L) or (S[i] = '''');
       Result := Result + Copy(S, K + 1, I - K - 1);
       Inc(I);
     end else
   if S[I] = '#' then
     begin
       K := I + 1;
       repeat
         Inc(I)
       until (I > L) or not IsDigitA(S[I]);
       if (K = I) or ((I - K) > 3) then
         raise Exception.Create('Invalid character code');
       Result := Result + Chr(StrToInt(Copy(S, K, I - K)));
     end else Exit;
//   else raise Exception.Create('Invalid property data');
end;

// =============================================================================
//  Clipboard support
// =============================================================================
function StringFromHandle(HMem: integer; Format: WORD; CharSet: TFontCharset): ecString;
var P: {$IFDEF EC_DOTNET} IntPtr;{$ELSE} Pointer; {$ENDIF}
begin
  Result := '';
  if integer(HMem) = 0 then Exit;
  P := GlobalLock(HMem);
  if Integer(P) <> 0 then
  try
{$IFDEF EC_DOTNET}
  case Format of
    CF_TEXT:        Result := Marshal.PtrToStringAnsi(P);
    CF_UNICODETEXT: Result := Marshal.PtrToStringUni(P);
  end;
{$ELSE}
  {$IFDEF EC_UNICODE}
  case Format of
    CF_TEXT:        Result := AnsiToUnicode(PAnsiChar(P), Charset);
    CF_UNICODETEXT: Result := PWideChar(P);
  end;
  {$ELSE}
  case Format of
    CF_TEXT:        Result := PAnsiChar(P);
    CF_UNICODETEXT: Result := UnicodeToAnsi(PWideChar(P), Charset);
  end;
  {$ENDIF}
{$ENDIF}
  finally
    GlobalUnlock(HMem);
  end;
end;

function BlockTypeFromHandle(HMem: integer): Byte;
var
{$IFDEF EC_DOTNET}
   bt: TBytes;
   P: IntPtr;
{$ELSE}
   P: Pointer;
{$ENDIF}
begin
  Result := 0;
  if integer(HMem) = 0 then Exit;
  P := GlobalLock(HMem);
  if Integer(P) <> 0 then
  try
   {$IFDEF EC_DOTNET}
    Marshal.PtrToStructure(P, bt);
    if Length(bt) = 1 then Result := bt[0];
   {$ELSE}
    Result := PByte(P)^;
   {$ENDIF}
  finally
    GlobalUnlock(HMem);
  end;
end;

function GetClipboardText(CharSet: TFontCharset): ecString;
begin
  if Clipboard.HasFormat(CF_UNICODETEXT) then
    Result := StringFromHandle(Clipboard.GetAsHandle(CF_UNICODETEXT), CF_UNICODETEXT, CharSet) else
  if Clipboard.HasFormat(CF_TEXT) then
    Result := StringFromHandle(Clipboard.GetAsHandle(CF_TEXT), CF_TEXT, CharSet)
  else
    Result := '';
end;

// For "Smart Paste"
function GetClipboardTextEx(CharSet: TFontCharset = DEFAULT_CHARSET): ecString;
var S1, S2: ecString;
  function CountRepl(const S: ecString): integer;
  var i: integer;
  begin
    Result := 0;
    for i := 1 to Length(S) do
      if S[i] = '?' then
        Inc(Result);
  end;
begin
  if Clipboard.HasFormat(CF_UNICODETEXT) then
    S1 := StringFromHandle(Clipboard.GetAsHandle(CF_UNICODETEXT), CF_UNICODETEXT, CharSet)
  else
    S1 := '';

  if Clipboard.HasFormat(CF_TEXT) then
    S2 := StringFromHandle(Clipboard.GetAsHandle(CF_TEXT), CF_TEXT, CharSet)
  else
    S2 := '';

  if CountRepl(S1) <= CountRepl(S2) then // checking which string is better
    Result := S1
  else
    Result := S2;
end;

procedure SetClipboardText(const Text: ecString; CharSet: TFontCharset);
{$IFDEF EC_DOTNET}
begin
  Clipboard.AsText := Text;
{$ELSE}
var W: WideString;
    S: AnsiString;
begin
  Clipboard.Open;
  try
    // Save as ANSI text
    {$IFDEF EC_UNICODE}
    S := UnicodeToAnsi(Text, CharSet);
    {$ELSE}
    S := Text;
    {$ENDIF}
    SetClipboardFromBuffer(CF_TEXT, PAnsiChar(S)^, Length(S) + 1);

    // Save as UNICODE text
    {$IFDEF EC_UNICODE}
    W := Text;
    {$ELSE}
    W := AnsiToUnicode(Text, CharSet);
    {$ENDIF}
    SetClipboardFromBuffer(CF_UNICODETEXT, PWideChar(W)^, Length(W) * 2 + 2);
  finally
    Clipboard.Close;
  end;
{$ENDIF}
end;

function GetClipboardToBuffer(Format: WORD; {$IFDEF EC_DOTNET}Buffer: TBytes{$ELSE}var Buffer{$ENDIF}; Size: Integer): Integer;
var
  Data: THandle;
{$IFDEF EC_DOTNET}
  DataPtr: IntPtr;
{$ELSE}
  DataPtr: Pointer;
{$ENDIF}
begin
  Result := 0;
  ClipBoard.Open;
  try
    Data := GetClipboardData(Format);
    if Data <> 0 then begin
      DataPtr := GlobalLock(Data);
      if DataPtr <> nil then
      try
        Result := GlobalSize(Data);
        if Result > Size then
          Result := Size;
        {$IFDEF EC_DOTNET}
        SetLength(Buffer, Size);
        Marshal.PtrToStructure(DataPtr, Buffer);
        {$ELSE}
        Move(DataPtr^, Buffer, Result);
        {$ENDIF}
      finally
        GlobalUnlock(Data);
      end;
    end;
  finally
   ClipBoard.Close;
  end;
end;

procedure SetClipboardFromBuffer(Format: Word; {$IFDEF EC_DOTNET}Buffer: TBytes{$ELSE}var Buffer{$ENDIF}; Size: Integer);
var Data: THandle;
    DataPtr: {$IFDEF EC_DOTNET}IntPtr{$ELSE}Pointer{$ENDIF};
begin
  Clipboard.Open;
  try
    Data := GlobalAlloc(GMEM_MOVEABLE+GMEM_DDESHARE, Size);
    try
      DataPtr := GlobalLock(Data);
      try
        {$IFDEF EC_DOTNET}
        Marshal.Copy(Buffer, 0, DataPtr, Size);
        {$ELSE}
        Move(Buffer, DataPtr^, Size);
        {$ENDIF}
        Clipboard.SetAsHandle(Format, Data);
      finally
        GlobalUnlock(Data);
      end;
    except
      GlobalFree(Data);
      raise;
    end;
  finally
    Clipboard.Close;
  end;
end;

function GetClipboardBlockType: BYTE;
{$IFDEF EC_DOTNET}
var bt: TBytes;
{$ENDIF}
begin
  Result := 0;
{$IFDEF EC_DOTNET}
  SetLength(bt, 1);
  if GetClipboardToBuffer(CF_BLOCKTYPE, bt, 1) = 1 then
    Result := bt[0];
{$ELSE}
  GetClipboardToBuffer(CF_BLOCKTYPE, Result, 1);
{$ENDIF}
end;

procedure SetClipboardBlockType(BlockType: BYTE);
{$IFDEF EC_DOTNET}
var  bt: TBytes;
{$ENDIF}
begin
{$IFDEF EC_DOTNET}
  SetLength(bt, 1);
  bt[0] := BlockType;
  SetClipboardFromBuffer(CF_BLOCKTYPE, bt, 1);
{$ELSE}
  SetClipboardFromBuffer(CF_BLOCKTYPE, BlockType, 1);
{$ENDIF}
end;

{$IFDEF EC_DOTNET}

function Utf8_Ansi(const utf8Str: string; const Charset: integer): string;
begin
  Result := UTF8Decode(utf8Str);
end;

function Ansi_Utf8(const ansiStr: string; const Charset: integer): string;
begin
  Result := UTF8Encode(ansiStr);
end;

function AnsiToUnicode(const S: string; Charset: TFontCharset = DEFAULT_CHARSET): string;
begin
  Result := S;
end;

function UnicodeToAnsi(const S: string; Charset: TFontCharset = DEFAULT_CHARSET): string;
begin
  Result := S;
end;

function UTF8Decode(const S: string): string;
begin
  Result := (System.Text.UnicodeEncoding.Create).GetString((System.Text.UTF8Encoding.Create).GetBytes(S));
end;

function UTF8Encode(const S: string): string;
begin
  Result := (System.Text.UTF8Encoding.Create).GetString((System.Text.UnicodeEncoding.Create).GetBytes(S));
end;

{$ELSE}

function AnsiToUnicodeCP(const S: AnsiString; CodePage: integer): WideString;
var N: integer;
begin
  N := MultiByteToWideChar(CodePage, 0, PAnsiChar(S), Length(S), nil, 0);
  SetLength(Result, N);
  MultiByteToWideChar(CodePage, 0, PAnsiChar(S), Length(S), PWideChar(Result), N);
end;

function UnicodeToAnsiCP(const S: WideString; CodePage: integer): AnsiString;
var N: integer;
begin
  N := WideCharToMultiByte(CodePage, 0{WC_COMPOSITECHECK}, PWideChar(S), Length(S), nil, 0, nil, nil);
  SetLength(Result, N);
  WideCharToMultiByte(CodePage, 0{WC_COMPOSITECHECK}, PWideChar(S), Length(S), PAnsiChar(Result), N, nil, nil);
end;

function CharSetToCodePage(ciCharset: UINT): Cardinal;
var C: TCharsetInfo;
begin
  case ciCharset of
    DEFAULT_CHARSET: Result := CP_ACP;
    OEM_CHARSET: Result := CP_OEMCP;
    else
      if TranslateCharsetInfo({$IFNDEF EC_DOTNET}PDWORD(ciCharset){$ELSE}ciCharset{$ENDIF}, C, TCI_SRCCHARSET) then
        Result := C.ciACP
      else
        Result := CP_ACP;
  end;
end;

function Utf8_Ansi(const utf8Str: AnsiString; const Charset: integer): AnsiString;
begin
  Result := UnicodeToAnsi(UTF8Decode(utf8Str), Charset);
end;

function Ansi_Utf8(const ansiStr: AnsiString; const Charset: integer): AnsiString;
begin
  Result := UTF8Encode(AnsiToUnicode(ansiStr, Charset));
end;

function AnsiToUnicode(const S: AnsiString; Charset: TFontCharset; CodePage: integer): WideString;
begin
  if CodePage = CP_ACP then
    Result := AnsiToUnicodeCP(S, CharSetToCodePage(Charset))
  else
    Result := AnsiToUnicodeCP(S, CodePage);
end;

function UnicodeToAnsi(const S: WideString; Charset: TFontCharset; CodePage: integer): AnsiString;
begin
  if CodePage = CP_ACP then
    Result := UnicodeToAnsiCP(S, CharSetToCodePage(Charset))
  else
    Result := UnicodeToAnsiCP(S, CodePage);
end;

function UTF8Decode(const S: AnsiString): WideString;
begin
  Result := AnsiToUnicodeCP(S, CP_UTF8);
end;

function UTF8Encode(const S: WideString): AnsiString;
begin
  Result := UnicodeToAnsiCP(S, CP_UTF8);
end;
{$ENDIF}

{$IFNDEF EC_DOTNET}
type
  TCanvasHack = class(TCanvas);
{$ENDIF}

function ecTextExtent(Canvas: TCanvas; const S: ecString; StartPos: integer; Len: integer): TSize;
{$IFNDEF EC_STRING_UNICODE}
var ptr: integer;
{$ENDIF}
begin
 Result.cx := 0;
 Result.cy := 0;
 if Length(S) = 0 then Exit;
 if Assigned(Canvas.OnChanging) then
   Canvas.OnChanging(Canvas);
 if (Len = -1) or (Len > Length(S)) then
  Len := Length(S);

 {$IFDEF EC_STRING_UNICODE}
   if (Len = Length(S)) and (StartPos = 1) then
     Result := Canvas.TextExtent(S)
   else
     Result := Canvas.TextExtent(Copy(S, StartPos, Len));
 {$ELSE}
   ptr := integer(Canvas) + TPersistent.InstanceSize;
   TCanvasHack(Canvas).RequiredState([csHandleValid, csFontValid]);
   {$IFDEF EC_UNICODE}
   GetTextExtentPoint32W(PHandle(ptr)^, PWideChar(@S[StartPos]), Len, Result);
   {$ELSE}
   GetTextExtentPoint32(PHandle(ptr)^, PChar(@S[StartPos]), Len, Result);
   {$ENDIF}
 {$ENDIF}
end;

procedure ecTextOut(Canvas: TCanvas; X, Y: integer; const S: ecString);
begin
 {$IFDEF EC_UNICODE}
  with TCanvasHack(Canvas) do
   begin
    Changing;
    RequiredState([csHandleValid, csFontValid, csBrushValid]);
    if CanvasOrientation = coRightToLeft then Inc(X, ecTextExtent(Canvas, S).cx + 1);
    Windows.ExtTextOutW(Handle, X, Y, TextFlags, nil, PWideChar(S),
     Length(S), nil);
    Changed;
   end;
 {$ELSE}
   {$IFDEF EC_DOTNET}
    Canvas.TextOut(X, Y, S);
   {$ELSE}
    TextOut(Canvas.Handle, X, Y, PChar(S), min(Length(S), 1000));
   {$ENDIF}
 {$ENDIF}
end;

{$IFDEF EC_MBCS}
function TestCharType(const S: string; Index: integer; Charset: TFontCharset): TMbcsByteType;
var cp, I: integer;
begin
  cp := CharSetToCodePage(Charset);

  Result := mbSingleByte;
  if S = '' then Exit;
  if (Index = 1) then
  begin
    if IsDBCSLeadByteEx(cp, Ord(S[1])) then Result := mbLeadByte;
  end
  else
  begin
    I := Index - 1;
    while (I >= 1) and IsDBCSLeadByteEx(cp, Ord(S[I])) do Dec(I);
    if ((Index - I) mod 2) = 0 then Result := mbTrailByte
    else if IsDBCSLeadByteEx(cp, Ord(S[Index])) then Result := mbLeadByte;
  end;
end;
{$ENDIF}

procedure ChangeStrCase(var S: ecString; ChangeCase: TChangeCase);
var j: integer;
    c: ecChar;
begin
  case ChangeCase of
    ccUpper: for j := 1 to Length(S) do
               S[j] := ecUpCase(S[j]);
    ccLower: for j := 1 to Length(S) do
               S[j] := ecLoCase(S[j]);
    ccToggle:for j := 1 to Length(S) do
                begin
                  c := ecUpCase(S[j]);
                  if c = S[j] then S[j] := ecLoCase(c)
                    else S[j] := c;
                end;
    ccTitle: if Length(S) > 0 then S[1] := ecUpCase(S[1]);
  end;
end;

function ecPosEx(const SubStr, S: ecString; Offset: Cardinal = 1): Integer;
var
  I,X: Integer;
  Len, LenSubStr: Integer;
begin
  if Offset = 1 then
    Result := Pos(SubStr, S)
  else
  begin
    I := Offset;
    LenSubStr := Length(SubStr);
    Len := Length(S) - LenSubStr + 1;
    while I <= Len do
    begin
      if S[I] = SubStr[1] then
      begin
        X := 1;
        while (X < LenSubStr) and (S[I + X] = SubStr[X + 1]) do
          Inc(X);
        if (X = LenSubStr) then
        begin
          Result := I;
          exit;
        end;
      end;
      Inc(I);
    end;
    Result := 0;
  end;
end;

function ec_UpperCase(const S: ecString): ecString;
var i: integer;
begin
  Result := S;
  for i := 1 to Length(S) do
    Result[i] := ecUpCase(S[i]);
end;

initialization
 CF_BLOCKTYPE := RegisterClipboardFormat('Borland IDE Block Type');
 CF_RTF := RegisterClipboardFormat('Rich Text Format');

end.
