rvuni.pas

richview1.7 full.source

unit RVUni;

interface
{$I RV_Defs.inc}

uses SysUtils, Windows, Classes, Graphics,
     RVItem, RVStyle, RVScroll;

type TRVIntegerArray = array[0..100000] of Integer;
     PRVIntegerArray = ^TRVIntegerArray;
type TRVUnsignedArray = array[0..100000] of Cardinal;
     PRVUnsignedArray = ^TRVUnsignedArray;
type TRVWordArray = array[0..100000] of Word;
     PRVWordArray = ^TRVWordArray;

{$IFNDEF RVDONOTUSEUNICODE}
function RVU_FindLineBreak(Str: PRVWordArray; Length: Integer): Pointer;
{$ENDIF}
function RVU_Copy(const s: String; Index, Count: Integer; ItemOptions: TRVItemOptions): String;
procedure RVU_Delete(var s: String; Index, Count: Integer; ItemOptions: TRVItemOptions);
procedure RVU_Insert(const Source: String; var s: String; Index: Integer; ItemOptions: TRVItemOptions);
procedure RVU_GetTextExtentExPoint(Canvas: TCanvas; const s: String;
                                  MaxExtent: Integer; var Fit: Integer;
                                  PDx: PRVIntegerArray;
                                  ItemOptions: TRVItemOptions);
procedure RVU_GetTextExtentExPointPC(Canvas: TCanvas; pc: PChar; Length: Integer;
                                  MaxExtent: Integer; var Fit: Integer;
                                  PDx: PRVIntegerArray;
                                  ItemOptions: TRVItemOptions;
                                  var sz: TSize);
function RVU_GetTextCaretPos(Canvas: TCanvas; const s: String;
                              PCP: PRVIntegerArray;
                              ItemOptions: TRVItemOptions): Boolean;
function RVU_Length(const s: String; ItemOptions: TRVItemOptions): Integer;
function RVU_TextWidth(const s: String; Canvas: TCanvas;
                       ItemOptions: TRVItemOptions): Integer;
function RVU_IsSpace(const s: String; Index: Integer;
                       ItemOptions: TRVItemOptions): Boolean;
function RVU_OffsInPChar(Offs: Integer; ItemOptions: TRVItemOptions): Integer;
{$IFDEF RICHVIEWCBDEF3}
function RVU_Charset2CodePage(Charset: TFontCharset): TRVCodePage;
function RVU_Charset2Language(Charset: TFontCharset): TRVCodePage;
function RVU_GetRawUnicode(const s: WideString):String;
function RVU_RawUnicodeToWideString(const s: String):WideString;
{$ELSE}
function RVU_GetRawUnicode(const s: String):String;
{$ENDIF}
procedure RVU_SwapWordBytes(arr: PWord; Count: Integer);

function RVU_AnsiToUnicode(CodePage: TRVCodePage; const s: String): String;
function RVU_UnicodeToAnsi(CodePage: TRVCodePage; const s: String): String;
function RVU_StrScanW(Str: Pointer; Ch: Word; Length: Integer): Pointer;

type TRVUnicodeTestResult = (rvutNo, rvutYes, rvutProbably, rvutEmpty, rvutError);
function RV_TestFileUnicode(const FileName: String): TRVUnicodeTestResult;

function RVU_GetKeyboardCodePage: TRVCodePage;
function RVU_KeyToUnicode(const Key: String): String;

procedure RVU_WriteHTMLEncodedUnicode(Stream: TStream; const s: String;NoEmptyLines, SpecialCode:Boolean);
function RVU_GetHTMLEncodedUnicode(const s: String;NoEmptyLines,SpecialCode:Boolean): String;

function RV_ReturnCapitalized(const s: String; TextStyle: TFontInfo): String;

function RVU_DrawSelectedTextEx(Left, Top, Height: Integer; const s: String; Canvas: TCanvas; Index1,Index2: Integer;
                                ItemOptions: TRVItemOptions;
                                BiDiMode: TRVBiDiMode): Boolean;
{$IFNDEF RICHVIEWDEF6}
{$IFDEF RICHVIEWCBDEF3}
function Utf8Decode(const S: String): WideString;
{$ENDIF}
{$ENDIF}


