Советы по Delphi. Версия 1.0.6 - [3]

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)?

Решение 1

/////////////////////////////////////////////////////////////////////////
// преобразование 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;

Решение 2

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;

Решение 3

Следующая функция получает в качестве параметра 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

Решение 1

Попробуйте:

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;

Решение 2

Способ преобразования изображения размером 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 }
end;

var
 Form1: TForm1;

implementation
{$R *.DFM}

Procedure Tform1.Button1Click(Sender: Tobject);
 var winDC, srcdc, destdc : HDC;
 oldBitmap : HBitmap;
 iinfo : TICONINFO;
begin
 GetIconInfo(Image1.Picture.Icon.Handle, iinfo);
 WinDC:= getDC(handle);
 srcDC:= CreateCompatibleDC(WinDC);
 destDC:= CreateCompatibleDC(WinDC);
 oldBitmap:= SelectObject(destDC, iinfo.hbmColor);
 oldBitmap:= SelectObject(srcDC, iinfo.hbmMask);
 BitBlt(destdc, 0, 0, Image1.picture.icon.width, Image1.picture.icon.height, srcdc, 0, 0, SRCPAINT);
 Image2.picture.bitmap.handle := SelectObject(destDC, oldBitmap);
 DeleteDC(destDC);
 DeleteDC(srcDC);
 DeleteDC(WinDC);
 image2.Picture.Bitmap.savetofile(ExtractFilePath(Application.ExeName) + 'myfile.bmp');
end;

Procedure Tform1.FormCreate(Sender: Tobject);
begin
 image1.picture.icon.loadfromfile('c:\myicon.ico');
end;

end.

Unix-строки (чтение и запись Unix-файлов)

Данный модуль позволяет читать и записывать файлы формата Unix.