tntsysutils.pas

TNTUniCtrlsWithExceptions UniCode 国际化语言

  inherited HelpContext := AHelpContext;
end;

constructor WideException.CreateFmtHelp(const Msg: WideString;
  const Args: array of const; AHelpContext: Integer);
begin
  FMessage := WideFormat(Msg, Args);
  inherited Message := FMessage;
  inherited HelpContext := AHelpContext;
end;

constructor WideException.CreateResHelp(Ident: Integer; AHelpContext: Integer);
begin
  FMessage := WideLoadStr(Ident);
  inherited Message := FMessage;
  inherited HelpContext := AHelpContext;
end;

constructor WideException.CreateResHelp(ResStringRec: PResStringRec;
  AHelpContext: Integer);
begin
  FMessage := WideLoadResString(ResStringRec);
  inherited Message := FMessage;
  inherited HelpContext := AHelpContext;
end;

constructor WideException.CreateResFmtHelp(Ident: Integer;
  const Args: array of const; AHelpContext: Integer);
begin
  FMessage := WideFormat(WideLoadStr(Ident), Args);
  inherited Message := FMessage;
  inherited HelpContext := AHelpContext;
end;

constructor WideException.CreateResFmtHelp(ResStringRec: PResStringRec;
  const Args: array of const; AHelpContext: Integer);
begin
  FMessage := WideFormat(WideLoadResString(ResStringRec), Args);
  inherited Message := FMessage;
  inherited HelpContext := AHelpContext;  
end;

procedure WideException.SetMessage(const Value: WideString);
begin
  FMessage := Value;
  inherited Message := FMessage;
end;

//---------------------------------------------------------------------------------------------
//                                 Tnt - SysUtils
//---------------------------------------------------------------------------------------------

