Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2010年07月07日] [更新 2013年11月09日] Delphi サンプルプログラム集
SystemParametersInfo 関数サンプル
S03_アイコン関係
動作確認等 Windows 7 U64(SP1) + Delphi XE Pro
S03_SystemParametersInfo_Icon.zip [2,222 KB] 2013年11月09日版 (EXE 同梱)







01_アイコン関係メトリック


Windows XPでは [画面のプロパティ] ダイアログの [デザイン] から [詳細設定],Windows 7 では [コントロールパネル] [個人設定] [フォントの色] で行うアイコン関係の取得と設定です.
本ページの他のサンプルは,このサンプルの個別の取得と設定となっています.

キャプションの折り返しは,古い Windows にはありましたが,現在はこの機能はありません.マイクロソフトのコントロールパネルからの設定の記事にもありますが,「反映されない場合はログインし直すか再起動」することになります.
これらの他,uiAction パラメータに SPI_SETICONS というのがあります.これは,例えばファイルやプログラムの関連付けでアイコンを変更した時に,更新をシステムに通知して再ロードするために使用するということですが,筆者は動作確認していません.

筆者の環境では,フォントの設定が,エクスプローラでは,一度ウィンドウを閉じて,再表示しないと結果が反映されない部分がありました.本サンプルでは,SystemParametersInfo 関数の最後の引数に SPIF_SENDCHANGE or SPIF_UPDATEINIFILE を指定して,次回のシステム起動時も設定が有効になるようにしています.


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

uiAction パラメータ uiParam と pvParam パラメータ
SPI_GETICONMETRICS 取得
ICONMETRICS 構造体を使用
構造体の cbSize はこの構造体のサイズとする
uiParam もこの構造体のサイズ
pvParam はこの構造体へのポインタ
この構造体に情報が格納される
SPI_SETICONMETRICS 設定
ICONMETRICS 構造体に新しい値を設定
この構造体の cbSize をこの構造体のサイズとする
uiParam もこの構造体のサイズ
pvParam はこの構造体のポインタ


図1
設計時画面
  • 横と縦のドットはアイコンの幅 + 間隔
  • [コントロールパネル] での項目名は [間隔] となっている
図2
起動すると現在の設定を取得
図3
通常画面
図4
設定を変更した画面の例
  • 設定後に再起動した結果

リスト1
アイコンのメトリック関係の取得と設定
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    LabeledEdit1: TLabeledEdit;
    LabeledEdit2: TLabeledEdit;
    CheckBox1: TCheckBox;
    FontDialog1: TFontDialog;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private 宣言 }
    OrignalRecord : TIconMetrics;
    NewRecord     : TIconMetrics;
    StrReg        : String;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

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

  NewRecord := OrignalRecord;

  LabeledEdit1.Text := IntToStr(OrignalRecord.iHorzSpacing);
  LabeledEdit2.Text := IntToStr(OrignalRecord.iVertSpacing);
  CheckBox1.Checked := NewRecord.iTitleWrap = 1;

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

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

  //横ドット
  NewRecord.iHorzSpacing := StrToIntDef(LabeledEdit1.Text,
                                        OrignalRecord.iHorzSpacing);
  //縦ドット
  NewRecord.iVertSpacing := StrToIntDef(LabeledEdit2.Text,
                                        OrignalRecord.iVertSpacing);
  //折返し表示
  NewRecord.iTitleWrap := Ord(CheckBox1.Checked);

  SystemParametersInfo(SPI_SETICONMETRICS,
                       SizeOf(NewRecord),
                       @NewRecord,
                       SPIF_SENDCHANGE or SPIF_UPDATEINIFILE);

  //変更をトップレベルのウインドウにWM_SETTINGCHANGEで通知する
  SendMessage(HWND_BROADCAST,
              WM_SETTINGCHANGE,
              SPI_SETICONMETRICS,
              Integer(PChar(StrReg)));

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

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

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

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

  SystemParametersInfo(SPI_SETICONMETRICS,
                       SizeOf(OrignalRecord),
                       @OrignalRecord,
                       SPIF_SENDCHANGE);

  //変更をトップレベルのウインドウにWM_SETTINGCHANGEで通知する
  SendMessage(HWND_BROADCAST,
              WM_SETTINGCHANGE,
              SPI_SETICONMETRICS,
              Integer(PChar(StrReg)));
  FormCreate(nil);

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

end.




02_アイコンのタイトルフォント


アイコンのタイトルフォントですが,ここではフォントサイズだけの取得と設定にしています.
デスクトップのフォントは設定後に反映されますが,他のウインドウは一度閉じて,開きなおさないと設定が有効とならない場合があります.


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

