cxstandardmask.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 739 行 · 第 1/2 页

  AResult := FullEmptyString;

  if FLeading then
  begin
    ANotTestedPos := Count - 1;
    AStep := -1;
    I := Length(AText);
  end
  else
  begin
    ANotTestedPos := 0;
    AStep := 1;
    I := 1;
  end;

  while (I >= 1) and (I <= Length(AText)) do
  begin
    AChar := AText[I];
    J := ANotTestedPos;
    while (J >= 0) and (J < Count) do
    begin
      if not SaveLiteralCharacters and not AMatchForBlanksAndLiterals and
        (Items[J] is TcxStandardMaskLiteralItem) then
      begin
        Inc(J, AStep);
        Continue;
      end;
      if Items[J].Check(AChar) then
      begin
        Delete(AResult, J + 1, 1);
        if AChangeCharCase then
          Insert(AChar, AResult, J + 1)
        else
          Insert(AText[I], AResult, J + 1);
        ANotTestedPos := J + AStep;
        Break;
      end
      else
      begin
        if ((AText[I] = FBlank) or (AText[I] = ' ')) and (Items[J] is TcxStandardMaskManyItem) then
        begin
          ANotTestedPos := J + AStep;
          Break;
        end;
      end;
      Inc(J, AStep);
    end;
    Inc(I, AStep);
  end;

  AText := AResult;
end;

// The AText must be fotmatted by Format procedure already
procedure TcxStandardMask.Format2(var AText: string);

  function FormatWithLiteralCharacters: string;
  var
    I: Integer;
  begin
    Result := '';
    for I := 1 to Length(AText) do
    begin
      if I > Count then
        Break;
      if Items[I - 1] is TcxStandardMaskLiteralItem then
        Result := Result + AText[I]
      else if Items[I - 1] is TcxStandardMaskManyItem then
      begin
        if AText[I] = FBlank then
          Result := Result + ' '
        else
          Result := Result + AText[I];
      end;
    end;
  end;

  function FormatWithoutLiteralCharacters: string;
  var
    I: Integer;
  begin
    Result := '';
    for I := 1 to Length(AText) do
    begin
      if I > Count then
        Break;
      if Items[I - 1] is TcxStandardMaskManyItem then
        if AText[I] = FBlank then
          Result := Result + ' '
        else
          Result := Result + AText[I];
    end;
  end;

begin
  if SaveLiteralCharacters then
    AText := FormatWithLiteralCharacters
  else
    AText := FormatWithoutLiteralCharacters;
end;

function TcxStandardMask.IsFullValid(var AText: string): Boolean;
var
  AIsCharValid: Boolean;
  I: Integer;
begin
  if Length(AText) = Count then
  begin
    Result := True;
    for I := 1 to Length(AText) do
    begin
      AIsCharValid := Items[I - 1].Check(AText[I]);
      if not AIsCharValid then
      begin
        if ((AText[I] = FBlank) or (AText[I] = ' ')) and (Items[I - 1] is TcxStandardMaskManyItem) and
            (TcxStandardMaskManyItem(Items[I - 1]).Optional) then
          Continue
        else
        begin
          Result := False;
          Break;
        end;
      end;
    end;
  end
  else
    Result := False;
end;

function TcxStandardMask.IsValid(var AText: string): Boolean;
var
  AIsCharValid: Boolean;
  I: Integer;
begin
  if Length(AText) <= Count then
  begin
    Result := True;
    for I := 1 to Length(AText) do
    begin
      AIsCharValid := Items[I - 1].Check(AText[I]);
      if not AIsCharValid then
      begin
        if ((AText[I] = FBlank) or (AText[I] = ' ')) and (Items[I - 1] is TcxStandardMaskManyItem) then
          Continue
        else
        begin
          Result := False;
          Break;
        end;
      end;
    end;
  end
  else
    Result := False;
end;

procedure TcxStandardMask.Clear;
var
  I: Integer;
begin
  FMask := '';
  FLeading := False;
  FSaveLiteralCharacters := True;
  FBlank := cxDefaultBlank;
  for I := 0 to FItems.Count - 1 do
    TcxStandardMaskCustomItem(FItems[I]).Free;
  FItems.Clear;
end;

procedure TcxStandardMask.DoCompileBody(const AMask: string);
var
  I: Integer;
  ACaseControl: TcxCaseControl;
