tsmask.pas

企业进销存管理系统

    end;
end;

function TtsTextMask.GetItem(var TextPos: Integer; Chars: Integer; NodeType: TtsPictureNodeType): TtsPictureNode;
var
    ItemNode: TtsPictureNode;
begin
    Result := nil;
    if TextPos > FPictureLength then Exit;

    ItemNode := CreatePictureNode(NodeType);
    if Assigned(ItemNode) then
    begin
        try
            ItemNode.Count := 1;
            ItemNode.Optional := False;
            ItemNode.StartPos := TextPos;
            ItemNode.CharCount := Chars;
        except
            ItemNode.Free;
            raise;
        end;
    end;

    Result := ItemNode;
end;

function TtsTextMask.GetNextItem(var TextPos: Integer): TtsPictureNode;
var
    Count: Integer;
    CountFound: Boolean;
    ItemNode: TtsPictureNode;
    Pos: Integer;
begin
    Result := nil;
    if TextPos > FPictureLength then Exit;

    ItemNode := nil;
    Count := 1;
    CountFound := False;
    if Picture[TextPos] = tsPicCountChar then
    begin
        CountFound := True;
        Count := GetItemCount(TextPos);
    end;

    if TextPos > FPictureLength then
        FMask.InvalidOp(Format(StsPctErrEnd, [FMask.Name]))
    else if IsLiteral(TextPos) then
    begin
        Pos := TextPos + PictureCharCount(TextPos);
        ItemNode := GetItem(TextPos, Pos - TextPos, pntLiteralChars);
        TextPos := Pos;
    end
    else if IsMaskChar(TextPos) then
    begin
        Pos := TextPos + PictureCharCount(TextPos);
        if not CountFound then
        begin
            while IsMaskChar(Pos) do Inc(Pos);
        end;

        ItemNode := GetItem(TextPos, Pos - TextPos, pntMaskChars);
        TextPos := Pos;
    end
    else if IsGroupStart(TextPos) then
        ItemNode := GetGroup(TextPos)
    else if (not CountFound) and IsCaseChar(TextPos) then
    begin
        Pos := TextPos + PictureCharCount(TextPos);
        ItemNode := GetItem(TextPos, Pos - TextPos, pntCase);
        TextPos := Pos;
    end
    else
    begin
        FMask.InvalidOp(Format(StsPctInvalidChar, [FMask.Name, Picture[TextPos], TextPos]));
    end;

    if ItemNode <> nil then ItemNode.Count := Count;
    Result := ItemNode;
end;

function TtsTextMask.GetRange(var TextPos: Integer; var Node: TtsPictureNode): Boolean;
var
    Chars: Integer;
begin
    Node := nil;
    Result := IsRange(TextPos, Chars);

    if Result then
    begin
        Node := CreatePictureNode(pntRange);
        try
            if Assigned(Node) then
            begin
                if Picture[TextPos] = tsPicNotChar then
                begin
                    Node.Complement := True;
                    TextPos := TextPos + 1;
                    Chars := Chars - 1;
                end;

                Node.Count := 1;
                Node.StartPos := TextPos;
                Node.CharCount := Chars;

                if Picture[Node.StartPos] = tsPicEscapeChar then
                    Node.StartPos := Node.StartPos + 1;
                Node.EndPos := Node.StartPos + CharCount(Picture, Node.StartPos) + 1;
                if Picture[Node.EndPos] = tsPicEscapeChar then
                    Node.EndPos := Node.EndPos;
            end;

            TextPos := TextPos + Chars;
        except
            Node.Free;
            raise;
        end;
    end;
end;

function TtsTextMask.GetNextAlternative(var TextPos: Integer; EndChar: Char): TtsPictureNode;
var
    PrevNode, StartNode, Node: TtsPictureNode;
