cxmaskedit.pas

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

  finally
    AStream.Free;
  end;

  FNeedUpdateEditValue := not HasEdit;
end;

function TcxMaskEditRegExprExMode.GetEmptyString: string;
var
  ARegExpr: TcxRegExpr;
begin
  ARegExpr := TcxRegExpr.Create;
  ARegExpr.CaseInsensitive := Properties.CaseInsensitive;
  ARegExpr.UpdateOn := False;

  if CompileRegExpr(ARegExpr) then
  begin
    ARegExpr.OnSymbolUpdate := InternalSymbolUpdate;
    FInternalUpdate := '';
    ARegExpr.UpdateOn := True;
    Result := FInternalUpdate;
  end
  else
    Result := '';

  ARegExpr.Free;
end;

function TcxMaskEditRegExprExMode.GetFormattedText(AText: string;
  AMatchForBlanksAndLiterals: Boolean = True): string;
begin
  if not FRegExpr.IsCompiled then
  begin
    Result := '';
    Exit;
  end;

  FRegExpr.UpdateOn := False;
  Clear;

  Result := inherited GetFormattedText(AText, AMatchForBlanksAndLiterals);

  FRegExpr.UpdateOn := True;
  Result := Result + FUpdate;
end;

procedure TcxMaskEditRegExprExMode.GotoEnd;
begin
  FRegExpr.UpdateOn := False;

  inherited GotoEnd;

  FRegExpr.UpdateOn := True;
end;

function TcxMaskEditRegExprExMode.IsFullValidText(AText: string): Boolean;
var
  ARegExpr: TcxRegExpr;

  function IsStart: Boolean;
  begin
    ARegExpr.UpdateOn := True;
    Result := AText = FInternalUpdate; 
  end;

var
  I: Integer;
begin
  ARegExpr := TcxRegExpr.Create;
  ARegExpr.CaseInsensitive := Properties.CaseInsensitive;
  ARegExpr.UpdateOn := False;
  Result := CompileRegExpr(ARegExpr);

  if Result then
  begin
    ARegExpr.OnSymbolUpdate := InternalSymbolUpdate;
    FInternalUpdate := '';
    if not IsStart then
    begin
      ARegExpr.UpdateOn := False;
      ARegExpr.Reset;
      for I := 1 to Length(AText) do
      begin
        if not ARegExpr.Next(AText[I]) then
        begin
          Result := False;
          Break;
        end;
      end;

      if Result then
        if not Properties.IgnoreMaskBlank then
          Result := ARegExpr.IsFinal;
    end;
  end;

  ARegExpr.Free;
end;

procedure TcxMaskEditRegExprExMode.PrePasteFromClipboard;
begin
  CursorCorrection;
end;

function TcxMaskEditRegExprExMode.PressBackSpace: Boolean;
var
  ASelLength: Integer;
  I: Integer;
