convutil.inc 25 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646
  1. {
  2. This file is part of the Free Pascal run time library.
  3. Copyright (c) 2004 by Marco van de Voort
  4. member of the Free Pascal development team.
  5. An implementation for unit convutils, which converts between
  6. units and simple combinations of them.
  7. Based on a guessed interface derived from some programs on the web. (Like
  8. Marco Cantu's EuroConv example), so things can be a bit Delphi
  9. incompatible. Also part on Delphibasics.co.uk.
  10. Quantities are mostly taken from my HP48g/gx or the unix units program
  11. This program is distributed in the hope that it will be useful,
  12. but WITHOUT ANY WARRANTY;without even the implied warranty of
  13. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  14. **********************************************************************}
  15. unit convutils;
  16. interface
  17. {$mode objfpc}
  18. {$H+}
  19. Type TConvType = type Integer;
  20. TConvFamily = type Integer;
  21. var
  22. {cbArea family}
  23. auSquareMillimeters,
  24. auSquareCentimeters,
  25. auSquareDecimeters,
  26. auSquareMeters,
  27. auSquareDecameters,
  28. auSquareHectometers,
  29. auSquareKilometers,
  30. auSquareInches,
  31. auSquareFeet ,
  32. auSquareYards ,
  33. auSquareMiles,
  34. auAcres ,
  35. auCentares ,
  36. auAres ,
  37. auHectares ,
  38. auSquareRods ,
  39. {cbDistance family}
  40. duMicromicrons,
  41. duAngstroms ,
  42. duMillimicrons,
  43. duMicrons,
  44. duMillimeters,
  45. duCentimeters,
  46. duDecimeters,
  47. duMeters,
  48. duDecameters,
  49. duHectometers,
  50. duKilometers,
  51. duMegameters,
  52. duGigameters,
  53. duInches,
  54. duFeet,
  55. duYards,
  56. duMiles ,
  57. duNauticalMiles,
  58. duAstronomicalUnits,
  59. duLightYears,
  60. duParsecs,
  61. duCubits,
  62. duFathoms,
  63. duFurlongs,
  64. duHands,
  65. duPaces,
  66. duRods,
  67. duChains,
  68. duLinks,
  69. duPicas,
  70. duPoints,
  71. {cbMass family}
  72. muNanograms,
  73. muMicrograms,
  74. muMilligrams,
  75. muCentigrams,
  76. muDecigrams,
  77. muGrams,
  78. muDecagrams,
  79. muHectograms,
  80. muKilograms,
  81. muMetricTons,
  82. muDrams,
  83. muGrains,
  84. muLongTons,
  85. muTons,
  86. muOunces,
  87. muPounds,
  88. muStones,
  89. {cbTemperature family}
  90. tuCelsius,
  91. tuKelvin,
  92. tuFahrenheit,
  93. tuRankine,
  94. tuReamur,
  95. {
  96. cbTime family
  97. }
  98. tuMilliSeconds,
  99. tuSeconds,
  100. tuMinutes,
  101. tuHours,
  102. tuDays,
  103. tuWeeks,
  104. tuFortnights,
  105. tuMonths,
  106. tuYears,
  107. tuDecades,
  108. tuCenturies,
  109. tuMillennia,
  110. tuDateTime,
  111. tuJulianDate,
  112. tuModifiedJulianDate,
  113. {
  114. cbVolume family
  115. }
  116. vuCubicMillimeters,
  117. vuCubicCentimeters,
  118. vuCubicDecimeters,
  119. vuCubicMeters,
  120. vuCubicDecameters,
  121. vuCubicHectometers,
  122. vuCubicKilometers,
  123. vuCubicInches,
  124. vuCubicFeet,
  125. vuCubicYards,
  126. vuCubicMiles,
  127. vuMilliLiters,
  128. vuCentiLiters,
  129. vuDeciLiters,
  130. vuLiters,
  131. vuDecaLiters,
  132. vuHectoLiters,
  133. vuKiloLiters,
  134. vuAcreFeet,
  135. vuAcreInches,
  136. vuCords,
  137. vuCordFeet,
  138. vuDecisteres,
  139. vuSteres,
  140. vuDecasteres,
  141. vuFluidGallons,
  142. vuFluidQuarts,
  143. vuFluidPints,
  144. vuFluidCups,
  145. vuFluidGills,
  146. vuFluidOunces,
  147. vuFluidTablespoons,
  148. vuFluidTeaspoons,
  149. vuDryGallons,
  150. vuDryQuarts,
  151. vuDryPints,
  152. vuDryPecks,
  153. vuDryBuckets,
  154. vuDryBushels,
  155. vuUKGallons,
  156. vuUKPottles,
  157. vuUKQuarts,
  158. vuUKPints,
  159. vuUKGills,
  160. vuUKOunces,
  161. vuUKPecks,
  162. vuUKBuckets,
  163. vuUKBushels : TConvType;
  164. var
  165. cbArea : TConvFamily;
  166. cbDistance : TConvFamily;
  167. cbMass : TConvFamily;
  168. cbTemperature : TConvFamily;
  169. cbTime : TConvFamily;
  170. cbVolume : TConvFamily;
  171. Type TConvUtilFloat = double;
  172. Function RegisterConversionFamily(Const S : String):TConvFamily;
  173. Function RegisterConversionType(Fam:TConvFamily;Const S:String;Value:TConvUtilFloat):TConvType;
  174. function Convert ( const Measurement : Double; const FromType, ToType : TConvType ) :TConvUtilFloat;
  175. function Convert ( const Measurement : Double; const FromType1, FromType2, ToType1, ToType2 : TConvType ) :TConvUtilFloat;
  176. Implementation
  177. ResourceString // Note, designations for FFU's are guesses.
  178. txtauSquareMillimeters = 'Square millimeters (mm^2)';
  179. txtauSquareCentimeters = 'Square centimeters (cm^2)';
  180. txtauSquareDecimeters = 'Square decimeters (dm^2)';
  181. txtauSquareMeters = 'Square meters (m^2)';
  182. txtauSquareDecameters = 'Square decameters (dam^2)';
  183. txtauSquareHectometers = 'Square hectometers (hm^2)';
  184. txtauSquareKilometers = 'Square kilometers (km^2)';
  185. txtauSquareInches = 'Square inch (in^2)';
  186. txtauSquareFeet = 'Square feet (ft^2)';
  187. txtauSquareYards = 'Square yards (yd^2)';
  188. txtauSquareMiles = 'Square miles (mi^2)';
  189. txtauAcres = 'Square acres (acre^2)';
  190. txtauCentares = 'Centares (care^2)';
  191. txtauAres = 'Ares (are=dam^2)';
  192. txtauHectares = 'Hectares (ha=hm^2)';
  193. txtauSquareRods = 'Square Rods (sqr)';
  194. txtduMicromicrons = 'micro microms (mumum)';
  195. txtduAngstroms = 'Aengstroem (ang)';
  196. txtduMillimicrons = 'millimicroms (mmum)';
  197. txtduMicrons = 'microns (um)';
  198. txtduMillimeters = 'millimeters (mm)';
  199. txtduCentimeters = 'centimeters (cm)';
  200. txtduDecimeters = 'decimeters (dm)';
  201. txtduMeters = 'meters (m)';
  202. txtduDecameters = 'decameters (dam)';
  203. txtduHectometers = 'hectometers (hm)';
  204. txtduKilometers = 'kilometers (km)';
  205. txtduMegameters = 'megameters (Mm)';
  206. txtduGigameters = 'gigameters (Gm)';
  207. txtduInches = 'inches (in)';
  208. txtduFeet = 'feet (ft)';
  209. txtduYards = 'yards (yd)';
  210. txtduMiles = 'miles (mi)';
  211. txtduNauticalMiles = 'nautical miles (nmi)';
  212. txtduAstronomicalUnits = 'astronomical units (au)';
  213. txtduLightYears = 'light years (ly)';
  214. txtduParsecs = 'Parsec (Ps)';
  215. txtduCubits = 'Cubits (cb)';
  216. txtduFathoms = 'Fathom (Fth)';
  217. txtduFurlongs = 'Furlongs (furl)';
  218. txtduHands = 'Hands (hnd)';
  219. txtduPaces = 'Paces (pc)';
  220. txtduRods = 'Rods (rd)';
  221. txtduChains = 'Chains (ch)';
  222. txtduLinks = 'Links (lnk)';
  223. txtduPicas = 'Pica''s (pc)';
  224. txtduPoints = 'Points (pnts)'; // carat/Karaat 2E-6 gram ?
  225. txtmuNanograms = 'nanograms (ng)';
  226. txtmuMicrograms = 'micrograms (um)';
  227. txtmuMilligrams = 'milligrams (mg)';
  228. txtmuCentigrams = 'centigrams (cg)';
  229. txtmuDecigrams = 'decigrams (dg)';
  230. txtmuGrams = 'grams (g)';
  231. txtmuDecagrams = 'decagrams (dag)';
  232. txtmuHectograms = 'hectograms (hg)';
  233. txtmuKilograms = 'kilograms (kg)';
  234. txtmuMetricTons = 'metric ton (t)';
  235. txtmuDrams = 'dramgs (??)';
  236. txtmuGrains = 'grains (??)';
  237. txtmuLongTons = 'longton (??)';
  238. txtmuTons = 'imperial ton (??)'; // calling metric ton "ton" is normal in metric countries
  239. txtmuOunces = 'ounce (??)';
  240. txtmuPounds = 'pounds (??)'; // what kind? Metric pound =0.5
  241. txtmuStones = 'stones (??)';
  242. txttuCelsius = 'degrees Celsius (degC)';
  243. txttuKelvin = 'degrees Kelvin (K)';
  244. txttuFahrenheit = 'degrees Fahrenheit (degF)';
  245. txttuRankine = 'degrees Rankine (degR)';
  246. txttuReamur = 'degrees Reamur (degReam)';
  247. txttuMilliSeconds = 'milli seconds (ms)';
  248. txttuSeconds = 'seconds (s)';
  249. txttuMinutes = 'minutes (min)';
  250. txttuHours = 'hours (hr)';
  251. txttuDays = 'days (days)';
  252. txttuWeeks = 'weeks (weeks)';
  253. txttuFortnights = 'Fortnights (??)';
  254. txttuMonths = 'Months (months)';
  255. txttuYears = 'Years (years)';
  256. txttuDecades = 'Decades (decades)';
  257. txttuCenturies = 'Centuries (centuries)';
  258. txttuMillennia = 'Millennia (millenia)';
  259. txttuDateTime = 'DateTime (??)';
  260. txttuJulianDate = 'JulianDate (??)';
  261. txttuModifiedJulianDate = 'Modified JulianData (??)';
  262. txtvuCubicMillimeters = 'cubic millimeters (mm^3)';
  263. txtvuCubicCentimeters = 'cubic centimeters (cm^3)';
  264. txtvuCubicDecimeters = 'cubic decimeters (dm^3)';
  265. txtvuCubicMeters = 'cubic meters (m^3)';
  266. txtvuCubicDecameters = 'cubic decameters (dam^3)';
  267. txtvuCubicHectometers = 'cubic hectometers (hm^3)';
  268. txtvuCubicKilometers = 'cubic kilometers (km^3)';
  269. txtvuCubicInches = 'cubic inches (in^3)';
  270. txtvuCubicFeet = 'cubic feet (ft^3)';
  271. txtvuCubicYards = 'cubic yards (yd^3)';
  272. txtvuCubicMiles = 'cubic miles (mi^3)';
  273. txtvuMilliLiters = 'milliliters (ml)';
  274. txtvuCentiLiters = 'centiliters (cl)';
  275. txtvuDeciLiters = 'deciliters (dl)';
  276. txtvuLiters = 'liters (l)';
  277. txtvuDecaLiters = 'decaliters (dal)';
  278. txtvuHectoLiters = 'hectoliters (hl)';
  279. txtvuKiloLiters = 'kiloliters (kl)';
  280. txtvuAcreFeet = 'acrefeet (acre ft)';
  281. txtvuAcreInches = 'acreinches (acre in)';
  282. txtvuCords = 'cords (??)';
  283. txtvuCordFeet = 'cordfeet (??)';
  284. txtvuDecisteres = 'decisteres (??)';
  285. txtvuSteres = 'steres (??)';
  286. txtvuDecasteres = 'decasteres (??)';
  287. txtvuFluidGallons = 'US fluid gallons (fl gal)';
  288. txtvuFluidQuarts = 'US fluid Quarts (fl Quart)';
  289. txtvuFluidPints = 'US fluid Pints (fl pints)';
  290. txtvuFluidCups = 'US fluid Cups (fl Cups)';
  291. txtvuFluidGills = 'US fluid Gills (fl Quart)';
  292. txtvuFluidOunces = 'US fluid Ounces (fl Ounces)';
  293. txtvuFluidTablespoons = 'US fluid Tablespoons (fl Tablespoons)';
  294. txtvuFluidTeaspoons = 'US fluid teaspoons (fl teaspoon)';
  295. txtvuDryGallons = 'US dry gallons (dr gal)';
  296. txtvuDryQuarts = 'US dry Quarts (dr Quart)';
  297. txtvuDryPints = 'US dry Pints (dr pints)';
  298. txtvuDryPecks = 'US dry pecks (dr pecks)';
  299. txtvuDryBuckets = 'US dry buckets (dr buckets)';
  300. txtvuDryBushels = 'US dry bushels (dr bushels)';
  301. txtvuUKGallons = 'UK gallons (fl gal)';
  302. txtvuUKPottles = 'UK Pottles (fl pttle)';
  303. txtvuUKQuarts = 'UK Quarts (fl Quart)';
  304. txtvuUKPints = 'UK Pints (fl pints)';
  305. txtvuUKGills = 'UK Gills (fl Quart)';
  306. txtvuUKOunces = 'UK Ounces (fl Ounces)';
  307. txtvuUKPecks = 'UK pecks (dr pecks)';
  308. txtvuUKBuckets = 'UK buckets (dr buckets)';
  309. txtvuUKBushels = 'UK bushels (dr bushels)';
  310. Type ResourceData = record
  311. Description : String;
  312. Value : TConvUtilFloat;
  313. Fam : TConvFamily;
  314. end;
  315. var TheUnits : array of ResourceData =nil;
  316. TheFamilies : array of string =nil;
  317. Function RegisterConversionFamily(Const S:String):TConvFamily;
  318. var i,l : Longint;
  319. begin
  320. l:=Length(TheFamilies);
  321. If l=0 Then
  322. begin
  323. SetLength(TheFamilies,1);
  324. TheFamilies[0]:=S;
  325. Result:=0;
  326. end
  327. else
  328. begin
  329. i:=0;
  330. while (i<l) and (s<>TheFamilies[i]) do inc(i);
  331. if i=l Then
  332. begin
  333. SetLength(TheFamilies,l+1);
  334. TheFamilies[l]:=s;
  335. end;
  336. Result:=i;
  337. end;
  338. end;
  339. Function CheckFamily(i:TConvFamily):Boolean;
  340. begin
  341. Result:=i<Length(TheFamilies);
  342. end;
  343. const macheps=1E-9;
  344. Function RegisterConversionType(Fam:TConvFamily;Const S:String;Value:TConvUtilFloat):TConvType;
  345. var i,l1 : Longint;
  346. begin
  347. If NOT CheckFamily(Fam) Then exit(-1); // family not registered.
  348. if (value+1.0)<macheps then // not properly defined yet.
  349. exit(-1);
  350. l1:=length(theunits);
  351. Setlength(theunits,l1+1);
  352. theunits[l1].description:=s;
  353. theunits[l1].value:=value;
  354. theunits[l1].fam:=fam;
  355. Result:=l1;
  356. end;
  357. function SearchConvert(TheType:TConvType; var r:ResourceData):Boolean;
  358. var i,j,l1,l2 : longint;
  359. begin
  360. l1:=length(TheUnits);
  361. if thetype>=l1 then
  362. exit(false);
  363. r:=theunits[thetype];
  364. result:=true;
  365. end;
  366. function Convert ( const Measurement : Double; const FromType, ToType : TConvType ) :TConvUtilFloat;
  367. var
  368. fromrec,torec : resourcedata;
  369. begin
  370. if not SearchConvert(fromtype,fromrec) then
  371. exit(-1.0); // raise exception?
  372. if not SearchConvert(totype,torec) then
  373. exit(-1.0); // raise except?
  374. if fromrec.fam<>torec.fam then
  375. exit(-1.0);
  376. result:=Measurement*fromrec.value/torec.value;
  377. end;
  378. function Convert ( const Measurement : Double; const FromType1, FromType2, ToType1, ToType2 : TConvType ) :TConvUtilFloat;
  379. var
  380. fromrec1,fromrec2,torec1 ,
  381. torec2 : resourcedata;
  382. begin
  383. if not SearchConvert(fromtype1,fromrec1) then
  384. exit(-1.0); // raise exception?
  385. if not SearchConvert(totype1,torec1) then
  386. exit(-1.0); // raise except?
  387. if not SearchConvert(fromtype2,fromrec2) then
  388. exit(-1.0); // raise exception?
  389. if not SearchConvert(totype2,torec2) then
  390. exit(-1.0); // raise except?
  391. if (fromrec1.fam<>torec1.fam) or (fromrec1.fam<>torec1.fam) then
  392. exit(-1.0);
  393. result:=Measurement*(fromrec1.value/fromrec2.value)/(torec1.value/torec2.value);
  394. end;
  395. // initial FFU factors from a HP48g calculator and BSD units program. However after
  396. // a while, the bushels/forthnight got boring, so please check.
  397. // undefined/uncertain factors get -1, and convert() functions
  398. // should check that and bomb on it.
  399. procedure RegisterArea;
  400. begin
  401. auSquareMillimeters := RegisterConversionType(cbArea,txtauSquareMillimeters,1E-6);
  402. auSquareCentimeters := RegisterConversionType(cbArea,txtauSquareCentimeters,1E-4);
  403. auSquareDecimeters := RegisterConversionType(cbArea,txtauSquareDecimeters,1E-2);
  404. auSquareMeters := RegisterConversionType(cbArea,txtauSquareMeters,1);
  405. auSquareDecameters := RegisterConversionType(cbArea,txtauSquareDecameters,1E2);
  406. auSquareHectometers := RegisterConversionType(cbArea,txtauSquareHectometers,1E4);
  407. auSquareKilometers := RegisterConversionType(cbArea,txtauSquareKilometers,1E6);
  408. auSquareInches := RegisterConversionType(cbArea,txtauSquareInches,0.00064516);
  409. auSquareFeet := RegisterConversionType(cbArea,txtauSquareFeet,0.092903040);
  410. auSquareYards := RegisterConversionType(cbArea,txtauSquareYards,0.83612736);
  411. auSquareMiles := RegisterConversionType(cbArea,txtauSquareMiles,2589988.11034);
  412. auAcres := RegisterConversionType(cbArea,txtauAcres,4046.87260987);
  413. auCentares := RegisterConversionType(cbArea,txtauCentares,-1);
  414. auAres := RegisterConversionType(cbArea,txtauAres,100);
  415. auHectares := RegisterConversionType(cbArea,txtauHectares,10000);
  416. auSquareRods := RegisterConversionType(cbArea,txtauSquareRods,25.2929538117);
  417. end;
  418. procedure RegisterLengths;
  419. begin
  420. duMicromicrons := RegisterConversionType(cbDistance,txtduMicromicrons,1E-12);
  421. duAngstroms := RegisterConversionType(cbDistance,txtduAngstroms,1E-10);
  422. duMillimicrons := RegisterConversionType(cbDistance,txtduMillimicrons,1E-9);
  423. duMicrons := RegisterConversionType(cbDistance,txtduMicrons,1E-6);
  424. duMillimeters := RegisterConversionType(cbDistance,txtduMillimeters,1E-3);
  425. duCentimeters := RegisterConversionType(cbDistance,txtduCentimeters,1E-2);
  426. duDecimeters := RegisterConversionType(cbDistance,txtduDecimeters,1E-1);
  427. duMeters := RegisterConversionType(cbDistance,txtduMeters,1);
  428. duDecameters := RegisterConversionType(cbDistance,txtduDecameters,10);
  429. duHectometers := RegisterConversionType(cbDistance,txtduHectometers,100);
  430. duKilometers := RegisterConversionType(cbDistance,txtduKilometers,1000);
  431. duMegameters := RegisterConversionType(cbDistance,txtduMegameters,1E6);
  432. duGigameters := RegisterConversionType(cbDistance,txtduGigameters,1E9);
  433. duInches := RegisterConversionType(cbDistance,txtduInches,0.0254);
  434. duFeet := RegisterConversionType(cbDistance,txtduFeet,0.3048);
  435. duYards := RegisterConversionType(cbDistance,txtduYards,0.9144);
  436. duMiles := RegisterConversionType(cbDistance,txtduMiles,1609.344);
  437. duNauticalMiles := RegisterConversionType(cbDistance,txtduNauticalMiles,1852);
  438. duAstronomicalUnits := RegisterConversionType(cbDistance,txtduAstronomicalUnits,149597900000.0);
  439. duLightYears := RegisterConversionType(cbDistance,txtduLightYears,9.46052840488E15);
  440. duParsecs := RegisterConversionType(cbDistance,txtduParsecs, 3.08567818585E16);
  441. duCubits := RegisterConversionType(cbDistance,txtduCubits,0.4572);
  442. duFathoms := RegisterConversionType(cbDistance,txtduFathoms,1.8288);
  443. duFurlongs := RegisterConversionType(cbDistance,txtduFurlongs,201.168);
  444. duHands := RegisterConversionType(cbDistance,txtduHands,0.1016);
  445. duPaces := RegisterConversionType(cbDistance,txtduPaces,0.9144);
  446. duRods := RegisterConversionType(cbDistance,txtduRods,5.0292);
  447. duChains := RegisterConversionType(cbDistance,txtduChains,20.1168);
  448. duLinks := RegisterConversionType(cbDistance,txtduLinks,0.201168);
  449. duPicas := RegisterConversionType(cbDistance,txtduPicas,0.0042333333);
  450. duPoints := RegisterConversionType(cbDistance,txtduPoints,0.00035277778);
  451. end;
  452. procedure Registermass; // weight? :)
  453. begin
  454. muNanograms := RegisterConversionType(cbMass,txtmuNanograms,1E-12);
  455. muMicrograms := RegisterConversionType(cbMass,txtmuMicrograms,1E-9);
  456. muMilligrams := RegisterConversionType(cbMass,txtmuMilligrams,1E-6);
  457. muCentigrams := RegisterConversionType(cbMass,txtmuCentigrams,1E-5);
  458. muDecigrams := RegisterConversionType(cbMass,txtmuDecigrams,1E-4);
  459. muGrams := RegisterConversionType(cbMass,txtmuGrams,1E-3);
  460. muDecagrams := RegisterConversionType(cbMass,txtmuDecagrams,1E-2);
  461. muHectograms := RegisterConversionType(cbMass,txtmuHectograms,1E-1);
  462. muKilograms := RegisterConversionType(cbMass,txtmuKilograms,1);
  463. muMetricTons := RegisterConversionType(cbMass,txtmuMetricTons,1000);
  464. muDrams := RegisterConversionType(cbMass,txtmuDrams,0.0017718452);
  465. muGrains := RegisterConversionType(cbMass,txtmuGrains,6.479891E-5);
  466. muLongTons := RegisterConversionType(cbMass,txtmuLongTons,1016.0469);
  467. muTons := RegisterConversionType(cbMass,txtmuTons,907.18474);
  468. muOunces := RegisterConversionType(cbMass,txtmuOunces,0.028349523);
  469. muPounds := RegisterConversionType(cbMass,txtmuPounds,0.45359237);
  470. muStones := RegisterConversionType(cbMass,txtmuStones,6.3502932);
  471. end;
  472. procedure RegisterTemperature;
  473. begin
  474. tuCelsius := RegisterConversionType(cbTemperature,txttuCelsius,1);
  475. tuKelvin := RegisterConversionType(cbTemperature,txttuKelvin,1);
  476. tuFahrenheit := RegisterConversionType(cbTemperature,txttuFahrenheit,5/9);
  477. tuRankine := RegisterConversionType(cbTemperature,txttuRankine,0.5555556);
  478. tuReamur := RegisterConversionType(cbTemperature,txttuReamur,10/8); // Reaumur?
  479. end;
  480. Const Yearsec=365.24219879*24*3600.0; // year in seconds;
  481. procedure RegisterTimes;
  482. begin
  483. tuMilliSeconds := RegisterConversionType(cbTime,txttuMilliSeconds,1E-3);
  484. tuSeconds := RegisterConversionType(cbTime,txttuSeconds,1);
  485. tuMinutes := RegisterConversionType(cbTime,txttuMinutes,60.0);
  486. tuHours := RegisterConversionType(cbTime,txttuHours,3600.0);
  487. tuDays := RegisterConversionType(cbTime,txttuDays,24*3600.0);
  488. tuWeeks := RegisterConversionType(cbTime,txttuWeeks,7*24*3600.0);
  489. tuFortnights := RegisterConversionType(cbTime,txttuFortnights,14*24*3600.0);
  490. tuMonths := RegisterConversionType(cbTime,txttuMonths,1/12*YearSec);
  491. tuYears := RegisterConversionType(cbTime,txttuYears,YearSec);
  492. tuDecades := RegisterConversionType(cbTime,txttuDecades,10*YearSec);
  493. tuCenturies := RegisterConversionType(cbTime,txttuCenturies,100*yearsec);
  494. tuMillennia := RegisterConversionType(cbTime,txttuMillennia,1000*yearsec);
  495. tuDateTime := RegisterConversionType(cbTime,txttuDateTime,-1);
  496. tuJulianDate := RegisterConversionType(cbTime,txttuJulianDate,-1);
  497. tuModifiedJulianDate := RegisterConversionType(cbTime,txttuModifiedJulianDate,-1);
  498. end;
  499. const flgal=0.0037854118;
  500. procedure RegisterVolumes;
  501. begin
  502. vuCubicMillimeters := RegisterConversionType(cbVolume,txtvuCubicMillimeters,1E-9);
  503. vuCubicCentimeters := RegisterConversionType(cbVolume,txtvuCubicCentimeters,1E-6);
  504. vuCubicDecimeters := RegisterConversionType(cbVolume,txtvuCubicDecimeters,1E-3);
  505. vuCubicMeters := RegisterConversionType(cbVolume,txtvuCubicMeters,1);
  506. vuCubicDecameters := RegisterConversionType(cbVolume,txtvuCubicDecameters,1E3);
  507. vuCubicHectometers := RegisterConversionType(cbVolume,txtvuCubicHectometers,1E6);
  508. vuCubicKilometers := RegisterConversionType(cbVolume,txtvuCubicKilometers,1E9);
  509. vuCubicInches := RegisterConversionType(cbVolume,txtvuCubicInches,1.6387064E-5);
  510. vuCubicFeet := RegisterConversionType(cbVolume,txtvuCubicFeet,0.028316847);
  511. vuCubicYards := RegisterConversionType(cbVolume,txtvuCubicYards,0.76455486);
  512. vuCubicMiles := RegisterConversionType(cbVolume,txtvuCubicMiles,4.1681818E9);
  513. vuMilliLiters := RegisterConversionType(cbVolume,txtvuMilliLiters,1E-6);
  514. vuCentiLiters := RegisterConversionType(cbVolume,txtvuCentiLiters,1E-5);
  515. vuDeciLiters := RegisterConversionType(cbVolume,txtvuDeciLiters,1E-4);
  516. vuLiters := RegisterConversionType(cbVolume,txtvuLiters,1E-3);
  517. vuDecaLiters := RegisterConversionType(cbVolume,txtvuDecaLiters,1E-2);
  518. vuHectoLiters := RegisterConversionType(cbVolume,txtvuHectoLiters,1E-1);
  519. vuKiloLiters := RegisterConversionType(cbVolume,txtvuKiloLiters,1);
  520. vuAcreFeet := RegisterConversionType(cbVolume,txtvuAcreFeet, -1);
  521. vuAcreInches := RegisterConversionType(cbVolume,txtvuAcreInches, -1);
  522. vuCords := RegisterConversionType(cbVolume,txtvuCords,128*0.028316847);
  523. vuCordFeet := RegisterConversionType(cbVolume,txtvuCordFeet,128*0.028316847);
  524. vuDecisteres := RegisterConversionType(cbVolume,txtvuDecisteres,0.1);
  525. vuSteres := RegisterConversionType(cbVolume,txtvuSteres,1);
  526. vuDecasteres := RegisterConversionType(cbVolume,txtvuDecasteres,10);
  527. vuFluidGallons := RegisterConversionType(cbVolume,txtvuFluidGallons,flgal);
  528. vuFluidQuarts := RegisterConversionType(cbVolume,txtvuFluidQuarts,0.25*flgal);
  529. vuFluidPints := RegisterConversionType(cbVolume,txtvuFluidPints,0.5*0.25*flgal);
  530. vuFluidCups := RegisterConversionType(cbVolume,txtvuFluidCups, -1);
  531. vuFluidGills := RegisterConversionType(cbVolume,txtvuFluidGills,-1);
  532. vuFluidOunces := RegisterConversionType(cbVolume,txtvuFluidOunces,1/16*0.5*0.25*flgal);
  533. vuFluidTablespoons := RegisterConversionType(cbVolume,txtvuFluidTablespoons,-1);
  534. vuFluidTeaspoons := RegisterConversionType(cbVolume,txtvuFluidTeaspoons,-1);
  535. vuDryGallons := RegisterConversionType(cbVolume,txtvuDryGallons,-1);
  536. vuDryQuarts := RegisterConversionType(cbVolume,txtvuDryQuarts,-1);
  537. vuDryPints := RegisterConversionType(cbVolume,txtvuDryPints,-1);
  538. vuDryPecks := RegisterConversionType(cbVolume,txtvuDryPecks, 0.0088097675);
  539. vuDryBuckets := RegisterConversionType(cbVolume,txtvuDryBuckets,-1);
  540. vuDryBushels := RegisterConversionType(cbVolume,txtvuDryBushels,0.03523907);
  541. vuUKGallons := RegisterConversionType(cbVolume,txtvuUKGallons,0.0045460993);
  542. vuUKPottles := RegisterConversionType(cbVolume,txtvuUKPottles,-1);
  543. vuUKQuarts := RegisterConversionType(cbVolume,txtvuUKQuarts,0.0011365248);
  544. vuUKPints := RegisterConversionType(cbVolume,txtvuUKPints,-1);
  545. vuUKGills := RegisterConversionType(cbVolume,txtvuUKGills,-1);
  546. vuUKOunces := RegisterConversionType(cbVolume,txtvuUKOunces,2.8413121E-5);
  547. vuUKPecks := RegisterConversionType(cbVolume,txtvuUKPecks,0.0090921986);
  548. vuUKBuckets := RegisterConversionType(cbVolume,txtvuUKBuckets,-1);
  549. vuUKBushels := RegisterConversionType(cbVolume,txtvuUKBushels,0.036368794);
  550. end;
  551. Procedure RegisterFamilies;
  552. Begin
  553. cbArea := RegisterConversionFamily('Area');
  554. cbDistance := RegisterConversionFamily('Distance');
  555. cbMass := RegisterConversionFamily('Mass');
  556. cbTemperature := RegisterConversionFamily('Temperature');
  557. cbTime := RegisterConversionFamily('Time');
  558. cbVolume := RegisterConversionFamily('Volume');
  559. End;
  560. Procedure RegisterAll;
  561. begin
  562. RegisterFamilies;
  563. RegisterVolumes;
  564. RegisterTimes;
  565. RegisterTemperature;
  566. Registermass;
  567. RegisterLengths;
  568. RegisterArea;
  569. end;
  570. initialization
  571. registerall;
  572. finalization
  573. setlength(theunits,0);
  574. setlength(thefamilies,0);
  575. end.