zextra.pas

一款由Zlib来的数学公式解析器

{******************************************************************
*  (c)copyrights Capella Development Group, Donetsk 1999 - 2000
*  Project: Zeos Library
*  Module: Extra functions
*  Author: Sergey Seroukhov   E-Mail: [e-mail]
*  Date: 24/04/99
*      
*  List of changes:
*   08/05/99 - Add function currency to string
*   13/03/00 - Fixed style, code improved (Thanks Robert Marquardt)
******************************************************************}

unit ZExtra;

interface

uses SysUtils, Classes, Db, ZToken;

{$INCLUDE Zeos.inc}

{**************** Extra functions definition ****************}

{ Last char position in string }
function LastPos(Value: string; Chr: Char): Integer;

{ string compare from the end }
function StrCmpEnd(Str1, Str2: string): Boolean;

{ string compare from the begin }
function StrCmpBegin(Str1, Str2: string): Boolean;

{ Compares strings case sensitively }
function StrCaseCmp(Str1, Str2: string): Boolean;

{ Convert string value to float with '.' delimiter }
function StrToFloatEx(Value: string): Double;

{ Convert string value to float with '.' delimiter with default value }
function StrToFloatDefEx(Value: string; Default: Double): Double;

{ Convert string value to float with '.' delimiter }
function StrToFloatCom(Value: string): Double;

{ Convert float value to string with '.' delimiter }
function FloatToStrEx(Value: Double): string;

{ Convert currency value to string }
function MoneyToString(Total: Double; Currency, Coin: string): string;

{ Get maximum value }
function Max(A, B: Integer): Integer;

{ Get minimum value }
function Min(A, B: Integer): Integer;

{****************** Functions for SQL92 dates processing  *******************}

{ Convert SQL Date to TDateTime }
function SqlDateToDateTime(Value: string): TDateTime;

{ Convert TDateTime to SQL Ansi-92 Date }
function DateTimeToSqlDate(Value: TDateTime): string;

{ Convert TDateTime to SQL Ansi-92 Date with constant date part}
function DateTimeToSqlDateEx(Value: TDateTime): string;

{ Format date to SQL92 standart }
function EncodeSqlDate(Year, Month, Day: Word): string;

{ Encode SQL92 date into year, month and day }
procedure DecodeSqlDate(Date: string; var Year, Month, Day: Word);

{ Define begin of a month }
function BeginMonth(Date: string): string;

{ Define last day of a month }
function LastDay(Month, Year: Word): Word;

{ Define and of a month }
function EndMonth(Date: string): string;

{ Define end of a previous month }
function PriorMonth(Date: string): string;

{ Define begin of a next month }
function NextMonth(Date: string): string;

{ Define previous day }
function PriorDay(Date: string): string;

{ Define next day }
function NextDay(Date: string): string;

implementation

{************** Extra functions implementation ***************}

{ Convert SQL Date to TDateTime }
function SqlDateToDateTime(Value: string): TDateTime;
var
  Year, Month, Day, Hour, Min, Sec: Integer;
  Temp: string;
begin
  Temp   := Value;
  Result := 0;
  if Length(Temp) > 8 then
  begin
    Year  := StrToIntDef(Copy(Temp,1,4),0);
    Month := StrToIntDef(Copy(Temp,6,2),0);
    Day   := StrToIntDef(Copy(Temp,9,2),0);

    if (Year*Month*Day) <> 0 then
      Result := EncodeDate(Year, Month, Day)
    else
      Result := 0;
  end;
  if Length(Temp) > 11 then
    Temp := Copy(Temp,12,8);
  if Length(Temp) <= 8 then
  begin
    Hour := StrToIntDef(Copy(Temp,1,2),0);
    Min  := StrToIntDef(Copy(Temp,4,2),0);
    Sec  := StrToIntDef(Copy(Temp,7,2),0);
    Result := Result + EncodeTime(Hour, Min, Sec, 0);
  end;
end;

{ Convert TDateTime to SQL Ansi-92 Date }
function DateTimeToSqlDate(Value: TDateTime): string;
begin
  Result := '';
  if Trunc(Value) <> 0 then
    Result := FormatDateTime('yyyy-mm-dd', Value);
  if Frac(Value) <> 0 then
  begin
    if Result <> '' then
      Result := Result + ' ';
    Result := Result + FormatDateTime('hh:nn:ss', Value);
  end;
end;

{ Convert TDateTime to SQL Ansi-92 Date with constant date part}
function DateTimeToSqlDateEx(Value: TDateTime): string;
begin
  Result := FormatDateTime('yyyy-mm-dd', Value);
  if Frac(Value) <> 0 then
  begin
    if Result <> '' then
      Result := Result + ' ';
    Result := Result + FormatDateTime('hh:nn:ss', Value);
  end;
end;

{ Last char position in string }
function LastPos(Value: string; Chr: Char): Integer;
begin
  Result := LastDelimiter(Chr, Value);
end;

{ string compare from the end }
function StrCmpEnd(Str1, Str2: string): Boolean;
var
  P1, P2: Integer;
begin
  Result := True;
  P1 := Length(Str1);
  P2 := Length(Str2);
  while (P1 > 0) and (P2 > 0) and Result do
  begin
    Result := (Str1[P1] = Str2[P2]);
    Dec(P1);
    Dec(P2);
  end;
end;

{ string compare from the begin }
function StrCmpBegin(Str1, Str2: string): Boolean;
begin
  if ((Str1 = '') or (Str2 = '')) and (Str1 <> Str2) then
    Result := False
  else
    Result := (StrLComp(PChar(Str1), PChar(Str2),
      Min(Length(Str1), Length(Str2))) = 0);
end;

{ Compares strings case sensitively }
function StrCaseCmp(Str1, Str2: string): Boolean;
begin
  Result := CompareText(Str1, Str2) = 0;
end;

{ Convert string value to float with '.' or ',' delimiter }
function StrToFloatEx(Value: string): Double;
var
  Ptr: PChar;
begin
  Ptr := PChar(Value);
  while Ptr^ <> #0 do
  begin
    if Ptr^ in [',','.'] then
      Ptr^ := DecimalSeparator;
    Inc(Ptr);
  end;
  if Value <> '' then
    try
      Result := StrToFloat(Value);
    except
      Result := 0;
    end
  else
    Result := 0;
end;

{ Convert string value to float with '.' delimiter }
function StrToFloatCom(Value: string): Double;
var
  Temp: Char;
begin
  Temp := DecimalSeparator;
  DecimalSeparator := '.';
  if Value <> '' then
    try
      Result := StrToFloat(Value);
    except
      Result := 0;
    end
  else
    Result := 0;
  DecimalSeparator := Temp;
end;

{ Convert string value to float with '.' delimiter with default value }
function StrToFloatDefEx(Value: string; Default: Double): Double;
var
  Ptr: PChar;
begin
  Ptr := PChar(Value);
  while Ptr^ <> #0
  do begin
    if Ptr^ in ['.',','] then
      Ptr^ := DecimalSeparator;
    Inc(Ptr);
  end;
  if Value <> '' then
    try
      Result := StrToFloat(Value);
    except
      Result := Default;
    end
  else
    Result := 0;
end;

{ Convert float value to string with '.' delimiter }
function FloatToStrEx(Value: Double): string;
begin
  Result := FloatToStr(Value);
end;

{ Convert currency value to string }
function MoneyToString(Total: Double; Currency, Coin: string): string;
const
{$IFDEF RUSSIAN}
  StrTop: array[0..5] of string =
    ('','螓