wwdbedit.pas

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

Function TwwCustomMaskEdit.HavePictureMask: boolean;
begin
   result:=
     FUsePictureMask and
     (FwwPicture.PictureMask<>'')
end;

Function TwwCustomMaskEdit.GetMaskBlank: char;
begin
   result:= MaskGetMaskBlank(EditMask);
end;

function MaskGetCharType(const EditMask: string; MaskOffset: Integer): TMaskCharType;
var
  MaskChar: Char;
begin
  Result := mcLiteral;
  MaskChar := #0;
  if MaskOffset <= Length(EditMask) then
    MaskChar := EditMask[MaskOffset];
  if MaskOffset > Length(EditMask) then
    Result := mcNone

  else if ByteType(EditMask, MaskOffset) <> mbSingleByte then
    Result := mcLiteral

  else if (MaskOffset > 1) and (EditMask[MaskOffset - 1] = mDirLiteral) and
      (ByteType(EditMask, MaskOffset - 1) = mbSingleByte) and
      not ((MaskOffset > 2) and (EditMask[MaskOffset - 2] = mDirLiteral) and
      (ByteType(EditMask, MaskOffset - 2) = mbSingleByte)) then
    Result := mcLiteral
  else if (MaskChar = MaskFieldSeparator) and
         (Length(EditMask) >= 4) and
         (MaskOffset > Length(EditMask) - 4) then
    Result := mcFieldSeparator

  else if (Length(EditMask) >= 4) and
         (MaskOffset > (Length(EditMask) - 4)) and
         (EditMask[MaskOffset - 1] = MaskFieldSeparator) and
         not ((MaskOffset > 2) and (EditMask[MaskOffset - 2] = mDirLiteral) and
         (ByteType(EditMask, MaskOffset - 2) <> mbTrailByte)) then
    Result := mcField
  else if MaskChar in [mMskTimeSeparator, mMskDateSeparator] then
    Result := mcIntlLiteral

  else if MaskChar in [mDirReverse, mDirUpperCase, mDirLowerCase,
      mDirLiteral] then
    Result := mcDirective

  else if MaskChar in [mMskAlphaOpt, mMskAlphaNumOpt, mMskAsciiOpt,
      mMskNumSymOpt, mMskNumericOpt] then
    Result := mcMaskOpt

  else if MaskChar in [mMskAlpha, mMskAlphaNum, mMskAscii, mMskNumeric] then
    Result := mcMask;
end;

function MaskGetCurrentDirectives(const EditMask: string;
  MaskOffset: Integer): TMaskDirectives;
var
  I: Integer;
  MaskChar: Char;
begin
  Result := [];
  for I := 1 to Length(EditMask) do
  begin
    MaskChar := EditMask[I];
    if (MaskChar = mDirReverse) then
      Include(Result, mdReverseDir)
    else if (MaskChar = mDirUpperCase) and (I < MaskOffset) then
    begin
      Exclude(Result, mdLowerCase);
      if not ((I > 1) and (EditMask[I-1] = mDirLowerCase)) then
        Include(Result, mdUpperCase);
    end
    else if (MaskChar = mDirLowerCase) and (I < MaskOffset) then
    begin
      Exclude(Result, mdUpperCase);
      Include(Result, mdLowerCase);
    end;
  end;
  if MaskGetCharType(EditMask, MaskOffset) = mcLiteral then
    Include(Result, mdLiteralChar);
end;

function TwwCustomMaskEdit.RemoveEditFormat(const Value: string): string;
var
  I: Integer;
  OldLen: Integer;
  Offset, MaskOffset: Integer;
  CType: TMaskCharType;
  Dir: TMaskDirectives;
begin
  Offset := 1;
  Result := Value;
  for MaskOffset := 1 to Length(EditMask) do
  begin
    CType := MaskGetCharType(EditMask, MaskOffset);

    if CType in [mcLiteral, mcIntlLiteral] then
      Result := Copy(Result, 1, Offset - 1) +
        Copy(Result, Offset + 1, Length(Result) - Offset);
    if CType in [mcMask, mcMaskOpt] then Inc(Offset);
    if CType in [mcFieldSeparator] then
    begin
