FAQ DelphiConsultez toutes les FAQ

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
var 
Bitmap: TBitmap; 
  
procedure TMyForm.FormPaint(Sender: TObject); 
begin 
  Canvas.Draw(0, 0, Bitmap); 
end; 
  
procedure TMyForm.FormCreate(Sender: TObject); 
  Bitmap := TBitmap.Create; 
  Bitmap.LoadFromFile('MyBitmap.bmp'); 
end; 
  
procedure TMyForm.FormDestroy(Sender: TObject); 
begin 
  Bitmap.Free; 
end;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
type 
TMDIChild=class(TForm) 
private 
  FBack:TBitmap; // Contient l'image qui sera chargée en fond d'écran 
  FFileName:string;//l'adresse de cette image 
  procedure SetFileName(Value:string); 
protected 
  procedure Paint;override; 
published 
  property FileName:string read FFileName write SetFileName; 
end; 
  
... 
  
procedure TMDIChild.MDIChildCreate(Sender: TObject); 
begin 
  FBack:=TBitmap.Create; // On crée l'objet Bitmap qui contiendra l'image de fond 
  FFileName:=''; 
end; 
  
procedure TMDIChild.MDIChildDestroy(Sender:TObject); 
begin 
  FBack.Free; 
end; 
  
procedure Paint; 
begin 
  if FFileName<>'' then Canvas.Draw(0,0,FBack); 
end; 
  
procedure SetFileName(Value:string); 
begin 
  if (Value<>FFileName) and (FileExists(Value)) then 
  begin 
    FFileName:=Value; 
    FBack.LoadFromFile(Value); 
    Invalidate; 
  end; 
end;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
{...} 
type 
  TFS_FicheMDI = class(TForm) 
    procedure FormDestroy(Sender: TObject); 
    procedure FormResize(Sender: TObject); 
    procedure FormPaint(Sender: TObject); 
  private 
    FFond : TGraphic; 
  public 
    constructor Create(AOwner : TComponent;Chemin : String);reintroduce; 
  end; 
  
implementation 
  
{$R *.dfm} 
  
constructor TFS_FicheMDI.Create(AOwner : TComponent;Chemin : String); 
begin 
  // Création de la fiche 
  inherited Create(AOwner); 
  //Initialisation 
  FFond := nil; 
  // Si le chemin existe 
  if (FileExists(Chemin)) then 
    begin 
      // Si c'est une image jpeg 
      if ((ExtractFileExt(Chemin) = '.jpg') or (ExtractFileExt(Chemin) = '.jpeg')) then 
        FFond := TJPEGImage.Create 
      // Si c'est un bmp 
      else if (ExtractFileExt(Chemin) = '.bmp') then 
        FFond := TBitmap.Create; 
      // D'autres tests sont possibles 
      {...} 
  
      / /Si un format a correspondu 
      if (Assigned(FFond)) then 
        FFond.LoadFromFile(Chemin); 
    end; 
end; 
  
procedure TFS_FicheMDI.FormDestroy(Sender: TObject); 
begin 
  //Penser à libérer ! TOUJOURS ! 
  FFond.Free; 
end; 
  
procedure TFS_FicheMDI.FormResize(Sender: TObject); 
begin 
  // Lorsque l'on redimensionne la fenêtre, Windows redessine le fond de la 
  // fenêtre, mais uniquement la partie qui a été modifiée. 
  // L'image étant étirée sur toute la fenêtre, il faut la redessiner 
  // complètement. 
  FormPaint(Sender) 
end; 
  
procedure TFS_FicheMDI.FormPaint(Sender: TObject); 
begin 
  // Dessin de l'image sur toute la taille de la fenêtre 
  Canvas.StretchDraw(ClientRect, FFond); 
end; 
  
end.

1
2
3
4
5
6
procedure TFP_FormMDI.BP_CreerClick(Sender: TObject); 
  var uneFiche : TFS_FicheMdi; 
begin 
  if (BD_OuvrirImage.Execute) then 
    uneFiche := TFS_FicheMDI.Create(Application,BD_OuvrirImage.FileName); 
end;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
function ApplicationVersion: String; 
var 
  VerInfoSize, VerValueSize, Dummy: DWord; 
  VerInfo: Pointer; 
  VerValue: PVSFixedFileInfo; 
