tsmask.pas

企业进销存管理系统

function TtsTextMask.CheckLiteralChar(var MaskInput: TtsMaskInput; var MaskPos: Integer;
                                      var Matched: Boolean; Node: TtsPictureNode;
                                      Options: TtsMaskOptions): Boolean;
var
    Pos: Integer;
    Chars: Integer;
begin
    Result := False;
    Pos := MaskPos;
    if Picture[MaskPos] = tsPicEscapeChar then Pos := Pos + 1;

    with MaskInput do
    begin
        Chars := CharCount(Picture, Pos);
        if (not Matched) and (TextPos + Chars - 1 <= Length(Text)) then
        begin
            if IsInputChar(MaskInput) and (moConvertInput in Options) then
                Result := AnsiStrLIComp(PChar(@Text[TextPos]), PChar(@Picture[Pos]), Chars) = 0
            else
                Result := AnsiStrLComp(PChar(@Text[TextPos]), PChar(@Picture[Pos]), Chars) = 0;

            if Result then
            begin
                Text[TextPos] := Picture[Pos];
                if Chars > 1 then Text[TextPos + 1] := Picture[Pos + 1];
                MaskPos := Pos + Chars;
                TextPos := TextPos + Chars;
                Matched := True;
            end;
        end;

        if (not Result) and CanInsertLiteral(MaskInput, Options) then
        begin
            Result := True;
            MaskInput.Literals := MaskInput.Literals + Copy(Picture, Pos, Chars);
            MaskPos := Pos + Chars;
        end;
    end;
end;

function TtsTextMask.CheckLiterals(Node: TtsPictureNode; var MaskInput: TtsMaskInput;
                                   Options: TtsMaskOptions; var Matched: Boolean): Boolean;
var
    Ok: Boolean;
    MaskPos, MaxMaskPos: Integer;
    CurInput: TtsMaskInput;
begin
    Result := False;
    if not Assigned(Node) then Exit;

    if (MaskInput.TextPos > Length(MaskInput.Text)) and
       not (moFullCompare in Options) then
    begin
        Result := True;
        Exit;
    end;

    Ok := True;
    CurInput := MaskInput;
    with CurInput do
    begin
        MaskPos := Node.StartPos;
        MaxMaskPos := Node.StartPos + Node.CharCount - 1;
        while Ok and (MaskPos <= MaxMaskPos) do
        begin
            if (TextPos > Length(Text)) and not (moFullCompare in Options) then Break;
            Ok := CheckLiteralChar(CurInput, MaskPos, Matched, Node, Options);
        end;
    end;

    Result := Ok;
    if Result then MaskInput := CurInput;
end;

function TtsTextMask.CheckMaskChar(var MaskInput: TtsMaskInput; var MaskPos: Integer;
                                   Options: TtsMaskOptions): Boolean;
var
    Chars: Integer;
    ConvertType: TtsMaskOption;
begin
    Result := False;
    with MaskInput do
    begin
        if TextPos > Length(Text) then Exit;

        Chars := CharCount(Text, TextPos);
        case Picture[MaskPos] of
            tsPicDigit:
                Result := Text[TextPos] in ['0'..'9'];

            tsPicLetter:
                begin
                    Result := IsCharAlpha(Text[TextPos]);
                    if Result then
                    begin
                        ConvertType := GetCaseType(MaskInput, Options, moNone);
                        if CanConvertCase(MaskInput, Options, ConvertType) then
                            ConvertCase(MaskInput, Chars, ConvertType)
                        else if ConvertType <> moNone then
                        begin
                            if (ConvertType in [moUpper, moLower]) or
                               IsInputChar(MaskInput) then
                            begin
                                Result := CheckCase(Text, TextPos, Chars, ConvertType)
                            end;
                        end;
                    end;
                end;

            tsPicUpperLetter:
                begin
                    Result := IsCharAlpha(Text[TextPos]);
                    if Result then
                    begin
                        ConvertType := GetCaseType(MaskInput, Options, moUpper);
                        if CanConvertCase(MaskInput, Options, ConvertType) then
                            ConvertCase(MaskInput, Chars, moUpper)
                        else
                            Result := CheckCase(Text, TextPos, Chars, moUpper);
                    end;
                end;

            tsPicAny:
                begin
                    Result := not IsCharAlpha(Text[TextPos]);
                    if not Result then
                    begin
                        Result := True;
                        ConvertType := GetCaseType(MaskInput, Options, moNone);
                        if CanConvertCase(MaskInput, Options, ConvertType) then
                            ConvertCase(MaskInput, Chars, ConvertType)
                        else if ConvertType <> moNone then
                        begin
                            if (ConvertType in [moUpper, moLower]) or
                               IsInputChar(MaskInput) then
                            begin
                                Result := CheckCase(Text, TextPos, Chars, ConvertType);
                            end;
                        end;
                    end;
                end;

            tsPicUpperAny:
                begin
                    Result := not IsCharAlpha(Text[TextPos]);
                    if not Result then
                    begin
                        ConvertType := GetCaseType(MaskInput, Options, moNone);
                        if CanConvertCase(MaskInput, Options, ConvertType) then
                        begin
                            Result := True;
                            ConvertCase(MaskInput, Chars, moUpper)
                        end
                        else
                            Result := CheckCase(Text, TextPos, Chars, moUpper);
                    end;
                end;
        end;

        if Result then
        begin
            MaskPos := MaskPos + CharCount(Picture, MaskPos);
            TextPos := TextPos + Chars;
        end;
    end;