begin
  I := 1;
  ACaseControl := ccUserCase;
  while I <= Length(AMask) do
  begin
    case AMask[I] of
      'L':
        begin
          FItems.Add(TcxStandardMaskAlphaItem.Create(False, ACaseControl));
          Inc(I);
        end;
      'l':
        begin
          FItems.Add(TcxStandardMaskAlphaItem.Create(True, ACaseControl));
          Inc(I);
        end;
      'A':
        begin
          FItems.Add(TcxStandardMaskAlphaNumericItem.Create(False, ACaseControl));
          Inc(I);
        end;
      'a':
        begin
          FItems.Add(TcxStandardMaskAlphaNumericItem.Create(True, ACaseControl));
          Inc(I);
        end;
      'C':
        begin
          FItems.Add(TcxStandardMaskASCIIItem.Create(False, ACaseControl));
          Inc(I);
        end;
      'c':
        begin
          FItems.Add(TcxStandardMaskASCIIItem.Create(True, ACaseControl));
          Inc(I);
        end;
      '0':
        begin
          FItems.Add(TcxStandardMaskNumericItem.Create(False, ACaseControl));
          Inc(I);
        end;
      '9':
        begin
          FItems.Add(TcxStandardMaskNumericItem.Create(True, ACaseControl));
          Inc(I);
        end;
      '#':
        begin
          FItems.Add(TcxStandardMaskNumericSymbolItem.Create(True, ACaseControl));
          Inc(I);
        end;
      ':':
        begin
          FItems.Add(TcxStandardMaskLiteralItem.Create(TimeSeparator));
          Inc(I);
        end;
      '/':
        begin
          FItems.Add(TcxStandardMaskLiteralItem.Create(DateSeparator));
          Inc(I);
        end;
      '\':
        begin
          Inc(I);
          if I <= Length(AMask) then
          begin
            FItems.Add(TcxStandardMaskLiteralItem.Create(AMask[I]));
            Inc(I);
          end;
        end;
      '<':
        begin
          ACaseControl := ccLowerCase;
          Inc(I);
          if I <= Length(AMask) then
            if AMask[I] = '>' then
            begin
              ACaseControl := ccUserCase;
              Inc(I);
            end;
        end;
      '>':
        begin
          ACaseControl := ccUpperCase;
          Inc(I);
        end;
      ';':
        begin
          if Length(AMask) - I = 3 then
          begin
            if AMask[I + 2] = ';' then
            begin
              if (AMask[I + 1] = '0') or (AMask[I + 1] = '1') then
              begin
                FSaveLiteralCharacters := AMask[I + 1] <> '0';
                FBlank := AMask[I + 3];
                Inc(I, 4);
              end
              else
              begin
                FItems.Add(TcxStandardMaskLiteralItem.Create(AMask[I]));
                Inc(I);
              end;
            end
            else
            begin
              FItems.Add(TcxStandardMaskLiteralItem.Create(AMask[I]));
              Inc(I);
            end;
          end
          else if Length(AMask) - I = 1 then
          begin
            if (AMask[I + 1] = '0') or (AMask[I + 1] = '1') then
            begin
              FSaveLiteralCharacters := AMask[I + 1] <> '0';
              Inc(I, 2);
            end
            else
            begin
              FItems.Add(TcxStandardMaskLiteralItem.Create(AMask[I]));
              Inc(I);
            end;
          end
          else
          begin
            FItems.Add(TcxStandardMaskLiteralItem.Create(AMask[I]));
            Inc(I);
          end;
        end;
      else
      begin
        FItems.Add(TcxStandardMaskLiteralItem.Create(AMask[I]));
        Inc(I);
      end;
    end;
  end;
end;

procedure TcxStandardMask.DoCompileHead(var AMask: string);
begin
  if AMask <> '' then
  begin
    if AMask[1] = '!' then
    begin
      FLeading := True;
      Delete(AMask, 1, 1);
    end
    else
      FLeading := False;
  end;
end;

function TcxStandardMask.GetCount: Integer;
begin
  Result := FItems.Count;
end;

function TcxStandardMask.GetEmptyString: string;
var
  I: Integer;
begin
  Result := '';
  for I := 0 to Count - 1 do
  begin
    if Items[I] is TcxStandardMaskLiteralItem then
    begin
      if FSaveLiteralCharacters then
        Result := Result + TcxStandardMaskLiteralItem(Items[I]).Literal
    end
    else
      Result := Result + ' ';
  end;
end;

function TcxStandardMask.GetFullEmptyString: string;
var
  I: Integer;
begin
  Result := '';
  for I := 0 to Count - 1 do
  begin
    if Items[I] is TcxStandardMaskLiteralItem then
      Result := Result + TcxStandardMaskLiteralItem(Items[I]).Literal
    else if Items[I] is TcxStandardMaskManyItem then
      Result := Result + FBlank
  end;
end;

function TcxStandardMask.GetItems(AIndex: Integer): TcxStandardMaskCustomItem;
begin
  Result := TcxStandardMaskCustomItem(FItems[AIndex]);
end;

end.