|
Registriert seit: 15. Dez 2004 Ort: Dillingen 38 Beiträge Delphi 7 Professional |
#1
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 ![]()
Delphi-Quellcode:
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
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. Viel Spaß damit... Elmar |
![]() |
Themen-Optionen | Thema durchsuchen |
Ansicht | |
ForumregelnEs ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.
BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus. Trackbacks are an
Pingbacks are an
Refbacks are aus
|
|
Nützliche Links |
Heutige Beiträge |
Sitemap |
Suchen |
Code-Library |
Wer ist online |
Alle Foren als gelesen markieren |
LinkBack |
![]() |
![]() |