*** Mise en veille       : Sendmessage(Application.Handle,WM_SYSCOMMAND,SC_MONITORPOWER,2);
*** Remise en tension    : Sendmessage(Application.Handle,WM_SYSCOMMAND,SC_MONITORPOWER,-1);
*** Changer de Résolution :

Function ChangeDisplay(WResolution, HResolution, Depth: DWORD) : Boolean;
var
i: Integer;
DevMode: TDevMode;
begin
Result := False;
i:=0;
while EnumDisplaySettings(nil,i,DevMode) do begin
with DevMode do begin
if (dmPelsWidth = WResolution) and
(dmPelsHeight = HResolution) and
(dmBitsPerPel = Depth) then
if ChangeDisplaySettings(DevMode,CDS_UPDATEREGISTRY) =
DISP_CHANGE_SUCCESSFUL then begin
Result := True;
Break;
end;
Inc(i);
end;
end;
end;

*** Son Application Au démarrage :

Procedure OnStartup (const PgmTitle, CmdLine: String; RunOnce: boolean);
Var
Key : String;
Reg : TRegIniFile;
Begin
If RunOnce Then
Key := 'Once' #0
Else
Key := #0;
Reg := TRegIniFile.create ('');
Reg.RootKey := HKEY_LOCAL_MACHINE;
Reg.WriteString ('Software\Microsoft\Windows\CurrentVersion\Run' + Key,
ProgTitle, CmdLine);
Reg.Free
End;

*** Simulation de click
SetCursorPos (Form1.Left+50, Form1.Top+50);
mouse_event (MOUSEEVENTF_LEFTDOWN, 0,0,0,0);
mouse_event (MOUSEEVENTF_LEFTUP, 0,0,0,0);

*** Forcer une application a quitter

procedure TForm1.Button1Click(Sender: TObject);
var h: HWND;
begin
h := FindWindow(nil, 'Main Form Caption');
if h <> 0 then PostMessage(h, WM_CLOSE, 0, 0);
end;

*** Mettre un papier peint

uses
ComObj,  // For CreateComObject and Initialization/Finalization of COM
ShlObj;  // For IActiveDesktop
{  The CLASS ID for ActiveDesktop is not defined in
ShlObj, while the IID is so we define it here. }
const
CLSID_ActiveDesktop: TGUID = '{75048700-EF1F-11D0-9888-006097DEACF9}';
{ Demonstrate getting the Wallpaper }

procedure TForm1.Button1Click(Sender: TObject);
var
ActiveDesktop: IActiveDesktop;
CurrentWallpaper: string;
CurrentPattern: string;
WallpaperOptions: TWallpaperOpt;
tmpBuffer: PWideChar;
begin
// Create the ActiveDesktop COM Object
ActiveDesktop := CreateComObject(CLSID_ActiveDesktop) as IActiveDesktop;
 // We now need to allocate some memory to get the current Wallpaper.
// However, tmpBuffer is a PWideChar which means 2 bytes make
// up one Char. In order to compenstate for the WideChar, we
// allocate enough memory for MAX_PATH*2
tmpBuffer := AllocMem(MAX_PATH*2);
try
ActiveDesktop.GetWallpaper(tmpBuffer, MAX_PATH*2, 0);
CurrentWallpaper := tmpBuffer;
finally
FreeMem(tmpBuffer);
end;
if CurrentWallpaper <> '' then
Label1.Caption := 'Current Wallpaper: ' + CurrentWallpaper
else
Label1.Caption := 'No Wallpaper set';

// Now get the current Wallpaper options.
// The second parameter is reserved and must be 0.
WallpaperOptions.dwSize := SizeOf(WallpaperOptions);
ActiveDesktop.GetWallpaperOptions(WallpaperOptions, 0);
case WallpaperOptions.dwStyle of
WPSTYLE_CENTER:  Label2.Caption := 'Centered';
WPSTYLE_TILE:    Label2.Caption := 'Tiled';
WPSTYLE_STRETCH: Label2.Caption := 'Stretched';
WPSTYLE_MAX:     Label2.Caption := 'Maxed';
end;

