[ S09_ウィンドウ関係の SystemParametersInfo 関数サンプル ]

Delphi Programming / Object Pascal

[掲載 2010年07月07日] [更新 2013年11月11日]　Delphi サンプルプログラム集

SystemParametersInfo 関数サンプル S09_ウィンドウ関係
動作確認等	Windows 7 U64(SP1) + Delphi XE Pro

S09_SystemParametersInfo_Window.zip　[7,136 KB]　2013年11月11日版 (EXE 同梱)

SystemParametersInfo 関数サンプル概要 (別ページ)
SystemParametersInfo 関数サンプルサンプルで使用している構造体 (別ページ)
01_アクティブウインドウのトラッキング状態
02_アクティブウインドウトラッキングで最前面表示
03_アクティブウインドウトラッキングの待ち時間
04_ユーザ操作関連のアニメーション効果
05_ウインドウのサイズ変更枠
06_キャレット幅
07_ウィンドウのフルドラッグ
08_ウインドウのタスクバー点滅
09_タスクバー点滅テスト用アプリケーション
10_キャプションバーとタスクバーを強制的に点滅
11_最小化ウインドウの配置方法
12_非クライアント領域のメトリック
13_システムの GUI で使用されるフォントを取得
14_その他

2010年08月12日
[08_ウィンドウのタスクバー点滅] に確認用プログラムを追加

01_アクティブウインドウのトラッキング状態

トラッキング (ウィンドウにマウスポインタが重なっている状態) によってそのウィンドウをアクティブにするかを設定するパラメータのテストです．

表1
uiAction パラメータは SystemParametersInfo 関数の第 1 引数
uiParam は第 2 引数で，pvParam は第 3 引数

uiAction パラメータ	uiParam と pvParam パラメータ
SPI_GETACTIVEWINDOWTRACKING	取得 uiParam は 0 pvParam は BOOL 型変数この変数が 0 の時は有効．無効の時は 0
SPI_SETACTIVEWINDOWTRACKING	設定 uiParam は 0 pvParam を 0 以外にすると有効，0 にすると無効

	図1 起動すると現在の設定を表示
	図2 この機能が有効な場合マウスカーソルが後ろのウィンドウに移動してアクティブになっている

リスト1
アクティブウインドウのトラッキング状態

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    CheckBox1: TCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
    OrignalValue : Boolean;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  プログラムを起動したら現在の設定を取得しておく
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  SystemParametersInfo(SPI_GETACTIVEWINDOWTRACKING,
                       0,
                       @OrignalValue,
                       0);
  CheckBox1.Checked := OrignalValue;
end;

//=============================================================================
//  [設定]ボタン
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  Screen.Cursor := crHourGlass;

  SystemParametersInfo(SPI_SETACTIVEWINDOWTRACKING,
                       0,
                       Pointer(Ord(CheckBox1.Checked)),
                       SPIF_SENDCHANGE);

  Screen.Cursor := crDefault;
end;

//=============================================================================
//  元に戻す
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  Screen.Cursor := crHourGlass;

  SystemParametersInfo(SPI_SETACTIVEWINDOWTRACKING,
                       0,
                       Pointer(Ord(OrignalValue)),
                       SPIF_SENDCHANGE);
  FormCreate(nil);
  Screen.Cursor := crDefault;
end;

end.

02_アクティブウインドウトラッキングで最前面表示

トラッキングによってウィンドウをアクティブして最前面に移動するかを指定するフラグの取得と設定のサンプルです．トラッキングが有効になっていないと機能しません．
添付の EXE を実行する時は，どのウィンドウにも隠れないようにします．他のウィンドウに隠れてしまうと，テストプログラムを最前面にするのが困難となります．

表2
uiAction パラメータは SystemParametersInfo 関数の第 1 引数
uiParam は第 2 引数で，pvParam は第 3 引数

uiAction パラメータ	uiParam と pvParam パラメータ
SPI_GETACTIVEWNDTRKZORDER	取得 uiParam は 0 pvParam は BOLL 型変数 pvParam が 0 以外の値の場合は有効．0 なら無効
SPI_SETACTIVEWNDTRKZORDER	設定 uiParam は 0 pvParam を 0 以外の値にすると有効．0 なら無効

	図3 起動すると現在の設定を表示
	図4 有効な場合の実行例ウィンドウにマウスカーソルを移動すると，クリックしなくてもアクティブになって最前面に移動

リスト2
アクティブウインドウトラッキングで最前面表示

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    CheckBox1: TCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
    OrignalValue : Boolean;
    TrackingValue : Boolean;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  プログラムを起動したら現在の設定を取得しておく
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  //アクティブウインドウのトラッキングを有効にしないと機能しないので元の値を取得
  SystemParametersInfo(SPI_GETACTIVEWINDOWTRACKING,
                       0,
                       @TrackingValue,
                       0);

  //アクティブウインドウトラッキングで最前面表示の現在の設定を取得
  SystemParametersInfo(SPI_GETACTIVEWNDTRKZORDER,
                       0,
                       @OrignalValue,
                       0);
  CheckBox1.Checked := OrignalValue;
end;

