Einzelnen Beitrag anzeigen

Benutzerbild von matthiasl
matthiasl

Registriert seit: 30. Okt 2003
Ort: Nienburg
14 Beiträge
 
Delphi 2007 Enterprise
 
#7

Re: ungültiger Extended-Value

  Alt 18. Feb 2006, 07:19
Danke, Leute.

Leider muß ich sagen, daß ich Delphi 5.0 benutze und die Funktionen "IsNan" und "IsInfinite" anscheinend erst später dazugekommen sind.

Ich habe mich zu folgenden Routinen durchgerungen, um das Transportproblem DAO->MySql zu beseitigen. Dabei war eine Überlegung: Ein Fehler ist schlecht, ein unsichtbarer Fehler eine Katastrophe. Ich wollte also das Problem nicht einfach verstecken, sondern mir die Möglichkeit offen halten, einen eventuell ursächlichen Fehler irgendwann auch mal zu finden.

Delphi-Quellcode:
  procedure ValidateSingle(var Value:Single);
    // 4 Byte Float-Value
    // SEEEEEEE MMMMMMMM MMMMMMM MMMMMMM
    var
      c:Cardinal;
    begin
      c:=Cardinal(Pointer(Integer(@Value)+0)^);
      if ((c shr 24) and $7f)=$7f then begin
        case ((c shr 22) and 3) of
          2 : begin // INF
                if ((c shr 31) and 1)=0 then begin // Positiv
                  if MessageDlg('Es ist ein Wert von "positiv Unendlich" aufgetreten. Wollen Sie den Wert auf Null setzen?',mtConfirmation,[mbYes,mbNo],0)=idYes then
                    Value:=0;
                end else begin // Negativ
                  if MessageDlg('Es ist ein Wert von "negativ Unendlich" aufgetreten. Wollen Sie den Wert auf Null setzen?',mtConfirmation,[mbYes,mbNo],0)=idYes then
                    Value:=0;
                end;
              end;
          3 : begin // NAN
                if MessageDlg('Es ist ein ungültiger Fließkomma-Wert aufgetreten. Wollen Sie den Wert auf Null setzen?',mtConfirmation,[mbYes,mbNo],0)=idYes then
                  Value:=0;
              end;
        end;
      end;
    end;

  procedure ValidateDouble(var Value:Double);
    // 8 Byte Float-Value
    // SEEEEEEE EEEMMMMM MMMMMMMM MMMMMMMM MMMMMMMM MMMMMMMM MMMMMMMM MMMMMMMM
    var
      c:Cardinal;
    begin
      c:=Cardinal(Pointer(Integer(@Value)+4)^);
      if ((c shr 21) and $3ff)=$3ff then begin
        case ((c shr 19) and 3) of
          2 : begin // INF
                if ((c shr 31) and 1)=0 then begin // Positiv
                  if MessageDlg('Es ist ein Wert von "positiv Unendlich" aufgetreten. Wollen Sie den Wert auf Null setzen?',mtConfirmation,[mbYes,mbNo],0)=idYes then
                    Value:=0;
                end else begin // Negativ
                  if MessageDlg('Es ist ein Wert von "negativ Unendlich" aufgetreten. Wollen Sie den Wert auf Null setzen?',mtConfirmation,[mbYes,mbNo],0)=idYes then
                    Value:=0;
                end;
              end;
          3 : begin // NAN
                if MessageDlg('Es ist ein ungültiger Fließkomma-Wert aufgetreten. Wollen Sie den Wert auf Null setzen?',mtConfirmation,[mbYes,mbNo],0)=idYes then
                  Value:=0;
              end;
        end;
      end;
    end;

  procedure ValidateExtended(var Value:Extended);
    // 10 Byte Float-Value
    // SEEEEEEE EEEEEEEE MMMMMMMM MMMMMMMM MMMMMMMM MMMMMMMM MMMMMMMM MMMMMMMM MMMMMMMM MMMMMMMM
    var
      c:Cardinal;
    begin
      c:=Cardinal(Pointer(Integer(@Value)+6)^);
      if ((c shr 16) and $7fff)=$7fff then begin
        case ((c shr 14) and 3) of
          2 : begin // INF
                if ((c shr 31) and 1)=0 then begin // Positiv
                  if MessageDlg('Es ist ein Wert von "positiv Unendlich" aufgetreten. Wollen Sie den Wert auf Null setzen?',mtConfirmation,[mbYes,mbNo],0)=idYes then
                    Value:=0;
                end else begin // Negativ
                  if MessageDlg('Es ist ein Wert von "negativ Unendlich" aufgetreten. Wollen Sie den Wert auf Null setzen?',mtConfirmation,[mbYes,mbNo],0)=idYes then
                    Value:=0;
                end;
              end;
          3 : begin // NAN
                if MessageDlg('Es ist ein ungültiger Fließkomma-Wert aufgetreten. Wollen Sie den Wert auf Null setzen?',mtConfirmation,[mbYes,mbNo],0)=idYes then
                  Value:=0;
              end;
        end;
      end;
    end;

  procedure ValidateVariant(var Value:Variant);
    begin
      case tVarData(Pointer(@Value)^).VType of
        varSingle:ValidateSingle(tVarData(Pointer(@Value)^).VSingle);
        varDouble:ValidateDouble(tVarData(Pointer(@Value)^).VDouble);
      end;
    end;
Herzlichen Dank nochmal.
  Mit Zitat antworten Zitat