常駐型アプリケーション作成 ～Delphiソースコード集

• ホーム
• Delphiでお手軽プログラミング
• 常駐型アプリケーション作成 ～Delphiソースコード集

常駐型アプリケーション作成 ～Delphiソースコード集

常駐するアプリケーションなので、起動してもウィンドウ（フォーム）は非表示で、タスクトレイアイコンを表示させます。
タスクトレイアイコンを左クリックするとポップアップメニューを表示させ、「終了」と「フォームを表示」のメニューを表示させます。
フォームを表示して、「OnCloseQuery」を使ってフォームの右上の「×」ボタンを押しても終了させないようにします。 ただし、この対応を行うとＯＳのシャットダウンができなくなるので「WM_QUERYENDSESSION」メッセージを捉えて対応します。

プロジェクトを作成する

画面設計

ソースコードの記述

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
  Vcl.Menus, Vcl.StdCtrls, winapi.ShellAPI;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    PopupMenu1: TPopupMenu;
    X1: TMenuItem;
    S1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormDestroy(Sender: TObject);
    procedure X1Click(Sender: TObject);
    procedure S1Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
    NotifyIconData: TNotifyIconData;
    //タスクバーが落ちて再構築されたときにメッセージをもらう
    TaskbarRestart:NativeInt;
    //アプリを終了したい場合はTrue
    WantTerminate:Boolean;
    //タスクアイコンをクリックした場合などの通知先ウィンドウハンドル
    hTrayIcon:HWnd;
    MutexHandle:THandle;

    //タスクアイコンをクリックした場合などの通知先プロシージャ
    procedure TaskTrayWndProc(var Msg: TMessage);
    //タスクトレイアイコンの登録
    procedure CreateTaskTrayIcon();
    //OSがシャットダウンした時の通知
    procedure OSEnd(var Msg : TWMQueryEndSession);message WM_QUERYENDSESSION;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

const
  //多重起動防止ミューテックス用文字列
  MutexUniqueName='Local\UNIQUE_REGIDENT_APPLICATION'; //一意な文字列を入れる


implementation

{$R *.dfm}

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
begin
  //「常駐を終了」ボタンが押されたら、アプリを終了させる
  WantTerminate:=True;
  Application.Terminate;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  //「閉じる」ボタンが押されたら、フォームを隠す
  Self.Hide;
end;

procedure TForm1.CreateTaskTrayIcon;
var ret:LongBool;
    err:Cardinal;
    ct:Integer;
begin
  ct:=0;
  repeat
    //タスクトレイアイコンに登録
    ret:=Shell_NotifyIcon( NIM_ADD, @NotifyIconData );
    if ret=False then //タスクトレイアイコン登録に失敗
    begin
      //エラー内容を取得
      err:=GetLastError();
      if err=ERROR_TIMEOUT then //エラーがERROR_TIMEOUTだったら
      begin
        //タスクトレイアイコンの変更を試してみる
        ret:=Shell_NotifyIcon(NIM_MODIFY,@NotifyIconData);
      end;
    end;
    if ret=false then sleep(1000);//失敗したら1秒待つ
    inc(ct);
  until (ret=true) or (ct>20); //とりあえず20回トライする
  //20回トライしてもダメだったのでアプリケーションを終了させる
  if ret=false then application.Terminate;
end;


procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  //ウィンドウの右上×ボタンでは非表示処理
  //本当に常駐終了したい場合（OSシャットダウン、常駐終了ボタン）には応答
  if WantTerminate then
    CanClose:=True
  else
  begin
    CanClose:=False;
    Self.Hide;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  //メインフォームを非表示にする
  Application.ShowMainForm:=False;
  Self.Hide;
  WantTerminate:=False;

  MutexHandle:=CreateMutex(nil,true,MutexUniqueName);
  if (MutexHandle<>0) and (GetLastError()=ERROR_ALREADY_EXISTS) then
  begin
    //多重起動の場合、即時終了させる
    WantTerminate:=True;
    Application.Terminate;
  end;

  //タスクバーが落ちて再構築されたときにメッセージをもらう
  TaskbarRestart:=RegisterWindowMessage('TaskbarCreated');

  //タスクアイコンをクリックした場合などの通知先ウィンドウハンドルの作成
  hTrayIcon := AllocateHWnd(TaskTrayWndProc);
  //
  ZeroMemory(@NotifyIconData,sizeof(TNotifyIconData));
  NotifyIconData.cbSize:=SizeOf(TNotifyIconData);
  NotifyIconData.Wnd:=hTrayIcon;
  NotifyIconData.uCallbackMessage:=WM_APP+$300;
  NotifyIconData.uID:=1;
  NotifyIconData.szTip:='クリックでメニュー表示';
  NotifyIconData.uFlags:=NIF_ICON or NIF_MESSAGE or NIF_TIP;
  //とりあえずアイコンはアプリケーションのアイコンにする
  NotifyIconData.hIcon:=Application.Icon.Handle;
  //タスクトレイアイコンの登録
  CreateTaskTrayIcon();
end;


procedure TForm1.FormDestroy(Sender: TObject);
begin
  //タスクトレイアイコンを削除する
  Shell_NotifyIcon(NIM_DELETE,@NotifyIconData);
  //タスクトレイアイコンの通知用ウィンドウハンドルを削除する
  DeallocateHWnd(hTrayIcon);
  //ミューテックスの解除
  ReleaseMutex(MutexHandle);
  CloseHandle(MutexHandle);
end;


procedure TForm1.OSEnd(var Msg: TWMQueryEndSession);
begin
  //「Windows OSのシャットダウン」メッセージが届いた場合
  WantTerminate:=True;
end;


procedure TForm1.S1Click(Sender: TObject);
begin
  //ポップアップメニューの「フォームを表示」をクリックすると、
  //このフォーム（ウィンドウ）を表示する
  self.Show;
end;

procedure TForm1.TaskTrayWndProc(var Msg: TMessage);
var ps: TPoint;
begin
  //登録したタスクトレイアイコンで左マウスボタンが離されたとき
  if Msg.LParam=WM_LBUTTONUP then
  begin
    //マウスカーソルの位置を取得
    GetCursorPos(ps);
    SetForegroundWindow(Handle);
    //フォームに置いたPopupMenu1を表示する
    PopupMenu1.Popup(ps.x,ps.y);
  end
  else if Msg.LParam=TaskbarRestart then
  begin
    //タスクバーが再構築されたのでタスクトレイアイコンを再登録する
    CreateTaskTrayIcon();
  end;
end;

procedure TForm1.X1Click(Sender: TObject);
begin
  //ポップアップメニューの
  //「終了」をクリックするとアプリケーションを終了する
  WantTerminate:=True;
  Application.Terminate;
end;

end.

実行する