//=============================================================================
//  [設定]ボタン
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  V : Integer;
begin
  Screen.Cursor := crHourGlass;

  V := 1;
  SystemParametersInfo(SPI_SETACTIVEWINDOWTRACKING,
                       0,
                       Pointer(V),
                       SPIF_SENDCHANGE);

  SystemParametersInfo(SPI_SETACTIVEWNDTRKZORDER,
                       0,
                       Pointer(Ord(CheckBox1.Checked)),
                       SPIF_SENDCHANGE);

  Screen.Cursor := crDefault;
end;

//=============================================================================
//  元に戻す
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  Screen.Cursor := crHourGlass;

  SystemParametersInfo(SPI_SETACTIVEWINDOWTRACKING,
                       0,
                       Pointer(Ord(TrackingValue)),
                       SPIF_SENDCHANGE);

  SystemParametersInfo(SPI_SETACTIVEWNDTRKZORDER,
                       0,
                       Pointer(Ord(OrignalValue)),
                       SPIF_SENDCHANGE);
  FormCreate(nil);
  Screen.Cursor := crDefault;
end;

end.

03_アクティブウインドウトラッキングの待ち時間

上で説明したトラッキングの設定が有効となるまでの時間の取得と設定サンプルです．
Windows 7 ではこの設定は機能しませんでした．

表3
uiAction パラメータは SystemParametersInfo 関数の第 1 引数
uiParam は第 2 引数で，pvParam は第 3 引数

uiAction パラメータ	uiParam と pvParam パラメータ
SPI_GETACTIVEWNDTRKTIMEOUT	取得 uiParam は 0 pvParam は DWORD 型変数この値が待ち時間 (ミリ秒)
SPI_SETACTIVEWNDTRKTIMEOUT	設定 uiParam は 0 pvParam に待ち時間をミリ秒で指定

図5
起動すると現在の設定を表示

リスト3
アクティブウインドウトラッキングの待ち時間

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls, Spin;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    SpinEdit1: TSpinEdit;
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
    OrignalValue : Integer;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  プログラムを起動したら現在の設定を取得しておく
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  //現在の設定値読出し
  SystemParametersInfo(SPI_GETACTIVEWNDTRKTIMEOUT,
                       0,
                       @OrignalValue,
                       0);

  SpinEdit1.Value := OrignalValue;
end;

//=============================================================================
//  [設定]ボタン
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  NewValue : Integer;
begin
  Screen.Cursor := crHourGlass;

  //設定した値をセット
  NewValue := SpinEdit1.Value;
  SystemParametersInfo(SPI_SETACTIVEWNDTRKTIMEOUT,
                       0,
                       Pointer(NewValue),
                       SPIF_SENDCHANGE);

  Screen.Cursor := crDefault;
end;

//=============================================================================
//  元に戻す
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);

begin
  Screen.Cursor := crHourGlass;

  SystemParametersInfo(SPI_SETACTIVEWNDTRKTIMEOUT,
                       0,
                       Pointer(OrignalValue),
                       SPIF_SENDCHANGE);
  FormCreate(nil);

  Screen.Cursor := crDefault;
end;

end.

04_ユーザ操作関連のアニメーション効果

このフラグが有効になっていると，例えばウィンドウを最小化したり元のサイズに戻す際，フェードインやフェードアウトするようになります．

表4
uiAction パラメータは SystemParametersInfo 関数の第 1 引数
uiParam は第 2 引数で，pvParam は第 3 引数

uiAction パラメータ	uiParam と pvParam パラメータ
SPI_GETANIMATION	取得 ANIMATIONINFO 構造体を使用この構造体の cbSize を構造体のサイズとする uiParam もこの構造体のサイズ pvParam はこの構造体へのポインタ
SPI_SETANIMATION	設定 ANIMATIONINFO 構造体に新しい情報を設定この構造体の cbSize をこの構造体のサイズとする uiParam もこの構造体のサイズ pvParam は ANIMATIONINFO 構造体へのポインタ

図6
起動すると現在の設定を表示

リスト4
ユーザ操作関連のアニメーション効果

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    CheckBox1: TCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
    OrignalRecord : TAnimationInfo;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  プログラムを起動したら現在の設定を取得しておく
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  OrignalRecord.cbSize := SizeOf(TAnimationInfo);
  SystemParametersInfo(SPI_GETANIMATION,
                       SizeOf(TAnimationInfo),
                       @OrignalRecord,
                       0);
  CheckBox1.Checked := OrignalRecord.iMinAnimate <> 0;
end;

//=============================================================================
//  [設定]ボタン
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  NewRecord : TAnimationInfo;
begin
  Screen.Cursor := crHourGlass;

  NewRecord.cbSize := SizeOf(TAnimationInfo);
  NewRecord.iMinAnimate := Ord(CheckBox1.Checked);
  SystemParametersInfo(SPI_SETANIMATION,
                       SizeOf(TAnimationInfo),
                       @NewRecord,
                       SPIF_SENDCHANGE);

  Screen.Cursor := crDefault;
end;

//=============================================================================
//  元に戻す
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  Screen.Cursor := crHourGlass;

  SystemParametersInfo(SPI_SETANIMATION,
                       SizeOf(TAnimationInfo),
                       @OrignalRecord,
                       SPIF_SENDCHANGE);
  FormCreate(nil);
  Screen.Cursor := crDefault;
end;

end.

05_ウインドウのサイズ変更枠

ウィンドウのサイズ変更枠サイズ変更のサンプルコードです．

表5
uiAction パラメータは SystemParametersInfo 関数の第 1 引数
uiParam は第 2 引数で，pvParam は第 3 引数

