ホーム >プログラム >Delphi 6 ローテクTips >タスクバーのタイトルもUnicode表示に

タスクバー上のタイトルもウムラウトのようなUnicode文字に対応させましょうというページ。

参考サイト
第１章 窓をあければ
http://mrxray.on.coocan.jp/Halbow/Chap01.html

CreateWindow APIを使ってアプリケーションを作成するサンプル。


3.2 Application 変数
http://www.asahi-net.or.jp/~ha3t-nkmr/vcl3-2.htm

TApplicationの詳細。

Delphi製のアプリでは、タスクバー上のタイトルはApplicationのTitleプロパティの値が表示されます。
これはApplicationのウィンドウテキストになります。
ということでタスクバー上のタイトルをUnicode対応にするにはApplicationウィンドウテキストをUnicode対応にしないとなりません。
とはいえApplicationはAnsi版のCreateWindowEx APIで作成されているのでウムラウトのようなUnicode文字は直接持たせられません。
またタスクバー上の表示は自アプリで行うのではなく管轄外なのでリストボックスやメニューでやったようなDrawTextW APIを使って自前で描画する方法も使えません。
どうするか。

　CreateWindowW APIでUnicode対応のウィンドウを作り、SetParent APIでApplicationウィンドウをその子ウィンドウにしてしまいます。
そして作成したウィンドウのウィンドウテキストにUnicodeな文字をセットします。
そうするとタスクバー上のタイトルは作成したUnicode対応ウィンドウのウィンドウテキストが表示されることになるので、めでたくタスクバー上のタイトルもUnicode対応ということになります。

やることは単純ですが、自力でUnicode対応のウィンドウを作ったり、そのUnicode対応ウィンドウとApplicationやMainFormとのメッセージのやり取りを必要なだけ書かないといけないので少し面倒になります。

まずUnicode対応のウィンドウを作るためのユニットを書きます。
この例では手続きと関数だけで書いていますが、クラスにしてしまってもかまいません。
ただしウィンドウプロシージャ(下の例ではUBaseAppWndProc)はクラス内の関数を指定するのは難しいようなのでクラス外の関数にします。

unit u_base;

interface
uses
  Windows;

procedure gpcUBaseAppCreate;
procedure gpcUBaseAppFree;
function  gfnsUBaseAppTitleGet: WideString;
procedure gpcUBaseAppTitleSet(sTitle: WideString);

const
  //クラス名
  gcsUAPP_CLASSNAME = 'TUApplication';

var
  //Unicode対応ウィンドウのウィンドウハンドルを保持するグローバル変数
  ghUAppHandle: HWND = 0


implementation
uses
  Messages,
  Forms,
  SysUtils;


function UBaseAppWndProc(hWindow: HWND; Msg: UINT; iWParam: WPARAM; iLParam: LPARAM): LRESULT; stdcall;
var
  lr_Msg:     TMessage;
  lrc_Rect:   TRect;
  l_MainForm: TForm;
begin
  Result := 0;
  l_MainForm := Application.MainForm;

  FillChar(lr_Msg, SizeOf(lr_Msg), 0);
  with lr_Msg do begin
    Msg := hWindow;
    WParam := iWParam;
    LParam := iLParam;
    Result := 0;
  end;

  case Msg of
    WM_SYSCOMMAND: begin
      case (TWMSysCommand(lr_Msg).CmdType) of
        SC_MINIMIZE: begin
          //最小化のときのアニメーションが不自然にならないようにメインフォームの大きさにしておく。
          SetWindowPos(hWindow, l_MainForm.Handle, l_MainForm.Left, l_MainForm.Top, l_MainForm.Width, 0, SWP_SHOWWINDOW);
          Result := DefWindowProcW(hWindow, Msg, iWParam, iLParam);
          Application.Minimize;
        end;

        SC_RESTORE: begin
          Result := DefWindowProcW(hWindow, Msg, iWParam, iLParam);
          Application.Restore;
          GetWindowRect(Application.Handle, lrc_Rect);
          SetWindowPos(hWindow, 0, lrc_Rect.Left, lrc_Rect.Top, 0, 0, SWP_SHOWWINDOW);
          //元のサイズに戻したときメインフォームをアクティブにするため。
          SendMessage(l_MainForm.Handle, WM_ACTIVATE, 1, 0);
        end;

        else begin
          Result := DefWindowProcW(hWindow, Msg, iWParam, iLParam);
        end;
      end;
    end;

    WM_ACTIVATEAPP: begin
      //TApplicationEventsのイベントを起こすため
      SendMessage(Application.Handle, Msg, iWParam, iLParam);
      if (l_MainForm <> nil) then begin
        //タスクバー上のアイコンをクリックしたときにメインフォームをアクティブにするため。
        if (TWMActivateApp(lr_Msg).Active) then begin
          SendMessage(l_MainForm.Handle, WM_ACTIVATE, 1, 0);
        end;
      end;
    end;

    WM_DESTROY: begin
      //Applicationをトップレベルウィンドウに戻しておく。
      Windows.SetParent(Application.Handle, 0);
      PostQuitMessage(0);
    end;

   //その他に必要なメッセージがあれば書き足す。

   else begin
      Result := DefWindowProcW(hWindow, Msg, iWParam, iLParam);
    end;
  end;
