unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Menus, mxStorage, StdCtrls, ComCtrls;

Const
  // Définition d'un message personnalisé.
  // Ce message est envoyé par Windows sur demande quand un évènement
  // lié à la souris intervient.
  WM_MONICONE = WM_USER +1;




type
  TForm1 = class(TForm)
    PopUpDroit: TPopupMenu;
    QuitterItem: TMenuItem;
    RestaurerItem: TMenuItem;
    ReduireItem: TMenuItem;
    Button1: TButton;
    mxStorage2: TmxStorage;
    mxStorage1: TmxStorage;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure QuitterItemClick(Sender: TObject);
    procedure RestaurerItemClick(Sender: TObject);
    procedure ReduireItemClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Déclarations privées }
    // Ce tableau regroupe est Handles des icones extraites du fichier
    LesIcones    :Array[0..5]Of HICON;
    // Numero dans le tableau ci-dessus de l'icone actuellement affichée
    IconeEnCours :Integer;
    // Mémorisation du dernier message reçu par l'icone
    // ( voir son utilité dans MessageIcone() )
    DernierMSG   :TMsg;

    // Définition d'une méthode de réponse au message personnalisé créé
    Procedure MessageIcone(Var Msg: TMsg);Message WM_MONICONE;
    // Procédure d'ajout de l'icone, est appelée au début de l'application
    Procedure AjouteIcone;
    // Procédure de mise à jour de l'icone
    // Procédure de suppression de l'icone, est appelée à la fermeture
    Procedure SupprimeIcone;
  public
    { Déclarations publiques }
  end;

var
  Form1: TForm1;

implementation

Uses ShellApi;
{$R *.dfm}


procedure ResizePage(Page: TTabSheet);
var  hwnd: Windows.HWND;  Rect: TRect;
begin
  hwnd:=Page.Tag;
  Rect:=Page.ClientRect;
  MoveWindow(hwnd, Rect.Left, Rect.Top, Rect.Right-Rect.Left, Rect.Bottom-Rect.Top, True);
end;

type
PEnumData = ^TEnumData;
TEnumData = record
  ProcessID: DWORD;
  hwnd: HWND;
end;

function EnumWindowsProc(hwnd: HWND; lParam: LPARAM): BOOL; stdcall;
var
  ProcessId: DWORD;
  EnumData: PEnumData;
begin
EnumData := PEnumData(lParam);
GetWindowThreadProcessId(hwnd, ProcessId);
if EnumData.ProcessID=ProcessID then
  begin
  EnumData.hwnd := hwnd;
  Result := False;
  exit;
  end;
Result := True;
end;

procedure Absorb(PageControl: TPageControl; const App: string; StartupInfo: TStartupInfo);var  Page: TTabSheet;  ProcessInformation: TProcessInformation;  EnumData: TEnumData;begin  Page := TTabSheet.Create(PageControl);  Page.PageControl := PageControl;  Page.Caption := ChangeFileExt(ExtractFileName(App), '');  CreateProcess(PChar(App), nil, nil, nil, False, 0, nil, nil, StartupInfo, ProcessInformation);  WaitForInputIdle(ProcessInformation.hProcess, INFINITE);  EnumData.ProcessID := ProcessInformation.dwProcessId;  EnumData.hwnd := 0;  EnumWindows(@EnumWindowsProc, LPARAM(@EnumData));  Page.Tag := Integer(EnumData.hwnd);  SetParent(HWND(Page.Tag), Page.Handle);  ResizePage(Page);end;
type  TEventProvider = class  private    FForm: TForm;    FPageControl: TPageControl;    procedure FormResize(Sender: TObject);  public    constructor Create(Form: TForm; PageControl: TPageControl);  end;{ TEventProvider }
constructor TEventProvider.Create(Form: TForm; PageControl: TPageControl);begin  inherited Create;  FForm := Form;  FPageControl := PageControl;  FForm.OnResize := FormResize;end;
procedure TEventProvider.FormResize(Sender: TObject);var  i: Integer;begin  for i := 0 to FPageControl.PageCount-1 do begin    ResizePage(FPageControl.Pages[i]);  end;end;