begin
    Result := nil;
    if TextPos > FPictureLength then Exit;

    PrevNode := nil;
    StartNode := nil;
    try
        while (TextPos <= FPictureLength) and (Picture[TextPos] <> EndChar) and
              (Picture[TextPos] <> tsPicAltChar) do
        begin
            Node := GetNextItem(TextPos);
            if Assigned(PrevNode) then PrevNode.NextItem := Node;
            if not Assigned(StartNode) then StartNode := Node;
            PrevNode := Node;
        end;

        if (TextPos <= FPictureLength) and
           (Picture[TextPos] = tsPicAltChar) then Inc(TextPos);
    except
        StartNode.Free;
        raise;
    end;

    Result := StartNode;
end;

function TtsTextMask.GetGroup(var TextPos: Integer): TtsPictureNode;
var
    PrevNode, GroupNode, Node: TtsPictureNode;
    EndChar: Char;
    Optional: Boolean;
begin
    Result := nil;
    if TextPos > FPictureLength then Exit;

    PrevNode := nil;
    GroupNode := CreatePictureNode(pntGroup);
    try
        Optional := GetGroupType(TextPos, EndChar);
        if Assigned(GroupNode) then
        begin
            GroupNode.Count := 1;
            GroupNode.Optional := Optional;
        end;

        if GetRange(TextPos, Node) then
        begin
            if Assigned(Node) and Assigned(GroupNode) then
                GroupNode.SubItems := Node;
        end
        else
        begin
            while (TextPos <= FPictureLength) and
                  (Picture[TextPos] <> EndChar) do
            begin
                Node := GetNextAlternative(TextPos, EndChar);
                if Assigned(Node) and Assigned(GroupNode) then
                begin
                    if not Assigned(PrevNode)
                        then GroupNode.SubItems := Node
                        else PrevNode.NextAlternative := Node;
                end;
                PrevNode := Node;
            end;
        end;

        CheckGroupEnd(TextPos, EndChar);
    except
        GroupNode.Free;
        raise;
    end;

    Result := GroupNode;
end;

procedure TtsTextMask.ParsePicture(SyntaxOnly: Boolean);
var
    List: TtsPictureList;
    Node, GroupNode: TtsPictureNode;
    TextPos: Integer;