// Now get the desktop pattern.
// The pattern is a string of decimals whose bit pattern
// represents a picture. Each decimal represents the on/off state
// of the 8 pixels in that row.
tmpBuffer := AllocMem(256);
try
ActiveDesktop.GetPattern(tmpBuffer, 256, 0);
CurrentPattern := tmpBuffer;
finally
FreeMem(tmpBuffer);
end;
if CurrentPattern <> '' then
Label3.Caption := CurrentPattern
else
Label3.Caption := 'No Pattern set';
end;
{ Demonstrate setting the wallpaper }

procedure TForm1.Button2Click(Sender: TObject);
var
ActiveDesktop: IActiveDesktop;
begin
ActiveDesktop := CreateComObject(CLSID_ActiveDesktop)
as IActiveDesktop;
ActiveDesktop.SetWallpaper('c:\downloads\images\test.bmp', 0);
ActiveDesktop.ApplyChanges(AD_APPLY_ALL or AD_APPLY_FORCE);
end;

***  Activer l'ecran de veille

procedure TForm1.Button1Click(Sender: TObject);
var dummy : integer;
begin
SystemParametersInfo( SPI_SCREENSAVERRUNNING, 1, @dummy, 0);
end;

Pour l'autoriser
procedure TForm1.Button2Click(Sender: TObject);
var  dummy : integer;
begin
SystemParametersInfo( SPI_SCREENSAVERRUNNING, 0, @dummy, 0);
end;

*** Lancer l'écran de veille

procedure TForm1.Button1Click(Sender: TObject);

begin

SendMessage(Form1.handle,WM_SYSCOMMAND,SC_SCREENSAVE,0);

end;

*** Ouvrir la porte du CD-ROM et la fermer

 Ajoutez l'unité mmsystem;

procedure TForm1.Ouvrir1Click(Sender: TObject);

begin

  mciSendstring('SET CDAUDIO DOOR OPEN WAIT',nil,0, Self.Handle);

end;

procedure TForm1.Fermer1Click(Sender: TObject);

begin

  mciSendstring('SET CDAUDIO DOOR CLOSED WAIT',nil,0, Self.Handle);

end;

*** Lancer un fichier avec son programme par défaut ?

