ラベル win32 の投稿を表示しています。 すべての投稿を表示
ラベル win32 の投稿を表示しています。 すべての投稿を表示

2013年2月13日水曜日

IME のメッセージを Windows Hook で取得する


Delphi-ML で、IME の変換スタートと終了を知りたい、という投稿がありました。
全ての Edit をサブクラス化して実装しようとされていたのですが、それでは非常に大変だと思い、Windows Hook による方法を投稿しました。

それが、以下のコードです。

unit uIMEStartEnd;
 
interface
 
uses
Winapi.Windows;
 
type
// IME の開始と終了を知らせるイベント
TIMEStartEndNotifyEvent =
procedure(const iWnd: HWND; const iStart: Boolean) of object;
 
// イベントを受け取るイベントリスナを設定・削除する
procedure AddIMEEventListener(const iEvent: TIMEStartEndNotifyEvent);
procedure RemoveIMEEventListener(const iEvent: TIMEStartEndNotifyEvent);
 
implementation
 
uses
Winapi.Messages, Vcl.Controls, System.Generics.Collections;
 
var
// WindowsHook のハンドル
GHookHandle: HHOOK;
// イベントリスナのリスト
GHandlers: TList<TIMEStartEndNotifyEvent>;
// イベントリスナを追加
procedure AddIMEEventListener(const iEvent: TIMEStartEndNotifyEvent);
begin
if (GHandlers.IndexOf(iEvent) < 0) then
GHandlers.Add(iEvent);
end;
 
// イベントリスナを削除
procedure RemoveIMEEventListener(const iEvent: TIMEStartEndNotifyEvent);
begin
if (GHandlers.IndexOf(iEvent) > -1) then
GHandlers.Remove(iEvent);
end;
 
// イベントリスナを呼び出す
// iWnd IME メッセージを受け取ったウィンドウ
// iStart 開始の場合は True
procedure CallEventHandlers(const iWnd: HWND; const iStart: Boolean);
var
Handler: TIMEStartEndNotifyEvent;
begin
for Handler in GHandlers do
Handler(iWnd, iStart);
end;
 
// Hook のメイン関数
function CallWndProc(
iNCode: Integer;
iWParam: WPARAM;
iLParam: LPARAM): LRESULT; stdcall;
begin
// 先に、次のフックチェインを呼び出してしまう
Result := CallNextHookEx(GHookHandle, iNCode, iWParam, iLParam);
 
// iNCode が 0 以下ならフックは作業してはならない
if (iNCode < 0) then
Exit;
 
// lParam は CWPStruct 形式で、メッセージが入っている
with PCWPStruct(iLParam)^ do begin
case message of
WM_IME_STARTCOMPOSITION: begin
// IME 変換開始
CallEventHandlers(hwnd, True);
end;
 
WM_IME_ENDCOMPOSITION: begin
// IME 変換終了
CallEventHandlers(hwnd, False);
end;
end;
end;
end;
 
initialization
begin
// イベントハンドラを管理するリストを作成
GHandlers := TList<TIMEStartEndNotifyEvent>.Create;
 
// WindowsHook
GHookHandle :=
SetWindowsHookEx(WH_CALLWNDPROC, CallWndProc, 0, GetCurrentThreadID);
end;
 
finalization
begin
// Hook を解放
UnhookWIndowsHookEx(GHookHandle);
 
// リストを破棄
GHandlers.Free;
end;
 
end.

具体的にはソースコードのコメントを参照してほしいのですが、一点だけ Windows Hook について説明します。
Windows Hook は Windows の作業に割り込む機構です。
例えば、キーボードの入力があった時や、新しいウィンドウが開くときなど本来アプリケーション側からは見えない Windows の作業に割り込むことができます。
Windows Hook を設定するためには SetWindowsHookEx API を使います。
SetWindowsHookEx の説明を見て頂ければわかるように、様々なフックがあります。
今回は、その中で WH_CALLWNDPROC フックを使う事にしました。
このフックは Window Procedure にメッセージが渡されるタイミングで呼び出されます。
そのタイミングとはいつかというと、具体的には SendMessage API が呼ばれた時です。

PostMessage API を使った場合は、WH_GETMESSAGE フックが使えます。

WH_CALLWNDPROC フックを使うのは IME のメッセージは SendMessage で送られるためです。
そして、今回のソースでは SetWindowsHookEx の3番目の引数に 0 を指定しています。
ここに 0 を指定して、次の引数に現在の Thread ID を指定すると、現在のスレッドで処理される SendMessage についてフックされるます。
この Unit の Initialization 節はメインスレッドから呼ばれるので、メインスレッド(GUI の操作・表示をするスレッド)がメッセージを受け取る度に、CallWndProc 関数が呼ばれることになります。
その結果、Edit などで IME の処理が行われると、それを感知してイベントを発行できます。