begin
  CursorCorrection;
  Clear;

  if FEdit.SelLength <= 0 then
  begin
    if FHead = '' then
    begin
      Result := False;
      Exit;
    end;

    FRegExpr.Prev;

    if FRegExpr.IsStart then
      if FEdit.SelStart = FDeleteNumber then
      begin
        FRegExpr.Next(FHead[1]);
        Result := False;
        BeepOnError;
        Exit;
      end;

    Delete(FHead, Length(FHead) - FDeleteNumber, FDeleteNumber + 1);

    for I := 0 to FDeleteNumber do
      FEdit.SendMyKeyPress(#8);

    FRegExpr.UpdateOn := False;

    if NextTail then
      UpdateTail
    else
      ClearTail;

    FRegExpr.UpdateOn := True;
  end
  else
  begin
    DeleteSelection;

    if FEdit.SelStart = 0 then
    begin
      FRegExpr.UpdateOn := False;
      FRegExpr.UpdateOn := True;
      if FUpdate <> '' then
      begin
        FHead := FUpdate;
        Clear;
        ASelLength := FEdit.SelLength;
        FEdit.SelStart := Length(FHead);
        FEdit.SelLength := ASelLength - FEdit.SelStart;
        FTail := Copy(FEdit.Text, FEdit.SelStart + 1, FEdit.SelLength) + FTail;
        Result := PressBackSpace;
        Exit;
      end
    end;

    FEdit.SendMyKeyPress(#8);

    FRegExpr.UpdateOn := False;

    if NextTail then
      UpdateTail
    else
      ClearTail;

    FRegExpr.UpdateOn := True;
  end;

  Result := False;
end;

function TcxMaskEditRegExprExMode.PressDelete: Boolean;
var
  I: Integer;
begin
  CursorCorrection;
  Clear;

  if FEdit.SelLength <= 0 then
  begin
    if FTail = '' then
    begin
      Result := False;
      Exit;
    end;

    if FEdit.SelStart = 0 then
    begin
      FRegExpr.UpdateOn := False;
      FRegExpr.UpdateOn := True;
      if FUpdate <> '' then
      begin
        FRegExpr.Prev;
        Clear;
        Result := False;
        BeepOnError;
        Exit;
      end;
    end;

    FRegExpr.Next(FTail[1]);
    for I := 0 to Length(FUpdate) do
      FEdit.SendMyKeyDown(VK_DELETE, []);
    Delete(FTail, 1, Length(FUpdate) + 1);
    FRegExpr.Prev;

    FRegExpr.UpdateOn := False;

    if NextTail then
      UpdateTail
    else
      ClearTail;

    FRegExpr.UpdateOn := True;
  end
  else
    PressBackSpace;

  Result := False;
end;

function TcxMaskEditRegExprExMode.PressEnd: Boolean;
begin
  Result := True;

  CursorCorrection;
  Clear;

  FRegExpr.UpdateOn := False;

  inherited PressEnd;

  FRegExpr.UpdateOn := True;
end;

function TcxMaskEditRegExprExMode.PressHome: Boolean;
begin
  Result := True;

  CursorCorrection;
  Clear;

  inherited PressHome;
end;

function TcxMaskEditRegExprExMode.PressLeft: Boolean;
var
  I: Integer;
begin
  Result := True;

  CursorCorrection;
  Clear;

  if FEdit.SelLength > 0 then
  begin
    if (FEdit.CursorPos = FEdit.SelStart + FEdit.SelLength) and
        not FEdit.FShiftOn then
    begin
      FRegExpr.UpdateOn := False;
      inherited PressLeft;
      Clear;
      FRegExpr.UpdateOn := True;
      if FUpdate <> '' then
        FRegexpr.Prev;

      Exit;
    end
    else if (FEdit.CursorPos = FEdit.SelStart) and not FEdit.FShiftOn then
      Exit;
  end;

  inherited PressLeft;

  if FRegExpr.IsStart then
    if FEdit.SelStart = 0 then
    begin
      if FEdit.SelLength = FDeleteNumber then
        Dec(FDeleteNumber);
    end
    else
      if FEdit.SelStart = FDeleteNumber then
        Dec(FDeleteNumber);

  if FDeleteNumber > 0 then
  begin
    for I := 0 to FDeleteNumber - 1 do
    begin
      FTail := FHead[Length(FHead) - I] + FTail;
      FEdit.SendMyKeyDown(VK_LEFT, []);
    end;
    Delete(FHead, Length(FHead) - FDeleteNumber + 1, FDeleteNumber);
  end;
end;

function TcxMaskEditRegExprExMode.PressRight: Boolean;
var
  I: Integer;
begin
  Result := True;

  CursorCorrection;
  Clear;

  if FEdit.SelLength > 0 then
  begin
    if (FEdit.CursorPos = FEdit.SelStart) and
        not FEdit.FShiftOn then
    begin
      FRegExpr.UpdateOn := False;
      inherited PressRight;
      Clear;
      FRegExpr.UpdateOn := True;

      Exit;
    end
    else if (FEdit.CursorPos = FEdit.SelStart + Fedit.SelLength) and
        not FEdit.FShiftOn then
      Exit;
  end;

  inherited PressRight;

  if FUpdate <> '' then
  begin
    for I := 1 to Length(FUpdate) do
    begin
      FHead := FHead + FTail[I];
      FEdit.SendMyKeyDown(VK_RIGHT, []);
    end;
    Delete(FTail, 1, Length(FUpdate));
  end;
end;

function TcxMaskEditRegExprExMode.PressSymbol(var ASymbol: Char): Boolean;
var
  I: Integer;
  ASelLength: Integer;
begin
  CursorCorrection;
  Clear;

  if FEdit.SelLength > 0 then
  begin
    DeleteSelection;
    if FEdit.SelStart = 0 then
    begin
      FRegExpr.UpdateOn := False;
      FRegExpr.UpdateOn := True;
      if FUpdate <> '' then
      begin
        FHead := FUpdate;
        Clear;
        ASelLength := FEdit.SelLength;
        FEdit.SelStart := Length(FHead);
        FEdit.SelLength := ASelLength - FEdit.SelStart;
        FTail := Copy(FEdit.Text, FEdit.SelStart + 1, FEdit.SelLength) + FTail;
        Result := PressSymbol(ASymbol);
        Exit;
      end
    end;
  end;

  if FRegExpr.Next(ASymbol) then
  begin
    FHead := FHead + ASymbol + FUpdate;

    FEdit.SendMyKeyPress(ASymbol);
    for I := 1 to Length(FUpdate) do
      FEdit.SendMyKeyPress(FUpdate[I]);

    FRegExpr.UpdateOn := False;

    if NextTail then
      UpdateTail
    else
      ClearTail;

    FRegExpr.UpdateOn := True;
  end
  else
  begin
    if FEdit.SelLength > 0 then
      RestoreSelection;

    BeepOnError;
  end;

  FSelect := '';
  Result := False;
end;

procedure TcxMaskEditRegExprExMode.SetText(AText: string);
var
  I: Integer;
begin
  FRegExpr.UpdateOn := False;
  FRegExpr.Reset;

  for I := 1 to Length(AText) do
  begin
    FRegExpr.Next(AText[I]);
  end;

  Clear;
  FRegExpr.UpdateOn := True;
  FHead := AText + FUpdate;
  FTail := '';

  if HasEdit then
  begin
    FMouseAction := True;
    CursorCorrection;
  end;

  ClipboardTextLength := 0;
end;

procedure TcxMaskEditRegExprExMode.UpdateEditValue;
begin
  if FNeedUpdateEditValue then
  begin
    FEdit.InternalEditValue := FUpdate;
    FNeedUpdateEditValue := False;
  end;
end;

procedure TcxMaskEditRegExprExMode.CursorCorrection;

  procedure Next;
  begin
    if FTail <> '' then
    begin
      Clear;
      FRegExpr.Next(FTail[1]);
      FHead := FHead + Copy(FTail, 1, Length(FUpdate) + 1);
      Delete(FTail, 1, Length(FUpdate) + 1);
    end;
  end;

  procedure Prev;
  begin
    if FHead <> '' then
    begin
      Clear;
      FRegExpr.Prev;

      FTail := Copy(FHead, Length(FHead) - FDeleteNumber, FDeleteNumber + 1) + FTail;

      if FRegExpr.IsStart then
        FHead := ''
      else
        Delete(FHead, Length(FHead) - FDeleteNumber, FDeleteNumber + 1);
    end;
  end;

var
  ASelStart: Integer;
  ASelEnd: Integer;

  procedure CorrectSelLength;
  begin
    while True do
    begin
      Next;
      if ASelEnd <= Length(FHead) then
      begin
        FEdit.DirectSetSelLength(Length(FHead) - FEdit.SelStart);
        Break;
      end;
    end;
  end;

begin
  if not HasEdit or not FEdit.HandleAllocated then
    Exit;

  if (FHead = '') and (FTail = '') and (FEdit.Text <> '') then
  begin
    FTail := FEdit.Text;
    FRegExpr.Reset;
    FMouseAction := True;
  end;

  if not FMouseAction then
    Exit
  else
    FMouseAction := False;

  ASelStart := FEdit.SelStart;
  ASelEnd := FEdit.SelStart + FEdit.SelLength;

  // Correct FEdit.SelStart
  if ASelStart > Length(FHead) then
    while True do
    begin
      Next;
      if ASelStart < Length(FHead) then
      begin
        Prev;
        FEdit.DirectSetSelStart(Length(FHead));
        Break;
      end
      else
        if ASelStart = Length(FHead) then
          Break;
    end
  else
    if ASelStart < Length(FHead) then
      while True do
      begin
        Prev;