unit wallvideo;

interface
uses
  Windows;

//壁紙
function gfnsWallPaperGet: WideString;
procedure gpcWallPaperSet(const sWFile: WideString);

//背景色
function gfniDesktopColorGet: DWORD;
procedure gpcDesktopColorSet(const iColor: DWORD);

//壁紙ビデオ
procedure gpcWallVideoInit;
procedure gpcWallVideoFree;


//===============================================================================
implementation
uses
  SysUtils;


//背景を退避するクラス・ここから -----------------------------------------------
//ユニットローカル
type
  TMyWallVideo = class(TObject)
  private
    F_sWallPaperName: WideString;
    F_iDesktopColor:  DWORD;
  public
    constructor Create;
    destructor  Destroy; override;
  end;

constructor TMyWallVideo.Create;
const
  //オーバーレイされる背景色
  lci_BGCOLOR = $100010;
begin
  inherited;

  //現在の壁紙と背景色の設定を記録しておく
  F_sWallPaperName := gfnsWallPaperGet;
  F_iDesktopColor  := gfniDesktopColorGet;

  gpcWallPaperSet('');             //壁紙を無しにする
  gpcDesktopColorSet(lci_BGCOLOR); //背景色を $100010 にする
end;

destructor TMyWallVideo.Destroy;
begin
  //壁紙を戻す
  if  (gfnsWallPaperGet = '')   //壁紙が空であり
  and (F_sWallPaperName <> '')  //退避していた壁紙ファイルが空でなければ
  then begin                   //処理に入る
    gpcWallPaperSet(F_sWallPaperName);
  end;

  //背景色を戻す
  if (gfniDesktopColorGet <> F_iDesktopColor) then begin
    gpcDesktopColorSet(F_iDesktopColor);
  end;

  inherited;
end;
//壁紙を退避するクラス・ここまで -----------------------------------------------


var
  lmyWallVideo: TMyWallVideo;  //unitローカル変数


//以下三つのルーチンが壁紙の退避とそれを戻す手続き
//最初に呼ぶ。ただし再セットアップはできない
procedure gpcWallVideoInit;
begin
  if not(Assigned(lmyWallVideo)) then begin
    lmyWallVideo := TMyWallVideo.Create;
  end;
end;

//後始末
procedure gpcWallVideoFree;
begin
  if (Assigned(lmyWallVideo)) then begin
    lmyWallVideo.Free;
    lmyWallVideo := nil;
  end;
end;

//再セットアップも可能
procedure gpcWallVideoSetup;
begin
  if not(Assigned(lmyWallVideo)) then begin
    lmyWallVideo := TMyWallVideo.Create;
  end else begin
    lmyWallVideo.gpcOverlaySet;
  end;
end;


//壁紙 -------------------------------------------------------------------------
function gfnsWallPaperGet: WideString;
//壁紙取得
const
  //Windows2000以降で壁紙のファイル名を取得
  SPI_GETDESKWALLPAPER = 115;
var
  lp_PWFile: PWideChar;
begin
  lp_PWFile := AllocMem((MAX_PATH + 1) * 2);
  try
    SystemParametersInfoW(SPI_GETDESKWALLPAPER, MAX_PATH, lp_PWFile, 0);
    Result := WideString(lp_PWFile);
  finally
    FreeMem(lp_PWFile);
  end;
end;

procedure gpcWallPaperSet(const sWFile: WideString);
//壁紙セット
begin
  SystemParametersInfoW(SPI_SETDESKWALLPAPER, 0, PWideChar(sWFile), SPIF_UPDATEINIFILE or SPIF_SENDWININICHANGE);
end;


//背景色 -----------------------------------------------------------------------
function gfniDesktopColorGet: DWORD;
begin
  Result := GetSysColor(COLOR_BACKGROUND);
end;

procedure gpcDesktopColorSet(const iColor: DWORD);
var
  li_Element: Integer;
begin
  //デスクトップの背景色を変更
  li_Element := COLOR_BACKGROUND;
  SetSysColors(1, li_Element, iColor);
end;


initialization
  lmyWallVideo := nil;

finalization
  gpcWallVideoFree;


end.