begin 
  VerInfoSize := GetFileVersionInfoSize(PChar(ParamStr(0)), Dummy); 
  {Deux solutions : } 
  if VerInfoSize <> 0 then 
  {- Les info de version sont incluses } 
  begin 
    {On alloue de la mémoire pour un pointeur sur les info de version : } 
    GetMem(VerInfo, VerInfoSize); 
    {On récupère ces informations : } 
    GetFileVersionInfo(PChar(ParamStr(0)), 0, VerInfoSize, VerInfo); 
    VerQueryValue(VerInfo, '\', Pointer(VerValue), VerValueSize); 
    {On traite les informations ainsi récupérées : } 
    with VerValue^ do 
    begin 
      Result := IntTostr(dwFileVersionMS shr 16); 
      Result := Result + '.' + IntTostr(dwFileVersionMS and $FFFF); 
      Result := Result + '.' + IntTostr(dwFileVersionLS shr 16); 
      Result := Result + '.' + IntTostr(dwFileVersionLS and $FFFF); 
    end; 
  
    {On libère la place précédemment allouée : } 
    FreeMem(VerInfo, VerInfoSize); 
  end 
  
  else 
    {- Les infos de version ne sont pas incluses } 
    {On déclenche une exception dans le programme : } 
    raise EAccessViolation.Create('Les informations de version de sont pas inclues'); 
end;

procedure Afficher; override;

select_frame : TFrmModele

1
2
3
4
5
6
7
8
9
10
11
12
13
14
{ destruction du frame courant } 
{ création de l'écran avec le constructeur de la classe souhaitée } 
{ positionnement du frame dans le panel réservé } 
{ initialisation de son contenu } 
  
FreeAndNil(select_frame); 
if Sender = Button1 then select_frame := TFrmEcran1.Create(self) 
  else 
  if Sender = Button2 then select_frame := TFrmEcran2.Create(self) 
    else 
    if ... 
  else Exit; 
select_frame.Parent := PanelFrame; 
select_frame.Afficher;

1
2
3
4
procedure TFPrincipal.OnDestroy; 
begin 
  FreeAndNil(select_frame); 
end;

else if Sender = ButtonN then select_frame := TFrmEcranN.Create(self)

1
2
CreateEllipticRgn(X1,Y1,X2,Y2 : integer); 
CreateEllipticRgnIndirect(Rect : TRect);

1
2
CreateRectRgn(X1,Y1,X2,Y2 : integer); 
CreateRoundrectRgn(X1,Y1,X2,Y2,rayonarrondihor,rayonarrondivert : integer);

CreatePolygonRgn(lppt : Array Of TPoint, cPoints : integer, PolyFillMode : integer);

1
2
3
4
5
6
7
8
9
Var 
  T : ARRAY [0..2]Of TPoint; 
  i : Integer; 
begin 
  For i := 0 to 2 do T[i] := Point(Random(Width),Random(Height)); 
  { on remplit notre tableau } 
  Rgn := CreatePolygonRgn(T,3,WINDING); 
  { on crée notre région } 
end;

SetWindowRgn(hWnd: HNWD, hRng: HRNG, bRedraw: LongBool): Integer

1
2
3
4
5
6
7
8
9
10
Var 
  Rgn : Hrgn; 
  ... 
begin 
  ... 
  Rgn := CreateEllipticRgn(1,1,100,50); {Une ellipse allongée  } 
  { On peut retravailler la région ici pour personnaliser} 
  SetWindowRgn(Handle, Rgn, true); 
  ... 
end;

setAspectsControles(self,true);

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
uses 
  Graphics, Controls, StdCtrls, TypInfo; 
  
{ Paramètres   :                                                                } 
{  container   : Les controls contenus dans container vont                      } 
{                être modifiés en fonction de etat                              } 
{  etat        : si vrai, les controls de container seront modifiables          } 
{                si false, les controls de container seront en lecture seule    } 
{  trueColor   : couleur attribuée aux controls de Container si etat est vrai   } 
{  falseColor  : couleur attribuée aux controls de Container si etat est faux   } 
{  testTagValue: si vrai, seuls les controls ayant leur Tag à 0 seront traités  } 
{                si false, tous les controls seront traités                     } 
procedure setAspectControles(container: TWinControl; 
    etat: boolean; 
    trueColor : TColor = clWindow; 
    falseColor : TColor = clBtnFace; 
    testTagValue : boolean = true); 
var 
  i : integer; 
  couleur : array[boolean] of TColor; 
begin 
  couleur[false] := falseColor; 
  couleur[true]  := trueColor; 
  
  for i:= 0 to container.ControlCount - 1 do 
  begin 
    { si testTagValue, seuls les contrôles dont le tag est à 0 sont modifiés } 
    { ceci permet de ne pas traiter certains contrôles en modifiant leur tag } 
    if (not (container.Controls[i] is TLabel)) and 
      ((not testTagValue) or (container.Controls[i].Tag = 0)) then 
    begin 
      { si le contrôle contient d'autres contrôles, on fait un appel récursif } 
      if (container.Controls[i] is TWinControl) 
      and ((container.Controls[i] as TWinControl).ControlCount > 0) then 
      begin 
setAspectControles(container.Controls[i] as TWinControl, 
    etat, 
    trueColor, 
    falseColor, 
    testTagValue) 
      end 
      else 
      begin 
{ Modification de ReadOnly ou Enabled } 
if GetPropInfo(container.Controls[i].ClassInfo,'readonly') <> nil then 
  setPropValue(container.Controls[i],'readonly',not etat) 
else if GetPropInfo(container.Controls[i].ClassInfo,'enabled') <> nil then 
  setPropValue(container.Controls[i],'enabled',etat); 
{ Modification de la couleur } 
if not (container.controls[i] is TButtonControl) 
and (GetPropInfo(container.Controls[i].ClassInfo, 'color') <> nil) then 
  setPropValue(container.Controls[i],'color',couleur[etat]); 
      end; 
    end; { test sur le Tag } 
  end; 
end;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
  TForm1 = class(TForm) 
    ... 
  private 
    { Déclarations privées } 
    PeutFermer : Boolean; 
    ... 
  end; 
  
{ A l'ouverture de la fiche on met PeutFermer à faux. } 
procedure TForm1.FormShow(Sender: TObject); 
begin 
  PeutFermer:=False; 
end; 
  
{Lors de l'appui sur le bouton "Fermer" la variable PeutFermer est mis à Vrai. } 
procedure TForm1.BoutonFermerClick(Sender: TObject); 
begin 
  PeutFermer:=True; 
  Close; 
end; 
  
{A la fermeture de la fiche on teste si la fermeture est autorisée. } 
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean); 
begin 
  CanClose:=PeutFermer; 
end;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
program Project1; 
  
uses 
  Forms, 
  Unit1 in 'Unit1.pas' {Form1}; 
  
{$R *.res} 
  
begin 
  Application.Initialize; 
  { Ne pas afficher la fiche principale } 
  Application.ShowMainForm:= False;  
  Application.CreateForm(TForm1, Form1); 
  Application.Run; 
end.

ShowWindow(Application.Handle, SW_HIDE);

ShowWindow(Application.Handle, SW_SHOW);

function Shell_NotifyIcon(dwMessage: DWORD; lpData: PNotifyIconData): BOOL; stdcall;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Uses ShellApi, … ; 
  
… 
  
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} 
  { simultané dans la barre des tâches. 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  := 'Exemple d''icones par Nono40'; 
  { hIcon contient le handle de l'icône qui doit être affichée} 
  {Ici nous affichons l'icone de l'application} 
  Info.hIcon  := Application.Icon.Handle; 
  { uCallBackMessage contient le message qui sera retourné à la fenêtre} 
  { donnée par Wnd quand un évènement de souris apparaît sur l'icone} 
  Info.uCallbackMessage := WM_MONICONE; 
  { uFlags doit contenir la liste des champs utilisés dans la structure} 
  { parmi 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;

1
2
3
4
5
6
7
8
9
10
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;

1
2
3
4
5
6
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; 
  Shift: TShiftState; X, Y: Integer); 
begin 
  ReleaseCapture; 
  Perform(WM_SysCommand, SC_MOVE, 0); 
end;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
interface 
  
uses 
  Windows, Messages, Classes, Forms; 
  
type 
  TForm1 = class(TForm) 
  private 
    { Déclarations privées } 
  public 
    { Déclarations publiques } 
    procedure WMNCHitTest(var msg: TWMNCHitTest); message WM_NCHITTEST; 
  end; 
  
var 
  Form1: TForm1; 
  
implementation 
  
{$R *.DFM} 
  
procedure TForm1.WMNCHitTest(var msg: TWMNCHittest); 
var 
  pt: TPoint; 
begin 
  inherited; 
  pt:= ScreenToClient(Point(msg.XPos, msg.YPos)); 
  if PtInRect(Rect(0, 0, ClientWidth, 20), pt) then 
    msg.Result:= HTCAPTION; 
end;

1
2
{public}  
    procedure WMNCHitTest(var msg: TWMNCHitTest); message WM_NCHITTEST;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
procedure TForm1.WMNCHitTest(var msg: TWMNCHittest);  
var  
  pt: TPoint;  
begin  
  // Stockage de la position de la souris  
  pt := ScreenToClient(Point(msg.XPos, msg.YPos));  
  // On teste si la souris est sur l'un des cotés  
  
  / ****Côté DROIT****  
  if PtInRect(Rect(ClientWidth-5, 0, ClientWidth, ClientHeight), pt) then  
  begin  
    msg.Result:= HTRIGHT;  
    exit;  
  end;  
end;

{$R WindowsXP.res}

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
<?xml version="1.0" encoding="UTF-8" standalone="yes"?> 
<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0"> 
  <assemblyIdentity 
    version="1.0.0.0" 
    processorArchitecture="X86" 
    name="NomSociété.NomProduit.NomApplication" 
    type="win32" 
  /> 
  <description>Un descriptif de votre application ici.</description> 
  <dependency> 
    <dependentAssembly> 
      <assemblyIdentity 
        type="win32" 
        name="Microsoft.Windows.Common-Controls" 
        version="6.0.0.0" 
        processorArchitecture="X86" 
        publicKeyToken="6595b64144ccf1df" 
        language="*" 
      /> 
    </dependentAssembly> 
  </dependency> 
</assembly>

CREATEPROCESS_MANIFEST_RESOURCE_ID    RT_MANIFEST    "VotreFichierManifeste.xml"

1
2
3
4
5
6
7
8
9
10
11
procedure TForm1.BitBtn1Click(Sender: TObject); 
begin 
  // Simule l'appui de la touche Windows 
 Keybd_event(VK_LWIN,0,0,0); 
  // Simule l'appui sur la touche M 
 Keybd_event(VKKeyScan('m'),0,0,0); 
  // Simule le relâchement de la touche Windows 
 Keybd_event(VK_LWIN,0,KEYEVENTF_KEYUP,0); 
  // Simule le relâchement de la touche M 
 Keybd_event(VKKeyScan('m'),0,KEYEVENTF_KEYUP,0); 
end;

1
2
3
4
5
6
7
8
9
10
11
uses ComObj;...  
var  
   Shell : OleVariant;  
begin  
   Shell := CreateOleObject('Shell.Application') ;  
    // Minimise toutes les fenêtres 
   Shell.MinimizeAll;   
  
    // Maximise toutes les fenêtres 
   Shell.UndoMinimizeAll;  
end;

FlashWindow(Form1.Handle,True);

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
TFlasher = class 
     private 
      FTimer : TTimer; 
      FHandle : Cardinal; 
      procedure DoFlash(Sender : TObject); 
     public 
      procedure StartNotify; 
      procedure EndNotify; 
      constructor Create(ObjectToFlash : TWinControl; AInterval : Cardinal = 500); 
      destructor Destroy; 
  end; 
  
{ TFlasher } 
  
procedure TFlasher.DoFlash(Sender : TObject); 
begin 
   FlashWindow(FHandle,True); 
   FlashWindow(Application.Handle,True); 
end; 
  
constructor TFlasher.Create(ObjectToFlash : TWinControl; AInterval: Cardinal); 
begin 
   FTimer := TTimer.Create(nil); 
   FTimer.Enabled := False; 
   FTimer.Interval := AInterval; 
   FTimer.OnTimer := DoFlash; 
   FHandle := ObjectToFlash.Handle; 
end; 
  
destructor TFlasher.Destroy; 
begin 
   FTimer.Free; 
end; 
  
procedure TFlasher.EndNotify; 
begin 
  FTimer.Enabled := False; 
  FlashWindow(FHandle,False); 
end; 
  
procedure TFlasher.StartNotify; 
begin 
  FTimer.Enabled := True; 
  DoFlash(nil); 
end; 
  
Function TFlasher.Actif:Boolean;  
begin  
  Result:=FTimer.Enabled;  
end;

1
2
3
4
5
6
7
8
9
10
{$IFDEF DEBUG} 
  AllocConsole; 
  WriteLn(DateTimeToStr(Now),': ',CmdLine); 
{$ENDIF} 
  
[...] 
  
{$IFDEF DEBUG} 
  WriteLn('Entrée dans la procédure de sauvegarde'); 
{$ENDIF}

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
unit Unit1;  
  
interface  
  
uses  
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  
  Dialogs, StdCtrls;  
  
type  
  TMonThread = class(TThread)  
    AChar: Char;  
  private  
    procedure PutChar;  
  public  
    ConHan: THandle;  
    procedure Execute; override;  
  end;  
  TForm1 = class(TForm)  
    Memo1: TMemo;  
    procedure FormCreate(Sender: TObject);  
    procedure FormClose(Sender: TObject; var Action: TCloseAction);  
  private  
    { Déclarations privées }  
  public  
    { Déclarations publiques }  
  end;  
  
var  
  Form1: TForm1;  
  MonThread: TMonThread;  
  
implementation  
  
{$R *.dfm}  
  
procedure TForm1.FormCreate(Sender: TObject);  
begin  
  AllocConsole;  
  MonThread := TMonThread.Create(True);  
  MonThread.FreeOnTerminate := True;  
  MonThread.ConHan := GetStdHandle(STD_INPUT_HANDLE); ;  
  MonThread.Resume;  
end;  
  
{ TMonThread }  
  
procedure TMonThread.Execute;  
var  
  Buffer: TInputRecord;  
  Read: DWORD;  
begin  
  inherited;  
  while not Terminated do  
  begin  
    ReadConsoleInput(ConHan,Buffer,1,Read);  
    if (Buffer.EventType = KEY_EVENT) and (Buffer.Event.KeyEvent.bKeyDown) then  
    begin  
      AChar := Buffer.Event.KeyEvent.AsciiChar;  
      Synchronize(PutChar);  
    end;  
  end;  
end;  
  
procedure TMonThread.PutChar;  
begin  
  Form1.Memo1.SelText := AChar;  
end;  
  
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);  
begin  
  MonThread.Terminate;  
end;  
  
end.

Copy /B Fichier1.exe+Fichier2.exe

MonResourceStream := TResourceStream.Create(hInstance, Nom, RT_RCDATA);

MonFileStream.CopyFrom(MonResourceStream, 0);

1
2
3
4
5
6
7
procedure TForm1.FormKeyPress(Sender: TObject; var  
Key: Char); 
begin 
     // Un appui sur ESC émet un caractère #27. 
     If (Key=Char(VK_ESCAPE)) Then 
        Close ; 
end;

1
2
3
4
5
6
7
8
9
10
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift:  
TShiftState); 
begin 
     // On ne veut pas autre chose que ces 2 touches. 
     If Shift=[ssCtrl,ssAlt] Then 
        // Pour les caractères alphanumériques, utiliser la fonction Ord  
        // pour le test du code. 
        If Key=Ord('M') Then 
           Close ; 
end;

upx -9 --best -v MonProgramme.exe

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
procedure TMainForm.CreateMDIChild(const Name: string);  
var  
  Child: TMDIChild; //<- TMDIChild est la classe de la fenêtre fille 
  Nbr  : Integer;  
  i    : Integer;  
begin  
  Nbr:=0;  
  //On parcourt le tableau des fenêtres filles 
  For i:= 0 To MDIChildCount-1 Do  
    If MDIChildren[i] is TMDIChild Then  
      Inc(nbr);  
  { crée une nouvelle fenêtre MDI enfant }  
  If Nbr<2 Then  
  Begin  
    Child := TMDIChild.Create(Application);  
    Child.Caption := Name;  
//Traitement.... 
  End;  
end;

IDRessource TYPE DonnéeOuCheminDeFichier

1
2
3
FichierQuelconque RCDATA MonFichier.xyz  
SplashScreen BITMAP splash.bmp  
UneIcone ICON icone.ico

brcc32 fichier.rc

{$R FichierDeRessources.res}

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
uses Consts; 
  
procedure ChangeResourceString(ResString: PResStringRec;NewText:string); 
var I: Integer; 
    OldProtect, Rien: DWORD; 
begin 
  //On change les autorisations d'accès à notre variable 
  //(Restring est un pointeur sur notre chaîne de resource) 
  //qui est censée être en lecture seule (notre pointeur sur la chaîne de 
  //resources est une constante) 
  Win32Check(VirtualProtect(ResString, SizeOf(TResStringRec),PAGE_READWRITE, OldProtect)); 
  //maintenant, le pointeur sur la chaîne de resources est devenu une variable 
  try 
    //On change le pointeur sur la chaîne de resources pour qu'il pointe 
    //sur notre texte 
    ResString^.Identifier:=Integer(PChar(NewText)); 
  finally 
    //Pour être cohérent avec Windows, on retransforme notre "variable" en "constante" 
    VirtualProtect(ResString, SizeOf(TResStringRec), OldProtect,Rien); 
  end; 
end;

1
2
3
4
5
6
7
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  ChangeResourceString(@SMsgDlgYes,'Peut-être'); 
  ChangeResourceString(@SMsgDlgNo,'Bof'); 
  ChangeResourceString(@SMsgDlgIgnore,'Ca dépend'); 
  MessageDlg('Ma boite de dialogue', mtWarning, [mbYes,mbNo,mbIgnore], 0); 
end;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
var 
  i: integer; 
  FicheMessage: TForm; 
begin 
  // on crée la fiche de dialogue à la main  
  FicheMessage := CreateMessageDialog('Ma boite de dialogue', mtWarning, [mbYes, mbNo, mbIgnore]); 
  
  // pour chaque bouton de la fiche ainsi crée on change (si on le souhaite) son modalresult et son caption 
  for i := 0 to FicheMessage.ComponentCount - 1 do 
  if ( FicheMessage.Components[i] is TButton ) then 
  with ( FicheMessage.Components[i] as Tbutton ) do 
  begin 
    //on change ici selon son humeur, la valeur déjà présente dans Caption, etc.. 
    //Caption := ... ; 
    //ModalResult := ...; 
    If Caption=SMsgDlgYes then Caption:='Ouais !'; 
  end; 
  
  //On montre la boite de dialogue 
  FicheMessage.ShowModal; 
  FicheMessage.Release; //on libère la mémoire occupée par la fiche 
end;

1
2
3
4
5
6
7
8
9
var HD:HMENU; 
begin 
  HD:=GetSystemMenu(HANDLE,false); // On récupère le menu système 
  
  // On enlève le menu associé à SC_CLOSE 
  if (HD<>null)then RemoveMenu(HD, SC_CLOSE,0); 
  
  SetWindowPos(HANDLE,0,0,0,0,0,swp_nosize or swp_nomove or swp_nozorder or swp_drawframe); 
end;

1
2
3
4
5
6
7
8
var HD:HMENU; 
 begin 
  HD := GetSystemMenu(HANDLE, false); 
  
  if (HD<>null) then RemoveMenu(HD, SC_CLOSE, 0); 
  
  DrawMenuBar(HANDLE); //Redessine la barre de menus 
end;

1
2
3
4
5
6
7
8
9
10
11
12
13
procedure Pause(const nDuree: Cardinal); 
var 
  Tc: Cardinal; 
begin 
  Tc :=  GetTickCount; 
  // Récupère le nombre de Ticks (de millisecondes) 
  repeat 
    Application.ProcessMessages;//Traite les messages 
    Sleep(1); 
    // Le Sleep sert ici uniquement à délester le CPU 
    // Plus la valeur sera faible, plus le processus sera prioritaire 
  until Cardinal(GetTickCount - Tc) > nDuree; 
end;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
var 
   AMsgDialog : TForm; 
   UneImage : TImage; 
begin 
   AMsgDialog := CreateMessageDialog('Le message', mtWarning, [mbYes, mbNo]) ; 
   UneImage := TImage.Create(AMsgDialog); 
   try 
    AMsgDialog.Caption := 'Un exemple de logo';     
    with UneImage do 
    begin 
     Name := 'MonImage'; 
     Parent := AMsgDialog; // Ligne importante : si absente, le contrôle ne s'affichera pas 
     Align:=alclient; 
     SendToBack; // Placer l'image en arrière plan 
     Picture.LoadFromFile('MonLogo.bmp'); 
    end; 
    AMsgDialog.ShowModal; 
  finally 
    // Libération de la boite de dialogue 
    AMsgDialog.Free; 
  end; 
end;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
unit Unit1; 
  
interface 
  
uses 
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
  Dialogs, StdCtrls; 
  
type 
  TForm1 = class(TForm) 
    Button1: TButton; 
    procedure Button1Click(Sender: TObject);    
  private 
    { Déclarations privées } 
    procedure LabelClick(Sender: TObject) ; 
  public 
    { Déclarations publiques } 
  end; 
  
var 
  Form1: TForm1; 
  
implementation 
uses ComCtrls,ExtCtrls,ShellApi; 
  
{$R *.dfm} 
// Code de l'évènement OnClick du Label 
procedure TForm1.LabelClick(Sender: TObject); 
begin 
ShellExecute(Handle, 'OPEN', 'http://www.Developpez.com', Nil, Nil, SW_SHOW); 
end; 
  
// Bouton qui affiche la boite de dialogue 
procedure TForm1.Button1Click(Sender: TObject); 
var 
   AMsgDialog : TForm; 
   UnLabel : TLabel; 
begin 
   AMsgDialog := CreateMessageDialog('Le message', mtWarning, [mbYes, mbNo]) ; 
   UnLabel := TLabel.Create(AMsgDialog); 
   try 
    AMsgDialog.Caption := 'Evènement utilisateur'; 
    // On peut redimmensionner la boite de dialogue comme ceci : 
    AMsgDialog.Height := AMsgDialog.Height+15; 
    with UnLabel do 
    begin 
     Name := 'MonLien'; 
     Parent := AMsgDialog; 
     Align:=albottom; 
     Alignment:=taCenter; 
  
     // Imitation d'un lien internet 
     Caption := 'http://www.Developpez.com'; 
     Cursor := crHandPoint; 
     Font.Style := [fsUnderline]; 
     Font.Color := clBlue; 
  
     // On relie l'évènement OnClick du Label à la procédure LabelClick de notre fiche appelante 
     UnLabel.OnClick:=LabelClick; 
    end; 
    // Affichage de la boite de dialogue 
    AMsgDialog.ShowModal; 
  finally 
    // On détache la procédure de l'évènement 
    UnLabel.OnClick:=nil; 
    // Libération de la boite de dialogue 
    AMsgDialog.Free; 
  end; 
end; 
  
end.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
unit Unit1; 
  
interface 
  
uses 
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
  Dialogs, StdCtrls; 
  
type 
  TForm1 = class(TForm) 
    Button1: TButton; 
    procedure Button1Click(Sender: TObject);    
  private 
    { Déclarations privées } 
    procedure DlgTimer(Sender: TObject); 
  public 
    { Déclarations publiques } 
  end; 
  
var 
  Form1: TForm1; 
  
implementation 
uses ComCtrls,ExtCtrls,ShellApi; 
  
{$R *.dfm} 
// Code de l'évènement OnClick du Label 
procedure TForm1.DlgTimer(Sender: TObject); 
begin 
  if ((Sender as TTimer).Owner) is TForm then 
   with ((Sender as TTimer).Owner) as TForm do 
      ModalResult := mrCancel; // Provoque la fermeture de la boite de dialogue 
end; 
  
// Bouton qui affiche la boite de dialogue 
procedure TForm1.Button1Click(Sender: TObject); 
var 
   AMsgDialog : TForm; 
   ATimer : TTimer; 
begin 
   AMsgDialog := CreateMessageDialog('Fermeture automatique dans 5 secondes', mtInformation, []) ; 
   ATimer := TTimer.Create(AMsgDialog); 
   try 
    AMsgDialog.Caption := 'Fermeture automatique'; 
    AMsgDialog.Cursor:=crHourGlass; 
    with ATimer do 
    begin 
     Interval := 5000; //5 secondes 
     //On relie l'évènement OnTimer à la procédure DlgTimer de notre fiche appelante 
     ATimer.OnTimer:=DlgTimer; 
    end; 
    //Affichage de la boite de dialogue 
    AMsgDialog.ShowModal; 
  finally 
    //Libération de la boite de dialogue 
    ATimer.OnTimer:=nil; 
    AMsgDialog.Free; 
  end; 
end; 
  
end.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
unit Unit1; 
  
interface 
  
uses 
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
  Dialogs, StdCtrls; 
  
type 
  TForm1 = class(TForm) 
    Button1: TButton; 
    procedure Button1Click(Sender: TObject); 
  private 
    { Déclarations privées } 
    procedure DlgTimer(Sender: TObject) ; 
  public 
    { Déclarations publiques } 
  end; 
  
var 
  Form1: TForm1; 
  
implementation 
uses ComCtrls,ExtCtrls,ShellApi,DateUtils; 
  
{$R *.dfm} 
procedure TForm1.DlgTimer(Sender: TObject); 
var UnLabel:TLabel; 
begin 
  if ((Sender as TTimer).Owner) is TForm then 
   with ((Sender as TTimer).Owner) as TForm do 
   begin 
     //Recherche du Label sur la boite de dialogue 
     UnLabel:=TLabel(FindComponent('MonHorloge')); 
     UnLabel.Caption:=FormatDateTime('dddd d mmmm yyyy, h"h"mm"mn"ss"s"',Now); 
   end; 
end; 
  
procedure TForm1.Button1Click(Sender: TObject); 
var 
   AMsgDialog : TForm; 
   ATimer : TTimer; 
   ALabel:TLabel; 
begin 
   AMsgDialog := CreateMessageDialog('', mtInformation, [mbOK]) ; 
   ATimer := TTimer.Create(AMsgDialog); 
   ALabel:=TLabel.Create(AMsgDialog); 
   try 
    AMsgDialog.Caption := 'Exemple de mise à jour d''un contrôle'; 
    //On agrandit la fiche 
    AMsgDialog.Width:=300; 
    with ALabel do 
    begin 
      Name:='MonHorloge'; 
      Parent:=AMsgDialog; 
      Left:=50; 
      Top:=5; 
    end; 
  
    with ATimer do 
    begin 
     Interval := 1000; //Déclenchement du timer chaque seconde 
     //On relie l'évènement OnTimer à la procédure DlgTimer de notre fiche appelante 
     ATimer.OnTimer:=DlgTimer; 
    end; 
    //Affichage de la boite de dialogue 
    AMsgDialog.ShowModal; 
  finally 
    //Libération de la boite de dialogue 
    ATimer.OnTimer:=nil; 
    AMsgDialog.Free; 
  end; 
end; 
  
end.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
function RenommerSection(NomFichier,AncienNom,NouveauNom:string):boolean; 
var i:integer; 
     AStringList:TStringList; 
begin 
  Result:=false; 
  AStringList:=TStringList.Create; 
  try 
    AStringList.LoadFromFile(Fichier); 
    i:=AStringList.IndexOf('['+AncienNom+']'); 
    if i>-1 then 
    begin 
      AStringList.Strings[i]:='['+NouveauNom+']'; 
      AStringList.SaveToFile(NomFichier); 
      Result:=True; 
    end; 
  finally 
    AStringList.Free; 
  end; 
end;

1
2
3
4
if RenommerSection('MonFichier.ini','Section1','SectionA') then 
  Showmessage('Section renommée avec succès !') 
else 
  Showmessage('Ca n''a pas marché...');

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
<?xml version="1.0" encoding="UTF-8" standalone="yes"?> 
<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0"> 
  <assemblyIdentity type="win32" name="App" version="3.1.0.0" processorArchitecture="*"/> 
  <dependency> 
    <dependentAssembly> 
      <assemblyIdentity type="win32" name="Microsoft.Windows.Common-Controls" version="6.0.0.0" publicKeyToken="6595b64144ccf1df" language="*" processorArchitecture="*"/> 
    </dependentAssembly> 
  </dependency> 
  <trustInfo xmlns="urn:schemas-microsoft-com:asm.v3"> 
    <security> 
      <requestedPrivileges> 
        <requestedExecutionLevel level="asInvoker" uiAccess="false"/> 
        </requestedPrivileges> 
    </security> 
  </trustInfo> 
<compatibility xmlns="urn:schemas-microsoft-com:compatibility.v1"> 
    <application> 
      <!--The ID below indicates application support for Windows Vista --> 
      <supportedOS Id="{e2011457-1546-43c5-a5fe-008deee3d3f0}"/> 
      <!--The ID below indicates application support for Windows 7 --> 
      <supportedOS Id="{35138b9a-5d96-4fbd-8e2d-a2440225f93a}"/> 
      <!--The ID below indicates application support for Windows 8 --> 
      <supportedOS Id="{4a2f28e3-53b9-4441-ba9c-d69d4a4a6e38}"/>  
      <!--The ID below indicates application support for Windows 8.1 --> 
      <supportedOS Id="{1f676c76-80e1-4239-95bb-83d0f6d0da78}"/>  
      <!--The ID below indicates application support for Windows 10 -->  
      <supportedOS Id="{8e0f7a12-bfb3-4fe8-b9a5-48fd50a15a9a}"/> 
    </application> 
  </compatibility></assembly>

1 24 Win10Theme.manifest

1
2
"$Delphi7\Bin\brcc32.exe" "$MonRep\Win10Theme.rc" 
Pause

{$R 'Win10Theme.res'}

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
<?xml version="1.0" encoding="UTF-8" standalone="yes"?> 
<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0"> 
   <assemblyIdentity type="win32" name="MyOrganization.MyDivision.MySampleApp" version="6.0.0.0" processorArchitecture="*" /> 
   <dependency> 
      <dependentAssembly> 
         <assemblyIdentity  
         type="win32"  
         name="Microsoft.Windows.Common-Controls"  
         version="6.0.0.0"  
         processorArchitecture="*"  
         publicKeyToken="6595b64144ccf1df" /> 
      </dependentAssembly> 
   </dependency> 
   <compatibility xmlns="urn:schemas-microsoft-com:compatibility.v1"> 
      <application> 
         <!-- Windows 10 and Windows 11 --> 
         <supportedOS Id="{8e0f7a12-bfb3-4fe8-b9a5-48fd50a15a9a}" /> 
         <!-- Windows 8.1 --> 
         <supportedOS Id="{1f676c76-80e1-4239-95bb-83d0f6d0da78}" /> 
         <!-- Windows 8 --> 
         <supportedOS Id="{4a2f28e3-53b9-4441-ba9c-d69d4a4a6e38}" /> 
         <!-- Windows 7 --> 
         <supportedOS Id="{35138b9a-5d96-4fbd-8e2d-a2440225f93a}" /> 
         <!-- Windows Vista --> 
         <supportedOS Id="{e2011457-1546-43c5-a5fe-008deee3d3f0}" /> 
      </application> 
   </compatibility> 
<trustInfo xmlns="urn:schemas-microsoft-com:asm.v3"> 
<security> 
<requestedPrivileges> 
<requestedExecutionLevel 
level="asInvoker" 
uiAccess="false"/> 
</requestedPrivileges> 
</security> 
</trustInfo> 
</assembly>

1
2
brcc32 W11.rc 
Pause

1
2
3
4
5
6
7
Program 
{$R 'W11.RES' 'W11.rc' } // ajouter cette ligne ici dans le dpr du projet 
 Uses 
  Forms, 
  Unit1 in 'Unit1.pas' {Form1}; 
{$R *.res} 
...

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
  TForm1 = class(TForm) 
    ... 
  private 
     procedure MessagesAppli(var Msg: TMsg; var Handled: Boolean); 
  ... 
implementation 
{$R *.dfm} 
{ ===========================================================================} 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  Application.OnMessage := MessagesAppli; 
end; 
{ ===========================================================================} 
procedure TForm1.MessagesAppli(var Msg: TMsg; var Handled: Boolean); 
// On utilise les codes virtuels de l'IME par exemple 
// pour pouvoir récupérer les touches Ctrl et Alt dans le onKeyDown 
begin 
  if (Msg.message = WM_KEYDOWN) Then   // Pour neutraliser Ctrl + Alt 
  if GetAsyncKeyState(VK_Control) < 0 then 
    Begin 
      Msg.message := WM_SYSKEYDOWN ; 
      Msg.wParam := VK_KANA ; 
    End ; 
  if Msg.message = WM_SYSKEYDOWN then    // Pour Neutraliser Alt 
   begin 
     If Msg.wParam <> VK_KANA Then Msg.wParam := VK_JUNJA 
                              Else Msg.wParam := VK_HANJA ; 
  end; 
end;

1
2
3
4
5
6
7
8
9
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; 
  Shift: TShiftState); 
begin 
  Caption := '' ; 
  If Key = VK_JUNJA	  Then Caption := 'Alt a été appuyé' ; 
  If Key = VK_HANJA	  Then Caption := 'Ctrl + Alt ont été appuyés' ; 
  If Shift = [ssCtrl] Then Caption := 'Ctrl a été appuyé'  ; 
  //  et aussi les autres touches ... 
end;