uiAction パラメータ	uiParam と pvParam パラメータ
SPI_GETBORDER	取得 uiParam は 0 pvParam は整数型変数へのポインタこの変数に，この乗数の値が格納される
SPI_SETBORDER	設定 uiParam に新しい値を指定 pvParam は nil

	図7 起動すると現在の設定を表示
	図8 変更例

リスト5
ウインドウのサイズ変更枠

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls, Spin;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    SpinEdit1: TSpinEdit;
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
    OrignalValue : Integer;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  プログラムを起動したら現在の設定を取得しておく
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  //現在の設定値読出し
  SystemParametersInfo(SPI_SETBORDER,
                       0,
                       @OrignalValue,
                       0);

  SpinEdit1.Value := OrignalValue;
end;

//=============================================================================
//  [設定]ボタン
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  NewValue : Integer;
begin
  Screen.Cursor := crHourGlass;

  //設定した値をセット
  NewValue := SpinEdit1.Value;
  SystemParametersInfo(SPI_SETBORDER,
                       NewValue,
                       nil,
                       SPIF_SENDCHANGE);

  Screen.Cursor := crDefault;
end;

//=============================================================================
//  元に戻す
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  Screen.Cursor := crHourGlass;

  SystemParametersInfo(SPI_SETBORDER,
                       OrignalValue,
                       nil,
                       SPIF_SENDCHANGE);
  FormCreate(nil);

  Screen.Cursor := crDefault;
end;

end.

06_キャレット幅

テキスト入力用カーソル幅の取得と設定のサンプルです．

表6
uiAction パラメータは SystemParametersInfo 関数の第 1 引数
uiParam は第 2 引数で，pvParam は第 3 引数

uiAction パラメータ	uiParam と pvParam パラメータ
SPI_GETCARETWIDTH	取得 uiParam は 0 pvParam は DWORD 型変数へのポインタこの値がキャレットの幅のピクセル単位の値
SPI_SETCARETWIDTH	設定 uiParam は 0 pvParam は設定するキャレット幅のピクセル値

	図9 起動すると現在の設定を表示
	図10 変更例

リスト6
キャレット幅の設定

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls, Spin;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    SpinEdit1: TSpinEdit;
    Label1: TLabel;
    Edit1: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
    OrignalValue : Integer;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  プログラムを起動したら現在の設定を取得しておく
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  //現在の設定値読出し
  SystemParametersInfo(SPI_GETCARETWIDTH,
                       0,
                       @OrignalValue,
                       0);

  SpinEdit1.Value := OrignalValue;
end;

//=============================================================================
//  [設定]ボタン
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  NewValue : Integer;
begin
  Screen.Cursor := crHourGlass;

  //設定した値をセット
  NewValue := SpinEdit1.Value;
  SystemParametersInfo(SPI_SETCARETWIDTH,
                       0,
                       Pointer(NewValue),
                       SPIF_SENDCHANGE);

  Screen.Cursor := crDefault;
  Edit1.SetFocus;
end;

//=============================================================================
//  元に戻す
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  Screen.Cursor := crHourGlass;

  SystemParametersInfo(SPI_SETCARETWIDTH,
                       0,
                       Pointer(OrignalValue),
                       SPIF_SENDCHANGE);
  FormCreate(nil);

  Screen.Cursor := crDefault;
  Edit1.SetFocus;
end;

end.

07_ウィンドウのフルドラッグ

ウィンドウをドラッグして移動する際，枠だけか，ウィンドウの内容を表示したままとするかを指定するフラグの取得と設定のサンプルです．
まだグラフィックスの性能が低い時代の Windows は，枠だけの移動でした．枠だけの移動では，移動を終了するとウィンドウの内容を表示します．

表7
uiAction パラメータは SystemParametersInfo 関数の第 1 引数
uiParam は第 2 引数で，pvParam は第 3 引数

uiAction パラメータ	uiParam と pvParam パラメータ
SPI_GETDRAGFULLWINDOWS	取得 uiParam は 0 pvParam は BOOL 型変数へのポインタ有効になっている場合は 1，無効の場合は 0
SPI_SETDRAGFULLWINDOWS	設定 uiParam が 0 以外の場合は有効，0 の場合は無効 pvParam は nil

	図11 起動すると現在の設定を表示
	図12 実行例無効にして枠だけの移動の場合

リスト7
ウィンドウのフルドラッグ

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    CheckBox1: TCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
    OrignalValue : Boolean;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  プログラムを起動したら現在の設定を取得しておく
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  //現在の設定値読出し
  SystemParametersInfo(SPI_GETDRAGFULLWINDOWS,
                       0,
                       @OrignalValue,
                       0);
  CheckBox1.Checked := OrignalValue;
end;

//=============================================================================
//  [設定]ボタン
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  Screen.Cursor := crHourGlass;

  SystemParametersInfo(SPI_SETDRAGFULLWINDOWS,
                       Ord(CheckBox1.Checked),
                       nil,
                       SPIF_SENDCHANGE);

  Screen.Cursor := crDefault;
end;

//=============================================================================
//  元に戻す
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  Screen.Cursor := crHourGlass;

  SystemParametersInfo(SPI_SETDRAGFULLWINDOWS,
                       Ord(OrignalValue),
                       nil,
                       SPIF_SENDCHANGE);
  FormCreate(nil);
  Screen.Cursor := crDefault;
