Conversion of (hex bin oct) to each other

Soyez le premier à donner votre avis sur cette source.

Vue 9 282 fois - Téléchargée 1 233 fois

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

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

yvessimon
Messages postés
644
Date d'inscription
mardi 22 avril 2003
Statut
Membre
Dernière intervention
9 janvier 2017
-
Bonjour,
Dommage j'ai l'erreur :
"L'unité StdActns a été compilée avec une version différente de
StrUtils.TStringSearchOptions " ?

Salutations
Cirec
Messages postés
3809
Date d'inscription
vendredi 23 juillet 2004
Statut
Modérateur
Dernière intervention
1 septembre 2019
32 -
@YvesSimon:

supprime les fichiers *.dcu et recompile le tout.
ça devrait fonctionner

d'ailleurs ces fichiers (*.dcu) ne devraient pas être dans l'archive ainsi que (*.~*)
cs_systmd
Messages postés
46
Date d'inscription
mercredi 25 février 2004
Statut
Membre
Dernière intervention
29 août 2012
-
Bonsoir

je pense que ça vient du fait que l'unité StrUtils existe déjà dans delphi
exemple avec D7 ...Borland\Delphi7\Source\Rtl\Common
Cirec
Messages postés
3809
Date d'inscription
vendredi 23 juillet 2004
Statut
Modérateur
Dernière intervention
1 septembre 2019
32 -
ah oui tout à fait ...
SystmD a raison ... j'avais pas vu l'homographie avec une unité
de Delphi.

La solution est donc de renommer l'unité en ConvertUtils par exemple.
yvessimon
Messages postés
644
Date d'inscription
mardi 22 avril 2003
Statut
Membre
Dernière intervention
9 janvier 2017
-
MERCI

Tout fonctionne

Salutations

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.