wwpict.pas

胜天进销存源码,国产优秀的进销存

        curPos:= startGroup;
        repeat
           ToGroupEnd(curPos, endGroup)
        until (curPos >= EndGroup) or (Pic^[curPos] = ',');
        result := curPos <= endGroup;
        tempEndGroup:= curPos-1;
      end;
    begin
       tempStartGroup:= startGroup;
       tempEndGroup:= endGroup;
       tempStartGroup:= tempStartGroup + 1;  { Skip opening parens }
       result:= False; { Make compiler happy }

       while True do begin
          if not GetSubGroup(tempStartGroup, tempEndGroup) then
          begin
             result:= False;
             break;
          end
          else if (CheckComplete(prIncomplete, tempStartGroup, tempEndGroup)=prAmbiguous) then
          begin
             result:= True;
             break;
          end
          else begin
             tempStartGroup:= tempEndGroup + 2;
             if tempStartGroup>endGroup then
             begin
                result:= False;
                break;
             end
          end
       end
    end;

    function CheckComplete(Rslt: TwwPicResult; startGroup, EndGroup: integer): TwwPicResult;
    var
      J, EndJ: word;
    begin
      J := startGroup;
      if IsIncomplete(Rslt) then
      begin
        { Skip optional pieces }
        while True do begin
          case Pic^[J] of
            '[': ToGroupEnd(J, EndGroup);

            '*':
              if not IsNumber(Pic^[J + 1]) then
              begin
                Inc(J);
                ToGroupEnd(J, EndGroup);
              end
              else begin
                if (J+2<EndGroup) and (Pic^[J + 2]='[') then {Whole iteration is Optional!!!}
                begin
                   j:= j+2;
                   ToGroupEnd(J, EndGroup)
                end
                else
                   Break;
              end;

            ',': ToParensEnd(J); { Scan until encounter ending parens }

            '{': begin
                   EndJ:= j;
                   ToGroupEnd(EndJ, EndGroup);
                   if isOptionalParensGroup(j, EndJ-1) then j:= EndJ
                   else break; { has a required character}
                 end

            else begin
                CheckComplete:= Rslt;  {Not complete }
                exit;
            end
          end;

          if J >= EndGroup then break;  { Nothing required in current Group }
        end;

        if (J >= EndGroup) then Rslt := prAmbiguous;
      end;
      CheckComplete := Rslt;
    end;

    function Scan: TwwPicResult;
    var
      Ch: Char;
      temp:string;
      Rslt: TwwPicResult;
    begin
      Scan := prError;
      Rslt := prEmpty;
      while (I <> TermCh) and (Pic^[I] <> ',') do
      begin
        if J > Length(Input) then
        begin
          Scan := CheckComplete(Rslt, I, TermCh);
          Exit;
        end;

        Ch := Input[J];
        case Pic^[I] of
          '#': if not IsNumber(Ch) then Exit
               else Consume(Ch);
          '?': if not IsIntlLetter(Ch) then Exit
               else Consume(Ch);
          '&': if not IsIntlLetter(Ch) then Exit
               else begin
                 temp := AnsiUpperCase(ch);
                 Ch := temp[1];
                 Consume(Ch);
               end;
          '~': if not IsIntlLetter(Ch) then Exit
               else begin
                 temp := AnsiLowerCase(ch);
                 Ch := temp[1];
                 Consume(Ch);
               end;
          '!': begin
                 temp := AnsiUpperCase(ch);
                 Ch := temp[1];
                 Consume(Ch);
               end;
          '@': Consume(Ch);
          '*':
            begin
              Rslt := Iteration;
              if not IsComplete(Rslt) then
              begin
                Scan := Rslt;
                Exit;
              end;
              if Rslt = prError then Rslt := prAmbiguous;
            end;
          '{':
            begin
              Rslt := Group;
              if not IsComplete(Rslt) then
              begin
                Scan := Rslt;
                Exit;
              end;
            end;
          '[':
            begin
              Rslt := Group;
              if IsIncomplete(Rslt) then
              begin
                Scan := Rslt;
                Exit;
              end;
              if Rslt = prError then Rslt := prAmbiguous;
            end;
        else
          if Pic^[I] = ';' then Inc(I);
          if UpCase(Pic^[I]) <> UpCase(Ch) then begin
            if (not SkipAutofill) and (Ch = ' ') and (j = length(input)) then
{               Ch := Pic^[I]}
            else Exit;
          end
          else begin
            if (Ch = ' ') and (j = length(input)) then
               SkipAutoFill := True;
          end;
          Consume(Pic^[I]);
        end;

        if Rslt = prAmbiguous then
          Rslt := prIncompNoFill
        else
          Rslt := prIncomplete;
      end;

      if Rslt = prIncompNoFill then
        Scan := prAmbiguous
      else
        Scan := prComplete;
    end;

  begin
    Incomp := False;
    Incompi:= 0;  Incompj:= 0; {Make compiler happy}
    OldI := I;
    OldJ := J;
    skipAutoFill := False;
    repeat
      Rslt := Scan;

      { Only accept completes if they make it farther in the input
        stream from the last incomplete }
      if (Rslt in [prComplete, prAmbiguous]) and Incomp and (J < IncompJ) then
      begin
        Rslt := prIncomplete;
        J := IncompJ;
      end;

      if (Rslt = prError) or (Rslt = prIncomplete) then
      begin
        Process := Rslt;
        if not Incomp and (Rslt = prIncomplete) then
        begin
          Incomp := True;
          IncompI := I;
          IncompJ := J;
        end;
        I := OldI;
        J := OldJ;
        if not SkipToComma then
        begin
          if Incomp then
          begin
            Process := prIncomplete;
            I := IncompI;
            J := IncompJ;
          end;
          Exit;
        end;
        OldI := I;
      end;
    until (Rslt <> prError) and (Rslt <> prIncomplete);

    if (Rslt = prComplete) and Incomp then
      Process := prAmbiguous
    else
      Process := Rslt;
  end;

  function SyntaxCheck: Boolean;
  var
    I: Integer;
    BrkLevel, BrcLevel: Integer;
  begin
    SyntaxCheck := False;

    if Pic^ = '' then Exit;

    if Pic^[Length(Pic^)] = ';' then Exit;
    if (Pic^[Length(Pic^)] = '*') and (Pic^[Length(Pic^) - 1] <> ';') then
      Exit;

    I := 1;
    BrkLevel := 0;
    BrcLevel := 0;
    while I <= Length(Pic^) do
    begin
      case Pic^[I] of
        '[': Inc(BrkLevel);
        ']': Dec(BrkLevel);
        '{': Inc(BrcLevel);
        '}': Dec(BrcLevel);
        ';': Inc(I);
      end;
      Inc(I);
    end;
    if (BrkLevel <> 0) or (BrcLevel <> 0) then Exit;

    SyntaxCheck := True;
  end;


