mainunit.~pas

简单功能,实现输入的编号由正向反重新排序

unit MainUnit;

interface

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

type
  TMainForm = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    GroupBox1: TGroupBox;
    Edit1: TEdit;
    Label1: TLabel;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    RadioButton3: TRadioButton;
    Button1: TButton;
    GroupBox2: TGroupBox;
    RadioButton4: TRadioButton;
    RadioButton5: TRadioButton;
    RadioButton6: TRadioButton;
    Edit2: TEdit;
    Label2: TLabel;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
    procedure Button1Click(Sender: TObject);
    procedure RadioButton2Click(Sender: TObject);
    procedure RadioButton1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure RadioButton3Click(Sender: TObject);
    procedure RadioButton4Click(Sender: TObject);
    procedure RadioButton5Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private declarations }
    Flag,nFlag: integer;
    function Str_IntToBin(Int: LongInt; Size: Integer): string;
    function HexToInt(Const HexValue: String) : Integer;
    function IntToHexA(Const Value: Integer): string;
    function BintoInt(Value:   String):   LongInt;
    function HextoBinary(Hex:string):string;
    function BinToHex(mBin:   string):   string;
  public
    { Public declarations }
  end;

const   
  cBinStrings: array[0..15] of string= (
  '0000',   '0001',   '0010',   '0011',
  '0100',   '0101',   '0110',   '0111',
  '1000',   '1001',   '1010',   '1011',
  '1100',   '1101',   '1110',   '1111'
  );

var
  MainForm: TMainForm;

implementation

{$R *.dfm}


function   TMainForm.BinToHex(mBin:   string):   string;
var
  I,   J,   L:   Integer;
      S:   string;
begin
      S   :=   '';
      L   :=   Length(mBin);
      if   L   mod   4   <>   0   then
          for   I   :=   1   to   4   -   (L   mod   4)   do
              mBin   :=   '0'   +   mBin;

      for   I   :=   Length(mBin)   downto   1   do   begin
          S   :=   mBin[I]   +   S;
          if   Length(S)   =   4   then   begin
              for   J   :=   0   to   15   do
                  if   S   =   cBinStrings[J]   then   begin
                      S   := IntToHex(J,1);
                      Break;
                  end;
              if   Length(S)   >   1   then
                  Result   :=   '0'   +   Result
              else   Result   :=   S   +   Result;
              S   :=   '';
     end   ;
  end;
end;

function TMainForm.HextoBinary(Hex:string):string;
const
    BOX: array [0..15] of string =
         ('0000','0001','0010','0011',
          '0100','0101','0110','0111',
          '1000','1001','1010','1011',
          '1100','1101','1110','1111');
var
    i:integer;
begin
    for i:=Length(Hex) downto 1 do
        Result:=BOX[StrToInt('$'+Hex[i])]+Result;
end;

function TMainForm.BintoInt(Value:   String):   LongInt;
  var
      i,Size:   Integer;
  begin
      Result:=0;
      Size:=Length(Value);
      for   i:=Size   downto   1   do
      begin
          if   Copy(Value,i,1)='1'   then
              Result:=Result+(1   shl   (Size-i));
      end;
  end;

procedure TMainForm.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
 //sHOWmESSAGE(inTTOsTR(KEY))
  if RadioButton1.Checked then
    if not (Key  in['0'..'9']) then Key:= #0;
 if RadioButton2.Checked then
    if not (Key  in['0'..'9','A'..'F']) then Key:= #0;

end;

//十六进制转成二进制
function TMainForm.HexToInt(Const HexValue: String) : Integer;
begin
  Val('$'+HexValue, Result, Result);
end;

function TMainForm.IntToHexA(Const Value: Integer): string;
const
  HexChars: array[0..15] of Char = '0123456789ABCDEF';
var
  iTemp: Integer;
  i: Integer;
begin
  Result := '';
  i := 0;
  while i<4 do
  begin
    case i of
      0: iTemp := Value shr 24 and $FF;
      1: iTemp := Value shr 16 and $FF;
      2: iTemp := Value shr 8 and $FF;
      3: iTemp := Value and $FF;
    end;
    Result := Result + HexChars[iTemp div 16];
    Result := Result + HexChars[iTemp mod 16];
    Inc(i);
  end;
end;

procedure TMainForm.Button1Click(Sender: TObject);
var
  iTemp,iLow,iHigh: integer;