//       screen.cursor:= crarrow;
       break;
    end
  end;

  Dir := MaskGetCurrentDirectives(EditMask, 1);
  if mdReverseDir in Dir then
  begin
    Offset := 1;
    for I := 1 to Length(Result) do
    begin
      if Result[I] = GetMaskBlank then
        Inc(Offset)
      else
        break;
    end;
    if Offset <> 1 then
      Result := Copy(Result, Offset, Length(Result) - Offset + 1);
  end
  else begin
    OldLen := Length(Result);
    for I := 1 to OldLen do
    begin
      if Result[OldLen - I + 1] = GetMaskBlank then
        SetLength(Result, Length(Result) - 1)
      else Break;
    end;
  end;
  if GetMaskBlank <> ' ' then
  begin
    OldLen := Length(Result);
    for I := 1 to OldLen do
    begin
      if Result[I] = GetMaskBlank then
        Result[I] := ' ';
      if I > OldLen then Break;
    end;
  end;
end;

function TwwCustomMaskEdit.JustHaveLiteralTemplate: boolean;
var TempEditText: string;
begin
   result:= False;
   if MaskStoreLiteralTemplate then exit;

   if (not HavePictureMask) and
      (EditMask<>'') then
   begin
     TempEditText:= EditText;
     TempEditText:= RemoveEditFormat(TempEditText);
     strStripTrailing(TempEditText, [' ']);

     if TempEditText='' then { If blank, then just have literal text }
     begin
        result:= True;
     end;
   end;
end;

procedure TwwCustomMaskEdit.DoExit;
var valid: boolean;
begin
   inherited DoExit;

   DoExitPictureError:= False;

   // 2/24/00 - If just literal template then
{   if not HavePictureMask and (EditMask<>'') and Modified then
   begin
       if JustHaveLiteralTemplate then exit;
       ValidateEdit;
       exit;
   end;
}
   if not Modified then exit;

   if (regexMask.Mask<>'') then
   begin
     valid:= RegexMatch(regexmask.mask, not regexmask.CaseSensitive, Text);

     //DoOnCheckValue(valid);
     if (not valid) and (not regexMask.AllowInvalidExit) then
       begin
         SelectAll;
         SetFocus;
         Modified:= True; {SetFocus clears modified so set it back to true }
         ValidationErrorUsingMask(regexMask.ErrorMessage);
         MessageBeep(0);
         DoExitPictureError:= True;  { Communicate to cmExit routine }
       end;

   end;

   if HavePictureMask then
   begin
      valid:=isValidPictureValue(Text);

      if ((not valid) and (not FwwPicture.AllowInvalidExit)) then
      begin
         SelectAll;
         SetFocus;
         Modified:= True; {SetFocus clears modified so set it back to true }
         MessageBeep(0);
         DoExitPictureError:= True;  { Communicate to cmExit routine }
      end
   end;

//   DoOnCheckValue(valid);

end;

procedure TwwDBCustomEdit.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (FDataLink <> nil) and
    (AComponent = DataSource) then DataSource := nil;
  if (Operation = opRemove) then begin
     if (AComponent = FController) then FController:= nil;
  end;

end;


procedure TwwDBCustomEdit.KeyDown(var Key: Word; Shift: TShiftState);
type
  TSelection = record
    StartPos, EndPos: Integer;
  end;

var
  parentGrid: TCustomGrid; { 6/22/99 - Support TwwObjectView embedding }

  procedure SendToObjectView;
  begin
    if not IsInwwObjectView(self) then exit;
//    TwwDBGrid(ParentGrid).KeyDown(Key, Shift);
    TCheatGridCast(ParentGrid).KeyDown(Key, Shift);
  end;

  procedure SendToParent;
  begin
    if ParentGrid.Visible then ParentGrid.setFocus;
    { If grid does not have focus then SetFocus raised exception }
    if ParentGrid.focused then  { 7/2/98 }
       TCheatGridCast(ParentGrid).KeyDown(Key, Shift);
