１５番会議室「ＦＡＱ編纂委員会」に寄せられた「よくある質問の答え」
[Ｑ]
ＪＩＳとシフトＪＩＳ、ＥＵＣ、ＪＩＳ区点、全角、半角の変換をしたいのですが 関数が見つかりません。 半角カナだけを全角にしたいのですが？
[Ａ]
もっと効率のいいものもあるかもしれませんが、以下の関数を作成して、使用する プログラムに Uses してみてください。[例]
{ 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[#0$A6..#0$DF]OFBYTE=
($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 [#0$a6..#0$af,#0$b1..#0$df]thenbegin
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 [#0$de,#0$df])thenbegin
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 [#0$de,#0$df])thenbegin
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 [#0$81..#0$9f,#0$e0..#0$fc]thenbegin
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 [#0$A0..#0$DF]thenbegin
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 [#0$81..#0$9f,#0$E0..#0$fc]
end;
end.
{ end of Unit===============================================================}
ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum FDELPHIに寄せられる質問の中から、よくある質問への回答を FDELPHIのメンバーがまとめたものです。 したがって、これらの回答はボーランド株式会社がサポートする公式のものではなく、掲示されている内容についての問い合わせは受けられない場合があります。