また、SetWindowsHookEx の3番目の引数に HInstance を指定してフックする DLL を作ると、全プロセスに結びつくフックを作る事ができます。
これによって、他のプログラムのメッセージを見ることもできます。

これをグローバルフック DLL と呼びます。
グローバルフック DLL の作成については、また次回!


2013年1月21日月曜日

管理者権限で起動する CMD


開発していると、結構コマンドプロンプト(CMD.exe)を実行することがあります。
普通に CMD.exe を起動すると、普通の権限で起動します。
しかし、管理者権限でのみ動作するようなプログラムなどを起動したい場合に、一々 UAC が開くのは煩わしいものです。
かといって「管理者としてこのプログラムを起動する」っていうチェックをいれるというのも、いまいちです。
というのも、もしも顧客に対して提供するコマンドラインツールがあったとすると、「このコマンドを実行して下さい。このコマンドは管理者権限で~云々」と説明しなくてはならないためです(しかも正しく伝わる確率の方が低い!)。
そこで、管理者権限で起動する CMD.exe を作ってみます。

ポイントは3つ。

1つ目は、CMD.exe のパスの取得です。
CMD.exe のパスの取得はいくつかやり方があります。
まずは SHGetSpecialFolderLocation を使って「Windows\System32」のパスを取得し、そのパスに CMD.exe を結合して実行する方法です。
とても真っ当な方法ですが ItemIDList を取得したりと、何かと面倒です。
そこで、もう1つの方法「環境変数」から取得することにします。
環境変数「ComSpec」は、CMD.exe のパスを示す環境変数です。
取得した環境変数を展開して有効なパスに変換する API が ExpandEnvironmentStrings です。
これを使って「%ComSpec%」という環境変数を「C:\Windows\System32\cmd.exe」に変換します。

2つ目は、管理者権限での実行です。
とても有名なので既にご存じかも知れませんが、ShellExecuteEx の lpVerb に 'runas' を指定して、プログラムを実行すると UAC が開いて管理者権限で実行できます。
これについては過去のデベロッパーキャンプでエンバカデロの高橋さんが説明(pdf)されています。

3つ目は、起動しても自分自身は見せずに CMD.exe だけを実行する方法です。
プログラムを一個起動するだけなので {$APPTYPE CONSOLE} で、コンソールアプリとして実装すれば良さそうに見えますが、そうするとコンソールが開いてしまいます。
そこで、今回は何も指定しない、つまり {$APPTYPE GUI} としてアプリケーションを作る事にします。
こうすることで、開く Window(TForm)が存在しないため、何も表示せずにアプリケーションを実行可能です。

これらを踏まえたコードが下記です。

program AdminCMD;
 
// 自分を表示したくないので指定しない
//{$APPTYPE CONSOLE}
 
uses
Winapi.Windows, Winapi.ShellApi, System.SysUtils;
 
// 管理者権限で実行する
function RunAsAdmin(const iExeName, iParam: String): Boolean;
var
SEI: TShellExecuteInfo;
begin
Result := False;
 
// runas は、Vista 以降のみ動作する
if (CheckWin32Version(6)) then begin
ZeroMemory(@SEI, SizeOf(SEI));
 
with SEI do begin
cbSize := SizeOf(SEI);
Wnd := 0;
fMask := SEE_MASK_FLAG_DDEWAIT or SEE_MASK_FLAG_NO_UI;
lpVerb := 'runas';
lpFile := PChar(iExeName);
lpParameters := PChar(iParam);
nShow := SW_SHOW;
end;
 
Result := ShellExecuteEx(@SEI);
end;
end;
 