begin
    List := nil;
    FValidPicture := True;
    FPictureParsed := True;
    if (Picture <> '') then
    begin
        FCreateTree := not SyntaxOnly;
        List := CreatePictureTree(pctText);
        try
            TextPos := 1;
            Node := GetNextAlternative(TextPos, #0);
            if Assigned(List) and Assigned(Node) then
            begin
                GroupNode := CreatePictureNode(pntGroup);
                GroupNode.Count := 1;
                GroupNode.Optional := False;
                GroupNode.SubItems := Node;
                List.StartNode := GroupNode;
            end;
        except
            List.Free;
            raise;
        end;
    end;

    FPictureList := List;
    FPictureParsed := True;
end;

procedure TtsTextMask.SetPicture(Value: string);
var
    RaiseError: Boolean;
begin
    if (FPicture <> Value) or not FPictureParsed then
    begin
        FPictureList.Free;
        FPictureList := nil;

        FPicture := Value;
        FPictureLength := Length(Value);
        try
            ParsePicture(True);
        except
            on E:EtsMaskError do
            begin
                FValidPicture := False;
                FPictureParsed := True;
                FMask.DoParseError(E.Message, RaiseError);
                if RaiseError then raise;
            end;

            on Exception do raise;
        end;
    end;
end;

function TtsTextMask.GetTextCase: TtsTextCase;
begin
    Result := FMask.TextCase;
end;

function TtsTextMask.GetPictureList: TtsPictureList;
begin
    if ((not FPictureParsed) or FValidPicture) and
       (not Assigned(FPictureList)) then ParsePicture(False);
    Result := FPictureList;
end;

function TtsTextMask.CheckCase(Text: string; TextPos: Integer; Chars: Integer; Option: TtsMaskOption): Boolean;
var
    I: Integer;
    Buf: array[1..2] of Char;
begin
    if Chars > High(Buf) then Chars := High(Buf);
    for I := 1 to Chars do Buf[I] := Text[TextPos - I + 1];

    if Option in [moUpper, moOptUpper]
        then CharUpperBuff(@Buf, Chars)
        else CharLowerBuff(@Buf, Chars);

    Result := True;
    for I := 1 to Chars do
    begin
        Result := (Buf[I] = Text[TextPos - I + 1]);
        if not Result then Break;
    end;
end;

function TtsTextMask.IsWordStart(MaskInput: TtsMaskInput): Boolean;
var
    Chars: Integer;
begin
    with MaskInput do
    begin
        Result := (TextPos = 1);
        if not Result then
        begin
            Chars := PrevCharCount(PChar(Text), TextPos - 1);
            Result := not IsTextChar(PChar(Text), TextPos - 1 - Chars);
        end;
    end;
end;

function TtsTextMask.IsSentenceStart(MaskInput: TtsMaskInput): Boolean;
var
    PText: PChar;
begin
    with MaskInput do
    begin
        Result := (TextPos = 1);
        if not Result then
        begin
            PText := StrRNTextScan(PChar(Text), TextPos - 1);
            if PText <> nil then Result := (PText^ = '.');
        end;
    end;
end;

function TtsTextMask.GetCaseType(const MaskInput: TtsMaskInput; Options: TtsMaskOptions;
                                 DefaultCase: TtsMaskOption): TtsMaskOption;
begin
    with MaskInput do
    begin
        Result := DefaultCase;
        if moUpper in Options then
            Result := moUpper
        else if (moLower in Options) then
            Result := moLower
        else if (moOptUpper in Options) then
            Result := moOptUpper
        else if (moOptLower in Options) then
            Result := moOptLower
        else if (TextCase.CaseType = cstUpper) then
        begin
            if TextCase.Optional then Result := moOptUpper
                                 else Result := moUpper
        end
        else if TextCase.CaseType = cstLower then
        begin
            if TextCase.Optional then Result := moOptLower
                                 else Result := moLower
        end
        else
        begin
            case TextCase.CaseType of
                cstTitle:
                    if IsWordStart(MaskInput) then
                    begin
                        if TextCase.Optional then Result := moOptUpper
                                             else Result := moUpper;
                    end;

                cstSentence:
                    if IsSentenceStart(MaskInput) then
                    begin
                        if TextCase.Optional then Result := moOptUpper
                                             else Result := moUpper;
                    end;
            end;
        end;
    end;
end;

function TtsTextMask.IsInputChar(const MaskInput: TtsMaskInput): Boolean;
begin
    with MaskInput do
    begin
        Result := (TextPos >= InsertPos) and
                  (TextPos <= InsertPos + InsertLen - 1);
    end;
end;

function TtsTextMask.CanConvertCase(const MaskInput: TtsMaskInput; Options: TtsMaskOptions; CaseType: TtsMaskOption): Boolean;
begin
    with MaskInput do
    begin
        Result :=  IsInputChar(MaskInput) and (CaseType <> moNone) and
                   (moConvertInput in Options);
    end;
end;

procedure TtsTextMask.ConvertCase(var MaskInput: TtsMaskInput; Chars: Integer; ConvertType: TtsMaskOption);
begin
    with MaskInput do
    begin
        if ConvertType in [moUpper, moOptUpper] then
            CharUpperBuff(@Text[TextPos], Chars)
        else if ConvertType in [moLower, moOptLower] then
            CharLowerBuff(@Text[TextPos], Chars);
    end;
end;

function TtsTextMask.CanInsertLiteral(MaskInput: TtsMaskInput; Options: TtsMaskOptions): Boolean;
begin
    Result := (MaskInput.TextPos = MaskInput.InsertPos) and
              (moInsertLiteral in Options);
end;