![]() |
| ||
|
|
Новости |
Поиск |
FAQ |
Статьи |
Книги |
Новости VCL
| | Форумы ЧАТ |
Орешник |
|
| |||
| |||
« предыдущая ветвь | форум | следующая ветвь »
Перевод из двоичной в 16-ю [D6, D7, XP]
maxXP © (2007-03-14 17:28:00)Подскажите есть ли встроенная функция перевода из двоичной в шесн-ю?
maxXP (2007-03-26 12:45:00) [1]И завершаем наш занимательный диспут
данным юнитом. Надеюсь кому-нибудь понадобится/
Взято отсюда http://articles.org.ru/cfaq/index.php?qid=2133&catid=34
\\Перевод между системами счисления
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;
{ this function converts numbers from decimal (base 10 notation) to
different systems of notation. valid systems are from base 2 notation
to base 36 notation }
function basen2dec(base: integer; num: string): longint;
{ this function converts numbers from different systems of notation
to decimal (base 10 notation). valid systems are from base 2 notation
to base 36 notation }
....
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;
...
maxXP (2007-03-26 12:42:00) [2]И завершаем наш занимательный диспут
данным юнитом. Надеюсь кому-нибудь понадобится/
Взято отсюда http://articles.org.ru/cfaq/index.php?qid=2133&catid=34
\\Перевод между системами счисления
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;
{ this function converts numbers from decimal (base 10 notation) to
different systems of notation. valid systems are from base 2 notation
to base 36 notation }
function basen2dec(base: integer; num: string): longint;
{ this function converts numbers from different systems of notation
to decimal (base 10 notation). valid systems are from base 2 notation
to base 36 notation }
....
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;
...
Johnmen (2007-03-23 19:39:00) [3]
> - Удачи вам и ОБЯЗАТЕЛЬНО познакомтесь с ФАНАТОМ и пхпклуба!
Ты и там зажигаешь?
maxXP (2007-03-23 17:28:00) [4]
> Alexdeil
,
> Хаванагил
Большое спасибо. Все как надо.
> Сергей М
,
> Плохиш
- Удачи вам и ОБЯЗАТЕЛЬНО познакомтесь с ФАНАТОМ и пхпклуба!
Хаванагил (2007-03-23 17:18:00) [5]по моему так красивее =)
function BinToInt(bin: string): integer;
var
i, p: integer;
begin
p := 1;
for i := Length(bin) downto 1 do
begin
if bin[i] = '1' then Inc(Result, p);
p := p shl 1;
end;
end;
Сергей М. (2007-03-23 17:13:00) [6]
> maxXP © (23.03.07 17:07) [27]
> в исходной функции засылки в лпт используется 16-ная
Да нам, понимаешь ли, "фиолетово", что там "использует" твоя фунцкия какой-то там "засылки" в какой-то там "лпт")
У тебя отсутствуют базовыезнания - какой тут, нахрен, "лпт" может быть ?)...
Alexdeil (2007-03-23 17:12:00) [7]Умников слишком много, дерзайте (а как из int в Hex, я думаю Вы знаете) :
// Binary to Integer
function BinToInt(Value: string): Integer;
var
i, iValueSize: Integer;
begin
Result := 0;
iValueSize := Length(Value);
for i := iValueSize downto 1 do
if Value[i] = '1' then Result := Result + (1 shl (iValueSize - i));
end;
function HexToBin(Hexadecimal: string): string;
const
BCD: array [0..15] of string =
('0000', '0001', '0010', '0011', '0100', '0101', '0110', '0111',
'1000', '1001', '1010', '1011', '1100', '1101', '1110', '1111');
var
i: integer;
begin
for i := Length(Hexadecimal) downto 1 do
Result := BCD[StrToInt('$' + Hexadecimal[i])] + Result;
end;
// Integer to Binary
function IntToBin1(Value: Longint; Digits: Integer): string;
var
i: Integer;
begin
Result := '';
for i := Digits downto 0 do
if Value and (1 shl i) <> 0 then
Result := Result + '1'
else
Result := Result + '0';
end;
function IntToBin2(d: Longint): string;
var
x, p: Integer;
bin: string;
begin
bin := '';
for x := 1 to 8 * SizeOf(d) do
begin
if Odd(d) then bin := '1' + bin
else
bin := '0' + bin;
d := d shr 1;
end;
Delete(bin, 1, 8 * ((Pos('1', bin) - 1) div 8));
Result := bin;
end;
maxXP (2007-03-23 17:07:00) [8]
> Сергей М
Специально для сергея потому-что в исходной функции засылки в лпт используется 16-ная.
Странно а я думал что вы телепаты.
Плохиш (2007-03-23 17:07:00) [9]
> maxXP © (23.03.07 17:05) [25]
Понятно, значит и фраза " когда я отвечаю на вопросы в своей области знаний я не издеваюсь" такое же враньё, что и про экономиста...
maxXP (2007-03-23 17:05:00) [10]НЕ ФЛУДИТЕ. ЭТОТ ФОРУМ ДЛЯ ЛЮБЫХ ВОПРОСОВ! Нет желания не отвечайте.
> Плохиш ©
Закопай на поле чудес и вырастит деревце =))))))))
Сергей М. (2007-03-23 17:01:00) [11]
> maxXP © (23.03.07 16:54) [22]
>
> Ой рассмешили!
>
> *Может я экономист.
Ну и нахрена экономисту нужны преобразования между различными системами представления чисел ?)
Чем традиционная обезъянья десятичная не угодила ?
Поясни ...
Плохиш (2007-03-23 16:58:00) [12]
> maxXP © (23.03.07 16:54) [22]
> Ой рассмешили!
>
> *Может я экономист.
Не верю.
> но когда я отвечаю на вопросы в своей области знаний я не
> издеваюсь
Ответь на вопрос, сколько я должен потратить денег через полчаса, чтобы через час у меня было денег в 5 раз больше?
maxXP (2007-03-23 16:54:00) [13]Ой рассмешили!
*Может я экономист.
*Во вторых я умею делать преобразования ,но может есть чтонить готовое.
*Я не программист по образованию поэтому и прошу помощи, просто надо подправить кое что
* Ребята вы чего Конференция для начинающих, а также для тех, кому сложно объяснить чего он хочет. Просьба к участникам быть взаимовежливыми, профессионалам отдельная просьба - быть снисходительными. Пожалуйста ударение на снисходительными.
Ну напишу сам функцию БЕЗ проблем, но когда я отвечаю на вопросы в своей области знаний я не издеваюсь =)
Добрее надо быть.
Плохиш (2007-03-23 16:53:00) [14]
> Мож оно арбузолитейное
Вот и пусть льёт свои арбузы, хотя, думается, что от-туда его уже выперли и он решил, что программером самое то :@
Сергей М. (2007-03-23 16:51:00) [15]
> Плохиш © (23.03.07 16:46) [19]
>
> Афигеть, человек с высшим образованием
Мож оно арбузолитейное ?)
Плохиш (2007-03-23 16:46:00) [16]Афигеть, человек с высшим образованием (по анкете) не умеет скадывать степени двойки, не говоря уж о преобразовании чисел в разные системы счисления. И ещё смеет прикрываться термином "начинающий" :-(
maxXP, тебе до начинающего как ползком до южного полюса...
Сергей М. (2007-03-23 16:43:00) [17]
> maxXP © (23.03.07 16:38) [16]
> BinToInt - такой функции нет
Угу, нет.
И BinToХрен() - такой функции тоже нет.
ЧТО тебе мешает ее реализовать самому ?)
Хаванагил (2007-03-23 16:40:00) [18]
> maxXP © (23.03.07 16:38) [16]
ну напиши :)
maxXP (2007-03-23 16:38:00) [19]
> Хаванагил
BinToInt- такой функции нет
Хаванагил (2007-03-23 16:37:00) [20]
> Сергей М. © (23.03.07 16:34) [14]
что не так?