end;

end.

08_ウインドウのタスクバー点滅

特定のウィンドウをフォアグラウンドウィンドウにするよう要求が発行され，その要求が拒否された場合，SetForegroundWindow 関数はタスクバー内のボタンを点滅させます．この点滅回数を取得または設定するサンプルです．
この点滅の動作については，以下の参考リンクの記事も参考にしてください．

最前面に表示するウィンドウに関する動作仕様が，Windows XP で変わりました．Windows 2000 以前と動作仕様が違っています．[Windows XP 環境への既存アプリケーションの移行] の [最前面ウィンドウの扱い] の項目の記事を参考にしてください (要ページ内検索)．

表8
uiAction パラメータは SystemParametersInfo 関数の第 1 引数
uiParam は第 2 引数で，pvParam は第 3 引数

uiAction パラメータ	uiParam と pvParam パラメータ
SPI_GETFOREGROUNDFLASHCOUNT	取得 uiParam は 0 pvParam は DWORD 型変数へのポインタこの変数に点滅回数が格納される
SPI_SETFOREGROUNDFLASHCOUNT	設定 uiParam は 0 pvParam に点滅回数を指定

図13
起動すると現在の設定を表示

このタスクバーの点滅回数の設定状態を実際に確認するためのプログラムを添付しました．
このプログラムを起動するとエクセルが起動します．
このプログラムを強制的に最前面に表示するためのコードも追加しています．チェックボックスをチェックするとその機能が有効になります．これは，スレッドのアタッチという手法を利用しています．

図14
テスト確認用プログラム

図15
[エクセルを前面] ボタンクリック

エクセルが前面に表示される
エクセルで何か作業する
5 秒後に SetForegroundWindow 実行
フォームが前面にならずタスクバー点滅
点滅回数の確認が可能
チェックボックスをチェックして再度ボタンクリック
エクセルを最前面にしても，今度は 5 秒後にこのフォームが前面に表示される

リスト8
ウインドウのタスクバー点滅回数の設定

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls, Spin;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    SpinEdit1: TSpinEdit;
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
    OrignalValue : Integer;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  プログラムを起動したら現在の設定を取得しておく
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  //現在の設定値読出し
  SystemParametersInfo(SPI_GETFOREGROUNDFLASHCOUNT,
                       0,
                       @OrignalValue,
                       0);

  SpinEdit1.Value := OrignalValue;
end;

//=============================================================================
//  [設定]ボタン
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  NewValue : Integer;
begin
  Screen.Cursor := crHourGlass;

  //設定した値をセット
  NewValue := SpinEdit1.Value;
  SystemParametersInfo(SPI_SETFOREGROUNDFLASHCOUNT,
                       0,
                       Pointer(NewValue),
                       SPIF_SENDCHANGE);

  Screen.Cursor := crDefault;
end;

//=============================================================================
//  元に戻す
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  Screen.Cursor := crHourGlass;

  SystemParametersInfo(SPI_SETFOREGROUNDFLASHCOUNT,
                       0,
                       Pointer(OrignalValue),
                       SPIF_SENDCHANGE);
  FormCreate(nil);

  Screen.Cursor := crDefault;
end;

end.

09_タスクバー点滅テスト用アプリケーション

タスクバーの点滅回数というより，点滅の動作仕様をテストするためのプログラムです．
起動すると，同時にエクセルが起動します．エクセルに入力フォーカスがあった場合に，チェックボックスをチェックしておくと，強制的に，このプログラムをフォアグランドなウィンドウにできます．
この動作を実現するために，スレッドアタッチという手法を使用しています．

動作仕様については，参考リンクの [Windows XP 環境への既存アプリケーションの移行] の [最前面ウィンドウの扱い] の項目の記事も参考にしてください (要ページ内検索)．

リスト9
タスクバー点滅回数を確認するためのプログラム
スレッドをアタッチして，ウィンドウを最前面にするコードを実装

unit ForeGroundTestUnit;

interface

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

type
  TForeGroundTestForm = class(TForm)
    Button1: TButton;
    CheckBox1: TCheckBox;
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
    ExcelObj   : OleVariant;
    WorkBook   : OleVariant;
    WorkSheet  : OleVariant;
    XlsHandle  : hWND;
  public
    { Public 宣言 }
  end;

var
  ForeGroundTestForm: TForeGroundTestForm;

implementation

{$R *.dfm}

//=============================================================================
//  フォームを表示したらテスト用にエクセルを表示
//  操作用にエクセルのハンドルを取得しておく
//=============================================================================
procedure TForeGroundTestForm.FormShow(Sender: TObject);
begin
  if VarIsEmpty(ExcelObj) then begin
    ExcelObj  := CreateOleObject('Excel.Application');
    WorkBook  := ExcelObj.Workbooks.Add;
    WorkSheet := WorkBook.WorkSheets[1];
    ExcelObj.Visible := True;

    XlsHandle := FindWindow('XLMAIN', nil);
    ExcelObj.DisplayAlerts := False;
  end;
end;

//=============================================================================
//  フォームを閉じる時はエクセルも閉じる
//=============================================================================
procedure TForeGroundTestForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if not VarIsEmpty(ExcelObj) then begin
    try
      WorkBook.Saved := True;
      WorkBook.close;
    except
    end;

    WorkBook  := unAssigned;
    WorkSheet := unAssigned;
    ExcelObj  := unAssigned;
  end;
