Conversion of (hex bin oct) to each other

Télécharger le projet
Commenter

Description

Convert Text Instead of Numbers

in this example i convert a big value witch the calculator can not do
here i changed the rule of conversion, instead of converting a big type such as int64 or cardinal... i convert the string characters and i rarly use numbers.

Source / Exemple : 


unit Main;

interface

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

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Edit2: TEdit;
    GroupBox1: TGroupBox;
    ComboBox1: TComboBox;
    ComboBox2: TComboBox;
    Label1: TLabel;
    Label2: TLabel;
    procedure Edit1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
    procedure FormCreate(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
    FirstNum : Boolean;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = 46 then
    Begin
      FirstNum := True;
      Edit1.Text := '0';
      Edit2.Text := '0';
    End;
end;

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
  if FirstNum then
    Begin
      Case ComboBox1.ItemIndex of
        0 : if Key in ['0'..'7'] then Edit1.Text := Key
              else
                beep;
        1 : if Key in ['0'..'1'] then Edit1.Text := Key
              Else
                Beep;
        2 : if Key in ['0'..'9', 'A'..'F'] then Edit1.Text := Key
              Else
                Beep;
      End;
    End
      Else

      Case ComboBox1.ItemIndex of
        0 : if Key in ['0'..'7'] then Edit1.Text := Edit1.Text + Key
              Else
                Beep;
        1 : if Key in ['0'..'1'] then Edit1.Text := Edit1.Text + Key
              Else
                Beep;
        2 : if Key in ['0'..'9', 'A'..'F'] then Edit1.Text := Edit1.Text + Key
              Else
                Beep;
      End;

      Case ComboBox1.ItemIndex of
        0 : if Key in ['0'..'7'] then FirstNum := False;
        1 : if Key in ['0'..'1'] then FirstNum := False;
        2 : if Key in ['0'..'9', 'A'..'F'] then FirstNum := False;
      End;

  // Here we choose witch way of conversion should be..
  Case ComboBox1.ItemIndex of
    0 : Case ComboBox2.ItemIndex of
          1 : Edit2.Text := OctToBin(Edit1.Text);
          2 : Edit2.Text := OctToHex(Edit1.Text);
        End;

    1 : Case ComboBox2.ItemIndex of
          0 : Edit2.Text := BinToOct(Edit1.Text);
          2 : Edit2.Text := BinToHex(Edit1.Text);
        End;

    2 : Case ComboBox2.ItemIndex of
          0 : Edit2.Text := HexToOct(Edit1.Text);
          1 : Edit2.Text := HexToBin(Edit1.Text);
        End;
  End;

  if ComboBox1.ItemIndex = ComboBox2.ItemIndex then
     Edit2.Text := Edit1.Text;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FirstNum := True;
  ComboBox1.ItemIndex := 0;
  ComboBox2.ItemIndex := 2;
end;

procedure TForm1.ComboBox1Change(Sender: TObject);
begin
  FirstNum := True;
  Edit1.Text := '0';
  Edit2.Text := '0';
end;

end.

unit MathUtils;

interface
  Uses
    SysUtils, StrUtils;

  function Bin(X : Word) : Integer;
  Function BinToOther(S : String) : BYTE;
  function BinToOct(S : String) : String;
  function BinToHex(S : String) : String;
  function Order(C : Char) : Integer;
  function OneHexToBin(C : Char) : String;
  function HexToBin(S : String) : String;
  function OneOctToBin(C : Char) : String;
  function OctToBin(S : String) : String;
  function HexToOct(S : String) : String;
  function OctToHex(S : String) : String;

  {OctToHex
   HexToOct
   OctToBin
   HexToBin
   BinToHex
   BinToOct}

implementation

Const
  H : Array[0..15] of Char = ('0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'A', 'B', 'C', 'D', 'E', 'F');

function Bin(X : Word) : Integer;
Var
  I : Integer;
begin
  Result := 0;
  for I := 0 to X do
    begin
      Result := Result + Result;
      if I = 1 then Result := 1;
    end;
end;

Function BinToOther(S : String) : BYTE;
Var
  I : BYTE;
begin
  Result := 0;
  for I := Length(S) DownTo 1 do
    if S[I] = '1' then Result := Result + Bin(Length(S) + 1 - I);
end;

function BinToOct(S : String) : String;
Var
  Text : TText;
  I    : Integer;
begin
  Result := '';
  DivideText(S, Text, 3);
  for I := 0 to High(Text) do
    Result := Result + IntToStr(BinToOther(Text[I]));

  TurnOver(Result);
end;

function BinToHex(S : String) : String;
Var
  Text : TText;
  I    : Integer;
begin
  Result := '';
  DivideText(S, Text, 4);
  for I := 0 to High(Text) do
    Result := Result + H[BinToOther(Text[I])];

  TurnOver(Result);
end;

function Order(C : Char) : Integer;
begin
  for Result := 0 to High(H) do
    if C = H[Result] then Break;
  if not (Result in [0..15]) then Result := -1;
end;

function OneHexToBin(C : Char) : String;
Var
  V, I : Integer;
begin
  V      := Order(C);
  Result := '';
  for I := 4 DownTo 1 do
    if V >= Bin(I) then
      Begin
        Result := Result + '1';
        Dec(V, Bin(I));
      End
        Else
          Result := Result + '0';
end;

function HexToBin(S : String) : String;
Var
  I : Integer;
begin
  Result := '';
  for I := 1 To Length(S) do
    Result := Result + OneHexToBin(S[I]);

  for I := 1 to Length(Result) do
    if Result[I] = '1' then
      Begin
        Delete(Result, 1, I - 1);
        Break;
      End;
end;

function OneOctToBin(C : Char) : String;
Var
  V, I : Integer;
begin
  V      := Order(C);
  Result := '';
  for I := 3 DownTo 1 do
    if V >= Bin(I) then
      Begin
        Result := Result + '1';
        Dec(V, Bin(I));
      End
        Else
          Result := Result + '0';
end;

function OctToBin(S : String) : String;
Var
  I : Integer;
begin
  Result := '';
  for I := 1 To Length(S) do
    Result := Result + OneOctToBin(S[I]);

  for I := 1 to Length(Result) do
    if Result[I] = '1' then
      Begin
        Delete(Result, 1, I - 1);
        Break;
      End;
end;

function HexToOct(S : String) : String;
begin
  Result := BinToOct(HexToBin(S));
end;

function OctToHex(S : String) : String;
begin
  Result := BinToHex(OctToBin(S));
end;

end.

unit StrUtils;

interface

  TYPE
    TText = Array of String;

  procedure ExChange(Var C1, C2 : Char);
  procedure TurnOver(Var S : String);
  function  RCopy(Source : String; Index, Count : Integer) : String;
  procedure RCopyDef(Source : String; Var Dest : String; Count, Index : Integer;
                      DefaultChar : Char = '0');
  procedure DivideText(Source : String; Var Text : TText; Len : Integer);

implementation

procedure ExChange(Var C1, C2 : Char);
Var
  C3 : Char;
begin
  C3 := C1;
  C1 := C2;
  C2 := C3;
end;

procedure TurnOver(Var S : String);
Var
  I : Integer;
begin
  for I := 1  to Length(S) Div 2 do
    ExChange(S[I], S[Length(S) - I + 1]);
end;

function RCopy(Source : String; Index, Count : Integer) : String;
begin
  TurnOver(Source);
  Result := Copy(Source, Index, Count);
  TurnOver(Result);
end;

procedure RCopyDef(Source : String; Var Dest : String; Count, Index : Integer;
                      DefaultChar : Char = '0');
begin
  Dest := RCopy(Source, Index, Count);
  Dest := StringOfChar(DefaultChar, Count - Length(Dest)) + Dest;
end;

procedure DivideText(Source : String; Var Text : TText; Len : Integer);
Var
  Index : Integer;
begin
  SetLength(Text, 0);
  Index := 1;

  While Index <= Length(Source) do
    Begin
      SetLength(Text, Length(Text) + 1);
      RCopyDef(Source, Text[High(Text)], Len, Index);
      Inc(Index, Len);
    End;
end;

end.

Conclusion :


read it carefully
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.