jclunicode.pas

East make Tray Icon in delphi

    Result := UnicodeDecomposeHangul(Code)
  else
  begin
    First := (Code shr 8) and $FF;
    Second := Code and $FF;
    if Compatible then
    begin
      // Check first stage table whether there is a particular block and
      // (if so) then whether there is a decomposition or not.
      if (CompatibleDecompositions[First] = nil) or (CompatibleDecompositions[First, Second] = nil) then
      begin
        // if there is no compatibility decompositions try canonical
        if (CanonicalDecompositions[First] = nil) or (CanonicalDecompositions[First, Second] = nil) then
          Result := nil
        else
          Result := CanonicalDecompositions[First, Second];
      end
      else
        Result := CompatibleDecompositions[First, Second];
    end
    else
    begin
      if (CanonicalDecompositions[First] = nil) or (CanonicalDecompositions[First, Second] = nil) then
        Result := nil
      else
        Result := CanonicalDecompositions[First, Second];
    end;
  end;
end;

//----------------- support for combining classes --------------------------------------------------

type
  TClassArray = array of Byte;

var
  // canonical combining classes, again as two stage matrix
  CCCsLoaded: Boolean;
  CCCs: array [Byte] of TClassArray;

procedure LoadCombiningClassData;
var
  Stream: TResourceStream;
  I, J, K,
  Size: Cardinal;
  Buffer: TRangeArray;
  First,
  Second: Byte;
begin
  // make sure no other code is currently modifying the global data area
  LoadInProgress.Enter;

  try
    if not CCCsLoaded then
    begin
      CCCsLoaded := True;
      Stream := TResourceStream.Create(HInstance, 'COMBINING', 'UNICODEDATA');
      try
        while Stream.Position < Stream.Size do
        begin
          // a) determine which class is stored here
          Stream.ReadBuffer(I, 4);
          // b) determine how many ranges are assigned to this class
          Stream.ReadBuffer(Size, 4);
          // c) read start and stop code of each range
          if Size > 0 then
          begin
            SetLength(Buffer, Size);
            Stream.ReadBuffer(Buffer[0], Size * SizeOf(TRange));

            // d) put this class in every of the code points just loaded
            for J := 0 to Size - 1 do
              for K := Buffer[J].Start to Buffer[J].Stop do
              begin
                Assert(K < $10000, LoadResString(@RsCombiningClassUnicodeChar));
                
                First := (K shr 8) and $FF;
                Second := K and $FF;
                // add second step array if not yet done
                if CCCs[First] = nil then
                  SetLength(CCCs[First], 256);
                CCCs[First, Second] := I;
              end;
          end;
        end;
      finally
        Stream.Free;
      end;
    end;
  finally
    LoadInProgress.Leave;
  end;
end;

function CanonicalCombiningClass(Code: Cardinal): Cardinal;
var
  First,
  Second: Byte;
begin
  // load combining class data if not already done
  if not CCCsLoaded then
    LoadCombiningClassData;

  First := (Code shr 8) and $FF;
  Second := Code and $FF;
  if CCCs[First] <> nil then
    Result := CCCs[First, Second]
  else
    Result := 0;
end;

//----------------- support for numeric values -----------------------------------------------------

type
  // structures for handling numbers
  TCodeIndex = record
    Code,
    Index: Cardinal;
  end;

var
  // array to hold the number equivalents for specific codes
  NumberCodes: array of TCodeIndex;
  // array of numbers used in NumberCodes
  Numbers: array of TUcNumber;

procedure LoadNumberData;
var
  Stream: TResourceStream;
  Size: Cardinal;
begin
  // make sure no other code is currently modifying the global data area
  LoadInProgress.Enter;

  try
    if NumberCodes = nil then
    begin
      Stream := TResourceStream.Create(HInstance, 'NUMBERS', 'UNICODEDATA');
      // Numbers are special (compared to other Unicode data) as they utilize two
      // arrays, one containing all used numbers (in nominator-denominator format) and
      // another one which maps a code point to one of the numbers in the first array.

      // a) determine size of numbers array
      Stream.ReadBuffer(Size, 4);
      SetLength(Numbers, Size);
      // b) read numbers data
      Stream.ReadBuffer(Numbers[0], Size * SizeOf(TUcNumber));
      // c) determine size of index array
      Stream.ReadBuffer(Size, 4);
      SetLength(NumberCodes, Size);
      // d) read index data
      Stream.ReadBuffer(NumberCodes[0], Size * SizeOf(TCodeIndex));
      Stream.Free;
    end;
  finally
    LoadInProgress.Leave;
  end;
end;