end;

function TtsTextMask.CheckMaskChars(Node: TtsPictureNode; var MaskInput: TtsMaskInput;
                                    Options: TtsMaskOptions): Boolean;
var
    Ok: Boolean;
    MaskPos, MaxMaskPos: Integer;
    CurInput: TtsMaskInput;
begin
    Ok := True;
    CurInput := MaskInput;
    with CurInput do
    begin
        MaskPos := Node.StartPos;
        MaxMaskPos := Node.StartPos + Node.CharCount - 1;

        while Ok and (MaskPos <= MaxMaskPos) do
        begin
            if (TextPos > Length(Text)) and not (moFullCompare in Options) then Break;
            Ok := CheckMaskChar(CurInput, MaskPos, Options)
        end;
    end;

    Result := Ok;
    if Result then MaskInput := CurInput;
end;

function TtsTextMask.CheckRange(Node: TtsPictureNode; var MaskInput: TtsMaskInput;
                                Options: TtsMaskOptions): Boolean;
var
    InRange: Boolean;
    Chars: Integer;
    TextChar, StartChar, EndChar: string;
begin
    Result := False;
    with MaskInput do
    begin
        if TextPos > Length(Text) then Exit;

        Chars := CharCount(Text, TextPos);
        if not tsIsFarEast or
           ((Chars = 1) and (CharCount(Picture, Node.StartPos) = 1) and
                            (CharCount(Picture, Node.EndPos) = 1)) then
        begin
            InRange := (Text[TextPos] >= Picture[Node.StartPos]) and
                       (Text[TextPos] <= Picture[Node.EndPos]);
            if (not InRange) and IsInputChar(MaskInput) and
               (moConvertInput in Options) and IsCharAlpha(Text[TextPos]) and
               (not Node.Complement) then
            begin
                if CheckCase(Text, TextPos, 1, moUpper)
                    then TextChar := LowerCase(Text[TextPos])
                    else TextChar := UpperCase(Text[TextPos]);

                InRange := (TextChar[1] >= Picture[Node.StartPos]) and
                           (TextChar[1] <= Picture[Node.EndPos]);
                if InRange then Text[TextPos]:= TextChar[1];
            end;
        end
        else
        begin
            StartChar := Copy(Picture, Node.StartPos, CharCount(Picture, Node.StartPos));
            EndChar := Copy(Picture, Node.EndPos, CharCount(Picture, Node.EndPos));
            TextChar := Copy(Text, TextPos, Chars);

            InRange := (AnsiStrComp(PChar(TextChar), PChar(StartChar)) >= 0) and
                       (AnsiStrComp(PChar(TextChar), PChar(EndChar)) <= 0);

            if (not InRange) and IsInputChar(MaskInput) and
               (moConvertInput in Options) and IsCharAlpha(TextChar[1]) and
               (not Node.Complement) then
            begin
                if CheckCase(TextChar, 1, Length(TextChar), moUpper)
                    then CharUpperBuff(PChar(TextChar), Length(TextChar))
                    else CharLowerBuff(PChar(TextChar), Length(TextChar));

                InRange := (AnsiStrComp(PChar(TextChar), PChar(StartChar)) >= 0) and
                           (AnsiStrComp(PChar(TextChar), PChar(EndChar)) <= 0);
                if InRange then
                begin
                    Text[TextPos] := TextChar[1];
                    if Length(TextChar) > 1 then Text[TextPos + 1] := TextChar[2];
                end;
            end;
        end;

        Result := InRange;
        if Node.Complement then Result := not Result;
        if Result then TextPos := TextPos + Chars;
    end;
end;

function TtsTextMask.CheckItem(Node: TtsPictureNode; var MaskInput: TtsMaskInput;
                               Options: TtsMaskOptions): Boolean;