const
  UNI_LF                 = Word($000A);
  UNI_CR                 = Word($000D);
  UNI_LineSeparator      = Word($2028);
  UNI_ParagraphSeparator = Word($2029);
  UNI_VerticalTab        = Word($000B);
  UNI_FormFeed           = Word($000C);
  UNI_LSB_FIRST          = Word($FEFF);
  UNI_MSB_FIRST          = Word($FFFE);
  UNI_FF                 = Word($000C);
  UNI_HYPHEN             = Word($002D);
  UNI_Space              = Word(ord(' '));
  UNI_ZeroWidthSpace     = Word($200B);

  UNI_LSB_FIRST1         = #$FF;
  UNI_LSB_FIRST2         = #$FE;

var RVNT: Boolean;

implementation
uses CRVData, RVStr;

const
  GETCHARACTERPLACEMENTFLAGS = GCP_DIACRITIC or GCP_GLYPHSHAPE or GCP_USEKERNING or GCP_REORDER;

{------------------------------------------------------------------------------}
{$IFNDEF RVDONOTUSEUNICODE}
type
  TRVLineBreakClass =
  (
  rvu_lb_OP, // Opening Punctuation
  rvu_lb_CL, // Closing Punctuation
  rvu_lb_QU, // Ambiguous Quotation
  rvu_lb_GL, // Non-breaking ("Glue")
  rvu_lb_NS, // Non Starter
  rvu_lb_EX, // Exclamation/Interrogation
  rvu_lb_SY, // Symbols Allowing Breaks
  rvu_lb_IS, // Infix Separator (Numeric)
  rvu_lb_PR, // Prefix (Numeric)
  rvu_lb_PO, // Postfix (Numeric)
  rvu_lb_NU, // Numeric
  rvu_lb_AL, // Ordinary Alphabetic and Symbol Characters
  rvu_lb_ID, // Ideographic
  rvu_lb_IN, // Inseparable
  rvu_lb_HY, // Hyphen
  rvu_lb_BA, // Break Opportunity After
  rvu_lb_BB, // Break Opportunity Before
  rvu_lb_B2, // Break Opportunity Before and After
  rvu_lb_ZW, // Zero Width Space
  rvu_lb_CM // Attached Characters and Combining Marks
  );

  {
  rvu_lb_BK, // Mandatory Break // may not occur
  rvu_lb_CR, // Carriage Return // may not occur
  rvu_lb_LF, // Line Feed       // may not occur

  rvu_lb_SP, // Space           // special processing
  rvu_lb_SG, // Surrogates                            // treated as AL
  rvu_lb_CB, // Contingent Break Opportunity          // treated as AL
  rvu_lb_XX, // Unknown                               // treated as AL
  rvu_lb_SA, // Complex Context (South East Asian)    // treated as AL
  rvu_lb_AI, // Ambiguous (Alphabetic or Ideographic) // treated as AL
  }

  TRVLineBreakAction =
  (
     bk_DBK,  // direct break
     bk_IBK,  // indirect break
     bk_PBK   // prohibited break
  );
