Instance d'application unique avec Delphi

Instance d'Application Unique avec ATOM

Cette source montre comment lancer une application en mode caché.

L'astuce est assez simple et consiste à affecter la valeur "False" à la propriété "Visible" de la fiche principale de l'application lors du lancement et de l'application.

Project1.dpr

Program

Project1;

uses
Forms,
unit1 in 'unit1.pas' {FMain};

{$R *.RES}

begin
Application.Initialize;
Application.Title := 'Instance Unique ATOM';
Application.CreateForm(TFMain, FMain);
Application.Run;
end.

Haut de Page ^

Unit1.pas

unit
Unit1;

interface

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

type
TFMain=class(TForm)
LbLink:TLabel;
Label1:TLabel;

procedure LbLinkClick(Sender:TObject);

private

public
end;

var
FMain:TFMain;

implementation

{$R *.DFM}

var AT:Word;
procedure TFMain.LbLinkClick(Sender:TObject);
begin
ShellExecute(Handle,'open',PChar(LbLink.Caption),nil,nil,1);
end;

initialization
if GlobalFindAtom('ThisAppWillRunOneTime')=0 then AT:=GlobalAddAtom('ThisAppWillRunOneTime')else
begin
ShowMessage('Cette application est déjà en exécution !');
Halt;
end;

finalization
GlobalDeleteAtom(AT);
end.

Haut de Page ^

Unit1.dfm

object FMain: TFMain
Left = 339
Top = 211
BorderIcons = [biSystemMenu]
BorderStyle = bsSingle
Caption = 'Instance d'#39'Application Unique ATOM'
ClientHeight = 160
ClientWidth = 326
Color = 13619151
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
PixelsPerInch = 96
TextHeight = 13
object LbLink: TLabel
Left = 0
Top = 0
Width = 326
Height = 25
Cursor = crHandPoint
Align = alTop
Alignment = taCenter
AutoSize = False
Caption = 'http://www.delphilab.com'
Color = 10053171
Font.Charset = ANSI_CHARSET
Font.Color = clWhite
Font.Height = -13
Font.Name = 'Tahoma'
Font.Style = []
ParentColor = False
ParentFont = False
Layout = tlCenter
OnClick = LbLinkClick
end
object Label1: TLabel
Left = 24
Top = 48
Width = 265
Height = 13
Caption = 'Essayez d'#39'ex'#233'cuter cette application une deuxi'#232'me fois'
Font.Charset = ANSI_CHARSET
Font.Color = 3618615
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
ParentFont = False
end
end

Haut de Page ^