Zahlen umwandeln (Bin, Oct, Dec, Hex)

[Morlon]

Hi,

ich hab mir grad mühevoll ein kleines Progi geschrieben mit dem ich Binär, Oktal, Dezimal und HexaDezimal umwandeln kann wie ich lustig bin. Da ich das ohne eure schönes Forum hier nich geschafft hätte und da ich gesehn hab dass es x posts gibt in denen nach solchen umwandlungen gefragt wurde denk ich ist es nich mehr als fair wenn ich das progi mal poste
Die eine oder andere Zeile kommt euch sicherlich bekannt vor, aber alles in allem hab ichs doch irgendwie selbst zusammen geknaupt
Man kann sicherlich noch einiges dran optimieren, vor allem, weil ich noch nich so sehr viele befehle kenn, was man sicherlich auch merken wird, aber es funktioniert also hier mal der Quelltext:

Delphi-Quellcode:

unit Zahlwandler1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    GroupBox1: TGroupBox;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    RadioButton3: TRadioButton;
    RadioButton4: TRadioButton;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Edit1: TEdit;
    GroupBox2: TGroupBox;
    RadioButton5: TRadioButton;
    RadioButton6: TRadioButton;
    RadioButton7: TRadioButton;
    RadioButton8: TRadioButton;
    Label1: TLabel;
    procedure Button3Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

uses StrUtils;

  type typBin = Array[1..100] of Boolean;
  var arrBin: typBin;

{$R *.dfm}

//*************************************************************************
//                           ARRAY LEEREN
//*************************************************************************
procedure ArrClear(PArr: typBin);
var i: integer;
begin
  for i := 1 to 100 do arrBin[i] := False;
end;

//*************************************************************************
//                           POTENZIEREN
//*************************************************************************
function potenziren(FWert: integer): integer;
var i: integer;
begin
  if FWert = 0 then result := 1 else result := 2;
  for i := 1 to FWert - 1 do result := result * 2;
end;

//*************************************************************************
//                            Dezimal => Binär
//*************************************************************************
function FDecToBin(FWert: String): String;
var i, FIntWert, Counter, BinStellen: Integer;
    bolSchleife, bolErstlauf: Boolean;
begin
  Result := '';
  bolErstlauf := True;
  FIntWert := StrToInt(FWert);
  while FIntWert > 0 do
    begin
      i := 1;
      Counter := 0;
      bolSchleife := True;
      while bolSchleife = True do
        begin
          if i * 2  <= FIntWert then
            i := i * 2
          else
            bolSchleife := False;
          Counter := Counter + 1;
        end;
      if bolErstlauf = true then BinStellen := Counter;
      bolErstlauf := False;
      arrBin[Counter] := True;
      FIntWert := FIntWert - i;
    end;
  for i := BinStellen  downto 1 do
    if arrBin[i] = true then Result := Result + '1' else Result := Result + '0';
  ArrClear(arrBin);
end;

//*************************************************************************
//                            HexaDezimal => Dezimal
//*************************************************************************
function FHexToDec(FWert: String): String;
begin
  FWert := '$' + FWert;
  Result := InttoStr(StrToInt(FWert));
end;

//*************************************************************************
//                            Oktal => Dezimal
//*************************************************************************
function FOctToDec(FWert: String): String;
var i, ZwErg: Integer;
begin 
  ZwErg := 0;
  for i := 1 to Length(FWert) do
    begin
      ZwErg := ZwErg * 8 +(Byte(FWert[i]) - Byte('0'));
    end;
  Result := IntToStr(ZwErg);
end;

//*************************************************************************
//                            Dezimal => Oktal
//*************************************************************************
function FDecToOct(FWert: String): String;
var ZwErg1: Integer;
    ZwErg2: String;
    FIntWert: Integer;
begin
  FIntWert := StrToInt(FWert);
  ZwErg2 := '';
  while FIntWert > 0 do
    begin
      ZwErg1 := FIntWert mod 8;
      FIntWert := FIntWert div 8;
      ZwErg2 := IntToStr(ZwErg1) + ZwErg2;
  end;
  Result := ZwErg2;
end;

//*************************************************************************
//                            Binär => Dezimal
//*************************************************************************
function FBinToDec(FWert: String): String;
var i, ZwErg: integer;
begin
  ZwErg := 0;
  for i := 1 to Length(FWert) do
    ZwErg := ZwErg + strtoint(FWert[i]) * potenziren(Length(FWert)-i);
  Result := inttostr(ZwErg);
end;

//*************************************************************************
//                            Binär => HexaDezimal
//*************************************************************************
function FBinToHex(FWert: String): String;
var ZwErgStr: String;
    ZwErgInt: Double;
    arrIndex: Integer;
const arrHex: array[0..15] of Char = ('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F');
begin
  while Length(FWert) > 0 do
      if Length(FWert) > 4 then
        begin
          ZwErgInt := strtoint(FBinToDec(RightStr(FWert,4)));
          FWert := LeftStr(FWert,Length(FWert)-4);
          ZwErgStr := FloatToStr(ZwErgInt);
          arrIndex := Strtoint(ZwErgStr);
          Result := arrHex[arrIndex] + Result;
        end
      else
        begin
          ZwErgInt := strtoint(FBinToDec(FWert));
          FWert := '';
          ZwErgStr := FloatToStr(ZwErgInt);
          arrIndex := Strtoint(ZwErgStr);
          Result := arrHex[arrIndex] + Result;
        end
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  close;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  RadioButton1.Checked := True;
  RadioButton5.Checked := True;
  Label1.Caption := '';
  Edit1.Clear;