end;

//=============================================================================
//  エクセルを最前面にして一定時間後このフォームを前面にするために
//  SetForegroundWindowを実行
//  エクセルで何か作業をしていると，タスクバーでブリンクして前面表示しない
//  CheckBox1をチェックするとその対策を実行する
//=============================================================================
procedure TForeGroundTestForm.Button1Click(Sender: TObject);
var
  StartTime     : Cardinal;
  dTime         : Cardinal;
  ForegroundWnd : HWND;
  ThreadForeID  : Cardinal;
  ThreadSelfID  : Cardinal;
begin
  //エクセルを前面に
  //前面に表示されたらエクセルで何か作業する(単なるセルクリックでもOK)
  try
    SetForegroundWindow(XlsHandle);
  except
    exit;
  end;

  StartTime := GetTickCount;
  //5秒待つ
  dTime := 5000;
  while True do begin
    if (GetTickCount - StartTime) >= dTime then break;
    Application.ProcessMessages;
  end;

  //指定ウィンドウを前面に表示．ここではこのフォーム
  if CheckBox1.Checked = False then begin
    SetForegroundWindow(Handle);
  end else begin
    //目的のウィンドウが前面かを検査
    if GetForegroundWindow <> Handle then begin
      //現在の前面ウィンドウのバンドル取得(このサンプルの場合はXlsHandleと同じ)
      ForegroundWnd := GetForegroundWindow;
      //そのスレッドIDを取得
      ThreadForeID := GetWindowThreadProcessId(ForegroundWnd);

      //前面表示するウィンドウのスレッドIDを取得
      ThreadSelfID := GetCurrentThreadId;
      //スレッドのアタッチ
      AttachThreadInput(ThreadSelfID, ThreadForeID, True);

      //アタッチしたハンドルのウィドウを前面に
      SetForegroundWindow(Handle);
      //終了したらアタッチを切り離す
      AttachThreadInput(ThreadSelfID, ThreadForeID, False);
    end;
  end;
end;

end.

10_キャプションバーとタスクバーを強制的に点滅

タスクバーのアイコンは意図的に点滅させることもできます．そのサンプルです．下のコードは，ウィンドウが最小化された時に 5 回点滅させます．

リスト10
キャプションバーまたはタスクバーを意図的に点滅させる

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, AppEvnts;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
  protected
    procedure WMSysCommand(var Message: TWMSysCommand); message WM_SYSCOMMAND;
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

//=============================================================================
//  ボタンをクリックしたらタイトル(キャプション)バーを点滅
//  hwndはこのフォームのハンドルとする
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  FWinfo : TFlashwinfo;
begin
  FWinfo.cbSize    := SizeOf(FWInfo);
  FWinfo.hwnd      := Handle;
  FWinfo.dwFlags   := FLASHW_CAPTION;
  FWinfo.uCount    := 5;
  FWinfo.dwTimeout := 0;

  FlashWindowEx(FWinfo);
end;

//=============================================================================
//  最小化したらタスクバーのアイコンを点滅
//  Delphi2009(2007?)より前ではhwndはアプリケーションのハンドルとする
//  Delphi2009以降ではプロジェクトファイルで
//  Application.MainFormOnTaskbar := True;としておく
//=============================================================================
procedure TForm1.WMSysCommand(var Message: TWMSysCommand);
var
  FWinfo : TFlashwinfo;
begin
  if (Message.CmdType and $FFF0) = SC_MINIMIZE then begin
    FWinfo.cbSize    := SizeOf(FWInfo);
    FWinfo.hwnd      := Handle;
    FWinfo.dwFlags   := FLASHW_TRAY;
    FWinfo.uCount    := 5;
    FWinfo.dwTimeout := 0;

    FlashWindowEx(FWinfo);
  end;

  inherited;
end;

end.

11_最小化ウインドウの配置方法

最小化するウィンドウの配置方法の取得と設定のサンプルコードです．
これから最小化するウィンドウに対して有効となります．既に最小化しているウィンドウの最小化状態はそのままです．[画面領域外] とはタスクバーや通知領域のことです．

表9
uiAction パラメータは SystemParametersInfo 関数の第 1 引数
uiParam は第 2 引数で，pvParam は第 3 引数

uiAction パラメータ	uiParam と pvParam パラメータ
SPI_GETMINIMIZEDMETRICS	取得 MINIMIZEDMETRICS 構造体を使用この構造体の cbSize をこの構造体のサイズとする uiParam もこの構造体のサイズ pvParam はこの構造体へのポインタこの構造体に配置方法に関する情報が格納される
SPI_SETMINIMIZEDMETRICS	設定 MINIMIZEDMETRICS 構造体に情報を設定この構造体の cbSeiz をこの構造体のサイズとする uiParam もこの構造体のサイズ pvParam はこの構造体へのポインタ

	図16 起動すると現在の設定を表示
	図17 実行例右上から下方向に配置にした場合

