tmsuflxmessages.pas

TMS Component Pack V5.0包含了超过 280 个为 Delphi 以及 C++Builder 设计的 TMS 生产控件

  /// for column 256.
  /// </remarks>
  /// <param name="C">Index to the column (1 based)</param>                                             
  function EncodeColumn(const C: integer): string;

  /// <summary>
  /// \Internal use. Returns a TFormatSettings object with the default settings.
  /// </summary>
  /// <remarks>
  /// This method will return a cached LocalSettings if supported by the Delphi version.
  /// </remarks>                                                                        
  function GetDefaultLocaleFormatSettings: PFormatSettings;

implementation

function EncodeColumn(const C: integer): string;
var
  Delta: integer;
begin
  Delta:=Ord('Z')-Ord('A')+1;
  if C<=Delta then Result:=chr(Ord('A')+C-1) else
    Result:=EncodeColumn(((C-1) div Delta))+ chr(Ord('A')+(C-1) mod Delta);
end;

function IsAbsolute(const AFileName: string): boolean;
begin
  if ExtractFileDrive(AFileName) <> '' then Result := true //this takes care of UNC drives too.
  else if (Length(AFileName) > 0) and (AFileName[1] = PathDelim) then Result := true
  else Result := false;
end;

function SearchPathStr(const AFileName: String): String;
begin
  Result := SearchPathStr('', AFileName)
end;

function SearchPathStr(const AFilePath, AFileName: String): String; overload;
var
  SearchPath: string;
  SearchFile: string;
begin
  if IsAbsolute(AFileName) then
  begin;
    if not FileExists(AFileName) then raise Exception.CreateFmt(ErrCantFindFile,[AFileName]);
    Result := AFileName;
    exit;
  end;

  if Trim(AFilePath) <> '' then
  begin
    SearchFile := IncludeTrailingPathDelimiter(AFilePath) + AFileName;
    if FileExists(SearchFile) then begin; Result := SearchFile; exit; end;
    raise Exception.CreateFmt(ErrCantFindFile,[SearchFile]);
  end;

  SearchPath := ExtractFilePath(ParamStr(0));
  SearchFile := IncludeTrailingPathDelimiter(SearchPath) + AFileName;
  if FileExists(SearchFile) then begin; Result := SearchFile; exit; end;

  SearchPath := ExtractFilePath(GetModuleName(HINSTANCE));
  SearchFile := IncludeTrailingPathDelimiter(SearchPath) + AFileName;
  if FileExists(SearchFile) then begin; Result := SearchFile; exit; end;
  

  raise Exception.CreateFmt(ErrCantFindFile,[AFileName]);

end; // SearchRecStr

{$IFDEF  VER130}
function IncludeTrailingPathDelimiter(const S: string): string;
begin
  Result:=IncludeTrailingBackslash(s);
end;

function VarIsClear(const v: variant): boolean;
begin
  Result:=VarIsNull(v);
end;

function TryStrToInt(const s: string; var i: integer): boolean;
var
  errcode: integer;
begin
  val(s, i, errcode);
  Result:= errCode = 0;
end;

function TryStrToFloat(const s: string; var i: extended): boolean;
var
  errcode: integer;
begin
  val(s, i, errcode);
  Result:= errCode = 0;
end;
{$ENDIF}

{$IFDEF NOFORMATSETTINGS}
procedure GetLocaleFormatSettings(LCID: Integer; var FormatSettings: TFormatSettings);
begin
  //Not supported in Delphi 5/6
end;

procedure EnsureAMPM(var FormatSettings: PFormatSettings);
begin
end;
{$ELSE}
procedure EnsureAMPM(var FormatSettings: PFormatSettings);
begin
       //Windows uses empty AM/PM designators as empty. Excel uses AM/PM. This happens for example on German locale.
      if (FormatSettings.TimeAMString = '') then
      begin
        FormatSettings.TimeAMString := 'AM';
      end;
      if (FormatSettings.TimePMString = '') then
      begin
        FormatSettings.TimePMString := 'PM';
      end;
end;
{$ENDIF}

var
  CachedRegionalCulture: TFormatSettings;  //Cached because it is slow.