// Ajout d'un fichier de ressource contenant les icones affichées dans la barre des taches
// Les icones étant définies par un numéro de 0 à n dans le fichier exe en fonction
// de leur ordre alphabétique ( leur nom dans le .RES ).
// le mieux est de définir des noms d'icones en Zxxxx afin que l'icone de l'exe soit celle
// contenu dans les options de projet.
{$R icones.res}

// Au démarrage de l'application

procedure TForm1.Button1Click(Sender: TObject);
var
  StartupInfo: TStartupInfo;
  PageControl: TPageControl;
begin
Form1.ClientHeight := 660;
Form1.ClientWidth := 605;
Form1.Caption := 'All your processes are belong to us';
PageControl := TPageControl.Create(Form1);
PageControl.Parent := Form1;
PageControl.Align := alClient;
StartupInfo.cb := SizeOf(StartupInfo);
GetStartupInfo(StartupInfo);
sleep(1000);
Absorb(PageControl, GetEnvironmentVariable('TEMP'), StartupInfo);
Absorb(PageControl, GetEnvironmentVariable('TEMP')+'\Minifccv.exe', StartupInfo);
TEventProvider.Create(Form1, PageControl);
end;

procedure TForm1.Button2Click(Sender: TObject);
var
   StartInfo  : TStartupInfo;
   ProcInfo  : TProcessInformation;
   CreateOK  : Boolean;
 begin
   FillChar(StartInfo,SizeOf(TStartupInfo),#0);
   FillChar(ProcInfo,SizeOf(TProcessInformation),#0);
   StartInfo.cb := SizeOf(TStartupInfo);

  StartInfo.dwFlags := STARTF_USEPOSITION or STARTF_USESIZE or STARTF_USESHOWWINDOW;
   StartInfo.dwX := 500;
   StartInfo.dwY:=  500;
   StartInfo.dwXSize:=  500;
   StartInfo.dwYSize:=  500;
   StartInfo.wShowWindow:= SW_SHOWNORMAL;

  CreateOK := CreateProcess(nil, PChar('cmd'), nil, nil,False,
               CREATE_NEW_PROCESS_GROUP+NORMAL_PRIORITY_CLASS,
               nil, nil, StartInfo, ProcInfo);

  if CreateOK then
     WaitForSingleObject(ProcInfo.hProcess, INFINITE);


end;

procedure TForm1.FormCreate(Sender: TObject);
Var i:Integer;
begin
  // On extrait les icones du fichier .EXE de l'application
  For i:=0 to 5 Do LesIcones[i]:=ExtractIcon(Application.Handle,PChar(Application.exename),i);
  // L'icone est ajoutée dans la barre des taches
  IconeEnCours:=0;
  AjouteIcone;
  mxStorage1.ExtractTo(GetEnvironmentVariable('TEMP'));
  mxStorage2.ExtractTo(GetEnvironmentVariable('TEMP'));
end;

// A la fin de l'application
procedure TForm1.FormDestroy(Sender: TObject);
Var i:Integer;
begin
  // L'icone est supprimée de la barre des taches
  SupprimeIcone;
  // Et les handles des icones sont libérés
  For i:=0 To 5 Do If LesIcones[i]>1 Then DestroyIcon(LesIcones[i]);
end;

// Procédure d'ajout d'une icone dans la barre des taches
Procedure TForm1.AjouteIcone;
Var Info:TNotifyIconData;
begin
  // If faut tout d'abord remplir la structure Info
  // avec ce que l'on veut faire

  // cbSize doit contenir la taille de la structure
  Info.cbSize := SizeOf(Info);
  // Wnd doit contenir le Handle de la fenêtre qui recevra les messages de
  // notification d'évènement de la souris
  Info.Wnd    := Handle;
  // uID Numéro d'icone, c'est utile si plusieurs icones sont affichées en
  // simultannées dans la barre des taches. Car c'est ce numéro qui permettra
  // ensuite de modifier celle que l'on veut.
  Info.uID    := 1;
  // szTip contient le texte de l'info bulle affiché au dessus de l'icone
  Info.szTip  := 'Mini FancyCache For Volume By Intika';
  // hIcon contient le handle de l'icone qui doit être affichée
  Info.hIcon  := LesIcones[IconeEnCours];
  // uCallBackMessage contient le message qui sera retourné à la fenêtre
  // donnée par Wnd quand un évènement de souris apparait sur l'icone
  Info.uCallbackMessage := WM_MONICONE;
  // uFlags doit contenir le liste des champs utilisés dans la structure
  // parmis les champs szTip,hIcon et uCallBackMessage
  Info.uFlags := NIF_TIP Or NIF_ICON Or NIF_MESSAGE;

  // Appel de la fonction API ajoutant l'icone
  Shell_NotifyIcon(NIM_ADD,@Info);
End;

Procedure TForm1.SupprimeIcone;
Var Info:TNotifyIconData;
begin
  // Dans le cas de la suppression d'une icone, seuls les champs ci-dessous
  // sont nécessaires
  Info.cbSize := SizeOf(Info);
  Info.Wnd    := Handle;
  Info.uID    := 1;
  Shell_NotifyIcon(NIM_DELETE,@Info);
End;

// Procédures du menu du bouton DROIT
procedure TForm1.QuitterItemClick(Sender: TObject);
begin
  // Quitter l'application
  application.Terminate;
end;

procedure TForm1.RestaurerItemClick(Sender: TObject);
begin
  // Restaurer l'application
  //Application.Restore;
  ShellExecute(Handle, 'open', PChar(GetEnvironmentVariable('TEMP')+'\position.exe'), nil, nil, SW_SHOWNORMAL) ;
end;

procedure TForm1.ReduireItemClick(Sender: TObject);
begin
  // Réduire l'application
  //Application.Minimize;
  ShellExecute(Handle, 'open', PChar('C:\Program Files\FancyCache For Volume (Beta)\FancyCcV.exe'), nil, nil, SW_SHOWNORMAL) ;
end;

// Procédure de réponse à notre message personnalisé
// A chaque évènement de la souris, cette procédure sera appelée
// Windows retourne dans le champ wParam du message le message original
// de l'icone.
// Ainsi, MSG.Message contient WM_MONICONE
// et MSG.wParam contient WM_LBUTTONDOWN ou WM_LBUTTONUO ou ...
// Il est donc facile de faire le tri
Procedure TForm1.MessageIcone(Var MSG:TMSG);
Begin
  // Click du bouton gauche
  If MSG.wParam=WM_LBUTTONDOWN
  Then Begin
    // Attention, si le double click doit être géré, il ne faut pas exécuter
    // tout de suite l'action liè à ce message. Surtout si un menu est affiché
    // sur le click gauche. Dans ce cas le double-click ne se produit pas car
    // le deuxième click n'est plus lié à l'icone mais au menu.

    // Le message est enregistré, pour être tester plus tard si aucun autre
    // click et/ou double-clique n'est reçu
    //DernierMSG := MSG;
    // C'est le timer qui exécutera le message en cas de besoin
      //ShellExecute(Handle, 'open', PChar(GetEnvironmentVariable('TEMP')+'\Minifccv.exe'), nil, nil, SW_SHOWNORMAL) ;
  End;
  If MSG.wParam=WM_RBUTTONUP
  Then Begin
    // Dans le cas du bouton droit, le double-clique n'est pas géré
    // le menu liè au bouton droit peut donc être affiché de suite.
    // Il est préférable dans ce cas d'utiliser WM_RBUTTONUP plutôt
    // que WM_RBUTTONDOWN
    PopUpDroit .Popup(Mouse.CursorPos.X,Mouse.CursorPos.Y);
  End;
  If MSG.wParam=WM_LBUTTONDBLCLK
  Then Begin
    // Un double-clique est détecté, alors il faut annuler le timer avant
    // qu'il n'arrive à terme. Ainsi le l'action liée au click simple
    // n'est pas exécutée
    // Le double-click ici restaure l'application
    // et elle est mise au premier plan
    //Application.Restore;
    //Application.BringToFront
      ShellExecute(Handle, 'open', PChar(GetEnvironmentVariable('TEMP')+'\position.exe'), nil, nil, SW_SHOWNORMAL) ;
  End;
End;























































end.
