stdatest.pas

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

      end else if (T = BadTime) and (Length(t1159) = 0) then begin
        C := SubstCharSim(Result[TPos], TimeOnly, ' ');
        Result[TPos] := C[1];
      end else begin
        I := 1;
        L := Length(P);
  //        while (I <= L) and (Result[TPos] = TimeOnly) do begin            {!!.01} {!!.03}
        while (I <= L) and                                             {!!.03}
          (TPos <= Length(Result)) and (Result[TPos] = TimeOnly) do    {!!.03}
        begin                                                          {!!.03}
          Result[TPos] := P[I];
          Inc(I);
          Inc(TPos);
        end;
      end;
    end;

    if Pack and (T <> BadTime) then
      Result := PackResult(Picture, Result);
  end;

  function StTimeToTimeString(const Picture : string; const T : TStTime;
                              Pack : Boolean) : string;
    {-Convert T to a string of the form indicated by Picture}
  begin
    Result := TimeToTimeStringPrim(Picture, T, Pack, w1159, w2359);
  end;

  function StTimeToAmPmString(const Picture : string; const T : TStTime;
                            Pack : Boolean) : string;
    {-Convert T to a string of the form indicated by Picture. Times are always
      displayed in am/pm format.}
  const
    t1159 = 'AM';
    t2359 = 'PM';
  var
    P    : Cardinal;
  begin
    Result := Picture;
    if NOT (StrChPosL(Result, TimeOnly, P)) then
      Result := Result + TimeOnly;
    Result := TimeToTimeStringPrim(Result, T, Pack, t1159, t2359);
  end;

  function CurrentTime : TStTime;
    {-Returns current time in seconds since midnight}
  begin
    Result := Trunc(SysUtils.Time * SecondsInDay);
  end;

  function CurrentTimeString(const Picture : string; Pack : Boolean) : string;
    {-Returns current time as a string of the specified form}
  begin
    Result := StTimeToTimeString(Picture, CurrentTime, Pack);
  end;

  function MaskCharCount(const P : string; MC : ANSIChar) : Integer;   {!!.02}
  var
    I, R,
    Len  : Cardinal;
    OK   : Boolean;
  begin
    OK := StrChPosL(P, MC, I);
    R := Ord(OK);
    Len := Length(P);
    if OK then
      while (I+R <= Len) and (P[I+R] = MC) do                            {!!.01}
        Inc(R);
    Result := R;
  end;

  function InternationalDate(ForceCentury : Boolean) : string;
    {-Return a picture mask for a date string, based on Windows' int'l info}

    procedure FixMask(MC : ANSIChar; DL : Integer);
    var
      I, J, AL, D : Cardinal;
      MCT : ANSIChar;
      OK  : Boolean;
    begin
      {find number of matching characters}
      OK := StrChPosL(Result, MC, I);
      MCT := MC;
      if not OK then begin
        MCT := UpCase(MC);
        OK := StrChPosL(Result, MCT, I);
      end;
      if NOT OK then
        Exit;

      D := DL;
      {pad substring to desired length}
      AL := MaskCharCount(Result, MCT);
      if AL < D then
        for J := 1 to D-AL do
          Result := StrChInsertL(Result, MCT, I);

      if MC <> YearOnly then begin
        {choose blank/zero padding}
        case AL of
          1 : if MCT = MC then
                Result := SubstCharSim(Result, MCT, UpCase(MCT));
          2 : if MCT <> MC then
                Result := SubstCharSim(Result, MCT, MC);
        end;
      end;
    end;

  begin
    {copy Windows mask into our var}
    Result := wShortDate;

    {if single Day marker, make double}
    FixMask(DayOnly, 2);

    {if single Month marker, make double}
    FixMask(MonthOnly, 2);

    {force yyyy if desired}
    FixMask(YearOnly, 2 shl Ord(ForceCentury));
  end;


  function InternationalLongDate(ShortNames : Boolean;
                                 ExcludeDOW : Boolean) : string;
    {-Return a picture mask for a date string, based on Windows' int'l info}
  var
    I, WC : Cardinal;
    OK,
    Stop : Boolean;
    Temp : string[81];

    function LongestMonthName : Integer;
    var
      L, I : Integer;
    begin
      L := 0;
      for I := 1 to 12 do
        L := Maxword(L, Length(LongMonthNames[I]));
      LongestMonthName := L;
    end;

    function LongestDayName : Integer;
    var
      D : TStDayType;
      L : Integer;
    begin
      L := 0;
      for D := Sunday to Saturday do
        L := Maxword(L, Length(LongDayNames[Ord(D)+1]));
      LongestDayName := L;
    end;

    procedure FixMask(MC : ANSIChar; DL : Integer);
    var
      I, J, AL, D : Cardinal;                                          
      MCT : ANSIChar;
    begin
      {find first matching mask character}
      OK := StrChPosS(Temp, MC, I);
      MCT := MC;
      if NOT OK then begin
        MCT := UpCase(MC);
        OK := StrChPosS(Temp, MCT, I);
      end;
      if NOT OK then
        Exit;

      D := DL;                                                         
      {pad substring to desired length}
      AL := MaskCharCount(Temp, MCT);
      if AL < D then begin
        for J := 1 to D-AL do                                          
          Temp := StrChInsertS(Temp, MCT, I);
      end else if (AL > D) then                                        
        Temp := StrStDeleteS(Temp, I, AL-D);                           

      if MC <> YearOnly then
        {choose blank/zero padding}
        case AL of
          1 : if MCT = MC then
                Temp := SubstCharSim(Temp, MCT, UpCase(MCT));
          2 : if MCT <> MC then
                Temp := SubstCharSim(Temp, MCT, MC);
        end;
    end;

  begin
    {copy Windows mask into temporary var}
    Temp := wLongDate;

    if ExcludeDOW then begin
      {remove day-of-week and any junk that follows}
      if (StrChPosS(Temp, WeekDayOnly,I)) then begin
        Stop := False;
        WC := I+1;
        while (WC <= Length(Temp)) AND (NOT Stop) do
        begin
          if LoCase(Temp[WC]) in [MonthOnly,DayOnly,YearOnly,NameOnly] then
            Stop := TRUE
          else
            Inc(WC);
        end;
        if (NOT ShortNames) then
          Dec(WC);
        Temp := StrStDeleteS(Temp, I, WC);
      end;
    end
    else if ShortNames then
      FixMask(WeekDayOnly, 3)
    else if MaskCharCount(Temp, WeekdayOnly) = 4 then
      FixMask(WeekDayOnly, LongestDayName);

    {fix month names}
    if ShortNames then
      FixMask(NameOnly, 3)
    else if MaskCharCount(Temp, NameOnly) = 4 then
      FixMask(NameOnly, LongestMonthName);

    {if single Day marker, make double}
    FixMask(DayOnly, 2);

    {if single Month marker, make double}
    FixMask(MonthOnly, 2);

    {force yyyy}
    FixMask(YearOnly, 4);

    Result := Temp;
  end;

  function InternationalTime(ShowSeconds : Boolean) : string;
    {-Return a picture mask for a time string, based on Windows' int'l info}
  var
    ML,
    I  : Integer;
  begin
    {format the default string}

    SetLength(Result,21);
    Result := 'hh:mm:ss';
    if not wTLZero then
       Result[1] :=  HourOnlyU;

    {show seconds?}
    if not ShowSeconds then
      SetLength(Result,5);

    {handle international AM/PM markers}
    if w12Hour then begin
      ML := Maxword(Length(w1159), Length(w2359));
      if (ML <> 0) then begin
        AppendChar(Result,' ');
        for I := 1 to ML do
          AppendChar(Result, TimeOnly);
      end;
    end;
  end;

  procedure SetDefaultYear;
    {-Initialize DefaultYear and DefaultMonth}
  var
    Month, Day : Word;
    T : TDateTime;
    W : Word;
  begin
    T := Now;
    W := DefaultYear;
    DecodeDate(T,W,Month,Day);
    DefaultYear := W;
    DefaultMonth := Month;
  end;

  procedure ResetInternationalInfo;
  var
    I : Integer;
    S : array[0..20] of char;

    procedure ExtractSubString(SubChar : ANSIChar; Dest : string);
    var
      I, L, P : Cardinal;
    begin
      SetLength(Dest,sizeof(wldSub1));
      FillChar(Dest[1], SizeOf(wldSub1), 0);
      if NOT (StrChPosS(wLongDate, '''',I)) then
        Exit;

      {delete the first quote}
      wLongDate := StrChDeleteS(wLongDate, I);

      {assure that there is another quote}
      if NOT (StrChPosS(wLongDate, '''',P)) then
        Exit;

      {copy substring into Dest, replace substring with SubChar}
      L := 1;
      while wLongDate[I] <> '''' do
        if L < SizeOf(wldSub1) then begin
          Dest[L] := wLongDate[I];
          Inc(L);
          wLongDate[I] := SubChar;
          Inc(I);
        end else
          wLongDate := StrChDeleteS(wLongDate, I);

      {delete the second quote}
      wLongDate := StrChDeleteS(wLongDate, I);
    end;

  begin
    wTLZero := LongTimeFormat[2] = 'h';
    w12Hour := LongTimeFormat[length(LongTimeFormat)] = 'M';

    wColonChar := TimeSeparator;
    wSlashChar := DateSeparator;

    GetProfileString('intl','s1159','AM', S, SizeOf(S));
    w1159 := StrPas(S);
    GetProfileString('intl','s2359','PM', S, SizeOf(S));
    w2359 := StrPas(S);

    {get short date mask and fix it up}
    wShortDate := ShortDateFormat;
    for I := 1 to Length(wShortDate) do
      if (wShortDate[I] = wSlashChar) then
        wShortDate[I] := '/';

    {get long date mask and fix it up}
    wLongDate := LongDateFormat;
    ExtractSubString(LongDateSub1, wldSub1);
    ExtractSubString(LongDateSub2, wldSub2);
    ExtractSubString(LongDateSub3, wldSub3);

    {replace ddd/dddd with www/wwww}
    I := pos('ddd',wLongDate);
    if I > 0 then begin
      while wLongDate[I] = 'd' do begin
        wLongDate[I] := 'w';
        Inc(I);
      end;
    end;

    {replace MMM/MMMM with nnn/nnnn}
    if pos('MMM',wLongDate) > 0 then
      while (pos('M',wLongDate) > 0) do
        wLongDate[pos('M',wLongDate)] := 'n';

    {deal with oddities concerning . and ,}
    for I := 1 to Length(wLongDate)-1 do begin
      case wLongDate[I] of
        '.', ',' :
          if wLongDate[I+1] <> ' ' then
            wLongDate := StrChInsertS(wLongDate, ' ', I+1);
      end;
    end;
  end;


initialization
  {initialize DefaultYear and DefaultMonth}
  SetDefaultYear;
  ResetInternationalInfo;
end.