end;

procedure gpcUBaseAppCreate;
var
  l_WndClass: TWndClassW;
  lrc_Rect:   TRect;
  lh_Menu:    HMENU;
begin
  if (IsWindow(ghUAppHandle)) then begin
Exit;
  end;

  FillChar(l_WndClass, SizeOf(l_WndClass), 0);
  with l_WndClass do begin
    style          := 0;
    lpfnWndProc    := @UBaseAppWndProc;
    cbClsExtra     := 0;
    cbWndExtra     := 0;
    hInstance      := SysInit.HInstance;
    hIcon          := LoadIconW(hInstance, 'MAINICON');
    hCursor        := 0;
    hbrBackground  := 0;
    lpszMenuName   := nil;
    lpszClassName  := gcsUAPP_CLASSNAME;
  end;
  if (RegisterClassW(l_WndClass) = 0)
  and not(GetLastError = ERROR_CLASS_ALREADY_EXISTS)
  then begin
Exit;
  end;

  //サイズをApplicationと同じにするため。
  GetWindowRect(Application.Handle, lrc_Rect);

  ghUAppHandle := CreateWindowExW(
    0,                  //拡張スタイル
    gcsUAPP_CLASSNAME,  //クラス名
    PWideChar(WideString(Application.Title)), //ウィンドウテキスト
    WS_VISIBLE          //スタイル
    or WS_CAPTION
    or WS_POPUP
    or WS_SYSMENU
    or WS_MINIMIZEBOX
    ,
    lrc_Rect.Left,      //Left
    lrc_Rect.Top,       //Top
    0,                  //Width
    0,                  //Height
    0,                  //親ウィンドウまたはオーナーウィンドウ
    0,                  //メインメニュー
    SysInit.HInstance,  //インスタンス
    nil
  );
  if (ghUAppHandle = 0) then begin
Exit;
  end;

  //タスクバーのメニューから不要なものを除く。
  lh_Menu := GetSystemMenu(ghUAppHandle, False);
  DeleteMenu(lh_Menu, 4, MF_BYPOSITION); //最大化
  DeleteMenu(lh_Menu, 2, MF_BYPOSITION); //サイズ変更
  DeleteMenu(lh_Menu, 1, MF_BYPOSITION); //移動
  DrawMenuBar(lh_Menu);

  //Applicationを子ウィンドウにしてしまう。
  Windows.SetParent(Application.Handle, ghUAppHandle);
end;

procedure gpcUBaseAppFree;
begin
  Windows.SetParent(Application.Handle, 0);
  if (IsWindow(ghUAppHandle)) then begin
    DestroyWindow(ghUAppHandle);
  end;
  ghUAppHandle := 0;
end;

function gfnsUBaseAppTitleGet: WideString;
//タイトルを取得。
var
  li_Len:  Integer;
  lp_Buff: PWideChar;
begin
  Result := '';

  li_Len := SendMessageW(ghUAppHandle, WM_GETTEXTLENGTH, 0, 0);
  if (li_Len > 0) then begin
    li_Len  := li_Len +1;
    lp_Buff := AllocMem(li_Len * 2);
    try
      SendMessageW(ghUAppHandle, WM_GETTEXT, WPARAM(li_Len), LPARAM(lp_Buff));
      Result := WideString(lp_Buff);
    finally
      FreeMem(lp_Buff);
    end;
  end;