リスト11
最初化ウインドウの配置方法

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls, Spin;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    SpinEdit1: TSpinEdit;
    SpinEdit2: TSpinEdit;
    SpinEdit3: TSpinEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    RadioGroup1: TRadioGroup;
    RadioGroup2: TRadioGroup;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure RadioGroup1Click(Sender: TObject);
  private
    { Private 宣言 }
    OrignalRecord : TMinimizedMetrics;
    NewRecord     : TMinimizedMetrics;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  プログラムを起動したら現在の設定を取得しておく
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
begin
  //現在の設定値読出し
  OrignalRecord.cbSize := SizeOf(TMinimizedMetrics);
  SystemParametersInfo(SPI_GETMINIMIZEDMETRICS,
                       SizeOf(TMinimizedMetrics),
                       @OrignalRecord,
                       0);
  NewRecord := OrignalRecord;

  //ウィンドウの幅と間隔
  SpinEdit1.Value := OrignalRecord.iWidth;
  SpinEdit2.Value := OrignalRecord.iHorzGap;
  SpinEdit3.Value := OrignalRecord.iVertGap;

  //基準位置
  if OrignalRecord.iArrange = ARW_BOTTOMLEFT  then RadioGroup1.ItemIndex := 0;
  if OrignalRecord.iArrange = ARW_BOTTOMRIGHT then RadioGroup1.ItemIndex := 1;
  if OrignalRecord.iArrange = ARW_TOPLEFT     then RadioGroup1.ItemIndex := 2;
  if OrignalRecord.iArrange = ARW_TOPRIGHT    then RadioGroup1.ItemIndex := 3;
  if OrignalRecord.iArrange = ARW_HIDE        then RadioGroup1.ItemIndex := 4;

  //配置方向
  if OrignalRecord.iArrange = ARW_LEFT  then RadioGroup2.ItemIndex := 0;
  if OrignalRecord.iArrange = ARW_RIGHT then RadioGroup2.ItemIndex := 1;
  if OrignalRecord.iArrange = ARW_UP    then RadioGroup2.ItemIndex := 2;
  if OrignalRecord.iArrange = ARW_DOWN  then RadioGroup2.ItemIndex := 3;
end;

//=============================================================================
//  [設定]ボタン
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  AArrange : Integer;
begin
  Screen.Cursor := crHourGlass;

  //設定した値をセット
  NewRecord.iWidth   := SpinEdit1.Value;
  NewRecord.iHorzGap := SpinEdit2.Value;
  NewRecord.iVertGap := SpinEdit3.Value;

  AArrange := 0;
  if RadioGroup1.ItemIndex = 0 then AArrange := AArrange or ARW_BOTTOMLEFT;
  if RadioGroup1.ItemIndex = 1 then AArrange := AArrange or ARW_BOTTOMRIGHT;
  if RadioGroup1.ItemIndex = 2 then AArrange := AArrange or ARW_TOPLEFT;
  if RadioGroup1.ItemIndex = 3 then AArrange := AArrange or ARW_TOPRIGHT;
  if RadioGroup1.ItemIndex = 4 then AArrange := AArrange or ARW_HIDE;

  if RadioGroup2.ItemIndex = 0 then AArrange := AArrange or ARW_LEFT;
  if RadioGroup2.ItemIndex = 1 then AArrange := AArrange or ARW_RIGHT;
  if RadioGroup2.ItemIndex = 2 then AArrange := AArrange or ARW_UP;
  if RadioGroup2.ItemIndex = 3 then AArrange := AArrange or ARW_DOWN;

  NewRecord.iArrange := AArrange;

  //設定実行
  SystemParametersInfo(SPI_SETMINIMIZEDMETRICS,
                       SizeOf(TMinimizedMetrics),
                       @NewRecord,
                       SPIF_SENDCHANGE);

  Screen.Cursor := crDefault;
end;

//=============================================================================
//  元に戻す
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  Screen.Cursor := crHourGlass;

  SystemParametersInfo(SPI_SETMINIMIZEDMETRICS,
                       SizeOf(TMinimizedMetrics),
                       @OrignalRecord,
                       SPIF_SENDCHANGE);
  FormShow(nil);

  Screen.Cursor := crDefault;
end;

//=============================================================================
//  配置の基準位置を指定するラジオグループのクリックイベント
//  基準位置によって指定可能な配置可能な方向が違うので判定
//=============================================================================
procedure TForm1.RadioGroup1Click(Sender: TObject);
var
  i      : Integer;
  AIndex : Integer;
begin
  //まず初期化してしまう
  RadioGroup2.ItemIndex := -1;
  for i := 0 to RadioGroup2.Items.Count -1 do begin
    RadioGroup2.Buttons[i].Enabled := False;
  end;

  AIndex := RadioGroup1.ItemIndex;

  RadioGroup2.Buttons[0].Enabled := (AIndex = 1) or (AIndex = 3);
  RadioGroup2.Buttons[1].Enabled := (AIndex = 0) or (AIndex = 2);
  RadioGroup2.Buttons[2].Enabled := (AIndex = 1) or (AIndex = 0);
  RadioGroup2.Buttons[3].Enabled := (AIndex = 3) or (AIndex = 2);
end;

end.

12_非クライアント領域のメトリック

タイトルバー (キャプションバー) 等，ウィンドウの非クライアント領域に関するメトリックの取得と設定のサンプルです．他の uiAction パラメータの設定同様，アプリケーションで独自に対応していると設定内容の更新はありません．

Windows Vista 以降では，メッセージのフォント設定は正常に機能しません．設定すると，ダイアログのウィンドウの Border スタイルが Windows XP スタイルになってしまいます．[元に戻す] でも元に戻りません．変更してしまった場合は，[05_ウインドウのサイズ変更枠] のサンプルで 0 を設定するとデフォルトの状態に戻ります．