begin
  try
    case Flag  of
      2: iTemp:= HexToInt(Trim(Edit1.Text));
      3: iTemp:= BinToInt(Trim(Edit1.Text));
      1: iTemp:= StrToInt(Trim(Edit1.Text));
    end;
  except
    MessageBox(handle,PChar('转换错误!'),PChar('提示'),mb_IconInformation);
    Exit;
  end;
//  iTemp:= swap(iTemp);
  iLow:= Word(iTemp);
  iLow:= swap(iLow);
  iTemp := iTemp shr 16;
  iHigh:= word(iTemp);
  iHigh:= swap(iHigh);
  //dLow:= iLow;
  iLow:= iLow shl 16;
 // dHigh:= dHigh shl 16;
  iTemp:=  iLow or iHigh;
  Edit2.Text:= IntToStr(iTemp);
  nFlag:=1;
  RadioButton4.Checked:= True;
end;

procedure TMainForm.RadioButton2Click(Sender: TObject);
begin
  try
    if Trim(Edit1.Text)<>'' then
    begin
      if Flag = 1 then
      begin
        Edit1.Text := IntToHexA(StrToInt(Edit1.Text));
      end;
      if Flag= 3 then
      begin
        Edit1.Text:= BinToHex(Trim(Edit1.Text));
      end;
    end;
    Flag:=2;
  except
    MessageBox(handle,PChar('输入错误或者超出范围'),PChar('提示'),mb_IconInformation);
    Flag:=2;
    Edit1.Clear;
  end;

end;

procedure TMainForm.RadioButton1Click(Sender: TObject);
begin
  try
    if Trim(Edit1.Text)<>'' then
    begin
      if Flag =2 then
      begin
        Edit1.Text := IntToStr(HexToInt(Trim(Edit1.Text)));
      end;
      if Flag =3 then
      begin
        Edit1.Text:= IntToStr(BinToInt(Trim(Edit1.Text)));
      end;
    end;
    Flag :=1;
  except
    MessageBox(handle,PChar('输入错误或者超出范围'),PChar('提示'),mb_IconInformation);
    Flag:=1;
    Edit1.Clear;
  end;
end;

procedure TMainForm.FormShow(Sender: TObject);
begin
  Flag :=1;
  nFlag:= 1;
end;

function TMainForm.Str_IntToBin(Int: LongInt; Size: Integer): string;
var
  i: Integer;
begin
  if Size < 1 then Exit;
  for i := Size downto 1 do
  begin
  if Int and (1 shl (Size - i)) <> 0 then
    result := '1' + Result
  else
    Result := '0' + Result;
  end;
End;

procedure TMainForm.RadioButton3Click(Sender: TObject);
begin
  if Flag= 1 then
  begin
    Edit1.Text:= Str_IntToBin(StrToInt(Trim(Edit1.Text)),32);
  end;
  if Flag= 2 then
  begin
    Edit1.Text:= HextoBinary(Trim(Edit1.Text));
  end;
  Flag:= 3;
end;

procedure TMainForm.RadioButton4Click(Sender: TObject);
begin
  try
    if Trim(Edit2.Text)<>'' then
    begin
      if nFlag =2 then
      begin
        Edit2.Text := IntToStr(HexToInt(Trim(Edit2.Text)));
      end;
      nFlag:= 1;
    end;
  except
    MessageBox(handle,PChar('输入错误或者超出范围'),PChar('提示'),mb_IconInformation);
    nFlag:=1;
    Edit2.Clear;
  end;
end;

procedure TMainForm.RadioButton5Click(Sender: TObject);
begin
  try
    if Trim(Edit2.Text)<>'' then
    begin
      if nFlag = 1 then
      begin
        Edit2.Text := IntToHexA(StrToInt(Edit2.Text));
      end;
      nFlag:=2;
    end;
  except
    MessageBox(handle,PChar('输入错误或者超出范围'),PChar('提示'),mb_IconInformation);
    nFlag:=2;
    Edit2.Clear;
  end;
end;

procedure TMainForm.Button2Click(Sender: TObject);
begin
  Edit1.Clear;
  Edit1.SetFocus;
end;

procedure TMainForm.Button3Click(Sender: TObject);
begin
  Edit1.SelectAll;
  Edit1.CopyToClipboard;
  Edit1.SetFocus;

end;

procedure TMainForm.Button4Click(Sender: TObject);
begin
  Edit1.PasteFromClipboard;
  Edit1.SetFocus;
end;

end.