begin
    Result := False;
    if not Assigned(Node) then Exit;

    if (MaskInput.TextPos > Length(MaskInput.Text)) and
       not (moFullCompare in Options) then
    begin
        Result := True;
        Exit;
    end;

    case Node.NodeType of
        pntMaskChars:
            Result := CheckMaskChars(Node, MaskInput, Options);
        pntRange:
            Result := CheckRange(Node, MaskInput, Options);
    else
        Result := True;
    end;
end;

function TtsTextMask.CheckNextItems(Stack: TtsParseStack; StackPos: Integer; Options: TtsMaskOptions;
                                    var MaskInput: TtsMaskInput; var NrOfMatches: Integer): Boolean;
var
    Node, NextItem: TtsPictureNode;
    Count, NextCount: Integer;
    Parent: Integer;
    CurNrOfMatches: Integer;
begin
    Result := MaskInput.TextPos > Length(MaskInput.Text);
    if StackPos = 0 then Exit;

    Node := Stack.Items[StackPos].Node;
    Parent := Stack.Items[StackPos].Parent;
    Count := Stack.Items[StackPos].Count;

    if Node.Optional and (Count > 0) and
       (Stack.Items[StackPos].TextPos = MaskInput.TextPos) then
    begin
        Result := False;
        Exit;
    end;

    NextCount := 0;
    NextItem := Node.NextItem;
    if (not Node.Optional) and (Count < Node.Count) then
    begin
        NextCount := Count + 1;
        NextItem := Node;
    end;

    CurNrOfMatches := NrOfMatches;
    if Assigned(NextItem) then
    begin
        Result := CheckSubItems(Stack, Parent, NextItem, NextCount,
                                Options, MaskInput, NrOfMatches);
    end
    else
    begin
        Result := CheckNextItems(Stack, Parent, Options, MaskInput, NrOfMatches);
    end;

    if (not Result) and (NrOfMatches <= 1) then
    begin
        if (Count = 0) or (CurNrOfMatches <> NrOfMatches) or
           (Stack.Items[StackPos].TextPos < MaskInput.TextPos) then
        begin
            Result := CheckSubItems(Stack, Parent, Node, Count + 1,
                                    Options, MaskInput, NrOfMatches);
        end;
    end;
end;

procedure TtsTextMask.CheckCaseOptions(Node: TtsPictureNode; var Options: TtsMaskOptions);
var
    Pos, Chars: Integer;
begin
    Pos := Node.StartPos;
    Chars := Node.CharCount;
    if Picture[Pos] = tsPicUpper then
    begin
        Options := Options - [moLower, moOptLower, moUpper, moOptUpper];
        if Chars = 1 then Include(Options, moOptUpper)
                     else Include(Options, moUpper);
    end
    else if Picture[Pos] = tsPicLower then
    begin
        Options := Options - [moLower, moOptLower, moUpper, moOptUpper];
        if Chars = 1 then
            Include(Options, moOptLower)
        else if Picture[Pos+1] = tsPicLower then
            Include(Options, moLower);
    end;
end;

function GetMatchedLen(Str1: string; Str2: string): Integer;
var
    Pos: Integer;
begin
    Result := 0;

    Pos := 0;
    while (Pos < Length(Str1)) and (Pos < Length(Str2)) do
    begin
        Pos := Pos + 1;
        if Str1[Pos] <> Str2[Pos] then break;
        Result := Result + 1
    end;
end;

function TtsTextMask.CheckSubItems(Stack: TtsParseStack; Parent: Integer; Node: TtsPictureNode;
                                   Count: Integer; Options: TtsMaskOptions;
                                   var MaskInput: TtsMaskInput; var NrOfMatches: Integer): Boolean;
var
    StackPos: Integer;
    CurOptions: TtsMaskOptions;
    OldInput: TtsMaskInput;
    Matched: Boolean;
    MatchLen: Integer;
    CurNrOfMatches: Integer;
begin
    Result := False;
    if not Assigned(Node) then Exit;
    if (Count = 0) and (not Node.Optional) then Inc(Count);
    if (Node.Count <> -1) and (Count > Node.Count) then Exit;

    OldInput := MaskInput;
    StackPos := Stack.Push(Parent, Node, MaskInput.TextPos, Count);
    if Count = 0 then
        Result := CheckNextItems(Stack, StackPos, Options, MaskInput, NrOfMatches)
    else if Node.NodeType = pntCase then
    begin
        CurOptions := Options;
        CheckCaseOptions(Node, CurOptions);
        Result := CheckNextItems(Stack, StackPos, CurOptions, MaskInput, NrOfMatches);
    end
    else if Node.NodeType = pntLiteralChars then
    begin
        CurNrOfMatches := NrOfMatches;
        Matched := False;
        Result := CheckLiterals(Node, MaskInput, Options, Matched);