Fermer windows ou votre session en un simple double-clic !

Soyez le premier à donner votre avis sur cette source.

Vue 7 540 fois - Téléchargée 651 fois

Description

hello

ptit exe ki se loge dans le systray, configurable, il ferme la session, reboot le pc et eteint le pc via un clic.
c un gadjet :D

Source / Exemple :


unit Closewin;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, systray, Buttons, Menus, StdCtrls, SkinCtrls, shellapi, registry,
  XPMan;

type
  TFormMain = class(TForm)
    PopupMenu1: TPopupMenu;
    Eteindre1: TMenuItem;
    Quitter1: TMenuItem;
    About1: TMenuItem;
    Timer1: TTimer;
    Bevel1: TBevel;
    Bevel2: TBevel;
    Image1: TImage;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    spSkinLinkLabel1: TspSkinLinkLabel;
    spSkinLinkLabel2: TspSkinLinkLabel;
    SpeedButton1: TSpeedButton;
    Session1: TMenuItem;
    config1: TMenuItem;
    XPManifest1: TXPManifest;
    Reboot1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormDestroy(Sender: TObject);
    procedure PopupMenuClick2(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure spSkinLinkLabel1Click(Sender: TObject);
    procedure spSkinLinkLabel2Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FormMain: TFormMain;
  dblClickActionAlreadyLoaded, LoadWin, LoadWinAlreadyLoaded: boolean;
  dblClickAction: integer;
  procedure PowerOff;
  procedure Reboot;
  procedure SuspendSession;

implementation

uses Config;

{$R *.dfm}
{$R icones.res}

function WindowsRep():string;
var
    WindowsDir : array[0..MAX_PATH] of Char;
    nSize       : DWord;
begin
    nSize := SizeOf(WindowsDir);
    GetWindowsDirectory(@WindowsDir, nSize);
    result := WindowsDir;
end;

procedure PowerOff;
begin
winexec(Pchar(WindowsRep()+'\system32\shutdown.exe -s -f -t 00'),SW_SHOWNORMAL);
end;

procedure Reboot;
begin
winexec(PChar(WindowsRep()+'\system32\shutdown.exe' + ' -r -f -t 00'),SW_SHOWNORMAL);
end;

procedure SuspendSession;
begin
LockWorkStation();
end;

procedure TFormMain.spSkinLinkLabel2Click(Sender: TObject);
begin
ShellExecute(Handle,'OPEN','http://www.diabloporc.fr.st',Nil,Nil,SW_SHOW);
end;

procedure TFormMain.FormCreate(Sender: TObject);
var
  Reg: TRegistry;
begin
if not fileexists(WindowsRep()+'\system32\shutdown.exe') then
begin
 if MessageDlg('Le fichier "'+WindowsRep()+'\system32\shutdown.exe" est introuvable.'+#10+#13+'Désirez-vous le télécharger ?',mtError,[mbYes,mbNo],0)=mrNo then Begin MessageDlg('L''application ne peut continuer.',mtError,[mbOk],0); Application.terminate; end else
 begin
  MessageDlg('Redémarrez Closeme.exe apres avoir copié "shutdown.exe" dans le dossier "'+WindowsRep()+'\system32\"',mtWarning,[mbOk],0);
  ShellExecute(Handle,'OPEN','http://diabloporc.free.fr/delphi/closeme/shutdown.exe',Nil,Nil,SW_SHOW);
  Application.terminate;
 end;
end;

  Application.Icon.Handle := LoadIcon(hInstance,PChar('HAND'));
  AjouteIconeTray(FormMain.handle,application.Icon.Handle,'Close Me !');

  Reg := TRegistry.Create;
  Reg.RootKey := HKEY_CURRENT_USER;
  Reg.OpenKey('SOFTWARE\Diabloporc\CloseMe\', true);
  if Reg.ValueExists('LoadWin') then LoadWin := Reg.ReadBool('LoadWin') else LoadWin := False;
  Reg.Free;

  Reg := TRegistry.Create;
  Reg.RootKey := HKEY_CURRENT_USER;
  Reg.OpenKey('SOFTWARE\Diabloporc\CloseMe\', true);
  if Reg.ValueExists('dblClickAction') then dblClickAction := Reg.ReadInteger('dblClickAction') else dblClickAction := 0;
  Reg.Free;

  LoadWinAlreadyLoaded := true;
  dblClickActionAlreadyLoaded := true;

  Reg := TRegistry.Create;
  Reg.RootKey := HKEY_CURRENT_USER;
  Reg.OpenKey('SOFTWARE\Diabloporc\CloseMe\', true);
  Reg.WriteString('Version', '1.1');
  Reg.Free;

end;

procedure TFormMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
EnleveIconeTray();
end;

procedure TFormMain.FormDestroy(Sender: TObject);
begin
EnleveIconeTray();
end;

procedure TFormMain.Timer1Timer(Sender: TObject);
begin
formmain.hide;
timer1.Enabled := false;
end;

procedure TFormMain.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
   Pos:TPoint;
begin
     GetCursorPos(Pos);
     case X of
         WM_LBUTTONDBLCLK:if dblClickAction=0 then PowerOff else if dblClickAction=1 then Reboot else SuspendSession;
         WM_LBUTTONDOWN:;
         WM_LBUTTONUP:;
         WM_RBUTTONDBLCLK:;
         WM_RBUTTONDOWN:;
         WM_RBUTTONUP:PopupMenu1.Popup(Pos.X,Pos.Y);
     end;
end;

procedure TFormMain.PopupMenuClick2(Sender: TObject);
begin
if Sender=Eteindre1 then PowerOff;
if Sender=Reboot1 then Reboot;
if Sender=Session1 then SuspendSession;
if Sender=Config1 then FormConfig.showmodal;
if Sender=Quitter1 then begin enleveiconetray(); Application.terminate; end;
if Sender=About1 then formmain.Show;
end;

procedure TFormMain.spSkinLinkLabel1Click(Sender: TObject);
begin
ShellExecute(Handle,'OPEN','mailto:diabloporc@laposte.net',Nil,Nil,SW_SHOW);
end;

procedure TFormMain.SpeedButton1Click(Sender: TObject);
begin
formmain.hide;
end;

end.

Conclusion :


je ne l'ai testé que sur win xp donc si ça ne marche pas ailleurs, mailez moi vos modifs ou mailez moi si vous n'y arrivez pas lol

bye merci

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

ni69
Messages postés
1529
Date d'inscription
samedi 12 juin 2004
Statut
Membre
Dernière intervention
5 juillet 2010
7 -
C'est un gadjet comme tu dis mais c'est bien pratique ;)
JulioDelphi
Messages postés
2349
Date d'inscription
dimanche 5 octobre 2003
Statut
Modérateur
Dernière intervention
18 novembre 2010
11 -
hohoho ma source à 1an !
pour toi ni69, je la remets a jour si tu veux :D j'ai vu k'elle avait qqs problemes sur certains pc ... je vais eput etre utiliser un composant ABF pour etre sur ke les OS soient bien pris en compte, je la posterais en double ds la source (cette version + celle avec le compo)
merci pour la note :) ++
botelec
Messages postés
41
Date d'inscription
vendredi 20 juin 2003
Statut
Membre
Dernière intervention
11 septembre 2010
1 -
Salut Julio, ta source à maintenant 4 ans .. =)
je suis tombé dessus en cherchant une méthode pour intercepter un double clic sur une forme.
Je cherchais en effet une méthode différente de celle qui consiste à surcharger la procédure normale d'interception des messages.
(Suis je clair?)

je me suis donc intéressé de près à ta source,
et je pense qu'il y a grande confusion dans la procédure :

procedure TFormMain.FormMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
var
Pos:TPoint;
begin
GetCursorPos(Pos);
case X of
WM_LBUTTONDBLCLK:
if dblClickAction=0
then PowerOff
else if dblClickAction=1
then Reboot
else SuspendSession;
WM_LBUTTONDOWN:;
WM_LBUTTONUP:;
WM_RBUTTONDBLCLK:;
WM_RBUTTONDOWN:;
WM_RBUTTONUP: PopupMenu1.Popup(Pos.X,Pos.Y);
end;
end;

Tu fais une sélection par le case X avec comme résultats possible des constantes de message,
alors que X représente la valeur sur l'axe X de la position du curseur ...

Du coup j'ai cherché un peu, et je laisse un exemple.. pour ceux qui sont interressés:

*Placez ce code dans FormMouseUp pour intercepter un clic gauche relachés.

procedure TFormMain.FormMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
var
Pos:TPoint;
begin
GetCursorPos(Pos);
if Shift = [ssRight]
then PopupMenu1.Popup(Pos.X,Pos.Y);
else if Shift = [ssRight,ssDouble]
then if dblClickAction=0
then PowerOff
else if dblClickAction=1
then Reboot
else SuspendSession;
end;
end;

BBye

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.