paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-23 20:40:01 +02:00
Code Issues Packages Projects Releases Wiki Activity

* compilation with 1.0.10 fixed

Browse Source
This commit is contained in:
florian 2004-04-27 17:29:04 +00:00
parent c63660d3b9
commit 8222e0deb6
1 changed files with 97 additions and 86 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

183
rtl/objpas/convutils.pp
View File

@ -10,7 +10,7 @@
Based on a guessed interface derived from some programs on the web. (Like Based on a guessed interface derived from some programs on the web. (Like
Marco Cantu's EuroConv example), so things can be a bit Delphi Marco Cantu's EuroConv example), so things can be a bit Delphi
incompatible. Also part on Delphibasics.co.uk. incompatible. Also part on Delphibasics.co.uk.
Quantities are mostly taken from my HP48g/gx or the unix units program Quantities are mostly taken from my HP48g/gx or the unix units program
This program is distributed in the hope that it will be useful, This program is distributed in the hope that it will be useful,
@ -22,18 +22,21 @@
unit convutils; unit convutils;
interface interface
{$mode objfpc}{$H+}
{$ifndef VER1_0}
{$mode objfpc}
{$H+}
Type TConvType = type Integer; Type TConvType = type Integer;
TConvFamily = type Integer; TConvFamily = type Integer;
var var
{cbArea family} {cbArea family}
auSquareMillimeters, auSquareMillimeters,
auSquareCentimeters, auSquareCentimeters,
auSquareDecimeters, auSquareDecimeters,
auSquareMeters, auSquareMeters,
auSquareDecameters, auSquareDecameters,
auSquareHectometers, auSquareHectometers,
@ -48,7 +51,7 @@ var
auHectares , auHectares ,
auSquareRods , auSquareRods ,
{cbDistance family} {cbDistance family}
duMicromicrons, duMicromicrons,
duAngstroms , duAngstroms ,
@ -82,8 +85,8 @@ var
duPicas, duPicas,
duPoints, duPoints,
{cbMass family} {cbMass family}
muNanograms, muNanograms,
muMicrograms, muMicrograms,
muMilligrams, muMilligrams,
@ -95,7 +98,7 @@ var
muKilograms, muKilograms,
muMetricTons, muMetricTons,
muDrams, muDrams,
muGrains, muGrains,
muLongTons, muLongTons,
muTons, muTons,
muOunces, muOunces,
@ -103,7 +106,7 @@ var
muStones, muStones,
{cbTemperature family} {cbTemperature family}
tuCelsius, tuCelsius,
tuKelvin, tuKelvin,
tuFahrenheit, tuFahrenheit,
@ -111,13 +114,13 @@ var
tuReamur, tuReamur,
{ {
cbTime family cbTime family
} }
tuMilliSeconds, tuMilliSeconds,
tuSeconds, tuSeconds,
tuMinutes, tuMinutes,
tuHours, tuHours,
tuDays, tuDays,
tuWeeks, tuWeeks,
tuFortnights, tuFortnights,
@ -129,11 +132,11 @@ cbTime family
tuDateTime, tuDateTime,
tuJulianDate, tuJulianDate,
tuModifiedJulianDate, tuModifiedJulianDate,
{ {
cbVolume family cbVolume family
} }
vuCubicMillimeters, vuCubicMillimeters,
vuCubicCentimeters, vuCubicCentimeters,
vuCubicDecimeters, vuCubicDecimeters,
@ -144,22 +147,22 @@ cbVolume family
vuCubicInches, vuCubicInches,
vuCubicFeet, vuCubicFeet,
vuCubicYards, vuCubicYards,
vuCubicMiles, vuCubicMiles,
vuMilliLiters, vuMilliLiters,
vuCentiLiters, vuCentiLiters,
vuDeciLiters, vuDeciLiters,
vuLiters, vuLiters,
vuDecaLiters, vuDecaLiters,
vuHectoLiters, vuHectoLiters,
vuKiloLiters, vuKiloLiters,
vuAcreFeet, vuAcreFeet,
vuAcreInches, vuAcreInches,
vuCords, vuCords,
vuCordFeet, vuCordFeet,
vuDecisteres, vuDecisteres,
vuSteres, vuSteres,
vuDecasteres, vuDecasteres,
vuFluidGallons, vuFluidGallons,
vuFluidQuarts, vuFluidQuarts,
vuFluidPints, vuFluidPints,
vuFluidCups, vuFluidCups,
@ -175,19 +178,19 @@ cbVolume family
vuDryBushels, vuDryBushels,
vuUKGallons, vuUKGallons,
vuUKPottles, vuUKPottles,
vuUKQuarts, vuUKQuarts,
vuUKPints, vuUKPints,
vuUKGills, vuUKGills,
vuUKOunces, vuUKOunces,
vuUKPecks, vuUKPecks,
vuUKBuckets, vuUKBuckets,
vuUKBushels : TConvType; vuUKBushels : TConvType;
var var
cbArea : TConvFamily; cbArea : TConvFamily;
cbDistance : TConvFamily; cbDistance : TConvFamily;
cbMass : TConvFamily; cbMass : TConvFamily;
cbTemperature : TConvFamily; cbTemperature : TConvFamily;
cbTime : TConvFamily; cbTime : TConvFamily;
cbVolume : TConvFamily; cbVolume : TConvFamily;
@ -199,8 +202,12 @@ Function RegisterConversionType(Fam:TConvFamily;Const S:String;Value:TConvUtilFl
function Convert ( const Measurement : Double; const FromType, ToType : TConvType ) :TConvUtilFloat; function Convert ( const Measurement : Double; const FromType, ToType : TConvType ) :TConvUtilFloat;
function Convert ( const Measurement : Double; const FromType1, FromType2, ToType1, ToType2 : TConvType ) :TConvUtilFloat; function Convert ( const Measurement : Double; const FromType1, FromType2, ToType1, ToType2 : TConvType ) :TConvUtilFloat;
{$endif VER1_0}
Implementation Implementation
{$ifndef VER1_0}
ResourceString // Note, designations for FFU's are guesses. ResourceString // Note, designations for FFU's are guesses.
txtauSquareMillimeters = 'Square millimeters (mm^2)'; txtauSquareMillimeters = 'Square millimeters (mm^2)';
@ -315,7 +322,7 @@ ResourceString // Note, designations for FFU's are guesses.
txtvuDecasteres = 'decasteres (??)'; txtvuDecasteres = 'decasteres (??)';
txtvuFluidGallons = 'US fluid gallons (fl gal)'; txtvuFluidGallons = 'US fluid gallons (fl gal)';
txtvuFluidQuarts = 'US fluid Quarts (fl Quart)'; txtvuFluidQuarts = 'US fluid Quarts (fl Quart)';
txtvuFluidPints = 'US fluid Pints (fl pints)'; txtvuFluidPints = 'US fluid Pints (fl pints)';
txtvuFluidCups = 'US fluid Cups (fl Cups)'; txtvuFluidCups = 'US fluid Cups (fl Cups)';
txtvuFluidGills = 'US fluid Gills (fl Quart)'; txtvuFluidGills = 'US fluid Gills (fl Quart)';
txtvuFluidOunces = 'US fluid Ounces (fl Ounces)'; txtvuFluidOunces = 'US fluid Ounces (fl Ounces)';
@ -336,21 +343,21 @@ ResourceString // Note, designations for FFU's are guesses.
txtvuUKPecks = 'UK pecks (dr pecks)'; txtvuUKPecks = 'UK pecks (dr pecks)';
txtvuUKBuckets = 'UK buckets (dr buckets)'; txtvuUKBuckets = 'UK buckets (dr buckets)';
txtvuUKBushels = 'UK bushels (dr bushels)'; txtvuUKBushels = 'UK bushels (dr bushels)';
Type ResourceData = record Type ResourceData = record
Description : String; Description : String;
Value : TConvUtilFloat; Value : TConvUtilFloat;
Fam : TConvFamily; Fam : TConvFamily;
end; end;
var TheUnits : array of ResourceData =nil; var TheUnits : array of ResourceData =nil;
TheFamilies : array of string =nil; TheFamilies : array of string =nil;
Function RegisterConversionFamily(Const S:String):TConvFamily; Function RegisterConversionFamily(Const S:String):TConvFamily;
var i,l : Longint; var i,l : Longint;
begin begin
l:=Length(TheFamilies); l:=Length(TheFamilies);
If l=0 Then If l=0 Then
@ -361,7 +368,7 @@ begin
end end
else else
begin begin
i:=0; i:=0;
while (i<l) and (s<>TheFamilies[i]) do inc(i); while (i<l) and (s<>TheFamilies[i]) do inc(i);
if i=l Then if i=l Then
begin begin
@ -369,7 +376,7 @@ begin
TheFamilies[l]:=s; TheFamilies[l]:=s;
end; end;
Result:=i; Result:=i;
end; end;
end; end;
Function CheckFamily(i:TConvFamily):Boolean; Function CheckFamily(i:TConvFamily):Boolean;
@ -410,7 +417,7 @@ end;
function Convert ( const Measurement : Double; const FromType, ToType : TConvType ) :TConvUtilFloat; function Convert ( const Measurement : Double; const FromType, ToType : TConvType ) :TConvUtilFloat;
var var
fromrec,torec : resourcedata; fromrec,torec : resourcedata;
begin begin
@ -420,11 +427,11 @@ begin
exit(-1.0); // raise except? exit(-1.0); // raise except?
if fromrec.fam<>torec.fam then if fromrec.fam<>torec.fam then
exit(-1.0); exit(-1.0);
result:=Measurement*fromrec.value/torec.value; result:=Measurement*fromrec.value/torec.value;
end; end;
function Convert ( const Measurement : Double; const FromType1, FromType2, ToType1, ToType2 : TConvType ) :TConvUtilFloat; function Convert ( const Measurement : Double; const FromType1, FromType2, ToType1, ToType2 : TConvType ) :TConvUtilFloat;
var var
fromrec1,fromrec2,torec1 , fromrec1,fromrec2,torec1 ,
torec2 : resourcedata; torec2 : resourcedata;
@ -465,7 +472,7 @@ begin
auCentares := RegisterConversionType(cbArea,txtauCentares,-1); auCentares := RegisterConversionType(cbArea,txtauCentares,-1);
auAres := RegisterConversionType(cbArea,txtauAres,100); auAres := RegisterConversionType(cbArea,txtauAres,100);
auHectares := RegisterConversionType(cbArea,txtauHectares,10000); auHectares := RegisterConversionType(cbArea,txtauHectares,10000);
auSquareRods := RegisterConversionType(cbArea,txtauSquareRods,25.2929538117); auSquareRods := RegisterConversionType(cbArea,txtauSquareRods,25.2929538117);
end; end;
procedure RegisterLengths; procedure RegisterLengths;
@ -502,7 +509,7 @@ begin
duLinks := RegisterConversionType(cbDistance,txtduLinks,0.201168); duLinks := RegisterConversionType(cbDistance,txtduLinks,0.201168);
duPicas := RegisterConversionType(cbDistance,txtduPicas,0.0042333333); duPicas := RegisterConversionType(cbDistance,txtduPicas,0.0042333333);
duPoints := RegisterConversionType(cbDistance,txtduPoints,0.00035277778); duPoints := RegisterConversionType(cbDistance,txtduPoints,0.00035277778);
end; end;
procedure Registermass; // weight? :) procedure Registermass; // weight? :)
@ -524,14 +531,14 @@ begin
muOunces := RegisterConversionType(cbMass,txtmuOunces,0.028349523); muOunces := RegisterConversionType(cbMass,txtmuOunces,0.028349523);
muPounds := RegisterConversionType(cbMass,txtmuPounds,0.45359237); muPounds := RegisterConversionType(cbMass,txtmuPounds,0.45359237);
muStones := RegisterConversionType(cbMass,txtmuStones,6.3502932); muStones := RegisterConversionType(cbMass,txtmuStones,6.3502932);
end; end;
procedure RegisterTemperature; procedure RegisterTemperature;
begin begin
tuCelsius := RegisterConversionType(cbTemperature,txttuCelsius,1); tuCelsius := RegisterConversionType(cbTemperature,txttuCelsius,1);
tuKelvin := RegisterConversionType(cbTemperature,txttuKelvin,1); tuKelvin := RegisterConversionType(cbTemperature,txttuKelvin,1);
tuFahrenheit := RegisterConversionType(cbTemperature,txttuFahrenheit,5/9); tuFahrenheit := RegisterConversionType(cbTemperature,txttuFahrenheit,5/9);
tuRankine := RegisterConversionType(cbTemperature,txttuRankine,0.5555556); tuRankine := RegisterConversionType(cbTemperature,txttuRankine,0.5555556);
tuReamur := RegisterConversionType(cbTemperature,txttuReamur,10/8); // Reaumur? tuReamur := RegisterConversionType(cbTemperature,txttuReamur,10/8); // Reaumur?
end; end;
@ -541,19 +548,19 @@ procedure RegisterTimes;
begin begin
tuMilliSeconds := RegisterConversionType(cbTime,txttuMilliSeconds,1E-3); tuMilliSeconds := RegisterConversionType(cbTime,txttuMilliSeconds,1E-3);
tuSeconds := RegisterConversionType(cbTime,txttuSeconds,1); tuSeconds := RegisterConversionType(cbTime,txttuSeconds,1);
tuMinutes := RegisterConversionType(cbTime,txttuMinutes,60.0); tuMinutes := RegisterConversionType(cbTime,txttuMinutes,60.0);
tuHours := RegisterConversionType(cbTime,txttuHours,3600.0); tuHours := RegisterConversionType(cbTime,txttuHours,3600.0);
tuDays := RegisterConversionType(cbTime,txttuDays,24*3600.0); tuDays := RegisterConversionType(cbTime,txttuDays,24*3600.0);
tuWeeks := RegisterConversionType(cbTime,txttuWeeks,7*24*3600.0); tuWeeks := RegisterConversionType(cbTime,txttuWeeks,7*24*3600.0);
tuFortnights := RegisterConversionType(cbTime,txttuFortnights,14*24*3600.0); tuFortnights := RegisterConversionType(cbTime,txttuFortnights,14*24*3600.0);
tuMonths := RegisterConversionType(cbTime,txttuMonths,1/12*YearSec); tuMonths := RegisterConversionType(cbTime,txttuMonths,1/12*YearSec);
tuYears := RegisterConversionType(cbTime,txttuYears,YearSec); tuYears := RegisterConversionType(cbTime,txttuYears,YearSec);
tuDecades := RegisterConversionType(cbTime,txttuDecades,10*YearSec); tuDecades := RegisterConversionType(cbTime,txttuDecades,10*YearSec);
tuCenturies := RegisterConversionType(cbTime,txttuCenturies,100*yearsec); tuCenturies := RegisterConversionType(cbTime,txttuCenturies,100*yearsec);
tuMillennia := RegisterConversionType(cbTime,txttuMillennia,1000*yearsec); tuMillennia := RegisterConversionType(cbTime,txttuMillennia,1000*yearsec);
tuDateTime := RegisterConversionType(cbTime,txttuDateTime,-1); tuDateTime := RegisterConversionType(cbTime,txttuDateTime,-1);
tuJulianDate := RegisterConversionType(cbTime,txttuJulianDate,-1); tuJulianDate := RegisterConversionType(cbTime,txttuJulianDate,-1);
tuModifiedJulianDate := RegisterConversionType(cbTime,txttuModifiedJulianDate,-1); tuModifiedJulianDate := RegisterConversionType(cbTime,txttuModifiedJulianDate,-1);
end; end;
@ -582,7 +589,7 @@ begin
vuKiloLiters := RegisterConversionType(cbVolume,txtvuKiloLiters,1); vuKiloLiters := RegisterConversionType(cbVolume,txtvuKiloLiters,1);
vuAcreFeet := RegisterConversionType(cbVolume,txtvuAcreFeet, -1); vuAcreFeet := RegisterConversionType(cbVolume,txtvuAcreFeet, -1);
vuAcreInches := RegisterConversionType(cbVolume,txtvuAcreInches, -1); vuAcreInches := RegisterConversionType(cbVolume,txtvuAcreInches, -1);
vuCords := RegisterConversionType(cbVolume,txtvuCords,128*0.028316847); vuCords := RegisterConversionType(cbVolume,txtvuCords,128*0.028316847);
vuCordFeet := RegisterConversionType(cbVolume,txtvuCordFeet,128*0.028316847); vuCordFeet := RegisterConversionType(cbVolume,txtvuCordFeet,128*0.028316847);
vuDecisteres := RegisterConversionType(cbVolume,txtvuDecisteres,0.1); vuDecisteres := RegisterConversionType(cbVolume,txtvuDecisteres,0.1);
vuSteres := RegisterConversionType(cbVolume,txtvuSteres,1); vuSteres := RegisterConversionType(cbVolume,txtvuSteres,1);
@ -610,17 +617,17 @@ begin
vuUKPecks := RegisterConversionType(cbVolume,txtvuUKPecks,0.0090921986); vuUKPecks := RegisterConversionType(cbVolume,txtvuUKPecks,0.0090921986);
vuUKBuckets := RegisterConversionType(cbVolume,txtvuUKBuckets,-1); vuUKBuckets := RegisterConversionType(cbVolume,txtvuUKBuckets,-1);
vuUKBushels := RegisterConversionType(cbVolume,txtvuUKBushels,0.036368794); vuUKBushels := RegisterConversionType(cbVolume,txtvuUKBushels,0.036368794);
end; end;
Procedure RegisterFamilies; Procedure RegisterFamilies;
Begin Begin
cbArea := RegisterConversionFamily('Area'); cbArea := RegisterConversionFamily('Area');
cbDistance := RegisterConversionFamily('Distance'); cbDistance := RegisterConversionFamily('Distance');
cbMass := RegisterConversionFamily('Mass'); cbMass := RegisterConversionFamily('Mass');
cbTemperature := RegisterConversionFamily('Temperature'); cbTemperature := RegisterConversionFamily('Temperature');
cbTime := RegisterConversionFamily('Time'); cbTime := RegisterConversionFamily('Time');
cbVolume := RegisterConversionFamily('Volume'); cbVolume := RegisterConversionFamily('Volume');
End; End;
Procedure RegisterAll; Procedure RegisterAll;
@ -640,11 +647,15 @@ initialization
finalization finalization
setlength(theunits,0); setlength(theunits,0);
setlength(thefamilies,0); setlength(thefamilies,0);
{$endif VER1_0}
end. end.
{ {
$Log$ $Log$
Revision 1.1 2004-03-20 23:41:34 marco Revision 1.2 2004-04-27 17:29:04 florian
* compilation with 1.0.10 fixed
Revision 1.1 2004/03/20 23:41:34 marco
* Initial version * Initial version
} }