stdatest.pas

条码控件： 一维条码控件 二维条码控件 PDF417Barcode MaxiCodeBarcode

(* ***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * The Original Code is TurboPower SysTools
 *
 * The Initial Developer of the Original Code is
 * TurboPower Software
 *
 * Portions created by the Initial Developer are Copyright (C) 1996-2002
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** *)

{*********************************************************}
{* SysTools: StDateSt.pas 4.03                           *}
{*********************************************************}
{* SysTools: Date and time string manipulation           *}
{*********************************************************}

{$I StDefine.inc}

unit StDateSt;

interface

uses
  Windows, SysUtils,
  StStrS,
  StStrZ,
  StStrL,
  StConst,
  StBase,
  StUtils,
  StDate;

const
  {the following characters are meaningful in date Picture strings}
  MonthOnly = 'm';      {Formatting character for a date string picture mask}
  DayOnly = 'd';        {Formatting character for a date string picture mask}
  YearOnly = 'y';       {Formatting character for a date string picture mask}
  MonthOnlyU = 'M';     {Formatting character for a date string picture mask.
  Uppercase means pad with ' ' rather than '0'}
  DayOnlyU = 'D';       {Formatting character for a date string picture mask.
  Uppercase means pad with ' ' rather then '0'}
  DateSlash = '/';      {Formatting character for a date string picture mask}

  {'n'/'N' may be used in place of 'm'/'M' when the name of the month is
   desired instead of its number. E.g., 'dd/nnn/yyyy' -\> '01-Jan-1980'.
   'dd/NNN/yyyy' -\> '01-JAN-1980' (if SlashChar = '-'). The abbreviation used
   is based on the width of the subfield (3 in the example) and the current
   contents of the MonthString array.}
  NameOnly = 'n';       {Formatting character for a date string picture mask}
  NameOnlyU = 'N';      {Formatting character for a date string picture mask.
  Uppercase causes the output to be in uppercase}

  {'w'/'W' may be used to include the day of the week in a date string. E.g.,
  'www dd nnn yyyy' -\> 'Mon 01 Jan 1989'. The abbreviation used is based on
  the width of the subfield (3 in the example) and the current contents of the
  DayString array. Note that TurboPower Entry Fields will not allow the user to
  enter text into a subfield containing 'w' or 'W'. The day of the week will be
  supplied automatically when a valid date is entered.}
  WeekDayOnly = 'w';    {Formatting character for a date string picture mask}
  WeekDayOnlyU = 'W';   {Formatting character for a date string picture mask.
  Uppercase causes the output to be in uppercase}

  LongDateSub1 = 'f';   {Mask character used strictly for dealing with Window's
  long date format}
  LongDateSub2 = 'g';   {Mask character used strictly for dealing with Window's
  long date format}
  LongDateSub3 = 'h';   {Mask character used strictly for dealing with Window's
  long date format}

  HourOnly = 'h';       {Formatting character for a time string picture mask}
  MinOnly = 'm';        {Formatting character for a time string picture mask}
  SecOnly = 's';        {Formatting character for a time string picture mask}
  {if uppercase letters are used, numbers are padded with ' ' rather than '0'}
  HourOnlyU = 'H';      {Formatting character for a time string picture mask.
  Uppercase means pad with ' ' rather than '0'}
  MinOnlyU = 'M';       {Formatting character for a time string picture mask.
  Uppercase means pad with ' ' rather than '0'}
  SecOnlyU = 'S';       {Formatting character for a time string picture mask.
  Uppercase means pad with ' ' rather than '0'}
  {'hh:mm:ss tt' -\> '12:00:00 pm', 'hh:mmt' -\> '12:00p'}
  TimeOnly = 't';       {Formatting character for a time string picture mask.
  This generates 'AM' or 'PM'}
  TimeColon = ':';      {Formatting character for a time string picture mask}


  {-------julian date routines---------------}

function DateStringHMStoAstJD(const Picture, DS : string;              {!!.02}
  H,M,S,Epoch : integer) : Double;
  {-Returns the Astronomical Julian Date using a Date String,
  Hours, Minutes, Seconds}

function MonthToString(const Month : Integer) : string;
  {-Return the month as a string}

  {-------date string routines---------------}

function DateStringToStDate(const Picture, S : string; Epoch : Integer) : TStDate;
  {-Convert a string to a Julian date}

