// efg, October 2000, www.efg2.com/Lab
// Some ideas adapted from Ray Lischner's math10.zip from
// http://www.tempest-sw.com/freeware/freeware.cgi?Delphi

unit ScreenRounding;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TFormRound = class(TForm)
    ButtonNearest: TButton;
    Memo: TMemo;
    ButtonDown: TButton;
    ButtonUp: TButton;
    ButtonTruncate: TButton;
    procedure ButtonClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FormRound: TFormRound;

implementation
{$R *.DFM}

type TRoundMode = (rmNearest, rmDown, rmUp, rmTruncate);


// Return the FPU control word
function GetControlWord:  Word;  Assembler;
  var
    ControlWord: Word;
asm
  FSTCW ControlWord
  MOV AX, ControlWord
end;


// Return the current rounding mode
function GetRoundMode: TRoundMode;
begin
  Result := TRoundMode((GetControlWord SHR 10) AND 3);
end;


// Set the rounding mode and return the old mode
function SetRoundMode(RoundMode: TRoundMode): TRoundMode;
var
  ControlWord: Word;
begin
  ControlWord := GetControlWord;
  System.Set8087CW( (ControlWord AND $F3FF) OR (ORD(RoundMode) SHL 10) );
  Result := TRoundMode((ControlWord SHR 10) AND 3);
end;


procedure TFormRound.ButtonClick(Sender: TObject);
  CONST
    RoundMode:  ARRAY[0..3] OF STRING
             = ('Nearest', 'Down', 'Up', 'Truncate');
  VAR
    i:  INTEGER;
begin
  CASE (Sender AS TButton).Tag OF
    0:  SetRoundMode(rmNearest);
    1:  SetRoundMode(rmDown);
    2:  SetRoundMode(rmUp);
    3:  SetRoundMode(rmTruncate);
  END;

  Memo.Lines.Clear;
  Memo.Lines.Add('Round Mode = ' + RoundMode[(Sender AS TButton).Tag]);

  FOR i := 0 TO 9 DO
  BEGIN
    Memo.Lines.Add( 'Round(' + IntToStr(i) + '/2) = ' +
                    IntToStr( Round(i/2) ));
  END

end;

end.