unit1_bak.pas

2,4,8,16进制转换

unit Unit1_bak;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls,Types;
type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Button2: TButton;
    RadioGroup1: TRadioGroup;
    Button3: TButton;
    Button4: TButton;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    Memo1: TMemo;
    Edit5: TEdit;
    Edit6: TEdit;
    procedure RadioGroup1Click(Sender: TObject);
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
    procedure Edit1Change(Sender: TObject);
    procedure Edit2Change(Sender: TObject);
    procedure Edit3Change(Sender: TObject);
    procedure Edit4Change(Sender: TObject);
    procedure Edit2KeyPress(Sender: TObject; var Key: Char);
    procedure Edit3KeyPress(Sender: TObject; var Key: Char);
    procedure Edit4KeyPress(Sender: TObject; var Key: Char);
    
  private
    procedure RadioGroupChange(OldType,NewType:integer);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  Curr_Type:integer=1;
  Int_Data:integer=0;
implementation

{$R *.dfm}
function TypeToDec(Buffer: string;iTypes:SmallInt): string;
const ArrayHex_Char: array ['a'..'f'] of SmallInt =
    ( 10,11,12,13,14,15);
var
 i,iDec,itmp :integer;
 sBin :pchar;
begin
    iDec:=0;
    sBin:=Pchar(Buffer);
    if iTypes>10 then
    begin
       For i := 1 To Length(sBin) do
       begin
           if sBin[i-1] in ['a'..'f'] then
              itmp:=ArrayHex_Char[sBin[i-1]]
           else
              itmp:=StrToInt(sBin[i-1]);
           iDec:=iDec*iTypes+itmp;
        end ;
     end
     else
     begin
         For i := 1 To Length(sBin) do
         begin
             iDec:=iDec*iTypes+StrToInt(sBin[i-1]);
         end ;
     end;
    Result:=IntToStr(iDec);
end;
function DecToType(Buffer: string;iTypes:SmallInt): string ;
const ArrayHex_Char: array [0..15] of Char = '0123456789abcdef';
var
iDec:integer;
begin
   iDec:=StrToInt(Buffer);
   Result :='';
   while iDec >0 do
   begin
       Result:=ArrayHex_Char[iDec Mod iTypes] + Result ;
       iDec:=iDec div iTypes;
   end;
end;

function TypeToType(Buffer: string;iTypesOld,iTypesNew:SmallInt): string;
var
tmpBuffer:string;
begin
if iTypesOld<>iTypesNew then
begin
   tmpBuffer:=TypeToDec(Buffer,iTypesOld);
   Int_data:=StrToInt(tmpBuffer);
   Result:=DecToType(tmpBuffer,iTypesNew);
end;
end;


function UpCase( ch : Char ) : Char;
begin
  Result := ch;
  case Result of
    'a'..'z':  Dec(Result, Ord('a') - Ord('A'));
  end;
end;
function LowerCase(ch:Char):Char;
begin
  Result := ch;
  case Result of
    'A'..'Z':  Inc(Result, Ord('a') - Ord('A'));
  end;
end;
{function IntToBin(Value: Integer): string ;
begin
   Result :='';
   while Value >0 do
   begin
   Result:=inttostr(Value mod 2) + Result ;
   Value:=Value div 2;
   end;
end; }
//Dec Bin
{function DecToBin(Value: Integer): string;
var
  i: Integer;
begin
  SetLength(result, 32);
  for i := 1 to 32 do
  begin
    if ((Value shl (i-1)) shr 31) = 0 then
      result[i] := '0'
    else
      result[i] := '1';
  end;
end;
function BinToDec(Value:string):String;
Var
 i,iDec :integer;
 sBin :pchar;
begin
    iDec:=0;
    sBin:=pchar(Trim(Value));
    For i := 1 To Length(sBin) do
    begin
        if sBin[i-1]<>' ' then
        begin
           iDec:=iDec*2+StrToInt(sBin[i-1]);
        end ;
    end;
    Result:=IntToStr(iDec);
end;
//Dec Bin
//Oct Dec
function DecToOct(Value: Integer): string ;
var
iDec:integer;
begin
   iDec:=Value;
   Result :='';
   while iDec >0 do
   begin
   Result:=inttostr(iDec mod 8) + Result ;
   iDec:=iDec div 8;
   end;
end;
function OctToDec(Buffer: Integer): string;
var
 i,iDec :integer;
 sBin :pchar;
begin
    iDec:=0;
    sBin:=pchar(Buffer);
    For i := 1 To Length(sBin) do
    begin
        iDec:=iDec*8+StrToInt(sBin[i-1]);
    end;
    Result:=IntToStr(iDec);
end;
// Oct Dec
//Hex Dec
function DecToHex(Value: Integer): string;
const ArrayHex_Char: array [0..15] of Char = '0123456789abcdef';
var
iDec:integer;
begin
   iDec:=Value;
   Result :='';
   while iDec >0 do
   begin
   Result:=ArrayHex_Char[iDec Mod 16] + Result ;
   iDec:=iDec div 16;
   end;
end;
function HexToDec(Buffer: string): string;
const ArrayHex_Char: array ['a'..'f'] of SmallInt =
    ( 10,11,12,13,14,15);
var
 i,iDec,itmp :integer;
 sBin :pchar;
begin
    iDec:=0;
    sBin:=Pchar(Buffer);
    For i := 1 To Length(sBin) do
    begin
        if sBin[i-1] in ['a'..'f'] then
           itmp:=ArrayHex_Char[sBin[i-1]]
        else
           itmp:=StrToInt(sBin[i-1]);
        iDec:=iDec*16+itmp;
    end;
    Result:=IntToStr(iDec);
end; }
//Hex Dec
//Bin Hex
{function BinToHexStr(AData: Pointer; ADataLen: Integer): String;
var
  LSrc: PChar;
  i: Integer;
Begin
  LSrc:=AData;
  SetString(Result,NIL,ADataLen*2);

  for i:=0 to ADataLen-1 do begin
    Result[i*2+1]:=IdHexDigits[ord(LSrc^) shr 4];
    Result[i*2+2]:=IdHexDigits[ord(LSrc^) and $F];
    inc(LSrc);
  end;
End; }