var
CmdPath: String;
begin
// 環境変数から CMD.exe のパスを取得する
CmdPath := StringOfChar(#0, MAX_PATH);
ExpandEnvironmentStrings(
PChar('%ComSpec%'),
PChar(CmdPath),
Length(CmdPath));
 
CmdPath := Trim(CmdPath);
 
// 管理者権限で実行
RunAsAdmin(CmdPath, '');
end.

このコードを実行すると……



UAC の確認ダイアログが出た後に



コマンドプロンプトが開きます。
使いどころを誤らなければ、便利なコマンドプロンプトだと思います。

2013年1月17日木曜日

IME が ATOK か見分ける

ごくごく希に IME をいじる時があります。
そして、MS-IME と ATOK で違う動作をさせたいなーという事が、すごっく希にあります。

そんなとき、Screen.ImesScreen.DefaultIme で IME の名前を取れば、ATOK かそうでないかが見分けられます。

たとえば、次のような関数で ATOK かどうかを見分けられます。

function IsATOK: Boolean;
begin
Result := (Screen.DefaultIme.IndexOf('ATOK') > -1);
end;

また、Screen.Imes.Objects[] プロパティには「入力ロケール識別子」(旧名:キーボードレイアウト)が入っています。 あるエディットコントロールでは、この識別子、また別の時には別の識別子、を指定して ActiveKeyboardLayout API を呼び出して、IME を指定したりすることもできます。

Screen.DefaultKbLayout というデフォルトの入力ロケール識別子を返すプロパティもあります。)

2012年9月26日水曜日

FMX.Types.TCanvas.DrawLine のアンチエイリアスと DDA




twitter で LandscapeSketch (WorkToolSmith) さんから、アンチエイリアスの付いていない線を引きたい!というお話しがありました。

FireMonkey で普通に線を描こうと思ったら、↓こんなコードになります。

// FBmp は TBitmap のインスタンス
FBmp.Canvas.BeginScene;
try
  FBmp.Canvas.DrawLine(
    TPointF.Create(0, 0),
    TPointF.Create(FBmp.Width, FBmp.Height),
    1);
finally
  FBmp.Canvas.EndScene;
end;

そうすると描ける線は↓こんな風にアンチエイリアスがかかって非常にキレイな線になります。



↓線を拡大したところ


大体のケースでは線がキレイになるし問題ないんだろうと思いますが、アンチエイリアスが不必要な場合もあります。
たとえば、領域指定でアンチエイリアスの扱いをどうするのかとか……?

では、アンチエイリアスを外そう!と思っても、一筋縄ではいきません。
というのも、FireMonkey の TCanvas は複数の実装があり、TCanvas は、それらの Abstract クラスでしかないからです。

Direct2D が使える環境では TCanvasD2D が実装で、それ以外の GDI+ が使える環境では TCanvasGdiPlus が実装です。
もちろん Mac であれば、また違って TCanvasQuartz が実装になっています。

そうなると、アンチエイリアスを外そうにも実装によって異なっているため、非常に面倒な作業になります。
そもそも、アンチエイリアスを解除できない場合も想定されます。

TCanvasGdiPlus  だけアンチエイリアスを外そうと思えば外せそうです。
それは GDI+に SetSmoothingMode という API があるからです。
ただし、TCanvasGdiPlus が持っている TGPGraphics のインスタンスは private 変数& pirvate メソッドでしか取得できないため、リフレクションを使うなど手荒な技が必要になります。

なお、実際にアンチエイリアスをかける実体は TStrokeBrush のインスタンスである TCanvas.Stroke です。

そういったわけで、FireMonkey でアンチエイリアスを外すくらいなら、自分で描いちゃおうぜっていうお話しです。

自分で線を描くためには DDA を使います。
DDA は Digital Differential Analyzer の略で日本語では「デジタル微分解析器」とかそんな意味です。

線を描くに当たって問題なのは「ディスプレイは画素の集まり」であって連続的な線を表せるわけでは無い事です。
そのため、始点から終点まで、どの画素を通るのかということを知る必要があります。
その計算をするのが(ここでの)DDA です。
その名の通り微分するので傾きが求まり、それをデジタル値として返します。

また、DDA が優れているのは、加算・減算・論理演算、のみで実装可能なことです。乗算や除算、小数演算などが必要無いため、非常に高速に実行できます。
ここでは Delphi 言語で実装していますが、機械語での実装も容易でしょう(有効かどうかはともあれ……)。

ということで、DDA で線の描画を実装したサンプルが↓です。


サンプルソースはここから(GitHub)


詳しい説明は、昔のデブキャンの資料(PDF)をどうぞ……と思ったら、そんなに詳しく書いていなかった件……。

大まかに説明すると、4つに場合分けします。

  • 幅の方が大きい場合
    • 始点の方が小さい
    • 終点の方が小さい
  • 高さの方が大きい場合
    • 始点の方が小さい
    • 終点の方が小さい

つまり、必ず小さい方から大きい方に動くように正規化してやります。
コードでは↓こんな感じです。

procedure DDA(
  iX1, iY1, iX2, iY2: Integer;
  const iOnDDAEvent: TDDAEvent;
  const iData: Pointer);
