实现2～36进制间的随意转换

//作者:海宏软件 [email protected]
//程序功能：将数字在2～36进制之间随意转换
//附加说明：进制表示时，0～9表示为0～9，10～36表示为A～Z。中间用字符串保存
unit UntMain;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, Buttons, ExtCtrls,StrUtils,Gs_Function,Math,
  Menus;type
  Tfrm_Main = class(TForm)
    Label1: TLabel;
    Edit1: TEdit;
    UpDown_Source: TUpDown;
    Label2: TLabel;
    edt_Source: TEdit;
    Label3: TLabel;
    Edit3: TEdit;
    UpDown_Target: TUpDown;
    Grp_Type: TGroupBox;
    Radio_Auto: TRadioButton;
    RadioButton2: TRadioButton;
    Label4: TLabel;
    edt_Target: TEdit;
    Mem_Info: TMemo;
    lbl_Tips: TLabel;
    cmd_Start: TBitBtn;
    Timer_Source: TTimer;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    SaveDialog1: TSaveDialog;
    procedure FormCreate(Sender: TObject);
    procedure Timer_SourceTimer(Sender: TObject);
    procedure Grp_TypeClick(Sender: TObject);
    procedure Radio_AutoClick(Sender: TObject);
    procedure RadioButton2Click(Sender: TObject);
    procedure cmd_StartClick(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;Function StrToStepNum(const sInput:string='0';nBase:Double=10;nPower:Double=1):Double;   //字符输入，进制数，乘方
Function ConvStrStep(const sInput:string='';nIBase:double=10;nOBase:Double=10):String;  //将输入的字符X进制转化为Y进制字符返回
Function StepNumToStr(const nInput:Double=0;nBase:Integer=10):String;var
  frm_Main: Tfrm_Main;implementation{$R *.dfm}
//---------------------转化主函数-----------------------//
Function ConvStrStep(const sInput:string='';nIBase:double=10;nOBase:Double=10):String;  //将输入的字符X进制转化为Y进制字符返回
var
    nSource:Double;
    i:Integer;
    sTemp,sTarget:String;
begin
    Result:='';
    nSource:=0;
    sTemp:=sInput;
    if sTemp='' then exit;
    //将字符输入转化为长浮点数
    for i:=1 to length(sTemp) do
        nSource:=nSource+StrToStepNum(MidStr(sTemp,i,1),nIBase,Length(sTemp)-i);
    //将转换来的长浮点数转化为指定进制的字符串
    sTarget:=StepNumToStr( nSource,Round(nOBase));
    Result:=sTarget;
end;
//----------------将字符转换为Double输出---------------------------//
Function StrToStepNum(const sInput:string='0';nBase:Double=10;nPower:Double=1):Double;   //字符输入，进制数，乘方
var
    nInput:Double;
    cValue:char;
    sValue:string;
    i:Integer;
begin
    Result:=0;   nInput:=0;
    sValue:=uppercase(sInput);
    //将输入字符解析为一个数字
    for i:=1 to length(sInput) do begin
        cValue:=sValue[i];
        if (cValue>='0') and (cValue<='9') then
            nInput:=Ord(cValue)-ord('0')
        else
          if (cValue>='A') and (cValue<='Z') then
            nInput:=Ord(cValue)-Ord('A')+10
          else
            Begin
                nInput:=0;
                Raise Exception.Create('StrToNum函数接收到的参数不是合法字符[0-9/A-Z]！');
                Exit;
            End;
          //将输入数字进行处理：乘方和底数
          nInput:=nInput*Power(nBase,nPower) ;
          Result:=Result + nInput;
    End;
end;
//---------------将数字转化为X进制字符输出------------------//
Function StepNumToStr(const nInput:Double=0;nBase:Integer=10):String;
var
    cTarget,cTemp:pChar;
    sTemp:string;
    i,j:Integer;
    nTemp,nMulti,nLeft,nValue:Int64;
    lSign:Boolean;
begin
    Result:='';
    GetMem(cTarget,255); GetMem(cTemp,255);
    i:=0;   nTemp:= Trunc( nInput );  lSign:=False;
    if (nTemp=0) or (nBase<=1) or (nBase>36) then exit;
    setRoundMode(rmNearest);
    While Not lSign do
    Begin
        nLeft:=nTemp mod nBase ;        //取余数
        nTemp:=nTemp div nBase ;        //取除数的商
        //除数得到的商小于基数。Over        if abs(nTemp)<=0 then           //nBase
        Begin
            lSign:=(nTemp<nBase);        end;
//        nLeft:=nTemp;
        //将取得的数字转化为字符，放入cTemp中
        if abs(nLeft)<=9 then
            sTemp:=IntToStr( nLeft )
        else
          if (abs(nLeft)>=10) and (abs(nLeft)<=36) then
            Begin
              sTemp:=CHR(abs(nLeft)-10+ord('A'));
            end
          else
            Begin
              Raise Exception.Create('意外错误：余数大于36，将终止！');
              Exit;
            end;
        //放入pChar
        cTemp[i]:=sTemp[1];
        i:=i+1;
    End;
    for j:=0 to i-1 do cTarget[j]:=cTemp[i-j-1]; //逆向取回来
    Result:=LeftStr(StrPas(cTarget),i);
    FreeMem(cTarget);  FreeMem(cTemp);
End;
//--------------------界面----------------------//
procedure Tfrm_Main.FormCreate(Sender: TObject);
begin
    edt_Source.Text:='';Edt_Target.Text:='';Mem_Info.Text:='';
end;
//----------------调用--------------------------------//
procedure Tfrm_Main.cmd_StartClick(Sender: TObject);
begin
    edt_Target.Text:=padl( ConvStrStep(edt_Source.Text,UpDown_Source.Position,UpDown_Target.Position) ,9);
    Mem_Info.Lines.Add( Trim(edt_Source.Text)+' : '+IntToStr(upDown_Source.Position)+'  ==>  '+Trim(edt_Target.Text)+' : '+inttostr(updown_Target.Position)+#13 );
end;
//-----------------自动生成字符串----------------//
procedure Tfrm_Main.Timer_SourceTimer(Sender: TObject);
var sValue:string;
begin
    sValue:=DateTimeToStr(Now);
    sValue:=AnsiReplaceStr(sValue,'.','');
    sValue:=AnsiReplaceStr(sValue,' ','');
    sValue:=AnsiReplaceStr(sValue,':','');
    sValue:='2'+MidStr( AnsiReplaceStr(sValue,'-','') ,3,10);
    sValue:=sValue+ leftstr( padl( IntToStr(random(10000)*random(10000)),4), 14-length(sValue) );
    edt_Source.Text:=sValue;
end;
//----------------关闭／开启Timer--------------------//
procedure Tfrm_Main.Grp_TypeClick(Sender: TObject);
begin
    timer_Source.Enabled:=(Radio_Auto.checked );
end;procedure Tfrm_Main.Radio_AutoClick(Sender: TObject);
begin
    timer_Source.Enabled:=(Radio_Auto.checked );
end;procedure Tfrm_Main.RadioButton2Click(Sender: TObject);
begin
    timer_Source.Enabled:=(Radio_Auto.checked );
end;
procedure Tfrm_Main.N4Click(Sender: TObject);
begin
    Application.MessageBox('谢谢使用海宏软件！','海宏',0);
end;procedure Tfrm_Main.N1Click(Sender: TObject);
begin
    Mem_Info.Clear;
end;procedure Tfrm_Main.N2Click(Sender: TObject);
begin
    if Trim(Mem_Info.Text)='' then exit;
    if SaveDialog1.Execute then Mem_Info.Lines.SaveToFile(SaveDialog1.FileName);
end;end.