unit main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, MPlayer, StdCtrls, ExtCtrls;
type
TForm1 =
class(TForm)
Panel1: TPanel;
ComboBox1: TComboBox;
Panel2: TPanel;
Button1: TButton;
Button2: TButton;
CheckBox1: TCheckBox;
Panel3: TPanel;
MediaPlayer1: TMediaPlayer;
OpenDialog1: TOpenDialog;
procedure FormCreate (Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button1Click (Sender: TObject);
procedure Button2Click (Sender: TObject);
procedure CheckBox1Click (Sender: TObject);
procedure ComboBox1Select (Sender: TObject);
procedure Panel3Resize (Sender: TObject);
procedure MediaPlayer1Notify(Sender: TObject);
private
{ Private 宣言 }
F_bMediaIsVideo: Boolean;
F_iMediaWidth, F_iMediaHeight: Integer;
F_bWallvideo: Boolean;
F_sWallpaper:
String;
F_clBGColor: TColor;
procedure F_Play(iIndex: Integer);
procedure F_SetWallvideo;
procedure F_ResetWallvideo;
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
uses
sub;
{$R *.dfm}
function gfnsWallPaperGet:
String;
//壁紙取得
const
//Windows2000以降で壁紙のファイル名を取得
SPI_GETDESKWALLPAPER = 115;
var
lp_Buff: PChar;
begin
lp_Buff := AllocMem(MAX_PATH+1);
try
SystemParametersInfo(SPI_GETDESKWALLPAPER, MAX_PATH, lp_Buff, 0);
Result :=
String(lp_Buff);
finally
FreeMem(lp_Buff);
end;
end;
procedure gpcWallPaperSet(sFile:
String);
//壁紙セット
begin
SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, PChar(sFile), 0);
// SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, PChar(sFile), SPIF_UPDATEINIFILE or SPIF_SENDWININICHANGE);
end;
//背景色 -----------------------------------------------------------------------
function gfniDesktopColorGet: DWORD;
begin
Result := GetSysColor(COLOR_BACKGROUND);
end;
procedure gpcDesktopColorSet(iColor: DWORD);
var
li_Element: Integer;
begin
//デスクトップの背景色を変更
li_Element := COLOR_BACKGROUND;
SetSysColors(1, li_Element, iColor);
end;
//------------------------------------------------------------------------------
procedure TForm1.FormCreate(Sender: TObject);
begin
Form2 := TForm2.Create(Self);
Form2.BorderStyle := bsNone;
Form2.SetBounds(0, 0, 0, 0);
Panel3.Align := alClient;
F_bWallvideo := False;
F_sWallpaper := '';
F_clBGColor := clBackground;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
F_ResetWallvideo;
end;
//リストに追加
procedure TForm1.Button1Click(Sender: TObject);
var
li_Index: Integer;
begin
if (OpenDialog1.Execute)
then begin
li_Index := ComboBox1.Items.Count;
ComboBox1.Items.AddStrings(OpenDialog1.Files);
F_Play(li_Index);
end;
end;
//リストをクリア
procedure TForm1.Button2Click(Sender: TObject);
begin
ComboBox1.Items.Clear;
end;
//リストから選択
procedure TForm1.ComboBox1Select(Sender: TObject);
begin
F_Play(ComboBox1.ItemIndex);
end;
//ビデオサイズの調整
procedure TForm1.Panel3Resize(Sender: TObject);
begin
if not(CheckBox1.Checked)
then begin
//アスペクト比はPanel3のサイズによって変化
MediaPlayer1.DisplayRect := Rect(0, 0, Panel3.ClientWidth, Panel3.ClientHeight);
end;
end;
//壁紙ビデオのオンオフ
procedure TForm1.CheckBox1Click(Sender: TObject);
var
lf_Aspect: Extended;
li_Left, li_Top, li_Width, li_Height: Integer;
//ビデオの拡大サイズ
begin
if (F_bMediaIsVideo)
and (CheckBox1.Checked)
then begin
F_SetWallvideo;
MediaPlayer1.Display := Form2;
//MediaPlayer1.DisplayRect := Screen.WorkAreaRect;
//アスペクト比を保って画面いっぱいになるように
lf_Aspect := F_iMediaHeight / F_iMediaWidth;
li_Width := Screen.WorkAreaWidth;
li_Height := Trunc(li_Width * lf_Aspect);
if (li_Height < Screen.WorkAreaHeight)
then begin
li_Height := Screen.WorkAreaHeight;
li_Width := Trunc(li_Height / lf_Aspect);
end;
//画面の中央に表示するため
li_Left := (Screen.WorkAreaWidth - li_Width)
div 2;
li_Top := (Screen.WorkAreaHeight - li_Height)
div 2;
MediaPlayer1.DisplayRect := Rect(li_Left, li_Top, li_Width, li_Height);
end else begin
F_ResetWallvideo;
MediaPlayer1.Display := Panel3;
if (F_bMediaIsVideo)
then begin
//ビデオのアスペクト比に合わせて高さを調整
Self.ClientHeight := Trunc(Panel3.ClientWidth * (F_iMediaHeight / F_iMediaWidth)) + Panel1.Height + Panel2.Height;
end;
Panel3Resize(
nil);
end;
end;
//ループ再生
procedure TForm1.MediaPlayer1Notify(Sender: TObject);
var
li_Index: Integer;
begin
if (MediaPlayer1.Position = MediaPlayer1.Length)
then begin
li_Index := ComboBox1.ItemIndex;
Inc(li_Index);
if (li_Index >= ComboBox1.Items.Count)
then begin
//リストの最後まできたら頭に戻って再生を続ける
li_Index := 0;
end;
F_Play(li_Index);
end;
end;
procedure TForm1.F_Play(iIndex: Integer);
begin
ComboBox1.ItemIndex := iIndex;
MediaPlayer1.FileName := ComboBox1.Items[ComboBox1.ItemIndex];
MediaPlayer1.Open;
F_iMediaWidth := MediaPlayer1.DisplayRect.Right;
F_iMediaHeight := MediaPlayer1.DisplayRect.Bottom;
//MediaPlayer1.DisplayRectのBottomとRightが0より大きければビデオがある
F_bMediaIsVideo := (F_iMediaWidth > 0)
and (F_iMediaHeight > 0);
CheckBox1.OnClick(
nil);
//壁紙ビデオ
MediaPlayer1.Play;
end;
procedure TForm1.F_SetWallvideo;
begin
if not(F_bWallvideo)
then begin
//背景を退避
F_sWallpaper := gfnsWallpaperGet;
F_clBGColor := gfniDesktopColorGet;
//背景を壁紙ビデオ用にセット
gpcWallpaperSet('');
gpcDesktopColorSet($100010);
F_bWallvideo := True;
end;
end;
procedure TForm1.F_ResetWallvideo;
begin
//背景を戻す
if (F_bWallvideo)
then begin
gpcWallpaperSet(F_sWallpaper);
gpcDesktopColorSet(F_clBGColor);
F_bWallvideo := False;
end;
end;
end.