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.