TStatusBarはAutoHintプロパティがTrueでフォーム上のコントロールのShowHintプロパティがTrueの場合そのコントロール上にマウスカーソルが乗っている間そのコントロールのHintプロパティの内容を表示します。
操作の手助けとなる情報をユーザーに提示できるので重宝します。
これをUnicodeな文字を表示できるようにしようというのがこのページの趣旨です。
//--- WideString⇔AnsiString
//WideStringとAnsiStringの可逆変換関数
const
l_csDEFAULT_CHAR = #1;
l_csPREFIX_CHAR = '$';
function gfnsWideToAnsiEx(
const sWSrc:
WideString): AnsiString;
{
WideString→AnsiString
WideStringをAnsiStringに変換
キャストするだけやWideCharToString関数と違ってウムラウトなどのUnicode文字を$+16進に変換して返す
http://yokohama.cool.ne.jp/chokuto/urawaza/api/WideCharToMultiByte.html
0x00000400 (WC_NO_BEST_FIT_CHARS)
Windows 2000/XP： 直接マルチバイト文字に変換できない文字をデフォルトキャラクタに置きかえます。
}
var
i, li_Pos, li_Len: Integer;
lb_Bool: LongBool;
ls_PStr: PAnsiChar;
begin
Result := '';
if (sWSrc <> '')
then begin
li_Len := WideCharToMultiByte(CP_ACP, $400, PWideChar(sWSrc),
-1,
nil, 0, l_csDEFAULT_CHAR, @lb_Bool);
if (lb_Bool = False)
and (Pos(l_csPREFIX_CHAR, sWSrc) = 0)
then begin
//ウムラウトのようなUnicode文字がなくプリフィクス文字($)もない場合は変換する必要なし
//$は2バイト文字の第一バイトにも第二バイトにも現れないのでPosでよい
Result := sWSrc;
end else begin
ls_PStr := AllocMem(li_Len + 1);
try
li_Len := WideCharToMultiByte(CP_ACP, $400,
PWideChar(sWSrc), -1, ls_PStr, li_Len, l_csDEFAULT_CHAR,
nil);
if (li_Len > 0)
then begin
Dec(li_Len);
i := 0;
//ls_PStr のインデックス
li_Pos := 1;
//sWSrc のインデックス
repeat
if (ls_PStr[i] = l_csDEFAULT_CHAR)
or (ls_PStr[i] = l_csPREFIX_CHAR)
then begin
//デフォルトキャラクタとプリフィクスキャラクタは $xxxx の書式に変換
Result := Result + l_csPREFIX_CHAR
+ Format('%0.4x', [Ord(sWSrc[li_Pos])]);
end else begin
Result := Result + ls_PStr[i];
end;
if (IsDBCSLeadByte(Byte(ls_PStr[i])))
then begin
//2バイト文字の先頭バイトなのでもう1バイトスキップ
Result := Result + ls_PStr[i + 1];
Inc(i, 2);
end else begin
Inc(i);
end;
Inc(li_Pos);
until (i >= li_Len);
//untilは条件がTrueで終了
end;
finally
FreeMem(ls_PStr);
end;
end;
end;
end;
function gfnsAnsiToWideEx(
const sSrc: AnsiString):
WideString;
//gfnsWideToAnsiExの逆
var
li_Pos, li_Len: Integer;
ls_WStr, ls_WCnv:
WideString;
begin
Result := '';
if (sSrc <> '')
then begin
ls_WStr :=
WideString(sSrc);
li_Pos := Pos(l_csPREFIX_CHAR, ls_WStr);
if (li_Pos = 0)
then begin
//2008-02-12:プリフィクス文字($)がなければ変換する必要はない
Result := ls_WStr;
end else begin
li_Len := Length(ls_WStr);
repeat
//'$'までの文字列を足しこむ
Result := Result + Copy(ls_WStr, 1, li_Pos - 1);
try
//'$'に続く(はずの)4文字の数値をUnicode文字に変換
ls_WCnv :=
WideString(WideChar(StrToInt(Copy(ls_WStr, li_Pos, 5))));
Result := Result + ls_WCnv;
ls_WStr := Copy(ls_WStr, li_Pos +4 +1, li_Len);
//4文字の数値の次からコピー開始
except
//イレギュラー
Result := Result +
WideString(l_csPREFIX_CHAR);
//イレギュラー時はそのままにする
ls_WStr := Copy(ls_WStr, li_Pos +1, li_Len);
//'$'の次からコピー開始
end;
//次の'$'までの位置を取得
li_Pos := Pos(l_csPREFIX_CHAR, ls_WStr);
Application.ProcessMessages;
until (li_Pos = 0);
//untilは条件がTrueで終了
Result := Result + ls_WStr;
end;
end;
end;
procedure TForm1.StatusBar1DrawPanel(StatusBar: TStatusBar; Panel: TStatusPanel;
const Rect: TRect);
//Unicode対応ステータスバー
const
lci_MARGIN = 2;
var
lrc_Rect : TRect;
begin
lrc_Rect := Rect;
Inc(lrc_Rect.Left, lci_MARGIN);
DrawTextW(StatusBar1.Canvas.Handle, PWideChar(
gfnsAnsiToWideEx(Panel.Text)), -1, lrc_Rect, DT_NOPREFIX
or DT_SINGLELINE
or DT_VCENTER);
end;
