rvuni.pas

richview1.7 full.source

    for l := 0 to Length(s)-1 do
      Result[l*2+1] := RVDEFAULTCHARACTER
  end;
end;
{------------------------------------------------------------------------------}
function RVU_UnicodeToAnsi(CodePage: TRVCodePage; const s: String): String;
var l: Integer;
    DefChar: Char;
    Flags: Integer;
    Len: Integer;
begin
  if Length(s)=0 then begin
    Result := '';
    exit;
  end;
  RVCheckUni(Length(s));
  DefChar := RVDEFAULTCHARACTER;
  Flags := WC_COMPOSITECHECK or WC_DISCARDNS or WC_SEPCHARS or WC_DEFAULTCHAR;
  Len := Length(s) div 2;
  l := WideCharToMultiByte(CodePage, Flags, Pointer(s), Len, nil, 0, @DefChar, nil);
  if (l=0) and (CodePage<>CP_ACP) then begin
    CodePage := CP_ACP;
    l := WideCharToMultiByte(CodePage, Flags, Pointer(s), Len, nil, 0, @DefChar, nil);
  end;
  if l<>0 then begin
    SetLength(Result, l);
    WideCharToMultiByte(CodePage, Flags, Pointer(s), Len, PChar(Result), l, @DefChar, nil);
    end
  else begin
    SetLength(Result, Len);
    FillChar(PChar(Result)^, Len, RVDEFAULTCHARACTER);
  end;
end;
{------------------------------------------------------------------------------}
function RV_TestFileUnicode(const FileName: String): TRVUnicodeTestResult;
var Stream: TFileStream;
    FirstChar: Word;
    Len: Integer;
    s: String;
