Decimal Feet to Feet & Ins

[Julian Carr]

Anyone have a routine for converting decimal inches into fractions, irrespective of the document unit settings? For example:

 

1.375 -> 1 3/8"

1.188 -> 1 3/16"

1.75 -> 1 3/4"

1.5 -> 1 1/2"

4.25 -> 4 1/4"

 

Thanks!

[Pat Stanford]

Here is the basic algorithm. It needs some work to simplify the fractional part (0.5 shows as 4/8 instead of 1/2), and to round up to the next whole number if the fraction is equal to 1.

 

Procedure Test;

Const
	Base=8;

Var
	Original, DecPart:	Real;
	IntPart, FracPart:	LONGINT;
	RetValue: String;
	
Begin
	Original:=RealDialog('Enter Decimal Number', '0.0');
	IntPart:=TRUNC(Original);
	DecPart:=Original-IntPart;
	FracPart:= Round(DecPart * Base);
	RetValue:=Concat(IntPart, ' ',FracPart, '/',Base,'"');
	Message(Date(2,2),' ', RetValue);
End;

Run(Test);
	

 

[michaelk]

Could you solve 4/8 problem by using a case?  Assuming that */16 was as accurate as anyone needs to be (as far as I know, only @Bruce Kieffer uses the really little lines on the tape measure).

 

Procedure Test;

Const
	Base=16;

Var
	Original, DecPart:	Real;
	IntPart, FracPart:	LONGINT;
	RetValue: String;
	RetFract: String;
	
Begin
	Original:=RealDialog('Enter Decimal Number', '0.0');
	IntPart:=TRUNC(Original);
	DecPart:=Original-IntPart;
	FracPart:= Round(DecPart * Base);
	
	Case FracPart OF
		0: RetFract := '';
		1: RetFract := '1/16';
		2: RetFract := '1/8';
		3: RetFract := '3/16';
		4: RetFract := '1/4';
		5: RetFract := '5/16';
		6: RetFract := '3/8';
		7: RetFract := '7/16';
		8: RetFract := '1/2';
		9: RetFract := '9/16';
		10: RetFract := '5/8';
		11: RetFract := '11/16';
		12: RetFract := '3/4';
		13: RetFract := '13/16';
		14: RetFract := '7/8';
		15: RetFract := '15/16';
		16: Begin
				IntPart := IntPart + 1;
				RetFract := '';
			End;
	End;
	
	RetValue:=Concat(IntPart, ' ',RetFract);
	
	Message(Date(2,2),' ', RetValue);
End;

Run(Test);
	

 

[michaelk]

Or you can use fewer lines if you do the math for */2, */4, and */8.  But I think you still need special cases if the FracPart rounds to 0 or 16.

 

Procedure Test;

Const
	Base=16;
	Slash='/';
Var
	Original, DecPart:	Real;
	IntPart, FracPart:	LONGINT;
	RetValue: String;
	RetFract: String;
	
Begin
	Original:=RealDialog('Enter Decimal Number', '0.0');
	IntPart:=TRUNC(Original);
	DecPart:=Original-IntPart;
	FracPart:= Round(DecPart * Base);
	
	
	IF FracPart MOD 2 = 0 then RetFract := Concat(Num2Str(0,FracPart/2),Slash,Num2Str(0,Base/2));
	
	IF FracPart MOD 4 = 0 then RetFract := Concat(Num2Str(0,FracPart/4),Slash,Num2Str(0,Base/4));
	
	If FracPart MOD 8 = 0 then RetFract := Concat(Num2Str(0,FracPart/8),Slash,Num2Str(0,Base/8));
	
	If  (FracPart MOD 2 <> 0) AND (FracPart MOD 4 <> 0) AND (FracPart MOD 8 <> 0) then RetFract := Concat(Num2Str(0,FracPart),Slash,Num2Str(0,Base));
	
	
	Case FracPart OF
		0: RetFract := '';
		16: Begin
				IntPart := IntPart + 1;
				RetFract := '';
			End;
	End;
	
	RetValue:=Concat(IntPart, ' ',RetFract);
	
	Message(Date(2,2),' ', RetValue);