end;

procedure gpcUBaseAppTitleSet(sTitle: WideString);
//タスクバーに表示するタイトルをセット。
begin
  if (IsWindow(ghUAppHandle)) then begin
    SetWindowTextW(ghUAppHandle, PWideChar(sTitle));
  end;
end;


end.

クラス名はTUApplicationとしていますがエラーにならなければ何でもかまいません。
作成したウィンドウのウィンドウハンドルを保持するためのグローバル変数を用意します。
Unicode対応ウィンドウに対する操作はこのウィンドウハンドルに対して行います。

const
  //クラス名
  gcsUAPP_CLASSNAME = 'TUApplication';

var
  //Unicode対応ウィンドウのウィンドウハンドルを保持するグローバル変数
  ghUAppHandle: HWND = 0

UBaseAppWndProc関数でUnicode対応ウィンドウのメッセージを処理します。
とりあえずこの例では「最小化」と「元のサイズに戻す」、アプリケーションがアクティブになったときの処理を行っています。
これらの他に、例えばTApplicationEventsなどを利用してアプリケーションのイベントを処理しようと思ったら、対応するメッセージをこのUBaseAppWndProcの中で捕らえてApplicationにそのメッセージを転送しなければなりません。

function UBaseAppWndProc(hWindow: HWND; Msg: UINT; iWParam: WPARAM; iLParam: LPARAM): LRESULT; stdcall;
var
  lr_Msg:     TMessage;
  lrc_Rect:   TRect;
  l_MainForm: TForm;
begin
  Result := 0;
  l_MainForm := Application.MainForm;

  FillChar(lr_Msg, SizeOf(lr_Msg), 0);
  with lr_Msg dobegin
    Msg := hWindow;
    WParam := iWParam;
    LParam := iLParam;
    Result := 0;
  end;

  case Msg of
    WM_SYSCOMMAND: begin
      case (TWMSysCommand(lr_Msg).CmdType) of
        SC_MINIMIZE: begin
          //最小化のときのアニメーションが不自然にならないようにメインフォームの大きさにしておく。

    ...

    end;

    WM_ACTIVATEAPP: begin
      //TApplicationEventsのイベントを起こすため
      SendMessage(Application.Handle, Msg, iWParam, iLParam);

   ...

    end;

    WM_DESTROY: begin
      //Applicationをトップレベルウィンドウに戻しておく。
      Windows.SetParent(Application.Handle, 0);
      PostQuitMessage(0);
    end;

    //その他に必要なメッセージがあれば書き足す。

    else begin
      Result := DefWindowProcW(hWindow, Msg, iWParam, iLParam);
    end;
  end;
end;

以下はこのu_baseユニットを利用してタスクバーの表示をUnicode対応にする場合のメインフォームの例です。
メインフォームは最小化ボタンと閉じるボタンを押したときの動作をデフォルトの動作から変える必要があります。

unit main;

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

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private 宣言 }
    procedure WMSysCommand(var Msg: TWMSysCommand); message WM_SYSCOMMAND;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation
uses
  u_base;

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  //Unicode対応Applicationウィンドウ作成。
  u_base.gpcUBaseAppCreate;
  //一例として'Queensrÿche'をタイトルにセット。
  u_base.gpcUBaseAppTitleSet(WideFormat('Queensr%sche', [WideChar($00FF)]));
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  //Unicode対応Applicationウィンドウ破棄。
  u_base.gpcUBaseAppFree;
end;

procedure TForm1.WMSysCommand(var Msg: TWMSysCommand);
begin
  case Msg.CmdType of
    SC_MINIMIZE: begin
      //最小化ボタンを押したメッセージをUnicode対応Applicationウィンドウに渡す。
      SendMessageW(u_base.ghUAppHandle, WM_SYSCOMMAND, WPARAM(SC_MINIMIZE and $FFF0), 0);
    end;

    SC_CLOSE: begin
      //終了のメッセージをUnicode対応Applicationウィンドウに渡す。
      SendMessageW(u_base.ghUAppHandle, WM_SYSCOMMAND, WPARAM(SC_CLOSE and $FFF0), 0);
    end;

    else begin
      inherited;
    end;
  end;
end;


end.