wnccvmain.pas

介绍关于VB的基础教程有关代码 全英文从大学下载的PDF格式

{*******************************************************}
{                                                       }
{       Author: 王运龙                                  }
{                                                       }
{  [e-mail]                                      }
{                                                       }
{*******************************************************}
unit wnCCVMain;

interface

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

type
  TForm1 = class(TForm)
    btnConvert: TButton;
    rbtnInputHex: TRadioButton;
    rbtnInputChara: TRadioButton;
    memInput: TMemo;
    panResult: TPanel;
    rbtnUToA: TRadioButton;
    rbtnAToU: TRadioButton;
    Bevel1: TBevel;
    gbxUnicode: TGroupBox;
    memUnicode: TMemo;
    gbxAscii: TGroupBox;
    memAscii: TMemo;
    procedure btnConvertClick(Sender: TObject);
    procedure rbtnInputCharaClick(Sender: TObject);
    procedure rbtnInputHexClick(Sender: TObject);
  private
    { Private declarations }

    function GetHex(const aStr: string): string;
    function GetChars(aHexStr: string): string;
    //将UnicodeHex AscII字串转换为ANSI Ascii
    function UnicodeHexToStr(const asUnicodeHex: string): string;
    function ChinaToUnicode(const aWideStr: WideString): string;
    function UnicodeHex(const aWideStr: WideString): string;
    function FormatHexDisp(const asHex: string): string;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function TForm1.UnicodeHexToStr(const asUnicodeHex: string): string;
var
  i: Integer;
  sTemp: string;
begin
  //“中国网管程序：操作说明”的Unicode编码16进制为：
  //4E2D 56FD 7F51 7BA1 7A0B 5E8F FF1A 64CD 4F5C 8BF4 660E
  for i := 1 to Length(asUnicodeHex) do
  begin
    if i mod 4 = 0 then
    begin
      sTemp := Copy(asUnicodeHex, i - 3, 4);
      sTemp := WideChar(StrToIntDef('$' + sTemp, 0));
      Result := Result + sTemp;
    end;
  end;
end;


function TForm1.ChinaToUnicode(const aWideStr: WideString): string;
var
  sUnicodeHex: string;
  i : integer;
begin
  for i := 1 to Length(aWideStr) do
  begin
    sUnicodeHex := Format('%.4x', [Word(aWideStr[i])]);
    sUnicodeHex := Chr(StrToInt('$' + Copy(sUnicodeHex, 3, 2))) +
        Chr(StrToInt('$' + copy(sUnicodeHex, 1, 2)));
    Result := Result + sUnicodeHex;
  end;
end;

function TForm1.UnicodeHex(const aWideStr: WideString): string;
var
  i: Integer;
begin
  for i := 1 to length(aWideStr) do
  begin
    Result := Result + Format('%.4x', [Word(aWideStr[i])]);
  end;
end;

function TForm1.FormatHexDisp(const asHex: string): string;
var
  i, iLen: Integer;
begin
  Result := asHex;
  iLen := Length(Result);
  if Odd(iLen) then
  begin
    Result := '0' + Result;
    Inc(iLen);
  end;

  for i := iLen downto 1 do
  begin
    if Odd(i) then Continue;
    
    Insert(' ', Result, i - 1);
  end;
  Result := Trim(Result);
end;

procedure TForm1.btnConvertClick(Sender: TObject);
var
  s: string;
begin
  s := memInput.Text;
  if rbtnInputChara.Checked then
  begin
    memUnicode.Text := FormatHexDisp(UnicodeHex(s));
    memAscii.Text := FormatHexDisp(GetHex(s));
  end else
  begin
    s := StringReplace(s, ' ', '', [rfReplaceAll, rfIgnoreCase]);
    if rbtnUToA.Checked then
    begin
      memUnicode.Text := UnicodeHexToStr(s);
      memAscii.Text := FormatHexDisp(GetHex(memUnicode.Text));
    end else
    begin
      memUnicode.Text := GetChars(s);
      memAscii.Text := UnicodeHex(memUnicode.Text);
    end;
  end;
end;

procedure TForm1.rbtnInputCharaClick(Sender: TObject);
begin
  memUnicode.Clear;
  memAscii.Clear;
  gbxUnicode.Caption := 'Unicode编码';
  gbxAscii.Caption := 'Ascii编码';
  rbtnUToA.Enabled := False;
  rbtnAToU.Enabled := False;
end;

procedure TForm1.rbtnInputHexClick(Sender: TObject);
begin
  memUnicode.Clear;
  memAscii.Clear;

  gbxUnicode.Caption := '转换后的文本';
  gbxAscii.Caption := 'Hex编码';
  rbtnUToA.Enabled := True;
  rbtnAToU.Enabled := True;
end;

function TForm1.GetHex(const aStr: string): string;
var
  i: Integer;
begin
  for i := 1 to Length(aStr) do
  begin
    Result := Result + Format('%.2x', [Ord(aStr[i])]);
  end;
end;

function TForm1.GetChars(aHexStr: string): string;
var
  i: Integer;
begin
  aHexStr := StringReplace(aHexStr, ' ', '', [rfReplaceAll, rfIgnoreCase]);
  for i := 1 to Length(aHexStr) do
  begin
    if Odd(i) then
    begin
      Result := Result + Char(StrToIntDef('$' + Copy(aHexStr, i, 2), 0));
    end;
  end;
end;

end.