const
  BreakPairs : array [TRVLineBreakClass,TRVLineBreakClass] of TRVLineBreakAction =
  (
  (bk_PBK,bk_PBK,bk_PBK,bk_PBK,bk_PBK,bk_PBK,bk_PBK,bk_PBK,bk_PBK,bk_PBK,bk_PBK,bk_PBK,bk_PBK,bk_PBK,bk_PBK,bk_PBK,bk_PBK,bk_PBK,bk_PBK,bk_IBK),
  (bk_DBK,bk_PBK,bk_IBK,bk_IBK,bk_PBK,bk_PBK,bk_PBK,bk_PBK,bk_DBK,bk_IBK,bk_DBK,bk_DBK,bk_DBK,bk_DBK,bk_IBK,bk_IBK,bk_DBK,bk_DBK,bk_PBK,bk_IBK),
  (bk_PBK,bk_PBK,bk_IBK,bk_IBK,bk_IBK,bk_PBK,bk_PBK,bk_PBK,bk_IBK,bk_IBK,bk_IBK,bk_IBK,bk_IBK,bk_IBK,bk_IBK,bk_IBK,bk_IBK,bk_IBK,bk_PBK,bk_IBK),
  (bk_IBK,bk_PBK,bk_IBK,bk_IBK,bk_IBK,bk_PBK,bk_PBK,bk_PBK,bk_IBK,bk_IBK,bk_IBK,bk_IBK,bk_IBK,bk_IBK,bk_IBK,bk_IBK,bk_IBK,bk_IBK,bk_PBK,bk_IBK),
  (bk_DBK,bk_PBK,bk_IBK,bk_IBK,bk_IBK,bk_PBK,bk_PBK,bk_PBK,bk_DBK,bk_DBK,bk_DBK,bk_DBK,bk_DBK,bk_DBK,bk_IBK,bk_IBK,bk_DBK,bk_DBK,bk_PBK,bk_IBK),
  (bk_DBK,bk_PBK,bk_IBK,bk_IBK,bk_IBK,bk_PBK,bk_PBK,bk_PBK,bk_DBK,bk_DBK,bk_DBK,bk_DBK,bk_DBK,bk_DBK,bk_IBK,bk_IBK,bk_DBK,bk_DBK,bk_PBK,bk_IBK),
  (bk_DBK,bk_PBK,bk_IBK,bk_IBK,bk_IBK,bk_PBK,bk_PBK,bk_PBK,bk_DBK,bk_DBK,bk_IBK,bk_DBK,bk_DBK,bk_DBK,bk_IBK,bk_IBK,bk_DBK,bk_DBK,bk_PBK,bk_IBK),
  (bk_DBK,bk_PBK,bk_IBK,bk_IBK,bk_IBK,bk_PBK,bk_PBK,bk_PBK,bk_DBK,bk_DBK,bk_IBK,bk_DBK,bk_DBK,bk_DBK,bk_IBK,bk_IBK,bk_DBK,bk_DBK,bk_PBK,bk_IBK),
  (bk_IBK,bk_PBK,bk_IBK,bk_IBK,bk_IBK,bk_PBK,bk_PBK,bk_PBK,bk_DBK,bk_DBK,bk_IBK,bk_IBK,bk_IBK,bk_DBK,bk_IBK,bk_IBK,bk_DBK,bk_DBK,bk_PBK,bk_IBK),
  (bk_DBK,bk_PBK,bk_IBK,bk_IBK,bk_IBK,bk_PBK,bk_PBK,bk_PBK,bk_DBK,bk_DBK,bk_DBK,bk_DBK,bk_DBK,bk_DBK,bk_IBK,bk_IBK,bk_DBK,bk_DBK,bk_PBK,bk_IBK),
  (bk_DBK,bk_PBK,bk_IBK,bk_IBK,bk_IBK,bk_PBK,bk_PBK,bk_PBK,bk_DBK,bk_IBK,bk_IBK,bk_IBK,bk_DBK,bk_IBK,bk_IBK,bk_IBK,bk_DBK,bk_DBK,bk_PBK,bk_IBK),
  (bk_DBK,bk_PBK,bk_IBK,bk_IBK,bk_IBK,bk_PBK,bk_PBK,bk_PBK,bk_DBK,bk_DBK,bk_IBK,bk_IBK,bk_DBK,bk_IBK,bk_IBK,bk_IBK,bk_DBK,bk_DBK,bk_PBK,bk_IBK),
  (bk_DBK,bk_PBK,bk_IBK,bk_IBK,bk_IBK,bk_PBK,bk_PBK,bk_PBK,bk_DBK,bk_IBK,bk_DBK,bk_DBK,bk_DBK,bk_IBK,bk_IBK,bk_IBK,bk_DBK,bk_DBK,bk_PBK,bk_IBK),
  (bk_DBK,bk_PBK,bk_IBK,bk_IBK,bk_IBK,bk_PBK,bk_PBK,bk_PBK,bk_DBK,bk_DBK,bk_DBK,bk_DBK,bk_DBK,bk_IBK,bk_IBK,bk_IBK,bk_DBK,bk_DBK,bk_PBK,bk_IBK),
  (bk_DBK,bk_PBK,bk_IBK,bk_IBK,bk_IBK,bk_PBK,bk_PBK,bk_PBK,bk_DBK,bk_DBK,bk_DBK,bk_DBK,bk_DBK,bk_DBK,bk_IBK,bk_IBK,bk_DBK,bk_DBK,bk_PBK,bk_IBK),
  (bk_DBK,bk_PBK,bk_IBK,bk_IBK,bk_IBK,bk_PBK,bk_PBK,bk_PBK,bk_DBK,bk_DBK,bk_DBK,bk_DBK,bk_DBK,bk_DBK,bk_IBK,bk_IBK,bk_DBK,bk_DBK,bk_PBK,bk_IBK),
  (bk_IBK,bk_PBK,bk_IBK,bk_IBK,bk_IBK,bk_PBK,bk_PBK,bk_PBK,bk_IBK,bk_IBK,bk_IBK,bk_IBK,bk_IBK,bk_IBK,bk_IBK,bk_IBK,bk_IBK,bk_IBK,bk_PBK,bk_IBK),
  (bk_DBK,bk_PBK,bk_IBK,bk_IBK,bk_IBK,bk_PBK,bk_PBK,bk_PBK,bk_DBK,bk_DBK,bk_DBK,bk_DBK,bk_DBK,bk_DBK,bk_IBK,bk_IBK,bk_DBK,bk_PBK,bk_PBK,bk_IBK),
  (bk_DBK,bk_DBK,bk_DBK,bk_DBK,bk_DBK,bk_DBK,bk_DBK,bk_DBK,bk_DBK,bk_DBK,bk_DBK,bk_DBK,bk_DBK,bk_DBK,bk_DBK,bk_DBK,bk_DBK,bk_DBK,bk_PBK,bk_IBK),
  (bk_DBK,bk_PBK,bk_IBK,bk_IBK,bk_IBK,bk_PBK,bk_PBK,bk_PBK,bk_DBK,bk_DBK,bk_IBK,bk_IBK,bk_DBK,bk_IBK,bk_IBK,bk_IBK,bk_DBK,bk_DBK,bk_PBK,bk_IBK)
  );
{------------------------------------------------------------------------------}
function GetCharLineBreakClass(Char: Word): TRVLineBreakClass; forward;
{------------------------------------------------------------------------------}
// (We assumes that Str[Length] character exists)
// Returns the last character to leave on the line.
// In case of spaces, returns the space
function RVU_FindLineBreak(Str: PRVWordArray; Length: Integer): Pointer;
var i,j: Integer;
    cls, cls2: TRVLineBreakClass;
    act: TRVLineBreakAction;
