unitcharsetmap.pas

Delphi的另一款钢琴软件

    codePage := CP_USASCII;

  if gMultiLang and (codePage <> CP_ACP) then
  begin
    mode := 0;
    if not SUCCEEDED (gIMultiLanguage.ConvertStringFromUnicode(mode, codepage, PWideChar (ws), len, PChar (result), dlen)) then
      dlen := 0
  end
  else
    dlen := WideCharToMultiByte (codePage, 0, PWideChar (ws), len, PChar (result), len * 4, nil, nil);

  if dlen = 0 then
    result := ws
  else
    SetLength (result, dlen)
end;

function StringToWideString (const st : string; codePage : Integer) : WideString;
var
  len, dlen, mode : DWORD;
begin
  LoadMultiLanguage;
  if codePage = -1 then
    codePage := CP_USASCII;
  if st = '' then
    result := ''
  else
  begin
    len := Length (st);
    dlen := len * 4;
    SetLength (result, dlen);

    if gMultiLang and (codePage <> CP_ACP) then
    begin
      mode := 0;
      if not SUCCEEDED (gIMultiLanguage.ConvertStringToUnicode(mode, codepage, PChar (st), len, PWideChar (result), dlen)) then
        dlen := 0;
    end
    else
      dlen := MultiByteToWideChar (codepage, 0, PChar (st), len, PWideChar (result), len * 4);

    if dlen = 0 then
      result := st
    else
      SetLength (result, dlen)
  end
end;

function URLSuffixToCodePage (urlSuffix : string) : Integer;
var
  i : Integer;
begin
  LoadMultiLanguage;
  urlSuffix := LowerCase (urlSuffix);
  result := CP_USASCII;
  if urlSuffix <> '' then
    for i := Low (CharsetMap) to High (CharsetMap) do
      if CharsetMap [i].URLSuffix = urlSuffix then
      begin
        result := CharsetMap [i].CodePage;
        break
      end
end;

procedure GetCharsetNames (sl : TStrings);
var
  i : Integer;
  lst : string;
begin
  LoadMultiLanguage;
  sl.Clear;
  lst := '~';
  for i := Low (CharsetMap) to High (CharsetMap) do
    if lst <> CharsetMap [i].Name then
    begin
      lst := CharsetMap [i].Name;
      sl.Add (lst)
    end
end;

function TrimEx(const S: string): string;
var
  I, L: Integer;
