tntsysutilsex.pas

TntExUpdate 是 流行的 TntUnicodeControls控件的扩展包.包括很难找到的 TntJVCL 也在里面. TntSysUtils2.pas/TntSysUtilsEx.pa

unit TntSysUtilsEx;

interface

uses
  Windows, Classes, SysUtils;

type
  EWideException = class(Exception)
  private
    FMessage: WideString;
  public
    property Message: WideString read FMessage write FMessage;
    constructor Create(const Msg: WideString);
    constructor CreateRes(Res: PResStringRec);
    constructor CreateResFmt(Res: PResStringRec; const Args: array of const);
    constructor CreateFmt(const Msg: WideString; const Args: array of const);
  end;

procedure WideShowException(E: Exception);

function WideCapitalizeFirstLetter(const S: WideString): WideString;
function WideWordPosition(const N: Integer; const S: WideString;
  const WordDelims: array of WideChar): Integer;
function WideExtractWordPos(N: Integer; const S: WideString;
  const WordDelims: array of WideChar; var Pos: Integer): WideString;
function WideExtractWord(N: Integer; const S: WideString;
  const WordDelims: array of WideChar): WideString;
function WideWordCount(const S: WideString; const WordDelims: array of WideChar): Integer;
function WideTitleCaseString(const S: WideString): WideString;
function WideStringToStringExEx(const W: WideString; CodePage: Word; var Failed: BOOL):
  AnsiString;
function WideStringToCodePageISO(const W: WideString; CodePage: Word): AnsiString;

implementation

uses
  SysConst, TntWindows, TntSystem, TntSysUtils, TntClasses;

constructor EWideException.Create(const Msg: WideString);
begin
  inherited Create(Msg);
  FMessage := Msg;
end;

constructor EWideException.CreateFmt(const Msg: WideString;
  const Args: array of const);
begin
  FMessage := WideFormat(Msg, Args);
  inherited Create(FMessage);
end;

constructor EWideException.CreateRes(Res: PResStringRec);
begin
  FMessage := WideLoadResString(Res);
  inherited Create(FMessage);
end;

constructor EWideException.CreateResFmt(Res: PResStringRec;
  const Args: array of const);
begin
  FMessage := WideFormat(WideLoadResString(Res), Args);
  inherited Create(FMessage);
end;

procedure WideShowException(E: Exception);
var
  Title: WideString;
  Message: WideString;
begin
  SetLength(Title, 1024);
  Tnt_LoadStringW(FindResourceHInstance(HInstance), PResStringRec(@SExceptTitle).Identifier,
    PWideChar(Title), SizeOf(Title));
  if E is EWideException then
    Message := EWideException(E).Message
  else
    Message := E.Message;
  MessageBoxW(0, PWideChar(Message), PWideChar(Title),
    MB_OK or MB_ICONSTOP or MB_TASKMODAL);
end;

function WideUpperCase(A: WideChar): WideChar;
begin
  if (Word(A) < 256) and IsCharLower(Char(A)) then
    Result := WideChar(AnsiUppercase(A)[1])
  else
    case Word(A) of
      225..239, 241..246, 249..252: Result := WideChar(Word(A) - 32);
    else
      Result := A;
    end;
end;

function WideLowerCase(A: WideChar): WideChar;
begin
  if (Word(A) < 256) and IsCharUpper(Char(A)) then
    Result := WideChar(AnsiLowerCase(A)[1])
  else
    case Word(A) of
      192..207, 209..214, 217..220: Result := WideChar(Word(A) + 32);
    else
      Result := A;
    end;
end;

function CharIn(C: WideChar; CharSet: array of WideChar): Boolean;
var
  i: Integer;
begin
  for i := Low(CharSet) to High(CharSet) do
    if C = CharSet[i] then
    begin
      Result := True;
      Exit;
    end;
  Result := False;
end;

function WideWordCount(const S: WideString; const WordDelims: array of WideChar): Integer;
var
  SLen, I: Cardinal;