表10
uiAction パラメータは SystemParametersInfo 関数の第 1 引数
uiParam は第 2 引数で，pvParam は第 3 引数

uiAction パラメータ	uiParam と pvParam パラメータ
SPI_GETNONCLIENTMETRICS	取得 NONCLIENTMETRICS 構造体を使用この構造体の cbSize をこの構造体のサイズとする uiParam もこの構造体のサイズ pvParam はこの構造体へのポインタこの構造体にメトリック値が格納される
SPI_SETNONCLIENTMETRICS	設定 NONCLIENTMETRICS 構造体に情報を設定この構造体の cbSize をこの構造体のサイズとする uiParam もこの構造体のサイズ pvParam はこの構造体へのポインタ

	図18 起動すると現在の設定を表示
	図19 実行例タイトルバーのフォントを変更

リスト12
非クライアント領域のメトリック

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls, Spin;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    Button2: TButton;
    SpinEdit1: TSpinEdit;
    SpinEdit2: TSpinEdit;
    SpinEdit3: TSpinEdit;
    SpinEdit4: TSpinEdit;
    SpinEdit5: TSpinEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    FontDialog1: TFontDialog;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private 宣言 }
    OrignalRecord : TNonClientMetrics;
    NewRecord     : TNonClientMetrics;
    StrReg        : String;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  プログラムを起動したら現在の設定を取得しておく
//  フォントの値はフォント設定ダイアログ表示の際に取得して表示する
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
var
  ASize : Integer;
begin
  //構造体のサイズ取得
  //Vista以降ではiPaddedBorderWidthが追加されているため
  //SiziOf(TNonClientMetrics)の値はXP以前ではこの分が多く取得されてしまう
  //そこでclass functionのSizeOf関数を使用する
  OrignalRecord.cbSize := OrignalRecord.SizeOf;

  //現在の設定値読出し
  SystemParametersInfo(SPI_GETNONCLIENTMETRICS,
                       SizeOf(TNonClientMetrics),
                       @OrignalRecord,
                       0);
  NewRecord := OrignalRecord;

  //境界線の幅
  SpinEdit1.Value := OrignalRecord.iBorderWidth;
  //スクロールバーのサイズ
  SpinEdit2.Value := OrignalRecord.iScrollWidth;
  //タイトル(キャプション)バーのサイズ
  SpinEdit3.Value := OrignalRecord.iCaptionWidth;
  //小さいタイトル(キャプション)バーのサイズ
  SpinEdit4.Value := OrignalRecord.iSmCaptionWidth;
  //メニューバーのサイズ
  SpinEdit5.Value := OrignalRecord.iMenuWidth;

  //このuiActionのパラメータの値があるレジストリの場所
  //WindowMetricsだけでも動作結果は同じ
  StrReg := 'HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics';
end;

//=============================================================================
//  [設定]ボタン
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  LockWindowUpdate(Handle);
  Screen.Cursor := crHourGlass;

  //設定した値をセット
  //フォント関係はフォントダイアログを表示して構造体の各々の値にセット
  NewRecord.iBorderWidth     := SpinEdit1.Value;
  NewRecord.iScrollHeight    := SpinEdit2.Value;
  NewRecord.iScrollWidth     := SpinEdit2.Value;
  NewRecord.iCaptionWidth    := SpinEdit3.Value;
  NewRecord.iCaptionHeight   := SpinEdit3.Value;
  NewRecord.iSmCaptionWidth  := SpinEdit4.Value;
  NewRecord.iSmCaptionHeight := SpinEdit4.Value;
  NewRecord.iMenuWidth       := SpinEdit5.Value;
  NewRecord.iMenuHeight      := SpinEdit5.Value;

  SystemParametersInfo(SPI_SETNONCLIENTMETRICS,
                       SizeOf(TNonClientMetrics),
                       @NewRecord,
                       SPIF_SENDCHANGE);

  //変更をトップレベルのウインドウにWM_SETTINGCHANGEで通知する
  //Windows XPはこれがなくても反映される
  //Windows 7では[ウインドウの色]から設定しても再起動が必要
  SendMessage(HWND_BROADCAST,
              WM_SETTINGCHANGE,
              SPI_SETNONCLIENTMETRICS,
              Integer(PChar(StrReg)));

  Screen.Cursor := crDefault;
  LockWindowUpdate(0);
end;

//=============================================================================
//  元に戻す
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  LockWindowUpdate(Handle);
  Screen.Cursor := crHourGlass;

  SystemParametersInfo(SPI_SETNONCLIENTMETRICS,
                       SizeOf(TNonClientMetrics),
                       @OrignalRecord,
                       SPIF_SENDCHANGE);

  //変更をトップレベルのウインドウにWM_SETTINGCHANGEで通知する
  //Windows XPはこれがなくても反映される
  //Windows 7では[ウインドウの色]から設定しても再起動が必要
  SendMessage(HWND_BROADCAST,
              WM_SETTINGCHANGE,
              SPI_SETNONCLIENTMETRICS,
              Integer(PChar(StrReg)));
  FormShow(nil);

  Screen.Cursor := crDefault;
  LockWindowUpdate(0);
end;

//=============================================================================
//  タイトル(キャプション)バーのフォント設定
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
var
  lf : TLogFont;
