Валентин Озеров - Советы по Delphi. Версия 1.0.6 Страница 2

Домашние страницы

Русскоязычные

Алгоритмы

Преобразования

HEX→Integer

var

 i: integer;

 s: string;

begin

 s:= '$' + ThatHexString;

 i:= StrToInt(a);

end;

CONST HEX: ARRAY['A'..'F'] OF INTEGER = (10,11,12,13,14,15);

VAR str : String;

 Int, i: integer;

BEGIN

 READLN(str);

 Int:= 0;

 FOR i:= 1 TO length(str) DO

  IF str[i] < 'a' THEN Int:= Int * 16 + ord(str[i]) – 48

  ELSE Int:= Int * 16 + hex[str[i]];

 WRITELN(Int);

 READLN;

END.

Преобразование десятичного числа в шестнадцатиричное

Самое простое преобразование – через строку.

HexString:= Format('%0x', DecValue);

Преобразование ASCII в шестнадцатиричное представление

Строка представляет собой массив байтов в виде ASCII-символов. Необходимо организовать преобразование типов по аналогии с Delphi-функциями Ord и Chr.

Функция BytesToHexStr преобразует, к примеру, набор байтов [0,1,1,0] в строку '30313130', HexStrToBytes выполнит обратное преобразование.

unit Hexstr;

interface

uses String16, SysUtils;

Type

 PByte = ^BYTE;

procedure BytesToHexstr(var hHexStr: String; pbyteArray: PByte; InputLength: WORD);

procedure HexStrToBytes(hHexStr: String; pbyteArray: Pointer);

procedure HexBytesToChar(var Response: String; hexbytes: PChar; InputLength: WORD);

implementation

procedure BytesToHexStr(var hHexStr: String; pbyteArray: PByte; InputLength: WORD);

Const

 HexChars : Array[0..15] of char = '0123456789ABCDEF';

var

 i, j: WORD;