begin
  Result := nil;
  if Str[Length]=UNI_Space then begin
    Result := @(Str[Length]);
    exit;
  end;
  cls := GetCharLineBreakClass(Str[Length]);
  for i := Length-1 downto 0 do begin
    if Str[i]=UNI_Space then
      continue;
    cls2 := GetCharLineBreakClass(Str[i]);
    act := BreakPairs[cls2, cls];
    if (act = bk_IBK) then
      if Str[i+1]<>UNI_Space then
        act := bk_PBK;
    if act in [bk_IBK, bk_DBK] then begin
      j := i;
      while (j+1<Length) and (Str[j+1]=UNI_Space) do
        inc(j);
      Result := @(Str[j]);
      exit;
    end;
    cls := cls2;
  end;
end;
{$ENDIF}
type
{$IFDEF RICHVIEWDEF7}
  TGetCharacterPlacementVal = Integer;
{$ELSE}
  TGetCharacterPlacementVal = LongBool;
{$ENDIF}
{------------------------------------------------------------------------------}
function RVU_DrawSelectedTextEx_(Left, Top, Height: Integer; const s: String; Canvas: TCanvas; Index1,Index2: Integer;
                                ItemOptions: TRVItemOptions): Boolean;
var res: TGCPResultsA;
    i,j: Integer;
    POrder,POrderRev: PRVUnsignedArray;
    PDX: PRVIntegerArray;
    Selected: PChar;
    SelectedCount: Integer;
    DX, idx, idx1, idx2, Start: Integer;
    Len: Integer;
    r: TRect;
