excelmaskii2.pas

一个经典的读写Excel的控件

          j := i;
          while (i <= Length(Value)) and (S[i] = C) do
            Inc(i);
          j := i - j;
          case C of
            'y': if j < 3 then AddEntity(Index,meYear2)
                 else AddEntity(Index,meYear4);
            'm': if (LastTimeMD <> Nil) and (LastTimeMD.Entity in [meHourDig1,meHourDig2]) then begin
                   if j = 1 then AddEntity(Index,meMinuteDig1)
                   else AddEntity(Index,meMinuteDig2);
                 end
                 else begin
                   if j = 1 then AddEntity(Index,meMonthDig1)
                   else if j = 2 then AddEntity(Index,meMonthDig2)
                   else if j = 3 then AddEntity(Index,meMonthShort)
                   else if j = 4 then AddEntity(Index,meMonthName)
                   else AddEntity(Index,meMonthChar);
                 end;
            'd': if j = 1 then AddEntity(Index,meDayDig1)
                 else if j = 2 then AddEntity(Index,meDayDig2)
                 else if j = 3 then AddEntity(Index,meDayShort)
                 else AddEntity(Index,meDayName);
            'h': if j = 1 then AddEntity(Index,meHourDig1)
                 else AddEntity(Index,meHourDig2);
            's': begin
                   if (LastTimeMD <> Nil) and (LastTimeMD.Entity = meMonthDig1) then
                     LastTimeMD.Entity := meMinuteDig1
                   else if (LastTimeMD <> Nil) and (LastTimeMD.Entity = meMonthDig2) then
                     LastTimeMD.Entity := meMinuteDig2;
                   if j = 1 then AddEntity(Index,meSecondDig1)
                   else AddEntity(Index,meSecondDig2);
                 end;
          end;
          LastTimeMD := Data[Data.Count - 1];
          Dec(i);
        end;
        else begin
          pMD := AddEntity(Index,meLitteral);
          pMD.C := Value[i];
          if Value[i] in ['a','A'] then begin
            if Copy(Value,i,3) = 'a/p' then begin
              pMD.Entity := meStrap;
              Inc(i,2);
            end
            else if Copy(Value,i,5) = 'am/pm' then begin
              pMD.Entity := meStrAmPmLow;
              Inc(i,4);
            end
            else if Copy(Value,i,5) = 'AM/PM' then begin
              pMD.Entity := meStrAmPmUpp;
              Inc(i,4);
            end;
            if pMD.Entity in [meStrap,meStrAmPmLow,meStrAmPmUpp] then begin
              for j := Data.Count - 2 downto 0 do begin
                if PMaskData(Data[j]).Entity = meHourDig1 then begin
                  PMaskData(Data[j]).Entity := meHourDig1AmPm;
                  Break;
                end
                else if PMaskData(Data[j]).Entity = meHourDig2 then begin
                  PMaskData(Data[j]).Entity := meHourDig2AmPm;
                  Break;
                end
              end;
            end;
          end;
        end;
      end;
      Inc(i);
    end;
    for i := 0 to Data.Count - 1 do begin
      if PMaskData(Data[i]).Entity in [mePlace,meSpace,meZero,meDecimalPos] then begin
        if not (PMaskData(Data[i]).Entity = meDecimalPos) then
          Flags := Flags - [mfIsDateTime];
        New(pMD);
        pMD.Entity := meFirstDigitPlace;
        Data.Insert(i,pMD);
        Break;
      end;
    end;
    if Div1000Cnt > 4 then
      Div1000Cnt := 4;
  end;
end;

function TExcelMask.FormatNumberDateTime(FD: PFormatData; Value: double): string;
var
  i: integer;
  S: string;
  YY,MM,DD,HH,NN,SS,MS: word;
