求助一個從8進制轉換為10進制的函數.(100分)

  • 主题发起人 主题发起人 jackl
  • 开始时间 开始时间
// 10 进制 -> n 进制

function Dec_To_Base(nBase, nDec_Value, Lead_Zeros:integer
cOmit:string):string

{Function : converts decimal integer to base n, max = Base36
Parameters : nBase = base number, ie. Hex is base 16
nDec_Value = decimal to be converted
Lead_Zeros = min number of digits if leading zeros required
cOmit = chars to omit from base (eg. I,O,U,etc)
Returns : number in base n as string}
var
Base_PChar : PChar

Base_String : string

To_Del, Modulus, DivNo : integer

temp_string : string

i, nLen, Len_Base : integer

begin
{initialise..}
Base_String := ''0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ''
{max = Base36}
To_Del := 0

Modulus := 0

DivNo := nDec_Value

result := ''''

if (nBase > 36) then nBase := 36
{max = Base36}
cOmit := UpperCase(cOmit)

{build string to fit specified base}
if not(cOmit = '''') then begin
{iterate thru'' ommited letters}
nLen := Length(cOmit)

for i := 1 to nLen do begin
To_Del := Pos(cOmit, Base_String)
{find position of letter}
if (To_Del > 0) then begin
{remove letter from base string}
Len_Base := Length(Base_String)

temp_string := Copy(Base_String, 0, To_Del - 1)

temp_string := temp_string + Copy(Base_String,To_Del + 1,Len_Base - To_Del)

Base_String := temp_string

end
{if To_Del>0..}
end
{for i..}
end
{if not cOmit=''''..}
{ensure string is required length for base}
SetLength(Base_String, nBase)

Base_PChar := PChar(Base_String)

{divide decimal by base &amp
iterate until zero to convert it}
while DivNo > 0 do begin
Modulus := DivNo mod nBase
{remainder is next digit}
result := Base_PChar[Modulus] + result

DivNo := DivNo div nBase

end
{while..}
{fix zero value}
if (Length(result) = 0) then result := ''0''

{add required leading zeros}
if (Length(result) < Lead_Zeros) then
for i := 1 to (Lead_Zeros - Length(result)) do result := ''0'' + result

end
{function Dec_To_Base}

function Base_To_Dec(nBase:integer;cBase_Value, cOmit:string):integer

{Function : converts base n integer to decimal, max = Base36
Parameters : nBase = base number, ie. Hex is base 16
cBase_Value = base n integer (as string) to be converted
cOmit = chars to omit from base (eg. I,O,U,etc)
Returns : number in decimal as string}
var
Base_PChar : PChar

Base_String : string

To_Del, Unit_Counter : integer

temp_string : string

i, nLen, Len_Base : integer

begin
{initialise..}
Base_String := ''0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ''
{max = Base36}
To_Del := 0

Unit_Counter := nBase

result := 0

if (nBase > 36) then nBase := 36
{max = Base36}
cOmit := UpperCase(cOmit)

cBase_Value := UpperCase(cBase_Value)
{ensure uppercase letters}
{build string to fit specified base}
if not(cOmit = '''') then begin
{iterate thru'' ommited letters}
nLen := Length(cOmit)

for i := 1 to nLen do begin
To_Del := Pos(cOmit, Base_String)
{find position of letter}
if (To_Del > 0) then begin
{remove letter from base string}
Len_Base := Length(Base_String)

temp_string := Copy(Base_String, 0, To_Del - 1)

temp_string := temp_string + Copy(Base_String,To_Del + 1,Len_Base - To_Del)

Base_String := temp_string

end
{if To_Del>0..}
end
{for i..}
end
{if not cOmit=''''..}
{ensure string is required length for base}
SetLength(Base_String, nBase)

Base_PChar := PChar(Base_String)

{iterate thru digits of base n value, each digit is a multiple of base n}
nLen := Length(cBase_Value)

if (nLen = 0) then result := 0 {fix zero value}
else begin
for i := 1 to nLen do begin
if (i = 1) then unit_counter := 1 {1st digit = units}
else if (i > 1) then unit_counter := unit_counter * nBase
{multiples of base}
result := result
+ ((Pos(Copy(cBase_Value, (Length(cBase_Value)+1)-i, 1), Base_PChar) - 1)
* unit_counter)

end
{for i:=1..}
end
{else begin..}
end
{function Base_To_Dec}

end. {unit BaseFunctions}
 
楼上的已经给出了一个通用的法子,还不满意吗?
好,我来写一个非通用的:

function EightToDec(const Str:String):Integer;
var
i,n:Integer;
begin
Result:=0;
for i:=1 to Length(Str) do
Result:=Result*8+Byte(Str)-Byte('0');
end;

够简单——连异常处理都没有。 OK?
 
楼上的大侠,都是大好人
 
多人接受答案了。
 

Similar threads

S
回复
0
查看
1K
SUNSTONE的Delphi笔记
S
S
回复
0
查看
900
SUNSTONE的Delphi笔记
S
S
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
S
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
后退
顶部