//作成者 Fintake
//http://functiont.s53.xrea.com/
//作成日 2004年12月29日

//FullScreenForm
//フルスクリーンのON/OFFを切り替えられるフォーム
//問題があり、一部コメントアウト（開発日誌参照）

unit FullScreenForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs;
type pDevMode = ^DevMode;
type
  TFullScreenForm = class(TForm)
  private
    { Private 宣言 }
   FFullScreen: boolean;
//   FullScreenTmp: boolean; //フルスクリーンを一時解除しているか
   FFullScreenWidth: cardinal;
   FFullScreenHeight: cardinal;
   FOnFullScreen: TNotifyEvent;
   TmpWindowState: TWindowState;
   TmpBorderStyle: TBorderStyle;
   TmpWidth: cardinal;
   TmpHeight: cardinal;
//   Working: boolean;
   procedure ChangeWindowMode(const value: boolean);
  private
   //procedure AppActivate(Sender: TObject);
   //procedure AppDeactivate(Sender: TObject);
  public
    { Public 宣言 }
   constructor Create(AOwner: TComponent); override;
  published
   property FullScreen: boolean read FFullScreen write ChangeWindowMode default false;
   property FullScreenWidth: cardinal read FFullScreenWidth write FFullScreenWidth default 640;
   property FullScreenHeight: cardinal read FFullScreenHeight write FFullScreenHeight default 480;
   property OnFullScreen: TNotifyEvent read FOnFullScreen write FOnFullScreen;
  end;

implementation

//WindowsにあるChangeDisplayModeだと
//ChangeDisplaySettings(nil, 0);
//で元に戻せない。DLLから直接呼出し
function ChangeDisplaySettings_(lpDevMode: pDevMode; dwflags:DWORD):integer;
 stdcall external 'user32.dll' name 'ChangeDisplaySettingsA';

//ディスプレイをフルスクリーンにする
//色数の変更には対応しない（デスクトップカラーの設定が
//おかしくなると言う情報あり）
//使えるモードを列挙してからのほうがいい…。
procedure TFullScreenForm.ChangeWindowMode(const value: boolean);
 var
  dm :DEVMODE;
 begin
  if Value and FFullScreen then exit;
  if Value then
   begin

    ZeroMemory(@dm, sizeof(DEVMODE));
    dm.dmSize := sizeof(DEVMODE);
    dm.dmFields := DM_PELSWIDTH or DM_PELSHEIGHT;
    dm.dmPelsWidth := FullScreenWidth;
    dm.dmPelsHeight := FullScreenHeight;
    if ChangeDisplaySettings_(@dm, CDS_TEST) = DISP_CHANGE_SUCCESSFUL then
     begin
//      Working := true;
      TmpWindowState := WindowState;
      TmpBorderStyle := BorderStyle;
      TmpWidth := Width;
      TmpHeight := Height;
      ChangeDisplaySettings_(@dm, CDS_FULLSCREEN);
      BorderStyle := bsNone;
      WindowState := wsMaximized;
      FFullScreen := true;
      if Assigned(FOnFullScreen) then FOnFullScreen(self);
     end
    else
     FFullScreen := false;
   end
  else
   begin
    ChangeDisplaySettings_(nil, 0);
    FFullScreen := false;
    WindowState := TmpWindowState;
    BorderStyle := TmpBorderStyle;
    Width := TmpWidth;
    Height := TmpHeight;
    if Assigned(FOnFullScreen) then FOnFullScreen(self);
   end;
 end;
{
procedure TFullScreenForm.AppActivate(Sender: TObject);
begin
 if working then
  begin
   working := false;
   exit;
  end;
 //フルスクリーン化
 if FullScreenTmp and not(FullScreen) and not working then
  begin
   WindowState := TmpWindowState;
   ChangeWindowMode(true);
   FullScreenTmp := false;
  end;
end;

procedure TFullScreenForm.AppDeactivate(Sender: TObject);
begin
 //フルスクリーンを解除して最小化
 if FullScreen and not Working then
  begin
   ChangeWindowMode(false);
   WindowState := wsMinimized;
   FullScreenTmp := true;
  end;
end;
}
constructor TFullScreenForm.Create(AOwner: TComponent);
 begin
  FOnFullScreen := nil;
  inherited;
  TmpWindowState := WindowState;
  TmpBorderStyle := BorderStyle;
  TmpHeight := Height;
  TmpWidth := Width;
  //Application.OnActivate := AppActivate;
  //Application.OnDeactivate := AppDeactivate;
 end;
end.