begin
  if rvioUnicode in ItemOptions then
    Len := Length(s) div 2
  else
    Len := Length(s);
  r.Top := Top;
  r.Bottom := Top+Height;
  POrder := nil;
  POrderRev := nil;
  PDX       := nil;
  Selected  := nil;
  try
    GetMem(POrder,    Len*sizeof(Cardinal));
    GetMem(POrderRev, Len*sizeof(Cardinal));
    GetMem(PDX,       Len*sizeof(Integer));
    SelectedCount := Index2-Index1+1;
    GetMem(Selected, SelectedCount);
    FillChar(res, sizeof(res), 0);
    FillChar(POrder^, Len*sizeof(Cardinal), 0);
    FillChar(Selected^, SelectedCount, 1);
    res.lStructSize := sizeof(res);
    res.lpOrder := @(POrder[0]);
    res.lpDx    := @(PDX[0]);
    res.nGlyphs := Len;
    if rvioUnicode in ItemOptions then
      Result := GetCharacterPlacementW(Canvas.Handle, Pointer(s), TGetCharacterPlacementVal(Len), TGetCharacterPlacementVal(0), res,
                           GETCHARACTERPLACEMENTFLAGS)<>0
    else
      Result := GetCharacterPlacementA(Canvas.Handle, PChar(s), TGetCharacterPlacementVal(Len), TGetCharacterPlacementVal(0), res,
                           GETCHARACTERPLACEMENTFLAGS)<>0;
    if Result then begin
      for i := 0 to Len-1 do
        POrderRev[POrder[i]] := i;
      while SelectedCount>0 do begin
        Start := 0;
        for i := 0 to Len-1 do begin
          idx := POrderRev[i];
          if  (idx+1>=Index1) and (idx+1<=Index2) and
              (Selected[idx+1-Index1]<>#0) then begin
            idx1 := idx+1-1;
            idx2 := idx+1+1;
            while (idx2<=Index2) and (POrder[idx2-1]>POrder[idx+1-1]) and
                  (Integer(POrder[idx2-1]-POrder[idx+1-1])=idx2-(idx+1)) do
              inc(idx2);
            dec(idx2);
            while (idx1>=Index1) and (POrder[idx+1-1]>POrder[idx1-1]) and
                  (Integer(POrder[idx+1-1]-POrder[idx1-1])=(idx+1)-idx1) do
              dec(idx1);
            inc(idx1);
            r.Left := Left+Start;
            r.Right := r.Left;
            for j := idx1 to idx2 do begin
              //Assert(Selected[j-Index1]<>#0);
              Selected[j-Index1] := #0;
              dec(SelectedCount);
              inc(r.Right, PDX[POrder[j-1]]);
            end;
            if rvioUnicode in ItemOptions then begin
              ExtTextOutW(Canvas.Handle, Left,Top, ETO_CLIPPED or ETO_OPAQUE, @r,
                         Pointer(s), Length(s) div 2, nil);
              end
            else begin
              ExtTextOutA(Canvas.Handle, Left,Top, ETO_CLIPPED or ETO_OPAQUE, @r,
                         PChar(s), Length(s), nil);
            end;
            break;
          end;
          dx  := PDX[i];
          inc(Start,dx);
        end;
      end;
    end;
  finally
    FreeMem(POrder);
    FreeMem(POrderRev);
    FreeMem(PDX);
    FreeMem(Selected);
  end;
end;
{------------------------------------------------------------------------------}
function RVU_GetTextCaretPos(Canvas: TCanvas; const s: String;
                              PCP: PRVIntegerArray;
                              ItemOptions: TRVItemOptions): Boolean;
var res: TGCPResultsA;
    i: Integer;
    POrder,POrderRev: PRVUnsignedArray;
    PDX: PRVIntegerArray;
    PClass: PChar;
    DX, idx: Integer;
    cls: Char;
    p: Integer;
    Len: Integer;
begin
  if rvioUnicode in ItemOptions then
    Len := Length(s) div 2
  else
    Len := Length(s);
  POrder := nil;
  POrderRev := nil;
  PClass := nil;
  PDX    := nil;
  try
    GetMem(POrder,    Len*sizeof(Cardinal));
    GetMem(POrderRev, Len*sizeof(Cardinal));
    GetMem(PDX,       Len*sizeof(Integer));
    GetMem(PClass,    Length(s)); // for any case
    FillChar(res, sizeof(res), 0);
    FillChar(POrder^, Len*sizeof(Cardinal), 0);
    FillChar(PDX^,    Len*sizeof(Integer),  0);
    FillChar(PClass^, Length(s),            0);
    res.lStructSize := sizeof(res);
    res.nGlyphs := Len;
    res.lpOrder := @(POrder[0]);
    res.lpClass := PClass;
    res.lpDx    := @(PDX[0]);
    if rvioUnicode in ItemOptions then
      Result := GetCharacterPlacementW(Canvas.Handle, Pointer(s), TGetCharacterPlacementVal(Len), TGetCharacterPlacementVal(0), res,
                         GETCHARACTERPLACEMENTFLAGS)<>0
    else
      Result := GetCharacterPlacementA(Canvas.Handle, PChar(s),   TGetCharacterPlacementVal(Len), TGetCharacterPlacementVal(0), res,
                         GETCHARACTERPLACEMENTFLAGS)<>0;
    if Result then begin
      p := 0;
      for i := 0 to Len-1 do
        POrderRev[POrder[i]] := i;
      for i := 0 to Len-1 do begin
        idx := POrderRev[i];
        dx  := PDX[i];
        cls := PClass[idx];
        if cls in [chr(GCPCLASS_ARABIC),
                   chr(GCPCLASS_HEBREW)] then begin
          PCP[idx+1] := p;
          if idx=0 then
            PCP[0] := p+dx;
          end
        else begin
          PCP[idx+1] := p+dx+1;
          if idx=0 then
            PCP[0] := p;
        end;
        inc(p,dx);
      end;
    end;
  finally
    FreeMem(POrder);
    FreeMem(POrderRev);
    FreeMem(PClass);
    FreeMem(PDX);
  end;
end;
{$IFNDEF RVDONOTUSEUNICODE}
{------------------------------------------------------------------------------}
function RVU_Copy(const s: String; Index, Count: Integer; ItemOptions: TRVItemOptions): String;
begin
  if not (rvioUnicode in ItemOptions) then
    Result := Copy(s, Index, Count)
  else
    Result := Copy(s, 1+(Index-1)*2, Count*2);
end;
{------------------------------------------------------------------------------}
procedure RVU_GetTextExtentExPoint(Canvas: TCanvas; const s: String;
                                  MaxExtent: Integer; var Fit: Integer;
                                  PDx: PRVIntegerArray;
                                  ItemOptions: TRVItemOptions);
var sz: TSize;
    i: Integer;
  {$IFNDEF RICHVIEWDEF4}
    allocated: Boolean;
  {$ENDIF}
begin
  if Length(s)=0 then begin
    Fit := 0;
    exit;
  end;
  {$IFNDEF RICHVIEWDEF4}
  allocated := False;
  {$ENDIF}
  if not (rvioUnicode in ItemOptions) then begin
    {$IFNDEF RICHVIEWDEF4}
    if PDx=nil then begin
      GetMem(PDx, (Length(s)+1)*sizeof(Integer));
      allocated := True;
    end;
    {$ENDIF}
    GetTextExtentExPointA(Canvas.Handle,  PChar(s), Length(s), MaxExtent,
                            {$IFDEF RICHVIEWDEF4}
                            @Fit, PInteger(PDx),
                            {$ELSE}
                            Fit, PInteger(PDx)^,
                            {$ENDIF}
                            sz)
    end
  else if not (RVNT) then begin
    for i := 1 to Length(s) div 2 do begin
      GetTextExtentPoint32W(Canvas.Handle, Pointer(s), i, sz);
      if sz.cx>MaxExtent then begin
        Fit := i-1;