{$IFNDEF COMPILER_9_UP}

  function _Tnt_WideFormatBuf(var Buffer; BufLen: Cardinal; const FormatStr;
    FmtLen: Cardinal; const Args: array of const
      {$IFDEF COMPILER_7_UP}; const FormatSettings: PFormatSettings {$ENDIF}): Cardinal;
  var
    OldFormat: WideString;
    NewFormat: WideString;
  begin
    SetString(OldFormat, PWideChar(@FormatStr), FmtLen);
    { The reason for this is that WideFormat doesn't correctly format floating point specifiers.
      See QC#4254. }
    NewFormat := ReplaceFloatingArgumentsInFormatString(OldFormat, Args{$IFDEF COMPILER_7_UP}, FormatSettings{$ENDIF});
    {$IFDEF COMPILER_7_UP}
    if FormatSettings <> nil then
      Result := WideFormatBuf(Buffer, BufLen, Pointer(NewFormat)^,
        Length(NewFormat), Args, FormatSettings^)
    else
    {$ENDIF}
      Result := WideFormatBuf(Buffer, BufLen, Pointer(NewFormat)^,
        Length(NewFormat), Args);
  end;

  function Tnt_WideFormatBuf(var Buffer; BufLen: Cardinal; const FormatStr;
    FmtLen: Cardinal; const Args: array of const): Cardinal;
  begin
    Result := _Tnt_WideFormatBuf(Buffer, BufLen, FormatStr, FmtLen, Args{$IFDEF COMPILER_7_UP}, nil{$ENDIF});
  end;

  {$IFDEF COMPILER_7_UP}
  function Tnt_WideFormatBuf(var Buffer; BufLen: Cardinal; const FormatStr;
    FmtLen: Cardinal; const Args: array of const; const FormatSettings: TFormatSettings): Cardinal;
  begin
    Result := _Tnt_WideFormatBuf(Buffer, BufLen, FormatStr, FmtLen, Args, @FormatSettings);
  end;
  {$ENDIF}

  procedure _Tnt_WideFmtStr(var Result: WideString; const FormatStr: WideString;
    const Args: array of const{$IFDEF COMPILER_7_UP}; const FormatSettings: PFormatSettings{$ENDIF});
  var
    Len, BufLen: Integer;
    Buffer: array[0..4095] of WideChar;
  begin
    BufLen := Length(Buffer); // Fixes buffer overwrite issue. (See QC #4703, #4744)
    if Length(FormatStr) < (Length(Buffer) - (Length(Buffer) div 4)) then
      Len := _Tnt_WideFormatBuf(Buffer, Length(Buffer) - 1, Pointer(FormatStr)^,
        Length(FormatStr), Args{$IFDEF COMPILER_7_UP}, FormatSettings{$ENDIF})
    else
    begin
      BufLen := Length(FormatStr);
      Len := BufLen;
    end;
    if Len >= BufLen - 1 then
    begin
      while Len >= BufLen - 1 do
      begin
        Inc(BufLen, BufLen);
        Result := '';          // prevent copying of existing data, for speed
        SetLength(Result, BufLen);
        Len := _Tnt_WideFormatBuf(Pointer(Result)^, BufLen - 1, Pointer(FormatStr)^,
          Length(FormatStr), Args{$IFDEF COMPILER_7_UP}, FormatSettings{$ENDIF});
      end;
      SetLength(Result, Len);
    end
    else
      SetString(Result, Buffer, Len);
  end;

  procedure Tnt_WideFmtStr(var Result: WideString; const FormatStr: WideString;
    const Args: array of const);
  begin
    _Tnt_WideFmtStr(Result, FormatStr, Args{$IFDEF COMPILER_7_UP}, nil{$ENDIF});
  end;

  {$IFDEF COMPILER_7_UP}
  procedure Tnt_WideFmtStr(var Result: WideString; const FormatStr: WideString;
    const Args: array of const; const FormatSettings: TFormatSettings);
  begin
    _Tnt_WideFmtStr(Result, FormatStr, Args, @FormatSettings);
  end;
  {$ENDIF}

  {----------------------------------------------------------------------------------------
    Without the FormatSettings parameter, Tnt_WideFormat is *NOT* necessary...
      TntSystem.InstallTntSystemUpdates([tsFixWideFormat]);
        will fix WideFormat as well as WideFmtStr.
  ----------------------------------------------------------------------------------------}
  function Tnt_WideFormat(const FormatStr: WideString; const Args: array of const): WideString;
  begin
    Tnt_WideFmtStr(Result, FormatStr, Args);
  end;

  {$IFDEF COMPILER_7_UP}
  function Tnt_WideFormat(const FormatStr: WideString; const Args: array of const;
    const FormatSettings: TFormatSettings): WideString;
  begin
    Tnt_WideFmtStr(Result, FormatStr, Args, FormatSettings);
  end;
  {$ENDIF}

{$ENDIF}

type
  PWStrData = ^TWStrData;
  TWStrData = record
    Ident: Integer;
    Str: WideString;
  end;

function EnumStringModules(Instance: Longint; Data: Pointer): Boolean;
var
  ResStringRec: TResStringRec;
begin
  with PWStrData(Data)^ do
  begin
    ResStringRec.Module^ := Instance;
    ResStringRec.Identifier := Ident;
    Str := WideLoadResString(@ResStringRec);
    Result := Str = '';
  end;
end;

function WideFindStringResource(Ident: Integer): WideString;
var
  StrData: TWStrData;
begin
  StrData.Ident := Ident;
  StrData.Str := '';
  EnumResourceModules(EnumStringModules, @StrData);
  Result := StrData.Str;
end;

function WideLoadStr(Ident: Integer): WideString;
begin
  Result := WideFindStringResource(Ident);
end;

function WideFmtLoadStr(Ident: Integer; const Args: array of const): WideString;
begin
  WideFmtStr(Result, WideFindStringResource(Ident), Args);
end;

function Tnt_WideUpperCase(const S: WideString): WideString;
begin
  {$IFNDEF COMPILER_10_UP}
  { SysUtils.WideUpperCase is broken for Win9x. }
  Result := S;
  if Length(Result) > 0 then
    Tnt_CharUpperBuffW(PWideChar(Result), Length(Result));
  {$ELSE}
  Result := SysUtils.WideUpperCase{TNT-ALLOW WideUpperCase}(S);
  {$ENDIF}
end;

function Tnt_WideLowerCase(const S: WideString): WideString;
begin
  {$IFNDEF COMPILER_10_UP}
  { SysUtils.WideLowerCase is broken for Win9x. }
  Result := S;
  if Length(Result) > 0 then
    Tnt_CharLowerBuffW(PWideChar(Result), Length(Result));
  {$ELSE}
  Result := SysUtils.WideLowerCase{TNT-ALLOW WideLowerCase}(S);
  {$ENDIF}
end;

function TntWideLastChar(const S: WideString): WideChar;
var
  P: PWideChar;
begin
  P := WideLastChar(S);
  if P = nil then
    Result := #0
  else
    Result := P^;
end;

function Tnt_WideStringReplace(const S, OldPattern, NewPattern: WideString;
  Flags: TReplaceFlags; WholeWord: Boolean = False): WideString;

  function IsWordSeparator(WC: WideChar): Boolean;
  begin
    Result := (WC = WideChar(#0))
           or IsWideCharSpace(WC)
           or IsWideCharPunct(WC);
  end;

var
  SearchStr, Patt, NewStr: WideString;
  Offset: Integer;
  PrevChar, NextChar: WideChar;
begin
  if rfIgnoreCase in Flags then
  begin
    SearchStr := Tnt_WideUpperCase(S);
    Patt := Tnt_WideUpperCase(OldPattern);
  end else
  begin
    SearchStr := S;
    Patt := OldPattern;
  end;
  NewStr := S;
  Result := '';
  while SearchStr <> '' do
  begin
    Offset := Pos(Patt, SearchStr);
    if Offset = 0 then
    begin
      Result := Result + NewStr;
      Break;
    end; // done

    if (WholeWord) then
    begin
      if (Offset = 1) then
        PrevChar := TntWideLastChar(Result)
      else
        PrevChar := NewStr[Offset - 1];

      if Offset + Length(OldPattern) <= Length(NewStr) then
        NextChar := NewStr[Offset + Length(OldPattern)]
      else
        NextChar := WideChar(#0);

      if (not IsWordSeparator(PrevChar))
      or (not IsWordSeparator(NextChar)) then
      begin
        Result := Result + Copy(NewStr, 1, Offset + Length(OldPattern) - 1);
        NewStr := Copy(NewStr, Offset + Length(OldPattern), MaxInt);
        SearchStr := Copy(SearchStr, Offset + Length(Patt), MaxInt);
        continue;
      end;
    end;

    Result := Result + Copy(NewStr, 1, Offset - 1) + NewPattern;
    NewStr := Copy(NewStr, Offset + Length(OldPattern), MaxInt);
    if not (rfReplaceAll in Flags) then
    begin
      Result := Result + NewStr;
      Break;
    end;
    SearchStr := Copy(SearchStr, Offset + Length(Patt), MaxInt);
  end;
end;

function TntAdjustLineBreaksLength(const S: WideString; Style: TTntTextLineBreakStyle = tlbsCRLF): Integer;
var
  Source, SourceEnd: PWideChar;
begin
  Source := Pointer(S);
  SourceEnd := Source + Length(S);
  Result := Length(S);
  while Source < SourceEnd do
  begin
    case Source^ of
      #10, WideLineSeparator:
        if Style = tlbsCRLF then
          Inc(Result);
      #13:
        if Style = tlbsCRLF then
          if Source[1] = #10 then
            Inc(Source)
          else
            Inc(Result)
        else
          if Source[1] = #10 then
            Dec(Result);
    end;
    Inc(Source);
  end;
end;

function TntAdjustLineBreaks(const S: WideString; Style: TTntTextLineBreakStyle = tlbsCRLF): WideString;
var
  Source, SourceEnd, Dest: PWideChar;
  DestLen: Integer;
begin
  Source := Pointer(S);
  SourceEnd := Source + Length(S);
  DestLen := TntAdjustLineBreaksLength(S, Style);
  SetString(Result, nil, DestLen);
  Dest := Pointer(Result);
  while Source < SourceEnd do begin
    case Source^ of
      #10, WideLineSeparator:
        begin
          if Style in [tlbsCRLF, tlbsCR] then
          begin
            Dest^ := #13;
            Inc(Dest);
          end;
          if Style in [tlbsCRLF, tlbsLF] then
          begin
            Dest^ := #10;
            Inc(Dest);
          end;
          Inc(Source);
        end;
      #13:
        begin
          if Style in [tlbsCRLF, tlbsCR] then
          begin
            Dest^ := #13;
            Inc(Dest);
          end;
          if Style in [tlbsCRLF, tlbsLF] then
          begin
            Dest^ := #10;
            Inc(Dest);
          end;
          Inc(Source);
          if Source^ = #10 then Inc(Source);
        end;
    else
      Dest^ := Source^;
      Inc(Dest);
      Inc(Source);
    end;
  end;
end;

function WideWrapText(const Line, BreakStr: WideString; const BreakChars: TSysCharSet;
  MaxCol: Integer): WideString;

  function WideCharIn(C: WideChar; SysCharSet: TSysCharSet): Boolean;
  begin
    Result := (C <= High(AnsiChar)) and (AnsiChar(C) in SysCharSet);
  end;

const
  QuoteChars = ['''', '"'];
var
  Col, Pos: Integer;
  LinePos, LineLen: Integer;
  BreakLen, BreakPos: Integer;
  QuoteChar, CurChar: WideChar;
  ExistingBreak: Boolean;
begin
  Col := 1;
  Pos := 1;
  LinePos := 1;
  BreakPos := 0;
  QuoteChar := ' ';
  ExistingBreak := False;
  LineLen := Length(Line);
  BreakLen := Length(BreakStr);
  Result := '';
  while Pos <= LineLen do
  begin
    CurChar := Line[Pos];
    if CurChar = BreakStr[1] then
    begin
      if QuoteChar = ' ' then
      begin
        ExistingBreak := WideSameText(BreakStr, Copy(Line, Pos, BreakLen));
        if ExistingBreak then
        begin
          Inc(Pos, BreakLen-1);
          BreakPos := Pos;
        end;
      end
    end
    else if WideCharIn(CurChar, BreakChars) then
    begin
      if QuoteChar = ' ' then BreakPos := Pos
    end
    else if WideCharIn(CurChar, QuoteChars) then
    begin
      if CurChar = QuoteChar then
        QuoteChar := ' '
      else if QuoteChar = ' ' then
        QuoteChar := CurChar;
    end;
    Inc(Pos);
    Inc(Col);
    if not (WideCharIn(QuoteChar, QuoteChars)) and (ExistingBreak or
      ((Col > MaxCol) and (BreakPos > LinePos))) then
    begin
      Col := Pos - BreakPos;
      Result := Result + Copy(Line, LinePos, BreakPos - LinePos + 1);
      if not (WideCharIn(CurChar, QuoteChars)) then
        while Pos <= LineLen do
        begin
          if WideCharIn(Line[Pos], BreakChars) then
            Inc(Pos)
          else if Copy(Line, Pos, Length(sLineBreak)) = sLineBreak then
            Inc(Pos, Length(sLineBreak))
          else
            break;
        end;
      if not ExistingBreak and (Pos < LineLen) then
        Result := Result + BreakStr;
      Inc(BreakPos);
      LinePos := BreakPos;
      ExistingBreak := False;
    end;
  end;
  Result := Result + Copy(Line, LinePos, MaxInt);
end;

function WideWrapText(const Line: WideString; MaxCol: Integer): WideString;
begin
  Result := WideWrapText(Line, sLineBreak, [' ', '-', #9], MaxCol); { do not localize }
end;

function WideIncludeTrailingBackslash(const S: WideString): WideString;
begin
  Result := WideIncludeTrailingPathDelimiter(S);
end;

function WideIncludeTrailingPathDelimiter(const S: WideString): WideString;
begin
  Result := S;
  if not WideIsPathDelimiter(Result, Length(Result)) then Result := Result + PathDelim;
end;

function WideExcludeTrailingBackslash(const S: WideString): WideString;
begin
  Result := WideExcludeTrailingPathDelimiter(S);
end;