begin

 SetLength(hHexStr, (InputLength * 2));

 FillChar(hHexStr, sizeof(hHexStr), #0);

 j:= 1;

 for i := 1 to InputLength  do begin

  hHexStr[j]:= Char(HexChars[pbyteArray^ shr  4]); inc(j);

  hHexStr[j]:= Char(HexChars[pbyteArray^ and 15]); inc(j);

  inc(pbyteArray);

 end;

end;

procedure HexBytesToChar(var Response: String; hexbytes: PChar; InputLength: WORD);

var

 i: WORD;

 c: byte;

begin

 SetLength(Response, InputLength);

 FillChar(Response, SizeOf(Response), #0);

 for i:= 0 to (InputLength – 1) do begin

  c:= BYTE(HexBytes[i]) And BYTE($f);

  if c > 9 then Inc(c, $37)

  else Inc(c, $30);

  Response[i + 1]:= char(c);

 end;{for}

end;

procedure HexStrToBytes(hHexStr: String; pbyteArray: Pointer);

{pbyteArray указывает на область памяти, хранящей результаты}

var

 i, j: WORD;

 tempPtr: PChar;

 twoDigits: String[2];

begin

 tempPtr:= pbyteArray;

 j:= 1;

 for i:= 1 to (Length(hHexStr) DIV 2) do begin

  twoDigits:= Copy(hHexStr, j, 2); Inc(j, 2);

  PByte(tempPtr)^:= StrToInt('$' + twoDigits); Inc(tempPtr);

 end;{for}

end;

end.

UNIT string16.

interface

{$IFNDEF Win32}

procedure SetLength(var S: string; Len: Integer);

procedure SetString(var Dst: string; Src: PChar; Len: Integer);

{$ENDIF}

implementation

{$IFNDEF Win32}

procedure SetLength(var S: string; Len: Integer);

begin

 if len > 255 then S[0]:= Chr(255)

 else S[0]:= Chr(Len)

end;

procedure SetString(var Dst: string; Src: PChar; Len: Integer);

begin

 if Len > 255 then Move(Src^, Dst[1], 255)

 else Move(Src^, Dst[1], Len);

 SetLength(Dst, Len);

end;

{$ENDIF}

end.

Преобразование двоичного числа в десятичное

Может ли кто-нибудь дать мне идею простого преобразования двоичного кода (base2) в десятичный (base10)?

/////////////////////////////////////////////////////////////////////////

// преобразование 32-битного base2 в 32-битный base10                  //

// максимальное число = 99 999 999, возвращает –1 при большем значении //

/////////////////////////////////////////////////////////////////////////

function base10(base2:integer) : integer; assembler;

asm

 cmp        eax,100000000        // проверка максимального значения

 jb         @1                   // значение в пределах допустимого

 mov        eax,-1               // флаг ошибки

 jmp        @exit                // выход если –1

@1:

 push       ebx                  // сохранение регистров

 push       esi

 xor        esi,esi              // результат = 0

 mov        ebx,10               // вычисление десятичного логарифма

 mov        ecx,8                // преобразование по формуле 10^8-1

@2:

 mov        edx,0                // удаление разницы

 div        ebx                  // eax – целочисленное деление на 10, edx – остаток от деления на 10

 add        esi,edx              // результат = результат + разность[I]

 ror        esi,4                // перемещение разряда

 loop       @2                   // цикл для всех 8 разрядов

 mov        eax,esi              // результат функции

 pop        esi                  // восстанавление регистров

 pop        ebx

@exit:

end;

function IntToBin(Value: Longint; Size: Integer): String;

var

 i: Integer;

begin

 Result :='';

 for i:= Size downto 0 do begin

  if value and (1 shl i)<>0 then begin

   Result:= Result+'1';

  end else begin

   Result:= Result+'0';

  end;

 end;

end;

Function BinToInt(Value: String): Longint;

var

 i,Size: Integer;

begin

 Result:= 0;

 Size:= Length(Value);

 for i:=Size downto 0 do begin

  if copy(value,i,1) = '1' then begin

   Result:= Result + (1 shl i);

  end;

 end;

end;

Следующая функция получает в качестве параметра Base (1..16) любую десятичную величину и возвращает результат в виде строки, содержащей точное значение BaseX. Вы можете использовать данный алгоритм для преобразования арабских чисел в римские (смотри ниже).

function DecToBase(Decimal: Longint; const Base: Byte): String;

const Symbols: String[16] = '0123456789ABCDEF';

var

 scratch: String;

 remainder: Byte;

begin

 scratch:= '';

 repeat

  remainder:= Decimal mod base;

  scratch:= Symbols[remainder + 1] + scratch;

  Decimal:= Decimal div base;

 until (decimal = 0);

 Result:= scratch;

end;

Передайте данной функции любую десятичную величину (1…3999), и она возвратит строку, содержащую точное значение в римской транскрипции.

function DecToRoman(Decimal: Longint ): String;

const Romans: Array[1..13] of String = ('I', 'IV', 'V', 'IX', 'X', 'XL', 'L', 'XC', 'C', 'CD', 'D', 'CM', 'M');

 Arabics: Array[1..13] of integer = (1, 4, 5, 9, 10, 40, 50, 90, 100, 400, 500, 900, 1000);

var

 i: Integer;

 scratch: String;

begin

 scratch:= '';

 for i := 13 downto 1 do

  while (decimal >= arabics[i]) do begin

   Decimal:= Decimal – Arabics[i];

   scratch:= scratch + Romans[i];

  end;

 Result:= scratch;

end;

Преобразование ICO в BMP

Попробуйте:

var

 Icon: TIcon;

 Bitmap: TBitmap;

begin

 Icon:= TIcon.Create;

 Bitmap:= TBitmap.Create;

 Icon.LoadFromFile('c:\picture.ico');

 Bitmap.Width:= Icon.Width;

 Bitmap.Height:= Icon.Height;

 Bitmap.Canvas.Draw(0, 0, Icon);

 Bitmap.SaveToFile('c:\picture.bmp');

 Icon.Free;

 Bitmap.Free;

end;

Способ преобразования изображения размером 32×32 в иконку.

unit main;

interface

uses

 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,Dialogs,ExtCtrls, StdCtrls;

type TForm1 = class(TForm)

 Button1: TButton;

 Image1: TImage;

 Image2: TImage;

 procedure Button1Click(Sender: Tobject);

 procedure FormCreate(Sender: Tobject);

private

 { Private declarations }

public

 { Public declarations }