end;

procedure TForm1.Button1Click(Sender: TObject);
var i: integer;
    bolPruef: Boolean;
begin

  bolPruef := True;

  if RadioButton1.Checked = true then
    begin
      for i := 1 to Length(Edit1.Text) do
        if Edit1.Text[i] <> '0' then
          if Edit1.Text[i] <> '1' then
            bolPruef := False;
      if bolPruef = True then
        begin
          if RadioButton5.Checked = true then Label1.Caption := Edit1.Text;
          if RadioButton6.Checked = true then Label1.Caption := FDecToOct(FBinToDec(Edit1.Text));
          if RadioButton7.Checked = true then Label1.Caption := FBinToDec(Edit1.Text);
          if RadioButton8.Checked = true then Label1.Caption := FBinToHex(Edit1.Text);
        end
      else
        Label1.Caption := 'Wert nicht Binär';
    end;

  if RadioButton2.Checked = true then
    begin
      for i := 1 to Length(Edit1.Text) do
        if Edit1.Text[i] <> '0' then
          if Edit1.Text[i] <> '1' then
            if Edit1.Text[i] <> '2' then
              if Edit1.Text[i] <> '3' then
                if Edit1.Text[i] <> '4' then
                  if Edit1.Text[i] <> '5' then
                    if Edit1.Text[i] <> '6' then
                      if Edit1.Text[i] <> '7' then
                       bolPruef := False;
      if bolPruef = True then
        begin
          if RadioButton5.Checked = true then Label1.Caption := FDecToBin(FOctToDec(Edit1.Text));
          if RadioButton6.Checked = true then Label1.Caption := Edit1.Text;
          if RadioButton7.Checked = true then Label1.Caption := FOctToDec(Edit1.Text);
          if RadioButton8.Checked = true then Label1.Caption := FBinToHex(FDecToBin(FOctToDec(Edit1.Text)));
        end
      else
        Label1.Caption := 'Wert nicht Oktal';
    end;

  if RadioButton3.Checked = true then
    begin
      for i := 1 to Length(Edit1.Text) do
        if Edit1.Text[i] <> '0' then
          if Edit1.Text[i] <> '1' then
            if Edit1.Text[i] <> '2' then
              if Edit1.Text[i] <> '3' then
                if Edit1.Text[i] <> '4' then
                  if Edit1.Text[i] <> '5' then
                    if Edit1.Text[i] <> '6' then
                      if Edit1.Text[i] <> '7' then
                        if Edit1.Text[i] <> '8' then
                          if Edit1.Text[i] <> '9' then
                            bolPruef := False;
      if bolPruef = True then
        begin
      if RadioButton5.Checked = true then Label1.Caption := FDecToBin(Edit1.Text);
      if RadioButton6.Checked = true then Label1.Caption := FDecToOct(Edit1.Text);
      if RadioButton7.Checked = true then Label1.Caption := Edit1.Text;
      if RadioButton8.Checked = true then Label1.Caption := FBinToHex(FDecToBin(Edit1.Text));
        end
      else
        Label1.Caption := 'Wert nicht Dezimal';
    end;

  if RadioButton4.Checked = true then
    begin
      for i := 1 to Length(Edit1.Text) do
        if Edit1.Text[i] <> '0' then
          if Edit1.Text[i] <> '1' then
            if Edit1.Text[i] <> '2' then
              if Edit1.Text[i] <> '3' then
                if Edit1.Text[i] <> '4' then
                  if Edit1.Text[i] <> '5' then
                    if Edit1.Text[i] <> '6' then
                      if Edit1.Text[i] <> '7' then
                        if Edit1.Text[i] <> '8' then
                          if Edit1.Text[i] <> '9' then
                            if Edit1.Text[i] <> 'A' then
                              if Edit1.Text[i] <> 'B' then
                                if Edit1.Text[i] <> 'C' then
                                  if Edit1.Text[i] <> 'D' then
                                    if Edit1.Text[i] <> 'E' then
                                      if Edit1.Text[i] <> 'F' then
                                        if Edit1.Text[i] <> 'a' then
                                          if Edit1.Text[i] <> 'b' then
                                            if Edit1.Text[i] <> 'c' then
                                              if Edit1.Text[i] <> 'd' then
                                                if Edit1.Text[i] <> 'e' then
                                                  if Edit1.Text[i] <> 'f' then
                                                    bolPruef := False;
      if bolPruef = True then
        begin
      if RadioButton5.Checked = true then Label1.Caption := FDecToBin(FHexToDec(Edit1.Text));
      if RadioButton6.Checked = true then Label1.Caption := FDecToOct(FHexToDec(Edit1.Text));
      if RadioButton7.Checked = true then Label1.Caption := FHexToDec(Edit1.Text);
      if RadioButton8.Checked = true then Label1.Caption := Edit1.Text;
        end
      else
        Label1.Caption := 'Wert nicht Hexa';
    end;
end;

end.

Um das Ding zum laufen zu bekommen braucht ihr 3 Buttons (Button1 = Ausgabe, Button2 = Clear, Button3 = Beenden), 8 RadioButtons (1-4 Bin, Oct, Dez, Hex eingabewert, 5-8 Bin, Oct, Dez, Hex ausgabewert), ein editfeld zur eingabe und ein label zur ausgabe.... ich hab noch 2 groupbox drin, damits schön aussieht, könnt ihr aber auch rausschmeißen ;P

Viel Spaß damit...
Elmar