eznumed.pas

很管用的GIS控件

    Clipboard.AsText := FloatToStr( FNumericValue );
    Key := #0;
    exit;
  End;

  If ( FReadOnly = false ) And ( Key = ^V ) Then
  Begin {paste}
    Try
      Value := MyStrToFloat( Clipboard.AsText );
      If Not FAcceptNegatives Then
        Value := Abs( Value );
      FNumericValue := Value;
      Change;
      Invalidate;
    Except
      MessageBeep( 0 );
    End;
    Key := #0;
    Exit;
  End;

  Inherited KeyPress( Key );

  If FReadOnly Then
  Begin
    Key := #0;
    Exit;
  End;

  If Not ( Key In ['0'..'9', FDecimalSeparator, '-', #8] ) Then
  Begin
    MessageBeep( 0 );
    Key := #0;
    exit;
  End;

  FLastKey := Key;
  Changed := false;
  s := GetUnformattedText;
  sMask:= CreateMask( FEditFormat );
  OneIntegerDigit := false;
  If Length(sMask) = 1 Then
    OneIntegerDigit := true
  Else If ( Length( s ) > 1 ) Then
  Begin
    P := AnsiPos( FDecimalSeparator, s );
    If ( P > 0 ) And ( Copy( sMask, 1, 2 ) = '0' + FDecimalSeparator ) Then
      OneIntegerDigit := true;
  End;
  If Key In ['0'..'9'] Then
  Begin
    {insert the number}
    If Not FModified Then
    Begin
      FNumericValue := 0;
      s := GetUnformattedText;
      FModified := true;
    End;
    If ( FPartEditing = peInteger ) Then
    Begin
      If OneIntegerDigit Or
        ( Length( TrimLeft( AsString ) ) < Length( sMask ) ) Then
      Begin
        P := AnsiPos( FDecimalSeparator, s );
        If P = 0 Then
        Begin
          If sMask <> '0' Then
            s := s + Key
          Else
            s := Key;
        End
        Else
        Begin
          If Copy( sMask, 1, 2 ) = '0' + FDecimalSeparator Then
            s[P - 1] := Key
          Else
            System.Insert( Key, s, P );
        End;
      End;
    End
    Else
    Begin
      p2 := AnsiPos( FDecimalSeparator, AsString ) + 1;
      If FSelStart < p2 Then
        FSelStart := p2;
      P := FSelStart - p2 + 1;
      p1 := AnsiPos( FDecimalSeparator, s );
      s[p1 + p] := Key;
    End;
    FNumericValue := MyStrToFloat( s );
    If FNegFlag Then
    Begin
      FNumericValue := -FNumericValue;
      FNegFlag := false;
    End;
    Changed := true;
    SetCursorPos;
  End;

  If Key = #8 Then
  Begin {BACKSPACE}
    If FPartEditing = peInteger Then
    Begin
      p := AnsiPos( FDecimalSeparator, s );
      If p = 0 Then
        System.delete( s, Length( s ), 1 )
      Else
        System.delete( s, p - 1, 1 );
    End
    Else
    Begin
      p2 := AnsiPos( FDecimalSeparator, AsString ) + 1;
      If FSelStart < p2 Then
        FSelStart := p2;
      P := FSelStart - p2 + 1;
      p1 := AnsiPos( FDecimalSeparator, s );
      s[p1 + p] := '0';
    End;
    If ( s = '' ) Or ( s = '-' ) Then
    Begin
      FNumericValue := 0.0;
      FNegFlag := false;
    End
    Else
      FNumericValue := MyStrToFloat( s );
    FModified := true;
    Changed := true;
    SetCursorPos;
  End;

  If Key = FDecimalSeparator Then
  Begin
    FModified := true;
    If ( FPartEditing = peInteger ) And ( AnsiPos( FDecimalSeparator, sMask ) > 0 ) Then
    Begin
      FPartEditing := peDecimal;
    End
    Else
      FPartEditing := peInteger;
    Changed := true;
    SetCursorPos;
  End;

  If ( Key = '-' ) And FAcceptNegatives Then
  Begin
    If Not FModified Then
    Begin
      FNumericValue := 0;
      FModified := true;
    End;
    FNumericValue := -FNumericValue;
    If FNumericValue = 0 Then
      FNegFlag := Not FNegFlag;
    Changed := true;
  End;
  If Changed Then
  Begin
    Change;
    If Parent <> Nil Then
      SendMessage( Parent.Handle, WM_COMMAND, 0, ( EN_CHANGE Shl 16 ) Or Handle );
  End;
  Invalidate;
End;

Procedure TEzNumEd.SetBorderStyle( Value: TEzBorderStyle );
Begin
  If FBorderStyle <> Value Then
  Begin
    FBorderStyle := Value;
    RecreateWnd;
  End;
End;

Procedure TEzNumEd.CMFontChanged( Var Message: TMessage );
Begin
  Inherited;
  Invalidate;
End;

Procedure TEzNumEd.Change;
Begin
  If Assigned( FOnChange ) Then
    FOnChange( Self );
End;

Procedure TEzNumEd.WMActivateApp( Var Message: TWMActivateApp );
Begin
  Inherited;
  If ( Not Message.Active ) And Focused Then
    EditExit;
End;

Procedure TEzNumEd.SetHeightPad( Value: Integer );
Begin
  If Value <> FHeightPad Then
  Begin
    {if (FAcceptNegatives = false) and (Value < 0) then
       raise Exception.Create('Numeric value must be >= 0');}
    FHeightPad := Value;
    //     if Focused then SetCursorPos;
    Invalidate;
    //     Change;
  End;
End;

Procedure TEzNumEd.SetWidthPad( Value: Integer );
Begin
  If Value <> FWidthPad Then
  Begin
    {if (FAcceptNegatives = false) and (Value < 0) then
       raise Exception.Create('Numeric value must be >= 0');}
    FWidthPad := Value;
    //     if Focused then SetCursorPos;
    Invalidate;
    //     Change;
  End;
End;

{$IFNDEF BCB}

{- TEzDBNumEd control -}

Constructor TEzDBNumEd.Create( AOwner: TComponent );
Begin
  Inherited Create( AOwner );

  Inherited ReadOnly := true;

  FDataLink := TFieldDataLink.Create;
  FDataLink.Control := Self;

  FDataLink.OnDataChange := DataChange;
  FDataLink.OnEditingChange := EditingChange;
  FDataLink.OnUpdateData := UpdateData;
  FDataLink.OnActiveChange := ActiveChange;

End;

Destructor TEzDBNumEd.Destroy;
Begin
  FDataLink.Free;
  FDataLink := Nil;
  Inherited destroy;
End;

Procedure TEzDBNumEd.Change;
Begin
  If FDataLink <> Nil Then
    FDataLink.Modified;
  Inherited Change;
End;

Procedure TEzDBNumEd.DataChange( Sender: TObject );
Var
  TrashText: String;
Begin
  If FDataLink.Field = Nil Then Exit;
  { FDataLink.Field.Alignment is ignored
    also FDataLink.Field.EditMask is ignored.
    EditFormat is used instead}

  If FDataLink.CanModify Then
    If FDataLink.Field.DataType In ( [ftBCD, ftCurrency, ftFloat, ftSmallInt, ftInteger, ftWord] ) Then
    Begin
      If FDataLink.Field.Text = '' Then
      Begin
        NumericValue := 0.0; {accesing the property, update FOriginalValue}
      End
      Else
      Begin
        TrashText := FDataLink.Field.Text;
        While AnsiPos( FThousandSeparator, trashText ) > 0 Do
          Delete( TrashText, AnsiPos( FThousandSeparator, TrashText ), 1 );
        While AnsiPos( CurrencyString, trashText ) > 0 Do
          Delete( TrashText, AnsiPos( CurrencyString, TrashText ), Length( CurrencyString ) );
        {accesing the property, update FOriginalValue}
        NumericValue := MyStrToFloat( TrashText );
      End;
      Invalidate;
      FModified := false;
    End;
End;

Procedure TEzDBNumEd.EditingChange( Sender: TObject );
Begin
  Inherited ReadOnly := Not FDataLink.Editing;
End;

Procedure TEzDBNumEd.ActiveChange( Sender: TObject );
Begin
  If ( FDataLink <> Nil ) And FDatalink.Active Then
    CheckFieldType( DataField );
End;

Procedure TEzDBNumEd.UpdateData( Sender: TObject );
Begin
  If FDataLink = Nil Then
    exit;
  Case FDataLink.Field.DataType Of
    ftBCD: TBCDField( FDataLink.Field ).AsFloat := FNumericValue;
    ftCurrency: TCurrencyField( FDataLink.Field ).AsFloat := FNumericValue;
    ftFloat: TFloatField( FDataLink.Field ).AsFloat := FNumericValue;
    ftSmallInt: TSmallIntField( FDataLink.Field ).AsInteger := round( FNumericValue );
    ftInteger: TIntegerField( FDataLink.Field ).AsInteger := round( FNumericValue );
    ftWord: TWordField( FDataLink.Field ).AsInteger := round( FNumericValue );
  End;
End;

Function TEzDBNumEd.GetDataSource: TDataSource;
Begin
  Result := FDataLink.DataSource;
End;

Procedure TEzDBNumEd.SetDataSource( Value: TDataSource );
Begin
  FDataLink.DataSource := Value;
End;

Function TEzDBNumEd.GetDataField: String;
Begin
  Result := FDataLink.FieldName;
End;

Procedure TEzDBNumEd.SetDataField( Const Value: String );
Begin
  CheckFieldType( Value );
  FDataLink.FieldName := Value;
End;

Procedure TEzDBNumEd.CheckFieldType( Const Value: String );
Var
  FieldType: TFieldType;
Begin
  If ( Value <> '' ) And ( FDataLink <> Nil ) And ( FDataLink.Dataset <> Nil )
    And ( FDataLink.DataSet.Active ) Then
  Begin
    FieldType := FDataLink.DataSet.FieldByName( Value ).DataType;
    If Not ( FieldType In [ftCurrency, ftBCD, ftFloat, ftsmallint, ftinteger, ftword] ) Then
      Raise EInvalidFieldType.Create( 'DataField can only be connected to' +
        ' columns of type Numeric' );
  End
End;

Function TEzDBNumEd.GetReadOnly: Boolean;
Begin
  Result := FDataLink.ReadOnly;
End;

Procedure TEzDBNumEd.SetReadOnly( Value: Boolean );
Begin
  FDataLink.ReadOnly := Value;
End;

Function TEzDBNumEd.GetField: TField;
Begin
  Result := FDataLink.Field;
End;

Procedure TEzDBNumEd.Notification( AComponent: TComponent;
  Operation: TOperation );
Begin
  Inherited Notification( AComponent, Operation );
  If ( Operation = opRemove ) And ( FDataLink <> Nil ) And
    ( AComponent = DataSource ) Then
    DataSource := Nil;
End;

Procedure TEzDBNumEd.CMEnter( Var Message: TCMEnter );
Begin
  FDataLink.Reset;
  Inherited;
End;

Procedure TEzDBNumEd.CMExit( Var Message: TCMExit );
Begin
  Try
    FDataLink.UpdateRecord;
  Except
    Windows.SetFocus( Handle );
    Raise;
  End;
  Inherited;
End;

Procedure TEzDBNumEd.KeyDown( Var Key: Word; Shift: TShiftState );
Begin
  Inherited KeyDown( Key, Shift );
  If ( Key = VK_DELETE ) Or ( ( Key = VK_INSERT ) And ( ssShift In Shift ) ) Then
    FDataLink.Edit;
  If ( Key = VK_DELETE ) And ( Shift = [] ) Then
  Begin
    If FDataLink <> Nil Then
    Begin
      FNumericValue := 0;
      Change;
    End;
  End;
End;

Procedure TEzDBNumEd.KeyPress( Var Key: Char );
Var
  NumericValue_: extended;
Begin
  If ( Key In [#32..#255] ) And ( FDataLink.Field <> Nil ) And
    Not FDataLink.Field.IsValidChar( Key ) Then
  Begin
    MessageBeep( 0 );
    Key := #0;
  End;
  Case Key Of
    ^H, ^V, ^X, #32..#255:
      FDataLink.Edit;
    #27:
      Begin
        FDataLink.Reset;
        FModified := false;
        Key := #0;
      End;
  End;

  NumericValue_ := FNumericValue;

  Inherited KeyPress( Key );

  If FNumericValue <> NumericValue_ Then
    FDataLink.Modified;

End;
{$ENDIF}

End.