begin
  try
    Stream := TFileStream.Create(FileName, fmOpenRead);
    try
      if Stream.Size=0 then
        Result := rvutEmpty
      else if Stream.Size mod 2 <> 0 then
        Result := rvutNo
      else begin
        Stream.ReadBuffer(FirstChar, 2);
        if (FirstChar=UNI_LSB_FIRST) or
           (FirstChar=UNI_MSB_FIRST) then
          Result := rvutYes
        else begin
          Len := Stream.Size-2;
          if Len>500 then Len := 500;
          SetLength(s, Len);
          Stream.ReadBuffer(PChar(s)^, Len);
          if Pos(#0, s)<>0 then
            Result := rvutYes
          else
            Result := rvutProbably;
        end;
      end;
    finally
      Stream.Free;
    end;
  except
    Result := rvutError;
  end;
end;
{------------------------------------------------------------------------------}
function RVU_GetKeyboardCodePage: TRVCodePage;
var Buf: String;
    Len: Integer;
    Locale: LCID;
    {$IFNDEF RICHVIEWCBDEF3}
const LOCALE_IDEFAULTANSICODEPAGE     = $00001004;
    {$ENDIF}
begin
  Locale := GetKeyboardLayout(0) and $FFFF;
  Len := GetLocaleInfo(Locale, LOCALE_IDEFAULTANSICODEPAGE, nil, 0);
  SetLength(Buf, Len);
  GetLocaleInfo(Locale, LOCALE_IDEFAULTANSICODEPAGE, PChar(Buf), Len);
  Result := StrToIntDef(Buf, GetACP);
end;
{------------------------------------------------------------------------------}
function RVU_KeyToUnicode(const Key: String): String;
begin
  Result :=  RVU_AnsiToUnicode(RVU_GetKeyboardCodePage, Key);
end;
{------------------------------------------------------------------------------}
function RVU_StrScanW(Str: Pointer; Ch: Word; Length: Integer): Pointer;
// in: Str -> EAX, Ch -> EDX, Length -> ECX
// out: Result -> EAX
// Assums Str<>nil
asm
    JCXZ @@RetNil
@@Loop:
    CMP [EAX], DX
    JE @@Done
    INC EAX
    INC EAX
    DEC ECX
    JNZ @@Loop
@@RetNil:
    XOR EAX, EAX
@@Done:
end;

{------------------------------------------------------------------------------}
function GetCharHTMLCode(ch: Char; var prevspace, specialcode: Boolean): String;
begin
  if specialcode then begin
    Result := ch;
    prevspace := False;
    exit;
  end;
  if ch='&' then begin
    Result := '&amp;';
    prevspace := False;
    end
  else if ch='<' then begin
    Result := '&lt;';
    prevspace := False;
    end
  else if ch='>' then begin
    Result := '&gt;';
    prevspace := False;
    end
  else if ch=' ' then begin
    if prevspace then begin
      Result := '&nbsp;';
      prevspace := False;
      end
    else begin
      Result := ch;
      prevspace := True;
      end
    end
  else begin
    Result := ch;
    prevspace := False;
  end;
end;
{------------------------------------------------------------------------------}
procedure RVU_WriteHTMLEncodedUnicode(Stream: TStream; const s: String;NoEmptyLines,SpecialCode:Boolean);
var p: PWord;
    chars: String;
    i: Integer;
    prevspace: Boolean;
begin
  if (Length(s)=0) and NoEmptyLines then begin
    chars := '&nbsp;';
    Stream.WriteBuffer(PChar(chars)^,Length(chars));
  end;
  prevspace := True;
  p := PWord(PChar(s));
  for i := 1 to Length(s) div 2 do begin
    if (p^<128) then
      chars := GetCharHTMLCode(chr(p^), prevspace, SpecialCode)
    else begin
      chars := Format('&#%d;',[p^]);
      prevspace := False;
    end;
    Stream.WriteBuffer(PChar(chars)^,Length(chars));
    inc(PChar(p),2);
  end;
end;
{------------------------------------------------------------------------------}
function RVU_GetHTMLEncodedUnicode(const s: String;NoEmptyLines,SpecialCode:Boolean): String;
var p: PWord;
    i: Integer;
    prevspace: Boolean;
begin
  prevspace := True;
  Result := '';
  p := PWord(PChar(s));
  for i := 1 to Length(s) div 2 do begin
    if (p^<128) then
      Result := Result+GetCharHTMLCode(chr(p^), prevspace,SpecialCode)
    else begin
      Result := Result+Format('&#%d;',[p^]);
      prevspace := False;
    end;
    inc(PChar(p),2);
  end;
  if NoEmptyLines and (Length(Result)=0) then
    Result := '&nbsp;';
end;
{------------------------------------------------------------------------------}
function RV_ReturnCapitalized(const s: String; TextStyle: TFontInfo): String;
begin
  if rvfsAllCaps in TextStyle.StyleEx then begin
    {$IFNDEF RVDONOTUSEUNICODE}
    if TextStyle.Unicode then begin
      if RVNT then begin
        SetString(Result, PChar(s), Length(s));
        CharUpperBuffW(Pointer(Result), Length(s) div 2);
        end
      else
        Result := s;
      end
    else
   {$ENDIF}
     Result := AnsiUpperCase(s);
   end
  else
    Result := s;
end;

procedure RVCheckNT;
var vi: TOSVersionInfo;
begin
  vi.dwOSVersionInfoSize := sizeof(vi);
  GetVersionEx(vi);
  RVNT := vi.dwPlatformId=VER_PLATFORM_WIN32_NT;
end;

{------------------------------------------------------------------------------}
{$IFNDEF RVDONOTUSEUNICODE}
{$O+}
function GetCharLineBreakClass(Char: Word): TRVLineBreakClass;
begin
  case Char of
    $002D:
      Result := rvu_lb_HY;
    $002F:
      Result := rvu_lb_SY;
    $200B:
      Result := rvu_lb_ZW;
    $2014:
      Result := rvu_lb_B2;
    $2024..$2026:
      Result := rvu_lb_IN;
    $002C,$002E,$003A..$003B,$0589:
      Result := rvu_lb_IS;
    $00A0,$0F0C,$2007,$2011,$202F,$2060,$FEFF:
      Result := rvu_lb_GL;
    $00B4,$02C8,$02CC,$1806:
      Result := rvu_lb_BB;      
    $0009,$007C,$00AD,$058A,$0F0B,$1361,$1680,$17D5,$2000..$2006,$2008..$200A,
    $2010,$2012..$2013,$2027,$205F:
      Result := rvu_lb_BA;
    $0021,$003F,$2762..$2763,$FE56..$FE57,$FF01,$FF1F:
      Result := rvu_lb_EX;
    $0022,$0027,$00AB,$00BB,$2018..$2019,$201B..$201D,$201F,$2039..$203A,$23B6,
    $275B..$275E:
      Result := rvu_lb_QU;
    $0024,$002B,$005C,$00A3..$00A5,$00B1,$09F2..$09F3,$0E3F,$17DB,$20A0..$20A6,
    $20A8..$20B1,$2116,$2212..$2213,$FE69,$FF04,$FFE1,$FFE5..$FFE6:
      Result := rvu_lb_PR;
    $0025,$00A2,$00B0,$2030..$2037,$20A7,$2103,$2109,$2126,$FDFC,$FE6A,$FF05,
    $FFE0:
      Result := rvu_lb_PO;
    $0028,$005B,$007B,$0F3A,$0F3C,$169B,$201A,$201E,$2045,$207D,$208D,$2329,
    $23B4,$2768,$276A,$276C,$276E,$2770,$2772,$2774,$27E6,$27E8,$27EA,$2983,
    $2985,$2987,$2989,$298B,$298D,$298F,$2991,$2993,$2995,$2997,$29D8,$29DA,
    $29FC,$3008,$300A,$300C,$300E,$3010,$3014,$3016,$3018,$301A,$301D,$FD3E,
    $FE35,$FE37,$FE39,$FE3B,$FE3D,$FE3F,$FE41,$FE43,$FE59,$FE5B,$FE5D,$FF08,
    $FF3B,$FF5B,$FF5F,$FF62:
      Result := rvu_lb_OP;
    $0029,$005D,$007D,$0F3B,$0F3D,$169C,$2046,$207E,$208E,$232A,$23B5,$2769,
    $276B,$276D,$276F,$2771,$2773,$2775,$27E7,$27E9,$27EB,$2984,$2986,$2988,
    $298A,$298C,$298E,$2990,$2992,$2994,$2996,$2998,$29D9,$29DB,$29FD,
    $3001..$3002,$3009,$300B,$300D,$300F,$3011,$3015,$3017,$3019,$301B,
    $301E..$301F,$FD3F,$FE36,$FE38,$FE3A,$FE3C,$FE3E,$FE40,$FE42,$FE44,
    $FE50,$FE52,$FE5A,$FE5C,$FE5E,$FF09,$FF0C,$FF0E,$FF3D,$FF5D,$FF60..$FF61,
    $FF63..$FF64:
      Result := rvu_lb_CL;
    $0030..$0039,$0660..$0669,$06F0..$06F9,$0966..$096F,$09E6..$09EF,
    $0A66..$0A6F,$0AE6..$0AEF,$0B66..$0B6F,$0BE7..$0BEF,$0C66..$0C6F,
    $0CE6..$0CEF,$0D66..$0D6F,$0E50..$0E59,$0ED0..$0ED9,$0F20..$0F29,
    $1040..$1049,$1369..$1371,$17E0..$17E9,$1810..$1819:
      Result := rvu_lb_NU;
    $0E5A..$0E5B,$17D4,$17D6..$17DA,$203C,$2044,$3005,$301C,$303B..$303C,
    $3041,$3043,$3045,$3047,$3049,$3063,$3083,$3085,$3087,$308E,$3095..$3096,
    $309B..$309E,$30A0..$30A1,$30A3,$30A5,$30A7,$30A9,$30C3,$30E3,$30E5,$30E7,
    $30EE,$30F5..$30F6,$30FB,$30FD,$31F0..$31FF,$FE54..$FE55,$FF1A..$FF1B,
    $FF65,$FF67..$FF70,$FF9E..$FF9F:
      Result := rvu_lb_NS;
    $1100..$1159,$115F,$2E80..$2E99,$2E9B..$2EF3,$2F00..$2FD5,$2FF0..$2FFB,
    $3000,$3003..$3004,$3006..$3007,$3012..$3013,$3020..$3029,$3030..$303A,
    $303D..$303F,$3042,$3044,$3046,$3048,$304A..$3062,$3064..$3082,$3084,
    $3086,$3088..$308D,$308F..$3094,$309F,$30A2,$30A4,$30A6,$30A8,$30AA..$30C2,
    $30C4..$30E2,$30E4,$30E6,$30E8..$30ED,$30EF..$30F4,$30F7..$30FA,$30FC,
    $30FE..$30FF,$3105..$312C,$3131..$318E,$3190..$31B7,$3200..$321C,
    $3220..$3243,$3251..$327B,$327F..$32CB,$32D0..$32FE,$3300..$3376,
    $337B..$33DD,$33E0..$33FE,$3400..$4DB5,$4E00..$9FA5,$A000..$A48C,
    $A490..$A4C6,$AC00..$D7A3,$F900..$FA2D,$FA30..$FA6A,$FE30..$FE34,
    $FE45..$FE46,$FE49..$FE4F,$FE51,$FE58,$FE5F..$FE66,$FE68,$FE6B,
    $FF02..$FF03,$FF06..$FF07,$FF0A..$FF0B,$FF0D,$FF0F..$FF19,$FF1C..$FF1E,
    $FF20..$FF3A,$FF3C,$FF3E..$FF5A,$FF5C,$FF5E,$FFE2..$FFE4:
      Result := rvu_lb_ID;
    $0000..$0008,$000B,$000E..$001F,$007F..$009F,$0300..$034F,$0360..$036F,
    $0483..$0486,$0488..$0489,$0591..$05A1,$05A3..$05B9,$05BB..$05BD,$05BF,
    $05C1..$05C2,$05C4,$064B..$0655,$0670,$06D6..$06E4,$06E7..$06E8,
    $06EA..$06ED,$070F,$0711,$0730..$074A,$07A6..$07B0,$0901..$0903,$093C,
    $093E..$094D,$0951..$0954,$0962..$0963,$0981..$0983,$09BC,$09BE..$09C4,
    $09C7..$09C8,$09CB..$09CD,$09D7,$09E2..$09E3,$0A02,$0A3C,$0A3E..$0A42,
    $0A47..$0A48,$0A4B..$0A4D,$0A70..$0A71,$0A81..$0A83,$0ABC,$0ABE..$0AC5,
    $0AC7..$0AC9,$0ACB..$0ACD,$0B01..$0B03,$0B3C,$0B3E..$0B43,$0B47..$0B48,
    $0B4B..$0B4D,$0B56..$0B57,$0B82,$0BBE..$0BC2,$0BC6..$0BC8,$0BCA..$0BCD,
    $0BD7,$0C01..$0C03,$0C3E..$0C44,$0C46..$0C48,$0C4A..$0C4D,$0C55..$0C56,
    $0C82..$0C83,$0CBE..$0CC4,$0CC6..$0CC8,$0CCA..$0CCD,$0CD5..$0CD6,
    $0D02..$0D03,$0D3E..$0D43,$0D46..$0D48,$0D4A..$0D4D,$0D57,$0D82..$0D83,
    $0DCA,$0DCF..$0DD4,$0DD6,$0DD8..$0DDF,$0DF2..$0DF3,$0E31,$0E34..$0E3A,
    $0E47..$0E4E,$0EB1,$0EB4..$0EB9,$0EBB..$0EBC,$0EC8..$0ECD,$0F18..$0F19,
    $0F35,$0F37,$0F39,$0F3E..$0F3F,$0F71..$0F84,$0F86..$0F87,$0F90..$0F97,
    $0F99..$0FBC,$0FC6,$102C..$1032,$1036..$1039,$1056..$1059,$1160..$11A2,
    $11A8..$11F9,$1712..$1714,$1732..$1734,$1752..$1753,$1772..$1773,
    $17B4..$17D3,$180B..$180E,$18A9,$200C..$200F,$202A..$202E,$206A..$206F,
    $20D0..$20EA,$302A..$302F,$3099..$309A,$FB1E,$FE00..$FE0F,$FE20..$FE23,
    $FFF9..$FFFB:
      Result := rvu_lb_CM;
    else
      Result := rvu_lb_AL;
  end;
end;
{$ENDIF}

{$IFNDEF RICHVIEWDEF6}
{$IFDEF RICHVIEWCBDEF3}
function Utf8ToUnicode(Dest: PWideChar; MaxDestChars: Cardinal; Source: PChar; SourceBytes: Cardinal): Cardinal;
var
  i, count: Cardinal;
  c: Byte;
  wc: Cardinal;
begin
  if Source = nil then
  begin
    Result := 0;
    Exit;
  end;
  Result := Cardinal(-1);
  count := 0;
  i := 0;
  if Dest <> nil then
  begin
    while (i < SourceBytes) and (count < MaxDestChars) do
    begin
      wc := Cardinal(Source[i]);
      Inc(i);
      if (wc and $80) <> 0 then
      begin
        if i >= SourceBytes then Exit;          // incomplete multibyte char
        wc := wc and $3F;
        if (wc and $20) <> 0 then
        begin
          c := Byte(Source[i]);
          Inc(i);
          if (c and $C0) <> $80 then Exit;      // malformed trail byte or out of range char
          if i >= SourceBytes then Exit;        // incomplete multibyte char
          wc := (wc shl 6) or (c and $3F);
        end;
        c := Byte(Source[i]);
        Inc(i);
        if (c and $C0) <> $80 then Exit;       // malformed trail byte

        Dest[count] := WideChar((wc shl 6) or (c and $3F));
      end
      else
        Dest[count] := WideChar(wc);
      Inc(count);
    end;
    if count >= MaxDestChars then count := MaxDestChars-1;
    Dest[count] := #0;
  end
  else
  begin
    while (i < SourceBytes) do
    begin
      c := Byte(Source[i]);
      Inc(i);
      if (c and $80) <> 0 then
      begin
        if i >= SourceBytes then Exit;          // incomplete multibyte char
        c := c and $3F;
        if (c and $20) <> 0 then
        begin
          c := Byte(Source[i]);
          Inc(i);
          if (c and $C0) <> $80 then Exit;      // malformed trail byte or out of range char
          if i >= SourceBytes then Exit;        // incomplete multibyte char
        end;
        c := Byte(Source[i]);
        Inc(i);
        if (c and $C0) <> $80 then Exit;       // malformed trail byte
      end;
      Inc(count);
    end;
  end;
  Result := count+1;
end;

function Utf8Decode(const S: String): WideString;
var
  L: Integer;
  Temp: WideString;
begin
  Result := '';
  if S = '' then Exit;
  SetLength(Temp, Length(S));

  L := Utf8ToUnicode(PWideChar(Temp), Length(Temp)+1, PChar(S), Length(S));
  if L > 0 then
    SetLength(Temp, L-1)
  else
    Temp := '';
  Result := Temp;
end;
{$ENDIF}
{$ENDIF}

initialization
  RVCheckNT


end.