program project1;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Interfaces, // this includes the LCL widgetset
  Forms, Unit1, Windows, Dialogs
  { you can add units after this };

{$R *.res}

const
  UniqueName:string = 'HogeHogeApp';

//-----------------------------------------------------------------------------
//  EnumWindows のコールバック関数
//  起動済みのアプリを最前面に表示するために使用
//
//  lazarus-2.0.8 では ShowWindow(hWindow, SW_RESTORE) は機能しない
//  代わりに WM_SYSCOMMAND で SC_RESTORE をポストしている
//-----------------------------------------------------------------------------
function EnumWndProc(hWindow: HWND; lData: LPARAM): BOOL;stdcall;
begin
  Result := True;
  if GetProp(hWindow, PChar(lData)) = 1111 then begin
    if IsIconic(hWindow) then begin
      PostMessage(hWindow, WM_SYSCOMMAND, $FFF0 and SC_RESTORE, 0);
    end;
    SetForegroundWindow(hWindow);
    Result := False;
  end;
end;

//-----------------------------------------------------------------------------
//  引数で指定したプロパティを持つウィンドウが起動しているかを確認する関数
//-----------------------------------------------------------------------------
function IsPrevAppExist(AName: string):Boolean;
begin
  Result := False;
  CreateMutex(nil, True, PChar(AName));
  if GetLastError = ERROR_ALREADY_EXISTS then begin
    ShowMessage('このアプリは二重起動できません');
    EnumWindows(@EnumWndProc, LPARAM(PChar(AName)));
    Result := True;
  end;
end;

begin
  if IsPrevAppExist(UniqueName) then Exit;

  RequireDerivedFormResource:=True;
  Application.Scaled:=True;
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  SetProp(Application.Handle, PChar(UniqueName),1111);
  Application.Run;
  RemoveProp(Application.Handle, PChar(UniqueName));
end.

begin
  if IsPrevAppExist(UniqueName) then Exit;

  RequireDerivedFormResource:=True;
  Application.Scaled:=True;
  Application.Initialize;
  Application.MainFormOnTaskBar := True;
  Application.CreateForm(TForm1, Form1);
  SetProp(Application.MainForm.Handle, PChar(UniqueName),1111);
  Application.Run;
  RemoveProp(Application.MainForm.Handle, PChar(UniqueName));
end.

var
  FPreHWND : HWND;

begin
  FPreHWND := FindWindow('TTestMainForm', nil);
  if FPreHWND <> 0 then begin
    ShowMessage('二重起動を禁止しています');
    if IsIconic(FPreHWND) then begin
      PostMessage(FPreHWND, WM_SYSCOMMAND, $FFF0 and SC_RESTORE, 0);
    end;
    SetForegroundWindow(FPreHWND);
    Exit;
  end;

  RequireDerivedFormResource:=True;
  Application.Scaled:=True;
  Application.Initialize;
  // 最小化からの復帰を有効にするには以下を追加
  Application.MainFormOnTaskBar := True;
  Application.CreateForm(TTestMainForm, TestMainForm);
  Application.Run;
end.

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, Windows;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private

  public

  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

const
  UniqueName:string = 'HogeHogeApp';

//-----------------------------------------------------------------------------
//  EnumWindows のコールバック関数
//  起動済みのアプリを最前面に表示するために使用
//
//  lazarus-2.0.8 では ShowWindow(hWindow, SW_RESTORE) は機能しない
//  代わりに WM_SYSCOMMAND で SC_RESTORE をポストしている
//-----------------------------------------------------------------------------
function EnumWndProc(hWindow: HWND; lData: LPARAM): BOOL;stdcall;
begin
  Result := True;
  if GetProp(hWindow, PChar(lData)) = 1111 then begin
    if IsIconic(hWindow) then begin
      PostMessage(hWindow, WM_SYSCOMMAND, $FFF0 and SC_RESTORE, 0);
    end;
    SetForegroundWindow(hWindow);
    Result := False;
  end;
end;

//=============================================================================
//  フォーム生成時の処理
//  二重起動防止のチェック
//  既に起動していたらメインフォームであるこのフォームを閉じる
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  CreateMutex(nil, true, PChar(UniqueName));
  if GetLastError = ERROR_ALREADY_EXISTS then begin
    ShowMessage('このアプリは二重起動できません');
    EnumWindows(@EnumWndProc, LPARAM(PChar(UniqueName)));
    PostMessage(Handle, WM_CLOSE, 0, 0);
  end else begin
    SetProp(Application.Handle, PChar(UniqueName), 1111);
  end;
end;

//=============================================================================
//  メインフォーム破棄時の処理
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  RemoveProp(Application.Handle, PChar(UniqueName));
end;

//=============================================================================
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
//
end;

end.

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls,
  UniqueInstance, Windows;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    UniqueInstance1: TUniqueInstance;
    procedure UniqueInstance1OtherInstance(Sender: TObject;
      ParamCount: Integer; const Parameters: array of String);
  private

  public

  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

//=============================================================================
//  UniqueInstance1 の OnOtherInstance イベント処理
//  起動中の EXE を起動しようとすると発生する
//  引数は EXE のコマンドラインの数とその値
//
//  オブジェクトインスペクタで以下を設定
//  Enabled        : True (二重起動防止を有効にする)
//  Identifier     : MyHogeLazarusApp (EXE 識別用のユニークな文字列)
//  UpdateInterval : 1000 (イベント発生間隔．Windows では無効)
//
//  ShowMessage のダイアログはアクティブにはならない (筆者の環境では)
//=============================================================================
procedure TForm1.UniqueInstance1OtherInstance(Sender: TObject;
  ParamCount: Integer; const Parameters: array of String);