var
  (略)
begin
  XSize := abs(iX2 - iX1);
  YSize := abs(iY2 - iY1);

  if (XSize > YSize) then begin
    // 水平方向の方が広い場合
    Flag := XSize shr 1;

    if (iX1 < iX2) then begin
      // 左の方が小さい場合
      (略)
    end
    else begin
      // 右の方が小さい場合
      (略)
    end;
  end
  else begin
    // 垂直方向の方が広い場合
    Flag := YSize shr 1;

    if (iY1 < iY2) then begin
      // 上の方が小さい場合
       (略)
    end
    else begin
      // 下の方が小さい場合
      (略)
    end;
  end;
end;

それぞれの場合において、地道に X(n) に +1 をしていって、X(n+1) の値になったら Y(n)→Y(n+1) とするだけです。

全文ソースは GitHub に上がっているので、ご覧ください。

そんなこんなで DDA を使って書いた線がこちら。
赤がDDA で、青が通常の方法です。





赤の線はガックガクなのが判りますね

2012年9月24日月曜日

HotKeyStyleHook

皆さんご存じの通り、Vcl.ComCtrls.THotKey を使うと簡単にホットキーを設定したりできます。
THotKey を実際に貼ってみると下図のように、簡単にホットキーが表示できます。



だが!しかし!
VCL スタイルを設定していると下図のように白く浮いてしまうわけです!





かっこわるい!

これは、THotKey に専用の StyleHook が用意されていないために起きています(THotKey の StyleHook は TEditStyleHook が指定されています)。


Win32 の HotKey コントロールは自動的にホットキーを表示してくれますが、背景モードが OPAQUE になっています。
そのため、テキストの描画で、背景が塗りつぶされてしまうのです。

そこで、次の API を呼んでやります。

SetBkMode(Canvas.Handle, TRANSPARENT);

SetBkMode で TRANSPARENT に設定することで、テキストを描画したときに背景を塗りつぶさなくなります。

描画時に SetBkMode を呼ぶような Custom Style Hook の例が↓です。

unit uHotKeyStyleHook;

(略)

procedure THotKeyStyleHook.Paint(Canvas: TCanvas);
var
  Text: String;
  Shift: TShiftState;
  Key: Word;
begin
  // 表示する文字列を作成
  ShortCutToKey(THotKey(Control).HotKey, Key, Shift);

  if (ssAlt in Shift) then
    Text := Text + 'Alt + ';

  if (ssCtrl in Shift) then
    Text := Text + 'Ctrl + ';

  if (ssShift in Shift) then
    Text := Text + 'Shift + ';

  Text := Text + ShortCutToText(Key);
  
  // 背景モードを指定
  SetBkMode(Canvas.Handle, TRANSPARENT);

  // フォントカラーを StyleServices から取得
  Canvas.Font.Color := StyleServices.GetStyleFontColor(sfEditBoxTextNormal);

  // テキストを描画
  Canvas.TextOut(0, 0, Text);
end;

initialization
begin
  TCustomStyleEngine.RegisterStyleHook(THotKey, THotKeyStyleHook);
end;

end.

ここで、一点。
RegisterStyleHook を initialization 節に書いていますが、本来は StyleHook を適用したいコントロールの class constructor に書きます。
そうすると、そのコントロールを使わない限り、StyleHook が読み込まれることもありません。
しかし、THotKey は VCL で提供されているコントロールのため、THotKey のコードを書き換えるのは憚られます。
そのため、StyleHook 側の initialization 節に書いてみました。

この THotKeyStyleHook を使うために必要なコードは、たったこれだけです。

uses
  uHotKeyStyleHook;


uHotKeyStyleHook を組み込んだアプリは↓こちら。
ちゃんとスタイルが適用されました!!







ちなみに、このソースでは自分で文字列を組み立てて表示してますが、本当は


というインターフェースから、ホットキーの組み合わせ文字列を取得できるみたいです。
僕は上手くできなかったので、どなたかお願いいたします!

2012年9月23日日曜日

SysErrorMessage

初エントリなので軽めに。
CSS なんかの調節もしながら……。


Win32 API を呼んだとき、エラーが返ってきて、原因が知りたいなあ……
でも、メンドイなあっていうときには


を使うと便利です。

SysErrorMessage(GetLastError);

ってすると、簡単にエラーの原因を人間が読める文字列に!
僕は

function GetLastErrorMsg: String;
begin
  Result := SysErrorMessage(GetLastError);
end;

こんな関数を作って使っています。