Наши проекты:
Журнал · Discuz!ML · Wiki · DRKB · Помощь проекту |
||
ПРАВИЛА | FAQ | Помощь | Поиск | Участники | Календарь | Избранное | RSS |
[18.221.165.246] |
|
Сообщ.
#1
,
|
|
|
В FAQ имеется пример для перевода с ограничением, что СИ не может быть более чем 36-ти значная. Ниже код, которому все-равно. Главный недостаток - жутко тормозной . Так же имеются функции суммирования и умножения в произвольной СИ.
P.S. Вроде проверил, глюков не нашел; если что пните. P.P.S. Так же есть код и на VB const CharSetIn = '0123456789ABCDEF'; CharSetOut = '01'; // Пример конвертирует число FFA из 16-ричной СИ в двоичную Convert('FFA',CharSetIn,CharSetOut); // CharSet = "01234567" - 8-ми ричная система исчисления // MyChr(0) = "0", MyChr(7) = "7", MyChr(8) = "0" // Всегда: A = Ai*Base^i + ... + A1*Base + A0, где Ai in CharSet // Base = MyChr(Len(CharSet)-1) + 1 ~ 10 (соотв. СИ) // РЕАЛИЗОВАННЫЕ ФУНКЦИИ // Convert - преобразование числа из одной СИ в другую // f0 - преобразование одного символа исходной СИ в другую (впомогат.) // MySum - сумма двух чисел в некоторой СИ // MyMult - произведение двух чисел в некоторой СИ // MyChr - по номеру возвращает символ // MyOrd - по символу возвращает номер в CharSet //**MyOrd************************************************************** function MyOrd(A: Char; CharSet: String): Integer; var i: Integer; begin Result:=0; for i:=1 to Length(CharSet) do begin if CharSet[i]=A then begin Result:=i-1; exit; end end; end; //**MyChr************************************************************** function MyChr(Num: Integer; CharSet: String): Char; begin Result := CharSet[Num mod Length(CharSet) + 1]; end; //**MySum************************************************************ function MySum (A, B, CharSet: String): String; var i, Pos, Add, L, L_CharSet: Integer; AA,BB, O, Res: String; begin if Length(A)>=Length(B) then begin AA:=A; BB:=B; end else begin AA:=B; BB:=A; end; L:= Length(AA); L_CharSet := Length(CharSet); O:=MyChr(0, CharSet); for i := Length(BB) to L-1 do BB := O + BB; Add:=0; for i:= L downto 1 do begin Pos := MyOrd(AA[i], CharSet)+MyOrd(BB[i],CharSet) + Add; Add := 0; While Pos >= L_CharSet do begin Pos := Pos mod L_CharSet; Add := Add+1; end; Res := MyChr(Pos, CharSet) + Res; end; If Add<>0 then Result := MyChr(Add, CharSet) + Res else Result:=res; end; //**MyMulti************************************************************ function MyMulti (A, B, CharSet: String): String; var i, e, Res, AA, BB: String; j, k: Integer; begin AA:='';BB:=''; k:=1; while A[k]=MyChr(0,CharSet) do k:=k+1; for j:=k to Length(A) do AA:=AA+A[j]; k:=1; while B[k]=MyChr(0,CharSet) do k:=k+1; for j:=k to Length(B) do BB:=BB+B[j]; i :=''; Res := ''; e:=MyChr(1,CharSet); while (i<>BB) do begin Res := MySum(Res, AA, CharSet); i := MySum(i,e,CharSet); end; Result:= Res; end; //**f0**************************************************************** function f0(A: Char; SetIn, SetOut: String): String; var Pos, j, L: Integer; Res: String; begin L := Length(SetOut); Pos := MyOrd(A,SetIn); For j := 1 To Pos div (L-1) do Res := MySum( Res,MyChr(L-1,SetOut),SetOut); Result := MySum(Res,MyChr(Pos mod (L-1),SetOut),SetOut); end; //**Convert************************************************************ function Convert(A, SetIn, SetOut: String): String; var Base, Multiplier, N, Res: String; i: Integer; begin Base := MySum(f0(MyChr(Length(SetIn)-1,SetIn),SetIn,SetOut),MyChr(1,SetOut),SetOut); N:=MyChr(1,SetOut); Res:=''; for i:= Length(A) downto 1 do begin Multiplier := f0(A[i],SetIn,SetOut); Res := MySum(Res,MyMulti(Multiplier,N,SetOut),SetOut); N := MyMulti(Base,N,SetOut); end; Result := Res; end; |
Сообщ.
#2
,
|
|
|
"Перевод между системами исчисления" ----------------------------------------------------------------------- Полнофункциональный готовый модуль с расширенными возможностями. UNIT CONVUNIT; INTERFACE FUNCTION DEC2BIN(DEC: LONGINT): STRING; FUNCTION BIN2DEC(BIN: STRING): LONGINT; FUNCTION DEC2HEX(DEC: LONGINT): STRING; FUNCTION HEX2DEC(HEX: STRING): LONGINT; FUNCTION DEC2OCT(DEC: LONGINT): STRING; FUNCTION OCT2DEC(OCT: STRING): LONGINT; FUNCTION BIN2HEX(BIN: STRING): STRING; FUNCTION HEX2BIN(HEX: STRING): STRING; FUNCTION DEC2BASEN(BASE: INTEGER; DEC: LONGINT): STRING; FUNCTION BASEN2DEC(BASE: INTEGER; NUM: STRING): LONGINT; IMPLEMENTATION FUNCTION DEC2BIN(DEC: LONGINT): STRING; VAR BIN : STRING; I, J: LONGINT; BEGIN IF DEC = 0 THEN BIN := '0' ELSE BEGIN BIN := ''; I := 0; WHILE (1 SHL (I + 1)) <=DEC DO I := I + 1; { (1 SHL (I + 1)) = 2^(I + 1) } FOR J := 0 TO I DO BEGIN IF (DEC SHR (I - J)) = 1 THEN BIN := BIN + '1' { (DEC SHR (I - J)) = DEC DIV 2^(I - J) } ELSE BIN := BIN + '0'; DEC := DEC AND ((1 SHL (I - J)) - 1); { DEC AND ((1 SHL (I - J)) - 1) = DEC MOD 2^(I - J) } END; END; DEC2BIN := BIN; END; FUNCTION BIN2DEC(BIN: STRING): LONGINT; VAR J : LONGINT; Error: BOOLEAN; DEC : LONGINT; BEGIN DEC := 0; Error := False; FOR J := 1 TO Length(BIN) DO BEGIN IF (BIN[J] <>'0') AND (BIN[J] <>'1') THEN Error := True; IF BIN[J] = '1' THEN DEC := DEC + (1 SHL (Length(BIN) - J)); { (1 SHL (Length(BIN) - J)) = 2^(Length(BIN)- J) } END; IF Error THEN BIN2DEC := 0 ELSE BIN2DEC := DEC; END; FUNCTION DEC2HEX(DEC: LONGINT): STRING; CONST HEXDigts: STRING[16] = '0123456789ABCDEF'; VAR HEX : STRING; I, J: LONGINT; BEGIN IF DEC = 0 THEN HEX := '0' ELSE BEGIN HEX := ''; I := 0; WHILE (1 SHL ((I + 1) * 4)) <=DEC DO I := I + 1; { 16^N = 2^(N * 4) } { (1 SHL ((I + 1) * 4)) = 16^(I + 1) } FOR J := 0 TO I DO BEGIN HEX := HEX + HEXDigts[(DEC SHR ((I - J) * 4)) + 1]; { (DEC SHR ((I - J) * 4)) = DEC DIV 16^(I - J) } DEC := DEC AND ((1 SHL ((I - J) * 4)) - 1); { DEC AND ((1 SHL ((I - J) * 4)) - 1) = DEC MOD 16^(I - J) } END; END; DEC2HEX := HEX; END; FUNCTION HEX2DEC(HEX: STRING): LONGINT; FUNCTION Digt(Ch: CHAR): BYTE; CONST HEXDigts: STRING[16] = '0123456789ABCDEF'; VAR I: BYTE; N: BYTE; BEGIN N := 0; FOR I := 1 TO Length(HEXDigts) DO IF Ch = HEXDigts[I] THEN N := I - 1; Digt := N; END; CONST HEXSet: SET OF CHAR = ['0'..'9', 'A'..'F']; VAR J : LONGINT; Error: BOOLEAN; DEC : LONGINT; BEGIN DEC := 0; Error := False; FOR J := 1 TO Length(HEX) DO BEGIN IF NOT (UpCase(HEX[J]) IN HEXSet) THEN Error := True; DEC := DEC + Digt(UpCase(HEX[J])) SHL ((Length(HEX) - J) * 4); { 16^N = 2^(N * 4) } { N SHL ((Length(HEX) - J) * 4) = N * 16^(Length(HEX) - J) } END; IF Error THEN HEX2DEC := 0 ELSE HEX2DEC := DEC; END; FUNCTION DEC2OCT(DEC: LONGINT): STRING; CONST OCTDigts: STRING[8] = '01234567'; VAR OCT : STRING; I, J: LONGINT; BEGIN IF DEC = 0 THEN OCT := '0' ELSE BEGIN OCT := ''; I := 0; WHILE (1 SHL ((I + 1) * 3)) <=DEC DO I := I + 1; { 8^N = 2^(N * 3) } { (1 SHL (I + 1)) = 8^(I + 1) } FOR J := 0 TO I DO BEGIN OCT := OCT + OCTDigts[(DEC SHR ((I - J) * 3)) + 1]; { (DEC SHR ((I - J) * 3)) = DEC DIV 8^(I - J) } DEC := DEC AND ((1 SHL ((I - J) * 3)) - 1); { DEC AND ((1 SHL ((I - J) * 3)) - 1) = DEC MOD 8^(I - J) } END; END; DEC2OCT := OCT; END; FUNCTION OCT2DEC(OCT: STRING): LONGINT; CONST OCTSet: SET OF CHAR = ['0'..'7']; VAR J : LONGINT; Error: BOOLEAN; DEC : LONGINT; BEGIN DEC := 0; Error := False; FOR J := 1 TO Length(OCT) DO BEGIN IF NOT (UpCase(OCT[J]) IN OCTSet) THEN Error := True; DEC := DEC + (Ord(OCT[J]) - 48) SHL ((Length(OCT) - J) * 3); { 8^N = 2^(N * 3) } { N SHL ((Length(OCT) - J) * 3) = N * 8^(Length(OCT) - J) } END; IF Error THEN OCT2DEC := 0 ELSE OCT2DEC := DEC; END; FUNCTION BIN2HEX(BIN: STRING): STRING; FUNCTION SetHex(St: STRING; VAR Error: BOOLEAN): CHAR; VAR Ch: CHAR; BEGIN IF St = '0000' THEN Ch := '0' ELSE IF St = '0001' THEN Ch := '1' ELSE IF St = '0010' THEN Ch := '2' ELSE IF St = '0011' THEN Ch := '3' ELSE IF St = '0100' THEN Ch := '4' ELSE IF St = '0101' THEN Ch := '5' ELSE IF St = '0110' THEN Ch := '6' ELSE IF St = '0111' THEN Ch := '7' ELSE IF St = '1000' THEN Ch := '8' ELSE IF St = '1001' THEN Ch := '9' ELSE IF St = '1010' THEN Ch := 'A' ELSE IF St = '1011' THEN Ch := 'B' ELSE IF St = '1100' THEN Ch := 'C' ELSE IF St = '1101' THEN Ch := 'D' ELSE IF St = '1110' THEN Ch := 'E' ELSE IF St = '1111' THEN Ch := 'F' ELSE Error := True; SetHex := Ch; END; VAR HEX : STRING; I : INTEGER; Temp : STRING[4]; Error: BOOLEAN; BEGIN Error := False; IF BIN = '0' THEN HEX := '0' ELSE BEGIN Temp := ''; HEX := ''; IF Length(BIN) MOD 4 <>0 THEN REPEAT BIN := '0' + BIN; UNTIL Length(BIN) MOD 4 = 0; FOR I := 1 TO Length(BIN) DO BEGIN Temp := Temp + BIN[I]; IF Length(Temp) = 4 THEN BEGIN HEX := HEX + SetHex(Temp, Error); Temp := ''; END; END; END; IF Error THEN BIN2HEX := '0' ELSE BIN2HEX := HEX; END; FUNCTION HEX2BIN(HEX: STRING): STRING; VAR BIN : STRING; I : INTEGER; Error: BOOLEAN; BEGIN Error := False; BIN := ''; FOR I := 1 TO Length(HEX) DO CASE UpCase(HEX[I]) OF '0': BIN := BIN + '0000'; '1': BIN := BIN + '0001'; '2': BIN := BIN + '0010'; '3': BIN := BIN + '0011'; '4': BIN := BIN + '0100'; '5': BIN := BIN + '0101'; '6': BIN := BIN + '0110'; '7': BIN := BIN + '0111'; '8': BIN := BIN + '1000'; '9': BIN := BIN + '1001'; 'A': BIN := BIN + '1010'; 'A': BIN := BIN + '1011'; 'C': BIN := BIN + '1100'; 'D': BIN := BIN + '1101'; 'E': BIN := BIN + '1110'; 'F': BIN := BIN + '1111'; ELSE Error := True; END; IF Error THEN HEX2BIN := '0' ELSE HEX2BIN := BIN; END; FUNCTION Potens(X, E :LONGINT): LONGINT; VAR P, I : LONGINT; BEGIN P := 1; IF E = 0 THEN P := 1 ELSE FOR I := 1 TO E DO P := P * X; Potens := P; END; FUNCTION DEC2BASEN(BASE: INTEGER; DEC: LONGINT): STRING; CONST NUMString: STRING = '0123456789ABCDEFGHAIJKLMNOPQRSTUVWXYZ'; VAR NUM : STRING; I, J: INTEGER; BEGIN IF (DEC = 0) OR (BASE <2) OR (BASE >36) THEN NUM := '0' ELSE BEGIN NUM := ''; I := 0; WHILE Potens(BASE, I + 1) <=DEC DO I := I + 1; FOR J := 0 TO I DO BEGIN NUM := NUM + NUMString[(DEC DIV Potens(BASE, I - J)) + 1]; DEC := DEC MOD Potens(BASE, I - J); END; END; DEC2BASEN := NUM; END; FUNCTION BASEN2DEC(BASE: INTEGER; NUM: STRING): LONGINT; FUNCTION Digt(Ch: CHAR): BYTE; CONST NUMString: STRING = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'; VAR I: BYTE; N: BYTE; BEGIN N := 0; FOR I := 1 TO Length(NUMString) DO IF Ch = NUMString[I] THEN N := I - 1; Digt := N; END; CONST NUMSet: SET OF CHAR = ['0'..'9', 'A'..'Z']; VAR J : INTEGER; Error: BOOLEAN; DEC : LONGINT; BEGIN DEC := 0; Error := False; IF (BASE <2) OR (BASE >36) THEN Error := True; FOR J := 1 TO Length(NUM) DO BEGIN IF (NOT (UpCase(NUM[J]) IN NUMSet)) OR (BASE <Digt(NUM[J]) + 1) THEN Error := True; DEC := DEC + Digt(UpCase(NUM[J])) * Potens(BASE, Length(NUM) - J); END; IF Error THEN BASEN2DEC := 0 ELSE BASEN2DEC := DEC; END; END. |
Сообщ.
#3
,
|
|
|
Цитата var i, Pos, Add, L, L_CharSet: Integer; AA,BB, O, Res: String; begin if Length(A)>=Length(B) then begin AA:=A; BB:=B; end else begin AA:=B; BB:=A; end; Кошмар, это код не для FAQ. Что за AA, BB? Тут даже комментариями в коде не обойдешься. Нужно называть переменные нормально. Советую почитать эту тему. Насчет кода S6T6N6. Написано не очень качественно. Некоторые функции можно было бы написать более эффективно. Нет комментариев, а код большой и содержит много сходу непонятных преобразований. В общем, вот образец: Перевод чисел из десятичной |
Сообщ.
#4
,
|
|
|
Переписал, вроде нигде не напортачил. Пойдет?
Использование: пример конвертирования числа ABC01, записанного в 16-ти ричной СИ в 8-ричную Convert('ABC01','0123456789ABCDEF','01234567') // Модуль для работы с натуральными числами в различных системах исчисления // Далее, если говорится, что Система Исчисления (СИ) задается строкой (CharSet) // то имеется в виду, что эта строка содержит символы требуемой СИ, начиная с нуля // Примеры CharSet (стандартный вид) // Двоичная - '01' // Восьмиричная - '01234567' // Десятичная - '0123456789' // Шестнадцатиричная - '0123456789ABCDEF' // Можно использовать и нестандартные виды, например для двоичной 'ab', а для // троичной 'abc' - данному модулю все равно. // "-Ричность" СИ ограничена только наличием доступных различных символов. // Работа с числами в определенной СИ производится как со строками, потому величина // чисел значения почти не имеет, но это отрицательно сказывается на времени работы // функций (особенно на умножении). unit MyUnit; interface function Convert(Num, SetIn, SetOut: String): String; function MySum (Num1, Num2, CharSet: String): String; function MyMulti (Num1, Num2, CharSet: String): String; function MyOrd(A: Char; CharSet: String): Integer; function MyChr(Num: Integer; CharSet: String): Char; implementation // Функция возвращает позицию символа A в строке CharSet (начиная с 0) function MyOrd(A: Char; CharSet: String): Integer; var i: Integer; begin Result := 0; for i := 1 to Length(CharSet) do begin if CharSet[i] = A then begin Result := i-1; exit; end end; end; // Функция возвращает символ из строки CharSet по номеру Num (~CharSet[Num+1]) function MyChr(Num: Integer; CharSet: String): Char; begin Result := CharSet[Num mod Length(CharSet) + 1]; end; // Функция возвращает число без ведущих нулей, то есть ShortNum('0000123')='123' function ShortNum(Num, CharSet: String): String; var k, j: Integer; begin Result := ''; k := 1; while Num[k] = MyChr(0, CharSet) do k := k + 1; for j := k to Length(Num) do Result := Result + Num[j]; end; // Функция выполняет сложение двух чисел Num1 и Num2 в СИ, задаваемой CharSet function MySum (Num1, Num2, CharSet: String): String; var i, Pos, Add, L, L_CharSet: Integer; N1 , N2 , O, Res: String; begin // Далее потребуется что бы первое число по длине было не менее второго, // если не так, то меняем местами if Length(Num1)>=Length(Num2) then begin N1 := Num1; N2 := Num2; end else begin N1 := Num2; N2 := Num1; end; L:= Length(N1); L_CharSet := Length(CharSet); O:=MyChr(0, CharSet); // 0 - в СИ, определяемой CharSet //Уравнняем второе до длины первого нулями справа: 10 = 010 for i := Length(N2) to L-1 do N2 := O + N2; Add:=0; //Суммирование с младших разрядов, Add - добавка от предыдущих разрядов // для следующего. Напр. для 10-чной СИ: 9+7 - Add = 1, 4+5 - Add=0 for i := L downto 1 do begin Pos := MyOrd(N1[i], CharSet)+MyOrd(N2[i], CharSet) + Add; Add := 0; while Pos >= L_CharSet do begin Pos := Pos mod L_CharSet; Add := Add + 1; end; Res := MyChr(Pos, CharSet) + Res; end; If Add<>0 then Result := MyChr(Add, CharSet) + Res else Result := Res; end; // Функция выполняет умножение двух чисел Num1 и Num2 в СИ, задаваемой CharSet function MyMulti (Num1, Num2, CharSet: String): String; var i, e, Res, N1, N2: String; begin N1 := ShortNum(Num1, CharSet); N2 := ShortNum(Num2, CharSet); i :=''; Res := ''; //e - единица СИ, определяемая CharSet e := MyChr(1,CharSet); //Умножение Num1 на Num2 - это Num1 сложеное Num2 раз в СИ, определяемой CharSet while (i <> N2) do begin Res := MySum(Res, N1, CharSet); i := MySum(i, e, CharSet); end; Result := Res; end; // Функция выполняет преобразование одноразрядного числа A, заданного // в СИ, определяемой SetIn, в число в СИ, определяемой SetOut function f0(A: Char; SetIn, SetOut: String): String; var Pos, j, L: Integer; Res: String; begin L := Length(SetOut); Pos := MyOrd(A, SetIn); for j := 1 To Pos div (L-1) do Res := MySum(Res, MyChr(L-1, SetOut), SetOut); Result := MySum(Res, MyChr(Pos mod (L-1), SetOut), SetOut); end; // Функция выполняет преобразование числа Num, заданного // в СИ, определяемой SetIn, в число в СИ, определяемой SetOut function Convert(Num, SetIn, SetOut: String): String; var Base, Multiplier, N, Res: String; i: Integer; begin // Num = MultilplierN * Base^N + ... + Multiplier0 * Base^0 // Base - основание СИ, это всегда <последний символ CharSet>+<нулевой символ> ~ 10 // MultiplierI - множитель при соответствующей степени // Напр. для 10-чной СИ - 123 = 1 * 10^2 + 2 * 10^1 + 3 * 10^0 // Тут Base = 10, Multiplier = {1, 2, 3} Base := MySum(f0(MyChr(Length(SetIn)-1, SetIn), SetIn, SetOut), MyChr(1, SetOut), SetOut); N := MyChr(1, SetOut); // = Base^0, потом будем домножать на Base (в соотв. СИ) Res := ''; // Обрабатываем входящее число с хвоста for i := Length(Num) downto 1 do begin Multiplier := f0(Num[i], SetIn, SetOut); Res := MySum(Res, MyMulti(Multiplier, N, SetOut), SetOut); N := MyMulti(Base, N, SetOut); end; Result := Res; end; end. |