Tips dan Trik Delphi

function DecToRoman(Decimal: Longint): string;
const
  Numbers: array[1..13] of Integer =
    (1, 4, 5, 9, 10, 40, 50, 90, 100,
    400, 500, 900, 1000);
  Romans: array[1..13] of string =
    ('I', 'IV', 'V', 'IX', 'X', 'XL',
    'L', 'XC', 'C', 'CD', 'D', 'CM', 'M');
var
  i: Integer;
begin
  Result := '';
  for i := 13 downto 1 do
    while (Decimal >= Numbers[i]) do
    begin
      Decimal := Decimal - Numbers[i];
      Result  := Result + Romans[i];
    end;
end;

function OctToInt(Value: string): Longint;
var 
  i: Integer;
  int: Integer;
begin
  int := 0;
  for i := 1 to Length(Value) do
  begin
    int := int * 8 + StrToInt(Copy(Value, i, 1));
  end;
  Result := int;
end;

function IntToOct(Value: Longint; digits: Integer): string;
var
  rest: Longint;
  oct: string;
  i: Integer;
begin
  oct := '';
  while Value <> 0 do
  begin
    rest  := Value mod 8;
    Value := Value div 8;
    oct := IntToStr(rest) + oct;
  end;
  for i := Length(oct) + 1 to digits do
    oct := '0' + oct;
  Result := oct;
end;

function GetDateMMDDYYYY(TheDate: TDatetime):Str10;
begin
   DecodeDate(TheDate,vYY,vMM,vDD);
   Result:=IntToStr(vMM)+'/'+IntToStr(vDD)+'/'+IntToStr(vYY);
end;

function ToBin(Value: Byte; Splitter: Char): string;
var
  val, bit, intX: Byte;
begin
  val := Value;
  for intX := 0 to 7 do
  begin   //Alle 8 Bits durchlaufen
    bit := 48;    //48 (='0') zu bit
    val := val shr 1; //Value um 1 Bit nach rechts verschieben
    asm
   adc bit,0   //CarryFlag zu bit addieren
  end;
    if intX = 4 then Result := Splitter + Result;
    Result := Chr(bit) + Result;   //zu Result hinzufügen
  end;
end;
{------------------------------------------------------------------------------}

function ToBin(Value: Word; Splitter: Char): string;
begin
  Result := ToBin(Byte(Hi(Value)), Splitter) + Splitter + ToBin(Byte(Lo(Value)), Splitter);
end;
{------------------------------------------------------------------------------}

function BinTo(Value: string): Cardinal;
var
  intX, PosCnt: Byte;
begin
  Result := 0;
  PosCnt := 0;
  for intX := Length(Value) - 1 downto 0 do //zeichen von rechts durchlaufen
    case Value[intX + 1] of   //prüfen, ob 0 oder 1
      '0': Inc(PosCnt);  //bei 0 nur Pos-Zähler erhöhen
      '1':
        begin  //bei 1 Bit an Position einfügen
          Result := Result or (1 shl PosCnt);
          Inc(PosCnt); //und Zähler erhöhen
        end;
    end;
end;

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;

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;

procedure TForm1.Button1Click(Sender: TObject);
begin
  label1.Caption := IntToStr(StrToInt('$AFFE')); //45054
end;

function FacIterative(n: Word): Longint;
var
  f: LongInt;
  i: Integer;
begin
  f := 1;
  for i := 2 to n do f := f * i;
  Result := f;
end;

function FacRecursive(n: Word): LongInt;
begin
  if n > 1 then
    Result := n * FacRecursive(n-1)
  else
    Result := 1;
end;