Jump to content

Decimal Feet to Feet & Ins


Julian Carr

Recommended Posts

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);
	

 

Link to comment

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);
	

 

Link to comment

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.

Link to comment

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);

 

 

  • Like 1
Link to comment

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.  

  • Like 1
Link to comment

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...