function UnicodeNumberLookup(Code: UCS4; var Number: TUcNumber): Boolean;
// Searches for the given code and returns its number equivalent (if there is one).
// Typical cases are: '1/6' (U+2159), '3/8' (U+215C), 'XII' (U+216B) etc.
// Result is set to True if the code could be found.
var
  L, R, M: Integer;
begin
  // load number data if not already done
  if NumberCodes = nil then
    LoadNumberData;

  Result := False;
  L := 0;
  R := High(NumberCodes);
  while L <= R do
  begin
    M := (L + R) shr 1;
    if Code > NumberCodes[M].Code then
      L := M + 1
    else
    begin
      if Code < NumberCodes[M].Code then
        R := M - 1
      else
      begin
        Number := Numbers[NumberCodes[M].Index];
        Result := True;
        Break;
      end;
    end;
  end;
end;

//----------------- support for composition --------------------------------------------------------

type
  // maps between a pair of code points to a composite code point
  // Note: the source pair is packed into one 4 byte value to speed up search. 
  TCompositionPair = record
    Code: Cardinal;
    Composition: UCS4;
  end;

var
  // list of composition mappings
  Compositions: array of TCompositionPair;

procedure LoadCompositionData;
var
  Stream: TResourceStream;
  Size: Cardinal;
begin
  // make sure no other code is currently modifying the global data area
  LoadInProgress.Enter;

  try
    if Compositions = nil then
    begin
      Stream := TResourceStream.Create(HInstance, 'COMPOSITION', 'UNICODEDATA');
      // a) determine size of compositions array
      Stream.ReadBuffer(Size, 4);
      SetLength(Compositions, Size);
      // b) read data
      Stream.ReadBuffer(Compositions[0], Size * SizeOf(TCompositionPair));
      Stream.Free;
    end;
  finally
    LoadInProgress.Leave;
  end;
end;

function UnicodeComposePair(First, Second: UCS4; var Composite: UCS4): Boolean;
// Maps the sequence of First and Second to a composite.
// Result is True if there was a mapping otherwise it is False.
var
  L, R, M, C: Integer;
  Pair: Integer;
begin
  if Compositions = nil then
    LoadCompositionData;

  Result := False;
  L := 0;
  R := High(Compositions);
  Pair := Integer((First shl 16) or Word(Second));
  while L <= R do
  begin
    M := (L + R) shr 1;
    C := Integer(Compositions[M].Code) - Pair;
    if C < 0  then
      L := M + 1
    else
    begin
      R := M - 1;
      if C = 0 then
      begin
        Result := True;
        L := M;
      end;
    end;
  end;
  if Result then
    Composite := Compositions[L].Composition;
end;

//=== { TSearchEngine } ======================================================

constructor TSearchEngine.Create(AOwner: TWideStrings);
begin
  FOwner := AOwner;
  FResults := TList.Create;
end;

destructor TSearchEngine.Destroy;
begin
  Clear;
  FResults.Free;
  inherited Destroy;
end;

procedure TSearchEngine.AddResult(Start, Stop: Cardinal);
begin
  FResults.Add(Pointer(Start));
  FResults.Add(Pointer(Stop));
end;

procedure TSearchEngine.Clear;
begin
  ClearResults;
end;

procedure TSearchEngine.ClearResults;
begin
  FResults.Clear;
end;

procedure TSearchEngine.DeleteResult(Index: Cardinal);
// explicitly deletes a search result
begin
  with FResults do
  begin
    // start index
    Delete(2 * Index);
    // stop index
    Delete(2 * Index);
  end;
end;

function TSearchEngine.GetCount: Integer;
// returns the number of matches found
begin
  Result := FResults.Count div 2;
end;

procedure TSearchEngine.GetResult(Index: Cardinal; var Start, Stop: Integer);
// returns the start position of a match (end position can be determined by
// adding the length of the pattern to the start position)
begin
  Start := Cardinal(FResults[2 * Index]);
  Stop := Cardinal(FResults[2 * Index + 1]);
end;

//----------------- TUTBSearch ---------------------------------------------------------------------

procedure TUTBMSearch.ClearPattern;
begin
  FreeMem(FPattern);
  FPattern := nil;
  FFlags := [];
  FPatternUsed := 0;
  FPatternSize := 0;
  FPatternLength := 0;
  FreeMem(FSkipValues);
  FSkipValues := nil;
  FSkipsUsed := 0;
  FMD4 := 0;
end;

function TUTBMSearch.GetSkipValue(TextStart, TextEnd: PUCS2): Cardinal;
// looks up the SkipValues value for a character
var
  I: Integer;
  C1,
  C2: UCS4;
  Sp: PUTBMSkip;
begin
  Result := 0;
  if Cardinal(TextStart) < Cardinal(TextEnd) then
  begin
    C1 := UCS4(TextStart^);
    if (TextStart + 1) < TextEnd then
      C2 := UCS4((TextS