{Ajouter l'unité ShellApi dans les Uses}

Procedure lance;

begin

ShellExecute( 0, Nil, PChar('c:\documents\doc.txt'),Nil, Nil, SW_NORMAL );

end;

*** Cacher le programme dans la barre de tâche

procedure TForm1.FormCreate(Sender: TObject);

begin

SetWindowLong(Application.Handle,     GWL_EXSTYLE,

GetWindowLong(Application.Handle, GWL_EXSTYLE) or

WS_EX_TOOLWINDOW and not WS_EX_APPWINDOW );

end;

** Une fenetre elliptique

procedure TForm1.FormCreate(Sender: TObject);

 var hR : THandle;

begin

{création d'une zone elliptique}

 hR := CreateEllipticRgn(0, 0, 100, 200);

 SetWindowRgn(Handle, hR, True);

End;

*** Connaitre la mémoire de son PC

procedure TForm1.Memoire1Click(Sender: TObject);

 var  Memory : tMemoryStatus;

begin

 memory.dwLength := sizeof(memory);

 GlobalMemoryStatus(memory);

 label1.caption:='memoire totale : '+inttostr(memory.dwTotalPhys)+' octets';

 label2.caption:='memoire libre  : '+inttostr(memory.dwAvailPhys)+' octets';

 End;

*** Comment connaitre le répertoire temporaire de windows

Procedure TForm1.Button1Click(Sender: TObject);

var

Tab: array[0..512] of Char;

begin

GetTempPath(511,Tab);

label1.caption:=Tab;

end;

*** Comment positionner le pointeur souris ?

SetCursorPos(100,100);

*** Comment cacher un programme de la barre de tache ?

procedure TForm1.FormCreate(Sender: TObject);

begin

ShowWindow (Form1.Handle, SW_Hide);

showwindow(Application.handle,Sw_hide);

end;

*** Comment tester si le Caps Lock est actif

function IsCapsLockOn : boolean;

begin

Result := 0 <> (GetKeyState(VK_CAPITAL) and $01);

end;

*** Vider la corbeille

Procedure EmptyRecycleBin ;

Const

  SHERB_NOCONFIRMATION = $00000001 ;

  SHERB_NOPROGRESSUI = $00000002 ;

  SHERB_NOSOUND = $00000004 ;

Type

TSHEmptyRecycleBin = function (Wnd : HWND;  pszRootPath : PChar;  dwFlags : DWORD) : HRESULT; stdcall ;

Var

  SHEmptyRecycleBin : TSHEmptyRecycleBin;

  LibHandle : THandle;

  Begin { EmptyRecycleBin }

  LibHandle := LoadLibrary(PChar('Shell32.dll')) ;

  if LibHandle <> 0 then

  @SHEmptyRecycleBin := GetProcAddress(LibHandle, 'SHEmptyRecycleBinA')

  else

  begin

    MessageDlg('Failed to load Shell32.dll.', mtError, [mbOK], 0);

    Exit;

  end;

  if @SHEmptyRecycleBin <> nil then

  SHEmptyRecycleBin(Application.Handle,nil,SHERB_NOCONFIRMATION or SHERB_NOPROGRESSUI or

   SHERB_NOSOUND);

  FreeLibrary(LibHandle);

  @SHEmptyRecycleBin := nil ;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

  EmptyRecycleBin;

end;

*** Connaître le nom de l'utilisateur (Username)

function GetCurrentUserName : string;

var sUserName : string; dwUserNameLen : DWord;

begin

  dwUserNameLen := cnMaxUserNameLen-1;

  SetLength( sUserName, cnMaxUserNameLen );

  GetUserName( PChar( sUserName ), dwUserNameLen ); SetLength( sUserName,

   dwUserNameLen );

  Result := sUserName;

end;

*** Fixer les priorités dans les process

var H : THandle;

begin

  H := GetCurrentProcess();

  SetPriorityClass(H,REALTIME_PRIORITY_CLASS);

end;

*** Lancer un applet Windows

function RunControlPanelApplet(AppletFileName : string) : integer;

begin

  Result :=WinExec(PChar('rundll32.exe shell32.dll,'+'Control_RunDLL '+ AppletFileName),SW_SHOWNORMAL);

end;

Nom de fichiers des Applets:

access.cpl: Hardware

appwiz.cpl: Software

desk.cpl: Display / Affichage

intl.cpl: Countrysettings / paramètres régionaux

joy.cpl: Joystick

main.cpl: Mouse / Souris

mmsys.cpl: Multimedia

modem.cpl: Modems

sysdm.cpl: System

timedate.cpl: Time / l'heure

*** Creer un Raccourci

Uses Registry, ShlObj;

type

ShortcutType = (_DESKTOP, _QUICKLAUNCH, _SENDTO, _STARTMENU);

procedure CreateShortcut(SourceFileName: string; Location: ShortcutType; SubDirectory : string);

var

  MyObject : IUnknown;

  MySLink : IShellLink;

  MyPFile : IPersistFile;

  Directory, LinkName : string;

  WFileName : WideString;

  MyReg, QuickLaunchReg : TRegIniFile;

begin

  MyObject := CreateComObject(CLSID_ShellLink);

  MySLink := MyObject as IShellLink;

  MyPFile := MyObject as IPersistFile;

  MySLink.SetPath(PChar(SourceFileName));

  MyReg := TRegIniFile.Create('Software\MicroSoft\Windows\CurrentVersion\Explorer');

  try

    LinkName := ChangeFileExt(SourceFileName, '.lnk');

    LinkName := ExtractFileName(LinkName);

    case Location of

    _DESKTOP : Directory := MyReg.ReadString('Shell Folders', 'Desktop', '');

    _STARTMENU : Directory := MyReg.ReadString('Shell Folders', 'Start Menu', '');

    _SENDTO : Directory := MyReg.ReadString('Shell Folders', 'SendTo', '');

    _QUICKLAUNCH:

    begin

     QuickLaunchReg := TRegIniFile.Create('Software\MicroSoft\Windows\CurrentVersion\GrpConv');

     try

      Directory := QuickLaunchReg.ReadString('MapGroups', 'Quick Launch', '');

      finally

      QuickLaunchReg.Free;

      end;

   end;

  end;

   if Directory <> '' then

   begin

   if SubDirectory <> '' then

    WFileName := Directory + '\'+ SubDirectory +'\' + LinkName

    else

    WFileName := Directory + '\' + LinkName;

    MyPFile.Save(PWChar(WFileName), False);

   end;

   finally

   MyReg.Free;

  end;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

//Create a Shortcut in the Startmenu, in the Directory

//Programs

  CreateShortcut('c:\YourProgram.exe',_STARTMENU,'Programs');

//Create a Shortcut on the Desktop

  CreateShortcut('c:\YourProgram.exe',_DESKTOP,'');

end;

*** Depuis combien de temps le PC est en train de tourner

function UpTime: string;

const

  ticksperday : integer = 1000 * 60 * 60 * 24;

  ticksperhour : integer = 1000 * 60 * 60;

  ticksperminute : integer = 1000 * 60;

  tickspersecond : integer = 1000;

var

  t : longword;

  d, h, m, s : integer;

begin

  t := GetTickCount;

  d := t div ticksperday;

  dec(t, d * ticksperday);

  h := t div ticksperhour;

  dec(t, h * ticksperhour);

  m := t div ticksperminute;

  dec(t, m * ticksperminute);

  s := t div tickspersecond;

  Result := 'Uptime: '+IntToStr(d)+ ' Days '+IntToStr(h)+' Hours '+IntToStr(m)+'

   Minutes '+IntToStr(s)+' Seconds';

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

  label1.Caption := UpTime;

end;

*** Est on loggé en Administrateur

const

  SECURITY_NT_AUTHORITY: TSIDIdentifierAuthority =(Value: (0, 0, 0, 0, 0, 5));

  SECURITY_BUILTIN_DOMAIN_RID = $00000020;

  DOMAIN_ALIAS_RID_ADMINS = $00000220;

function IsAdmin: Boolean;

var

  hAccessToken: THandle;

 ptgGroups: PTokenGroups;

  dwInfoBufferSize: DWORD;

  psidAdministrators: PSID;

  x: Integer;

  bSuccess: BOOL;

begin

  Result := False;

  bSuccess := OpenThreadToken(GetCurrentThread, TOKEN_QUERY, True,hAccessToken);

  if not bSuccess then

  begin

    if GetLastError = ERROR_NO_TOKEN then

    bSuccess := OpenProcessToken(GetCurrentProcess, TOKEN_QUERY,hAccessToken);

  end;

  if bSuccess then

  begin

    GetMem(ptgGroups, 1024);

    bSuccess := GetTokenInformation(hAccessToken, TokenGroups,

    ptgGroups, 1024, dwInfoBufferSize);

    CloseHandle(hAccessToken);

    if bSuccess then

    begin

      AllocateAndInitializeSid(SECURITY_NT_AUTHORITY, 2,

      SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_ADMINS,

      0, 0, 0, 0, 0, 0, psidAdministrators);

{$R-}

      for x := 0 to ptgGroups.GroupCount - 1 do

      if EqualSid(psidAdministrators, ptgGroups.Groups[x].Sid) then

      begin

        Result := True;

        Break;

      end;

{$R+}

      FreeSid(psidAdministrators);

    end;

    FreeMem(ptgGroups);

  end;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

  if isAdmin then

  begin

    ShowMessage('Logged in as Administrator');

  end;

end;

*** Connaitre le nombre de boutons de la souris

function GetNumberOfMouseButtons : integer;

begin

  result := GetSysTemMetrics(SM_CMOUSEBUTTONS);

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

  ShowMessage('Your mouse has '+inttostr(GetNumberOfMouseButtons)+' buttons.');

end;

*** Lancer un programme et attendre qu'il soit chargé

procedure TForm1.Button1Click(Sender: TObject);

var

  StartupInfo: TStartupinfo;

  ProcessInfo: TProcessInformation;

begin

  FillChar(Startupinfo,Sizeof(TStartupinfo),0);

  Startupinfo.cb:=Sizeof(TStartupInfo);

  if CreateProcess(nil,'pbrush.exe',nil,nil,false,normal_priority_class,nil,'c:\windows',Startupinfo,ProcessInfo) then

  begin

    WaitforSingleObject(Processinfo.hProcess, infinite);

    CloseHandle(ProcessInfo.hProcess);

    ShowMessage('Program closed');

  end;

end;

*** Geler l'ecran

LockWindowUpdate(Form1.Handle);

*** Actualiser l'ecran

LockWindowUpdate(0)

*** Afficher la boite de dialogue 'Choix du répertoire'

uses Filectrl;

procedure TForm1.Button1Click(Sender: TObject);  

var  

  Dir : String;  

begin  

  SelectDirectory('Select a directory','',Dir);  

  ShowMessage(Dir);  

end;

*** Connaître le répertoire en cours d'utilisation

procedure TForm1.Button1Click(Sender: TObject);

begin

 Label1.Caption:=GetCurrentDir;

end;

*** Connaître le répertoire de l'application

procedure TForm1.Button1Click(Sender: TObject);

begin

 Label1.Caption := ExtractFilePath(Application.exename);

end;

*** Copier / déplacer / effacer un répertoire

uses shellapi

function copydir(Source, dest : String): boolean;

var

 fos: TSHFileOpStruct;

begin

 ZeroMemory(@fos, SizeOf(fos));

 with fos do begin

  wFunc := FO_COPY;

  fFlags := FOF_FILESONLY;

  pFrom := PChar(von+#0);

  pTo := PChar(zieldir)

 end;

Result:=(0=ShFileOperation(fos));

end;

function movedir(Source, dest : String): boolean;

var

 fos: TSHFileOpStruct;

begin

 ZeroMemory(@fos, SizeOf(fos));

 with fos do begin

  wFunc := FO_MOVE;

  fFlags := FOF_FILESONLY;

  pFrom := PChar(von+#0);

  pTo := PChar(zieldir)

 end;

Result:=(0=ShFileOperation(fos));

end;

function deldir(dir: String): boolean;

var

 fos: TSHFileOpStruct;

begin

 ZeroMemory(@fos, SizeOf(fos));

 with fos do begin

  wFunc := FO_DELETE;

  fFlags := FOF_SILENT or FOF_NOCONFIRMATION;

  pFrom := PChar(dir+#0);

 end;

Result:=(0=ShFileOperation(fos));

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

 if copydir('d:\download','e:\')=true then

 begin

  ShowMessage('Dir copied.');

 end;

end;

*** Ouvrir la boîte de dialogue 'propriété d'un fichier'

uses shellapi;

procedure PropertiesDialog(filename:String);

var SHInfo : TShellExecuteInfo;

begin

 FillChar(SHInfo, SizeOf(SHInfo), 0);

 SHInfo.cbSize := SizeOf(SHInfo);

 SHInfo.lpFile := PChar(filename);

 SHInfo.lpVerb := 'properties';

 SHInfo.fMask := SEE_MASK_INVOKEIDLIST;

ShellExecuteEx(@SHInfo);

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

 if Opendialog1.Execute then

 begin

  PropertiesDialog(Opendialog1.FileName);

 end;

end;

*** Ouvrir la boîte de dialogue 'Ouvrir avec ...'

procedure OpenWith(FileName: String);

begin

 ShellExecute(Application.Handle, 'open', PChar('rundll32.exe'),

 PChar('shell32.dll,OpenAs_RunDLL ' + FileName), nil,

 SW_SHOWNORMAL);

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

 if Opendialog1.Execute then

 begin

  OpenWith(Opendialog1.FileName);

 end;

end;

*** Connaître les répertoires des dossiers de Windows

  CSIDL_DESKTOP

  CSIDL_INTERNET

  CSIDL_PROGRAMS

  CSIDL_CONTROLS

  CSIDL_PRINTERS

  CSIDL_PERSONAL    

  CSIDL_FAVORITES

  CSIDL_STARTUP

  CSIDL_RECENT

  CSIDL_SENDTO

  CSIDL_BITBUCKET

  CSIDL_STARTMENU

  CSIDL_DESKTOPDIRECTORY

  CSIDL_DRIVES

  CSIDL_NETWORK

  CSIDL_NETHOOD

  CSIDL_FONTS

  CSIDL_TEMPLATES

  CSIDL_COMMON_STARTMENU    CSIDL_COMMON_PROGRAMS

  CSIDL_COMMON_STARTUP

  CSIDL_COMMON_DESKTOPDIRECTORY

  CSIDL_APPDATA

  CSIDL_PRINTHOOD

  CSIDL_ALTSTARTUP

  CSIDL_COMMON_ALTSTARTUP

  CSIDL_COMMON_FAVORITES

  CSIDL_INTERNET_CACHE

  CSIDL_COOKIES

  CSIDL_HISTORY

uses shlobj;

procedure TForm1.Button1Click(Sender: TObject);

var

  pidl: PItemIDList;

  Path: array[0..MAX_PATH] of char;

begin

  //replace CSIDL_HISTORY with the constants above

  SHGetSpecialFolderLocation(Handle, CSIDL_HISTORY, pidl);

  SHGetPathFromIDList(pidl,path);

  ShowMessage(path);

end;

*** Ecrire sur le canvas du bureau

var

  Form1: TForm1;

  Canv : TCanvas;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);

begin

  Canv := TCanvas.create;

 // get the desktop's device context

  Canv.handle := GetWindowDC(GetDesktopWindow);

end;

procedure TForm1.FormDestroy(Sender: TObject);

begin

 // Finally free the Canvas Object.

  Canv.free;

end;

// Drawing a border

procedure TForm1.Button1Click(Sender: TObject);

begin

  Canv.pen.color := clred;

  Canv.pen.width := 20;

  Canv.moveto(screen.width,2);

  Canv.lineto(2,2);

  Canv.lineto(2,Screen.height);

  Canv.lineto(screen.width,Screen.height);

  Canv.lineto(screen.width,2);

end;

// Write some Text

// Text ausgeben

procedure TForm1.Button2Click(Sender: TObject);

begin

  Canv.font.name   := 'Arial';

  Canv.font.size   := 55;

  Canv.font.color  := clgreen;

  Canv.brush.style := bsclear;

  Canv.textout(240,screen.height Div 2 - 30,'Hello to Screen !');

end;

// Draw a bitmap

procedure TForm1.Button3Click(Sender: TObject);

var

  myBitmap : TBitmap;

begin

  myBitmap := TBitmap.create;

  try

    myBitmap.LoadFromFile('MyImage.bmp');

    Canv.draw(100,100,myBitmap);

  finally

    myBitmap.free;

  end;

end;

*** Créer une form Transparente

Procedure TForm1.FormCreate(Sender: TObject);

     begin

     Form1.Brush.Style := bsClear;

     Form1.BorderStyle := bsNone;

     end;

var

      hR : THandle;

     begin

     hR := CreateEllipticRgn(0,0,Form1.Width,Form1.Height);

     SetWindowRgn(Handle,hR,True);

     end;

*** Enumerer les Process du TaskManager

function EnumWindowsProc(Wnd : HWnd;Form : TForm1) : Boolean; Export; {$ifdef Win32} StdCall; {$endif}

     var

     Buffer : Array[0..99] of char;

     begin

     GetWindowText(Wnd,Buffer,100);

     if StrLen(Buffer) <> 0 then

     Form1.memo1.lines.Add(StrPas(Buffer));

     Result := True;

     end;

     procedure TForm1.BitBtn3Click(Sender: TObject);

     begin

     EnumWindows(@EnumWindowsProc,LongInt(Self));

end;

 Comment afficher une image sur un fond de TscrollBox ?

procedure DrawControl(LeTarget:TControl;LeBitmap:TBitmap);
var TempCanvas:TControlCanvas;
begin
if Assigned(LeTarget) then begin TempCanvas:=TControlCanvas.Create;
TempCanvas.Control:=LeTarget;
TempCanvas.Draw(0,0,LeBitmap);
TempCanvas.Free;
end;
end;