function GetDefaultLocaleFormatSettings: PFormatSettings;
begin
{$IFNDEF NOFORMATSETTINGS}
  if (CachedRegionalCulture.DecimalSeparator = #0) then GetLocaleFormatSettings(-1, CachedRegionalCulture);
{$ENDIF}
  Result:= @CachedRegionalCulture;
end;

function TryStrToFloatInvariant(const s: string; out i: extended): boolean;
var
  errcode: integer;
begin
  i := 0;
  val(s, i, errcode);
  Result:= errCode = 0;
end;


{$IFDEF WIDEUPPEROK}
  function WideUpperCase98(const s: UTF16String):UTF16String;
  begin
  
  Result:=WideUpperCase(s);
  end;
{$ELSE}
  function WideUpperCase98(const s: UTF16String):UTF16String;
  var
    Len: Integer;
  begin
    Len := Length(S);
    SetString(Result, PWideChar(S), Len);
    if Len > 0 then CharUpperBuffW(Pointer(Result), Len);
    if GetLastError> 0 then result := UpperCase(s);
  end;
{$ENDIF}

//Defined as there is not posex on d5
function PosEx(const SubStr, S: UTF16String; Offset: Cardinal): Integer;
var
  i,k: integer;
  Equal: boolean;
begin
  i:= Offset;
  Result:=-1;

  while i<=Length(s)-Length(SubStr)+1 do
  begin
    if s[i]=Substr[1] then
    begin
      Equal:=true;
      for k:=2 to Length(Substr) do if s[i+k-1]<>Substr[k] then
      begin
        Equal:=false;
        break;
      end;
      if Equal then
      begin
        Result:=i;
        exit;
      end;
    end;
    inc(i);
  end;
end;

function StartsWith(const SubStr, S: UTF16String; Offset: integer): boolean;
var
  i: integer;
begin
  Result := false;

  if Offset - 1 + Length(SubStr) > Length(s)  then exit;

  for i := 1 to Length(SubStr) do
  begin
    if S[i + Offset - 1] <> SubStr[i] then exit;
  end;
  Result:= true;
end;

function StringReplaceSkipQuotes(const S, OldPattern, NewPattern: UTF16String): UTF16String;
var
  SearchStr, Patt: UTF16String;
  i,k,z: Integer;
  InQuote: boolean;
begin
  SearchStr := WideUpperCase98(S);
  Patt := WideUpperCase98(OldPattern);

  SetLength(Result, Length(SearchStr)*2);
  InQuote:=false;

  i:=1;k:=1;
  while i<= Length(SearchStr) do
  begin
    if SearchStr[i]='"' then InQuote:= not InQuote;
    if not InQuote and (StartsWith(Patt,SearchStr,i)) then
    begin
       if k+Length(NewPattern)-1>Length(Result) then SetLength(Result, k+Length(NewPattern)+100);
     for z:=1 to Length(NewPattern) do Result[z+k-1]:=NewPattern[z];
      inc(k, Length(NewPattern));
      inc(i, Length(Patt));
    end else
    begin
      if k>Length(Result) then SetLength(Result, k+100);
      Result[k]:=s[i];
      inc(i);
      inc(k);
    end;
  end;

  SetLength(Result, k-1);
end;


function DateIsOk(s: string; const v: TDateTime): boolean;
  //We have an issue with a string like '1.2.3'
  //If we are using german date separator (".") it will be converted to
  //Feb 1, 2003, which is ok. But, if we use another format, windows will think it
  //is a time, and will convert it to 1:02:03 am. That's why we added this 'patch' function.
var
  p: integer;
  i, err, k: integer;
begin
  Result:= true;
  if (Trunc(v)<>0) then exit;
  s:=s+'.';
  for i:=1 to 3 do
  begin
    p:= pos('.',s);
    if p<=0 then
    begin
      if i=3 then Result:=false;
      exit;
    end;
    val(copy(s,1,p-1), k, err);
    if (err<>0) or (k<0) then exit;
    s:=copy(s,p+1,Length(s));
  end;
  if trim(s)<'' then exit;
  Result:=false;
end;

function FlxTryStrToDateTime(const s:UTF16String; out Value: TDateTime; out dFormat: UTF16String; out HasDate, HasTime: boolean; const DateFormat: UTF16String=''; const TimeFormat: UTF16String=''): Boolean;
var
LResult: HResult;
  aDateFormat, aTimeFormat: UTF16String;
  {$IFDEF FLX_NOVARDATEFROMSTRING} //Delphi 5
    v1: olevariant;
  {$ENDIF}
begin
  if DateFormat='' then aDateFormat:=ShortDateFormat else aDateFormat:=DateFormat;
  if TimeFormat='' then aTimeFormat:=ShortTimeFormat else aTimeFormat:=TimeFormat;
  aTimeFormat:=StringReplaceSkipQuotes(aTimeFormat,'AMPM','AM/PM'); //Format AMPM is not recognized by Excel. This is harcoded on sysutils

  
    {$IFDEF FLX_NOVARDATEFROMSTRING} //Delphi 5. Doesn't work on kylix
      LResult:=VariantChangeType(v1, s, 0, varDate);
      Value:=v1;
    {$ELSE}
      //--------------------READ THIS!--------------------------------------------------------------------------------------//
      // If you get an error here with Delphi 6, make sure to install ALL latest Delphi 6 update packs, including RTL3 update
      //--------------------------------------------------------------------------------------------------------------------//
      // available from www.borland.com
      LResult := VarDateFromStr(S, FLX_VAR_LOCALE_USER_DEFAULT, 0, Value);
    

    Result:=(LResult = 0) and DateIsOk(s,Value);  //VAR_OK doesnt work on D5;
  {$ENDIF}

  //We have a problem with the german date separator "." and a.m. or p.m.
  //so we cant just test for a "." inside a formula to know it includes a date.
  HasDate:=(pos('.', s)>0) or (pos('/',s)>0) or (pos('-',s)>0)   //hate to hard-code this values, but I see not other viable way
          or (pos(DateSeparator, s)>0);
  HasDate:= HasDate and (Trunc(Value)>0);
  HasTime:=(pos(':',s)>0) or (pos(TimeSeparator, s)>0);    //Again... hard-coding :-( At least is isolated here

  if not HasDate and not HasTime then Result:=false;  //Things like "1A" are converted to times, even when it doesn't make sense.
  dFormat:='';
  if HasDate then dFormat:=dFormat+aDateFormat;
  if HasTime then
  begin
    if dFormat<>'' then dFormat:=dFormat+' ';
    dFormat:=dFormat+aTimeFormat;
  end;

end;

function TryFormatDateTime(const Fmt: string; value: TDateTime): string;
begin
  try
    Result :=FormatDateTime(Fmt, value);
  except
    Result :='##';
  end;
end;

function TryFormatDateTime1904(const Fmt: string; value: TDateTime; const Dates1904: boolean; const LocalSettings: TFormatSettings): string;
begin
  try
    if (Dates1904) then value:= value + Date1904Diff;
   {$IFDEF  NOFORMATSETTINGS}
    Result :=FormatDateTime(Fmt, value);
   {$ELSE}
    Result :=FormatDateTime(Fmt, value, LocalSettings);
   {$ENDIF}

  except
    Result :='##';
  end;
end;

function TryFormatDateTime1904(const Fmt: string; value: TDateTime; const Dates1904: boolean): string;
begin
  try
    if (Dates1904) then value:= value + Date1904Diff;
    Result :=FormatDateTime(Fmt, value);
  except
    Result :='##';
  end;
end;


function OffsetRange(const CellRange: TXlsCellRange; const DeltaRow, DeltaCol: integer): TXlsCellRange;
begin
  Result:=CellRange;
  inc(Result.Top, DeltaRow);
  inc(Result.Left, DeltaCol);
  inc(Result.Bottom, DeltaRow);
  inc(Result.Right, DeltaCol);
end;

procedure InitializeNamedRange(out NamedRange: TXlsNamedRange);
begin
  NamedRange.Name:='';
  NamedRange.RangeFormula:='';
  NamedRange.OptionFlags:=0;
  NamedRange.NameSheetIndex:=0;
end;


function VariantToString(const v: variant): UTF16String;
begin
{$IFDEF DELPHI2008UP}
  Result := VarToStr(v);
{$ELSE}
  Result := VarToWideStr(v);
{$ENDIF}
end;
end.