begin
  FormStyle := fsSystemStayOnTop;
  FormStyle := fsNormal;
  ShowMessage('このアプリは既に起動しています');
end;

end.

  FAllocWnd := AllocateHWnd(AllocWnd);
           ↓ // 以下に変更．アドレス演算子の @ を追加
  FAllocWnd := AllocateHWnd(@AllocWnd);

function AllocateHWnd(Method: TWndMethod): HWND;
  begin
    runerror(211);
  end;


procedure DeallocateHWnd(Wnd: HWND);
  begin
    runerror(211);
  end;

  FAllocWnd := AllocateHWnd(@AllocWnd);
  DeallocateHWnd(FAllocWnd);
         ↓ // 以下に変更．
 　         // Win32WidgetSet の同名の関数を使用 ( uses に win32int が必要
  FAllocWnd := Win32WidgetSet.AllocateHWnd(@AllocWnd);
  Win32WidgetSet.DeallocateHWnd(FAllocWnd);

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, OneInstance;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    OneInstance1: TOneInstance;
    procedure OneInstance1PrevInstanceExist(Sender: TObject);
  private

  public

  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

//=============================================================================
//  OneInstance1 の OnPrevInstanceExist イベント処理
//  起動中の EXE を起動する時に発生する
//
//  オブジェクトインスペクタで以下を設定
//  UniqueName  : EXE 識別用のユニークな文字列
//=============================================================================
procedure TForm1.OneInstance1PrevInstanceExist(Sender: TObject);
begin
  ShowMessage('このアプリは二重起動できません');
  OneInstance1.ActivatePrevApp;
end;

end.

begin
  RequireDerivedFormResource:=True;
  Application.Scaled:=True;
  Application.Initialize;
  // この時点ではフォームに配置したコンポーネントは生成されていない
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, Windows;

type

  { TForm1 }

  TForm1 = class(TForm)
    ApplicationProperties1: TApplicationProperties;
    CheckBox1: TCheckBox;
    procedure ApplicationProperties1Minimize(Sender: TObject);
  private
    procedure WMUser100(var AMsg: TMessage); message WM_APP+100;
  public

  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }


//=============================================================================
//  ApplicationProperties1 の OnMinimize イベント
//  アプリケーションのウィンドウが最小化した時に発生するイベント
//  メインフォームの最小化ボタンクリックでも発生する
//=============================================================================
procedure TForm1.ApplicationProperties1Minimize(Sender: TObject);
begin
  // 最小化は処理の途中なので SendMessage は使用しない
  PostMessage(Handle, WM_APP+100, 0, 0);
end;

//-----------------------------------------------------------------------------
//  メッセージ処理
//-----------------------------------------------------------------------------
procedure TForm1.WMUser100(var AMsg: TMessage);
begin
  Sleep(2000);
  if not CheckBox1.Checked then begin
    // 復帰しない
    ShowWindow(Application.Handle, SW_RESTORE);
  end else begin
    // 以下にすれば最小化状態から復帰する
    PostMessage(Application.Handle, WM_SYSCOMMAND, $FFF0 and SC_RESTORE, 0);
  end;
end;

end.

//=============================================================================
//  コードでウィンドウを最小化
//  アプリケーションのウィンドウを最小化する
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowWindow(Application.Handle, SW_MINIMIZE);
  PostMessage(Handle, WM_APP+100, 0, 0);
end;

//-----------------------------------------------------------------------------
//  メッセージ処理
//-----------------------------------------------------------------------------
procedure TForm1.WMUser100(var AMsg: TMessage);
begin
  Sleep(2000);
  if not CheckBox1.Checked then begin
    // 最小化状態から復帰する
    ShowWindow(Application.Handle, SW_RESTORE);
    // 以下でも復帰する
    // PostMessage(Application.Handle, WM_SYSCOMMAND, $FFF0 and SC_RESTORE, 0);
  end else begin
    // ShowWindow で最小化状態から復帰するが最前面には表示しない
    ShowWindow(Handle, SW_RESTORE);
    SetForegroundWindow(Handle);
  end;
end;

//=============================================================================
//  コードでウィンドウを最小化
//  メインフォーム (このフォーム) のウィンドウを最小化する
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowWindow(Handle, SW_MINIMIZE);
  PostMessage(Handle, WM_APP+100, 0, 0);
end;

//-----------------------------------------------------------------------------
//  メッセージ処理
//-----------------------------------------------------------------------------
procedure TForm1.WMUser100(var AMsg: TMessage);
begin
  Sleep(2000);
  if not CheckBox1.Checked then begin
    // 最小化状態から復帰できない
    // タスクバーのアイコンクリックでも復帰できない
    ShowWindow(Application.Handle, SW_RESTORE);
  end else begin
    // 最小化状態から復帰する
    ShowWindow(Handle, SW_RESTORE);
    // 以下でも復帰する
    // PostMessage(Handle, WM_SYSCOMMAND, $FFF0 and SC_RESTORE, 0);
  end;
end;

procedure TForm1.WMUser100(var AMsg: TMessage);
begin
  Sleep(2000);
  Application.Restore;
end;

procedure TForm1.WMUser100(var AMsg: TMessage);
begin
  Sleep(2000);
  Application.MainForm.WindowState := wsNormal;
end;