{ start of Unit=============================================================}
{ Modified on June 19,1998 }{===== henkanJ.pas =====}unit HenkanJ;interface
function JisToSJis(N:word):word;        {ＪＩＳをシフトＪＩＳに}
function JisToKuten(N:word):word;       {ＪＩＳを区点に}
function JisToEUC(N:word):word;         {ＪＩＳをＥＵＣに}
function SJisToJis(N:word):word;        {シフトＪＩＳをＪＩＳに}
function SJisToKuten(N:word):word;      {シフトＪＩＳを区点に}
function SJisToEUC(N:word):word;        {シフトＪＩＳをＥＵＣに}
function KutenToJis(N:word):word;       {区点をＪＩＳに}
function KutenToSJis(N:word):word;      {区点をシフトＪＩＳに}
function KutenToEUC(N:word):word;       {区点をＥＵＣに}
function EUCToJis(N:word):word;         {ＥＵＣをＪＩＳに}
function EUCToSJis(N:word):word;        {ＥＵＣをシフトＪＩＳに}
function EUCToKuten(N:word):word;       {ＥＵＣを区点に}
function WordToChar(N:word):string;     {数値を文字に}
function CharToWord(S:string):word;     {文字を数値に}
function HankToZen(S:string):string;    {半角を全角に}
function ZenToHank(S:string):string;    {全角を半角に}
function AlpToJis(c:char):word;         {アルファベットをＪＩＳに}
function AlpToSJis(c:char):word;        {アルファベットをシフトＪＩＳに}
function KigouToJis(c:char):word;       {記号をＪＩＳに}
function KigouToSJis(c:char):word;      {記号をシフトＪＩＳに}
function KanaToZen(S:string):string;    {カナ記号(#$A0〜#DF)のみを全角に}
function IsDBCSLeadChar(c:char):Boolean;{IsDBCSLeadByteの文字(char)版非API}
implementation
CONST KANA:ARRAY[#$A6..#$DF]OF BYTE=     ($72,$21,
      $23,$25,$27,$29,$63,$65,$67,$43,
      $00,$22,$24,$26,$28,$2A,$AB,$AD,
      $AF,$B1,$B3,$B5,$B7,$B9,$BB,$BD,
      $BF,$C1,$C4,$C6,$C8,$4A,$4B,$4C,
      $4D,$4E,$CF,$D2,$D5,$D8,$DB,$5E,
      $5F,$60,$61,$62,$64,$66,$68,$69,
      $6A,$6B,$6C,$6D,$6F,$73,$00,$00);
      KIGOU:string=' !"#$%&''()=`|-^\~{@[+*};:]<>?_､｡･,./ｰ｢｣';
      KKIGOU:string
                   ='　！”＃＄％＆’（）＝‘｜−＾￥￣｛＠［＋＊｝'+
                    '；：］＜＞？＿、。・，．／ー「」';
      ZEN:ARRAY[$21..$76] of byte=
     (1,11,2,12,3,13,4,14,5,15,                       {あ}
      16,16+56,17,17+56,18,18+56,19,19+56,20,20+56,   {か}
      21,21+56,22,22+56,23,23+56,24,24+56,25,25+56,   {さ}
      26,26+56,27,27+56,9,28,28+56,29,29+56,30,30+56, {た}
      31,32,33,34,35,                                 {な}
      36,36+56,36+112,37,37+56,37+112,38,38+56,38+112,{は}
      39,39+56,39+112,40,40+56,40+112,
      41,42,43,44,45,6,46,7,47,8,48,49,50,51,52,53,   {まやら}
      54,54,12,14,15,55,13+56,16,19);                 {わ}

function JisToSJis(N:WORD):WORD; assembler;
asm
    add  ax,0a17eh ; shr  ah,1      ; jb  @1
    cmp  al,0deh   ; sbb  al,5eh
@1: xor  ah,0e0h
end;
function SJisToJis(N:WORD):WORD; assembler;
asm
    shl  ah,1      ; sub  al,1fh    ; js   @1
    cmp  al,61h    ; adc  al,0deh
@1: add  ax,1fa1h  ; and  ax,7f7fh
end;
function JisToKuten(N:WORD):WORD; assembler;
asm
    sub ax,2020h
end;

function KutenToJis(N:WORD):WORD; assembler;
asm
    add ax,2020h
end;

function EUCToJis(N:word):word; assembler;
asm
    and ax,7f7fh
end;

function JisToEUC(N:word):word; assembler;
asm
    or ax,8080h
end;

function EUCToKuten(N:word):word; assembler;
asm
   and ax,7f7fh
   sub ax,2020h
end;

function KutenToEUC(N:word):word;
asm
   add ax,2020h
   or  ax,8080h
end;

function SJisToEUC(N:word):word;
begin Result:=SJisToJis(N) or $8080 end;

function EUCToSJis(N:word):word;
begin Result:=JisToSJis( n and $7f7f) end;

function SJisToKuten(N:WORD):WORD;
begin Result:=JisToKuten(SJisToJis(N)) end;

function KutenToSJis(N:WORD):WORD;
begin RESULT:=JisToSJis(KutenToJis(N)) end;

function WordToChar(N:WORD):String;
begin Result:=char(Hi(N))+char(Lo(N)) end;

function CharToWord(s:string):word;
begin Result:=(ord(s[1]) shl 8) + ord(s[2]) end;

function HankToZen(s:string):string;
var w:word;
begin  Result:='';
  while Length(s)>0 do begin
    if IsDBCSLeadChar(s[1]) then begin
      Result:=Result+Copy(s,1,2); Delete(s,1,2)
    end else if s[1] in [#$a6..#$af,#$b1..#$df]then begin
    if kana[s[1]]=0 then begin
         Result:=Result+s[1]; Delete(s,1,1)
      end else begin
         w:=$2500+(kana[s[1]] and $7f);
         if (kana[s[1]] and $80)=0 then begin
           Result:=Result+WordToChar(JisToSJis(w));
           if (Length(s)>1) and (s[2]in [#$de,#$df])then begin
             Result:=Result+WordToChar(JisToSJis($204d+Ord(s[2])));
             Delete(s,2,1)
           end;
           Delete(s,1,1)
         end else begin
           if (Length(s)>1) and (s[2] in [#$de,#$df])then begin
             w:=w+1+(Ord(s[2]) and 1);
             Delete(s,2,1)
           end;
           Result:=Result+WordToChar(JisToSJis(w));
           Delete(s,1,1)
         end
      end
    end else begin
      if s[1] in ['0'..'9','A'..'Z','a'..'z'] then begin
        Result:=Result+WordToChar(JisToSJis($2300+Ord(s[1])));
        Delete(s,1,1)
      end else
        if Pos(s[1],kigou)>0 then begin
          Result:=Result+WordToChar(KigouToSJis(s[1]));
          delete(s,1,1)
        end else begin
          Result:=Result+s[1]; Delete(s,1,1)
        end
    end
  end
end;

function ZenToHank(s:string):string;
var w:word;
begin
   Result:='';
   while Length(s)>0 do begin
     if s[1] in [#$81..#$9f,#$e0..#$fc]then begin
     w:=CharToWord(s+'@');
       if Hi(SJisToJis(w)) in [$24,$25] then begin
         if Lo(SJisToJis(w)) in [$21..$76] then begin
           w:=zen[Lo(SJisToJis(w))];
           Result:=Result+char((w mod 56)+$a6);
           case w div 56 of
           1:Result:=Result+'ﾞ';
           2:Result:=Result+'ﾟ';
           end;
           Delete(s,1,2)
         end else begin
           Result:=Result+s[1];
           Delete(s,1,1)
         end
       end else if Pos(Copy(s,1,2),kkigou)>0 then begin
         Result:=Result+kigou[Pos(copy(s,1,2),kkigou)div 2+1];
         Delete(s,1,2)
       end else if Hi(SJisToJis(w))=$23 then begin
         Result:=Result+char(lo(SJisToJis(w)));
         Delete(s,1,2)
       end else begin
         Result:=Result+Copy(s,1,2);
         Delete(s,1,2)
       end;
     end else begin
       Result:=Result+s[1];
       Delete(s,1,1)
     end;
   end;
end;

function AlpToJis(c:char):word;begin
  if c in ['0'..'9','A'..'Z','a'..'z'] then Result:=$2300+ord(c)
  else Result:=Ord(c){ ここに、他の変換を置く }
end;

function AlptoSjis(c:char):word;
begin result:=JisToSJis(AlpToJis(c)) end;

function KigouToJis(c:char):word;
begin result:=SJisToJis(KigouToSJis(c)) end;

function KigouToSJis(c:char):word;
var v:integer;
begin  v:=Pos(c,kigou);
  if v>0 then Result:=Ord(kkigou[v*2-1]) shl 8 + Ord(kkigou[v*2])
         else Result:=Ord(c)
end;

function KanaToZen(S:string):string;begin
  Result:='';  while Length(s)>0 do begin
    if IsDBCSLeadChar(s[1]) then begin
      Result:=Result+Copy(s,1,2);
      Delete(s,1,2)
    end else begin
      if s[1] in [#$A0..#$DF]then begin
        if Copy(s+' ',2,1)[1] in ['ﾞ','ﾟ'] then begin
          Result:=Result+HankToZen(Copy(s,1,2));
          Delete(s,1,2)
        end else begin
          Result:=Result+HankToZen(s[1]);
          Delete(s,1,1)
        end
      end else begin
        Result:=Result+s[1];
        Delete(s,1,1)
      end
    end
  end
end;

function IsDBCSLeadChar(c:char):boolean;begin
  Result:=c in [#$81..#$9f,#$E0..#$fc]
end;

end.