begin
  Result := 0;
  I := 1;
  SLen := Length(S);
  while I <= SLen do
  begin
    while (I <= SLen) and (CharIn(S[I], WordDelims)) do
      Inc(I);
    if I <= SLen then
      Inc(Result);
    while (I <= SLen) and not (CharIn(S[I], WordDelims)) do
      Inc(I);
  end;
end;


function WideCapitalizeFirstLetter(const S: WideString): WideString;
var
  I: Integer;
begin
  Result := S;
  if (Length(Result) > 1) and (Word(Result[1]) <= 255) then
    Result[1] := WideUpperCase(Result[1]);
  for i := 2 to Length(Result) do
  begin
    if Word(Result[I]) <= 255 then
    begin
      Result[I] := WideLowerCase(Result[I]);
    end;
  end;
end;

function WideWordPosition(const N: Integer; const S: WideString;
  const WordDelims: array of WideChar): Integer;
var
  Count, I: Integer;
begin
  Count := 0;
  I := 1;
  Result := 0;
  while (I <= Length(S)) and (Count <> N) do
  begin
    { skip over delimiters }
    while (I <= Length(S)) and (CharIn(S[I], WordDelims)) do
      Inc(I);
    { if we're not beyond end of S, we're at the start of a word }
    if I <= Length(S) then
      Inc(Count);
    { if not finished, find the end of the current word }
    if Count <> N then
      while (I <= Length(S)) and not (CharIn(S[I], WordDelims)) do
        Inc(I)
    else
      Result := I;
  end;
end;

function WideExtractWord(N: Integer; const S: WideString;
  const WordDelims: array of WideChar): WideString;
var
  I: Integer;
  Len: Integer;
begin
  Len := 0;
  I := WideWordPosition(N, S, WordDelims);
  if I <> 0 then
    { find the end of the current word }
    while (I <= Length(S)) and not (CharIn(S[I], WordDelims)) do
    begin
      { add the I'th character to result }
      Inc(Len);
      SetLength(Result, Len);
      Result[Len] := S[I];
      Inc(I);
    end;
  SetLength(Result, Len);
end;

function WideExtractWordPos(N: Integer; const S: WideString;
  const WordDelims: array of WideChar; var Pos: Integer): WideString;
var
  I, Len: Integer;
begin
  Len := 0;
  I := WideWordPosition(N, S, WordDelims);
  Pos := I;
  if I <> 0 then
    { find the end of the current word }
    while (I <= Length(S)) and not (CharIn(S[I], WordDelims)) do
    begin
      { add the I'th character to result }
      Inc(Len);
      SetLength(Result, Len);
      Result[Len] := S[I];
      Inc(I);
    end;
  SetLength(Result, Len);
end;


function WideTitleCaseString(const S: WideString): WideString;
var
  I: Integer;
begin
  Result := S;
  for I := 1 to Length(Result) do
  begin
    if Word(Result[I]) <= 255 then
    begin
      if (I = 1) or ((I > 1) and (Result[I - 1] = ' ')) then
        Result[I] := WideUpperCase(Result[I])
      else
        Result[I] := WideLowerCase(Result[I]);
    end;
  end;
end;

function WideStringToStringExEx(const W: WideString; CodePage: Word; var Failed: BOOL):
  AnsiString;
begin
  SetLength(Result, Length(W) * 2);
  SetLength(Result, WideCharToMultiByte(CodePage, 0, PWideChar(W), Length(W),
    PChar(Result), Length(Result), nil, @Failed));
end;

function WideStringToCodePageISO(const W: WideString; CodePage: Word): AnsiString;
var
  Src: PWideChar;
  i: Integer;
  Failed: BOOL;
  TempBuf: array[0..3] of Char;
begin
  Src := PWideChar(W);
  Result := '';
  for i := 1 to Length(W) do
  begin
    FillChar(TempBuf, SizeOf(TempBuf), 0);
    WideCharToMultibyte(CodePage, 0, Src, 1, @TempBuf,
      SizeOf(TempBuf), nil, @Failed);
    if not Failed then
      Result := Result + PChar(@TempBuf[0])
    else
      Result := Result + '&#' + IntToStr(Word(Src^)) + ';';
    Inc(Src);
  end;
end;

end.