Unicode対応のヒントウィンドウ

unit myHintWindow;
{Unicode対応のヒントウィンドウ
http://mrxray.on.coocan.jp/Halbow/Notes/N018.html
}


interface
uses
  Controls,
  Windows;

type
  TMyHintWindow = class(THintWindow)
  protected
    procedure Paint; override;
  public
    function CalcHintRect(MaxWidth: Integer; const AHint: string; AData: Pointer): TRect; override;
  end;

implementation
uses
  Classes,
  Forms;


//------------------------------------------------------------------------------
//AnsiStringとWideStringとの可逆変換関数。
const
  l_csDEFAULT_CHAR = #1;
  l_csPREFIX_CHAR  = '$';
const
  WC_NO_BEST_FIT_CHARS = $00000400;


function gfnsWideToAnsiEx(sSrc: WideString): AnsiString;
//ウムラウトなどのUnicode文字のみ$+16進の形に変換し、それ以外は普通にAnsiStringに変換した文字列を返す。
var
  i, li_Pos, li_Len: Integer;
  lb_Bool: LongBool;
  ls_PStr: PAnsiChar;
begin
  Result := '';
  if (sSrc <> '') then begin
    //WC_COMPOSITECHECKは指定してはいけない
    li_Len := WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, PWideChar(sSrc), -1, nil, 0, l_csDEFAULT_CHAR, @lb_Bool);
    if (lb_Bool = False) and (Pos(l_csPREFIX_CHAR, sSrc) = 0) then begin
      //ウムラウトのようなUnicode文字がなくプリフィクス文字($)もない場合は変換する必要なし
      Result := sSrc;
    end else begin
      ls_PStr := AllocMem(li_Len + 1);
      try
        li_Len := WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, PWideChar(sSrc), -1, ls_PStr, li_Len, l_csDEFAULT_CHAR, @lb_Bool);
        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
              //#1→'$xxxx' xxxx は元の文字の4桁の16進値
              Result := Result + l_csPREFIX_CHAR + Format('%0.4x', [Ord(sSrc[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 <> '') thenbegin
    ls_WStr := WideString(sSrc);
    li_Pos  := Pos(l_csPREFIX_CHAR, ls_WStr);
    if (li_Pos = 0) thenbegin
      //プリフィクス文字($)がなければ変換する必要はない
      Result := ls_WStr;
    endelsebegin
      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 TMyHintWindow.Paint;
var
  R: TRect;
begin
  R := ClientRect;
  Inc(R.Left, 4);
  Inc(R.Top,  4);
  Canvas.Font.Color := Screen.HintFont.Color;
  DrawTextW(Canvas.Handle, PWideChar(gfnsAnsiToWideEx(Caption)), -1, R, DT_VCENTER or DT_LEFT or DT_NOPREFIX or DT_WORDBREAK or DrawTextBiDiModeFlagsReadingOnly);
end;

function TMyHintWindow.CalcHintRect(MaxWidth: Integer; const AHint: string; AData: Pointer): TRect;
begin
  Result := Rect(0, 0, MaxWidth, 0);
  DrawTextW(Canvas.Handle, PWideChar(gfnsAnsiToWideEx(AHint)), -1, Result, DT_CALCRECT or DT_VCENTER or DT_LEFT or DT_WORDBREAK or DT_NOPREFIX or DrawTextBiDiModeFlagsReadingOnly);
  //ちょっと余裕を持たせた表示に
  Inc(Result.Right,  10);
  Inc(Result.Bottom,  4);
end;


initialization
  //Unicode対応ヒントウィンドウ
  HintWindowClass      := TMyHintWindow;
  Application.ShowHint := False;
  Application.ShowHint := True;

end.

  HintWindowClass      := TMyHintWindow;
  Application.ShowHint := False;
  Application.ShowHint := True;

procedure TForm1.WindowsMediaPlayer1PlayStateChange(Sender: TObject; NewState: Integer);
begin
  if (NewState = wmppsPlaying) then begin
    Self.Hint := gfnsWideToAnsiEx(
      WideFormat('%s'#13'%s'#13'%s', [
        WindowsMediaPlayer1.currentMedia.getItemInfo('Author'), //アーティスト名
        WindowsMediaPlayer1.currentMedia.getItemInfo('Title'),  //タイトル(曲名)
        WindowsMediaPlayer1.currentMedia.getItemInfo('Album')   //アルバム名
      ])
    );
  end;
end;