begin
  L := Length(S);
  I := 1;
  while (I <= L) and ((S[I] = ' ') or (s [i] = #9)) do Inc(I);
  if I > L then Result := '' else
  begin
    while (S[L] = ' ') or (s [l] = #9) do Dec(L);
    Result := Copy(S, I, L - I + 1);
  end;
end;


function LCIDToCodePage(ALcid: LCID): Integer;
var
  Buffer: array [0..6] of Char;
begin
  GetLocaleInfo(ALcid, LOCALE_IDEFAULTANSICODEPAGE, Buffer, SizeOf(Buffer));
  Result:= StrToIntDef(Buffer, GetACP);
end;

function StringToGDIString (const s : String; codePage : Integer) : string;
var
  cs : TFontCharset;
  i : Integer;
  destCP : Integer;
  mode : DWORD;
  len, dlen : DWORD;
begin
  LoadMultiLanguage;
  cs := CodePageToCharset (codePage);

  destCP := -1;
  for i := Low (CharsetMap) to High (CharsetMap) do
    if (CharsetMap [i].CharSet = cs) and (CharsetMap [i].CodePage < 2000) then
    begin
      destCP := CharsetMap [i].codePage;
      break
    end;

  if (destCP = -1) or (destCP = codePage) or (gIMultiLanguage.IsConvertible (codePage, destCP) <> S_OK) then
    result := s
  else
  begin
    mode := 0;
    len := Length (s);
    dlen := len * 4;
    SetLength (result, dlen);
    if not SUCCEEDED (gIMultiLanguage.ConvertString (mode, codepage, destCP, PChar (s), len, PChar (result), dlen)) then
      dlen := 0;

    if dlen = 0 then
      result := s
    else
      SetLength (result, dlen)
  end
end;

function GDIStringToString (const s : string; codePage : Integer) : string;
var
  cs : TFontCharset;
  i : Integer;
  srcCP : Integer;
  mode : DWORD;
  len, dlen : DWORD;
begin
  LoadMultiLanguage;
  cs := CodePageToCharset (codePage);

  srcCP := -1;
  for i := Low (CharsetMap) to High (CharsetMap) do
    if (CharsetMap [i].CharSet = cs) and (CharsetMap [i].CodePage < 2000) then
    begin
      srcCP := CharsetMap [i].codePage;
      break
    end;

  if (srcCP = -1) or (srcCP = codePage) or (gIMultiLanguage.IsConvertible (srcCP, codePage) <> S_OK) then
    result := s
  else
  begin
    mode := 0;
    len := Length (s);
    dlen := len * 4;
    SetLength (result, dlen);
    if not SUCCEEDED (gIMultiLanguage.ConvertString (mode, srcCP, codepage, PChar (s), len, PChar (result), dlen)) then
      dlen := 0;

    if dlen = 0 then
      result := s
    else
      SetLength (result, dlen)
  end
end;

function IsWideCharAlpha (ch : WideChar) : boolean;
var
  w : word;
begin
  w := Word (ch);

  if w < $80 then       // Ascii range
    result := (w >=  $41) and (w <=  $5a) or
              (w >=  $61) and (w <=  $7a)
  else
  if w < $250 then     // Latin & extensions
    result := (w >=  $c0) and (w <=  $d6) or
              (w >=  $d8) and (w <=  $f6) or
              (w >=  $f7) and (w <=  $ff) or
              (w >= $100) and (w <= $17f) or
              (w >= $180) and (w <= $1bf) or
              (w >= $1c4) and (w <= $233)
  else
  if w < $370 then  // IPA Extensions
    result := (w >= $250) and (w <= $2ad)

  else
  if w < $400 then // Greek & Coptic
    result := (w >= $386) and (w < $3ff)

  else
  if w < $530 then      // Cryllic
    result := (w >= $400) and (w <= $47f) or
              (w >= $500) and (w <= $52f)
  else
  if w < $590 then      // Armenian
    result := (w >= $531) and (w <= $556) or
              (w >= $561) and (w <= $587)
  else

    result := True;     // Can't be bothered to do any more - for the moment!
end;

function IsWideCharAlnum (ch : WideChar) : boolean;
var
  w : word;
begin
  w := Word (ch);
  if (w >= $30) and (w <= $39) then
    result := True
  else
    result := IsWideCharAlpha (ch)
end;

procedure FontToCharFormat(font: TFont; codePage : Integer; var Format: TCharFormatW);
var
  wFontName : WideString;
begin
  FillChar (Format, SizeOf (Format), 0);

  Format.cbSize := sizeof (Format);
  Format.dwMask := Integer (CFM_SIZE or CFM_COLOR or CFM_FACE or CFM_CHARSET or CFM_BOLD or CFM_ITALIC or CFM_UNDERLINE or CFM_STRIKEOUT);

  if Font.Color = clWindowText then
    Format.dwEffects := CFE_AUTOCOLOR
  else
    Format.crTextColor := ColorToRGB (Font.Color);

  if fsBold in Font.Style then
    Format.dwEffects := Format.dwEffects or CFE_BOLD;

  if fsItalic in Font.Style then
    Format.dwEffects := Format.dwEffects or CFE_ITALIC;

  if fsUnderline in Font.Style then
    Format.dwEffects := Format.dwEffects or CFE_UNDERLINE;

  if fsStrikeOut in Font.Style then
    Format.dwEffects := Format.dwEffects or CFE_STRIKEOUT;


  Format.yHeight := Abs (Font.Size) * 20;
  Format.yOffset := 0;
  Format.bCharSet := CodePageToCharset (codePage);

  case Font.Pitch of
    fpVariable: Format.bPitchAndFamily := VARIABLE_PITCH;
    fpFixed: Format.bPitchAndFamily := FIXED_PITCH;
    else Format.bPitchAndFamily := DEFAULT_PITCH;
  end;

  wFontName := font.Name;
  lstrcpynw (Format.szFaceName, PWideChar (wFontName),LF_FACESIZE - 1) ;
end;

function WideStringToUTF8 (const ws : WideString) : string;
begin
  result := WideStringToString (ws, CP_UTF8);
end;

function UTF8TOWideString (const st : string) : WideString;
begin
  result := StringToWideString (st, CP_UTF8);
end;

initialization
  if (Win32Platform = VER_PLATFORM_WIN32_NT) and (Win32MajorVersion >= 5) then
    CP_USASCII := 20127
  else
    CP_USASCII := CP_ACP;

  gCharsetMap [0].CodePage := CP_USASCII;
  gCharsetMap [1].CodePage := CP_USASCII;

  DefaultCodePage := LCIDToCodePage (SysLocale.DefaultLCID);
end.