function DateStringToDMY(const Picture, S : string;
                         Epoch : Integer;
                         var D, M, Y : Integer) : Boolean;
  {-Extract day, month, and year from a date string}

function StDateToDateString(const Picture : string; const Julian : TStDate;
                            Pack : Boolean) : string;
  {-Convert a Julian date to a string}

function DayOfWeekToString(const WeekDay : TStDayType) : string;
  {-Return the day of the week specified by WeekDay as a string in Dest.}

function DMYtoDateString(const Picture : string;
                         Day, Month, Year, Epoch : Integer;
                         Pack : Boolean) : string;
  {-Merge the month, day, and year into the picture}

function CurrentDateString(const Picture : string; Pack : Boolean) : string;
  {-Return today's date as a string}

  {-------time routines---------------}

function CurrentTimeString(const Picture : string;
                           Pack : Boolean) : string;
  {-Return the current time as a string of the specified form}

function TimeStringToHMS(const Picture, St : string;
                         var H, M, S : Integer) : Boolean;
  {-Extract hours, minutes, seconds from a time string}

function TimeStringToStTime(const Picture, S : string) : TStTime;
  {-Convert a time string to a time variable}

function StTimeToAmPmString(const Picture : string;
                             const T : TStTime; Pack : Boolean) : string;
  {-Convert a time variable to a time string in am/pm format}

function StTimeToTimeString(const Picture : string; const T : TStTime;
                            Pack : Boolean) : string;
  {-Convert a time variable to a time string}


  {-------- routines for international date/time strings ---------}

function DateStringIsBlank(const Picture, S : string) : Boolean;
  {-Return True if the month, day, and year in S are all blank}

function InternationalDate(ForceCentury : Boolean) : string;
  {-Return a picture mask for a short date string, based on Windows' international
    information}

function InternationalLongDate(ShortNames : Boolean;
                               ExcludeDOW : Boolean) : string;
  {-Return a picture mask for a date string, based on Windows' international
    information}

function InternationalTime(ShowSeconds : Boolean) : string;
  {-Return a picture mask for a time string, based on Windows' international
    information}

procedure ResetInternationalInfo;
  {-Update internal info to match Windows' international info}


implementation

const
  First2Months = 59;           {1600 was a leap year}
  FirstDayOfWeek = Saturday;   {01/01/1600 was a Saturday}
  DateLen = 40;                {maximum length of Picture strings}
  MaxMonthName = 15;
  MaxDayName   = 15;

type
{  DateString = string[DateLen];}
  SString = string[255];

var
  wLongDate  : string[40];
  wldSub1    : string[6];
  wldSub2    : string[6];
  wldSub3    : string[6];
  wShortDate : string[31];
  w1159      : string[7];
  w2359      : string[7];
  wSlashChar : ANSIChar;
  wColonChar : ANSIChar;
  wTLZero    : Boolean;
  w12Hour    : Boolean;
  DefaultYear : Integer;     {default year--used by DateStringToDMY}
  DefaultMonth : ShortInt;   {default month}

  procedure ExtractFromPicture(const Picture, S : string; Ch : ANSIChar; {!!.02}
    var I : Integer; Blank, Default : Integer); forward;

  procedure AppendChar(var S : string; Ch : AnsiChar);
  begin
    SetLength(S,Succ(Length(S)));
    S[Length(S)] := Ch;
  end;

  function DayOfWeekToString(const WeekDay : TStDayType) : string;
    {-Return the day of the week specified by WeekDay as a string in Dest.
    Will honor international names}
  begin
    Result := LongDayNames[Ord(WeekDay)+1];
  end;

  function MonthToString(const Month : Integer) : string;
  {-Return the month as a string. Will honor international names}
  begin
    if (Month >= 1) and (Month <= 12) then
      Result := LongMonthNames[Month]
    else
       Result := '';
  end;

  function AstJulianDatePrim(Year,Month,Date : Integer) : Double;
  var
    A, B : integer;
  begin
    if Month <= 2 then                                                  {!!.01}
    begin
      Dec(Year);
      Inc(Month,12);
    end;
    A := Trunc(Year/100);
    B := 2 - A + Trunc(A/4);

    Result := Trunc(365.25 * (Year+4716))
            + Trunc(30.6001 * (Month+1))
            + Date + B - 1524.5;
  end;

  function DateStringHMSToAstJD(const Picture, DS : string;            {!!.02}
    H,M,S,Epoch : Integer) : Double;
    {-Returns the Astronomical Julian Date using a Date String,
    Hours, Minutes, Seconds}
  var
    Date, Month, Year : Integer;
  begin
    ExtractFromPicture(Picture, DS, NameOnly, Month, -1, 0);
    if Month = 0 then
      ExtractFromPicture(Picture, DS, MonthOnly, Month, -1, DefaultMonth);
    ExtractFromPicture(Picture, DS, DayOnly, Date, -1, 1);
    ExtractFromPicture(Picture, DS, YearOnly, Year, -1, DefaultYear);

    Year := ResolveEpoch(Year, Epoch);
    Result := AstJulianDatePrim(Year,Month,Date)
            + H/HoursInDay + M/MinutesInDay + S/SecondsInDay;
  end;

  function MonthStringToMonth(const MSt : string; Width : Byte) : Byte;{!!.02}
    {-Convert the month name in MSt to a month (1..12)}
  var
    S   : String;
    T   : String;
    Len : Byte;
    I   : Word;
  begin
    S := UpperCase(MSt);
    Len := Length(S);
    SetLength(S,Width);
    if Width > Len then
      FillChar(S[Len+1], Length(S)-Len, ' ');

    for I := 1 to 12 do begin
      T := UpperCase(LongMonthNames[I]);
      Len := Length(T);
      SetLength(T,Width);
      if Width > Len then
        FillChar(T[Len+1], Length(T)-Len, ' ');

      if S = T then begin
        Result := I;
        Exit;
      end;
    end;
    Result := 0;
  end;

  procedure ExtractFromPicture(const Picture, S : string; Ch : ANSIChar; {!!.02}
    var I : Integer; Blank, Default : Integer);
    {-Extract the value of the subfield specified by Ch from S and return in
      I. I will be set to -1 in case of an error, Blank if the subfield exists
      in Picture but is empty, Default if the subfield doesn't exist in
      Picture.}
  var
    PTmp : string;
    C, posLCCh, posUCCh : Cardinal;
    Code : Integer;
  begin
    {find the start of the subfield}
    I := Default;

    StrChPosL(Picture, Ch, posLCCh);
    Ch := Upcase(Ch);
    StrChPosL(Picture, Ch, posUCCh);

    if (posLCCh < 1) or ((posUCCh > 0) and (posUCCh < posLCCh)) then
      posLCCh := posUCCh;
    if (posLCCh < 1)  or (Length(S) <> Length(Picture)) then
       Exit;

    {extract the substring}

    PTmp := '';
    C := Length(Picture);
    while (posLCCh <= C) and (Upcase(Picture[posLCCh]) = Ch) do begin
      if S[posLCCh] <> ' ' then
        AppendChar(PTmp,AnsiChar(S[posLCCh]));
      Inc(posLCCh);
    end;

    if Length(PTmp) = 0 then
      I := Blank
    else if Ch = NameOnlyU then begin
      I := MonthStringToMonth(PTmp, Length(PTmp));
      if I = 0 then
        I := -1;
    end
    else begin
      {convert to a value}
      Val(PTmp, I, Code);
      if Code <> 0 then
        I := -1;
    end;
  end;

  function DateStringToDMY(const Picture, S : string;
                           Epoch : Integer;
                           var D, M, Y : Integer) : Boolean;
    {-Extract day, month, and year from S, returning true if string is valid}
  begin
    ExtractFromPicture(Picture, S, NameOnly, M, -1, 0);
    if M = 0 then
      ExtractFromPicture(Picture, S, MonthOnly, M, -1, DefaultMonth);
    ExtractFromPicture(Picture, S, DayOnly, D, -1, 1);
    ExtractFromPicture(Picture, S, YearOnly, Y, -1, DefaultYear);
    if ValidDate(D, M, Y, Epoch) then begin                          
      Result := True;                                                
      Y := ResolveEpoch(Y, Epoch);                                   
    end else                                                         
      Result := False;                                               
  end;

  function DateStringIsBlank(const Picture, S : string) : Boolean;
    {-Return True if the month, day, and year in S are all blank}
  var
    M, D, Y : Integer;
  begin