FAQ DelphiConsultez toutes les FAQ

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
unit Unit1; 
  
interface 
  
uses 
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
  Dialogs, Grids, StdCtrls; 
  
type 
  TForm1 = class(TForm) 
    Button1: TButton; 
    ListBox1: TListBox; 
    procedure FormCreate(Sender: TObject); 
    procedure FormDestroy(Sender: TObject); 
  private 
    { Private declarations } 
    procedure DroppedFiles(var msg : TWMDropFiles) ; message WM_DROPFILES; 
  public 
    { Public declarations } 
  end; 
  
var 
  Form1: TForm1; 
  
implementation 
uses 
  ShellAPI; 
  
{$R *.dfm} 
  
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  { Nous devons tout d'abord informer le système que la fenêtre accepte 
    le lâcher de fichiers. } 
  DragAcceptFiles(self.Handle, True); 
end; 
  
procedure TForm1.FormDestroy(Sender: TObject); 
begin 
  { Le système doit également être informé que la fenêtre n'accepte plus 
    le lâcher de fichiers.} 
  DragAcceptFiles(self.Handle, false); 
end; 
  
procedure TForm1.DroppedFiles(var msg: TWMDropFiles); 
var 
  i: integer; 
  nombreDeFichiers: integer; 
  nomDuFichier: string; 
  tailleDuBuffer: integer; 
begin 
  { Ce gestionnaire de message est appelé lorsque l'utilisateur lâche un ou 
    plusieurs fichiers sur la fenêtre. Nous devons commencer par récupérer 
    le nombre de fichiers lâchés avant de les énumérer pour avoir leur nom.} 
  
  // Récupération du nombre de fichiers déposés sur la fenêtre 
  nombreDeFichiers:= DragQueryFile(msg.Drop, $FFFFFFFF, nil, 0); 
  
  // Affichage des noms des fichiers dans un TListBox 
  tailleDuBuffer:= MAX_PATH; 
  SetLength(nomDuFichier, tailleDuBuffer); 
  for i:= 0 to nombreDeFichiers - 1 do 
  begin 
    DragQueryFile(msg.Drop, i, PChar(nomDuFichier), tailleDuBuffer); 
    ListBox1.Items.Add(nomDuFichier); 
  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
procedure TForm1.Timer1Timer(Sender: TObject); 
var 
  Hand : THandle; 
  c    : PChar ; 
  L    : Cardinal; 
begin 
  Hand:=WindowFRomPoint(Mouse.CursorPos); //handle du composant 
  L := SendMessage(HAND,WM_GETTEXTLENGTH,0,0);//la longueur du texte 
  If L<>0 Then 
  Begin 
    GetMem(C,L+1); //on alloue la mémoire. 
// L+1 parce que les chaînes sont à zéro terminal, il faut prévoir la place  
du #0 
    Try 
      SendMessage(HAND,WM_GETTEXT,L+1,Integer(C));//on recupère le texte 
      Edit1.Text:=c; 
    Finally 
      FreeMem(c); 
    End; 
  End 
  Else Edit1.Text:=''; 
end;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
type 
  TConteneur = class(TScrollBox) 
  private 
    { Déclarations privées } 
  public 
    { Déclarations publiques } 
    constructor Create(AOwner: TComponent); override; 
    procedure CreateParams(var Params: TCreateParams); override; 
    procedure WMEraseBkgnd(var Msg: TWMEraseBkgnd); message WM_ERASEBKGND; 
  end; 
  
procedure TConteneur.CreateParams(var Params: TCreateParams); 
begin 
  inherited CreateParams(Params); 
  Params.ExStyle := params.ExStyle or WS_EX_TRANSPARENT; 
end; 
  
procedure TConteneur.WMEraseBkgnd(var Msg: TWMEraseBkgnd); 
begin 
  SetBkMode(Msg.DC, TRANSPARENT); 
  Msg.Result := 1; 
end;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
TForm1 = class(TForm) 
  private 
    { Déclarations privées } 
    procedure WMWindowClose(var Message: TWMWindowPosMsg); message WM_CLOSE; 
  public 
    { Déclarations publiques } 
  end; 
  
implementation 
  
procedure TForm1.WMWindowClose(var Message: TWMWindowPosMsg); 
begin 
  showMessage('Cette fiche ne peut être refermée'); 
end;

1
2
3
4
5
6
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose:  
Boolean); 
begin 
  showMessage('Cette fiche ne peut être refermée'); 
  CanClose := false; 
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
type 
  TForm1 = class(TForm) 
  private 
    { Déclarations privées } 
    procedure WMWindowMoving(var Message: TWMWindowPosMsg); message WM_MOVE; 
  public 
  end; 
  
  
implementation 
  
{$R *.DFM} 
  
procedure TForm1.WMWindowMoving(var Message: TWMWindowPosMsg); 
begin 
  if not Visible then Exit; 
  with Message do 
  begin 
    WindowPos.X:= Self.Left; 
    WindowPos.Y:= Self.Top; 
    Result:=0; 
  end; 
end; 
  
end;