begin
  S := '';
  i := 0;
  DecodeDate(Value,YY,MM,DD);
  DecodeTime(Value,HH,NN,SS,MS);
  with FD^do begin
    while i < Data.Count do begin
      case PMaskData(Data[i]).Entity of
        meLitteral: begin
          if PMaskData(Data[i]).C = '/' then
            S := S + DateSeparator
          else if PMaskData(Data[i]).C = ':' then
            S := S + TimeSeparator
          else
            S := S + PMaskData(Data[i]).C;
        end;
        meString: S := S + PMaskData(Data[i]).S;
        meYear2: S := S + FormatDateTime('yy',Value);
        meYear4: S := S + FormatDateTime('yyyy',Value);
        meMonthDig1: S := S + IntToStr(MM);
        meMonthDig2: if MM < 10 then S := S + '0' + IntToStr(MM)
                     else S := S + IntToStr(MM);
        meMonthShort: S := S + ShortMonthNames[MM];
        meMonthName: S := S + LongMonthNames[MM];
        meMonthChar: begin
          DecodeDate(Value,YY,MM,DD);
          S := S + ShortMonthNames[MM][1];
        end;
        meDayDig1: S := S + IntToStr(DD);
        meDayDig2: if DD < 10 then S := S + '0' + IntToStr(DD)
                   else S := S + IntToStr(DD);
        meDayShort: S := S + ShortDayNames[DayOfWeek(Value)];
        meDayName: S := S + LongDayNames[DayOfWeek(Value)];
        meHourDig1: S := S + IntToStr(HH);
        meHourDig2: if HH < 10 then S := S + '0' + IntToStr(HH)
                    else S := S + IntToStr(HH);
        meHourDig1AmPm: if HH > 11 then S := S + IntToStr(HH - 12)
                        else S := S + IntToStr(HH);
        meHourDig2AmPm: if HH > 11 then S := S + Format('%.2d',[HH - 12])
                        else S := S + Format('%.2d',[HH]);
        meHourElapsed: S := S + IntToStr(Trunc(Value) * 24 + Round(Frac(Value) / (1 / 24)));
        meMinuteDig1: S := S + IntToStr(NN);
        meMinuteDig2: if NN < 10 then S := S + '0' + IntToStr(NN)
                      else S := S + IntToStr(NN);
        meMinuteElapsed: S := S + IntToStr(Trunc(Value) * (24 * 60) + Round(Frac(Value) / (1 / (24 * 60))));
        meSecondDig1: S := S + IntToStr(SS);
        meSecondDig2: if SS < 10 then S := S + '0' + IntToStr(SS)
                      else S := S + IntToStr(SS);
        meSecondElapsed: S := S + IntToStr(Trunc(Value) * (24 * 60 * 60) + Round(Frac(Value) / (1 / (24 * 60 * 60))));
        meStrAmPmUpp: if HH > 11 then S := S + 'PM'
                      else S := S + 'AM';
        meStrAmPmLow: if HH > 11 then S := S + 'pm'
                      else S := S + 'am';
        meStrap:      if HH > 11 then S := S + 'p'
                      else S := S + 'a';
      end;
      Inc(i);
    end;
    Result := S;
  end;
end;

function TExcelMask.FormatNumberNumber(FD: PFormatData; Value: double): string;
const
  SZ_RESBUF = 300;
var
  i,j,ValPos,ResPos: integer;
  C: char;
  sVal,Res: string;

function GetNextDigit(DefaultChar: char): char;
begin
  if ValPos > 0 then begin
    Result := sVal[ValPos];
    Dec(ValPos);
  end
  else
    Result := DefaultChar;
end;

function GetNextDecimal(DefaultChar: char): char;
begin
  if ValPos <= Length(sVal) then begin
    Result := sVal[ValPos];
    Inc(ValPos);
  end
  else
    Result := DefaultChar;
end;

begin
  if FD = Nil then begin
    Result := FloatToStr(Value);
    Exit;
  end;
  with FD^ do begin
    if Data.Count < 1 then begin
      Result := FloatToStr(Value);
      Exit;
    end;
    if mfGeneral in Flags then begin
      Result := FloatToStr(Value);
      Exit;
    end
    else if mfIsDateTime in Flags then begin
      Result := FormatNumberDateTime(FD,Value);
      Exit;
    end

    else if mfScientific in Flags then begin
      Result := FloatToStrF(Value,ffExponent,FD.DecimalCount - 1,FD.DataDecimalPos);
      Exit;
    end;
    SetLength(Res,SZ_RESBUF);
    ResPos := SZ_RESBUF - 1;
    if mfZero in Flags then
      sVal := ''
    else begin
      if Div1000Cnt > 0 then
        Value := Value / Power(10,Div1000Cnt * 3);
      if mfPercent in Flags then
        Value := Value * 100;
      if mfScientific in Flags then
        sVal := Format('%e',[Value])
      else if mfThousand in Flags then
        sVal := Format('%.*n',[DecimalCount,Value])
      else
        sVal := Format('%.*f',[DecimalCount,Value]);
    end;
    if DataDecimalPos < 0 then
      i := Data.Count - 1
    else
      i := DataDecimalPos;
    ValPos := CPos(DecimalSeparator,sVal) - 1;
    if ValPos < 1 then
      ValPos := Length(sVal);
    while i >= 0 do begin
      case PMaskData(Data[i]).Entity of
        meLitteral: begin
          Res[ResPos] := PMaskData(Data[i]).C;
          Dec(ResPos);
        end;
        meString: begin
          j := Length(PMaskData(Data[i]).S) - 1;
          while (j >= 0) and (ResPos > 0) do begin
            Res[ResPos] := PMaskData(Data[i]).S[j];
            Dec(j);
            Dec(ResPos);
          end;
        end;
        mePlace: begin
          C := GetNextDigit('!');
          if C <> '!' then begin
            Res[ResPos] := C;
            Dec(ResPos);
          end;
        end;
        meSpace: begin
          Res[ResPos] := GetNextDigit(' ');
          Dec(ResPos);
        end;
        meZero: begin
          Res[ResPos] := GetNextDigit('0');
          Dec(ResPos);
        end;
        mePercentPos: begin
          Res[ResPos] := '%';
          Dec(ResPos);
        end;
        meFirstDigitPlace:
        begin
          while (ValPos > 0) and (ResPos > 0) do begin