procedure TForm1.RadioGroup1Click(Sender: TObject);
begin
     Form1.RadioGroupChange(Curr_Type,radiogroup1.ItemIndex);
     Curr_Type:=radiogroup1.ItemIndex;
     edit6.Text:=Inttostr(Int_data);
end;

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
if (Key > #31) and (Key <  #128) then
if not (key in ['0'..'9','a'..'f','A'..'F']) then
   key:=#48
else
   Key :=LowerCase(Key);
end;

procedure TForm1.RadioGroupChange(OldType,NewType:integer);
begin
     edit1.visible:=false ;
     edit2.visible:=false ;
     edit3.visible:=false ;
     edit4.visible:=false ;
     case NewType of
       0:
       begin
           edit1.visible:=true ;
           edit1.text:=DecToType(IntToStr(Int_Data),16);
       end ;
       1:
       begin
           edit2.visible:=true ;
           edit2.text:=IntToStr(Int_Data);
       end;
       2:
       begin
           edit3.visible:=true ;
           edit3.text:=DecToType(IntToStr(Int_Data),8) ;
       end ;
       3:
       begin
           edit4.visible:=true ;
           edit4.text:=DecToType(IntToStr(Int_Data),2) ;
       end ;
     end;
end;

procedure TForm1.Edit1Change(Sender: TObject);
var
I:integer;
vText:pchar;
begin
  vText:=Pchar(Edit1.Text);
  for I := 0 to length(Edit1.text)-1 do
  begin
    if not (vText[i] in ['0'..'f']) then
    begin
        Edit5.Text :=Edit1.Text;
        Edit1.Text :='0';
        MessageBox(0, '输入的数据不是有效的十六进制数！', 'Error', MB_ICONERROR or MB_OK);
        break;
    end ;
  end;
  Int_data:=StrToInt(TypeToDec(Edit1.Text,16));
end;

procedure TForm1.Edit2Change(Sender: TObject);
var
I:integer;
vText:pchar;
begin
  vText:=Pchar(Edit2.Text);
  for I := 0 to length(Edit2.text)-1 do
  begin
    if not (vText[i] in ['0'..'9']) then
    begin
        Edit5.Text :=Edit2.Text;
        Edit2.Text :='0';
        MessageBox(0, '输入的数据不是有效的十进制数！', 'Error', MB_ICONERROR or MB_OK);
        break;
    end ;
  end;
  Int_data:=StrToInt(Edit2.Text);
end;

procedure TForm1.Edit3Change(Sender: TObject);
var
I:integer;
vText:pchar;
begin
  vText:=Pchar(Edit3.Text);
  for I := 0 to length(Edit3.text)-1 do
  begin
    if not (vText[i] in ['0'..'7']) then
    begin
        Edit5.Text :=Edit3.Text;
        Edit3.Text :='0';
        MessageBox(0, '输入的数据不是有效的八进制数！', 'Error', MB_ICONERROR or MB_OK);
        break;
    end ;
  end;
  Int_data:=StrToInt(TypeToDec(Edit3.Text,8));
end;

procedure TForm1.Edit4Change(Sender: TObject);
var
I:integer;
vText:pchar;
begin
  vText:=Pchar(Edit4.Text);
  for I := 0 to length(Edit4.text)-1 do
  begin
    if not (vText[i] in ['0'..'1']) then
    begin
        Edit5.Text :=Edit4.Text;
        Edit4.Text :='0';
        MessageBox(0, '输入的数据不是有效的二进制数！', 'Error', MB_ICONERROR or MB_OK);
        break;
    end ;
  end;           
  Int_data:=StrToInt(TypeToDec(Edit4.Text,2));
end;

procedure TForm1.Edit2KeyPress(Sender: TObject; var Key: Char);
begin
if (Key > #31) and (Key <  #128) then
if not (key in ['0'..'9']) then
   key:=#48
else
   Key :=LowerCase(Key);
end;

procedure TForm1.Edit3KeyPress(Sender: TObject; var Key: Char);
begin
if (Key > #31) and (Key <  #128) then
if not (key in ['0'..'7']) then
   key:=#48
else
   Key :=LowerCase(Key);
end;

procedure TForm1.Edit4KeyPress(Sender: TObject; var Key: Char);
begin
if (Key > #31) and (Key <  #128) then
if not (key in ['0'..'1']) then
   key:=#48
else
   Key :=LowerCase(Key);
end;

end.