ULTRACONVERTOR - CONVERSION DE CHAÎNE CHR-DEC-HEX-BIN + OPTIONS

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Edit1: TEdit;
    Label2: TLabel;
    Edit2: TEdit;
    Label3: TLabel;
    Edit3: TEdit;
    Label4: TLabel;
    Edit4: TEdit;
    Label5: TLabel;
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    CheckBox3: TCheckBox;
    CheckBox4: TCheckBox;
    procedure Edit1Change(Sender: TObject);
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
    procedure Edit2KeyPress(Sender: TObject; var Key: Char);
    procedure Edit3KeyPress(Sender: TObject; var Key: Char);
    procedure Edit4KeyPress(Sender: TObject; var Key: Char);
    procedure Edit2Change(Sender: TObject);
    procedure Edit3Change(Sender: TObject);
    procedure Edit4Change(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;

var
  Form1 : TForm1;
  id : integer;

implementation

{$R *.dfm}

function ChrToDec(chaine : string; space : boolean) : string;
var
  i : integer;
  value : string;
begin
  result := '';
  for i := 1 to length(chaine) do
    begin
      value := IntToStr(ord(chaine[i]));
      while length(value) <> 3 do
        value := '0'+value;
      if (space = true) and (i <> 1) then
        value := ' '+value;
      result := result+value;
    end;
end;

function DecToHex(chaine : string; space, zero : boolean) : string;
var
  i : integer;
  value : string;
begin
  result := '';
  for i := 1 to length(chaine) do
    begin
      value := IntToHex(ord(chaine[i]),2);
      if (space = true) and (i <> 1) then
        value := ' '+value;
      if (zero = true) and (i <> 1) then
        value := '00'+value;
      if (space = true) and (zero = true) and (i <> 1) then
        value := ' '+value;
      result := result+value;
    end;
end;

function DecToBin(chaine : string; space : boolean) : string;
var
  i, i2, byte : integer;
  value : string;
begin
  result := '';
  for i := 1 to length(chaine) do
    begin
      value := '';
      byte := ord(chaine[i]);
      for i2 := 7 downto 0 do
        if byte and (1 shl i2)<>0 then
          value := value+'1'
        else
          value := value+'0';
      if (space = true) and (i <> 1) then
        value := ' '+value;
      result := result+value;
    end;
end;

function DecToChr(chaine : string) : string;
var
  i : integer;
  value : string;
begin
  value := '';
  for i := 1 to length(chaine) do
    if (ord(chaine[i]) <> 32) then
      value := value+chaine[i];
  chaine := value;
  if length(chaine) < 3 then exit;
  SetLength(chaine,(length(chaine) div 3)*3);
  result := '';
  i := 1;
  repeat
    value := chaine[i]+chaine[i+1]+chaine[i+2];
    if StrToInt(value) > 255 then
      begin
        ShowMessage(value+' is an incorrect value');
        exit;
      end;
    if (value <> '000') then
      begin
        value := chr(StrToInt(value));
        result := result+value;
      end;
    Inc(i,3);
  until i = length(chaine)+1;
end;

function HexToDec(chaine : string; space : boolean) : string;
var
  i : integer;
  value : string;
begin
  value := '';
  for i := 1 to length(chaine) do
    if (ord(chaine[i]) <> 32) then
      value := value+chaine[i];
  chaine := value;
  if length(chaine) < 2 then exit;
  SetLength(chaine,(length(chaine) div 2)*2);
  result := '';
  i := 1;
  repeat
    value := IntToStr(StrToInt('$'+chaine[i]+chaine[i+1]));
    while length(value) <> 3 do
      value := '0'+value;
    if (value <> '000') then
      begin
        if (space = true) and (i <> 1) then
          value := ' '+value;
        result := result+value;
      end;
    Inc(i,2);
  until i = length(chaine)+1;
end;

function BinToDec(chaine : string; space : boolean) : string;
var
  i, i2, value2 : integer;
  value : string;
begin
  value := '';
  for i := 1 to length(chaine) do
    if (ord(chaine[i]) <> 32) then
      value := value+chaine[i];
  chaine := value;
  if length(chaine) < 8 then exit;
  SetLength(chaine,(length(chaine) div 8)*8);
  result := '';
  i := 1;
  repeat
    value := chaine[i  ]+chaine[i+1]+chaine[i+2]+chaine[i+3]+
             chaine[i+4]+chaine[i+5]+chaine[i+6]+chaine[i+7];
    value2 := 0;
    for i2 := 1 to 8 do
      begin
        if (value[i2] <> '0') and (value[i2] <> '1') then
          begin
            ShowMessage('An error occured'+#10+'You may have entered bad data');
            result := '';
            exit;
          end;
        if (value[i2] = '0') then
          value2 := value2*2
        else
          value2 := value2*2+1;
      end;
    value := IntToStr(value2);
    while (length(value) <> 3) do
      value := '0'+value;
    if (space = true) and (i <> 1) then
      value := ' '+value;
    result := result+value;
    Inc(i,8);
  until i = length(chaine)+1;
end;

procedure TForm1.Edit1Change(Sender: TObject);
begin
  if (id = 1) then
    begin
      try
      Edit2.Text := ChrToDec(Edit1.Text, CheckBox1.Checked);
      Edit3.Text := DecToHex(Edit1.Text, CheckBox2.Checked, CheckBox4.Checked);
      Edit4.Text := DecToBin(Edit1.Text, CheckBox3.Checked);
      except
        ShowMessage('An error occured'+#10+'You may have entered bad data');
      end;
    end;
end;

procedure TForm1.Edit2Change(Sender: TObject);
begin
  if (id = 2) then
    begin
      try
      Edit1.Text := DecToChr(Edit2.Text);
      Edit3.Text := DecToHex(Edit1.Text, CheckBox2.Checked, CheckBox4.Checked);
      Edit4.Text := DecToBin(Edit1.Text, CheckBox3.Checked);
      except
        ShowMessage('An error occured'+#10+'You may have entered bad data');
      end;
    end;
end;

procedure TForm1.Edit3Change(Sender: TObject);
begin
  if (id = 3) then
    begin
      try
      Edit2.Text := HexToDec(Edit3.Text, CheckBox1.Checked);
      Edit1.Text := DecToChr(Edit2.Text);
      Edit4.Text := DecToBin(Edit1.Text, CheckBox3.Checked);
      except
        ShowMessage('An error occured'+#10+'You may have entered bad data');
      end;
    end;
end;

procedure TForm1.Edit4Change(Sender: TObject);
begin
  if (id = 4) then
    begin
      try
      Edit2.Text := BinToDec(Edit4.Text, CheckBox1.Checked);
      Edit1.Text := DecToChr(Edit2.Text);
      Edit3.Text := DecToHex(Edit1.Text, CheckBox2.Checked, CheckBox4.Checked);
      except
        ShowMessage('An error occured'+#10+'You may have entered bad data');
      end;
    end;
end;

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
  id := 1;
end;

procedure TForm1.Edit2KeyPress(Sender: TObject; var Key: Char);
const
  ValidChars = ['0'..'9', #8, #26, #24, #3, #22, #1, #32];
begin
  id := 2;
  if not (Key in ValidChars) then Key := #0;
end;

procedure TForm1.Edit3KeyPress(Sender: TObject; var Key: Char);
var
  str : string;
const
  ValidChars = ['0'..'9', 'a'..'f', 'A'..'F', #8, #26, #24, #3, #22, #1, #32];
begin
  id := 3;
  str := Key;
  Key := UpperCase(str)[1];
  if not (Key in ValidChars) then Key := #0;
end;

procedure TForm1.Edit4KeyPress(Sender: TObject; var Key: Char);
const
  ValidChars = ['0', '1', #8, #26, #24, #3, #22, #1, #32];
begin
  id := 4;
  if not (Key in ValidChars) then Key := #0;
end;

end. 

Télécharger le zip