uiAction パラメータ uiParam と pvParam パラメータ
SPI_GETICONTITLELOGFONT 取得
LOGFONT 構造体を使用
uiParam はこの構造体のサイズ
pvParam はこの構造体へのポインタ
この構造体に論理フォントの情報が格納される
SPI_SETICONTITLELOGFONT 設定
LOGFONT 構造体に新しいパラメータを設定
uiParam はこの構造体のサイズ
pvParam は LOGFONT 構造体のポインタ


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

リスト2
アイコンのタイトルフォントのサイズの取得と設定
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, 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 宣言 }
    OrignalRecord : TLogFont;
    NewRecord     : TLogFont;
    StrReg        : String;
    DPIY          : Integer;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  プログラムを起動したら現在の設定を取得しておく
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  //画面Y方向の解像度(DPI)を取得
  //デスクトップのハンドル(GetDesktopWindow)からデスクトップのデバイスコンテキ
  //ストハンドルを取得
  DPIY := GetDeviceCaps(GetDC(GetDesktopWindow), LOGPIXELSY);

  SystemParametersInfo(SPI_GETICONTITLELOGFONT,
                       SizeOf(OrignalRecord),
                       @OrignalRecord,
                       0);

  NewRecord := OrignalRecord;
  SpinEdit1.Value := Abs(Trunc(NewRecord.lfHeight * 72.0 / DPIY));

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

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

  NewFontSize := SpinEdit1.Value;
  NewRecord.lfHeight := -NewFontSize * DPIY div 72;

  SystemParametersInfo(SPI_SETICONTITLELOGFONT,
                       SizeOf(NewRecord),
                       @NewRecord,
                       SPIF_SENDCHANGE);

  //変更をトップレベルのウインドウにWM_SETTINGCHANGEで通知する
  SendMessage(HWND_BROADCAST,
              WM_SETTINGCHANGE,
              SPI_SETICONMETRICS,
              Integer(PChar(StrReg)));

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

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

  SystemParametersInfo(SPI_SETICONTITLELOGFONT,
                       SizeOf(OrignalRecord),
                       @OrignalRecord,
                       SPIF_SENDCHANGE);

  //変更をトップレベルのウインドウにWM_SETTINGCHANGEで通知する
  SendMessage(HWND_BROADCAST,
              WM_SETTINGCHANGE,
              SPI_SETICONMETRICS,
              Integer(PChar(StrReg)));
  FormCreate(nil);

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

end.




03_アイコン整列グリッドの幅


アイコンを整列する時のグリッド幅の取得と設定です.再起動しないと反映されない場合があります.この現象は [コントロールパネル] から操作しても同じです.
再起動後に設定を有効にするには,SystemParametersInfo の最後の引数に SPIF_UPDATEINIFILE を追加しておきます.


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

uiAction パラメータ uiParam と pvParam パラメータ
SPI_ICONHORIZONTALSPACING [設定]
uiParam に新しい値をピクセル値で指定
SM_CXICON 未満の値を指定することはできない
pvParam は nil

[取得]
uiParam は 0
pvParam は整数型変数
実行後この変数に現在の値 (ピクセル値) が格納される


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

リスト3
アイコン整列グリッドの幅の取得と設定
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, 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_ICONHORIZONTALSPACING,
                       0,
                       OrignalValue,
                       0);

  SpinEdit1.Value := OrignalValue;
end;

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

  NewValue := SpinEdit1.Value;
  SystemParametersInfo(SPI_ICONHORIZONTALSPACING,
                       NewValue,
                       nil,
                       SPIF_SENDCHANGE);
  Screen.Cursor := crDefault;
end;

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

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

  Screen.Cursor := crDefault;
end;

end.




04_アイコン整列グリッドの高さ


アイコン整列時のグリッド高さの取得と設定です.再起動しないと反映されない場合があります.これは [コントロールパネル] から操作しても同じです.
再起動後に設定を有効にするには,SystemParametersInfo の最後の引数に SPIF_UPDATEINIFILE を追加しておきます.


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

uiAction パラメータ uiParam と pvParam パラメータ
SPI_ICONVERTICALSPACING [設定]
uiParam に新しい値をピクセル値で指定
SM_CYICON 未満の値を指定することはできない
pvParam は nil

[取得]
uiParam は 0
pvParam は整数型変数
実行後この変数に現在の値 (ピクセル値) が格納される


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

リスト4
アイコン整列グリッドの高さの取得と設定
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, 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_ICONVERTICALSPACING,
                       0,
                       OrignalValue,
                       0);

  SpinEdit1.Value := OrignalValue;
end;

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

  NewValue := SpinEdit1.Value;
  SystemParametersInfo(SPI_ICONVERTICALSPACING,
                       NewValue,
                       nil,
                       SPIF_SENDCHANGE);
  Screen.Cursor := crDefault;
end;

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

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

  Screen.Cursor := crDefault;
end;

end.