begin
  //作業用のTLogFont変数を使う
  lf := NewRecord.lfCaptionFont;
  //TLogFontの情報をTFontの情報に変換
  FontDialog1.Font.Handle := CreateFontIndirect(lf);

  if FontDialog1.Execute then begin
    //TFontの情報をTLogFontに変換
    GetObject(FontDialog1.Font.Handle, SizeOf(TLogFont), @lf);
    NewRecord.lfCaptionFont := lf;
  end;
end;

//=============================================================================
//  小さいタイトル(キャプション)バーのフォント設定
//=============================================================================
procedure TForm1.Button4Click(Sender: TObject);
var
  lf : TLogFont;
begin
  //作業用のTLogFont変数を使う
  lf := NewRecord.lfSmCaptionFont;
  //TLogFontの情報をTFontの情報に変換
  FontDialog1.Font.Handle := CreateFontIndirect(lf);

  if FontDialog1.Execute then begin
    //TFontの情報をTLogFontに変換
    GetObject(FontDialog1.Font.Handle, SizeOf(TLogFont), @lf);
    NewRecord.lfSmCaptionFont := lf;
  end;
end;

//=============================================================================
//  メニューバーのフォント設定
//=============================================================================
procedure TForm1.Button5Click(Sender: TObject);
var
  lf : TLogFont;
begin
  //作業用のTLogFont変数を使う
  lf := NewRecord.lfMenuFont;
  //TLogFontの情報をTFontの情報に変換
  FontDialog1.Font.Handle := CreateFontIndirect(lf);

  if FontDialog1.Execute then begin
    //TFontの情報をTLogFontに変換
    GetObject(FontDialog1.Font.Handle, SizeOf(TLogFont), @lf);
    NewRecord.lfMenuFont := lf;
  end;
end;

//=============================================================================
//  ステータスバーのフォント設定
//=============================================================================
procedure TForm1.Button6Click(Sender: TObject);
var
  lf : TLogFont;
begin
  //作業用のTLogFont変数を使う
  lf := NewRecord.lfStatusFont;
  //TLogFontの情報をTFontの情報に変換
  FontDialog1.Font.Handle := CreateFontIndirect(lf);

  if FontDialog1.Execute then begin
    //TFontの情報をTLogFontに変換
    GetObject(FontDialog1.Font.Handle, SizeOf(TLogFont), @lf);
    NewRecord.lfStatusFont := lf;
  end;
end;

//=============================================================================
//  メッセージのフォント設定
//  Windows Vista以降では正常に機能しない
//=============================================================================
procedure TForm1.Button7Click(Sender: TObject);
var
  lf : TLogFont;
begin
  //作業用のTLogFont変数を使う
  lf := NewRecord.lfMessageFont;
  //TLogFontの情報をTFontの情報に変換
  FontDialog1.Font.Handle := CreateFontIndirect(lf);

  if FontDialog1.Execute then begin
    //TFontの情報をTLogFontに変換
    GetObject(FontDialog1.Font.Handle, SizeOf(TLogFont), @lf);
    NewRecord.lfMessageFont := lf;
  end;
end;

end.

13_システムの GUI で使用されるフォントを取得

上のように，個別ではなく，システムの GUI で使用されるフォントは，GetStockObject 関数で取得できます．その参考コードです．

参考リンク
GetStockObject function (wingdi.h) | Microsoft Docs
GetObject function (wingdi.h) | Microsoft Docs

図20
システムの GUI 用フォント

リスト13
システムの GUI で使用されるフォントを取得

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  システムのGUIで使用されるフォントを取得する例
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  SysFont : HFONT;
  SysLogFont : TLogFont;
begin
  Memo1.Lines.Clear;
  Memo1.Lines.BeginUpdate;

  SysFont := GetStockObject(DEFAULT_GUI_FONT);
  GetObject(SysFont, Sizeof(TLogFont), @SysLogFont);

  Memo1.Lines.Add(SysLogFont.lfFaceName);
  Memo1.Lines.Add(IntToStr(SysLogFont.lfHeight));

  Memo1.Lines.EndUpdate;
end;

end.

14_その他

以上の他，以下のようなものがあります．

表11
uiAction パラメータは SystemParametersInfo 関数の第 1 引数
uiParam は第 2 引数で，pvParam は第 3 引数

uiAction パラメータ	uiParam と pvParam パラメータ
SPI_SETDRAGWIDTH	ドラッグ操作の開始とは見なされない幅の設定 uiParam に設定する幅のピクセル値 pvParam は nil GetSystemMetrics(SM_CXDRAG) でも取得可能
SPI_SETDRAGHEIGHT	ドラッグ操作の開始とは見なされない高さの設定 uiParam に設定する高さのピクセル値 pvParam は nil GetSystemMetrics(SM_CYDRAG) でも取得可能
SPI_GETFOREGROUNDLOCKTIMEOUT	フォアグラウンド移行の禁止時間 (ms) の取得 uiParam は 0 pvParam に現在値が格納されるデバック中は取得不可
SPI_SETFOREGROUNDLOCKTIMEOUT	フォアグラウンド移行の禁止時間 (ms) の設定 uiParam は 0 pvParam に新しい設定値デバック中は設定不可この値を 0 にすると SetforegroundWindow で直ちに該当ウィンドウが前面表示される (注意: Windows XP ではこの仕様が変更された)