//            if sVal[ValPos] <> '0' then begin
              Res[ResPos] := sVal[ValPos];
              Dec(ResPos);
//            end;
            Dec(ValPos);
          end;
        end;
      end;
      Dec(i);
    end;
    Result := Copy(Res,ResPos + 1,SZ_RESBUF - ResPos - 1);
    if DataDecimalPos >= 0 then begin
      ValPos := CPos(DecimalSeparator,sVal) + 1;
      if ValPos < 1 then
        Exit;
      ResPos := 1;
      i := DataDecimalPos;
      while i < Data.Count do begin
        case PMaskData(Data[i]).Entity of
          meLitteral: begin
            Res[ResPos] := PMaskData(Data[i]).C;
            Inc(ResPos);
          end;
          meString: begin
            j := 0;
            while (j < Length(PMaskData(Data[i]).S)) and (ResPos < SZ_RESBUF) do begin
              Res[ResPos] := PMaskData(Data[i]).S[j];
              Inc(j);
              Inc(ResPos);
            end;
          end;
          mePlace: begin
            C := GetNextDecimal('!');
            if C <> '!' then begin
              Res[ResPos] := C;
              Inc(ResPos);
            end;
          end;
          meSpace: begin
            Res[ResPos] := GetNextDecimal(' ');
            Inc(ResPos);
          end;
          meZero: begin
            Res[ResPos] := GetNextDecimal('0');
            Inc(ResPos);
          end;
          meDecimalPos: begin
            Res[ResPos] := DecimalSeparator;
            Inc(ResPos);
          end;
          mePercentPos: begin
            Res[ResPos] := '%';
            Inc(ResPos);
          end;
          meFirstDigitPlace:
          begin
            while (ValPos > 0) and (ResPos > 0) do begin
              Res[ResPos] := sVal[ValPos];
              Dec(ValPos);
              Dec(ResPos);
            end;
          end;
        end;
        Inc(i);
      end;
      SetLength(Res,ResPos - 1);
      Result := Result + Res;
    end;
  end;
end;

function TExcelMask.FormatNumber(Value: double): string;

function FormatBytesStr(Bytes: double): string;
begin
  if Bytes = 0 then
    Result := '0 bytes'
  else if Bytes < $00000400 then
    Result := FloatToStr(Round(Bytes)) + ' bytes'
  else if Bytes < $00100000 then
    Result := Format('%.2f kb',[(Bytes / $00000400)])
  else if Bytes < $40000000 then
    Result := Format('%.2f Mb',[(Bytes / $00100000)])
  else
    Result := Format('%.2f Gb',[(Bytes / $40000000)]);
end;

begin
  if FMask = '##,_b_y_t_e_s' then
    Result := FormatBytesStr(Value)
  else if (Formats[1] <> Nil) and (Value < 0) then
    Result := FormatNumberNumber(Formats[1],Abs(Value))
  else if (Formats[2] <> Nil) and (Value = 0) then
    Result := FormatNumberNumber(Formats[2],Value)
  else
    Result := FormatNumberNumber(Formats[0],Value);
end;

function TExcelMask.Color(Value: double): TColor;
begin
  if (Formats[1] <> Nil) and (Value < 0) then
    Result := Formats[1].Color
  else if (Formats[2] <> Nil) and (Value = 0) then
    Result := Formats[2].Color
  else
    Result := Formats[0].Color;
end;

end.