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

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 ;

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 .

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 ;

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 ;

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 .

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 ;

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 ;

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 ;

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

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 ;

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 ;

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 ;

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 ;

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

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 ;

   var p: TPoint
  GetCursorPos(@p);

  SetCursorPos(100,100);

   var empl:TRect
  empl.Left:=100;
  empl. to p:=100;
  empl.Right:=200;
  empl.Bot to m:=200;
  ClipCursor(@empl);

  Sleep(durée);//(durée en millisecondes)

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

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

procedure Tform1.But to n1Click(Sender: Tobject);
   var
    mode : Word;
begin
  mode := SetErrorMode(SEM_FAILCRITICALERRORS);
   if DiskSize(1)<>-1 then beep;
  SetErrorMode(mode);
end ;

uses mmsystem;

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

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 ;

procedure Tform1.Button1Click(Sender: Tobject);
   var Bouton:Tbut to n;
begin
  Bouton:=Tbutton.Create(self);
  Bouton.Parent:=self; // necessaire pour que le Bouton soit visible
  Bouton.Visible:=true;
  Bouton.SetBounds(20,20,50,50);
  Bouton.Caption:='Bouton';
end ;

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 ;

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 ;

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 ;

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 ;

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 ;

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 ;

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 ;

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 .

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 ;

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 ;

// 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 ;

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 ;

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 ;

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 ;