End;

Run(Test);
	

Actually, on the 4th IF you probably don't need to check anything but MOD 2 <> 0.  If FracPart is odd then the result is FracPart/Base.

[Julian Carr]

Thanks to everyone for your help with this. It was actually for a worksheet script to enable door thicknesses to be listed at smaller increments than the document units settings allowed. Below is the final code. I saved the script with the name 'WSFixDoorThickness' so the cell formula to use it would be:

 

=RUNSCRIPT('WSFixDoorThickness')

 

This replaced the standard:

 

=(Door.DoorThickness)

 

In Vw 2021, it would be possible to use RUNEDITSCRIPT() instead and so allow the door thickness to be modified from the worksheet too. It was beyond the remit of this little project however so currently it only reports door the thickness.

 

{ FDT (Fix Door Thickness) - v1.0 - 27/10/2020 }
Procedure FDT;
VAR
    gr1 : REAL;
    gh1 : HANDLE;
    gs1 : STRING;
    Function Num2FandI(r1 : REAL) : STRING;
    Const
        kBase = 16;
    VAR
        DecPart:    REAL;
        IntPart, FracPart:    LONGINT;
        RetFract : STRING;
    BEGIN
        IntPart := TRUNC(r1);
        DecPart := r1 - IntPart;
        FracPart := Round(DecPart * kBase);
        Num2FandI := Concat(IntPart, ' ',FracPart, '/', kBase, '"');
        CASE FracPart OF
            0: RetFract := '';
            1: RetFract := '1/16';
            2: RetFract := '1/8';
            3: RetFract := '3/16';
            4: RetFract := '1/4';
            5: RetFract := '5/16';
            6: RetFract := '3/8';
            7: RetFract := '7/16';
            8: RetFract := '1/2';
            9: RetFract := '9/16';
            10: RetFract := '5/8';
            11: RetFract := '11/16';
            12: RetFract := '3/4';
            13: RetFract := '13/16';
            14: RetFract := '7/8';
            15: RetFract := '15/16';
            16: BEGIN
                IntPart := IntPart + 1;
                RetFract := '';
            END;
        END;
        Num2FandI:=Concat(IntPart, ' ',RetFract, '"');
    END; { Num2FandI }
BEGIN
    gh1 := WSScript_GetObject;
    gs1 := GetRField(gh1, 'Door', 'DoorThickness');
    IF ValidNumStr(gs1, gr1) THEN WSScript_SetResStr(Num2FandI(gr1));
END;
Run(FDT);

 

 

[michaelk]

Hi Julian

 

I know it's too late, but when I woke up this was floating in my head:

 

Procedure Test;

Const
	Base=16;
	Slash='/';
Var
	Original, DecPart:	Real;
	IntPart, FracPart:	LONGINT;
	RetValue: String;
	RetFract: String;
	i: Integer;
	
Begin
	Original:=RealDialog('Enter Decimal Number', '0.0');
	IntPart:=TRUNC(Original);
	DecPart:=Original-IntPart;
	FracPart:= Round(DecPart * Base);
	
	i :=2;
	While i < Base do
		begin
			if FracPart MOD i = 0 then RetFract := Concat(Num2Str(0,FracPart/i),Slash,Num2Str(0,Base/i));
			i := i * 2;		
		end;
	
	If  (FracPart MOD 2 <> 0) then RetFract := Concat(Num2Str(0,FracPart),Slash,Num2Str(0,Base));
	
	
	Case FracPart OF
		0: RetFract := '';
		Base: Begin
				IntPart := IntPart + 1;
				RetFract := '';
			End;
	End;
	
	RetValue:=Concat(IntPart, ' ',RetFract);
	
	Message(Date(2,2),' ', RetValue);
End;

Run(Test);
	

I *think* this will work for any power of 2 base.