Author: Dave Murray
How do I convert integers from Decimal to Base n and vice versa.
Answer:
Solve 1:
1 unit BaseFunctions;
2 {Unit for conversion functions Dec_To_Base and Base_To_Dec.}
3 {These functions are designed to convert integers from Decimal to Base n}
4 {They can be used to create serial numbers for Compaq, etc.}
5 {See below for usage.}
6 {Written by Dave Murray, Nov 2000.}
7
8 interface
9
10 uses
11 SysUtils;
12
13 function Dec_To_Base(nBase, nDec_Value, Lead_Zeros: integer; cOmit: string): string;
14 function Base_To_Dec(nBase: integer; cBase_Value, cOmit: string): integer;
15
16 implementation
17
18 function Dec_To_Base(nBase, nDec_Value, Lead_Zeros: integer; cOmit: string): string;
19 {Function : converts decimal integer to base n, max = Base36
20 Parameters : nBase = base number, ie. Hex is base 16
21 nDec_Value = decimal to be converted
22 Lead_Zeros = min number of digits if leading zeros required
23 cOmit = chars to omit from base (eg. I,O,U,etc)
24 Returns : number in base n as string}
25 var
26 Base_PChar: PChar;
27 Base_String: string;
28 To_Del, Modulus, DivNo: integer;
29 temp_string: string;
30 i, nLen, Len_Base: integer;
31 begin
32 {initialise..}
33 Base_String := '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'; {max = Base36}
34 To_Del := 0;
35 Modulus := 0;
36 DivNo := nDec_Value;
37 result := '';
38 if (nBase > 36) then
39 nBase := 36; {max = Base36}
40 cOmit := UpperCase(cOmit);
41 {build string to fit specified base}
42 if not (cOmit = '') then
43 begin
44 {iterate thru' ommited letters}
45 nLen := Length(cOmit);
46 for i := 1 to nLen do
47 begin
48 To_Del := Pos(cOmit[i], Base_String); {find position of letter}
49 if (To_Del > 0) then
50 begin
51 {remove letter from base string}
52 Len_Base := Length(Base_String);
53 temp_string := Copy(Base_String, 0, To_Del - 1);
54 temp_string := temp_string + Copy(Base_String, To_Del + 1, Len_Base -
55 To_Del);
56 Base_String := temp_string;
57 end; {if To_Del>0..}
58 end; {for i..}
59 end; {if not cOmit=''..}
60 {ensure string is required length for base}
61 SetLength(Base_String, nBase);
62 Base_PChar := PChar(Base_String);
63 {divide decimal by base & iterate until zero to convert it}
64 while DivNo > 0 do
65 begin
66 Modulus := DivNo mod nBase; {remainder is next digit}
67 result := Base_PChar[Modulus] + result;
68 DivNo := DivNo div nBase;
69 end; {while..}
70 {fix zero value}
71 if (Length(result) = 0) then
72 result := '0';
73 {add required leading zeros}
74 if (Length(result) < Lead_Zeros) then
75 for i := 1 to (Lead_Zeros - Length(result)) do
76 result := '0' + result;
77 end; {function Dec_To_Base}
78
79 function Base_To_Dec(nBase: integer; cBase_Value, cOmit: string): integer;
80 {Function : converts base n integer to decimal, max = Base36
81 Parameters : nBase = base number, ie. Hex is base 16
82 cBase_Value = base n integer (as string) to be converted
83 cOmit = chars to omit from base (eg. I,O,U,etc)
84 Returns : number in decimal as string}
85 var
86 Base_PChar: PChar;
87 Base_String: string;
88 To_Del, Unit_Counter: integer;
89 temp_string: string;
90 i, nLen, Len_Base: integer;
91 begin
92 {initialise..}
93 Base_String := '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'; {max = Base36}
94 To_Del := 0;
95 Unit_Counter := nBase;
96 result := 0;
97 if (nBase > 36) then
98 nBase := 36; {max = Base36}
99 cOmit := UpperCase(cOmit);
100 cBase_Value := UpperCase(cBase_Value); {ensure uppercase letters}
101 {build string to fit specified base}
102 if not (cOmit = '') then
103 begin
104 {iterate thru' ommited letters}
105 nLen := Length(cOmit);
106 for i := 1 to nLen do
107 begin
108 To_Del := Pos(cOmit[i], Base_String); {find position of letter}
109 if (To_Del > 0) then
110 begin
111 {remove letter from base string}
112 Len_Base := Length(Base_String);
113 temp_string := Copy(Base_String, 0, To_Del - 1);
114 temp_string := temp_string + Copy(Base_String, To_Del + 1, Len_Base -
115 To_Del);
116 Base_String := temp_string;
117 end; {if To_Del>0..}
118 end; {for i..}
119 end; {if not cOmit=''..}
120 {ensure string is required length for base}
121 SetLength(Base_String, nBase);
122 Base_PChar := PChar(Base_String);
123 {iterate thru digits of base n value, each digit is a multiple of base n}
124 nLen := Length(cBase_Value);
125 if (nLen = 0) then
126 result := 0 {fix zero value}
127 else
128 begin
129 for i := 1 to nLen do
130 begin
131 if (i = 1) then
132 unit_counter := 1 {1st digit = units}
133 else if (i > 1) then
134 unit_counter := unit_counter * nBase; {multiples of base}
135 result := result
136 + ((Pos(Copy(cBase_Value, (Length(cBase_Value) + 1) - i, 1), Base_PChar) -
137 1)
138 * unit_counter);
139 end; {for i:=1..}
140 end; {else begin..}
141 end; {function Base_To_Dec}
142
143 end. {unit BaseFunctions}
Solve 2:
144 function Dec2Numb(N: Longint; A, B: Byte): string;
145 var
146 C: Integer;
147 {$IFDEF RX_D4}
148 Number: Cardinal;
149 {$ELSE}
150 Number: Longint;
151 {$ENDIF}
152 begin
153 if N = 0 then
154 Result := '0'
155 else
156 begin
157 {$IFDEF RX_D4}
158 Number := Cardinal(N);
159 {$ELSE}
160 Number := N;
161 {$ENDIF}
162 Result := '';
163 while Number > 0 do
164 begin
165 C := Number mod B;
166 if C > 9 then
167 C := C + 55
168 else
169 C := C + 48;
170 Result := Chr(C) + Result;
171 Number := Number div B;
172 end;
173 end;
174 if Result <> '' then
175 Result := AddChar('0', Result, A);
176 end;
177
178 function Numb2Dec(S: string; B: Byte): Longint;
179 var
180 I, P: Longint;
181 begin
182 I := Length(S);
183 Result := 0;
184 S := UpperCase(S);
185 P := 1;
186 while (I >= 1) do
187 begin
188 if S[I] > '@' then
189 Result := Result + (Ord(S[I]) - 55) * P
190 else
191 Result := Result + (Ord(S[I]) - 48) * P;
192 Dec(I);
193 P := P * B;
194 end;
195 end;
Code from RXLib library.
|