begin
  Picture := prSyntax;
  OrigInput:= Input;
  if not SyntaxCheck then Exit;

  Picture := prEmpty;
  if Input = '' then Exit;

  J := 1;
  I := 1;

  Rslt := Process(Length(Pic^) + 1);
  if (Rslt <> prError) and (Rslt <> prSyntax) and (J <= Length(Input)) then
    Rslt := prError;

  if (Rslt = prIncomplete) and AutoFill then
  begin
    Reprocess := False;
    while (I <= Length(Pic^)) and
      not (Pic^[I] in ['#','?','&', '~', '!', '@', '*', '{', '}', '[', ']', ',', #0]) do
    begin
      if Pic^[I] = ';' then Inc(I);
      Input := Input + Pic^[I];
      Inc(I);
      Reprocess := True;
    end;
    J := 1;
    I := 1;
    if Reprocess then
    begin
      Rslt := Process(Length(Pic^) + 1);

      // 5/30/01 - If autofill failed, then use original Rslt
      if Rslt = prError then
      begin
         Rslt:= prIncomplete;
         Input:= OrigInput;
      end
    end
  end;

  if Rslt = prAmbiguous then
    Picture := prComplete
  else if Rslt = prIncompNoFill then
    Picture := prIncomplete
  else
    Picture := Rslt;
end;

end.