Posted By

tiaonlab on 04/04/07


Tagged

intfloatrealutility


Versions (?)

Who likes this?

2 people have marked this snippet as a favorite

icebob
alexmensi


Number utility functions


 / Published in: Pascal
 

URL: http://www.tiaon.com/wordpress/2007/03/05/some-useful-delphi-codes-part-1-numbers/

Over the years I have made quite a few software programs in Delphi, and inevitably I have also come up with many useful functions. Most of them I have never published on the Internet before, now I would like to list on blog.

Part 1 are functions for managing integer or real numbers, they were written very early in 1997.

  1. { ---------------------------------------------------
  2. Numbers Manager Copyright (r) by
  3.   Version : 1.75 Author : William Yang
  4. Last Update 24 - Aug - 97
  5.   --------------------------------------------------- }
  6.  
  7. unit NumMan;
  8.  
  9. interface
  10.  
  11. uses Classes, SysUtils, Windows;
  12.  
  13. // Force an integer number to be between certain range
  14. function MakeBetween(S, nFrom, nTo : Integer) : Integer;
  15. // Check if an integer is between n1 and n2
  16. function Between(S, N1, N2 : Integer) : Boolean;
  17. // Check if an real/float number is between n1 and n2
  18. function fBetween(S, N1, N2 : Real) : Boolean;
  19. // Calculate rectangular width
  20. function RectWidth(Rect: TRect) : Integer;
  21. // Calculate rectangular height
  22. function RectHeight(Rect: TRect) : Integer;
  23. // Find smallest integer in an array
  24. function MinMost(Nums: array of Integer): Integer;
  25. // Find largest integer in an array
  26. function MaxMost(Nums: array of Integer): Integer;
  27. // Check if the integers in an array are equal
  28. function AllEqual(Nums: array of Integer): Boolean;
  29. // Check if the integers in an array are different
  30. function AllDiff(Nums: array of Integer): Boolean;
  31. //Check if these numbers in the range
  32. function AllBetween(Nums: array of Integer; nFrom, nTo : Integer): Boolean;
  33. {Check if the numbers are like (1, 2, 3, 4, 5),
  34. you can set InOrder to false if you want check(4,2,3,5,1) }
  35. function IsIncreasement(Nums: array of Integer; InOrder: Boolean): Boolean;
  36. {more customisable with amount that increase }
  37. function IsIncreasementExt(Nums: array of Integer; InOrder: Boolean;
  38. Incs: Integer): Boolean;
  39. //Find a number an array of numbers, returns the index of the first catch.
  40. function FindNum(Num: Integer; Nums: array of Integer): Integer;
  41. //Find pairs, returns the total amount of pairs.
  42. function FindPairs(Nums: array of Integer): Integer;
  43. //Find the how many times the number appears.
  44. function NumAppears(Num: Integer; Nums: array of Integer): Integer;
  45. // A byte has 8 bits, ReadBits returns number value between certain bits in an integer
  46. function ReadBits(Num, Start, Count: Integer): Integer;
  47. // Returns how many bits are used to store this integer, e.g. 8 returns 4, 7 return 3
  48. function MaxBits(Num: Integer): Integer;
  49. // Translate integer to binaries
  50. function IntToBin(Num: Integer): String;
  51. // Modify certain bits in an integer
  52. function WriteBits(Num, Start, Val: Integer): Integer;
  53. // Integer swap
  54. procedure ISwap(var n1, n2: Integer);
  55. // Byte swap
  56. procedure BSwap(var n1, n2: Byte);
  57. // Real/ float number swap
  58. procedure FSwap(var n1, n2: Double);
  59. // Round up an real number by certain integer value, e.g. RoundBy(67.4, 10) return 70
  60. function RoundBy(ANum: Real; By: Integer): Integer;
  61. // Smallest float number
  62. function MinFloat(X, Y: Extended): Extended;
  63. // Largest float number
  64. function MaxFloat(X, Y: Extended): Extended;
  65.  
  66. implementation
  67.  
  68. function fBetween(S, N1, N2 : Real) : Boolean;
  69. begin
  70. if (S >= N1) and (S <= N2) then
  71. Result := True
  72. else
  73. Result := False;
  74. end;
  75.  
  76. function RoundBy(ANum: Real; By: Integer): Integer;
  77. begin
  78. Result := Round(ANum / By);
  79. Result := Result*By;
  80. end;
  81.  
  82. procedure ISwap(var n1, n2: Integer);
  83. var
  84. t: Integer;
  85. begin
  86. t := n1;
  87. n1 := n2;
  88. n2 := t;
  89. end;
  90.  
  91. procedure BSwap(var n1, n2: Byte);
  92. var
  93. t: Byte;
  94. begin
  95. t := n1;
  96. n1 := n2;
  97. n2 := t;
  98. end;
  99.  
  100. procedure FSwap(var n1, n2: Double);
  101. var
  102. t: Double;
  103. begin
  104. t := n1;
  105. n1 := n2;
  106. n2 := t;
  107. end;
  108.  
  109. function WriteBits(Num, Start, Val: Integer): Integer;
  110. begin
  111. Val := Val shl (Start - 1);
  112. Result := Num or Val;
  113. end;
  114.  
  115. function MaxBits(Num: Integer): Integer;
  116. begin
  117. Result := 0;
  118. repeat
  119. Num := Num shr 1;
  120. Inc(Result);
  121. until Num <= 0;
  122. end;
  123.  
  124. function IntToBin(Num: Integer): String;
  125. var
  126. Mask: Integer;
  127. i, Bits: Integer;
  128. begin
  129. Result := ''; Mask := 1;
  130. Bits := MaxBits(Num);
  131. for i := 1 to bits do
  132. begin
  133. if (Num and Mask) = Mask then
  134. Result := Result + '1'
  135. else
  136. Result := Result + '0';
  137. Mask := Mask shl 1;
  138. end;
  139. end;
  140.  
  141. function ReadBits(Num, Start, Count: Integer): Integer;
  142. var
  143. BitMask: Integer;
  144. i, Max: Integer;
  145. begin
  146. Max := MaxBits(Num);
  147. {
  148.   0000 1111
  149.   and 1011 0111
  150.   ---- ---- ----
  151. 0000 0111
  152.   }
  153. //Initialize Bitmask with 0.
  154. BitMask := 0;
  155. for i := Max downto 1 do
  156. begin
  157. if (i >= Start) and (i <= Start + Count - 1) then
  158. begin
  159. Bitmask := Bitmask or 1;
  160. end;
  161. if i > 1 then
  162. begin
  163. BitMask := BitMask shl 1;
  164. end;
  165. end;
  166. Result := BitMask and Num;
  167. Result := Result shr (Start - 1)
  168. end;
  169.  
  170. function FindPairs(Nums: array of Integer): Integer;
  171. var
  172. i: Integer;
  173. begin
  174. Result := 0;
  175. for i := Low(Nums) to High(Nums) do
  176. begin
  177. if NumAppears(Nums[i], Nums) = 2 then
  178. Inc(Result);
  179. end;
  180. Result := Result div 2;
  181. end;
  182.  
  183. function FindNum(Num: Integer; Nums: array of Integer): Integer;
  184. var
  185. i:Integer;
  186. begin
  187. Result := -1;
  188. for i := Low(Nums) to High(Nums) do
  189. begin
  190. if Nums[i] = Num then
  191. begin
  192. Result := i;
  193. Exit;
  194. end;
  195. end;
  196. end;
  197.  
  198. function NumAppears(Num: Integer; Nums: array of Integer): Integer;
  199. var
  200. i:Integer;
  201. begin
  202. Result := 0;
  203. for i := Low(Nums) to High(Nums) do
  204. begin
  205. if Nums[i] = Num then
  206. begin
  207. Inc(Result);
  208. end;
  209. end;
  210. end;
  211.  
  212. function IsIncreasementExt(Nums: array of Integer; InOrder: Boolean;
  213. Incs: Integer): Boolean;
  214. var
  215. i,j, k : Integer;
  216. begin
  217. Result := True;
  218. if InOrder then
  219. begin
  220. j := Nums[Low(Nums)] + Incs;
  221. for i := Low(Nums) + 1 to High(Nums) do
  222. begin
  223. if Nums[i] <> J then
  224. begin
  225. Result := False;
  226. Exit;
  227. end;
  228. Inc(j, Incs);
  229. end;
  230. end
  231. else
  232. begin
  233. k := MinMost(Nums);
  234. //Get the smallest number to start with.
  235. j := k + Incs;
  236. while (FindNum(j, Nums) <> - 1) do
  237. begin
  238. Inc(j, Incs);
  239. end;
  240. //if j is equal to the total increasement + minmost value.
  241. if j = k + (High(Nums) - Low(Nums)) * Incs then
  242. Result := True
  243. else
  244. Result := False;
  245. end;
  246. end;
  247.  
  248. function IsIncreasement(Nums: array of Integer; InOrder: Boolean): Boolean;
  249. begin
  250. Result := IsIncreasementExt(Nums, InOrder, 1);
  251. end;
  252.  
  253. function AllBetween(Nums: array of Integer; nFrom, nTo : Integer): Boolean;
  254. var
  255. i:Integer;
  256. begin
  257. Result := True;
  258. for i := Low(Nums) to High(Nums) do
  259. begin
  260. if not Between(Nums[i], nFrom, nTo) then
  261. begin
  262. Result := False;
  263. Exit;
  264. end;
  265. end;
  266.  
  267. end;
  268.  
  269. function AllDiff(Nums: array of Integer): Boolean;
  270. var
  271. i, j : Integer;
  272. begin
  273. Result := True;
  274. for i := Low(Nums) to High(Nums) do
  275. for j := Low(Nums) to High(Nums) do
  276. begin
  277. if (i<>j) and (Nums[j] = Nums[i]) then
  278. begin
  279. Result := False;
  280. Exit;
  281. end;
  282. end;
  283. end;
  284.  
  285. function AllEqual(Nums: array of Integer): Boolean;
  286. var
  287. i : Integer;
  288. begin
  289. Result := True;
  290. for i := Low(Nums) + 1 to High(Nums) do
  291. begin
  292. if Nums[Low(Nums)] <> Nums[i] then
  293. begin
  294. Result := False;
  295. Exit;
  296. end;
  297. end;
  298. end;
  299.  
  300. function MinMost(Nums: array of Integer): Integer;
  301. var
  302. i,j, k : Integer;
  303. begin
  304. //Go through each numbers.
  305. for i := Low(Nums) to High(Nums) do
  306. begin
  307. k := 0;
  308. //check if this number is smaller than others
  309. for j := Low(Nums) to High(Nums) do
  310. begin
  311. if (Nums[i] <= Nums[j]) and (i <> j) then
  312. Inc(k);
  313. end;
  314. {If there is 5 numbers, if a number smaller than other 4
  315.   then it is the smallest}
  316. if k = High(Nums) - Low(Nums) then
  317. Result := Nums[i];
  318. end;
  319. end;
  320.  
  321. function MaxMost(Nums: array of Integer): Integer;
  322. var
  323. i,j, k : Integer;
  324. begin
  325. for i := Low(Nums) to High(Nums) do
  326. begin
  327. k := 0;
  328. for j := Low(Nums) to High(Nums) do
  329. begin
  330. if (Nums[i] >= Nums[j]) and (i <> j) then
  331. Inc(k);
  332. end;
  333. if k = High(Nums) - Low(Nums) then
  334. Result := Nums[i];
  335. end;
  336. end;
  337.  
  338. function RectWidth(Rect: TRect) : Integer;
  339. begin
  340. Result := Rect.Right - Rect.Left;
  341. end;
  342.  
  343. function RectHeight(Rect: TRect) : Integer;
  344. begin
  345. Result := Rect.Bottom - Rect.Top;
  346. end;
  347.  
  348. Function Min(X, Y : Integer) : Integer;
  349. begin
  350. if X<=Y then
  351. Result := X
  352. else
  353. Result := y;
  354. end;
  355.  
  356. Function Max(X, Y : Integer) : Integer;
  357. begin
  358. if X>=Y then
  359. Result := X
  360. else
  361. Result := y;
  362. end;
  363.  
  364. function MinFloat(X, Y: Extended): Extended;
  365. begin
  366. if X < Y then Result := X else Result := Y;
  367. end;
  368.  
  369. function MaxFloat(X, Y: Extended): Extended;
  370. begin
  371. if X > Y then Result := X else Result := Y;
  372. end;
  373.  
  374. function Between(S, N1, N2 : Integer) : Boolean;
  375. begin
  376. if (S >= N1) and (S <= N2) then
  377. Result := True
  378. else
  379. Result := False;
  380. end;
  381.  
  382. function MakeBetween(S, nFrom, nTo : Integer) : Integer;
  383. begin
  384. Result := S;
  385. while Result < nFrom do
  386. begin
  387. Result := Result + (nTo - nFrom);
  388. end;
  389. while Result > nTo do
  390. begin
  391. Result := Result - (nTo - nFrom);
  392. end;
  393. end;
  394.  
  395.  
  396. end.

Report this snippet  

You need to login to post a comment.