mieki256's diary

unit PreviewFormUnit;

{$mode ObjFPC}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, LCLType,
  StdCtrls, LCLIntf, ExtCtrls,
  Windows;

type

  { TPreviewForm }

  TPreviewForm = class(TForm)
    Label1: TLabel;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: word; Shift: TShiftState);
    procedure Timer1Timer(Sender: TObject);
  private
    FParentHWND: HWND;
  protected
    procedure WndProc(var Message: TMessage); override;
  public
    procedure EmbedIntoParent(pHWND: HWND);

  end;

var
  PreviewForm: TPreviewForm;

implementation

{$R *.lfm}

{ TPreviewForm }

procedure TPreviewForm.FormCreate(Sender: TObject);
begin
  //FParentHWND := 0;
  BorderStyle := bsNone;
  Left := 0;
  Top := 0;
  Width := 152;
  Height := 112;

  Label1.Left := (ClientWidth - Label1.Width) div 2;
  Label1.Top := (ClientHeight - Label1.Height) div 2;
  Label1.Font.Color := clBlue;
end;

// 親ウインドウを指定
procedure TPreviewForm.EmbedIntoParent(pHWND: HWND);
var
  r: TRect;
begin
  FParentHWND := pHWND;

  if pHWND <> 0 then
  begin
    ParentWindow := pHWND;
    Windows.SetParent(self.Handle, pHWND);

    SetWindowLong(Self.Handle, GWL_STYLE, GetWindowLong(self.Handle, GWL_STYLE) or
      WS_CHILD);

    Windows.GetClientRect(pHWND, r);
    MoveWindow(Self.Handle, 0, 0, r.Right - r.Left, r.Bottom - r.Top, True);
    Visible := True;
  end;
end;

procedure TPreviewForm.Timer1Timer(Sender: TObject);
begin
  // 一定時間毎に自身が消えるべきかチェックする
  //Windows.Beep(440, 100);
  if (FParentHWND <> 0) and (not Windows.IsWindow(FParentHWND)) then
  begin
    // 親ウインドウが存在していないので終了
    //Windows.Beep(1000, 100);
    Application.Terminate;
  end
  else if not Windows.IsWindowVisible(self.Handle) then
  begin
    // 自分が非表示にされているなら終了
    //Windows.Beep(1000, 1000);
    Application.Terminate;
  end;
end;

procedure TPreviewForm.WndProc(var Message: TMessage);
begin
  //Windowsから閉じろとメッセージが来ているなら終了
  case Message.Msg of
    WM_CLOSE, WM_DESTROY, WM_NCDESTROY:
    begin
      //Windows.Beep(2000, 300);
      Application.Terminate;
    end;
  end;

  inherited WndProc(Message);
end;

procedure TPreviewForm.FormKeyDown(Sender: TObject; var Key: word; Shift: TShiftState);
begin
  if FParentHWND = 0 then
  begin
    // 開発時用。ESCキーで終了
    if Key = VK_ESCAPE then
      Application.Terminate;
  end;
end;

//initialization
//  RegisterClass(TPreviewForm);

end.

program sslazarus1;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}
  cthreads,
  {$ENDIF}
  {$IFDEF HASAMIGA}
  athreads,
  {$ENDIF}
  Interfaces, // this includes the LCL widgetset
  Forms,
  LCLIntf,
  LCLType,
  Windows,
  SysUtils,
  FullScrFormUnit,
  ConfigFormUnit,
  PreviewFormUnit { you can add units after this };

  {$R *.res}

var
  arg: string;
  phwnd: HWND;
  hMutex: THandle;

const
  MUTEX_NAME: string = 'ScreenSaverLazarus1Mutex8686';

begin
  RequireDerivedFormResource := True;
  Application.Scaled := True;
  {$PUSH}
  {$WARN 5044 OFF}
  //Application.MainFormOnTaskbar := True;
  Application.MainFormOnTaskbar := False;
  {$POP}
  Application.Initialize;

  if ParamCount >= 1 then
    arg := LowerCase(Copy(ParamStr(1), 1, 2))
  else
    arg := '';

  if arg = '/s' then
  begin
    // Fullscreen mode
    hMutex := CreateMutex(nil, False, PChar(MUTEX_NAME));
    if (hMutex = 0) or (GetLastError = ERROR_ALREADY_EXISTS) then
    begin
      if hMutex <> 0 then
        CloseHandle(hMutex);

      Exit;
    end;

    try
      Application.CreateForm(TFullScreenForm, FullScreenForm);
      Application.Run;
    finally
      if hMutex <> 0 then
        CloseHandle(hMutex);
    end;
  end
  else if arg = '/c' then
  begin
    // Config mode
    Application.CreateForm(TConfigForm, ConfigForm);
    Application.Run;
    Exit;
  end
  else if arg = '/p' then
  begin
    // Preview mode
    if ParamCount >= 2 then
      phwnd := HWND(StrToInt64Def(ParamStr(2), 0))
    else
      phwnd := 0;

    Application.CreateForm(TPreviewForm, PreviewForm);
    if phwnd <> 0 then
      PreviewForm.EmbedIntoParent(phwnd);

    Application.Run;
  end
  else
  begin
    // Config mode
    Application.CreateForm(TConfigForm, ConfigForm);
    Application.Run;
  end;

end.