//       TwwDBGrid(ParentGrid).KeyDown(Key, Shift);
    Key := 0;
  end;

  procedure ParentEvent;
  var
    GridKeyDown: TKeyEvent;
  begin
    { 1/25/99 - Prevent grid's OnKeyDown from firing twice when encounter tab or cr }
    if (Screen.ActiveControl<>self) and ((key=13) or (key=9)) then exit;

//    GridKeyDown := TwwDBGrid(ParentGrid).OnKeyDown;
    GridKeyDown:= TCheatGridCast(ParentGrid).OnKeyDown;
    if Assigned(GridKeyDown) then GridKeyDown(ParentGrid, Key, Shift);
  end;

  function ForwardMovement: Boolean;
  begin
     Result := (dgAlwaysShowEditor in wwGetGridOptions(self));
  end;
{  function ForwardMovement: Boolean;
  var tempGrid: TwwDBGrid;
  begin
     if ParentGrid is TwwDBGrid then
     begin
       tempGrid:= ParentGrid as TwwDBGrid;
       Result := (dgAlwaysShowEditor in (tempGrid.Options));
     end
     else result:= False;
  end;
}
  function Ctrl: Boolean;
  begin
    Result := ssCtrl in Shift;
  end;

  function Alt: Boolean;
  begin
    Result := ssAlt in Shift;
  end;

  function Selection: TSelection;
  begin
    {$ifdef win32}
    SendMessage(Handle, EM_GETSEL, Longint(@Result.StartPos), Longint(@Result.EndPos));
    {$else}
    Longint(Result) := SendMessage(Handle, EM_GETSEL, 0, 0);
    {$endif}
  end;

  function RightSide: Boolean;
  begin
    with Selection do
      Result := ((StartPos = 0) or (EndPos = StartPos)) and
        (EndPos = GetTextLen);
   end;

  function LeftSide: Boolean;
  begin
    with Selection do
      Result := (StartPos = 0) and
      ((EndPos = 0) or (EndPos = GetTextLen) or (isMasked and (EndPos=1)));
  end;

  procedure Deselect;
  begin
    {$ifdef win32}
    SendMessage(Handle, EM_SETSEL, -1, 0);
    {$else}
    SendMessage(Handle, EM_SETSEL, 1, $FFFFFFFF);
    {$endif}
    selLength:= 0;  {7/8/97 - Forces text to move to the far left }
  end;

  Function InsideMemoField: boolean;
  begin
     result:=
        (FDataLink.Field<>Nil) and isMemoField and (not allSelected);
  end;

begin
  { Don't pass to parent if inside memofield }
  if (parent is TCustomGrid) and not InsideMemoField then
  begin
     parentGrid:=  (parent as TCustomGrid);

     case Key of
       VK_ESCAPE: if not modified then SendToParent;
       VK_UP, VK_DOWN, VK_NEXT, VK_PRIOR: if (not Alt) then SendToParent;
       VK_LEFT: if IsInwwObjectView(self) then
                begin
//                   if Ctrl or LeftSide then SendToObjectView
                end
                else if ForwardMovement and (Ctrl or LeftSide) then SendToParent;
       VK_RIGHT: if IsInwwObjectView(self) then
                 begin
//                    if Ctrl or RightSide then SendToObjectView
                 end
                 else if ForwardMovement and (Ctrl or RightSide) then SendToParent;
       VK_HOME: if ForwardMovement and (Ctrl or LeftSide) then SendToParent;
       VK_END: if ForwardMovement and (Ctrl or RightSide) then SendToParent;
       VK_INSERT: if not (ssShift in Shift) then SendToParent; {12/20/96 - Pass to grid only if insert only}
       VK_DELETE: if (Ctrl) then SendToParent;
       VK_F2:
         begin
           ParentEvent;
           if Key = VK_F2 then
           begin
             if Editable then Deselect;
             Exit;
           end;
         end;
     end;
     if (not Editable) and (Key in [VK_LEFT, VK_RIGHT, VK_HOME, VK_END]) then SendToParent;

     if Key <> 0 then
       ParentEvent;

  end;

  if (Key <> 0) then begin
     inherited KeyDown(Key, Shift);
     if (Key = VK_DELETE) or ((Key = VK_INSERT) and (ssShift in Shift)) then
     begin
        if (DataSource=nil) then begin  {10/2/96 }
           if not ReadOnly then ReadOnly:= False
        end
        else begin
           if PreventEdit then begin
              key:= 0;
              exit;
           end;
{           if (DataSource<>Nil) and (not DataSource.autoEdit) then
           begin
              if (not (DataSource.state in [dsEdit, dsInsert])) then begin
                 key:= 0;
                 exit;
              end
           end;}
           FDataLink.Edit;
           SetModified(True); {12/20/96 - Delete should set modified flag }
        end
     end
  end