GUERRI

  FARES

30 rue Berlier,
Dijon,
21000
France
Tel: 0603653101

Comment obtenir la representation (string) d'un code d'erreur

procedure Tform1.Button1Click(Sender: Tobject);
begin
  {Cause a Windows system error message to be logged}
  ShowMessage(InttoStr(lStrLen( nil )));
  ShowMessage(SysErrorMessage(GetLastError));
end ;

Comment utiliser la boite de dialogue de recherche d'un fichier

procedure Tform1.Button1Click(Sender: Tobject);
begin
with TDDEClientConv.Create(Self) do
begin
    ConnectMode := ddeManual;
    ServiceApplication := 'explorer.exe';
    SetLink( 'Folders', 'AppProperties');
    OpenLink;
    ExecuteMacro('[FindFolder(, C:windows)]', False);
    CloseLink;
    Free;
  end ;
end ;

Comment effacer une console windows

program Project1;
{$APPTYPE CONSOLE}
uses
Windows;
{$R *.RES}
var
    sbi : TConsoleScreenBufferInfo;
    i : integer;
begin
  Writeln('Une application console ');
  Writeln('Appyuer sur la touche entrée pour effacer l'écran');
  GetConsoleScreenBufferInfo(GetStdHandle(STD_OUTPUT_HANDLE),sbi);
  Readln;
  GetConsoleScreenBufferInfo(GetStdHandle(STD_OUTPUT_HANDLE),sbi);
for i := 0 to sbi.dwSize.y do
    writeln;
  Writeln('Press Enter to end ');
  Readln;
end .

Comment écrire de deux couleurs différentes dans une barre d'état

procedure Tform1.StatusBar1DrawPanel(StatusBar: TStatusBar;
Panel: TStatusPanel; const Rect: TRect);
begin
if Panel = StatusBar.Panels[0] then begin
    StatusBar.Canvas.Font.Color := clRed;
    StatusBar.Canvas.Textout(Rect.Left, Rect.top, 'Panel - 0')
end else begin
    StatusBar.Canvas.Font.Color := clGreen;
    StatusBar.Canvas.Textout(Rect.Left, Rect.top, 'Panel - 1');
end ;
end ;

Comment détruire un répertoire ainsi que tous les fichiers qu'il contient

procedure Tform1.Button1Click(Sender: Tobject);
var
    DirInfo: TSearchRec;
    r : Integer;
begin
r := FindFirst('C:repertoire*.*', FaAnyfile, DirInfo);
while r = 0 do begin
if ((DirInfo.Attr and FaDirectory <> FaDirectory) and
      (DirInfo.Attr and FaVolumeId <> FaVolumeID)) then
if DeleteFile(pChar('C:repertoire' + DirInfo.Name))= false then
    ShowMessage('Impossible de détruire : C:repertoire' + DirInfo.Name);
    r := FindNext(DirInfo);
end ;
  SysUtils.FindClose(DirInfo);
if RemoveDirec to ry('C:repertoire') = false then
  ShowMessage('Impossible de détruire le répertoire : C:repertoire');
end ;

Comment obtenir le numéro de série d'un cd audio

uses MMSystem, MPlayer;

procedure Tform1.Button1Click(Sender: Tobject);
var
mp : TMediaPlayer;
msp : TMCI_INFO_PARMS;
MediaString : array[0..255] of char;
ret : longint;
begin
  mp := TMediaPlayer.Create( nil );
  mp.Visible := false;
  mp.Parent := Application.Mainform;
  mp.Shareable := true;
  mp.DeviceType := dtCDAudio;
  mp.FileName := 'D:';
  mp.Open;
  Application.ProcessMessages;
  FillChar(MediaString, sizeof(MediaString), #0);
  FillChar(msp, sizeof(msp), #0);
  msp.lpstrReturn := @MediaString;
  msp.dwRetSize := 255;
  ret := mciSendCommand(Mp.DeviceId,
  MCI_INFO,
  MCI_INFO_MEDIA_IDENTITY,
  longint(@msp));
if Ret <> 0 then begin
  MciGetErrorString(ret, @MediaString, sizeof(MediaString));
  Memo1.Lines.Add(StrPas(MediaString));
end else
  Memo1.Lines.Add(StrPas(MediaString));
  mp.Close;
  Application.ProcessMessages;
  mp.free;
end ;
end .

Comment utiliser un curseur animé

procedure Tform1.Button1Click(Sender: Tobject);
var
    h : THandle;
begin
  h := LoadImage(0,'fichier animation',IMAGE_CURSOR,0,0,
    LR_DEFAULTSIZE or LR_LOADFROMFILE);
if h = 0 then ShowMessage('echec a l'ouverture du curseur') else begin
  Screen.Cursors[1] := h;
  form1.Cursor := 1;
end ;
end ;

Comment connaitre la liste des polices installées

uses Printers;

function EnumFontFamilyProc( var lf : TLogFont;var tm : TNewTextMetric;
    FontType : integer; var Memo : TMemo) : integer
{$if DEFWIN32} stdcall; {$else } ; export; {$endif }
begin
  Memo.Lines.Add(StrPas(@lf.lfFaceName) +
  #32 + Int to Str(lf.lfHeight));
  result := 1;
end ;

function EnumFontFamiliesProc( var lf : TLogFont; var tm : TNewTextMetric;
      FontType : integer; var Memo : TMemo) : integer
{$ if DEF WIN32} stdcall; {$ else } ; export; {$ end if }
begin
if FontType = TRUETYPE_FONTTYPE then begin
    Memo.Lines.Add(StrPas(@lf.lfFaceName) + #32 + 'All Sizes');
end else
    EnumFontFamilies(Printer.Handle,
  @lf.lfFaceName,
  @EnumFontFamilyProc,
  LongInt(@Memo));
  result := 1;
end ;

procedure Tform1.Button1Click(Sender: Tobject);
var
    tm : TTextMetric;
    i : integer;
begin
if PrintDialog1.Execute then begin
    EnumFontFamilies(Printer.Handle, nil ,
    @EnumFontFamiliesProc,LongInt(@Memo1));
end ;
end ;

Comment determiner la taille de la barre des taches

procedure Tform1.Button1Click(Sender: Tobject);
var
    r : TRect;
begin
  SystemParametersInfo(SPI_GETWORKAREA,0,@r,0);
  Memo1.Lines.Add(Int to Str(r.top));
  Memo1.Lines.Add(Int to Str(r.Left));
  Memo1.Lines.Add(Int to Str(r.Bottom));
  Memo1.Lines.Add(Int to Str(r.Right));
end ;

Comment rafraichir le bureau de Windows

procedure Tform1.Button1Click(Sender: Tobject);
begin
  SendMessage(FindWindow('Progman', 'Program Manager'),WM_COMMAND,$A065,0);
end ;

Comment afficher l'icone associée a un type de fichier

uses ShellApi;

procedure Tform1.But to n1Click(Sender: Tobject);
var
    Icon : hIcon;
    IconIndex : word;
begin
  Icon := ExtractAssociatedIcon(HInstance,'C:SomePathSomeFile.ext',IconIndex);
  DrawIcon(form1.Canvas.Handle, 10, 10, Icon);
end ;

Comment utiliser Microsoft Help Workshop

Comme un bon exemple vaut mieux qu'un long discours voici un exemple de fichier d'aide;
(il s'agit de la solution du jeu tomb raider 3 que j'ai trouvé sur le Web)
ainsi que quelques pistes pour le comprendre:
-le texte d'aide doit être placé dans uun fichier unique au format rtf
-les différentes rubriques doivent êtree séparées par un saut de page(crlt entrée sous Word)
-pour ajouter un identificateur de rubrrique ou une entrée dans l'index ... il faut sous Word :
aller dans le menu insertion
cliquer sur inserer une note de bas de pages
puis saisir: # %ID de la rubrique%>
k %entrée dans l'index%
$ %entrée dans le menu rechercher%

Comment lancer une application et attendre qu'elle se termine

function WinExecAndWait32(FileName:String):integer;
var
    zAppName:array[0..512] of char;
    zCurDir:array[0..255] of char;
    WorkDir:String;
    StartupInfo:TStartupInfo;
    ProcessInfo:TProcessInformation;
begin
  StrPCopy(zAppName,FileName);
  GetDir(0,WorkDir);
  StrPCopy(zCurDir,WorkDir);
  FillChar(StartupInfo,Sizeof(StartupInfo),#0);
  StartupInfo.cb := Sizeof(StartupInfo);
  StartupInfo.dwFlags := STARTF_USESHOWWINdow;
  StartupInfo.wShowWindow := 0 ;
if not CreateProcess( nil , zAppName, nil , nil , false,
CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, nil , nil ,StartupInfo,ProcessInfo) then Result := -1
  else begin
    Wait for SingleObject(ProcessInfo.hProcess,INFINITE);
    GetExitCodeProcess(ProcessInfo.hProcess,Result);
end ;
end ;

Comment associer une extension de fichier avec une application Delphi

Typiquement il faut ajouter deux clées dans la base de registre, à la racine HKEY_CLASSES_ROOT.
Ainsi si l'extention des fichiers de votre application est ".ext", la première clée a ajouter est

    HKEY_CLASSES_ROOT
    .ext

dont la valeur "default" est la description de l'extention
par exemple Monappli. do cument:

    HKEY_CLASSES_ROOT
    .ext
    Default = "Monappli.document"

Puis vous creez la deuxième clée en lui donnant pour nom la description de l'extention

    HKEY_CLASSES_ROOT
    Monappli.document

Enfin vous ajouter a cette clée une sous clée portant le nom "shell",
a laquelle vous ajouter la sous clée portant le nom "open"
a laquelle vous ajouter la sous clée portant le nom "command"
La valeur "default" de cette sous clé doit etre le chemin de votre application
suivi des lettres "%1" pour representer le nom du fichier a passer en parametre
de votre application :

    HKEY_CLASSES_ROOT
    Monappli.document
    shell
    open
    command
    Default = "C:\monapp.exe %1"

Comment connaitre le répertoire temporaire ou le répertoire courant

procedure Tform1.Button1Click(Sender: Tobject);
var
    buffer:array[0..255] of Char;
begin
  GetTempPath(255,buffer);
  label1.caption:='Répertoire temporaire: '+buffer;
  GetCurrentDirec to ry(255,buffer);
  label2.caption:='Répertoire courant: '+buffer;
end ;

Comment utiliser la corbeille

Cette procedure prend en parametre le nom d'un fichier
et l'envoie dans la corbeille
procedure Envoyer_corbeille(chemin: string);
var
    FileOpStruct: TSHFileOpStruct;
begin
  FillChar(MyFile,SizeOf(MyFile),0);
  FileOpStruct.wFunc:=FO_DELETE;
  FileOpStruct.pFrom:=PChar(chemin);
  FileOpStruct.fFlags:=FOF_ALLOWUN do ;
  SHFileOperation(@FileOpStruct);
end ;

Comment savoir si la touche Caps Lock est active

function IsCapsLockOn : boolean;
begin
  Result := 0 <> (GetKeyState(VK_CAPITAL) and $01);
end ;

Comment afficher l'aide d'une barre d'outils dans une barre de statut

Principe: déclarer un gestionnaire d'événement OnHint comme propriété publique
de la fiche principale
type
Tform1 = class(Tform)
...
procedure DisplayHint(Sender: Tobject);
...
end ;

var form1: Tform1;
implementation
{$R *.FRM}

procedure Tform1.DisplayHint(Sender: Tobject);
begin
StatusBar1.SimpleText := GetLongHint(Application.Hint);
end ;

procedure Tform1.formCreate(Sender: Tobject);
begin
  Application.OnHint := DisplayHint;
end ;

Comment modifier le pointeur de la souris

Pour connaitre la position de la souris:
var p: TPoint
  GetCursorPos(@p);
Pour positionner la souris:
  SetCursorPos(100,100);
pour limiter le champ de déplacement de la souris;
var empl:TRect
  empl.Left:=100;
  empl. to p:=100;
  empl.Right:=200;
  empl.Bot to m:=200;
  ClipCursor(@empl);

Comment laisser la main a windows pendant une certaine durée

La fonction suivante permet de faire cela :
  Sleep(durée);//(durée en millisecondes)

Comment connaitre la résolution de l'écran

procedure Tform1.Button1Click(Sender: Tobject);
var
    larg,haut:integer;
begin
  larg:=TScreen.width;
  haut:=TScreen.height;
end ;

Comment vérifier si une disquette se trouve dans le lecteur

Ma solution:
procedure Tform1.But to n2Click(Sender: Tobject);
begin
if DirectoryExists('A:\') then beep;
end ;

une autre solution trouvée sur le site:[email protected]
procedure Tform1.But to n1Click(Sender: Tobject);
var
    mode : Word;
begin
  mode := SetErrorMode(SEM_FAILCRITICALERRORS);
if DiskSize(1)<>-1 then beep;
  SetErrorMode(mode);
end ;

Comment regler le volume du son d'un composant TMediaplayer

uses mmsystem;

procedure Tform1.Button1Click(Sender: Tobject);
var
    volume : Word;
begin
  volume:=65535; //valeur maximale
  AuxSetVolume(mediaplayer1.DeviceID,volume);
end ;

Comment personnalisé l'image d'un composant

Sous Delphi aller dans Outils|Editeur d'images
Dans le menu de l'éditeur d'images aller dans fichier|Nouvelle|ressource composants(.dcr)
Une fenetre apparait : cliquer sur celle ci avec le bouton droit
Selectionner Nouveau|Bitmap
Spécifier les dimensions : hauteur 24 largeur 24
couleur : VGA 16 couleurs
donner a ce bitmap le nom de la classe du composant (ex TBUT to N)
Dessiner l'image
Puis sauvegarder la ressource sous un nom quelconque(avec l'extention .dcr)
Enfin ajouter dans l'unité du composant sous le mot implementation {$R .dcr}

Comment glisser des fichiers

type
Tform1 = class(Tform)
...
procedure WmDropFiles( var msg : TMessage); message WM_DROPFILES;
...
end ;

implementation

uses
ShellAPI;

procedure Tform1.WmDropFiles( var msg : TMessage);
var
    hdrop: THandle;
    nbFichiers,i : integer;
    buffer:string;
begin
  // handle de la structure interne
  hdrop:=msg.wParam;
  SetLength(buffer, 300);
  //si son deuxième paramètre est $0FFFFFFFF
  // DragQueryFile renvoie le nombre des fichiers glissés
  nbFichiers:=DragQueryFile(hdrop,$0FFFFFFFF,PChar(buffer),0);
for i:=0 to nbFichiers-1 do
  begin
    DragQueryFile(hDrop, i, PChar(buffer), 300); // récupère le nom du fichier
    ListBox1.Items.Add(buffer); // ajoute le nom
end ;
  // pour libérer de la mémoire
  DragFinish(hDrop);
end ;

procedure Tform1.formCreate(Sender: Tobject);
begin
  DragAcceptFiles(Listbox1.Handle, true);
end ;

Comment mettre un papier peint dans une fiche

Ajouter le code suivant à la fiche:
procedure Tform1.formCreate(Sender: Tobject);
begin
  PapierPeint:=TBitmap.create;
try
    PapierPeint.LoadFromFile('c:\windowsPavés\rouges.bmp');
except
    PapierPeint.Free;
    PapierPeint:= nil ;
end ;
end ;

procedure Tform1.formPaint(Sender: Tobject);
var
    c, l: integer;
begin
if not Assigned(PapierPeint) then exit;
for c:=0 to (Width div PapierPeint.width) do
for l:=0 to (Height div PapierPeint.height) do
      canvas.draw(c*PapierPeint.width,l*PapierPeint.height, PapierPeint);
end ;

Comment utiliser une image jpeg avec delphi

Ajouter l'unité JPeg dans la clause uses de la fiche ainsi que le code suivant
procedure Tform1.Button1Click(Sender: Tobject);
begin
if Opendialog1.Execute then
begin
    Image1.Picture.LoadFromFile(Opendialog1.FileName);
        //pour effectuer un Zoom
    TJPEGImage(Image1.Picture.Graphic).Scale:=TJPegScale(RadioGroup1.ItemIndex);
end ;
end ;

Comment optenir la version du systeme d'exploitation

procedure Tform1.formCreate(Sender: Tobject);
type
TPlatform = (VER_PLATform_Win32s, VER_PLATform_Win32_Windows, VER_PLATform_Win32_NT);
const
TPlateforme : array[TPlatform] of string = ('Win32s','Windows 95', 'Windows NT');
var
    OsInfo : to sVersionInfo;
begin
  OsInfo.dwOSVersionInfoSize:=sizeof(OsInfo);
if not GetVersionEx(OsInfo) then
    raise except ion.create('L''appel de la fonction GetVersionEx a échoué');
with Memo1.lines, OsInfo do begin
add(format('La plate-forme est %s',[TPlateforme[TPlatform(dwPlatformId)]]));
add(format('version %d.%d, construction %d',[dwMajorVersion, dwMinorVersion,dwBuildNumber]));
end ;
end ;

Comment installer un nouveau composant

C'est relativement simple il suffit d'aller dans le menu Composant|installer un composant
une boite de dialogue apparait, alors:
spécifier le nom de l'unité du composant (*.pas ou *.dcu)
puis le nom du paquet dans lequel vous voulez le placer
puis cliquer sur ok

Comment réaliser des boutons ayant une forme ovale

Ajouter le code suivant à la fiche(qui contient un Bouton nommé Button1) :
procedure Tform1.formCreate(Sender: Tobject);
var
    rgn: hrgn;
begin
  rgn:=CreateRoundRectRgn(0,0,but to n1.width,but to n1.height,30,30);
  SetWindowRgn(but to n1.handle, rgn, true);
end ;

procedure Tform1.formPaint(Sender: Tobject);
begin
  canvas.pen.width:=6;
  canvas.pen.color:=clgreen;
  canvas.RoundRect(but to n1.left,but to n1. to p,but to n1.width+but to n1.left,but to n1.height+but to n1. to p,30,30);
end ;

Comment modifier le menu système d'une fiche

type
Tform1 = class(Tform)
procedure formCreate(Sender: Tobject);
private
{ Déclarations privées}
public
{ Déclarations publiques}
procedure WMSysCommand( var Msg:TMessage); message wm_SysCommand ;
end ;

...
const idaPropos=200;

procedure Tform1.formCreate(Sender: Tobject);
begin
  AppendMenu(GetSystemMenu(Handle,false),MF_SEPARA to R,0,'');
  AppendMenu(GetSystemMenu(Handle,false),MF_STRING,idaPropos,'A propos');
end ;

procedure Tform1.WMSysCommand( var Msg:TMessage);
begin
if (Msg.WParam=idaPropos)
then showmessage('A propos');
  inherited;
end ;

Comment obliger l'utilisateur a ne saisir que des chiffres dans un composant Tedit

procedure Tform1.Edit1KeyPress(Sender: Tobject; var Key: Char);
begin
if not(key in     ['1','2','3','4','5','6','7','8','9','0','.','#8','#13']) then key:=#0;
end ;

Comment réaliser une application console

Ouvrir un nouveau projet
Puis aller projet | options | panneau lieur
Cocher la case créer une application console

Comment limiter la taille du code d une application

Dans le cas ou vous avez 3 boutons (ou plus) sur une fiche
et qu'ils répondent tous a l'événement OnClick:
donnez leurs une valeur de Tag différente et remplacer leur procédure OnClick par cette procédure unique :
procedure Tform1.ButtonClick(Sender: Tobject);
begin
  case (TBut to n(Sender).tag) of
    0: caption:=' Bouton 1';
    1: caption:=' Bouton 2';
    2: caption:=' Bouton 3';
end ;
end ;

Comment afficher l'état de progression de compilation comme avec Borland Builder

Aller Outils | Options d'environnement.. | panneau Compilation
Cocher la case montrer la progression

Comment modifier le programme principal afin d'afficher un écran de démarrage

program Project1;
uses
forms,
SysUtils,
Unit1 in 'Unit1.pas' {form1},
Unit2 in 'Unit2.pas' {demaform};

{$R *.RES}
var demaform : Tdemaform;
tpsArret:Tdatetime;
begin
  Application.Initialize;
try
    demaform := Tdemaform.create(application);
    tpsArret:=Now+EncodeTime(0,0,4,0); // affichage de l'écran
    // pendant une durée de 4 secondes
    demaform.Show; // affichage de l'écran de démarrage
while tpsArret>Now do application.ProcessMessages;
    demaform.close;
finally
    demaform.free ;// libération de la mémoire
end ;
  Application.Createform(Tform1, form1);
  Application.Run;
end .

Comment utiliser un composant Tmediaplayer avec 2 lecteurs de CD

Mettre la propriété Au to Open du composant a False
puis ajouter ses trois lignes de code par exemple a la méthode OnCreate de la fiche.
procedure Tform1.formCreate(Sender: Tobject);
begin
  MediaPlayer1.DeviceType:=dtCDAudio;
  MediaPlayer1.FileName:='D:'; // La lettre D correspond au nom logique du lecteur de CD
  MediaPlayer1.Open;
end ;

Comment afficher un fichier AVI sur une fiche

déposer un composant Tmediaplayer et un composant Tbut to n
sur une fiche puis écrire affecter cette méthode a l'événement OnClick du bouton
procedure Tform1.Button1Click(Sender: Tobject);
begin
  MediaPlayer1.DeviceType:=dtAVIVideo;
  MediaPlayer1.Display:=form1; //nom du conteneur
  MediaPlayer1.FileName:='Fox.avi';
  MediaPlayer1.Open;
  MediaPlayer1.DisplayRect:=   Rect(10,10,700,500); // surface d'affichage
  MediaPlayer1.Play;
end ;

Comment jouer un son windows

Utiliser l'instruction : MessageBeep avec pour argument
l'une des constantes suivantes : (ex MessageBeep(MB_OK)
MB_OK
MB_DEFBUTTON1
MB_OKCANCEL
MB_DEFBUTTON2
MB_ABORTRETRYIGNORE
MB_DEFBUTTON3
MB_YESNOCANCEL
MB_DEFBUTTON4
MB_YESNO
MB_APPLMODAL
MB_RETRYCANCEL
MB_SYSTEMMODAL
MB_ICONHAND
MB_ICONASTERISK
MB_RETRYCANCEL
MB_TASKMODAL
MB_ICONQUESTION
MB_HELP
MB_ICONEXCLAMATION
MB_NOFOCUS
MB_SETFOREGROUND
MB_USERICON
MB_DEFAULT_DESKTOP_ONLY
MB_ICONWARNING
MB_TOPMOST
MB_ICONERROR
MB_RIGHT
MB_ICONINFORMATION
MB_RTLREADING
MB_SERVICE_NOTIFICATION
MB_SERVICE_NOTIFICATION_NT3X
MB_ICONSTOP
MB_TYPEMASK
MB_ICONMASK
MB_DEFMASK
MB_MODEMASK
MB_MISCMASK

Comment accéder a la base de registre

// recherche du répertoire du programme de l'explorateur
// windows a l'aide de la base de registre:
implementation
uses registry ;
{$R *.DFM}
procedure Tform1.Button1Click(Sender: Tobject);
var
    reg:tregistry;
begin
  reg:=tregistry.Create;
  reg.RootKey:=HKEY_LOCAL_MACHINE;
  reg.OpenKey('software',false);
  reg.OpenKey('microsoft',false);
  reg.OpenKey('windows',false);
  reg.OpenKey('currentversion',false);
  reg.OpenKey('setup',false);
  Caption:=reg.ReadString('windir')+'explorer.exe';
  reg.Destroy;
end ;

Comment jouer un son situé dans une ressource

Création et compilation d'une ressource
ouvrir un nouveau projet
sauver ce projet dans le même répertoire que vos fichiers sons
ajouter un fichier texte a votre projet ( Fichier | nouveau | texte )
dans ce fichier texte faites une liste de vos fichiers sons ( une ligne par fichier
de la forme: Nom de la ressource puis WAVE puis "nom du fichier sons"
ex: W1 WAVE "f007.wav"
sauver ce fichier en lui do nnant l'extension .rc ( ex son.rc )

puis aller dans Voir | Gestionnaire de projet
dans le gestionnaire de projet cliquez sur nouveau puis Fichier batch
(un nouveau projet do it apparaître)
cliquer deux fois (avec le Bouton gauche) sur le nouveau projet
puis cliquer une fois (avec le Bouton droit) sélectionner Edition/options...
taper dans la ligne de commande BRCC32 suivit du nom du fichier rc créer précédemment
(ex: BRCC32 son.rc ) cliquer sur OK
puis cliquer une fois (avec le Bouton droit) sélectionner Enregistrer...
puis cliquer une fois (avec le Bouton droit) sélectionner Exécuter...
votre fichier ressource (.res ) est enfin créer
Utilisation de la ressource
dans le gestionnaire de projet cliquez deux fois sur le premier projet (pour le réactiver)
puis ajouter un Bouton sur la fiche avec la méthode Onclick suivante
procedure Tform1.But to n1Click(Sender: Tobject);
begin
playsound('W1',hinstance,SND_RESOURCE or SND_ASYNC); // W1 nom do nné a la ressource
end ;
enfin remplacer ce qu'il y a sous le mot implementation par
uses mmsystem;
{$R *.DFM}
{$R son.RES}
Vous pouvez maintenant lancer le programme

Comment créer un raccourci

Le code suivant ouvre une boite de dialogue l'utilisateur choisi un fichier, le programme créer alors un raccourci de ce fichier
implementation
uses
ComObj, ActiveX, ShlObj;
procedure Tform1.Button1Click(Sender: Tobject);
var
    AnObj: IUnknown;
    ShLink: IShellLink;
    PFile: IPersistFile;
    FileName: string;
    WFileName: WideString;
begin
if Opendialog1.Execute then
begin
    AnObj := CreateComObject (CLSID_ShellLink);
    ShLink := AnObj as IShellLink;
    PFile := AnObj as IPersistFile;
    FileName:=Op end ialog1.FileName;
    // propriété du lien
    ShLink.SetPath(PChar(FileName));     //cible
    ShLink.SetWorkingDirec to ry(PChar(ExtractFilePath(FileName)));     //démarrer en emplacement du raccourci
    WFileName :='c:mon_raccourci.lnk';
    PFile.Save (PWChar (WFileName), False);
end ;
end ;

Comment exécuter un fichier

La fonction suivante permet d'exécuter un fichier, elle prends en paramètre :
le nom du fichier à exécuter, puis les paramètres a lui transmettre et enfin le réper to ire de l'exécutable.
function ExecuteFile(const FileName, Params, DefaultDir: string):THandle;
var
    zFileName, zParams, zDir: array[0..79] of Char;
begin
  Result := ShellExecute(Application.Mainform.Handle, nil ,
  StrPCopy(zFileName, FileName), StrPCopy(zParams,Params),
  StrPCopy(zDir, DefaultDir), SW_SHOW);
end ;

Comment exécuter un programme de présentation lors de l'insertion d'un CD-Rom dans un lecteur

Si vous possédez un graveur peut être réalisez vous des applications de présentation
avec Delphi.
Si vous voulez qu'elles s'exécutent au to matiquement lorsque vous insérer le C.D. dans le lecteur
créer un fichier de nom Au to run.ini a la racine du C.D. (avant de le graver).
Puis écrivez a l'intérieur le code suivant :
[au to run]
OPEN=Au to run.exe (Au to run.exe= nom de l'application de presentation )
ICON=Icone.ico (Icone.ico = nom de l'icone du cd)

Puis cliquer une fois (avec le Bouton droit) sur le fichier Au to run.ini sélectionner Installer...

Comment arrêter ou relancer windows

Arrêt de Windows :
ExitWindowsEx(EWX_SHUTdowN,0);
Redémarrage de Windows :
ExitWindowsEx(EWX_REBOOT,0);
Redémarrage d'une session Windows :
ExitWindowsEx(EWX_ for CE,0);

Comment inhiber les exceptions définies par le programmeur

Lors d'un débogage l'exécution d'un programme est arrêté a chaque déclenchement d' except ion
or pour to utes les except ions définies ( do nc en principe rattrapées) ceci peut être très rébarbat if .
Pour éviter cela:
Aller dans Outils | Options du débogueur puis dans le panneau except ions du langage
Enfin cliquer sur ajouter pour saisir le nom de la classe d' except ion que vous voulez inhiber.

Comment cacher la fenêtre principale d'une application

Une seule ligne de code suffit:
application.Mainform.Visible:=false;
Rq: si l'application ne contient qu'une seule fiche alors elle devient invisible
dans la barre et (plus grave) lors d'un ALT-CRTL-SUP.

Comment sélectionner un répertoire avec une boîte de dialogue style Win 95

Il faut utiliser la fonction SelectDirectory (2eme syntaxe de l'aide Delphi)
Le répertoire sélectionné est renvoyé en tant que paramètre Directory.

uses FileCtrl;
procedure Tform1.Button1Click(Sender: Tobject);
var
    Directory: string;
    Root: WideString;
begin
  Root:='c:windows';
  SelectDirec to ry('Sélection d''un répertoire',root,Directory);
end ;

Comment réaliser une barre d'outils mobile (style Adobe Photoshop )

Ajouter une fiche à votre projet
initialiser sa propriété BorderStyle à bs to olWindow
initialiser sa propriété formStyle à fsStayOn to p
Ajouter vos Boutons sur cette fiche
Lancer le programme : vous devez obtenir une barre d'outils mobile.