stdatest.pas

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

    ExtractFromPicture(Picture, S, NameOnly,  M, -2, 0);
    if M = 0 then
      ExtractFromPicture(Picture, S, MonthOnly, M, -2, -2);
    ExtractFromPicture(Picture, S, DayOnly,   D, -2, -2);
    ExtractFromPicture(Picture, S, YearOnly,  Y, -2, -2);
    Result := (M = -2) and (D = -2) and (Y = -2);
  end;


  function DateStringToStDate(const Picture, S : string; Epoch : Integer) : TStDate;
    {-Convert S, a string of the form indicated by Picture, to a julian date.
      Picture and S must be of equal lengths}
  var
    Month, Day, Year : Integer;
  begin
    {extract day, month, year from S}
    if DateStringToDMY(Picture, S, Epoch, Day, Month, Year) then
      {convert to julian date}
      Result := DMYtoStDate(Day, Month, Year, Epoch)
    else
      Result := BadDate;
  end;

  function SubstCharSim(P : string; OC, NC : ANSIChar) : string;
  var
     step : integer;
  begin
    for step := 1 to Length(P) do
    begin
      if P[step] = OC then
        P[step] := NC;
    end;
    Result := P;
  end;

  function SubstChar(Picture : string; OldCh, NewCh : ANSIChar) : string;
    {-Replace all instances of OldCh in Picture with NewCh}
  var
    I    : Integer;
    UpCh : ANSIChar;
    P    : Cardinal;
  begin
    UpCh := Upcase(OldCh);
    if (StrChPosL(Picture,OldCh,P)) or (StrChPosL(Picture,UpCh,P)) then
      for I := 1 to Length(Picture) do
        if Upcase(Picture[I]) = UpCh then
          Picture[I] := NewCh;
    Result := Picture;
  end;

  function PackResult(const Picture, S : string) : string;             {!!.02}
    {-Remove unnecessary blanks from S}
  var
    step     : Integer;
  begin
    Result := '';

    for step := 1 to Length(Picture) do
    begin
      case Picture[step] of
        MonthOnlyU, DayOnlyU, NameOnly, NameOnlyU, WeekDayOnly,
        WeekDayOnlyU, HourOnlyU, SecOnlyU :
          if S[step] <> ' ' then
            AppendChar(Result,S[Step]);
        TimeOnly :
          if S[step] <> ' ' then
            AppendChar(Result,S[step]);
      else
        AppendChar(Result,S[step]);
      end;
    end;
  end;

  procedure MergeIntoPicture(var Picture : string; Ch : ANSIChar; I : Integer);
    {-Merge I into location in Picture indicated by format character Ch}
  var
    Tmp     : string[40];
    C,
    J, K, L : Cardinal;
    UCh,
    CPJ,
    CTI     : ANSIChar;
    OK, Done: Boolean;
    step  : Cardinal;
  begin
    {find the start of the subfield}
    OK := StrChPosL(Picture,Ch,J);
    UCh := Upcase(Ch);
    if (NOT OK) then
    begin
      if NOT (StrChPosL(Picture, UCh, J)) then
        Exit;
    end;

    {find the end of the subfield}
    K := J;
    C := Length(Picture);
    while (J <= C) and (Upcase(Picture[J]) = UCh) do
      Inc(J);
    Dec(J);

    if (UCh = WeekDayOnlyU) or (UCh = NameOnlyU) then begin
      if UCh = WeekDayOnlyU then
        case I of
          Ord(Sunday)..Ord(Saturday) :
            Tmp := LongDayNames[I+1];
          else
            Tmp := '';
        end
      else
        case I of
          1..12 :
            Tmp := LongMonthNames[I];
          else
            Tmp := '';
        end;
      K := Succ(J-K);
      if K > Length(Tmp) then
        for step := 1 to (K-Length(Tmp)) do
          Tmp := Tmp + ' ';
      Tmp := Copy(Tmp,1,K);
    end else
      {convert I to a string}
      Str(I:DateLen, Tmp);

    {now merge}
    L := Length(Tmp);
    Done := False;
    CPJ := Picture[J];

    while (Upcase(CPJ) = UCh) and not Done do
    begin
      CTI := Tmp[L];
      if (UCh = NameOnlyU) or (UCh = WeekDayOnlyU) then
      begin
        case CPJ of
          NameOnlyU, WeekDayOnlyU :
            CTI := Upcase(CTI);
        end;
      end
      else{change spaces to 0's if desired}
        if (CPJ >= 'a') and (CTI = ' ') then
          CTI := '0';
      Picture[J] := CTI;
      Done := (J = 1) or (L = 0);
      if not Done then
      begin
        Dec(J);
        Dec(L);
      end;
      CPJ := Picture[J];
    end;
  end;


  procedure MergePictureSt(const Picture : string; var P : string;     {!!.02}
                          MC : ANSIChar; const SP : string);           {!!.02}
  var
    I, J : Cardinal;
    L    : Cardinal;
  begin
    if NOT (StrChPosL(Picture,MC,I)) then
       Exit;
    J := 1;
    L := Length(SP);
    while Picture[I] = MC do begin
      {if J <= Length(SP) then}
      if (L = 0) or (J > L) then
        P[I] := ' '
      else begin
        P[I] := SP[J];
        Inc(J);
      end;
      Inc(I);
    end;
  end;


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

  begin
    Result := Picture;

    Year := ResolveEpoch(Year, Epoch);

    DOW := Integer( DayOfWeekDMY(Day, Month, Year, 0) );
    MergeIntoPicture(Result, MonthOnly,   Month);
    MergeIntoPicture(Result, DayOnly,     Day);
    MergeIntoPicture(Result, YearOnly,    Year);
    MergeIntoPicture(Result, NameOnly,    Month);
    MergeIntoPicture(Result, WeekDayOnly, DOW);

    {map slashes}
    Result := SubstChar(Result, DateSlash, wSlashChar);

    MergePictureSt(Picture, Result, LongDateSub1, wldSub1);
    MergePictureSt(Picture, Result, LongDateSub2, wldSub2);
    MergePictureSt(Picture, Result, LongDateSub3, wldSub3);

    if Pack then
      Result:= PackResult(Picture, Result);
  end;

  function StDateToDateString(const Picture : string; const Julian : TStDate;
                              Pack : Boolean) : string;
    {-Convert Julian to a string of the form indicated by Picture}
  var
    Month, Day, Year : Integer;
  begin
    Result := Picture;
    if Julian = BadDate then begin
      {map picture characters to spaces}
      Result := SubstChar(Result, MonthOnly,   ' ');
      Result := SubstChar(Result, NameOnly,    ' ');
      Result := SubstChar(Result, DayOnly,     ' ');
      Result := SubstChar(Result, YearOnly,    ' ');
      Result := SubstChar(Result, WeekDayOnly, ' ');

      MergePictureSt(Picture, Result, LongDateSub1, wldSub1);
      MergePictureSt(Picture, Result, LongDateSub2, wldSub2);
      MergePictureSt(Picture, Result, LongDateSub3, wldSub3);

      {map slashes}
      Result := SubstChar(Result, DateSlash, wSlashChar);
    end
    else begin
      {convert Julian to day/month/year}
      StDateToDMY(Julian, Day, Month, Year);

      {merge the month, day, and year into the picture}
      Result := DMYtoDateString(Picture, Day, Month, Year, 0, Pack);
    end;
  end;

  function CurrentDateString(const Picture : string; Pack : Boolean) : string;
    {-Returns today's date as a string of the specified form}
  begin
    Result := StDateToDateString(Picture, CurrentDate, Pack);
  end;

  function TimeStringToHMS(const Picture, St : string; var H, M, S : Integer) : Boolean;
    {-Extract Hours, Minutes, Seconds from St, returning true if string is valid}
  var
    I,
    J      : Cardinal;
    Tmp,
    t1159,
    t2359  : string[20];
  begin
    {extract hours, minutes, seconds from St}
    ExtractFromPicture(Picture, St, HourOnly, H, -1, 0);
    ExtractFromPicture(Picture, St, MinOnly,  M, -1, 0);
    ExtractFromPicture(Picture, St, SecOnly,  S, -1, 0);
    if (H = -1) or (M = -1) or (S = -1) then begin
      Result := False;
      Exit;
    end;

    {check for TimeOnly}
    if (StrChPosL(Picture, TimeOnly, I)) and
       (Length(w1159) > 0) and (Length(w2359) > 0) then begin

      Tmp := '';
      J := 1;
      while (I <= Cardinal(Length(Picture))) and (Picture[I] = TimeOnly) do begin{!!.02}
  //      while (Picture[I] = TimeOnly) do begin
        Inc(Tmp[0]);
        Tmp[J] := St[I];
        Inc(J);
        Inc(I);
      end;
      Tmp := TrimTrailS(Tmp);

      t1159 := w1159;
      t2359 := w2359;
      if (Length(Tmp) = 0) then
         H := -1
      else if (UpperCase(Tmp) = UpperCase(t2359)) then begin
        if (H < 12) then
          Inc(H,12)
        else if (H=0) or (H > 12) then
          {force BadTime}
          H := -1;
      end
      else if (UpperCase(Tmp) = UpperCase(t1159)) then begin
        if H = 12 then
          H := 0
        else if (H = 0) or (H > 12) then
          {force BadTime}
          H := -1;
      end
      else
        {force BadTime}
        H := -1;
      end;
    Result := ValidTime(H, M, S);
  end;

  function TimeStringToStTime(const Picture, S : string) : TStTime;
    {-Convert S, a string of the form indicated by Picture, to a Time variable}
  var
    Hours, Minutes, Seconds : Integer;
  begin
    if TimeStringToHMS(Picture, S, Hours, Minutes, Seconds) then
      Result := HMStoStTime(Hours, Minutes, Seconds)
    else
      Result := BadTime;
  end;

  function TimeToTimeStringPrim(const Picture : string; T : TStTime;   {!!.02}
                                Pack : Boolean;
                                const t1159, t2359 : string) : string; {!!.02}
    {-Convert T to a string of the form indicated by Picture}
  var
    Hours,
    Minutes,
    Seconds  : Byte;
    L, I,
    TPos     : Cardinal;
    P        : string;
    OK       : Boolean;
    C        : string[1];
  begin
    {merge the hours, minutes, and seconds into the picture}
    StTimeToHMS(T, Hours, Minutes, Seconds);
    Result := Picture;

    {check for TimeOnly}
    OK := StrChPosL(Result, TimeOnly, TPos);
    if OK then begin
      if (Hours >= 12) then
        P := t2359
      else
        P := t1159;
      if (Length(t1159) > 0) and (Length(t2359) > 0) then
        case Hours of
          0 : Hours := 12;
          13..23 : Dec(Hours, 12);
        end;
    end;

    if T = BadTime then begin
      {map picture characters to spaces}
      Result := SubstChar(Result, HourOnly, ' ');
      Result := SubstChar(Result, MinOnly, ' ');
      Result := SubstChar(Result, SecOnly, ' ');
    end
    else begin
      {merge the numbers into the picture}
      MergeIntoPicture(Result, HourOnly, Hours);
      MergeIntoPicture(Result, MinOnly, Minutes);
      MergeIntoPicture(Result, SecOnly, Seconds);
    end;

    {map colons}
    Result := SubstChar(Result, TimeColon, wColonChar);

    {plug in AM/PM string if appropriate}
    if OK then begin
      if (Length(t1159) = 0) and (Length(t2359) = 0) then begin
        C := SubstCharSim(Result[TPos], TimeOnly, ' ');
        Result[TPos] := C[1];